ASMB,R,L,C
*     NAME:   OPEN
*     SOURCE: 92064-18178 
*     RELOC:  92064-16058 
*     PGMR:   G.A.A.
*     MOD:    G.L.M 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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  92064-16058  REV.1650  761116 
* 
      HED OPEN
* 
      ENT OPEN
      EXT EXEC,CLOSE,RMPAR,$OPEN,$LIBR,$LIBX
      EXT .DRCT,$CON
* 
* 
      EXT .ENTR,.P1,.P2,.P3,.P4,.P5,CLD.R 
      SUP 
* 
*  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 
* 
* 
      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
* 
      LDB NAME      FETCH ADDRESS OF NAME PARM
      LDA B,I       GET NAME WORD1
      CPA MJ..      CHECK FOR MAJIC LU
      INB,RSS       SO FAR SO GOOD
      JMP NORM      NOPE--NORMAL OPEN 
      LDA B,I       FETCH NEXT TWO CHARS
      CPA LU..      CHECK FOR LAST PART OF "LU.." 
      INB,RSS       GOT IT,ADVANCE TO LU WORD 
      JMP NORM      CONTINUE
* 
* 
* 
*  FOUND MAGIC NAME 
*  BUILD DUMMY DCB INFO 
* 
      LDA B,I       FETCH ASCII LU
      STA TEMP1     SAVE IT 
      ALF,ALF       POSITION FIRST DIGIT TO LOW END 
      AND B17       ISOLATE IT
      STA VALUE      SAVE FOR MULT. 
      LDA .10       FETCH BASE FOR CONVERSION 
      MPY VALUE     CONVERT TO BINARY 
      STA VALUE     SAVE RESULT 
      LDA TEMP1     FETCH ORIGINAL ASCII VALUES 
      AND B17       ISOLATE SECOND DIGIT
      ADA VALUE      INCLUDE CONVERTED VALUE
      JSB TYPER     GO GET DEVICE TYPE AND SUB-CHNL 
* 
*  DEVICE TYPE RETURNS IN (A) 
*  SUB-CHNL IS IN "SUBC"
* 
*  IF LU WAS NOT ASSIGNED, A ERROR-18 (ILLEGAL LU) EXIT 
*  IS TAKEN FROM TYPER
* 
      LDB B100      FETCH EOF CODE FOR MT TYPE DEVICES
      ADA N7K       SEE IF TYPE GREATER THAN 17 
      SSA,RSS         WELL? 
      JMP STEOF     YES IT IS--GO STORE THE EOF CODE
* 
*  CHECK FOR 2644\5\7 CTU'S 
* 
      LDA EQT5      RESTORE TYPE CODE 
      CPA B24K      IS THIS DVR05 
      RSS           YES--SKIP 
      JMP BRF       NOPE GO TRY SOMETHING ELSE
      LDA SUBC      FETCH SUBCHANNEL
      CPA .1        LCTU? 
      JMP STEOF     YES --GO SET EOF CODE(B100) 
      CPA .2        RCTU? 
      JMP STEOF     YES-- SEE ABOVE^^^^^^^^^^^^ 
* 
* 
BRF   LDB B1000     EOF CODE FOR PUNCH
      CPB EQT5      IT'S ALSO TYPE CODE FOR DVR02 
      RSS           YEP  IT'S A PUNCH--USE EOF CODE IN B
      LDB B1100     EVERYONE ELSE DEFAULTS TO 1100B 
STEOF STB EOF       SAVE CODE 
* 
* 
* 
*  SET UP REQUIRED DCB ADDRESSES
* 
* 
      LDA DCB 
      INA 
      STA DCB1
      INA 
      STA DCB2
      INA 
      STA DCB3
      INA 
      STA DCB4
      INA 
      STA DCB5
      INA 
      STA DCB6
      INA 
      STA DCB7
      ADA .2
      STA DCB9
      ADA .5
      STA DCB14 
* 
* 
* 
*  BUILD DCB INFO 
* 
      LDA DUM       SET DUMMY 
      STA DCB,I         DCB FLAG
      LDA EQT5      FETCH TYPE CODE 
      STA DCB1,I    SAVE IT 
      CLA 
      STA DCB2,I    SET TYPE
* 
      LDA OP,I      FETCH SUBFUNCTION 
      AND B3700     ISOLATE GOOD BITS 
      IOR VALUE     INCLUDE LU
      STA DCB3,I    SAVE IT 
      LDA EOF       INCLUDE EOF CODE NOW
      IOR VALUE 
      STA DCB4,I    SET FOR DCB MOVE
* 
* 
      LDA BOTHW     CODE FOR RW,SP,SC MATCH 
      STA DCB5,I
      STA DCB6,I
      STA DCB7,I
* 
      LDA XEQT
      STA DCB9,I
* 
      CLA,INA 
      STA DCB14,I 
* 
      LDA VALUE     FETCH LU AGAIN
      SZA           IF ZERO LU--ALLOW WRITE ONLY
      JMP NOZRO     NOT ZERO-CONTINUE 
      INA           SET FOR WRITE ONLY
      STA DCB6,I    SAVE READ WRITE CODE
* 
*  SEE IF PRE-FUNCTION IS REQUIRED
* 
NOZRO LDB OP,I      FETCH OPTION WORD 
      BLF,BRS       POSITION TO SLB THE INHIBIT BIT(#13)
      LDA EQT5      PUNCH?
      CPA B1000     PUNCH?
      JMP IH?       GO SEE IF LEADER HAS BEEN INHIBITED 
      CPA B400      PHOTO READR 
      LDA B700      CONTROL CODE TO SET EOT 
      SZA,RSS       IF NOT ONE OF ABOVE SKIP CONTROL
      JMP SPCN1 
SPCFN LDB VALUE     FETCH LU
      IOR B         COMBINE FOR CONTROL WORD
      STA VALUE     DON'T NEED LU ANY MORE--
* 
      JSB EXEC
      DEF SPCN1     DO
      DEF .3          SPECIAL PRE-FUNCTION--(SET EOT
      DEF VALUE        IF PHOTO READR,PUNCH LEADER ON PUNCH)
* 
* 
* 
* 
SPCN1 CLA 
      JMP EXIT2 
* 
* 
* 
B400  OCT 400 
B700  OCT 700 
BOTHW OCT 100001
DUM   OCT 177400
B17   OCT 17
.10   DEC 10
B100  OCT 100 
B1000 OCT 1000
N7K   OCT 170777
B24K  OCT 2400
B1100 OCT 1100
      SPC 2 
DCB1  NOP 
DCB2  NOP 
DCB3  NOP 
DCB4  NOP 
DCB5  NOP 
DCB6  NOP 
DCB7  NOP 
DCB9  NOP 
DCB14 NOP 
MJ..  ASC 1,LU
LU..  ASC 1,..
TEMP1 NOP 
VALUE NOP 
EQT5  NOP 
SUBC  NOP 
EOF   NOP 
* 
* 
*   INHIBIT BIT SET?
* 
* 
IH?   SLB,RSS       IF INHIBIT BIT NOT SET
      JMP SPCFN     GO DO LEADER
* 
      CLA 
      STA DCB1,I   PREVENT TRAILER ON CLOSE 
      JMP SPCN1     DON'T DO LEADER 
      SPC 5 
* 
* 
* 
* TYPER SUBROUTINE
*   FETCHES DEVICE TYPE AND SUB-CHNL
*   LDA LU
*   JSB TYPER 
*     RETURNS DEVICE TYPE IN (A)
* 
* 
* 
* 
* 
TYPER NOP 
      STA VALUE 
* 
      JSB EXEC
      DEF STRTN 
      DEF STAT
      DEF VALUE 
      DEF EQT5
      DEF EOF 
      DEF SUBC
* 
STRTN JMP ERN18     BAD LU EXIT 
* 
* 
      LDA EQT5
      AND TYPE      ISOLATE TYPE CODE BITS
      STA EQT5
* 
* 
      LDB MIDSK     MINIMUM DISK DRIVER TYPE-1
      ADB A         IF LESS--OK 
      SSB           WELL??? 
      JMP TYPER,I   IT'S OK SO GET OUT
* 
      LDB MADSK     MAXIUM DISK DRIVER TYPE+1 
      ADB A         CHECK IT
      SSB           OK IF GREATER OR ZERO 
      JMP ERN17 
* 
      JMP TYPER,I 
* 
* 
STAT  OCT 100015
TYPE  OCT 37400 
MADSK OCT 162000    NEG TYPE 34 
MIDSK OCT 164400     NEG TYPE 27
ND18  DEC -18 
ND17  DEC -17 
* 
* 
*  ILLEGAL LU(ASSIGNED TO DISK) OPEN
* 
ERN17 LDA ND17
      RSS 
*   BAD LU EXIT 
* 
ERN18 LDA ND18
      JMP EXIT2 
* 
* 
      SKP 
* 
* 
* 
*    NORMAL FILE OPEN 
*    **************** 
* 
* 
NORM  LDB $CON,I    FETCH WORD HOLDING NEW RUN FLAG 
      SSB,RSS       IF NOT SET--SKIP
      JMP NORM2 
* 
      JSB $LIBR     GO
      NOP               PRIV
      ELB,CLE,ERB    AND CLEAR
      STB $CON,I        IT. 
* 
* 
* 
      JSB $LIBX 
      DEF *+1 
      DEF *+1       RETURN TO NON-PRIV MODE 
* 
* 
NORM2 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 
      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 .11       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.RFP
* 
      JSB RMPAR     YES; GET THE RETURN 
      DEF *+2        CODES
      DEF ID          TO LOCAL AREA 
      LDA ID        GET ERROR WORD
      SSA            IF ERROR 
      JMP EXIT        EXIT
      DLD ID+1      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 ID+4      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 ID        IN ID 
      JSB CLOSE     ILLEGAL OPEN SO CLOSE 
      DEF *+2        THE
      DEF DCB,I       FILE
OPEN2 LDA ID        SEND ERROR CODE 
      LDB LU        GET SUB FUNCTION FLAG 
      SLB           IF NOT SET
      SZA           OR NOT TYPE ZERO
      JMP EXIT      THEN EXIT 
      SPC 1 
      LDB DCB       CACULATE DCB SUB FUNCTION 
      ADB .3        ADDRESS 
      STB SC        SAVE IT 
      LDA OP,I      GET THE OPTIN SUB FUNCTION
      AND B3700     MASK IT OFF 
      STA B         AND SAVE IT 
      LDA SC,I      GET THE CURRENT WORD
      AND B77       SAVE THE LU 
      ADA B         ADD IN THE NEW SUB FUNCTION 
      STA SC,I      SET IT IN THE DCB 
      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 
      SPC 2 
      SPC 3 
DZERO DEF ZERO
N10   DEC -10 
N11   DEC -11 
ID    NOP 
NAME1 BSS 4 
N7    DEC -7
ZERO  NOP 
.1    OCT 1 
.2    DEC 2 
.3    DEC 3 
.5    OCT 5 
B3700 OCT 3700
B77   OCT 77
BLK   ASC 1,
.11   DEC 11
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 3 
END   EQU * 
      END 
                                                                                                                          