ASMB,R,L,C
*     NAME:   OPEN
*     SOURCE: 92070-18047 
*     RELOC:  92070-16047 
*     PGMR:   G.A.A.
*     MOD:    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 OPEN,7  92070-1X047 REV.2009  800225
      SUP 
* 
      HED OPEN
      ENT OPEN
      EXT LURQ,CLOSE,IFTTY,$OPEN
      EXT .ENTR,.P1,.P2,.P3,.P4,CLD.R 
      EXT .R1,.R2,.R5 
* 
*  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)
* 
*  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 
*     -36   LOCK ERROR
      SKP 
* 
* 
OPEN  NOP 
      LDA DZERO      PRESET ENTRY PARMS 
      STA NAME
      STA OP
      STA SC
      STA LU
      STA IBLK
      CLA           RESET ZERO WORD 
      STA ZERO
      LDA OPEN
      STA DPEN
      JMP DPEN+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 
DPEN  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
      LDB OP,I       AND OPTION 
      ERB             EXCLUSIVE BIT TO E
      CME              INVERT AND 
      RAL,ERA           SET IN SIGN OF A
      STA .P3       SET FOR CALL TO D.RTR 
      STA LOCK      STORE FOR LOCK TEST 
      ISZ NAME      GET 
      DLD NAME,I     REST OF
      SZA,RSS       CHECK FOR NULL FROM ON PROCESSOR
      LDA BLK       FILL WITH BLANK 
      SZB,RSS       SAME CHECK
      LDB BLK       FILL WITH BLANKS
      DST .P4 
      LDA .9        FETCH OPEN CODE 
      STA .P1       SET IN CALL 
      LDA LU,I      FETCH CR\LU 
      STA .P2       SET IN CALL 
      JSB CLD.R     GO GET D.RTR
* 
      LDA .R1       GET ERROR WORD
      STA TMP       SAVE FILE LENGTH OR 0 IF TYPE 0 
      SSA            IF ERROR 
      JMP EXIT        EXIT
      DLD .R2       ELSE SET
      DST DCB,I      THE DCB FOR $OPEN
      CLO           SET O 
      LDA OP,I       TO 
      RAR,SLA,RAR     INDICATE
      STO              UPDATE OPTION
      ERA               AND E FOR TYPE 1 OVER-RIDE
      STA LU        SAVE FLAG 
      LDA DCB       GET DCB ADDRESS 
      LDB SC,I       AND SECURITY CODE
      JSB $OPEN       AND GO SET UP THE DCB 
      DEF IBLK,I    ADDRESS OF BLOCK SIZE 
      DEF .R5       ADDRESS OF NO OF SECTORS PER TRACK
      JMP OPEN1     ERROR - CLOSE AND EXIT
      SSA           IF OPEN PROTECT 
      SSB            AND CODE MISMATCH THEN SKIP
      JMP OPEN2       ELSE GO EXIT - GOOD OPEN
      SPC 2 
      LDA N7        SET EXIT CODE 
OPEN1 STA TMP       IN TEMP 
      JSB CLOSE     ILLEGAL OPEN SO CLOSE 
      DEF *+2        THE
      DEF DCB,I       FILE
OPEN2 LDA TMP       GET FILE LENGTH, ERROR CODE OR 0 IF TYPE 0
      SZA           IF NOT TYPE ZERO
      JMP EXIT      THEN EXIT 
      SPC 1 
      LDB LU        GET SUB FUNCTION FLAG AND 
      ERB            SET E AS SUB FUNCTION FLAG 
      LDB DCB       CACULATE DCB SUB FUNCTION 
      ADB .3        ADDRESS 
      STB SC        SAVE IT 
      LDA OP,I      GET THE OPTIN SUB FUNCTION
      AND B477K     MASK IT OFF 
      STA B         AND SAVE IT 
      LDA SC,I      GET THE CURRENT WORD
      AND B77       SAVE THE LU 
      STA LU        SAVE FOR LOCK 
      ADA B         ADD IN THE NEW SUB FUNCTION 
      SEZ           IF SUB FUNTION NOT SET USE FROM FILE
      STA SC,I      SET IT IN THE DCB 
      LDB DCB       GET DCB ADDRESS 
      ADB .15       POINT TO WORD 15
      STB SC        AND SAVE
      CLA,INA       DEFAULT TO DON'T
      STB SC,I        UNLOCK THE LU 
      LDA LOCK      LOCK THE LU?
      SSA,RSS       TEST SIGN 
      JMP LUEX      DON'T LOCK, EXIT
      JSB IFTTY     TEST IF LU IS 
      DEF *+2         INTERACTIVE 
      DEF LU
      SZA           INTERACTIVE?
      JMP LUEX      YES, DON'T LOCK!
* 
      JSB LURQ
      DEF *+4 
      DEF OPTN      OPTION WORD 
      DEF LU        LU WORD 
      DEF .1        ONE LU
      JMP ER18      ERROR ON LOCK 
      SSA           NO RN?
      JMP LCKER     RIGHT, ERROR
      STA SC,I      STORE LOCK WORD IN DCB15
LUEX  CLA           CLEAR A AND EXIT
      SPC 1 
EXIT  LDB DCB       IF NO ERRORS, 
      ADB .2        THEN REPLACE THE SIZE 
      SSA,RSS       WITH THE TYPE 
      LDA B,I       IF NO ERRORS
EXIT2 STA ERR,I     SET THE ERROR CODE
      JMP DPEN,I     AND RETURN 
* 
* 
LCKER LDB DCB       CLEAR THE OPEN
      ADB .9         FLAG  (GET ADDRESS)
      CLA 
      STA B,I        FILE NOT OPEN
      LDA N36       COULDN'T LOCK ERROR 
      JMP EXIT2 
* 
* 
ER18  LDA N18       ILLEGAL LU
      JMP EXIT2 
      SKP 
DZERO DEF ZERO
N10   DEC -10 
N11   DEC -11 
N7    DEC -7
ZERO  NOP 
.1    OCT 1 
.2    DEC 2 
.3    DEC 3 
.9    DEC 9 
B77   OCT 77
BLK   ASC 1,
.15   DEC 15
N18   DEC -18 
N36   DEC -36 
TMP   NOP 
LOCK  NOP 
OPTN  OCT 140001
B477K OCT 47700 
      SPC 3 
A     EQU 0 
B     EQU 1 
      SPC 3 
END   EQU * 
      END 
                                                                    