ASMB,R,L,C HED OPEN * NAME: OPENF * SOURCE: 92067-18178 * RELOC: 92067-16125 * PGMR: M.L.K.,N.J.S. * * *************************************************************** * * (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 92067-16125 REV.1940 790724 ENT OPENF EXT XLUEX, CLOSE EXT .ENTR, OPEN, LURQ SUP * * 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) * * 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 * -32 CARTRIDGE NOT FOUND * * 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 * 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 * JSB CLOSE CLOSE DEF *+2 IF DEF DCB,I OPEN SZA SKIP IF NO ERROR CPA N11 OR IF NOT OPEN CLE,RSS JMP EXIT ELSE TAKE ERR EXIT * LDA NAME,I GET FILE NAME ADA N20K IS IT LESS THAN SSA ASCII BLANK IN UPPER BYTE? JMP OPNLU YES, ASSUME ITS AN 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 XLUEX CALL FOR STATUS AND DEF STRTN DEVICE TYPE DEF STAT DEF NAME,I DEF DVT6 DEF EQT4 DEF SUBC STRTN JMP ER18 ILLEGAL LU ERROR RETURN * 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 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 * STA MINCR CLEAR MINI-CARTRIDGE FLAG LDA DEVTP GET DEVICE TYPE LDB SUBC GET DEVICE SUBCHANNEL SZB,RSS SUBCHANNEL ZERO? JMP OPT.1 YES - CAN'T BE A MINI-CARTRIDGE * ADB N3 TEST WITH MAX MINI-CR SUBCHANNEL + 1 CPA .5 DEVICE TYPE 5? SSB,RSS YES - AND SUBCHANNEL 1 OR 2? JMP OPT.1 NO - NOT A MINICARTRIDGE * ISZ MINCR SET MINI-CARTRIDGE FLAG CLB CLEAR INTERACTIVE FLAG (NOT INTERACTIVE) JMP OPT.2 AND GO SET IT. * OPT.1 CLB KNOW IT'S NOT A MINI-CARTRIDGE - SEE IF SZA,RSS IT'S INTERACTIVE TYPE ZERO? CCB YES - SET INTERACTIVE FLAG ADA N8 TEST WITH MAX INTERACTIVE TYPE + 1 SSA,RSS TYPE 7 OR LESS? JMP OPT.2 NO - GO SET INIT FLAG WITH B = 0 * ADA .5 NOW SEE IF IT'S TYPE 3 OR GREATER SSA,RSS IS IT? CCB YES, SET INTERACTIVE FLAG B = -1 OPT.2 STB INIT SAVE INTERACTIVE FLAG LDA OP,I GET THE OPTION WORD RAR,RAR GET BIT 3 - USE SUPPLIED OPTION RAR,ERA TO THE E-REGISTER LDA OP,I GET OPTION WORD AGAIN AND FMASK ISOLATE FUNCTION BITS SEZ SUPPOSED TO USE IT? JMP ADDLU YES - GO ADD IT IN CLA NO - GET RID OF IT SZB IF DEVICE IS INTERACTIVE LDA ECHO 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 LEADR PRESET TO LEADER FUNCTION CODE LDB DEVTP GET THE DEVICE TYPE CPB .2 PUNCH? JMP STEOF YES - GO SET CODE CPB .1 P T READER? JMP STEOF YES - GO SET CODE * LDA EOF GET WRITE EOF CODE LDB MINCR GET MINICR FLAG SZB MINICARTRIDGE? JMP STEOF YES - GO SET CODE * LDB DEVTP GET DEVICE TYPE AGAIN ADB M16 CHECK IF >17 OCTAL SSB,RSS JMP STEOF YES - GO SET CODE * LDA PAGE ALL OTHERS GET PAGE EJECT STEOF IOR NAME,I ADD IN THE LU STA DCBPT,I ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET SPACING * LDA BOTH SET A TO BOTH STA DCBPT,I STORE IN DCB5 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET READ/WRITE FLAG TO BOTH * LDB BOTH PRESET BOTH READ AND WRITE FLAGS LDA EQT4 GET EQT4 FROM STATUS REQUEST AND B77 MASK TO SELECT CODE SZA,RSS IF IT'S ZERO THIS IS EQT 0 = BIT BUCKET CLB,INB SO SET READ/WRITE CODE TO WRITE ONLY STB DCBPT,I STORE IN DCB 6 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET SECURITY CODE MATCH AND OPEN MODE TO UPDATE * LDA SCOPM GET SEC CODE SET AND OPEN MODE SET STA DCBPT,I STORE IN DCB7 * * SET OPEN FLAG * LDA XEQT GET OPEN FLAG LDB DCBPT INCREMENT DCB POINTER TO ADB .2 WORD 9 STA B,I STORE OPEN FLAG IN DCB9 * * SET RECORD COUNT TO 1 * ADB .4 INCREMENT TO WORD 13 CLA SET WORD 13 AND WORD STA B,I TO A DOUBLE WORD 1 INB INA STA B,I 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 INTERACTIVE SO DON'T LOCK LDA INIT TEST THE INTERACTIVE FLAG SZA INTERACTIVE? JMP EXOK INTERACTIVE - SO DON'T LOCK * LDA NAME,I SET BIT 13 ON LU WORD IOR BIT13 SO 8 BITS WILL BE USER FOR STA SUBC LU IN THE RESULTING EXEC CALL * JSB LURQ LOCK CALL DEF *+4 DEF OPTN OPTION WORD DEF SUBC LU WORD WITH BIT 13 SET DEF .1 ONE LU JMP ER18 ERROR ON LOCK SZA CHECK IF ITS NOT ZERO JMP LCKER YES, ERROR NO RN'S AVAILABLE 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 LDA N36 LOCK NOT GRANTED JMP EXIT * ER18 LDA N18 JMP EXIT SKP * * CONSTANTS * DZERO DEF ZERO ZERO NOP N3 DEC -3 N8 DEC -8 N10 DEC -10 N11 DEC -11 N20K OCT 160000 NEGATIVE 20K OCTAL STAT OCT 100015 STATUS EXEC WITH SIGN TYPE OCT 37400 MNDSC DEC -24 NEGATIVE TYPE 30 MXDSC DEC -27 NEGATIVE TYPE 33 DUMMY OCT 177700 DUMMY DCB FLAG ECHO OCT 400 PAGE OCT 1100 LEADR OCT 1000 EOF OCT 100 BOTH OCT 100001 M16 DEC -16 .1 DEC 1 .2 DEC 2 .4 DEC 4 .5 DEC 5 OPTN OCT 140001 N36 DEC -36 N18 DEC -18 N17 DEC -17 FMASK OCT 63700 BU/UE/TR/EC/BI MASK XEQT EQU 1717B SCOPM OCT 100010 BIT13 OCT 20000 B77 OCT 77 * * VARIABLES * DVT6 NOP STORAGE FOR DVT6 DEVTP NOP DEVICE TYPE EQT4 NOP DCBPT NOP DCB POINTER INIT NOP INTERACTIVE FLAG 0=NOT INT, #0=INT SUBC NOP MINCR NOP * A EQU 0 B EQU 1 * END EQU * END