ASMB,R,L,C
      HED COMPILER LIBRARY OPEN ROUTINE 
      NAM OPN.L,7 92070-1X280 REV. 1940 790514 $CLIB
*REVISED USE OF D.RPx TO .Rx AS IN RTE-LC FOR REV 1901
*ADDED STA C.EXT,I TO LINE 4  FOR REV 1826 (WASNT RESET EXTERN NO)
* 
* 
*************************************************************** 
* (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 :       92070-18280
* 
* 
* 
* 
*  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-L. 
* 
* 
* 
* 
* 
*  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 PROBT     DISC PROTECT BITS 
      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.TTY     FCB USER TERMINAL 
* 
      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 .R1     RETURN PARAMETERS 
      EXT .R2       OF OPEN CREATE ROUTINE 'GEX.C'
      EXT .R3 
      EXT .R4 
      EXT .R5 
      EXT .R6 
      EXT .R7 
      EXT C.INP 
      EXT C.LEN 
      EXT NAMR
      EXT FCB1. 
      EXT FCB2. 
      EXT RW#EC 
      EXT C.SON 
      EXT C.CRD     DEFAULT CARTRIDGE 
      EXT .TTY      TEST FOR INTERACTIVE TERMINAL 
      EXT CLO.C     THE CLOSE ROUTINE 
* 
* 
* 
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
      CLB 
      STB C.EXT,I 
      STB C.BFF,I 
      STB C.WRD,I 
      ISZ C.WRD,I 
      STB C.RSC,I   INITIALIZE  FCB FOR 
      STB C.RC#,I         RESTART 
      STB READF 
      LDA C.FID,I   SEE IF FILE IS ALREADY OPEN 
      AND B10 
      CPA B10 
      JMP RET2      YES, EXIT 
      STB C.LNK,I 
      STB C.??,I
      LDA .1
      STA TMP       INITIALIZE THE NAMR STRING CHARACTER POINTER
      LDA C.FID,I 
      IOR B10       SET OPEN BIT
      ELA,CLE,ERA   CLEAR OUT DEVICE TYPE FLAG
      STA C.FID,I 
      ALF,RAL       GET THE DEFAULT PARAMETER FROM C.FID
      AND B17 
      CPA .1        IS THIS THE SOURCE INPUT FCB? 
      JMP *+2       YES 
      JMP FATHR     NO
      LDB C.NAM 
      STB C.INP     SET UP THE SOURCE FCB NAMR POINTER
      LDB C.SON 
      SSB           ARE WE A SON PROCESS
      JMP SON1      YES 
FATHR INA           SET UP
      CMA             THE 
      STA END           PARSE STOP FLAG 
GETPR JSB NAMR      PARSE TURN ON STRING
      DEF *+5       RETURN ADDRESS
      DEF C.NAM,I   DESTINATION ADDRESS 
      DEF C.TRN     SOURCE ADDRESS
      DEF C.LEN     CHARACTER LENGTH OF SOURCE BUFFER 
      DEF TMP       THE STARTING CHARACTER NUMBER 
      SSA           DONE? 
      JMP DONE      YES 
      ISZ END       REACHED NAMR YET? 
      JMP GETPR     NO
DONE  LDA C.CR,I    IS CRN SUPPLIED FOR THIS FILE?
      SZA,RSS 
      LDA C.CRD     NO, USE SOURCE CRN
      STA C.CR,I
* 
*  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 
*            =  5   IS WRITE BINARY ABSOLUTE FILE (OR LU) 
* 
      LDA C.FID,I   EXTRACT 
      AND .7         FCB OPERATION TYPE 
      STA B 
      STA OPTYP     SAVE FILE OPEN TYPE 
      CPB .2        WRITE SCRATCH 
      JMP WRTSC     YES, CREATE SCRATCH FILE
* 
      LDA C.TYP,I   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 
      CPB .5        WRITE ABSOLUTE? 
      JMP WRITB     YES, CREATE ABSOLUTE FILE 
* 
*  READ SOURCE FILE OPEN
* 
      SZA,RSS       NULL SOURCE NAMR? 
      JMP E202      YES!
* 
OPNA  CCA 
      STA READF     SET UP READ SOURCE FLAG FOR SECURITY CODE CHECK 
* 
* 
* 
*      GEX.C IS CALLED TO OPEN A FILE, ON RETURN FROM GEX.C 
*      THE FOLLOWING PARAMETERS ARE PASSED BACK IN .R1 THRU .R7 
* 
*       .R1 = ERROR CODE, IF >= 0 THEN THE # OF SECTORS IN THE FILE 
*       .R2 = TRACK AND LOGICAL UNIT
*       .R3 = OFFSET AND SECTOR NUMBER
*       .R4 = TRACK NUMBER (LU IF TYPE = 0) 
*       .R5 = NUMBER OF SECTORS IN TRACK AND SECTOR NUMBER
*       .R6 = SECURITY CODE OF THE FILE 
*       .R7 = TYPE OF THE FILE
* 
* 
OPEN  LDA .2        CALL
      LDB C.CR,I      ROUTINE TO
      JSB GEX.C         OPEN A FILE 
      DEF C.NAM,I 
     JMP OPN.C,I   ERROR BUG OUT! 
* 
      LDA .R7     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!
      CPB .5        ABSOLUTE FILE OPEN? 
      JMP BIA       YES!
* 
CKSC  LDA .R6     IS SECURITY 
      SZA,RSS         = ZERO
      JMP RETRN         YES, MATCH ANYTHING ELSE TEST IT
      CPA C.SC,I      CODE OF FILE SAME AS USER SUPPLIED? 
      JMP RETRN     YES, OK!
      ISZ READF     IS THIS A READ ONLY OPERATION?
      JMP E7        NO , ILLEGAL SECURITY CODE! 
      SSA           IS THE FILE READ PROTECTED
      JMP E7        YES, NO CAN READ ON EITHER! 
RETRN LDB .R1     TYPE 0 FILE?
      LDA .R4     A=LU#,B=#SECTRS 
      SZB,RSS 
      JMP OPNL1     YES 
      JSB SETUP     SET UP THE FCB
      LDA C.CR,I
      LDB C.CRD 
      SZB,RSS 
      STA C.CRD     SET UP DEFAULT CARTRIDGE
* 
*  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 
      LDA OPTYP     WHAT KIND ON INITIALIZATION DO
      SZA,RSS         WE NEED ON THE DATA BUFFER
      JMP TYPE0 
      CPA .4        GARRENTEE REWIND? 
      JMP TYPE4     YES TEST FURTHER
TYPEN LDA B100K     INITIALIZE TO FORCE A WRITE 
      JMP *+2 
SONXT CLA 
TYPE0 EQU SONXT 
      STA C.BFF,I   SET THE FCB BUFFER TO FORCE A READ
RET1  CLA,INA 
      STA C.WRD,I   CLEAR WORD PTR
RET1B LDA C.HLK     GET HEAD
      LDB C.FCB     GET ADDRESS OF FILE CONTROL BLK 
      STB C.HLK       AND SET IT IN HEAD POINTER
      STA C.FCB,I   PLACE ADDRESS IN NEW FCB
RET2  CLA           CLEAR ERROR RETURN
      ISZ OPN.C     TAKE P+2 EXIT 
      JMP OPN.C,I 
* 
TYPE4 LDA C.FLU,I   IS THE LU A UNIT RECORD TYPE? 
      SSA 
      JMP TYPEN     YES, INITIALIZE TO WRITE
      JMP TYPE0     NO, INITIALIZE TO READ
* 
BIA   CPA .7        ABSOLUTE FILE?
      JMP CKSC      YES!
      JMP E16       NO, ILLEGAL FILE TYPE 
BIN   CPA .5        BINARY FILE?
      JMP CKSC      YES!
      JMP E16       NO, ILLEGAL FILE TYPE 
* 
LST   CPA .3        SOURCE FILE?
      JMP CKSC1     YES!
      CPA .4        SOURCE FILE?
      JMP CKSC1     YES!
      JMP E16       NO ,ILLEGAL FILE TYPE 
* 
CKSC1 LDA C.SON     AM I A SON PROCESS
      SZA,RSS 
      JMP CKSC      NO
      LDA C.EXT,I   IN EXTENT?
      SZA,RSS 
      JMP CKSC2     NO
      LDA .3
      LDB C.CR,I    CRN 
      JSB GEX.C     OPEN EXTENT 
      DEF .0
      JMP E203      CAN'T OPEN EXTENT 
CKSC2 CCA 
      JSB RW#EC     READ NEXT SECTOR
      JMP E204      READ ERROR
      LDA OPTYP 
       CPA .3       IS THIS THE LIST FILE 
      CLA,CCE,RSS   YES SET THE SIGN BIT
      CLA,INA,RSS   NO SET THE LSB
      ERA 
      STA C.BFF,I   BUFFER FLAG WORD
      JMP RET1B 
* 
E204  LDA M204      READ ERROR
     JMP OPN.C,I
E203  LDA M203      OPEN ERROR
     JMP OPN.C,I
E202  LDA M202      NO SOURCE NAMR
     JMP OPN.C,I
E15   LDA M15       BAD NAMR
     JMP OPN.C,I
* 
*FOLLOWING CODE CHANGED ON 790403 
*REV 1926-ADDED FOR CHECKING FOR LU>63! 
* 
E12  LDA M12
     JMP OPN.C,I    BAD LU (LU>63)! 
* 
*THAT'S IT! 
* 
E16   JSB NCLOS     ILLEGAL TYPE
      LDA M16 
     JMP OPN.C,I
E201  LDA M201      NO BINARY ERROR 
     JMP OPN.C,I
E200  LDA M200      BAD FCB FORMAT ERROR
     JMP OPN.C,I           TAKE P+1 ERROR EXIT
E7    JSB NCLOS     SECURITY CODE ERROR 
      LDA M7
     JMP OPN.C,I
      SPC 3 
NCLOS BSS 1         CLOSE THAT FILE THAT SHOULD NOT BE OPEN 
      LDA C.HLK     U GOT TO LINK IT IN FIRST 
      LDB C.FCB 
      STB C.HLK 
      STB PLACE     FOR CLO.C 
      SZA           IS ANYTHING IN THE LINKED LIST? 
      STA C.FCB,I 
      JSB CLO.C 
PLACE BSS 1 
      NOP           IGNORE ANY OTHER ERRORS 
      JMP NCLOS,I 
      SPC 3 
* 
*  WRITE BINARY (TYPE=5) FILE OR ABSOLUTE (TYPE=7)
* 
WRITB LDA C.TYP,I   IS NAME 
      SZA,RSS         A NULL? 
      JMP E201      YES SET ERROR TO 201 SO NOT TO OUTPUT BINARY
      LDB PERCT     USE % FOR FIRST CHARACTER IF BINARY 
      LDA OPTYP     GET FCB OPERATION TYPE
      CPA .5        WRITE BINARY ABSOLUTE?
      LDB XCLAM     YES, USE ! FOR FIRST CHARACTER
      JSB MINUT     TEST FOR MINUS
      LDA .5        SET FILE TYPE FOR BINARY RELOCATABLE
      LDB OPTYP 
      CPB .5        TEST FOR WRITE BINARY ABSOLUTE
      LDA .7        YES CHANGE FILE TYPE PARAMETER
      JMP CREAT     CREATE FILE OR OPEN IT
* 
* 
* WRITE SOURCE FILE - LIST(CREATE TYPE 4 FILE)
* 
* 
WRITS LDA C.SON 
      CPA M1        C.SON TRUE? 
      RSS           YES 
      JMP WRTS1     NO
      LDA .FCB2 
      JSB GTFCB     MOVE THE FATHER FCB IN
      LDA C.NAM,I   FETCH THE FIRST CHAR OF NAMR
      AND =B77777   MASK OFF THE EXCLUSIVE OPEN BIT 
      STA C.NAM,I   PUT IT BACK 
WRTS1 LDA C.TYP,I   IS NAMR 
      SZA,RSS         A NULL? 
      JMP LU6       YES, SET LU TO DEFAULT
      LDB APOST 
      JSB MINUT     TEST FOR MINUS CHAR IN NAMR 
      LDA C.SON     ARE WE A SON PROCESS? 
      SSA 
      JMP OPEN      YEA SWEETY, GO DO IT
      LDA .4        CREATE A TYPE 4 FILE
      SPC 2 
CREAT LDB C.FTY,I   TEST FOR A BAD FILE TYPE
      SSB 
      JMP E15       IT WAS A NEGATIVE NUMBER AND FMGR DOES NOT LIKE THAT
      JSB CRE.C       AND GO TO TO IT 
      JMP *+2       ERROR, DO SPECIAL CHECK 
      JMP RETRN     WE MADE IT SWEETY 
      CPA M2        DUPLICATE NAME? 
      JMP CKNAM     YES, CHECK IF SAME AS SOURCE NAMR 
      JMP OPN.C,I   NO, GO GIVE THE ERROR TO THE CALLER 
* 
* 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,I   GET 
      AND UCMSK       FIRST CHARACTER 
      CPA TMP       (') LIST, (%) BINARY, (!) ABSOLUTE
      JMP OPEN      YES, OPEN EXISTING FILE 
      JMP E15 NO, GIVE ERROR
* 
*  TEST FOR MINUS SIGN IN NAMR AND SET UP NAMR IF NECESSARY 
* 
MINUT BSS 1 
      STB TMP       SAVE THE POTENTIAL NAMR FIRST CHAR
      LDA C.NAM,I 
      AND UCMSK 
      CPA MINUS     IS THE FIRST CHARACTER A MINUS? 
      JMP *+2       YES 
      JMP MINUT,I   NO
      LDA .1       INITIATE THE NAMR CHAR PNTR
      STA TEMP
      LDA M3
      STA END 
MINUN JSB NAMR
      DEF *+5 
      DEF C.NAM,I 
      DEF C.TRN 
      DEF C.LEN 
      DEF TEMP
      ISZ END 
      JMP MINUN 
      LDA C.NAM,I 
      AND UCMSK 
      CPA AMPSD    IS SOURCE 1ST CHAR AN & ?
      JMP *+2      YES-OK 
      JMP E15      NO GO TELL THEM
      LDA C.NAM,I 
      AND B377
      IOR TMP       PUT PROPER 1ST CHAR IN NAMR 
      STA C.NAM,I 
      LDA C.CRD 
      LDB C.NAM 
      ADB .5
      STA B,I       GETS PROPER CR IN CASE NOT SPECIFIED
      JMP MINUT,I 
* 
* 
* 
* 
*  WRITE SCRATCH FILE (GET TRACK FOR RTE-II,RTE-III, AND RTE-IV)
*                     (OPEN SCRATCH FILES FOR RTE-M & -L) 
* 
WRTSC LDA .4
      JSB GEX.C     GET SCRATCH FILE
      JMP OPN.C,I   ERROR BUG OUT 
      JMP RETRN     SET UP FCB
* 
* 
* 
*  OPEN LOGICAL UNIT DEVICE 
* 
LU6   LDA C.TTY+2   DEFAULT TO MTM TERMINAL 
      JMP OPNL1 
OPNLU LDA C.NAM,I   GET LU FROM 
OPNL1 SSA           IS IT NEGATIVE
      CMA,INA       YES, FLIP IT
      STA LU        SET CONTROL LU
* 
*FOLLOWING CODE CHANGED ON 790403 
*REV 1926-ADDED TO CHECK FOR LU>63! 
* 
      AND B377      MASK TO LU NUMBER.
      STA LU# 
      ADA M64 
      SSA,RSS 
      JMP E12       BAD LU #. 
      LDA LU
* 
*THAT'S IT! 
* 
      IOR  B600     SET V AND K BITS TO ECHO AND PRINT COLUMN ONE ON LP 
      CPB .1        BINARY? 
      JMP WRTBN     YES!
      CPB .5        ABSOLUTE? 
      JMP WRTBN     YES!
      STA C.FLU,I   SET UP THE FCB LU WORD
      CPB .4        INPUT SOURCE-GUARANTEE REWINDABILITY? 
      JMP INSRC 
      SZB,RSS       PLAIN OLD READ SOURCE?
      JMP INSRC     YES, GO SET PAPER TAPE EOT
* 
DTTY2 JSB .TTY       TEST FOR INTERACTIVE LU
      DEF RT1 
      DEF LU
* 
* 
RT1   CPA M1
      JMP  GOOD 
      JMP LULK
* 
* 
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 OPTYP     IS THIS 
      CPA .4            READ OPERATION? 
      JMP OPSCR     YES!
      JMP RET1      NO! 
* 
OPSCR JSB GEX.C       GET SCRATCH FILE - A = 4 I HOPE 
      JMP OPN.C,I   ERROR EXIT
      JSB SETUP     SET UP FCB
      LDA C.HLU,I     AND ALSO
      STA C.SLU,I       SETUP SECONDARY LU
      LDA B100K 
      STA C.BFF,I   SET THE FCB BUFFER TO FORCE A WRITE 
      JMP RET1
* 
LULK  JSB LURQ      LOCK
      DEF *+4 
      DEF B101        THE 
      DEF LU# 
      DEF .1            DEVICE
* 
*FOLLOWING CODE CHANGED ON 790403 
*REV 1926-FOLLOWING 2 STATEMENTS REMOVED SO 
*         LU DE-LOCKING FOLLOWS ORDERLY PROGRESSION.
* 
*     CPA .1        LU ALREADY LOCKED?
*     JMP OPN1      YES!
* 
*THAT'S IT! 
* 
      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 B1000     SET UP TO OUTPUT LEADER 
      JMP CONT
INSRC LDA B700      SET UP FOR END OF PAPER TAPE REQUEST
CONT  IOR LU
      STA LU
      JSB EXEC      OUTPUT CONTROL FUNCTION 
      DEF *+3 
      DEF .3
      DEF LU
      JMP DTTY2 
* 
* 
* 
* 
*  SET UP DATA IN FCB 
* 
SETUP NOP 
      LDB C.BFF 
      CCA 
      INB 
      STA B,I       PUT AN EOF MARK IN THE FCB BUFFER 
      LDA .R1     MAKE SECTORS/FILE INTO BLOCKS/FILE
      RAR 
      STA C.#SC,I     AND STORE INTO FCB
      LDA .R2 
      AND B77       ISOLATE FILE LU AND 
      STA TMP         SAVE IT 
      CMA,INA       SET MINUS LU
      STA C.CR,I
      LDA .R4     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 .R5     EXTRACT 
      AND B377        START SECTOR
      STA C.SSC,I   SET START BLOCK 
      XOR .R5     EXTRACT 
      ALF,ALF         #BLOCKS/TRACK 
      RAR 
      STA C.S/T,I   SET UP NUMBER OF BLOCKS/TRACK IN FCB
      JMP SETUP,I 
* 
* 
* SET UP A SOURCE INPUT FCB FOR A SON PROCESS 
* 
SON1  LDA .FCB1 
      JSB GTFCB     MOVE THE FATHER FCB IN
      CLA 
      STA C.RSC,I 
      STA C.EXT,I 
      LDA C.FID,I   TEST FOR SCRATCH FILE 
      AND .7
      XOR .2
      SZA 
      JMP OPNA      NOT A SCRATCH FILE
      LDA C.HTR,I 
      STA C.STR,I   DO A FILE REWIND OPERATION
      JMP SONXT     GO DO A SON_SCRATCH TYPE EXIT 
* 
* MOVE AN FCB 
*  THE FROM ADDRESS IS ALREADY IN A 
* 
GTFCB BSS 1 
      JMP *+2       CLEAR ANY INDIRECTS 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      LDB C.FID     DESTINATION FCB 
      JSB .MVW      MOVE IT SWEETY
      DEF D26       THATS HOW BIG IT IS 
      NOP           FOR THE MICRO-CODE
      JMP GTFCB,I 
      SPC 3 
* 
*  CONSTANTS AND BUFFERS
* 
.FCB1 DEF FCB1. 
.FCB2 DEF FCB2. 
TMP   BSS 1 
TEMP  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 
.7    DEC 7 
.10   DEC 10
.12   DEC 12
.13   DEC 13
D26   DEC 26
M1    DEC -1
M2    DEC -2
M3    DEC -3
M7    DEC -7
* 
*FOLLOWING CODE CHANGED ON 790403 
*REV 1926-ERROR CODE AND CHECK PARAM. 
*         FOR LU>63 PROBLEM.
* 
M12   DEC -12 
M64   DEC -64 
* 
*THAT'S IT! 
* 
M15   DEC -15 
M16   DEC -16 
M200  DEC -200
M201  DEC -201
M202  DEC -202
M203  DEC -203
M204  DEC -204
B10   OCT 10
B17   OCT 17
B77   OCT 77
B100  OCT 100 
B377  OCT 377 
B600  OCT 600 
B700  OCT 700 
B1000 OCT 1000
UCMSK OCT 77400 
END   NOP 
LU    NOP 
LU#   NOP 
READF NOP 
B101  OCT 100001
B100K OCT 100000
SIGN  EQU B100K 
PRMPT BSS 1 
MINUS OCT 26400     MINUS CHARACTER 
AMPSD OCT 23000     AMPERSAND 
PERCT OCT 22400     PERCENT CHARACTER 
XCLAM OCT 20400     EXCLAMATION CHARACTER 
APOST OCT 23400     APOSTROPHE CHARACTER
      SPC 2 
      END 
                                                                          