ASMB,R,L,C
      HED OPEN  
*     NAME:   OPEN
*     SOURCE: 92064-18063 
*     RELOC:  92064-16061 
*     PGMR:   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-16061  REV.1650  760927 
* 
      ENT OPEN
      EXT EXEC,RMPAR,CLOSE,$CRLK,IMESS
      EXT .ENTR,.MVW,.DRCT,$CDIR
      EXT $LIBR,$LIBX 
      EXT .PDCV,$CON
      EXT CLD.R,.P1,.P2,.P3,.P4,.P5 
      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)
* 
* 
*       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 
*     -18   ILLEGAL LU (LU TOO LARGE OR NOT DEFINED)
* 
      SKP 
OPEN  NOP           ENTRY POINT 
      LDA DZERO     RESET ENTRY PARMS 
      STA NAME
      STA OP
      STA SC
      STA LU
      CLA 
      STA ZERO
      STA EQT5
      LDA SPC 
      STA RW
      LDA OPEN      SET PARM ADDR 
      STA DPEN      INTO DUMMY ENTRY POINT. 
      JMP DPEN+1
* 
.4    OCT 4 
N2    OCT -2
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 
      JSB NRUN      GO CHECK IF NEW RUN 
      LDB NAME      DID WE GET
      CPB DZERO      ENOUGH PARAMETERS? 
      JMP EXN10       NO; ERROR - EXIT
* 
      LDA OP         FETCH ADDRESS OF OPTION
      CPA DZERO      IF NO OPTN WORD
      JMP NOPSE      SKIP CHECK OF OPTN BITS
      LDA A,I        FETCH OPTION 
* 
      ELA            SET PAUSE\NO PAUSE FLAG? 
      SSA,RSS       SCRATCH OPEN? 
      JMP OP.1      NO--GO SEE IF PAUSE WAS REQUESTED 
* 
      LDB DSCR      FETCH ADDR. OF SCR. MESSAGAE
      LDA LU,I      CAN'T HAVE 0 FOR LU 
      SZA,RSS       MUST HAVE LU ON SCRATCH OPENS 
      JMP EXN10     ERROR-- NOT ENOUGH PARMS. 
      STB NAME      SET SCR. AS NAME TO BE PRINTED
* 
OP.1  SEZ,RSS       SEE IF PAUSE NEEDED.
      JMP NOPSE     NO--CONTINUE
* 
      LDA LU         FETCH LU PARM (AGAIN)
      CPA DZERO     IF NO LU GIVEN--
      CLA,RSS                        OUTPUT ZEROES
      LDA A,I        ELSE FETCH GIVEN LU
* 
      SSA           MAKE IT POS(MIGHT NEED TO INDICATE NEG FOR LU)
      CMA,INA         IF NEG, FOR CONVERSION
* 
* 
*       CONVERT IT TO ASCII DECMIAL 
* 
      JSB .PDCV     GO PRIV AND CALL SYS ROUTINE
* 
      STA ODLU      SET RESULT INTO PRINT BUFFER
* 
* 
*  FETCH PROG NAME AND SET INTO PRINT BUF 
* 
      LDB XEQT      FETCH ID SEG ADDR 
      ADB .14       ADVANCE TO LAST WORD
      LDA B,I       FETCH IT
      AND HBYTE         NOW ISOLATE IT
      IOR B40       INCLUDE BLANK 
      STA PG3       SAVE FOR PRINT
      ADB N2        BACKUP TO FIRST WD OF NAME
      DLD B,I       FETCH 1ST TWO WORDS 
      DST PG1       SAVE FOR PRINT
* 
      LDA NAME
      LDB NMEA      MOVE FILE NAME INTO 
      JSB .MVW          PRINT BUFFER
      DEF .3
      NOP 
* 
* 
*    USE CORRECT TERMINAL FOR MESSAGE 
* 
      JSB IMESS 
      DEF PSR 
      DEF .2
      DEF PGNA,I
      DEF .12 
* 
PSR   JSB EXEC       SUSPEND THE PROGRAM
      DEF NOPSE 
      DEF .7
* 
*   OPERATOR INTERACTION REQUIRED HERE
* 
* 
NOPSE JSB CLOSE      GO CLOSE THIS DCB
      DEF NO.2
      DEF DCB,I 
* 
NO.2  SZA       ANY ERRORS? 
      CPA N11       IGNORE NOT OPEN 
      RSS           IT'S OK 
      JMP EXIT
* 
*   CHECK FOR MAGIC NAME
* 
      LDB NAME      FETCH ADDRESS OF NAME 
      LDA B,I       FETCH FIRST TWO CHARACTERS
      CPA MJ..      CHECK FOR MAGIC FILE NAME(LU) 
      INB,RSS       FIRST TWO CHARS MATCH -CONTINUE 
      JMP NORM      NOPE NOT MAGIC NAME--CONTINUE 
      LDA B,I       FETCH CHARS 3&4 
      CPA LU..      CHECK FOR NEXT TWO MAGIC CHARS(..)
      INB,RSS       GOT EM--ADVANCE TO ASCII LU(2 DIGIT)
      JMP NORM      NOPE--NORMAL CALL 
* 
*  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 
* 
*  BUILD DCB INFO 
* 
      LDA DUM       SET DUMMY 
      STA DCB,I         DCB FLAG
* 
      LDA OP,I      FETCH SUBFUNCTION 
      AND B3700     ISOLATE GOOD BITS 
      IOR VALUE     INCLUDE LU
      STA WD3       SAVE IT 
      LDA EOF       INCLUDE EOF CODE NOW
      IOR VALUE 
      STA WD4       SET FOR DCB MOVE
* 
*  NOT SURE IF THIS IS NEEDED 
* 
      LDA VALUE     FETCH LU AGAIN
      SZA           IF ZERO LU--ALLOW WRITE ONLY
      JMP NOZRO     NOT ZERO-CONTINUE 
      INA           SET FOR WRITE ONLY
      STA RW        SAVE READ WRITE CODE
NOZRO JMP RTN       GO BUILD DUMMY DCB
* 
* 
* MID-CONSTANTS 
* 
* 
MJ..  ASC 1,LU
LU..  ASC 1,..
TEMP1 NOP 
VALUE NOP 
EQT5  NOP 
SUBC  NOP 
EOF   NOP 
B17   OCT 17
B100  OCT 100 
N7K   OCT 170777
B24K  OCT 2400
.1    OCT 1 
B1100 OCT 1100
B400  OCT 400 
* 
* 
NORM  LDA NAME
      CLE           CLEAR E FOR SCRATCH TEST
      CPA DSCR       IF SCRATCH OPEN-FORCE
      CLA,CME        INVALID FILENAME 
      LDA A,I 
* 
      STA .P3       SET FOR CALL TO D.RTR 
      ISZ NAME      GET 
      DLD NAME,I     REST OF NAME 
* 
      SZA,RSS       PAD 
      LDA BLNK         WITH  BLANKS 
      SZB,RSS               IF
      LDB BLNK                  NEEDED
* 
      RAL,ERA       IF SCR- SET SIGN OF P4
      DST .P4       NAME AND SET FOR D.RTR CALL 
      LDA .10       SET FUNCTION
      STA .P1         FOR D.R 
      LDA LU,I      SET LU
      STA .P2         FOR D.R 
* 
      JSB CLD.R     GO CALL D.R 
* 
* 
* 
SCRTN JSB RMPAR     YES; GET THE RETURN 
      DEF *+2        CODES
      DEF .P1         TO LOCAL AREA 
* 
* 
      LDA .P1       GET ERROR WORD
      SZA           EVERY THING OK? 
      JMP EXIT      NO,ERROR--EXIT
* 
* 
* 
NER   LDA .P2        CHECK FOR DEVICE FILE
      STA DCB,I      SET TYPE(DEVICE VS. USER FILE) 
* 
*  STANDARD USER FILE -- BUILD DCB
* 
      STA WD3       SAVE LU 
      AND B77       REMOVE SUBFUNCTION
      STA B 
      IOR EFCO      ADD EOF CODE
      STA WD4       SET FOR DCB 
* 
      ADB LCODE     CONFIGURE LOCATE
      STB XTMP      CONTROL REQUEST 
* 
      LDA .P4        FETCH ABSOLUTE FILE NUMBER 
      STA IPRM1      SAVE FOR POSITION CALL 
      JSB EXEC       ISSUE CONTROL REQUEST TO LOC. ABS FILE # IPRM1 
      DEF RTN 
      DEF .3
      DEF XTMP
      DEF IPRM1 
* 
*   STATUS CHECK HERE?? MUST HAVE GOOD POS OR BAD OPEN--
* 
RTN   LDB DCB        BUILD DEFAULT USER BUFFER
      LDA EQT5      FETCH DEVICE CODE/0 
      SZA,RSS       IF ZERO 
      LDA .P5       THEN GET FILE TYPE
      INB           ADVANCE TO DCB1 
      STA B,I       SET DEVICE\FILE TYPE INTO DCB 
      INB           ADVANCE TO FILE TYPE
      CLA           SET TYPE TO ZERO
      STA B,I 
      LDA WD3A      FETCH FROM ADDRESS FOR MOVE 
      INB           ADVANCE TO WD3
* 
      JSB .MVW       MOVE IN REST OF DCB INFO.
      DEF .4
      NOP 
* 
* 
      INB           SEE ABOUT USING SEC WORD
      LDA IPRM1     FETCH FILE #
      STA B,I       SET INTO DCB
* 
      INB           ADVANCE TO OPEN WORD
      LDA XEQT       SET DCB OPEN TO
      STA B,I          THIS PROGRAM 
* 
      ADB .5
      CLA,INA       SET REC NUM TO 1
      STA B,I 
* 
*  SEE IF PRE-FUNCTION IS REQUIRED
* 
      LDB OP,I      FETCH OPTION WORD 
      BLF,BRS       POSITION TO SLB THE INHIBIT BIT(#13)
      LDA EQT5      FETCH DEVICE TYPE/ZERO
      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 LDB DCB       CACULATE DCB SUB FUNCTION 
      ADB .3        ADDRESS 
      STB SC        SAVE IT 
      LDB OP        GET THE OPTIN SUB FUNCTION
      CPB DZERO 
      JMP NOOP      NOT GIVEN--EXIT 
      LDA B,I        FETCH ACTUAL OPTION WORD 
      AND .8        CHECK "F" BIT 
      SZA,RSS       IF NOT SET
      JMP NOOP      USE FUNCTION CODE DEFINED AT CREATION 
* 
      LDA B,I       FETCH OPTN AGAIN
      AND B3700     ISOLATE FUNCTION CODE 
      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 
NOOP  CLA,RSS       CLEAR A AND EXIT
EXN10 LDA N10 
      RSS 
ERN18 LDA N18 
      SPC 1 
EXIT  STA ERR,I     SET THE ERROR CODE
      JMP DPEN,I     AND RETURN 
* 
      SPC 2 
IH?   SLB           IF INHIBIT BIT WAS SET
      JMP SPCN1     DON'T DO LEADER 
      JMP SPCFN     ELSE DO IT
      SPC 5 
* 
* 
* 
* TYPER SUBROUTINE
*   FETCHES DEVICE TYPE AND SUB-CHNL
*   LDA LU
*   JSB TYPER 
*     RETURNS DEVICE TYPE IN (A)
* 
* 
* 
* 
CDIR  NOP 
* 
TYPER NOP 
      STA VALUE 
* 
      JSB EXEC
      DEF STRTN 
      DEF STAT
      DEF VALUE 
      DEF EQT5
      DEF EOF 
      DEF SUBC
* 
STRTN JMP ERN18     BAD LU EXIT 
* 
* 
TYP2  LDA EQT5
      AND TYPE      ISOLATE TYPE CODE BITS
      STA EQT5
      JMP TYPER,I 
* 
* 
STAT  OCT 100015
TYPE  OCT 37400 
* 
* 
NRUN  NOP 
      LDB $CON,I
      SSB,RSS 
      JMP NRUN,I
* 
      JSB $LIBR 
      NOP 
      ELB,CLE,ERB 
      STB $CON,I
* 
      CLB 
      LDA $CRLK     FETCH MASTER LOCK 
      CPA XEQT      OPEN THIS GUY?
      STB $CRLK     CLEAR IT IF IT WAS
* 
      JSB .DRCT 
      DEF $CDIR 
      STA CDIR
      ADA N1
      STA STOP
      INA 
NXT1  CPA STOP,I
      JMP NRUNX 
      ADA .3
      LDB A,I 
      CPB XEQT
      CLB 
      STB A,I 
INARS INA 
      JMP NXT1
* 
* 
NRUNX JSB $LIBX 
      DEF NRUN
* 
HBYTE OCT 177400
DUM   EQU HBYTE 
BUM   EQU HBYTE 
B40   OCT 40
.12   DEC 12
.14   DEC 14
* 
      SPC 3 
WD3A  DEF WD3 
WD3   NOP 
WD4   NOP 
SPC   OCT 100001
RW    OCT 100001
* 
LCODE OCT 2700
IPRM1 NOP 
EFCO  OCT 100 
      SPC 3 
DZERO DEF ZERO
N11   DEC -11 
N10   DEC -10 
.5    OCT 5 
.7    OCT 7 
.8    DEC 8 
.10   DEC 10
ZERO  NOP 
.2    DEC 2 
.3    DEC 3 
N18   DEC -18 
B3700 OCT 3700
B1000 OCT 1000
B700  OCT 700 
B77   OCT 77
STOP  NOP 
N1    OCT -1
* 
* 
PGNA  DEF *+1 
PG1   BSS 2 
PG3   BSS 1 
      ASC 1,: 
OUT1  ASC 2,OPEN
      OCT 26407     ASCII "- BELL"
NME   BSS 3 
      ASC 1, >
ODLU  NOP 
* 
SCR   ASC 3,SCR.
BLNK  EQU SCR+2 
DSCR  DEF SCR 
NMEA  DEF NME 
XTMP  EQU OPEN
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 3 
END   EQU * 
      END 
                                                                                                                                                                                                                                    