ASMB,R,L,C * NAME: OPEN * SOURCE: 92064-18178 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM OPEN,7 92064-16058 REV.1650 761116 * HED OPEN * ENT OPEN EXT EXEC,CLOSE,RMPAR,$OPEN,$LIBR,$LIBX EXT .DRCT,$CON * * EXT .ENTR,.P1,.P2,.P3,.P4,.P5,CLD.R SUP * * OPEN IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY. * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * OPEN ERRORS ARE AS FOLLOWS: * * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * * SKP * * OPEN NOP LDA DZERO PRESET ENTRY PARMS STA NAME STA OP STA SC STA LU STA IBLK CLA RESET ZERO WORD STA ZERO LDA OPEN STA DPEN JMP DPEN+1 * * MIGHT NEED TO CLEAR ZERO * DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 DPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA LDA N10 LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXIT NO; ERROR - EXIT SPC 1 JSB CLOSE CLOSE DEF *+2 IF DEF DCB,I OPEN SZA SKIP IF NO ERRORS CPA N11 OR IF NOT OPEN CLE,RSS JMP EXIT ELSE TAKE ERR EXIT * LDB NAME FETCH ADDRESS OF NAME PARM LDA B,I GET NAME WORD1 CPA MJ.. CHECK FOR MAJIC LU INB,RSS SO FAR SO GOOD JMP NORM NOPE--NORMAL OPEN LDA B,I FETCH NEXT TWO CHARS CPA LU.. CHECK FOR LAST PART OF "LU.." INB,RSS GOT IT,ADVANCE TO LU WORD JMP NORM CONTINUE * * * * FOUND MAGIC NAME * BUILD DUMMY DCB INFO * LDA B,I FETCH ASCII LU STA TEMP1 SAVE IT ALF,ALF POSITION FIRST DIGIT TO LOW END AND B17 ISOLATE IT STA VALUE SAVE FOR MULT. LDA .10 FETCH BASE FOR CONVERSION MPY VALUE CONVERT TO BINARY STA VALUE SAVE RESULT LDA TEMP1 FETCH ORIGINAL ASCII VALUES AND B17 ISOLATE SECOND DIGIT ADA VALUE INCLUDE CONVERTED VALUE JSB TYPER GO GET DEVICE TYPE AND SUB-CHNL * * DEVICE TYPE RETURNS IN (A) * SUB-CHNL IS IN "SUBC" * * IF LU WAS NOT ASSIGNED, A ERROR-18 (ILLEGAL LU) EXIT * IS TAKEN FROM TYPER * LDB B100 FETCH EOF CODE FOR MT TYPE DEVICES ADA N7K SEE IF TYPE GREATER THAN 17 SSA,RSS WELL? JMP STEOF YES IT IS--GO STORE THE EOF CODE * * CHECK FOR 2644\5\7 CTU'S * LDA EQT5 RESTORE TYPE CODE CPA B24K IS THIS DVR05 RSS YES--SKIP JMP BRF NOPE GO TRY SOMETHING ELSE LDA SUBC FETCH SUBCHANNEL CPA .1 LCTU? JMP STEOF YES --GO SET EOF CODE(B100) CPA .2 RCTU? JMP STEOF YES-- SEE ABOVE^^^^^^^^^^^^ * * BRF LDB B1000 EOF CODE FOR PUNCH CPB EQT5 IT'S ALSO TYPE CODE FOR DVR02 RSS YEP IT'S A PUNCH--USE EOF CODE IN B LDB B1100 EVERYONE ELSE DEFAULTS TO 1100B STEOF STB EOF SAVE CODE * * * * SET UP REQUIRED DCB ADDRESSES * * LDA DCB INA STA DCB1 INA STA DCB2 INA STA DCB3 INA STA DCB4 INA STA DCB5 INA STA DCB6 INA STA DCB7 ADA .2 STA DCB9 ADA .5 STA DCB14 * * * * BUILD DCB INFO * LDA DUM SET DUMMY STA DCB,I DCB FLAG LDA EQT5 FETCH TYPE CODE STA DCB1,I SAVE IT CLA STA DCB2,I SET TYPE * LDA OP,I FETCH SUBFUNCTION AND B3700 ISOLATE GOOD BITS IOR VALUE INCLUDE LU STA DCB3,I SAVE IT LDA EOF INCLUDE EOF CODE NOW IOR VALUE STA DCB4,I SET FOR DCB MOVE * * LDA BOTHW CODE FOR RW,SP,SC MATCH STA DCB5,I STA DCB6,I STA DCB7,I * LDA XEQT STA DCB9,I * CLA,INA STA DCB14,I * LDA VALUE FETCH LU AGAIN SZA IF ZERO LU--ALLOW WRITE ONLY JMP NOZRO NOT ZERO-CONTINUE INA SET FOR WRITE ONLY STA DCB6,I SAVE READ WRITE CODE * * SEE IF PRE-FUNCTION IS REQUIRED * NOZRO LDB OP,I FETCH OPTION WORD BLF,BRS POSITION TO SLB THE INHIBIT BIT(#13) LDA EQT5 PUNCH? CPA B1000 PUNCH? JMP IH? GO SEE IF LEADER HAS BEEN INHIBITED CPA B400 PHOTO READR LDA B700 CONTROL CODE TO SET EOT SZA,RSS IF NOT ONE OF ABOVE SKIP CONTROL JMP SPCN1 SPCFN LDB VALUE FETCH LU IOR B COMBINE FOR CONTROL WORD STA VALUE DON'T NEED LU ANY MORE-- * JSB EXEC DEF SPCN1 DO DEF .3 SPECIAL PRE-FUNCTION--(SET EOT DEF VALUE IF PHOTO READR,PUNCH LEADER ON PUNCH) * * * * SPCN1 CLA JMP EXIT2 * * * B400 OCT 400 B700 OCT 700 BOTHW OCT 100001 DUM OCT 177400 B17 OCT 17 .10 DEC 10 B100 OCT 100 B1000 OCT 1000 N7K OCT 170777 B24K OCT 2400 B1100 OCT 1100 SPC 2 DCB1 NOP DCB2 NOP DCB3 NOP DCB4 NOP DCB5 NOP DCB6 NOP DCB7 NOP DCB9 NOP DCB14 NOP MJ.. ASC 1,LU LU.. ASC 1,.. TEMP1 NOP VALUE NOP EQT5 NOP SUBC NOP EOF NOP * * * INHIBIT BIT SET? * * IH? SLB,RSS IF INHIBIT BIT NOT SET JMP SPCFN GO DO LEADER * CLA STA DCB1,I PREVENT TRAILER ON CLOSE JMP SPCN1 DON'T DO LEADER SPC 5 * * * * TYPER SUBROUTINE * FETCHES DEVICE TYPE AND SUB-CHNL * LDA LU * JSB TYPER * RETURNS DEVICE TYPE IN (A) * * * * * TYPER NOP STA VALUE * JSB EXEC DEF STRTN DEF STAT DEF VALUE DEF EQT5 DEF EOF DEF SUBC * STRTN JMP ERN18 BAD LU EXIT * * LDA EQT5 AND TYPE ISOLATE TYPE CODE BITS STA EQT5 * * LDB MIDSK MINIMUM DISK DRIVER TYPE-1 ADB A IF LESS--OK SSB WELL??? JMP TYPER,I IT'S OK SO GET OUT * LDB MADSK MAXIUM DISK DRIVER TYPE+1 ADB A CHECK IT SSB OK IF GREATER OR ZERO JMP ERN17 * JMP TYPER,I * * STAT OCT 100015 TYPE OCT 37400 MADSK OCT 162000 NEG TYPE 34 MIDSK OCT 164400 NEG TYPE 27 ND18 DEC -18 ND17 DEC -17 * * * ILLEGAL LU(ASSIGNED TO DISK) OPEN * ERN17 LDA ND17 RSS * BAD LU EXIT * ERN18 LDA ND18 JMP EXIT2 * * SKP * * * * NORMAL FILE OPEN * **************** * * NORM LDB $CON,I FETCH WORD HOLDING NEW RUN FLAG SSB,RSS IF NOT SET--SKIP JMP NORM2 * JSB $LIBR GO NOP PRIV ELB,CLE,ERB AND CLEAR STB $CON,I IT. * * * JSB $LIBX DEF *+1 DEF *+1 RETURN TO NON-PRIV MODE * * NORM2 LDA NAME,I LDB OP,I AND OPTION ERB EXCLUSIVE BIT TO E CME INVERT AND RAL,ERA SET IN SIGN OF A STA .P3 SET FOR CALL TO D.RTR ISZ NAME GET DLD NAME,I REST OF SZA,RSS CHECK FOR NULL FROM ON PROCESSOR LDA BLK FILL WITH BLANK SZB,RSS SAME CHECK LDB BLK FILL WITH BLANKS DST .P4 LDA .11 FETCH OPEN CODE STA .P1 SET IN CALL LDA LU,I FETCH CR\LU STA .P2 SET IN CALL JSB CLD.R GO GET D.RFP * JSB RMPAR YES; GET THE RETURN DEF *+2 CODES DEF ID TO LOCAL AREA LDA ID GET ERROR WORD SSA IF ERROR JMP EXIT EXIT DLD ID+1 ELSE SET DST DCB,I THE DCB FOR $OPEN CLO SET O LDA OP,I TO RAR,SLA,RAR INDICATE STO UPDATE OPTION ERA AND E FOR TYPE 1 OVER-RIDE STA LU SAVE FLAG LDA DCB GET DCB ADDRESS LDB SC,I AND SECURITY CODE JSB $OPEN AND GO SET UP THE DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF ID+4 ADDRESS OF NO OF SECTORS PER TRACK JMP OPEN1 ERROR - CLOSE AND EXIT SSA IF OPEN PROTECT SSB AND CODE MISMATCH THEN SKIP JMP OPEN2 ELSE GO EXIT - GOOD OPEN SPC 2 LDA N7 SET EXIT CODE OPEN1 STA ID IN ID JSB CLOSE ILLEGAL OPEN SO CLOSE DEF *+2 THE DEF DCB,I FILE OPEN2 LDA ID SEND ERROR CODE LDB LU GET SUB FUNCTION FLAG SLB IF NOT SET SZA OR NOT TYPE ZERO JMP EXIT THEN EXIT SPC 1 LDB DCB CACULATE DCB SUB FUNCTION ADB .3 ADDRESS STB SC SAVE IT LDA OP,I GET THE OPTIN SUB FUNCTION AND B3700 MASK IT OFF STA B AND SAVE IT LDA SC,I GET THE CURRENT WORD AND B77 SAVE THE LU ADA B ADD IN THE NEW SUB FUNCTION STA SC,I SET IT IN THE DCB CLA CLEAR A AND EXIT SPC 1 EXIT LDB DCB IF NO ERRORS, ADB .2 THEN REPLACE THE SIZE SSA,RSS WITH THE TYPE LDA B,I IF NO ERRORS EXIT2 STA ERR,I SET THE ERROR CODE JMP DPEN,I AND RETURN SPC 2 SPC 3 DZERO DEF ZERO N10 DEC -10 N11 DEC -11 ID NOP NAME1 BSS 4 N7 DEC -7 ZERO NOP .1 OCT 1 .2 DEC 2 .3 DEC 3 .5 OCT 5 B3700 OCT 3700 B77 OCT 77 BLK ASC 1, .11 DEC 11 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END