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 
                                                                                                                        