ASMB,R,L,C * NAME: OPENF * SOURCE: 92070-18048 * RELOC: 92070-16048 * PGMR: M.L.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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 OPENF,7 92070-1X048 REV.1941 790906 SUP * HED OPENF ENT OPENF EXT EXEC,CLOSE,GTOPN EXT .ENTR,OPEN,LURQ * * OPENF IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * CALL OPENF(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 OR LU * TO OPEN. * * 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) * * OPENF 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 * -36 LOCK ERROR SKP OPENF NOP LDA DZERO PRESET ENTRY PARMS STA NAME STA OP STA SC STA LU STA IBLK CLA RESET ZERO WORD STA ZERO LDA OPENF STA DPENF JMP DPENF+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 DPENF 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 * LDA NAME,I GET FILE NAME SSA POSITIVE? JMP ER18 NO, ILLEGAL LU ADA N64 IS IT LESS SSA THAN 64 JMP OPNLU YES, LEGAL LU ADA N17K IS IT SSA A NAME? JMP ER18 NO, ASSUME ILLEGAL LU * JSB OPEN NO, ASSUME ITS A FILE DEF OPRTN AND OPEN IT DEF DCB,I DEF ERR,I DEF NAME,I DEF OP,I DEF SC,I DEF LU,I DEF IBLK,I OPRTN JMP DPENF,I EXIT SKP OPNLU JSB EXEC CALL FOR STATUS AND DEF STRTN DEVICE TYPE DEF STAT DEF NAME,I DEF DVT6 DEF SELCD STRTN JMP ER18 ILLEGAL LU ERROR RETURN * LDA SELCD GET IFT 6 AND B77 ISOLATE SELECT CODE STA SELCD SAVE SELECT CODE FOR BIT BUCKET TEST * LDA DVT6 GET STATUS WORD AND TYPE ISOLATE DEVICE TYPE STA DVT6 SAVE CLB ASL 8 POSITION DEVICE TYPE TO LOWER BYTE OF B STB DEVTP * LDA MNDSC GET MINIMUM DISC TYPE ADA B IF LESS, OK SSA JMP NOTDS OK, NOT DISC * LDA MXDSC GET MAXIMUM DISC TYPE + 1 ADA B TEST VALUE SSA,RSS JMP NOTDS OK, NOT DISC * LDA N17 ERROR - DISC LU JMP EXIT * * SET UP DCB * NOTDS LDA DCB GET DCB POINTER STA DCBPT AND SAVE IT LDA DUMMY GET DUMMY DCB FLAG STA DCBPT,I AND STORE IN DCB0 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET DEVICE TYPE * LDA DVT6 GET DEVICE TYPE AND STA DCBPT,I STORE IN DCB1 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET FILE TYPE * CLA SET FILE TYPE TO 0 STA DCBPT,I AND STORE IN DCB2 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET LU AND SUBFUNCTION * CLB PRESET B FALSE (NOT INTERACTIVE) LDA M8 TEST WITH MAX INTERACTIVE + 1 ADA DEVTP TEST DEVICE FOR INTERACTIVE SSA INTERACTIVE? CCB YES,SET B TRUE (#0 I.E. INTERACTIVE) STB INT SAVE FOR LATER LDA OP,I GET THE OPTION WORD RAR,RAR PUT THE FUNCTION CODE BIT (#3) RAR,ERA INTO E REGISTER LDA OP,I GET THE OPTION WORD AGAIN AND FMASK ISOLATE FUNCTION BITS SEZ FUNCTION SET? JMP ADDLU YES, USE FUNCTION CODE FROM A REGISTER CLA NO, DEFAULT TO JUST LU UNLESS SZB INTERACTIVE? LDA ECHO YES, THEN DEFAULT TO ECHO ADDLU IOR NAME,I ADD IN THE LU STA DCBPT,I AND STORE IN DCB3 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET EOF CODE * LDA PAGE GET PAGE EJECT CODE LDB N12 TEST DEVICE TYPE AGAINST 13 (+1) OCTAL ADB DEVTP SSB IS IT IN RANGE 0-13 OCTAL? JMP STEOF YES, GO SET EOF * LDA LEADR PRESET A TO LEADER FUNCTION CODE LDB DEVTP GET DEVICE TYPE AND TEST CPB B26 AGAINST PAPER TAPE DEVICES JMP STEOF PAPER TAPE? CPB B27 JMP STEOF PAPER TAPE? * LDA EOF EVERTHING ELSE USES EOF STEOF IOR NAME,I ADD IN THE LU STA DCBPT,I AND STORE IN DCB4 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET SPACING * LDA BOTH PRESET A TO BOTH LDB M16 TEST IF ABOVE BOUNDRY ADB DEVTP SSB CLA BELOW BOUNDRY,SET NEITHER STA DCBPT,I STORE IN DCB5 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET READ/WRITE FLAG TO BOTH * LDA BOTH SET BOTH READ AND WRITE FLAGS LDB SELCD GET SELECT CODE SZB,RSS IS IT ZERO? CLA,INA YES, BIT BUCKET! ALLOW WRITE ONLY!! STA DCBPT,I STORE IN DCB6 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET SECURITY CODE MATCH AND OPEN MODE TO UPDATE * LDA BOTH SET BOTH SEC AND OPEN MODE STA DCBPT,I STORE IN DCB7 * * SET OPEN FLAG * JSB GTOPN GO GET CURRENT OPEN FLAG DEF *+1 LDB DCBPT INCREMENT DCB POINTER TO ADB .2 WORD 9 STB OPNPT SAVE OPEN FLAG LOCATION STA B,I STORE OPEN FLAG IN DCB9 * * SET RECORD COUNT TO 1 * ADB .5 INCREMENT TO WORD 14 CLA,INA SET 1 STA B,I STORE IN DCB14 INB POINT TO DCB15 STB DCBPT AND SAVE * * LOCK THE DEVICE IF NOT INTERACTIVE * CLA,INA SET A TO 1 STA DCBPT,I SET DEFAULT TO "DON'T UNLOCK" LDA OP,I GET OPEN OPTION SLA EXCLUSIVE OPEN? JMP EXOK NO, EXIT OK LDA INT TEST THE INTERACTIVE FLAG SZA INTERACTIVE? JMP EXOK INTERACTIVE SO DON'T LOCK * JSB LURQ LOCK CALL DEF *+4 DEF OPTN OPTION WORD DEF NAME,I LU WORD DEF .1 ONE LU JMP ER18 ERROR ON LOCK SZA CHECK IF ITS NON ZERO JMP LCKER YES, ERROR NO RN'S OR ALREADY LOCKED * STA DCBPT,I STORE LOCK SUCCESSFUL IN DCB14 EXOK CLA SET NO ERROR EXIT STA ERR,I STORE IN ERROR CODE JMP DPENF,I RETURN * * ERROR RETURNS * LCKER CLA CLEAR THE OPEN FLAG STA OPNPT,I FLAG IN DCB LDA N36 LOCK NOT GRANTED JMP EXIT * ER18 LDA N18 JMP EXIT SKP * * CONSTANTS * DZERO DEF ZERO DUMMY PARAMETER ZERO NOP DUMMY 0 N10 DEC -10 N11 DEC -11 N12 DEC -12 N64 DEC -64 N17K OCT -17700 USED FOR LEGAL LU TEST STAT OCT 100015 STATUS EXEC W/ SIGN TYPE OCT 37400 MNDSC DEC -24 NEGATIVE TYPE 30 MXDSC DEC -32 NEGATIVE TYPE 40 DUMMY OCT 177700 DUMMY DCB FLAG M8 DEC -8 ECHO OCT 400 ECHO BIT FOR CONWD PAGE OCT 1100 PAGE EJECT CONTROL REQUEST LEADR OCT 1000 PUNCH/READER CNTRL REQUEST EOF OCT 100 STANDARD EOF CONTROL REQUEST B26 OCT 26 B27 OCT 27 B77 OCT 77 BOTH OCT 100001 M16 DEC -16 .1 DEC 1 .2 DEC 2 .5 DEC 5 OPTN OCT 140001 N36 DEC -36 N18 DEC -18 N17 DEC -17 FMASK OCT 43700 BU/TR/EC/BI MASK * * VARIBLES * DVT6 NOP STORAGE FOR DVT6 SELCD NOP STORAGE FOR IFT6 (CONTAINS SELECT CODE) DEVTP NOP DEVICE TYPE DCBPT NOP DCB POINTER INT NOP INTERACTIVE FLAG 0=NOT INT, #0=INT OPNPT NOP OPEN FLAG LOCATION POINTER * A EQU 0 B EQU 1 * END EQU * END