ASMB,R,L,C
      HED COMPILER LIBRARY OPEN ROUTINE 
      NAM OPN.C,7 92064-18237 780407 REV. 1805 $CLIB
* 
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
* 
* 
* 
*   SOURCE PART NUMBER :       92060-18054
* 
* 
* 
* 
*  OPEN DEFAULT FILE
* 
*  THIS ROUTINE WILL INSPECT THE FILE CONTROL BLOCK AND DETERMINE 
*  WHETHER TO OPEN A 'FMGR' FILE, SCRATCH FILE OR LOGICAL UNIT. 
*  IN THE CASE OF THE 'FMGR' FILE IT WILL SET UP THE PARAMETERS 
*  AND CALL 'GEX.C'. IF IT IS A SCRATCH FILE IT WILL GET A TRACK
*  FOR RTE OR A SCRATCH FILE IN THE CASE OF OF RTE-M. 
* 
* 
* 
* 
* 
*  CALLING SEQUENCE:
* 
*         A REGISTER CONTAINS THE PROMPT CHARACTERS 
* 
*         JSB OPN.C 
*         DEF FCB 
*         ERROR RETURN
*         NO ERROR RETURN 
* 
*  ON RETURN A < 0  INDICATES ERROR 
*            A = 0  INDICATES NO ERROR
* 
* 
* 
*  ENTRY POINT: 
* 
      ENT OPN.C 
* 
*  EXTERNALS: 
* 
      EXT EXEC      SYSTEM EXEC 
      EXT GEX.C     CREATE-OPEN ROUTINE 
      EXT LURQ      LOCK LU ROUTINE 
      EXT CRE.C     CREATE ROUTINE
      EXT ADS.C     FCB ADDRESS PASSER ROUTINE
      EXT C.TRN     ASCII STRING CONTAINING TURN ON LIST FROM 'NAMR'
      EXT .MVW      MOVE WORD ROUTINE 
      EXT C.HLK     HEAD OF FCB LINKED LIST 
      EXT C.LNK     FCB LINK WORD 
      EXT C.FCB     ADDRESS OF FCB
      EXT C.FID     FCB ID WORD 
      EXT C.FLU     FCB LOGICAL UNIT WORD 
      EXT C.STR     FCB CURRENT EXTENT TRACK NUMBER WORD
      EXT C.SSC     FCB CURRENT EXTENT SECTOR NUMBER WORD 
      EXT C.EXT     FCB EXTENT NUMBER WORD
      EXT C.RSC     FCB EXTENT OFFSET NUMBER
      EXT C.S/T     FCB NUMBER OF BLOCKS/TRACK WORD 
      EXT C.#SC     FCB NUMBER OF BLOCKS/EXTENT WORD
      EXT C.BFF     FCB BUFFER ADDRESS WORD 
      EXT C.WRD     FCB CURRENT WORD POINTER WORD 
      EXT C.FAD     FCB DIRECTORY ADDRESS FROM D.RTR WORDS
      EXT C.HTR     FCB START OF FILE TRACK NUMBER WORD 
      EXT C.HLU     FCB HEAD LOGICAL UNIT NUMBER
      EXT C.SLU     FCB SECONDARY LOGICAL UNIT NUMBER WORD
      EXT C.RC#     FCB RECORD NUMBER 
      EXT C.??      FCB PROMPT CHARACTERS 
      EXT C.GRW     FCB REWIND GUARANTEE ROUTINE ADDRESS
      EXT C.INS     FCB $INCLUDE ROUTINE ADDRESS
      EXT C.CNT     FCB CONTROL ROUTINE ADDRESS 
* 
      EXT C.NAM     DEFAULT FILE NAME 
      EXT C.SC      DEFAULT FILE SECURITY CODE
      EXT C.CR      DEFAULT FILE CARTRIDGE OR LU NUMBER 
      EXT C.FTY     DEFAULT FILE TYPE 
      EXT C.FSZ     DEFAULT FILE SIZE 
      EXT C.TYP     'NAMR' TYPE 
      EXT C.FCB     ADDRESS OF FCB
      EXT C.FST     FIRST CHARACTER OF SOURCE NAMR
* 
      EXT D.RP1     RETURN PARAMETERS 
      EXT D.RP2       OF OPEN CREATE ROUTINE 'GEX.C'
      EXT D.RP3 
      EXT D.RP4 
      EXT D.RP5 
      EXT D.RP6 
      EXT D.RP7 
* 
* 
* 
A     EQU 0 
B     EQU 1 
* 
OPN.C NOP 
      JSB ADS.C     SET UP FILE CONTROL BLOCK ADDRESSES 
      DEC 0 
      STA PRMPT     SAVE PROMPT CHARACTERS
      CLA 
      STA C.EXT,I 
      STA C.RSC,I   INITIALIZE
      STA C.WRD,I     FCB FOR 
      STA C.LNK,I       RESTART 
      STA C.RC#,I 
      STA C.??,I
      LDA C.FID,I 
      ELA,CLE,ERA   CLEAR OUT DEVICE TYPE FLAG
      STA C.FID,I 
      LDA TRNON 
      JSB INDCK     MAKE DIRECT 
      STA TRNON 
      LDA TOADD 
      JSB INDCK 
      STA TOADD     MAKE DIRECT 
* 
      LDA C.FID,I   EXTRACT 
      ALF,RAL         DEFAULT PARAMETER 
      AND B17           NUMBER
      JSB GTNAM     MOVE DEFAULT PARAMETER TO BUFFER
* 
*  DETERMINE TYPE OF OPERATION
* 
*   THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: 
* 
*      TYPE  =  0   IS READ SOURCE FILE(OR LU)
*            =  1   IS WRITE BINARY FILE(OR LU) 
*            =  2   IS WRITE SCRATCH FILE 
*            =  3   IS WRITE LIST  FILE(OR LU)
*            =  4   IS READ SOURCE AND GUARANTEE REWINDABLITY 
* 
      LDA C.FID,I   EXTRACT 
      AND B17         FCB OPERATION TYPE
      STA B 
      STA OPTYP     SAVE FILE OPEN TYPE 
      CPB .2        WRITE SCRATCH 
      JMP WRTSC     YES, CREATE SCRATCH FILE
* 
      LDA C.TYP     ISOLATE 
      AND .3          PARAMETER TYPE
      CPA .1        INTEGER(LOGICAL UNIT!)
      JMP OPNLU     YES!
      CPA .3        FILE NAME?
      JMP *+3       YES!
      SZA           NULL? 
      JMP E200       NO SUCH TYPE!
* 
      CPB .1        WRITE BINARY? 
      JMP WRITB     YES , CREATE BINARY FILE! 
      CPB .3        WRITE SOURCE? 
      JMP WRITS     YES, CREATE SOURCE FILE 
* 
*  READ SOURCE FILE OPEN
* 
      SZA,RSS       NULL SOURCE NAMR? 
      JMP E202      YES!
      CCA 
      STA TMP       SET UP READ SOURCE FLAG FOR SECURITY CODE CHECK 
      LDA C.NAM     ISOLATE FIRST 
      AND HIMSK       CHARACTER 
      STA C.FST         AND SAVE FOR LIST AND BINARY CHECK
* 
* 
* 
*      GEX.C IS CALLED TO OPEN A FILE, ON RETURN FROM GEX.C 
*      THE FOLLOWING PARAMETERS ARE PASSED BACK IN D.RP1 THRU D.RP7 
* 
*       D.RP1 = ERROR CODE, IF > 0 THEN THE # OF SECTORS IN THE FILE
*       D.RP2 = TRACK AND LOGICAL UNIT
*       D.RP3 = OFFSET AND SECTOR NUMBER
*       D.RP4 = TRACK NUMBER (LU IF TYPE = 0) 
*       D.RP5 = NUMBER OF SECTORS IN TRACK AND SECTOR NUMBER
*       D.RP6 = SECURITY CODE OF THE FILE 
*       D.RP7 = TYPE OF THE FILE
* 
* 
OPEN  LDA .2        CALL
      LDB C.CR        ROUTINE TO
      JSB GEX.C         OPEN A FILE 
      DEF C.NAM 
      JMP ERR 
* 
      LDA D.RP7     CHECK TO SEE IF FILE TYPE MATCHES 
      LDB OPTYP 
      CPB .1        BINARY FILE OPEN??
      JMP BIN       YES!
      CPB .3        LIST FILE OPEN? 
      JMP LST       YES!
* 
CKSC  LDA D.RP6     IS SECURITY 
      CPA C.SC        CODE OF FILE SAME AS USER SUPPLIED? 
      JMP RETRN     YES, OK!
      SSA           FILE WRITE PROTECTED? 
      JMP E7        YES, ILLEGAL SECURITY CODE! 
      ISZ TMP       SOURCE FILE READ? 
      JMP E7        NO, NO CAN WRITE ON EITHER! 
RETRN LDB D.RP1     TYPE 0 FILE?
      LDA D.RP4     A=LU#,B=#SECTRS 
      SZB,RSS 
      JMP OPNL1     YES 
      JSB SETUP     SET UP THE FCB
* 
*  LINK THE FCB INTO THE LIST - HEAD IS GLOBAL CALLED C.HLK 
* 
      LDA C.HLU,I   SET TRACK LU
      STA C.FLU,I     INTO PRIMARY LU 
RET1  CLA,INA 
      STA C.WRD,I   CLEAR WORD PTR
      LDA C.HLK     GET HEAD
      LDB C.FCB     GET ADDRESS OF FILE CONTROL BLK 
      STB C.HLK       AND SET IT IN HEAD POINTER
      SZA           HEAD LINK PTR EMPTY?
      STA C.FCB,I   NO, SO PLACE ADDRESS IN NEW FCB 
      CLA           CLEAR ERROR RETRUN
      JMP EXIT      TAKE P+2 EXIT 
* 
BIN   CPA .5        BINARY FILE?
      JMP CKSC      YES!
      JMP E16       NO, ILLEGAL FILE TYPE 
* 
LST   CPA .3        SOURCE FILE?
      JMP CKSC      YES!
      CPA .4        SOURCE FILE?
      JMP CKSC      YES!
      JMP E16       NO ,ILLEGAL FILE TYPE 
* 
E202  LDA M202      NO SOURCE NAMR
      RSS 
E15   LDA M15       BAD NAMR
      RSS 
E16   LDA M16       ILLEGAL TYPE
      RSS 
E201  LDA M201      NO BINARY ERROR 
      RSS 
E200  LDA M200      BAD FCB FORMAT ERROR
      RSS           TAKE P+1 ERROR EXIT 
E7    LDA M7        SECURITY CODE ERROR 
      RSS 
EXIT  ISZ OPN.C     TAKE P+2 EXIT 
ERR   JMP OPN.C,I   EXIT
* 
*  WRITE BINARY (TYPE=5) FILE 
* 
WRITB LDA C.TYP     IS NAME 
      SZA,RSS         A NULL? 
      JMP E201      YES SET ERROR TO 201 SO NOT TO OUTPUT BINARY
      LDA C.NAM     IS
      AND HIMSK       FIRST 
      CPA MINUS         CHARACTER A MINUS?
      RSS           YES , USE SOURCE NAME EXECPT FOR FIRST CHAR 
      JMP CRE       CREATE A TYPE 5 FILE! 
SMNAM CLA,INA       GET SOURCE
      JSB GTNAM       NAMR
      LDA C.FST     IS FIRST CHARCTER 
      CPA AMPSD       AND AMPERSAND?
      RSS           YES!
      JMP E15       NO! 
      LDA C.NAM     USE SOURCE
      AND B377
      IOR PERCT       NAMR EXCEPT 
      STA C.NAM         REPLACE FIRST CHAR BY % 
CRE   LDB PERCT     SET UP FOR POSSIBLE DUPLICATE FILE NAME CHECK 
      LDA .5
      JMP CREAT     CREATE FILE OR OPEN IT
* 
* 
* WRITE SOURCE FILE - LIST(CREATE TYPE 4 FILE)
* 
WRITS LDA C.TYP     IS NAMR 
      SZA,RSS         A NULL? 
      JMP LU6       YES, SET LU TO 6
      LDA C.NAM     IS
      AND HIMSK       FIRST 
      CPA MINUS         CHARACTER A MINUS?
      RSS           YES, CREATE OR OPEN FILE WITH SAME NAME AS SOURCE 
      JMP CRE1      CREATE FILE NAME WITH SOURCE NAMR 
* 
      CLA,INA       GET LIST
      JSB GTNAM       NAMR
      LDA C.FST      IS FIRST 
      CPA AMPSD       CHARACTER OF SOURCE NAME AN AMPERSAND?
      RSS           YES, CREATE OR OPEN ('NAMR) 
      JMP E15       ILLEGAL NAME
      LDA C.NAM     STUFF IN
      AND B377
      IOR APOST       APOSTROPHE
      STA C.NAM 
CRE1  LDA .4        CREATE TYPE 4 FILE
      LDB APOST     SET UP
CREAT STB TMP         APOSTROPHE FOR POSSIBLE DUPLICATE FILE NAME CHECK 
      JSB CRE.C       AND GO TO TO IT 
      NOP           ERROR, DO SPECIAL CHECK 
      CPA M2        DUPLICATE NAME? 
      JMP CKNAM     YES, CHECK IF SAME AS SOURCE NAMR 
      SSA,RSS       ANY OTHER ERROR?
      JMP RETRN     SETUP FCB 
      JMP ERR       YES, PASS ON THRU 
* 
* CHECK NAME TO SEE IF IT STARTS WITH A (') FOR LIST OR (%) FOR 
*  BINARY. IF SO OPEN IT AND USE IT IF NOT THEN ERR 15. 
* 
CKNAM LDA C.NAM     GET 
      AND HIMSK       FIRST CHARACTER 
      CPA TMP       IS IT A (') FOR LIST OR (%) FOR BINARY? 
      JMP OPEN      YES, OPEN EXISTING FILE 
      JMP E15 NO, GIVE ERROR
* 
* 
* 
* 
*  WRITE SCRATCH FILE (GET TRACK FOR RTE-II,RTE-III, AND RTE-IV)
*                     (OPEN SCRATCH FILES FOR RTE-M)
* 
WRTSC LDA .4
      JSB GEX.C     GET SCRATCH FILE
      JMP ERR 
      JMP RETRN     SET UP FCB
* 
* 
* 
*  OPEN LOGICAL UNIT DEVICE 
* 
LU6   LDA .6        DEFAULT TO LU 6 
      RSS 
OPNLU LDA C.NAM     GET LU FROM 
OPNL1 STA LU        SET CONTROL LU
      IOR  B600     SET V AND K BITS TO ECHO AND PRINT COLUMN ONE ON LP 
      CPB .1        BINARY? 
      JMP WRTBN     YES!
      CPB .4        SOURCE INPUT? 
      JMP INSRC     YES!
      SZA,RSS       INPUT SOURCE-GUARANTEE REWINDABILITY? 
      JMP INSRC     YES!
      STA C.FLU,I   SET LU
      SSA 
      CMA,INA 
      STA LU
* 
DTTY2 JSB EXEC       REQUEST STATUS 
      DEF RT1 
      DEF .13 
      DEF LU
      DEF EQ5 
      DEF EQ4 
      DEF SPC 
* 
* 
RT1   LDA EQ5        CHECK FOR DVR00
      AND TYPE
      SZA,RSS 
      JMP GOOD       YEP--TAKE GOOD EXIT
* 
      ADA NDVR5      CHECK FOR DVR05
      SZA,RSS 
      JMP SBCNL      YEP--SO FAR SO GOOD--GO CHECK FOR SUB CHNL 0 
* 
      JMP LULK
* 
SBCNL LDA SPC        FETCH SUB CHNL 
      AND B77 
      SZA 
      JMP LULK       NOT ZERO 
* 
GOOD  LDA PRMPT     SET PROMPT
      STA C.??,I      CHARACTERS UP 
OPN1  LDA C.FID,I   SET SIGN
      IOR SIGN      BIT TO SHOW 
      STA C.FID,I   IT IS AN LU.
      LDA C.FID,I   IS THIS 
      AND B17         A REWINDABLE SOURCE 
      CPA .2            READ OPERATION? 
      RSS           YES!
      JMP RET1      NO! 
* 
      LDA .4        GET SCRATCH 
      JSB GEX.C       FILE
      JSB ERR 
      JSB SETUP     SET UP FCB
      LDA C.HLU,I     AND ALSO
      STA C.SLU,I       SETUP SECONDARY LU
      JMP RET1
* 
LULK  JSB LURQ      LOCK
      DEF *+4 
      DEF B101        THE 
      DEF C.FLU,I 
      DEF .1            DEVICE
      CPA .1        LU ALREADY LOCKED?
      JMP OPN1      YES!
      SZA,RSS       REQUEST MAKE IT?
      JMP OPN1      YES!
      JSB EXEC      NO RESCHEDULE 
      DEF *+6 
      DEF .12 
      DEF .0          AGAIN 15 SECONDS FROM NOW 
      DEF .2
      DEF .0
      DEF M15 
      JMP LULK
* 
WRTBN IOR B100      SET BINARY
      STA C.FLU,I     FLAG
      LDA LU
      IOR B1000     SET OUTPUT LEADER 
CONT  STA LU
      JSB EXEC      OUTPUT CONTROL FUNCTION 
      DEF *+3 
      DEF .3
      DEF LU
      JMP DTTY2 
* 
INSRC LDA LU
      IOR B700      SET END-OF PAPER TAPE 
      JMP CONT
* 
SIGN  DEF 0,I 
* 
*  INDIRECT ROUTINE 
* 
INDCK NOP 
      RSS 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      JMP INDCK,I 
* 
*  GET THE DEFAULT FILE NAMR INTO GLOBAL STORAGE
* 
*    CALLING SEQUENCE:
*    A  =  DEFAULT PARAMETER NUMBER 
*    JSB GTNAM
* 
* 
GTNAM NOP 
      ADA M1        COMPUTE 
      MPY .10         OFFSET WITHIN BUFFER
      ADA TRNON 
      LDB TOADD     MOVE DATA 
      JSB .MVW        TO BUFFER 
      DEF .8
      NOP 
      LDA C.CR      IS CARTRIDGE
      SZA,RSS         NUMBER SUPPLIED?
      LDA C.TRN+5   NO, USE SOURCE CR!
      STA C.CR
      JMP GTNAM,I   RETURN
* 
* 
*  SET UP DATA IN FCB 
* 
SETUP NOP 
      LDB C.BFF 
      LDA B100K     SET UP BUFFER 
      STA B,I 
      CCA 
      INB 
      STA B,I         FLAGS 
      LDA D.RP1     MAKE SECTORS/FILE INTO BLOCKS/FILE
      RAR 
      STA C.#SC,I     AND SAVE IN FCB 
      LDA D.RP2 
      AND B77       ISOLATE FILE LU AND 
      STA TMP         SAVE IT 
      CMA,INA       SET MINUS LU
      STA C.TRN+5     SOURCE FILE NAMR FOR LIST, BINARY DEFAULTS
      LDB C.#SC,I   GET FILE SIZE 
      LDA D.RP4     GET START 
      STA C.STR,I     TRACK AND SET IN FCB
      STA C.HTR,I       IN BOTH CURRENT AND HEAD TRACK
      LDA TMP       DISC FILE!
      IOR PROBT     OR IN DISC UNPROTECT BITS 
      STA C.HLU,I   SET IN FCB
      LDA D.RP5     EXTRACT 
      AND B377        START SECTOR
      STA C.SSC,I   SET START BLOCK 
      XOR D.RP5     EXTRACT 
      ALF,ALF         #BLOCKS/TRACK 
      RAR 
      STA C.S/T,I   SET UP NUMBER OF BLOCKS/TRACK IN FCB
      JMP SETUP,I 
* 
* 
* 
* 
*  CONSTANTS AND BUFFERS
* 
TRNON DEF C.TRN 
TOADD DEF C.NAM     TURN ON STRING ADDRESS
TMP   BSS 1 
OPTYP BSS 1 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.8    DEC 8 
.10   DEC 10
.12   DEC 12
.13   DEC 13
M1    DEC -1
M2    DEC -2
M7    DEC -7
M15   DEC -15 
M16   DEC -16 
M200  DEC -200
M201  DEC -201
M202  DEC -202
B17   OCT 17
B77   OCT 77
B100  OCT 100 
B377  OCT 377 
B600  OCT 600 
B700  OCT 700 
B1000 OCT 1000
HIMSK OCT 177400
TYPE  OCT 37400 
NDVR5 OCT -2400 
EQ4   NOP 
EQ5   NOP 
LU    NOP 
SPC   NOP 
B101  OCT 100001
B100K OCT 100000
PROBT OCT 74000 
PRMPT BSS 1 
MINUS OCT 26400     MINUS CHARACTER 
AMPSD OCT 23000     AMPERSAND 
PERCT OCT 22400     PERCENT CHARACTER 
APOST OCT 23400     APOSTROPHE CHARACTER
      SPC 2 
      END