ASMB,R,L,C HED OPEN * NAME: OPEN * SOURCE: 92064-18063 * RELOC: 92064-16061 * PGMR: 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-16061 REV.1650 760927 * ENT OPEN EXT EXEC,RMPAR,CLOSE,$CRLK,IMESS EXT .ENTR,.MVW,.DRCT,$CDIR EXT $LIBR,$LIBX EXT .PDCV,$CON EXT CLD.R,.P1,.P2,.P3,.P4,.P5 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) * * * 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 * -18 ILLEGAL LU (LU TOO LARGE OR NOT DEFINED) * SKP OPEN NOP ENTRY POINT LDA DZERO RESET ENTRY PARMS STA NAME STA OP STA SC STA LU CLA STA ZERO STA EQT5 LDA SPC STA RW LDA OPEN SET PARM ADDR STA DPEN INTO DUMMY ENTRY POINT. JMP DPEN+1 * .4 OCT 4 N2 OCT -2 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 JSB NRUN GO CHECK IF NEW RUN LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXN10 NO; ERROR - EXIT * LDA OP FETCH ADDRESS OF OPTION CPA DZERO IF NO OPTN WORD JMP NOPSE SKIP CHECK OF OPTN BITS LDA A,I FETCH OPTION * ELA SET PAUSE\NO PAUSE FLAG? SSA,RSS SCRATCH OPEN? JMP OP.1 NO--GO SEE IF PAUSE WAS REQUESTED * LDB DSCR FETCH ADDR. OF SCR. MESSAGAE LDA LU,I CAN'T HAVE 0 FOR LU SZA,RSS MUST HAVE LU ON SCRATCH OPENS JMP EXN10 ERROR-- NOT ENOUGH PARMS. STB NAME SET SCR. AS NAME TO BE PRINTED * OP.1 SEZ,RSS SEE IF PAUSE NEEDED. JMP NOPSE NO--CONTINUE * LDA LU FETCH LU PARM (AGAIN) CPA DZERO IF NO LU GIVEN-- CLA,RSS OUTPUT ZEROES LDA A,I ELSE FETCH GIVEN LU * SSA MAKE IT POS(MIGHT NEED TO INDICATE NEG FOR LU) CMA,INA IF NEG, FOR CONVERSION * * * CONVERT IT TO ASCII DECMIAL * JSB .PDCV GO PRIV AND CALL SYS ROUTINE * STA ODLU SET RESULT INTO PRINT BUFFER * * * FETCH PROG NAME AND SET INTO PRINT BUF * LDB XEQT FETCH ID SEG ADDR ADB .14 ADVANCE TO LAST WORD LDA B,I FETCH IT AND HBYTE NOW ISOLATE IT IOR B40 INCLUDE BLANK STA PG3 SAVE FOR PRINT ADB N2 BACKUP TO FIRST WD OF NAME DLD B,I FETCH 1ST TWO WORDS DST PG1 SAVE FOR PRINT * LDA NAME LDB NMEA MOVE FILE NAME INTO JSB .MVW PRINT BUFFER DEF .3 NOP * * * USE CORRECT TERMINAL FOR MESSAGE * JSB IMESS DEF PSR DEF .2 DEF PGNA,I DEF .12 * PSR JSB EXEC SUSPEND THE PROGRAM DEF NOPSE DEF .7 * * OPERATOR INTERACTION REQUIRED HERE * * NOPSE JSB CLOSE GO CLOSE THIS DCB DEF NO.2 DEF DCB,I * NO.2 SZA ANY ERRORS? CPA N11 IGNORE NOT OPEN RSS IT'S OK JMP EXIT * * CHECK FOR MAGIC NAME * LDB NAME FETCH ADDRESS OF NAME LDA B,I FETCH FIRST TWO CHARACTERS CPA MJ.. CHECK FOR MAGIC FILE NAME(LU) INB,RSS FIRST TWO CHARS MATCH -CONTINUE JMP NORM NOPE NOT MAGIC NAME--CONTINUE LDA B,I FETCH CHARS 3&4 CPA LU.. CHECK FOR NEXT TWO MAGIC CHARS(..) INB,RSS GOT EM--ADVANCE TO ASCII LU(2 DIGIT) JMP NORM NOPE--NORMAL CALL * * 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 * * BUILD DCB INFO * LDA DUM SET DUMMY STA DCB,I DCB FLAG * LDA OP,I FETCH SUBFUNCTION AND B3700 ISOLATE GOOD BITS IOR VALUE INCLUDE LU STA WD3 SAVE IT LDA EOF INCLUDE EOF CODE NOW IOR VALUE STA WD4 SET FOR DCB MOVE * * NOT SURE IF THIS IS NEEDED * LDA VALUE FETCH LU AGAIN SZA IF ZERO LU--ALLOW WRITE ONLY JMP NOZRO NOT ZERO-CONTINUE INA SET FOR WRITE ONLY STA RW SAVE READ WRITE CODE NOZRO JMP RTN GO BUILD DUMMY DCB * * * MID-CONSTANTS * * MJ.. ASC 1,LU LU.. ASC 1,.. TEMP1 NOP VALUE NOP EQT5 NOP SUBC NOP EOF NOP B17 OCT 17 B100 OCT 100 N7K OCT 170777 B24K OCT 2400 .1 OCT 1 B1100 OCT 1100 B400 OCT 400 * * NORM LDA NAME CLE CLEAR E FOR SCRATCH TEST CPA DSCR IF SCRATCH OPEN-FORCE CLA,CME INVALID FILENAME LDA A,I * STA .P3 SET FOR CALL TO D.RTR ISZ NAME GET DLD NAME,I REST OF NAME * SZA,RSS PAD LDA BLNK WITH BLANKS SZB,RSS IF LDB BLNK NEEDED * RAL,ERA IF SCR- SET SIGN OF P4 DST .P4 NAME AND SET FOR D.RTR CALL LDA .10 SET FUNCTION STA .P1 FOR D.R LDA LU,I SET LU STA .P2 FOR D.R * JSB CLD.R GO CALL D.R * * * SCRTN JSB RMPAR YES; GET THE RETURN DEF *+2 CODES DEF .P1 TO LOCAL AREA * * LDA .P1 GET ERROR WORD SZA EVERY THING OK? JMP EXIT NO,ERROR--EXIT * * * NER LDA .P2 CHECK FOR DEVICE FILE STA DCB,I SET TYPE(DEVICE VS. USER FILE) * * STANDARD USER FILE -- BUILD DCB * STA WD3 SAVE LU AND B77 REMOVE SUBFUNCTION STA B IOR EFCO ADD EOF CODE STA WD4 SET FOR DCB * ADB LCODE CONFIGURE LOCATE STB XTMP CONTROL REQUEST * LDA .P4 FETCH ABSOLUTE FILE NUMBER STA IPRM1 SAVE FOR POSITION CALL JSB EXEC ISSUE CONTROL REQUEST TO LOC. ABS FILE # IPRM1 DEF RTN DEF .3 DEF XTMP DEF IPRM1 * * STATUS CHECK HERE?? MUST HAVE GOOD POS OR BAD OPEN-- * RTN LDB DCB BUILD DEFAULT USER BUFFER LDA EQT5 FETCH DEVICE CODE/0 SZA,RSS IF ZERO LDA .P5 THEN GET FILE TYPE INB ADVANCE TO DCB1 STA B,I SET DEVICE\FILE TYPE INTO DCB INB ADVANCE TO FILE TYPE CLA SET TYPE TO ZERO STA B,I LDA WD3A FETCH FROM ADDRESS FOR MOVE INB ADVANCE TO WD3 * JSB .MVW MOVE IN REST OF DCB INFO. DEF .4 NOP * * INB SEE ABOUT USING SEC WORD LDA IPRM1 FETCH FILE # STA B,I SET INTO DCB * INB ADVANCE TO OPEN WORD LDA XEQT SET DCB OPEN TO STA B,I THIS PROGRAM * ADB .5 CLA,INA SET REC NUM TO 1 STA B,I * * SEE IF PRE-FUNCTION IS REQUIRED * LDB OP,I FETCH OPTION WORD BLF,BRS POSITION TO SLB THE INHIBIT BIT(#13) LDA EQT5 FETCH DEVICE TYPE/ZERO 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 LDB DCB CACULATE DCB SUB FUNCTION ADB .3 ADDRESS STB SC SAVE IT LDB OP GET THE OPTIN SUB FUNCTION CPB DZERO JMP NOOP NOT GIVEN--EXIT LDA B,I FETCH ACTUAL OPTION WORD AND .8 CHECK "F" BIT SZA,RSS IF NOT SET JMP NOOP USE FUNCTION CODE DEFINED AT CREATION * LDA B,I FETCH OPTN AGAIN AND B3700 ISOLATE FUNCTION CODE 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 NOOP CLA,RSS CLEAR A AND EXIT EXN10 LDA N10 RSS ERN18 LDA N18 SPC 1 EXIT STA ERR,I SET THE ERROR CODE JMP DPEN,I AND RETURN * SPC 2 IH? SLB IF INHIBIT BIT WAS SET JMP SPCN1 DON'T DO LEADER JMP SPCFN ELSE DO IT SPC 5 * * * * TYPER SUBROUTINE * FETCHES DEVICE TYPE AND SUB-CHNL * LDA LU * JSB TYPER * RETURNS DEVICE TYPE IN (A) * * * * CDIR NOP * TYPER NOP STA VALUE * JSB EXEC DEF STRTN DEF STAT DEF VALUE DEF EQT5 DEF EOF DEF SUBC * STRTN JMP ERN18 BAD LU EXIT * * TYP2 LDA EQT5 AND TYPE ISOLATE TYPE CODE BITS STA EQT5 JMP TYPER,I * * STAT OCT 100015 TYPE OCT 37400 * * NRUN NOP LDB $CON,I SSB,RSS JMP NRUN,I * JSB $LIBR NOP ELB,CLE,ERB STB $CON,I * CLB LDA $CRLK FETCH MASTER LOCK CPA XEQT OPEN THIS GUY? STB $CRLK CLEAR IT IF IT WAS * JSB .DRCT DEF $CDIR STA CDIR ADA N1 STA STOP INA NXT1 CPA STOP,I JMP NRUNX ADA .3 LDB A,I CPB XEQT CLB STB A,I INARS INA JMP NXT1 * * NRUNX JSB $LIBX DEF NRUN * HBYTE OCT 177400 DUM EQU HBYTE BUM EQU HBYTE B40 OCT 40 .12 DEC 12 .14 DEC 14 * SPC 3 WD3A DEF WD3 WD3 NOP WD4 NOP SPC OCT 100001 RW OCT 100001 * LCODE OCT 2700 IPRM1 NOP EFCO OCT 100 SPC 3 DZERO DEF ZERO N11 DEC -11 N10 DEC -10 .5 OCT 5 .7 OCT 7 .8 DEC 8 .10 DEC 10 ZERO NOP .2 DEC 2 .3 DEC 3 N18 DEC -18 B3700 OCT 3700 B1000 OCT 1000 B700 OCT 700 B77 OCT 77 STOP NOP N1 OCT -1 * * PGNA DEF *+1 PG1 BSS 2 PG3 BSS 1 ASC 1,: OUT1 ASC 2,OPEN OCT 26407 ASCII "- BELL" NME BSS 3 ASC 1, > ODLU NOP * SCR ASC 3,SCR. BLNK EQU SCR+2 DSCR DEF SCR NMEA DEF NME XTMP EQU OPEN SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END