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