Retro1.org codex

          IDENT  LFM,LFM 
          PERIPH
          BASE   MIXED
          SST
 EQV$     EQU    1           DEFINE NO EQUIPMENT CHECK FOR *COMPRSS*
 MSR$     EQU    1           DEFINE ERROR PROCESSING FOR *COMPRNS*
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
*COMMENT  LFM - LOCAL FILE MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  LFM - LOCAL FILE MANAGER.
          SPACE  4,10
***       LFM - LOCAL FILE MANAGER.
*         G. R. MANSFIELD.  70/12/18.
*         M. S. CARTER.      76/06/24.
          SPACE  4,10
***              LFM PERFORMS VARIOUS FILE MANAGING TASKS FOR A JOB.
          SPACE  4,10
***       CALL.
*
*T,       18/ *LFM*, 1/1, 5/ , 12/ CODE, 6/ FP, 18/ FET
*         CODE   FUNCTION CODE
*         FP     FUNCTION PARAMETER -
*                FOR FUNCTION 3, FP = FILE STATUS.
*                FOR STATUS FUNCTION 13, FP=1, IF ADDITIONAL TAPE
*                INFORMATION IS REQUESTED.
*                FOR EQUIPMENT ASSIGMENT FUNCTIONS 14B, 15B AND
*                26B, IF BIT 19 IS SET, NO DAYFILE MESSAGE
*                INDICATING THE EQUIPMENT ASSIGNED IS ISSUED.
*                FOR OPERATOR EQUIPMENT ASSIGNMENT FUNCTION 26B,
*                IF BIT 18 IS SET, OPERATOR TAPE ASSIGNMENT FOR
*                DUPLICATE *VSN* IS REQUIRED.
*                FOR FUNCTION 20B, FP = 0 TO ACCESS LIBRARY FILE,
*                FP = 1 IF *SYSTEM* FILE TO BE ASSIGNED.
*         FET    ADDRESS OF FET
*
*T FET    42/  *FILE NAME*,17/,1/0
*T        12/  EQ,3/,1/E,44/
*         EQ     EQUIPMENT TYPE
*         E      RETURN ERROR CODE
*
*         RETURN.
*
*T FET    42/  *FILE NAME*,8/  EC,9/,1/1
*         EC     ERROR CODE
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         * LFM INCORRECT REQUEST.* = *LFM* WAS CALLED WITHOUT
*         AUTO RECALL OR WITH INCORRECT FUNCTION CODE.
*
*         * COMMAND FILE ERROR.* = AN UNRECOVERABLE MASS STORAGE ERROR
*         OCCURRED ON THE JOBS COMMAND FILE.
*
*         * DUPLICATE FILE NAME.* = FILE ALREADY EXISTS FOR USER JOB.
*
*         * FILE EMPTY.* = FILE EXISTS BUT IS EMPTY.
*
*         * FILE NAME ERROR.* = FILE NAME CONTAINS INCORRECT CHARACTERS
*         OR MORE THAN SEVEN CHARACTERS.
*
*         * FILE NOT FOUND.* = REQUESTED FILE WAS NOT FOUND.
*
*         * INCORRECT EQUIPMENT.* = USER SPECIFIED EQUIPMENT THAT DOES
*         NOT EXIST OR IS NOT ALLOWED.
*
*         * INCORRECT FILE STATUS.* - FILE STATUS IS OUT OF RANGE OF
*         DEFINED VALUES.
*
*         * INCORRECT FILE TYPE.* = FILE WAS NOT CORRECT TYPE FOR
*         FUNCTION.
*
*         * INCORRECT FILE MODE.* = FUNCTION NOT ALLOWED ON
*         EXECUTE-ONLY FILE.
*
*         * USER ACCESS NOT VALID.* = USER ATTEMPTED TO ACCESS
*         SOMETHING WITHOUT REQUIRED VALIDATION.
*
*         * ACCESS LEVEL NOT VALID FOR FILE.* = *LFM* WAS CALLED BY
*         A USER WHO ATTEMPTED TO SET A FILE-S ACCESS LEVEL TO A
*         LEVEL NOT VALID FOR THAT USER, OR FOR THE EQUIPMENT UPON
*         WHICH THAT FILE RESIDED.
*
*         * EQUIPMENT NOT AVAILABLE.* = EQUIPMENT IS IN USE OR DOES
*         NOT EXIST, NO EQUIPMENT WITH THE PROPER ACCESS LEVEL CAN
*         BE FOUND, OR THE MASS STORAGE DEVICE ENCOUNTERED AN I/O
*         ERROR.
*
*         * NO MASS STORAGE AVAILABLE.* = NO TRACKS COULD BE FOUND
*         OF THE CORRECT TYPE.
*
*         * FET TOO SHORT.* = FET IS NOT LONG ENOUGH TO ACCOMPLISH
*         FUNCTION.
*
*         * GETFNT TABLE TOO LARGE.* = TABLE USED BY GETFNT
*         FUNCTION EXTENDS OUTSIDE FIELD LENGTH.
*
*         * ADDRESS OUT OF RANGE.* = SOME PORTION OF THE PARAMETER
*         BLOCK OR FET IS BEYOND THE USERS FIELD LENGTH.
*
*         * PARAMETER BLOCK BUSY.* = COMPLETION BIT IS SET BEFORE
*         PROCESSING OF FUNCTION BEGINS.
*
*         * I/O SEQUENCE ERROR.* = A REQUEST WAS MADE ON A BUSY FILE.
*
*         * MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.* = NO UDT ADDRESS
*         IN FST, OR MAGNET NOT PRESENT.
*
*         * SYSTEM ERROR.* = LFM CANNOT COMPLETE THE REQUESTED LFM
*         FUNCTION BECAUSE THE CALLING PROGRAM HAS A *DMP=* ENTRY
*         POINT.
*
*         * INCORRECT RANDOM ADDRESS.* = THE REQUESTED *LFM*
*         FUNCTION SPECIFIED A CURRENT RANDOM ADDRESS OF ZERO.
*
*         *XX, ASSIGNED TO FILENAM.* = *MSAL* DEVICE TYPE XX ASSIGNED.
*
*         *TTXXX, ASSIGNED TO FILENAM.* = EST ORDINAL XXX WITH TYPE TT
*         WAS ASSIGNED.
          SPACE  4,10
***       ACCOUNT DAYFILE MESSAGES.
*
*
*         *MFFI, FILENAME, LEVELNAME.* = AN INVALID ATTEMPT WAS MADE TO
*         CHANGE THE ACCESS LEVEL ON FILE FILENAME TO LEVEL LEVELNAME.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         * TRACK LIMIT.* = *LFM* IS WAITING FOR MASS STORAGE SPACE.
*
*         *EQXXX, TRACK LIMIT.* = *LFM* IS WAITING FOR MASS STORAGE
*         SPACE ON EST ORDINAL XXX.
*
*         *REQUEST NNNNNNN, EQ* = JOB IS REQUESTING ASSIGNMENT
*         OF EQUIPMENT TYPE *EQ* TO BE ASSIGNED TO FILE *NNNNNNN*.
          SPACE  4,10
**        ROUTINES CALLED.
*
*
*         0BF - BEGIN FILE.
*         0DF - DROP FILE.
          SPACE  4,10
**        NOTE - MONITOR FUNCTION *HNGM* WILL BE ISSUED IF *LFM*
*         DETECTS AN INCORRECT FILE STATUS IN THE FNT WHEN PROCESSING A
*         *FILINFO* REQUEST.
*         THE *FNT* ENTRY.
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMPMAC
          LIST   X
*CALL     COMSLFM
          LIST   *
          SPACE  4
          ORG    PPFW
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSEVT
*CALL     COMSLFD
*CALL     COMSCPS
*CALL     COMSJIO
*CALL     COMSMLS
*CALL     COMSMSP
*CALL     COMSPFM
*CALL     COMSSCD
*CALL     COMSPIM
*CALL     COMSSSD
*CALL     COMSSSE
*CALL     COMSSSJ
*CALL     COMSWEI
*CALL     COMSZOL
          SPACE  4
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 FS       EQU    20 - 24     FST ENTRY (5 LOCATIONS)
 EQ       EQU    25          EST ORDINAL
 AL       EQU    26          ACCESS LEVEL
 FP       EQU    27          FUNCTION PARAMETER
 CN       EQU    30 - 34     CM WORD BUFFER (5 LOCATIONS)
 AB       EQU    CN          FOR USE ON CALL TO *COMPCLD*
 RI       EQU    35 - 36     RANDOM INDEX
 FF       EQU    37          FET SPECIFIED FNT ADDRESS
 FN       EQU    40 - 44     FILE NAME (5 LOCATIONS)
 UN       EQU    FN          USER NAME (5 LOCATIONS)
 FE       EQU    45          FET LENGTH - 1
 LS       EQU    46          LAST FET STATUS
 OC       EQU    47          JOB ORIGIN CODE
 FA       EQU    57          ADDRESS OF FNT ENTRY
 FT       EQU    60 - 64     FNT POINTERS
 
****
          SPACE  4
**        ADDITIONAL DIRECT LOCATION ASSIGNMENTS DEFINED
*         LOCALLY TO OVERLAYS.
*
*         UD  =  60-64  -  OVERLAY 3LB.
*         VS  =  60-64  -  OVERLAY 3LC.
*         SP  =  60-64  -  OVERLAY 3LF.
*         ST  =  65     -  OVERLAY 3LB.
*         CF  =  65     -  OVERLAY 3LE.
*         CB  =  65     -  OVERLAY 3LG.
*         SX  =  66     -  OVERLAY 3LB.
*         WO  =  66     -  OVERLAY 3LE.
*         SB  =  66-67  -  OVERLAY 3LG.
          SPACE  4
**        ASSEMBLY CONSTANTS.
 
 
 DNFS     EQU    200         DEFAULT NUMBER OF FILES - GETFNT FCN.
 CGNT     EQU    10          FET PARAMETER WORD - GETFNT FCN.
          SPACE  4
*         OVERLAY CONTROL.
 
 
 .N       SET    0
 OVLB     MICRO  1,, 3L      BASE OVERLAY NAME
          TITLE  OVERLAY COMMUNICATION MACROS.
 OVERLAY  SPACE  4
**        OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
*         OVERLAY (TEXT)
*         ENTRY  *TEXT* = TEXT OF SUBTITLE.
 
 
          PURGMAC OVERLAY
 
 OVERLAY  MACRO  TEXT
          QUAL
 .N       SET    .N+1
 .M       MICRO  .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
 .O       MICRO  1,3, "OVLB"".M"
          QUAL   ".O"
          TTL    LFM/".O" - TEXT
          TITLE
          IDENT  ".O",OVL    TEXT
*COMMENT  LFM - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          ORG    OVL
          LJM    *
          UJN    *-2
          ENDM
 ENTRY    SPACE  4
**        ENTRY - DEFINE OVERLAY ENTRY POINT.
*
*
*         ENTRY  NAME
*         ENTRY  *NAME* = NAME OF ENTRY ADDRESS.
 
 
          PURGMAC ENTRY
 
 ENTRY    MACRO  NAME
          QUAL
 NAME     EQU    *+1R".M"*10000
          QUAL   ".O"
          ENDM
 CSR      SPACE  4,10
**        CSR - DEFINE 24 BIT QUANTITY FROM 18 BIT EQUATE.
*
*         CSR    R
*
*         *R* = VALUE TO BE EXPANDED TO 24 BITS.
*         IF *R* = 0, 77777777B WILL BE STORED.
 
 CSR      MACRO  R
          LOCAL  N,O,P,Q
          MACREF CSR
 N        SET    R
          IFNE   R,0
 O        SET    R/100B
 P        SET    O*100B
 Q        SET    R-P
          CON    O,Q*100B
          ELSE
          CON    7777B,7777B
          ENDIF
 CSR      ENDM
 TBLM     SPACE  4,10
**        TBLM - GENERATE LIST OF MASS STORAGE DEVICE MNEMONICS.
*
*         TBLM   EQ
*                EQ = DEVICE MNEMONIC.
 
 
 TBLM     MACRO  EQ
          CON    2R_EQ
 TBLM     ENDM
          TITLE  MAIN PROGRAM.
 LFM      SPACE  4
**        LFM - MAIN PROGRAM.
 
 
          ORG    PPFW
 LFM      RJM    PRS         PRESET PROGRAM
 LFM1     LDC    0
 LFMA     EQU    *-1         (OVERLAY NAME)
          ZJN    LFM2        IF NO OVERLAY REQUIRED
          LMC    2L"OVLB"    LOAD OVERLAY
          RJM    EXR
 LFM2     LJM    *           PROCESS REQUEST
 LFMB     EQU    *-1
 
 LFMX     RJM    SNB         SET FILE(S) NOT BUSY
 LFM3     RJM    SFS         SET FILE STATUS
          LDM    DPPB        CHECK FOR *UADM* DATA
          SHN    14
          ADM    DPPB+1
          ZJN    DPP         IF NO DATA
          LDD    MA          ISSUE *UADM* FUNCTION
          CWM    DPPA,ON
          LDN    1
          STD    CM+1
          STD    CM+2
          MONITOR  UADM
 DPP      SPACE  4,10
**        DPP - DROP PP.
 
 
 DPP      MONITOR  DPPM      DROP PPU
          LJM    PPR         RETURN TO PP RESIDENT
 
*         *UADM* PARAMETER WORD.
 
 DPPA     CON    CDCS        DECREMENT CONTROL POINT AREA
*         CON    (CICS)      INCREMENT CONTROL POINT AREA
          CON    ACLW
          CON    0D*100+18D
 DPPB     CON    0,0
          TITLE  RESIDENT SUBROUTINES.
 CKE      SPACE  4,10
**        CKE - CHECK ERROR PROCESSING.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   (EQ) = ERROR CODE.
*
*         USES   CM - CM+4.
*
*         CALLS  CPA, DRF.
 
 
 CKE      SUBR               ENTRY/EXIT
          STD    EQ          SAVE MESSAGE CODE
          ADN    1           SET FET ERROR CODE
          SHN    12
          STM    SFSC
          SHN    -14
          STM    SFSB
          RJM    CPA         READ FIRST
          ADN    1
          CRD    CM
          LDD    CM+1
          SHN    21-8D
          PJN    CKEX        RETURN IF USER NOT PROCESSING ERROR
          LDD    EQ
          LMN    /ERR/LNV
          ZJN    CKEX        IF ACCESS LEVEL NOT VALID FOR FILE
          LMN    /ERR/IOE&/ERR/LNV
          ZJN    CKEX        IF I/O SEQUENCE ERROR
          LMN    /ERR/NMA&/ERR/IOE
          NJN    CKE1        IF NOT TRACK LIMIT
          RJM    DRF         DROP FILE
 CKE1     LJM    LFMX        EXIT
 CLF      SPACE  4,10
**        CLF - CREATE LOCAL FILE.
*
*         ENTRY  (EQ) = EST ORDINAL.
*                (FN - FN+4) = FILE NAME.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
*         EXIT   SEE *EFN*.
*                (FN+4) = *SSST* FILE STATUS CLEARED.
*
*         CALLS  EFN.
*
*         MACROS NFA.
 
 
 CLF      SUBR               ENTRY/EXIT
          RJM    EFN         ENTER FILE
          LDD    FN+4        CHECK FILE STATUS
          LPN    77
          LMN    SSST
          NJN    CLFX        IF NOT SPECIAL SYSTEM FILE
          LCN    SSST        CLEAR SPECIAL SYSTEM FILE STATUS
          RAD    FN+4
          NFA    FA,R
          CWD    FN
          UJN    CLFX        RETURN
 CPA      SPACE  4,10
**        CPA - COMPUTE PARAMETER ADDRESS.
*
*         ENTRY  (IR+3 - IR+4) = RELATIVE PARAMETER ADDRESS.
*
*         EXIT   (A) = ABSOLUTE PARAMETER ADDRESS.
 
 
 CPA      SUBR               ENTRY/EXIT
          LDD    IR+3
          LPN    37
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          UJN    CPAX        RETURN
 DEQ      SPACE  4,10
**        DEQ - DROP EQUIPMENT.
*
*         ENTRY  (EQ) = EST ORDINAL.
*
*         USES   T0, CM - CM+4.
*
*         MACROS MONITOR, SFA.
 
 
 DEQ      SUBR               ENTRY/EXIT
          LDD    EQ          READ EST ENTRY
          LPC    777
          STD    T0          SAVE EST ORDINAL
          ZJN    DEQX        IF NO EQUIPMENT PRESENT
          SFA    EST
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-13
          MJN    DEQX        IF MASS STORAGE
          SHN    13-12
          PJN    DEQ1        IF NOT ALLOCATABLE
          SFA    EST,T0      CHECK EQUIPMENT ASSIGNMENT
          ADK    EQAE
          CRD    CM
          LDD    CM+4
          ZJN    DEQX        IF NOT ASSIGNED
 DEQ1     LDD    T0
          STD    CM+1
          MONITOR DEQM       RELEASE EQUIPMENT
          UJN    DEQX        RETURN
 DRF      SPACE  4,10
**        DRF - DROP FILE.
*
*         ENTRY  (FA) = RELATIVE ADDRESS OF FNT ENTRY IN NFL.
*
*         EXIT   (A) = (FA) = 0.
*
*         ERROR  TO *EER3*.
*
*         CALLS *0DF*.
*
*         MACROS EXECUTE.
 
 
 DRF      SUBR               ENTRY/EXIT
          LDN    1           SET *UNLOAD* FILE FLAG FOR *0DF*
          STM    OVL0
          EXECUTE 0DF,OVL0+1 DROP FILE
          NJN    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
*         STD    FA
          UJN    DRFX        RETURN
 EER      SPACE  4,10
**        EER - EVALUATE MASS STORAGE ERROR RETURN.
*
*         ENTRY  (A) = ERROR RESPONSE FROM DRIVER.
*                (T5) = EST ORDINAL.
*
*         USES   IR+4.
*
*         CALLS  ERR, SNB, *1RJ*.
*
*         MACROS EXECUTE, PAUSE.
 
 
 EER      PSN                ENTRY
          SHN    21-12
          PJN    EER2        IF ERROR RECOVERABLE
 EER1     LDN    /ERR/WEQ
          LJM    ERR         PROCESS ERROR
 
 EER2     LDM    MSD         CHECK CALLER
          SHN    21-13
          PJN    EER1        IF SUBSYSTEM
 EER3     PAUSE
          LDD    CM+1
          NJP    LFMX        IF ERROR FLAG SET
          RJM    SNB
          LDD    T5          SET EST ORDINAL
          STD    IR+4
          EXECUTE  1RJ       RECALL JOB
 EFN      SPACE  4,20
**        EFN - ENTER FILE NAME.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*                (EQ) = EST ORDINAL.
*
*         EXIT   (FA) = ADDRESS OF FNT ENTRY.
*                (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*                TO *RSP* IF WAIT FOR NFL INCREASE TO CREATE
*                FNT ENTRY.
*
*         ERROR  EXIT TO *ERR* IF DUPLICATE FILE NAME OR
*                FILE NAME ERROR.
*                EQUIPMENT RELEASED IF FILE NAME ERROR.
*
*         USES   FA, FS.
*
*         CALLS  COE, DEQ, VFN, *0BF*.
*
*         MACROS EXECUTE.
 
 
 EFN      SUBR               ENTRY/EXIT
          RJM    VFN         VERIFY FILE NAME
          NJN    EFN1        IF NO ERROR
          RJM    DEQ         RELEASE EQUIPMENT
          LDN    /ERR/FLN
          UJN    EFN2        PROCESS ERROR
 
 EFN1     LDD    EQ          SET EQUIPMENT ASSIGNMENT
          STD    FS
          LDD    AL
          SHN    6           PASS FILE ACCESS LEVEL TO *0BF*
          ADN    2           RETURN TO ENTER PP STACK FOR NFL INCREASE
          STM    OVL0
          EXECUTE  0BF,OVL0+1
          UJN    EFN3        CHECK RETURN STATUS
 
*         DUPLICATE FILE FOUND.
 
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LDN    /ERR/DFN    DUPLICATE FILE NAME
 EFN2     UJN    ERR         PROCESS ERROR
 
 EFN3     ZJN    EFNX        IF FNT ENTRY CREATED
          RJM    DEQ         RELEASE EQUIPMENT
          LDC    0
 EFNA     EQU    *-1
          ZJN    EFN4        IF NO OPERATOR ASSIGNED EQUIPMENT TO RESET
          RJM    COE         RESET OPERATOR ASSIGNED EQUIPMENT
 EFN4     LDN    NFIR        REASON CODE = NFL INCREASE PENDING
          LJM    RSP         ENTER PP RECALL STACK
 ABT      SPACE  4,10
**        ABT - ABORT JOB.
*
*         ENTRY  (A) = ADDRESS OF MESSAGE.
*
*         CALLS  DFM.
*
*         MACROS MONITOR.
 
 
 ABT      RJM    DFM         ISSUE DAYFILE MESSAGE
          MONITOR ABTM
          LJM    PPR         RETURN TO PP RESIDENT
 CFL      SPACE  4,10
**        CFL - CHECK FET LENGTH.
*
*         ENTRY  (A) = COMPLEMENT OF (MINIMUM LENGTH - 1).
*                (FE) = FET LENGTH - 1.
*
*         EXIT   TO *ERR*, IF ERROR.
 
 
 CFL      SUBR               ENTRY/EXIT
          ADD    FE
          PJN    CFLX        IF FET LENGTH SUFFICIENT
          LDN    /ERR/FTS    * FET TOO SHORT.*
*         LJM    ERR         ABORT
 ERR      SPACE  4,10
**        ERR - PROCESS ERROR.
*
*         ENTRY  (A) = ERROR CODE.
 
 
 ERR      STD    T0
          LMN    /ERR/IOE
          NJN    ERR1        IF NOT I/O SEQUENCE ERROR
          STD    FA          CLEAR FNT ADDRESS
 
 ERR1     LDD    T0
          RJM    CKE         CHECK ERROR PROCESSING
          LDC    ERP         SET ERROR PROCESSOR ADDRESS
          STM    LFMB
          SHN    -14         SET OVERLAY NAME
          STM    LFMA
          LJM    LFM1        PROCESS ERROR
 RCL      SPACE  4,15
**        RCL - RECALL *LFM*.
*
*         ENTRY  (A) = MESSAGE CODE.
*                (T7) = MESSAGE ADDRESS.
*
*         EXIT   TO *DPP* TO DROP PP.
*                TO *RSP* TO ENTER PP RECALL STACK.
*
*         USES   FS+4, CM - CM+4, CN - CN+4.
*
*         CALLS  CKE, DRF, SPB.
*
*         MACROS MONITOR, NFA.
 
 
 RCL      RJM    CKE         CHECK ERROR PROCESSING
          LDD    T7          SET MESSAGE ADDRESS
          ZJN    RCL2        IF NO MESSAGE
          STM    RCLA
          LDD    EQ
          LMN    /ERR/NMA
          ZJN    RCL1        IF TRACK LIMIT
          LDN    1
          RJM    SPB         SET PAUSE BIT
 RCL1     LDD    CP          STORE CONSOLE MESSAGE
          ADN    MS2W
          CWM    *,TR
 RCLA     EQU    *-1
 RCL2     AOD    FS+4        SET FILE STATUS NOT BUSY
          LDD    FA
          ZJN    RCL3        IF NO FNT ENTRY
          NFA    FA,R
          ADN    FSTL
          CWD    FS          STORE FST ENTRY
 RCL3     LDD    CP          CHECK FOR ERROR FLAGS
          ADN    STSW
          CRD    CM
          ADN    SNSW-STSW
          CRD    CN
          LDD    CN+3
          LPN    10
          ADD    CM+1
          ZJN    RCL4        IF NO ERROR FLAGS SET OR NO SUBSYSTEM IDLE
          LJM    DPP         DROP PP AND EXIT TO PP RESIDENT
 
 RCL4     LDD    EQ
          LMN    /ERR/NMA
          NJN    RCL5        IF NOT TRACK LIMIT
          RJM    DRF         CLEAR FNT ENTRY
          LDN    ZERL        SET TRACK LIMIT EVENT
          CRD    CM
          LDN    TKLE
          STD    CM+4
          MONITOR  EATM
          LDN    TRLR        SET TRACK LIMIT REASON CODE
          UJN    RSP         ENTER PP RECALL STACK
 
 RCL5     LDN    WEAR        SET WAIT EQUIPMENT ASSIGNMENT REASON CODE
*         UJN    RSP         ENTER PP RECALL STACK
 RSP      SPACE  4,10
**        RSP - RECALL STACK ENTRY PROCESSOR.
*
*         ENTRY  (A) = RECALL STACK REASON CODE.
*                (IR - IR+4) = PP CALL.
*
*         EXIT   TO *PPR*.
*
*         USES   CM - CM+5.
*
*         MACROS MONITOR.
 
 
 RSP      BSS    0           ENTRY
          STD    CM
          LDN    ZERL
          CRD    CM+1
          LDD    MA          WRITE PP CALL
          CWD    IR
          ADN    1           WRITE PARAMETER WORD
          CWD    CM
          MONITOR  RECM      ENTER DEFAULT TIMED RECALL
          LJM    PPR         EXIT TO PP RESIDENT
 SFS      SPACE  4,15
**        SFS - SET FILE STATUS.
*
*         ENTRY  (LS) = LAST FET STATUS.
*                (FN - FN+3) = FILE NAME FOR FET.
*                (IR+3 - IR+4) = FET ADDRESS.
*                (SFSB) = FET ERROR CODE (IF PERTINENT), SET BY *CKE*.
*                (SFSA) = RETURN FILE FUNCTION FLAG, SET BY *PRS*.
*                (SFSC) = FET ERROR CODE (IF PERTINENT), SET BY *CKE*.
*
*         EXIT   FET STATUS MADE *NOT BUSY* AND ERROR CODE FIELD SET.
*
*         USES   LS, FN+3, FN+4.
*
*         CALLS  CPA.
 
 
 SFS      SUBR               ENTRY/EXIT
          AOD    LS          MAKE FET NOT BUSY
          STD    FN+4
 SFSA     LDN    0
*         LDN    1           (RETURN FILE INFORMATION)
          NJN    SFS1        IF RETURN FILE INFORMATION
          LDD    FN+3        SET FET ERROR CODE FIELD
          SCN    77
          LMC    0           LEFT 6 BITS OF 8 BIT ERROR CODE FIELD
 SFSB     EQU    *-1
          STD    FN+3
          LDC    0
 SFSC     EQU    *-1
          RAD    FN+4
 SFS1     RJM    CPA         REWRITE FET+0
          CWD    FN
          UJN    SFSX        RETURN
 SIF      SPACE  4,15
**        SIF - SEARCH FOR AND INTERLOCK FILE.
*
*         ENTRY  (A) = INITIAL FNT ADDRESS FOR SEARCH.
*                (A) = 0, IF NO INITIAL FNT ADDRESS.
*                (FN - FN+4) = FILE NAME.
*
*         EXIT   FNT/FST FOR FILE SET BUSY, ELSE TO *ERR*.
*                (FA) = FNT ADDRESS IN NFL.
*                (CM - CM+4) = FNT WORD.
*                (FS - FS+4) = FST WORD.
*
*         CALLS   SAF, SFB.
 
 
 SIF      SUBR               ENTRY/EXIT
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    SIF1        IF FILE NOT FOUND
          RJM    SFB         SET FILE BUSY
          ZJN    SIFX        IF FILE SET BUSY
          LDN    /ERR/IOE&/ERR/FNF *I/O SEQUENCE ERROR*
 SIF1     LMN    /ERR/FNF    *FILE NOT FOUND*
          LJM    ERR         PROCESS ERROR
 SNB      SPACE  4,15
**        SNB - SET FILE(S) NOT BUSY.
*
*         ENTRY  (FA) = FNT ADDRESS OF BUSY FILE.
*                (FS - FS+4) = FST ENTRY OF FILE.
*                (SNBA) = FNT ADDRESS OF SECOND FILE.
*                       = 0 IF NO SECOND FILE.
*
*         EXIT   (A) = (FA) = (SNBA) = 0.
*
*         USES   FA, FS - FS+4.
*
*         MACROS NFA.
 
 
 SNB      SUBR               ENTRY/EXIT
          LDD    FA
          ZJN    SNB1        IF ONE FILE NOT BUSY
          AOD    FS+4
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL
          CWD    FS
 SNB1     LDC    0           POSSIBLE SECOND FILE FNT ADDRESS
 SNBA     EQU    *-1
          STD    FA
          ZJN    SNBX        IF NO SECOND FILE
          NFA    FA,R
          ADK    FSTL
          CRD    FS
          AOD    FS+4        SET FILE NOT BUSY
          NFA    FA,R
          ADK    FSTL        STORE FST INFORMATION
          CWD    FS
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          STM    SNBA
          UJP    SNBX        RETURN
 SPB      SPACE  4,10
**        SPB - SET/CLEAR PAUSE BIT.
*
*         ENTRY  (A) = 0 CLEAR PAUSE BIT.
*                (A) = 1 SET PAUSE BIT.
*
*         EXIT   (A) = ADDRESS OF *SNSW* IN CP AREA.
*                (CM - CM+4) = *SNSW*.
*
*         USES   T1, CM - CM+4.
 
 
 SPB      SUBR               ENTRY/EXIT
          STD    T1          SAVE PAUSE OPTION
          LDD    CP          READ SWITCH WORD
          ADN    SNSW
          CRD    CM
          LDD    CM+3        SET/CLEAR PAUSE BIT
          SCN    1
          LMD    T1
          STD    CM+3
          LDD    CP          UPDATE SWITCH WORD
          ADN    SNSW
          CWD    CM
          UJN    SPBX        RETURN
 SVF      SPACE  4,15
**        SVF - SEARCH FOR VSN ENTRY FILE.
*
*         ENTRY  (FN - FN+4) = FILE NAME
*
*         EXIT   (A) = 0 NO FILE FOUND OR VSN ENTRY FILE FOUND
*                (FA) = FNT ADDRESS.
*                (FS - FS+4) = FNT ENTRY.
*
*         USES   CM - CM+4.
*
*         CALLS  SAF.
*
*         MACROS NFA, SFA.
 
 
 SVF      SUBR               ENTRY/EXIT
          LDN    0           SET NO INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    SVFX        IF NO FILE
          NFA    FA,R        READ FST
          ADN    FSTL
          CRD    CM
          LDD    CM          CHECK EQUIPTMENT
          SFA    EST
          ADK    EQDE
          CRD    CM          READ EST ENTRY
          LDD    CM+3
          LMC    2RTE
          UJN    SVFX        RETURN
 UPP      SPACE  4,10
**        UPP - UPDATE PRIMARY FILE POINTERS.
*
*         ENTRY  (FA) = PRIMARY FILE FNT ADDRESS/OFFSET.
*                (FS - FS+4) = PRIMARY FILE FST ENTRY.
*
*         USES   CM - CM+4.
*
*         MACROS SFA, MONITOR.
 
 
 UPP      SUBR               ENTRY/EXIT
 
*         UPDATE WORD *TFSW* OF THE CONTROL POINT AREA.
 
          LDD    CP
          ADK    TFSW
          CRD    CM
          LDD    FA
          STD    CM+1
          LDD    CP
          ADK    TFSW
          CWD    CM
 
*         UPDATE EJT ENTRY.
 
          LDD    FS          STORE EQUIPMENT IN *UTEM* PARAMETER BLOCK
          STM    UPPA+3
          LDD    FS+1        STORE TRACK IN *UTEM* PARAMETER BLOCK
          STM    UPPA+4
          LDD    MA
          CWM    UPPA,ON
          SFA    EJT,CM      SET EJT ENTRY ADDRESS FOR *UTEM*
          STD    CM+4
          SHN    -14
          STD    CM+3
          LDN    1           SET NUMBER OF PARAMETERS FOR *UTEM*
          STD    CM+1
          MONITOR UTEM       UPDATE EJT ENTRY
          UJN    UPPX        RETURN
 
 
 UPPA     VFD    1/0,5/PRFE,6/24D  *UTEM* PARAMETER BLOCK
          VFD    6/0,6/0
          CON    0,0,0
          SPACE  4,10
**        COMMON DECKS.
 
 
          QUAL   COMPACS
*CALL     COMPACS
          QUAL   *
 EJT$     EQU    0           DEFINE *COMPGFP* ACCESS TO EJT
 QFT$     EQU    0           DEFINE *COMPGFP* ACCESS TO QFT
 IFP$     EQU    0           GENERATE *IFP* REMOTE CODE
*CALL     COMPGFP
 SAF$     EQU    0           SET INITIAL FNT ADDRESS PROVIDED
*CALL     COMPSAF
*CALL     COMPSEI
*CALL     COMPSFB
*CALL     COMPSRA
*CALL     COMPVFN
          USE    OVERLAY
 OVL      EQU    *+10
          TITLE  SUBROUTINES WHICH MAY BE OVERLAID.
 PRS      SPACE  4,20
**        PRS - PRESET PROGRAM.
*
*         ENTRY  (IR - IR+4) = INPUT REGISTER.
*
*         EXIT   (AL) = 0.
*                (EQ) = 0.
*                (FA) = 0.
*                (FE) = FET LENGTH - 1.
*                (FF) = FET SPECIFIED FNT ADDRESS.
*                (FP) = *LFM* FUNCTION CODE.
*                (LS) = LAST FET STATUS.
*                (OC) = ORIGIN CODE.
*                (IR+3 - IR+4) = FET ADDRESS.
*                (FN - FN+3) = FILE NAME.
*
*         ERROR  TO *ABT* IF INCORRECT REQUEST OR INCORRECT ADDRESS.
*
*         CALLS  CPA, CRS, IFP.
*
*         MACROS SFA.
 
 
 PRS      SUBR               ENTRY/EXIT
          RJM    CRS         CHECK RECALL STATUS
          NJN    PRS1        IF CALLED WITH AUTO RECALL
          LJM    PRS6        ISSUE ERROR
 
 PRS1     LDD    IR+3        SAVE FUNCTION PARAMETER
          SHN    -6
          STD    FP
          RJM    IFP         INITIALIZE EJT ACCESS
 
*         CHECK FOR RETURN FILE INFORMATION FUNCTION.
 
          LDD    IR+2        CHECK FUNCTION CODE
          SBN    32
          NJN    PRS2        IF NOT RETURN FILE INFORMATION
          AOM    SFSA
          RJM    CPA         READ PARAMETER BLOCK LENGTH
          CRD    CM
          LDD    CM+3
          LPN    77
          ZJN    PRS3        IF NO LENGTH
          SBN    1
          UJN    PRS3        SAVE LENGTH
 
*         CHECK IF FET IS CONTAINED IN FIELD LENGTH.
 
 PRS2     RJM    CPA         READ FET LENGTH
          ADN    1
          CRD    CM
          LDD    CM+3
          SHN    -6
          ADN    5-1
 PRS3     STD    FE          SAVE FET LENGTH - 1
          LDD    IR+3
          LPN    77
          SHN    14
          MJN    PRS4        IF OUT OF RANGE
          LMD    IR+4
          ADD    FE
          SHN    -6
          SBD    FL
          MJN    PRS5        IF FET CONTAINED IN FL
 PRS4     LDC    AORM        * ADDRESS OUT OF RANGE.*
          LJM    ABT         ABORT
 
*         CHECK FUNCTION CODE.
 
 PRS5     LDD    IR+2        CHECK FUNCTION CODE
          SHN    1
          STD    T7
          ADC    -TFCNL
          MJN    PRS7        IF LEGAL CODE
 PRS6     LDC    ILRM        * LFM INCORRECT REQUEST.*
          LJM    ABT         ABORT
 
 PRS7     LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      GET JOB ORIGIN TYPE FROM EJT ENTRY
          ADN    SCLE
          CRD    CM
          LDD    CM          SET JOB ORIGIN TYPE
          LPN    17
          STD    OC
          LDM    TFCN+1,T7   SET PROCESSOR ADDRESS
          STM    LFMB
          ZJN    PRS6        IF NOT DEFINED
 
*         SET OVERLAY NAME.
 
          LDM    TFCN,T7
          LPN    77
          STM    LFMA
          RJM    CPA
          ADN    4
          CRD    CM
          LDD    CM
          STD    FF
          RJM    CPA         READ FILE NAME
          CRD    FN
          LDD    FN+4        SAVE LAST FET STATUS
          LPC    1776
          STD    LS
          STD    FN+4
          LDD    FN+3        CLEAR ERROR CODES
          SCN    77
          STD    FN+3
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          STD    EQ          CLEAR EST ORDINAL
          STD    AL          CLEAR ACCESS LEVEL
          LJM    PRSX        RETURN
 
 AORM     DATA   C* ADDRESS OUT OF RANGE.*
 
 ILRM     DATA   C* LFM INCORRECT REQUEST.*
 CRX      SPACE  4,10
**        CRX - CHECK RESEX CALL.
*
*         EXIT   RETURNS IF NOT CALLED.
*                ABORTS IF RESEX DETECTED ERRORS.
*                TERMINATES LFM IF CALL COMPLETED NORMALLY.
*
*         USES   T1, CM - CM+4, CN - CN+4.
 
 
 CRX      SUBR               ENTRY/EXIT
          LDD    CP          READ SPCW
          ADC    SPCW
          CRD    CM
          LDD    CM+2        CHECK RETURN STATUS
          ZJN    CRXX        IF RESEX NOT CALLED
          SCN    1
          STD    T1
          LDN    ZERL
          CRD    CN
          LDD    CP
          ADC    SPCW
          CWD    CN          CLEAR SPCW
          LDD    T1
          NJN    CRX1        IF ERRORS FROM RESEX
          LJM    LFMX        EXIT
 
 CRX1     LDN    /ERR/RDE    * RESEX DETECTED ERRORS.*
          LJM    ERR         PROCESS ERROR
 FCN      SPACE  4,10
**        FCN - DEFINE FUNCTION PROCESSOR.
*
*
*         FCN    NAME,ORD
*
*         ENTRY  *NAME* = NAME OF FUNCTION PROCESSOR.
*                *ORD* = REQUIRED FUNCTION ORDINAL, IF ORDINAL MUST
*                        REMAIN A PARTICULAR VALUE.  AN ASSEMBLY ERROR
*                        WILL OCCUR IF THE ORDINAL ASSEMBLED DOES NOT
*                        AGREE WITH THE SPECIFIED *ORD* VALUE.
 
 
          NOREF  .I
 .I       SET    0
 FCN      MACRO  A,B
          LOC    .I/2
          IFNE   B,0
          ERRNZ  .I/2-B      ASSEMBLED ORDINAL NOT AS SPECIFIED
          ENDIF
          CON    A/10000,A-A/10000*10000
 .I       SET    .I+2
          ENDM
 TFCN     SPACE  4,10
**        TFCN - TABLE OF FUNCTION CODE PROCESSORS.
*
*         2 BYTES PER ENTRY.
*
*T,       12/  OV,12/  ADDR
*         OV     OVERLAY NAME
*         ADDR   ADDRESS OF FUNCTION PROCESSOR
 
 
 TFCN     BSS    0
 
          FCN    RNI         RENAME INITIALIZATION
          FCN    0           (UNUSED)
          FCN    0           (UNUSED)
          FCN    STS         SET FILE STATUS
          FCN    0           (UNUSED)
          FCN    0           (UNUSED)
          FCN    0           (UNUSED)
          FCN    FSL         SET FILE ACCESS LEVEL
          FCN    LCK         LOCK FILE
          FCN    ULK         UNLOCK FILE
          FCN    RLS         RETURN LAST STATUS
          FCN    RCP         RETURN CURRENT POSITION
          FCN    RQI         REQUEST EQUIPMENT
          FCN    AEQ         ASSIGN EQUIPMENT
          FCN    0           (UNUSED)
          FCN    0           (UNUSED)
          FCN    ALF         ACCESS LIBRARY FILE
          FCN    ACS         ATTACH  COMMAND FILE
          FCN    ECS         ENTER  COMMAND FILE
          FCN    PCS         POSITION  COMMAND FILE
          FCN    LBI         LABEL REQUEST
          FCN    GTF         GET FNT/FST ENTRY
          FCN    OAE         REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT
          FCN    VSN         ENTER VSN ENTRY FILE
          FCN    0           (UNUSED)
          FCN    PRI         MAKE FILE PRIMARY
          FCN    RFI         RETURN FILE INFORMATION
          FCN    SLF         SET LAST FILE EXECUTED
          FCN    0           (UNUSED)
          FCN    0,35        (RESERVED FOR INSTALLATIONS - MUST BE 35B)
          FCN    0,36        (RESERVED FOR INSTALLATIONS - MUST BE 36B)
          FCN    0,37        (RESERVED FOR INSTALLATIONS - MUST BE 37B)
 
          LOC    *O
 TFCNL    EQU    *-TFCN
          TITLE  RESIDENT PROCESSORS.
 ALF      SPACE  4,25
***       FUNCTION 20.
*         ACCESS LIBRARY FILE.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
*                (FN - FN+3) = FILE NAME FROM FET+0.
*                (FP) = FUNCTION PARAMETER.
*                       0 = ACCESS LIBRARY FILE.
*                       1 = ASSIGN *SYSTEM* FILE.
*
*         EXIT   FOR SUBFUNCTION 0 (ACCESS LIBRARY FILE), THE
*                FOLLOWING INFORMATION IS RETURNED.
*                RANDOM ADDRESS OF DIRECTORY STORED IN (FET+6).
*                ADDRESS BIAS FOR DIRECTORY STORED IN (FET+7).
*                SIGN BIT IN (FET+7) SET IF PROCEDURE FILE.
*                IF FILE IS ACCESSED FROM *CLD*, A LOCAL FNT ENTRY IS
*                CREATED, ASSIGNED TO THE CONTROL POINT AND POSITIONED
*                AT THE FILE.
*
*                FOR SUBFUNCTION 1 (ASSIGN *SYSTEM* FILE), A LOCAL
*                FILE WITH *LIFT* FILE TYPE WILL BE CREATED TO
*                ACCESS THE *SYSTEM* FILE IF THE JOB IS SYSTEM
*                ORIGIN OR IF THE USER IS ALLOWED TO ACCESS
*                THE SYSTEM FILE.
 
 
 ALF      LDD    FP
          ZJN    ALF4        IF ACCESS LIBRARY FILE FUNCTION
 
*         ASSIGN *SYSTEM* FILE.
 
          LDD    FF          SET INITIAL LOCAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    ALF3        IF LOCAL FILE PRESENT
 ALF1     LDD    OC          CHECK JOB ORIGIN
          LMK    SYOT
          ZJN    ALF2        IF SYSTEM ORIGIN JOB
          LDD    CP          CHECK USER ACCESS
          ADK    AACW
          CRD    CM
          LDD    CM+4
          SHN    21-5
          MJN    ALF2        IF LEGAL TO ACCESS SYSTEM FILE
          LDN    /ERR/IUA    * USER ACCESS NOT VALID.*
          UJN    ALF5        PROCESS ERROR
 
 ALF2     RJM    SSA         SET SYSTEM FILE FNT ADDRESS
          ERRNZ  FNTG        CHECK IF NOT WORD 0 OF SYSTEM FNT ENTRY
          CRD    CN          READ SYSTEM FILE FNT WORD
          RJM    CPF         COMPARE FILE NAMES
          ZJN    ALF3        IF FILE NAMES MATCH
          LDN    /ERR/FNF    * FILE NOT FOUND.*
          UJN    ALF5        PROCESS ERROR
 
 ALF3     RJM    SSA         READ SYSTEM FILE FST WORD
          ADN    FSTG
          CRD    CN
          LJM    ALF16       CONTINUE PROCESSING
 
*         ACCESS LIBRARY FILE.
 
 ALF4     LDN    ZERL        CLEAR FET+7
          CRD    CM
          LDD    FE
          SBN    7
          PJN    ALF6        IF FET LONG ENOUGH
          LDN    /ERR/FTS    * FET TOO SHORT.*
 ALF5     LJM    ERR         PROCESS ERROR
 
 ALF6     RJM    CPA
          ADN    7
          CWD    CM
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
 
*         SEARCH USER LIBRARY DIRECTORY (LBD).
 
          LDD    FE
          SBN    10
          MJN    ALF6.5      IF FET LENGTH LESS THAN 9 WORDS
          RJM    CPA         GET FILE NAME FROM FET+8
          ADN    10
          CRD    FN
          LDD    FN
          NJN    ALF6.5      IF FILE NAME IS NON-ZERO
          RJM    CPA         RESTORE FILE NAME FROM FET+0
          CRD    FN
 ALF6.5   LDK    LBDP        GET LBD POINTER
          CRD    T1
          LDD    T3          MOVE POINTER
          STD    T1
          LDD    T3+1
          STD    T1+1
 ALF7     LDD    T1          READ DIRECTORY ENTRY
          SHN    14
          ADD    T1+1
          CRD    CN
          LDN    2           ADVANCE POINTER
          RAD    T1+1        ADVANCE DIRECTORY INDEX
          SHN    -14
          RAD    T1
          LDD    CN
          ZJN    ALF8        IF END OF DIRECTORY
          RJM    CPF         COMPARE FILE NAMES
          NJN    ALF7        IF NO MATCH
          AOM    ALFB        FLAG LBD PROCESSING
          LJM    AFL13       PROCESS MATCH
 
*         SEARCH ENTRY POINT DIRECTORY (EPD).
 
 ALF8     LDD    MA          SET ENTRY POINT NAME
          CWD    FN
          CRD    AB
          LDD    AB+3
          SCN    77
          STD    AB+3
          LDN    0
          STD    AB+4
          RJM    CLD         SEARCH CENTRAL LIBRARY DIRECTORY
          NJN    ALF9        IF ENTRY FOUND
          LDD    FA
          NJN    AFL12       IF FILE ALREADY LOCAL
          LJM    ALF1        ASSIGN *SYSTEM* FILE
 
 
*         PROCESS CLD ENTRY POINT.
 
 ALF9     CRD    CN          READ PST ENTRY
          SBN    1           READ SYSTEM FILE LOCATION
          CRM    CRFA,ON
          LDD    CN+1
          LPN    37
          LMN    3           RELOCATABLE TYPE RECORD
          NJN    ALF10       IF NOT RELOCATABLE
          RJM    CRF         CREATE RELOCATABLE FNT FOR CLD
          LJM    ALF18       RETURN
 
 ALF10    LMN    20&3        CHECK FOR *PROC*
          ZJN    ALF11       IF *PROC* RECORD
          LMN    0&20        *TEXT* RECORD
          NJN    AFL12       IF NOT A *TEXT* RECORD
 ALF11    LDN    1           FLAG *PROC* AND *TEXT* FILE PROCESSING
          RJM    CFN         CREATE FNT ENTRY
          ZJN    ALF14       IF SAME ENTRY
 AFL12    LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LDN    /ERR/DFN    * DUPLICATE FILE NAME.*
          LJM    ERR         PROCESS ERROR
 
*         BEGIN LBD PROCESSING.
 
 AFL13    LDN    0           FLAG *ULIB* PROCESSING
          RJM    CFN         CREATE FNT ENTRY
          NJN    AFL12       IF ERROR
 ALF14    LDD    T1          READ CONTROL WORD
          SHN    14
          ADD    T1+1
 ALFB     SBN    0           EPD MATCH FOUND
*         SBN    1           (LBD MATCH FOUND)
          CRD    CM
          CRD    T3
          LDN    0
          STD    CM
          STD    T3
          LDD    CM+3
          SHN    6
          MJN    AFL12       IF NOT RANDOM ADDRESS
          LDC    *           SET *ULIB*/*PROC* BIT
*         LDC    0           (ULIB PROCESSING)
*         LDC    1           (PROC AND TEXT PROCESSING)
 ALFA     EQU    *-1
          STD    CM
          SOD    CM+4
          PJN    ALF15       IF NO UNDERFLOW
          AOD    CM+4
          SOD    CM+3
 ALF15    RJM    CPA         STORE FET + 6
          ADN    6
          CWD    T3
          ADN    1           STORE (FET+7)
          CWD    CM
 ALF16    LDD    FA
          ZJN    ALF17       IF FILE NOT ASSIGNED
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LJM    LFMX        EXIT
 
 ALF17    LDN    NEEQ        SET NULL EQUIPMENT
          STD    EQ
          RJM    CPA         RESTORE FILE NAME FROM FET+0
          CRD    FN
          RJM    EFN         ENTER FILE NAME
          LDD    CN          SET FST ENTRY
          STD    FS
          LDD    CN+1
          STD    FS+1
          STD    FS+2
          LDN    FSMS
          STD    FS+3
 ALF18    LDD    TH
          ERRNZ  1000-LIFT*100  ADJUST IF VALUE CHANGES
          STD    FN+4
          LDD    FN+3        SET LOCK
          SCN    77
          LMN    1
          STD    FN+3
          NFA    FA,R        STORE FNT WORD
          CWD    FN
          LJM    LFMX        EXIT
 CFN      SPACE  4,15
***       CFN - CREATE FNT ENTRY.
*
*         ENTRY  (A) = 0, IF NOT A PROC OR TEXT FILE.
*                (A) = 1, IF IS A PROC OR TEXT FILE.
*
*         EXIT   (A) = 0, IF SAME FILE.
*                (A) .NE. 0, IF NOT SAME FILE.
*
*         USES   CM - CM+4, CN - CN+4, FS - FS+4.
*
*         CALLS  SSA.
*
*         MACROS NFA, SFA.
 
 
 CFN      SUBR               ENTRY/EXIT
          SHN    13
          STM    ALFA
          RJM    SSA         SET SYSTEM FILE FNT ADDRESS
          ADN    FSTG
          CRD    CN
          LDD    FA
          ZJN    CFNX        IF NO ASSIGNED FILE
          NFA    FA,R        READ FST WORD
          ADN    FSTL
          CRD    FS
          SFA    EST,FS
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    -12
          LMN    3
          NJN    CFNX        IF NOT A SYSTEM DEVICE
          LDD    CN+1
          LMD    FS+1
          UJN    CFNX        RETURN
 
 RNI      SPACE  4,10
**        RNI - RENAME INITIALIZATION.
 
 
 RNI      RJM    CRX         CHECK RESEX CALL
          LDC    RNM         SET ENTRY
          UJN    RQI3        SET OVERLAY REQUEST
 RQI      SPACE  4,10
**        RQI - EQUIPMENT REQUEST INITIALIZATION.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
*                (FN - FN+3) = FILE NAME FROM FET+0.
 
 
 RQI      LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    RQI2        IF FILE NOT FOUND
 RQI1     LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LJM    LFMX        EXIT
 
 RQI2     LDC    REQ         SET ENTRY
 RQI3     STM    LFMB
          SHN    -14         SET OVERLAY NAME
          STM    LFMA
          LJM    LFM1        PROCESS REQUEST
 LBI      SPACE  4,10
**        LBI - LABEL REQUEST INITIALIZATION.
 
 
 LBI      RJM    CRX         CHECK RESEX CALL
          RJM    SVF         SEARCH FOR VSN FILE
          NJN    RQI1        IF NON-VSN FILE FOUND
          LDC    LBR         SET ENTRY
          UJN    RQI3        SET OVERLAY REQUEST
          TITLE  RESIDENT PROCESSOR SUBROUTINES.
 CPF      SPACE  4,10
**        CPF - COMPARE FILE NAMES.
*
*         ENTRY  (CN - CN+3) = FIRST FILE NAME.
*                (FN - FN+3) = SECOND FILE NAME.
*
*         EXIT   (A) = 0 IF FILE NAMES MATCH.
 
 
 CPF      SUBR               ENTRY/EXIT
          LDD    CN          COMPARE FILE NAMES
          LMD    FN
          NJN    CPFX        IF NO MATCH
          LDD    CN+1
          LMD    FN+1
          NJN    CPFX        IF NO MATCH
          LDD    CN+2
          LMD    FN+2
          NJN    CPFX        IF NO MATCH
          LDD    CN+3
          LMD    FN+3
          SCN    77
          UJN    CPFX        RETURN
 CRF      SPACE  4,20
**        CRF - CREATE RELOCATABLE ROUTINE FNT.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*                (CN - CN+4) = DIRECTORY ENTRY.
*                (T1 - T1+1) = POINTER TO ENTRY IN PST.
*
*         EXIT   (FA) = FILE FNT ADDRESS.
*                (FS - FS+4) = FST INFORMATION.
*
*         USES   EQ, FS - FS+3, CM - CM+4, CN - CN+4.
*
*         CALLS  EFN, SSA.
*
*         MACROS SFA.
*
*         NOTE - *CRF* WILL POSITION THE FST TO THE LOCATION
*                OF THE RELOCATABLE PROGRAM ON THE SYSTEM
*                DEVICE OR THE *ASR* DEVICE.
 
 
 CRF      SUBR               ENTRY/EXIT
          LDD    T1          READ PST CONTROL WORD
          SHN    14
          ADD    T1+1
          CRD    CN
          LDN    NEEQ        SET EST ORDINAL
          STD    EQ
          RJM    EFN         ENTER FILE NAME
 
*         SET FST INFORMATION.
 
          LDD    CN+2        SET EST ORDINAL
          LPC    777
          STD    FS
          LDD    CN+1        CHECK FOR ASR RESIDENT PROGRAM
          SHN    21-13
          PJN    CRF1        IF NOT *ASR* DEVICE
          SFA    EST,FS      CHECK FOR DEVICE *ON*
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-1
          MJN    CRF2        IF DEVICE OFF
          LDD    CN+3        SET FIRST = CURRENT
          STD    FS+1
          STD    FS+2
          LDD    CN+4
          STD    FS+3
          UJN    CRFX        RETURN
 
 CRF1     LDD    CN+3        GET TRACK
          STM    CRFA+3
          LDD    CN+4        GET SECTOR
          STM    CRFA+4
 CRF2     RJM    SSA         SET SYSTEM FILE FNT ADDRESS
          ADN    FSTG
          CRD    CM
          LDD    CM          SET SYSTEM EQUIPMENT
          STD    FS
          LDM    CRFA+3      SET FIRST = CURRENT
          STD    FS+1
          STD    FS+2
          LDM    CRFA+4      SET SECTOR
          STD    FS+3
          LJM    CRFX        RETURN
 
 
 CRFA     BSS    5           SYSTEM DEVICE INFORMATION
 SSA      SPACE  4,10
**        SSA - SET SYSTEM FILE FNT ENTRY ADDRESS.
*
*         EXIT   (A) = ABSOLUTE ADDRESS OF SYSTEM FILE ENTRY.
*
*         USES   CM - CM+4.
 
 
 SSA      SUBR               ENTRY/EXIT
          LDN    FNTP        FETCH FNT POINTER
          CRD    CM
          LDD    CM          GET SYSTEM FILE FNT ADDRESS
          SHN    14
          ADD    CM+1
*         ADN    SYFO*FNTE
          ERRNZ  SYFO        SYSTEM FILE IS NOT FIRST SYSTEM FNT ENTRY
          UJN    SSAX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCLD
*CALL     COMPCRS
          SPACE  4,10
 IFP      HERE               DUMP *IFP* REMOTE CODE
          SPACE  4
**        DEFINE ZERO LEVEL OVERLAY LOAD ADDRESS.
 
 
 .L1      EQU    7777-1-ZBFL LENGTH OF *0BF*
 .L2      EQU    BFMS-1-ZDFL LENGTH OF *0DF*
 .L3      MIN    .L1,.L2
 OVL0     EQU    .L3         DEFINE ZERO LEVEL OVERLAY LOAD ADDRESS
          SPACE  4,10
          ERRNG  OVL0-*      CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
          OVERLAY (ERROR PROCESSOR.)
 ERP      SPACE  4,10
**        ERP - ERROR PPROCESSOR.
*
*         ENTRY  (EQ) = ERROR NUMBER.
 
 
          ENTRY  ERP
          LDM    ERPA,EQ
          ZJN    ERP1        IF NO DAYFILE MESSAGES ARE TO BE ISSUED
          LDC    =C* LFM ERROR.*
          RJM    DFM         ISSUE DAYFILE MESSAGE
          LDD    EQ
          LMN    /ERR/DFN
          NJN    ERP0        IF NOT *DUPLICATE FILE NAME*
          STD    FN+4        TERMINATE FILE NAME
          LDD    FN+3
          SCN    77
          STD    FN+3
          LDM    ERPA,EQ     ADD FILE NAME TO MESSAGE
          ADN    13
          STD    T1
          LDN    FN
          RJM    /COMPACS/ACS
          LDC    =C*. *      ADD PERIOD
          RJM    /COMPACS/ACS
 ERP0     LDM    ERPA,EQ
          LMC    CPON
          RJM    DFM         ISSUE DAYFILE MESSAGE
 ERP1     RJM    SNB         SET FILE(S) NOT BUSY
 ERP2     RJM    SFS         SET FILE STATUS
          LDD    EQ
          LMN    /ERR/LNV
          ZJN    ERP4        IF *ACCESS LEVEL NOT VALID FOR FILE* ERROR
          MONITOR  ABTM      ABORT CONTROL POINT
 ERP3     LJM    PPR         EXIT TO PP RESIDENT
 
 ERP4     LDN    SVET        SET SECURITY VIOLATION ERROR FLAG
          STD    CM+1
          MONITOR  CEFM      SET ERROR FLAG
          MONITOR  DPPM      DROP PP
          UJN    ERP3        EXIT TO PPR
 
 
 ERPA     BSS    0
          QUAL   ERR
          LOC    0
 
 FNF      CON    =C* FILE NOT FOUND.*
 FLN      CON    =C* FILE NAME ERROR.*
 IFT      CON    =C* INCORRECT FILE TYPE.*
 FLE      CON    =C* FILE EMPTY.*
 MNA      CON    =C* MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.*
 CFE      CON    =C* COMMAND FILE ERROR.*
 IEQ      CON    =C* INCORRECT EQUIPMENT.*
 WEQ      CON    =C* EQUIPMENT NOT AVAILABLE.*
 DFN      CON    =C* DUPLICATE FILE NAME - *
 IUA      CON    =C* USER ACCESS NOT VALID.*
 LNV      CON    =C* ACCESS LEVEL NOT VALID FOR FILE.*
          CON    0           NOT USED
 RDE      CON    0           RESEX DETECTED ERROR
 IOE      CON    =C* I/O SEQUENCE ERROR.*
          CON    0           NOT USED
          CON    0           NOT USED
 NMA      CON    =C* NO MASS STORAGE AVAILABLE.*
 ILM      CON    =C* INCORRECT FILE MODE.*
 FTS      CON    =C* FET TOO SHORT.*
 GTL      CON    =C* GETFNT TABLE TOO LARGE.*
          CON    0           NOT USED
 PBB      CON    =C* PARAMETER BLOCK BUSY.*
 AOR      CON    =C* ADDRESS OUT OF RANGE.*
 SYE      CON    =C* SYSTEM ERROR.*
 IRA      CON    =C* INCORRECT RANDOM ADDRESS.*
 ODE      CON    =C* OPTICAL DISK SYSTEM ERROR.*
 IFS      CON    =C* INCORRECT FILE STATUS.*
 
          LOC    *O
          QUAL   *
          SPACE  4,10
          ERRNG  OVL0-*      CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
          OVERFLOW  OVL
          OVERLAY (LOCAL FILE FUNCTIONS.)
          SPACE  4,10
****      ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
 
 
 UD       EQU    60 - 64     UDT WORD BUFFER (5 LOCATIONS)
 ST       EQU    65          FILINFO STATUS BYTE (1 LOCATION)
 SX       EQU    66          FILINFO EXTENDED STATUS (1 LOCATION)
 
****
 RNM      SPACE  4,25
***       FUNCTION 0.
*         RENAME FILE.
*
*         RENAME FILE TO THE NAME SPECIFIED IN (FET+6).
*
*         RENAME,A=B.
*         RENAME *B* TO *A*.
*
*         1.  IF FILE *A* DOES NOT EXIST, THEN THE FILE NAME OF *B*
*         IS CHANGED TO *A* IN THE LOCAL FNT.
*
*         2.  IF FILE *A* EXISTS, THEN
*                A.  *0DF* IS CALLED TO DROP THE LOCAL AND GLOBAL FNT
*                ENTRY FOR FILE *A*.
*                NOTE - IF FILE *A* IS NAMED /INPUT/, *0DF* DOES NOT
*                DROP THE FILE BUT RATHER CHANGES THE NAME TO /INPUT*/.
*
*                B.  THE FILE NAME OF *B* IS CHANGED TO *A* IN THE
*                LOCAL FNT.
*
*         * INCORRECT FILE TYPE.* - FILE *B* IS NOT TYPE LOFT, OR THE
*                FILE TYPES OF *A* AND *B* ARE NOT THE SAME.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
 
 
          ENTRY  RNM
          LCN    6           CHECK FET LENGTH .GE. 7
          RJM    CFL
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SIF         SEARCH AND INTERLOCK FILE
          LDD    FA          SET FNT ADDRESS OF *B*
          STM    RNMA
          LDD    FS+2        CHECK CURRENT TRACK
          NJN    RNM1        IF FILE HAS BEEN USED
          AOM    RNMD        SET ERROR FLAG
 RNM1     LDD    FS          SAVE EST ORDINAL IN *CFT*
          STM    CFTB
          SFA    EST
          ADK    EQDE
          RJM    CDP         CHECK FOR DMP= CALLING PROGRAM
          LDD    CM+3
          LPN    77
          STM    RNMC        SET STATUS
          LDD    CM+4        CHECK FILE TYPE
          STM    RNMB        PRESET FILE TYPE
          SHN    -6
          RAM    CFTA        SET FILE TYPE
 
*         GET NEW FILE NAME FROM FET.
 
          RJM    CPA         READ NEW NAME - *A*
          ADN    6
          CRD    FN
          LDD    FA          SET FNT ADDRESS OF FILE *B*
          STM    SNBA
          LDN    0           SET NO INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    RNM2        IF FILE *A* ALREADY EXISTS
*         LDN    0
          LJM    RNM5        GET *B* FST
 
*         CHECK FILE TYPE OF *A*.
 
 RNM2     LMM    RNMA
          ZJN    RNM3        IF SAME FILE
          RJM    SFB         SET FILE *A* BUSY
          ZJN    RNM4        IF NO REJECT ON FILE INTERLOCK
          LDN    /ERR/IOE    * I/O SEQUENCE ERROR.*
          UJN    RNM6        PROCESS ERROR
 
*         EXIT WHEN FILE NAMES ARE THE SAME.
 
 RNM3     STD    FA
          LJM    LFMX        EXIT
 
 RNM4     RJM    CFT         CHECK FILE TYPE
          NJN    RNM7        IF INCORRECT FILE TYPE
          RJM    DRF         DROP FILE *A*
*         LDN    0
 RNM5     STM    SNBA
          LDC    0           RESTORE FILE *B* FNT ADDRESS
 RNMA     EQU    *-1
          STD    FA
          NFA    FA,R
          ADN    FSTL
          CRD    FS          LOAD ORIGINAL FST ENTRY
          RJM    VFN         VERIFY FILE NAME
          NJN    RNM8        IF NO ERROR
          LDN    /ERR/FLN    FILE NAME ERROR
 RNM6     LJM    ERR         PROCESS ERROR
 
*         EXIT IF INCORRECT FILE TYPE ON FILE *B*.
 
 RNM7     LDN    /ERR/IFT    * INCORRECT FILE TYPE.*
          UJN    RNM6        PROCESS ERROR
 
*         CHANGE FILE NAME FROM *B* TO *A* IN FNT WORD.
 
 RNM8     LDC    *           RESTORE FILE TYPE OF *B*
 RNMB     EQU    *-1         FILE TYPE
          STD    FN+4
          LDD    FN+3        RESTORE FILE STATUS OF *B*
          SCN    77
          ADC    *
 RNMC     EQU    *-1         FILE STATUS
          STD    FN+3
          NFA    FA,R        WRITE NEW FNT WORD
          CWD    FN
          LDD    FN+4
          SHN    -6
          LMN    PTFT
          NJN    RNM10       IF NOT PRIMARY TERMINAL TYPE
 RNMD     LDN    0
*         LDN    1           (FILE NOT USED)
          ZJN    RNM9        IF FILE USED
          LDN    /ERR/FLE    EMPTY FILE
          LJM    ERR         PROCESS ERROR
 
 RNM9     RJM    UPP         UPDATE PRIMARY FILE POINTERS
 RNM10    LDN    0           SET TO NON-TAPE EQUIPMENT
*         LDN    1           (TAPE EQUIPMENT)
 RNME     EQU    *-1
          NJN    RNM11       IF TAPE EQUIPMENT
          SFA    EST,FS      GET EQUIPMENT TYPE
          ADK    EQDE
          CRD    CM
          LDD    CM+3
          LMC    2ROD
          ZJP    RNM12       IF OPTICAL DISK FILE
          LJM    LFMX        EXIT
 
*         PROCESS TAPE EQUIPMENT.
 
 RNM11    LDN    0
          STD    CM+1
          MONITOR ROCM       ROLLOUT JOB
          LDD    IA          READ REQUEST
          CRD    CM
          CRD    CN
          LDD    CN+1
          SCN    77
          ADN    20          SET RECALL PP PROCESSOR BIT
          STD    CN+1
          STD    CM+1
          LDD    CN+3
          LPN    77
          STD    CN+3
          LDD    CP
          ADC    SPCW
          CWD    CN          ENTER EXTERNAL CALL
          LDD    RA          REWRITE USERS CALL
          SHN    6
          ADN    1
          CWD    CM
          RJM    CPA         SET ORIGINAL NAME IN FET + 0
          CRD    FN
          LJM    LFMX        EXIT
 
*         PROCESS OPTICAL DISK EQUIPMENT.
 
 RNM12    RJM    CPA         READ OLD FILE NAME
          CRD    FN
          RJM    SOF         SEARCH OPTICAL DISK FILE
          ZJN    RNM14       IF FILE FOUND
 RNM13    NFA    FA,R        RESTORE FNT/FST WORDS
          CRD    FN
          ADN    FSTL
          CRD    FS
          LDN    /ERR/ODE    * OPTICAL DISK SYSTEM ERROR.*
          LJM    ERR         PROCESS ERROR
 
 RNM14    NFA    FA,R        SET NEW FILE NAME IN LABEL RECORD
          CRM    BFMS+2,ON
          LDM    BFMS+5
          SCN    77
          STM    BFMS+5
          LDN    0
          STM    BFMS+6
          SETMS  IO,RW
          LDC    BFMS+WLSF
          RJM    WDS         WRITE SECTOR
          MJN    RNM13       IF WRITE ERROR
          ENDMS
          NFA    FA,R        RESTORE FNT/FST WORDS
          CRD    FN
          ADN    FSTL
          CRD    FS
          LJM    LFMX        EXIT
 STS      SPACE  4,10
***       FUNCTION 3.
*         SET FILE STATUS.
*
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS.
*                (FN - FN+3) = FILE NAME FROM FET+0.
*                (FF) = FET SPECIFIED FNT ADDRESS.
*                (FP) = FILE STATUS.
 
 
          ENTRY  STS         ENTRY
          LDD    CP          CHECK FOR *SSJ=* CALLER
          ADC    SEPW
          CRD    CM
          LDD    CM
          SHN    21-2
          MJN    STS2        IF CALLER IS *SSJ=*
 
*         FOR NON-*SSJ=* CALLER, VERIFY THAT VALUE SPECIFIED
*         IS ALLOWED.  OTHERWISE IGNORE REQUEST.
 
          AOM    STSA        INDICATE NON-*SSJ=* CALLER
          LDN    TNFSL-1
          STD    T1
 STS1     LDM    TNFS,T1     CHECK IF SPECIFIED VALUE IS IN TABLE
          LMD    FP
          ZJN    STS2        IF NEW STATUS FOUND IN TABLE
          SOD    T1
          PJN    STS1        IF NOT END OF TABLE
          LJM    LFMX        EXIT
 
 STS2     LDD    FP          CHECK SPECIFIED STATUS
          SBN    MXST
          MJN    STS5        IF LEGAL STATUS
          LDN    /ERR/IFS    * INCORRECT FILE STATUS.*
 STS3     LJM    ERR         PROCESS ERROR
 
*         CHECK CURRENT VALUE OF FILE STATUS FIELD.
 
 STS4     NFA    FA,R        READ LOCAL FNT WORD
          CRD    FS
          RJM    SFB         SET FILE BUSY
          ZJN    STS6        IF FILE SET BUSY
          LDN    /ERR/IOE    * I/O SEQUENCE ERROR.*
          UJN    STS3        PROCESS ERROR
 
 STS5     LDD    FF          SEARCH FOR ASSIGNED FILE
          RJM    SAF
          NJN    STS4        IF FILE FOUND
          RJM    EFN         CREATE LOCAL FILE
          NFA    FA,R
          CRD    CM
 
*         FOR A NON-*SSJ=* CALLER, VERIFY THAT THE CURRENT STATUS
*         IS A VALUE THAT MAY BE CHANGED.
 
 STS6     LDN    0
*         LDN    1           (NON-*SSJ=* CALLER)
 STSA     EQU    *-1
          ZJN    STS9        IF CALLER IS *SSJ=*
          LDN    TOFSL-1
          STD    T1
 STS7     LDM    TOFS,T1     COMPARE EXISTING STATUS WITH TABLE
          LMD    CM+4
          LPN    77
          ZJN    STS9        IF EXISTING STATUS FOUND IN TABLE
          SOD    T1
          PJN    STS7        IF NOT END OF TABLE
 STS8     LJM    LFMX        IGNORE REQUEST
 
*         SET NEW FILE STATUS.
 
 STS9     LDD    CM+4
          SCN    77
          LMD    FP
          STD    CM+4
          NFA    FA,R        REWRITE FNT WORD
          CWD    CM
          UJN    STS8        EXIT
 
 
*         TABLE OF STATUSES THAT MAY BE SET BY USER.
 
 TNFS     BSS    0
          CON    0
          CON    NDST
 TNFSL    EQU    *-TNFS
 
 
*         TABLE OF STATUSES THAT MAY BE CHANGED BY USER.
 
 TOFS     BSS    0
          CON    0
          CON    UPST
          CON    NDST
 TOFSL    EQU    *-TOFS
 FSL      SPACE  4,20
***       FSL - FUNCTION 7.
*
*         SET FILE ACCESS LEVEL.
*
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS.
*                (FET+1, BIT 39) = SECURITY PROCESSING BIT-
*                                = NONZERO, TAKE ACCESS LEVEL
*                                  FROM FET+4, BITS 36-38.
*                                = ZERO, USE JOB SECURITY ACCESS LEVEL.
*                (FN - FN+4) = FILE NAME.
 
 
          ENTRY  FSL
          LDN    0           SET FILE BUSY
          RJM    SIF
          SFA    EST,FS      READ EST ENTRY
          ADK    EQDE
          CRD    CN
          LDD    CN+3
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          PJN    FSL0        IF TAPE FILE
          LDD    CM+4        CHECK FILE TYPE
          SHN    -6
          LMN    LOFT
          ZJN    FSL1        IF *LOFT*
          LMN    PTFT&LOFT
          ZJN    FSL1        IF *PTFT*
          LMN    QFFT&PTFT
          ZJN    FSL1        IF *QFFT*
 FSL0     LDN    /ERR/IFT    * INCORRECT FILE TYPE.*
          LJM    ERR         PROCESS ERROR
 
*         EXTRACT REQUESTED SECURITY ACCESS LEVEL.
 
 FSL1     RJM    CPA         READ FET+1
          ADN    1
          CRD    CN
          ADN    3           READ FET+4
          CRD    CM
          LDD    CN+1        CHECK *SP* BIT
          SHN    21-3
          PJN    FSL2        IF NOT SET
          LDD    CM+1        EXTRACT SECURITY ACCESS LEVEL
          UJN    FSL3        CHECK REQUESTED LEVEL
 
 FSL2     LDD    CP          READ JOB SECURITY WORD
          ADC    JSCW
          CRD    CM
          LDD    CM+1        EXTRACT JOB ACCESS LEVEL
          SHN    -11
 
*         CHECK AND SET FILE SECURITY ACCESS LEVEL.
 
 FSL3     LPN    7           SAVE REQUESTED LEVEL
          STD    CM+4
          STM    FSLB
          LDD    FA          SET FNT ADDRESS
          STD    CM+3
          LDN    VSFS        SET SUBFUNCTION
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          NJN    FSL4        IF INCORRECT ACCESS LEVEL
          LJM    LFMX        EXIT
 
*         PROCESS SECURITY VIOLATION.
 
 FSL4     LDC    FSLA+3      SET FILE NAME IN MESSAGE
          STD    T1
          LDN    FN
          RJM    /COMPACS/ACS
          LDC    =C*, *      APPEND COMMA
          RJM    /COMPACS/ACS
          LDC    **          DETERMINE MNEMONIC OF ACCESS LEVEL
 FSLB     EQU    *-1
          SHN    2
          ADC    TALV        APPEND NEW ACCESS LEVEL
          RJM    /COMPACS/ACS
          LDC    =C*. *      TERMINATE MESSAGE WITH A PERIOD
          RJM    /COMPACS/ACS
          LDC    FSLA+ACFN   ISSUE ACCOUNT FILE MESSAGE
          RJM    DFM
          LDN    /ERR/LNV    * ACCESS LEVEL NOT VALID FOR FILE.*
          LJM    ERR         PROCESS ERROR
 
 FSLA     DATA   C*MFFI, *
          BSSZ   12
 LCK      SPACE  4,10
***       FUNCTION 10.
*         LOCK FILE.
*         SET WRITE LOCKOUT FOR FILE.
*         FILE MUST BE TYPE *LOFT* OR *PTFT*.
*         THE FILE CAN ALSO BE TYPE *ROFT* IF CALLED BY *RESTART*.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
 
 
          ENTRY  LCK
 LCK1     LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SIF         SEARCH AND INTERLOCK FILE
          LDD    CM+4
          SHN    -6
          LMN    LOFT
          ZJN    LCK3        IF LOCAL FILE TYPE
          LMN    PTFT&LOFT
          ZJN    LCK3        IF PRIMARY FILE TYPE
          LMN    ROFT&PTFT
          NJN    LCK1.1      IF NOT ROLLOUT FILE TYPE
          LDM    LCKA
          LPN    1
          ZJN    LCK1.1      IF NOT *LOCK* FUNCTION
          LDD    CP
          ADK    SEPW
          CRD    CN
          LDD    CN+2
          SHN    21-13
          MJN    LCK3        IF *RESTART*
 LCK1.1   LDN    /ERR/IFT    * INCORRECT FILE TYPE.*
 LCK2     LJM    ERR         PROCESS ERROR
 
 LCK3     LDM    LCKA
          LPN    1
          NJN    LCK4        IF LOCK
          LDD    CM+3        CHECK FOR EXECUTE ONLY
          SHN    21-2
          PJN    LCK4        IF NOT EXECUTE-ONLY
          LDN    /ERR/ILM    * INCORRECT FILE MODE.*
          UJN    LCK2        PROCESS ERROR
 
 LCK4     LDD    CM+3
          SCN    1
 LCKA     LMN    1
*         LMN    0           (UNLOCK FUNCTION)
          STD    CM+3
          NFA    FA,R        STORE FNT ENTRY
          CWD    CM
          LJM    LFMX        EXIT
 ULK      SPACE  4,10
***       FUNCTION 11.
*         UNLOCK FILE.
*         CLEAR WRITE LOCKOUT FOR FILE.
*         FILE MUST BE TYPE *LOFT* OR *PTFT* AND NOT EXECUTE-ONLY.
 
 
          ENTRY  ULK
          SOM    LCKA        DO NOT SET WRITE LOCKOUT
          LJM    LCK1        PROCESS AS LOCK
 RLS      SPACE  4,10
***       FUNCTION 12.
*         RETURN FILE FOUND/NOT FOUND.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
*                (FN - FN+3) = FILE NAME FROM FET+0.
 
 
          ENTRY  RLS
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    RLS2        IF NOT FOUND
          RJM    SFB         SET FILE BUSY
          ZJN    RLS1        IF NO REJECT ON FILE INTERLOCK
          LDN    /ERR/IOE    *I/O SEQUENCE ERROR.*
          LJM    ERR         PROCESS ERROR
 
 RLS1     LDN    2           FLAG FILE FOUND
 RLS2     STD    LS
          LJM    LFMX        EXIT
 RCP      SPACE  4,20
***       FUNCTION 13.
*         RETURN CURRENT POSITION AND STATUS.
*         RETURN FILE ACCESS LEVEL IN FET+4 IF BIT 39 IN FET+1 IS SET.
*         RETURN FNT ENTRY IN (FET+5).
*         RETURN FST ENTRY IN (FET+6).
*         OPTIONALLY RETURNS ADDITIONAL MAGNETIC TAPE INFORMATION
*         TO FET+8 IN LABEL MACRO FORMAT.
*         FIELDS RETURNED TO FET+8 INCLUDE -
*                1.  LABEL BIT (58)
*                2.  NONSTANDARD LABEL BIT (57)
*                3.  TAPE DEVICE TYPE (55-56)
*                4.  DENSITY (51-53)
*                5.  CONVERSION MODE (48-50)
*                6.  PROCESSING OPTIONS (36-47)
*                7.  FORMAT (30-35)
*                8.  NOISE SIZE (24-29) - IN FRAMES
*                9.  BLOCK SIZE (0-23) - IN CM WORDS
*         REFER TO LFM FUNCTION 24 DOCUMENTATION FOR FURTHER
*         DETAILS ON CONTENTS OF FET+8 FIELDS.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
 
 
          ENTRY  RCP
          LCN    6           CHECK FET LENGTH .GE. 7
          RJM    CFL
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SIF         SEARCH AND INTERLOCK FILE
          RJM    CPA         READ FIRST
          ADN    1
          CRD    CN
          ADN    3
          CRD    UD          READ FET+4
          ADN    1
          CWD    CM          STORE FNT
          ADN    1
          CWD    FS          STORE FST
          LDD    CN+1        CHECK WHETHER TO RETURN FILE ACCESS LEVEL
          SHN    21-3
          PJN    RCP0        IF NOT RETURNING FILE ACCESS LEVEL
          NFA    FA,R        GET FILE ACCESS LEVEL
          ADN    FUTL
          CRD    CM
          LDD    CM+2        SET FILE ACCESS LEVEL IN FET+4
          LMD    UD+1
          LPN    7
          LMD    UD+1
          STD    UD+1
          RJM    CPA         WRITE FET+4
          ADN    4
          CWD    UD
 RCP0     LDN    0           INITIALIZE *FIRST* EQUIPMENT TYPE
          STD    CN
          LDD    FS          READ EST ENTRY
          ZJN    RCP1        IF NO EQUIPMENT ASSIGNED
          SFA    EST
          ADK    EQDE
          CRD    CM
          LDD    CM+3        SET EQUIPMENT TYPE
          STD    CN
          LDD    CM          CHECK EQUIPMENT TYPE
          SHN    21-13
          MJN    RCP1        IF MASS STORAGE
          SHN    21-12-21+13
          MJN    RCP1        IF ALLOCATABLE TYPE
          LDC    4000
          RAD    CN
 RCP1     RJM    CPA         STORE FIRST
          ADN    1
          CWD    CN
          LDD    FP          FUNCTION PARAMETER
          LMN    1
          NJN    RCP2        IF EXTRA TAPE INFORMATION NOT REQUESTED
          LDD    CM+3
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          PJN    RCP3        IF TAPE EQUIPMENT
 RCP2     LJM    LFMX        EXIT
 
 RCP3     STD    FP          SET TAPE DEVICE TYPE
          LCN    10          CHECK FET LENGTH .GE. 9D
          RJM    CFL
          LDN    /MTX/UST4   GET *UST4* AND *UST5* WORDS FROM UDT
          STD    T1
          LDN    2
          RJM    TUW         READ UDT WORDS
          LDD    MA
          CRD    UD          (UD - UD+4) = UST4
          ADN    1
          CRD    CM          (CM - CM+4) = UST5
          LDN    ZERL        CLEAR FET+8 ASSEMBLY BUFFER
          CRD    CN
          LDD    UD          SET LABELED FLAGS AND DEVICE TYPE
          LPC    3700
          STD    CN
          LDD    CM          CONVERT DENSITY
          SHN    -3
          LPN    7
          STD    T2
          LDD    CM          CONVERT CONVERSION MODE
          LPN    7
          SBN    1
 RCP5     LMM    TDEN-1,T2
          RAD    CN
          LDD    UD+1        SET PROCESSING OPTIONS
          STD    CN+1
 
*         CONVERT NOISE BYTES (NB) AND FILL STATUS BACK TO NOISE SIZE
*         (NS) IN FRAMES.
*                7-TRACK FORMULA -
*                    NS = NB * 2
*                    IF FILL STATUS, NS = NS - 1 = NB * 2 - 1
*                9-TRACK FORMULA -
*                    NS = ( NB * 3 ) / 2
*                    IF FILL STATUS, NS = NS - 1 = ( NB * 3 ) / 2 - 1
 
          LDD    FP          CHECK TAPE DEVICE TYPE
          LPN    1
          NJN    RCP7        IF *CT* OR *AT* DEVICE
          LDD    UD+2        FILL STATUS BIT
          LPN    40
          STD    T1
          LDD    UD+2        NOISE SIZE IN BYTES
          LPN    37
          STD    T2
          SHN    1           NB * 2
          STD    CN+2
          LDD    FP
          ZJN    RCP6        IF 7-TRACK
          LDD    T2
          ADD    CN+2        NB + NB * 2
          SHN    -1          ( NB * 3 ) / 2
          STD    CN+2
 RCP6     LDD    T1
          ZJN    RCP7        IF NO FILL STATUS
          SOD    CN+2
 RCP7     LDD    UD+2        DATA FORMAT
          LPC    7700
          RAD    CN+2
 
*         RETURN BLOCK SIZE (IN CM WORDS).
*         BLOCK SIZE = BLOCK WORD COUNT + CHUNK COUNT * 600B.
 
          LDD    UD+3        BLOCK WORD COUNT
          STD    CN+4
          LDD    UD+4        CHUNK COUNT
          ZJN    RCP9        IF NOT LONG BLOCK
          STD    T1
 RCP8     LDC    /MTX/LBWD
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SOD    T1
          NJN    RCP8        IF OVERFLOW COUNT NOT EXHAUSTED
 
*         RETURN ADDITIONAL TAPE INFORMATION TO FET+8.
 
 RCP9     RJM    CPA         STORE FET + 8
          ADN    10
          CWD    CN
          LJM    LFMX        EXIT
 TUW      SPACE  4,15
**        TUW - TRANSFER UDT WORDS.
*
*         ENTRY  (A) = NUMBER OF WORDS TO TRANSFER.
*                (T1) = FIRST WORD FROM UDT TO BE TRANSFERRED.
*                (FS+1) = UDT ADDRESS OF ASSIGNED TAPE.
*
*         EXIT   CONTIGUOUS UDT WORDS REQUESTED IN MESSAGE BUFFER.
*
*         ERROR  TO *ERR* IF *MAGNET* NOT PRESENT.
*                TO *LFMX*, IF ERROR FLAG SET ON CONTROL POINT.
*
*         USES   T1, T2, CM - CM+4.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 TUW      SUBR               ENTRY/EXIT
          SHN    6
          STD    T2
          LDD    FS+1        UDT ADDRESS OF ASSIGNED TAPE
          ZJN    TUW2        IF NO UDT ADDRESS IN FST WORD
          RAD    T1          FWA IN MAGNET TO BE TRANSFERRED
 TUW1     LDD    T2          NUMBER OF WORDS TO TRANSFER
          STD    CM+3
          LDD    T1
          STD    CM+4
          LDN    0           SET READ
          STD    CM+1
          LCN    7777-MTSI   SET *MAGNET* SUBSYSTEM ID
          STD    CM+2
          MONITOR TDAM       GET UDT WORDS
          LDD    CM+1
          ZJN    TUWX        IF TRANSFER COMPLETE
          SBN    3
 TUW2     PJN    TUW3        IF *MAGNET* NOT UP OR FUNCTION REJECT
          PAUSE
          DELAY
          LDD    CM+1
          ZJN    TUW1        IF NO ERROR FLAGS SET ON CP
          LJM    LFMX        EXIT
 
 TUW3     LDN    /ERR/MNA    * MAGNETIC TAPE SUBSYSTEM NOT ACTIVE *
          LJM    ERR         PROCESS ERROR
 RFI      SPACE  4,30
***       RFI - FUNCTION 32.
*         RETURN FILE INFORMATION.
*         RETURN FILE INFORMATION TO USER IN SPECIFIED PARAMETER BLOCK.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER BLOCK.
*                THE PARAMETER BLOCK SHOULD HAVE THE FOLLOWING FORMAT.
*                (FE) = LENGTH OF PARAMETER BLOCK - 1.
*                (FF) = FET SPECIFIED FNT ADDRESS.
*
*T ADDR   42/LFN, 6/LEN, 11/0, 1/0
*T,ADDR+1 60/,
*T,ADDR+2 60/,
*T,ADDR+3 60/,
*T,ADDR+4 60/,
*         LEN = LENGTH OF TABLE, MUST BE .GE. 5.
*
*         EXIT   TO *ERR* IF ERROR ENCOUNTERED.
*                PARAMETER BLOCK RETURNED TO USER IN THE FOLLOWING
*                FORMAT.
*
*T ADDR   42/LFN, 6/LEN, 11/0, 1/1
*T ADDR+1 12/DEVICE TYPE, 12/RESERVED, 30/STATUS BITS, 6/FT
*T,ADDR+2 12/EQ, 48/0
*T,ADDR+3 24/FILE LENGTH IN SECTORS, 6/0, 24/CRA, 6/0
*T,ADDR+4 60/RESERVED
*         LEN = LENGTH OF TABLE.
*         STATUS BITS -
*                9/RESERVED.
*                2/TAPE DEVICE TYPE.
*                    0 = 7-TRACK TAPE (*MT*).
*                    1 = CARTRIDGE TAPE (*CT*).
*                    2 = 9-TRACK TAPE (*NT*).
*                    3 = ACS CARTRIDGE TAPE (*AT*).
*                1/TAPE FILE.
*                1/FILE AT EOI (MASS STORAGE ONLY).
*                1/FILE AT EOF (MASS STORAGE ONLY).
*                1/FILE AT BOI (MASS STORAGE ONLY).
*                1/LABELED TAPE FILE.
*                1/9-TRACK TAPE FILE.
*                1/7-TRACK TAPE FILE.
*                1/FILE OPEN.
*                1/INTERACTIVE TERMINAL FILE.
*                1/MASS STORAGE FILE.
*                1/FILE ON INACCESSIBLE DEVICE.
*                1/RESERVED.
*                1/FILE IS EXECUTE-ONLY.
*                1/FILE IN *RA* OR *RM* MODE.
*                1/FILE IN *RU* OR *RM* MODE.
*                1/FILE MAY BE ALTERED (*U*, *M* OR *W* MODE).
*                1/FILE MAY BE EXTENDED (*A*, *M* OR *W* MODE).
*                1/FILE MAY BE SHORTENED (*W* MODE).
*                1/FILE MAY NOT BE WRITTEN.
*         FT = FILE TYPE.
*         EQ = EST ORDINAL.
*         CRA = CURRENT RANDOM ADDRESS.
*
*         ADDITIONAL INFORMATION IS RETURNED BASED ON THE *KEY*
*         SPECIFIED IN BITS 0-4 OF EACH WORD DEFINED IN THE *FILINFO*
*         PARAMETER BLOCK BEYOND THE STANDARD 5 WORD LENGTH.  THE KEY
*         WORDS BEGIN AT THE *FILINFO* PARAMETER BLOCK ADDRESS + 5
*         AND CAN BE IN ANY ORDER.
*
*         KEY    RETURNED WORD (IF APPLICABLE - ELSE BIT 5 IS SET)
*
*         1      48/0, 6/F, 1/0, 5/1
*         2      41/0, 1/IEP, 6/LBTYP, 3/DEN, 3/CV, 1/0, 5/2
*         3      RESERVED FOR ANSI 1977 LBL. STD.
*         4-13B  RESERVED FOR CDC (COMMON O/S)
*         14B    12/0, 24/BSIZE, 12/PO, 6/NOISE, 1/0, 5/14B
*         15B-17B RESERVED FOR CDC (NOS ONLY)
*         20B-27B RESERVED FOR CDC (OTHER O/S-S)
*         30B-37B RESERVED FOR INSTALLATIONS
*                F = TAPE FORMAT.
*                    0 = INTERNAL BINARY (I)
*                    1 = NOS/BE INTERNAL BINARY (SI)
*                    2 = FOREIGN (F)
*                    3 = STRANGER (S)
*                    4 = LONG BLOCK STRANGER (L)
*                    5 = LONG BLOCK INTERNAL BINARY (LI)
*                    6-77B = RESERVED FOR CDC
*                IEP = ERROR PROCESSING INHIBITED (IF SET).
*                LBTYP = LABEL TYPE.
*                    0 = UNLABELED
*                    1 = STANDARD (ANSI 1969 STD.)
*                    2 = RESERVED FOR CDC (ANSI 1977 STD.)
*                    3-10B = RESERVED FOR CDC
*                    11B-13B = NOS/BE ONLY
*                    14B = NONSTANDARD (SKIP LABELS)
*                    15B-67B = RESERVED FOR CDC
*                    70B-77B = RESERVED FOR INSTALLATIONS
*                DEN = TAPE DENSITY.
*                    0 = NOT APPLICABLE
*                    1 = 556 BPI (7-TRACK)
*                    2 = 200 BPI (7-TRACK)
*                    3 = 800 BPI (7- OR 9-TRACK)
*                    4 = 1600 CPI (9-TRACK)
*                    5 = 6250 CPI (9-TRACK)
*                    6 = 38000 CPI (CARTRIDGE)
*                    7 = RESERVED FOR CDC
*                CV = CONVERSION MODE.
*                    0 = BCD CONVERSION (7-TRACK)
*                    1 = ASCII CONVERSION (9-TRACK)
*                    2 = EBCDIC CONVERSION (9-TRACK)
*                    3-7 = RESERVED FOR CDC
*                BSIZE = MAXIMUM BLOCK SIZE (IN CM WORDS).
*                PO = PROCESSING OPTIONS.
*                    0 = ABORT ON IRRECOVERABLE PARITY ERROR
*                        WITH EP SET
*                    1 = DO NOT ABORT ON IRRECOVERABLE PARITY
*                        WITHOUT EP SET
*                    2 = INHIBIT ERROR PROCESSING
*                    3 = ENFORCE RING OUT
*                    4 = ENFORCE RING IN
*                    5 = INHIBIT UNLOAD
*                    6 = DISABLE GCR HARDWARE WRITE ERROR CORRECTION
*                    7 = ISSUE ALL ERROR RECOVERY MESSAGES TO USER
*                        DAYFILE
*                    8 = RESERVED FOR CDC
*                    9-11 = END-OF-REEL PROCESSING OPTION
*                        9 = OPTION *S*
*                        10 = OPTION *P*
*                        11 = OPTION *I*
*                NOISE = NOISE SIZE (IN FRAMES).
 
 
          ENTRY  RFI         RETURN FILE INFORMATION
          LDN    0           CLEAR STATUS BYTES
          STD    ST
          STD    SX
          LDN    FIPBL*5-1*5-1
          STD    T1
 RFI1     LDN    0           INITIALIZE PARAMETER BLOCK BUFFER
          STM    FIPB,T1
          SOD    T1
          PJN    RFI1        IF MORE WORDS TO CLEAR
          RJM    CPA         GET PARAMETER BLOCK ADDRESS
          CRD    FN          READ FIRST WORD OF PARAMETER BLOCK
          ADN    1
          CWM    FIPB,ON     ZERO WORD ONE OF PARAMETER BLOCK
          LDD    FN+4        CHECK IF COMPLETION BIT SET
          SHN    21-0
          PJN    RFI2        IF COMPLETION BIT NOT SET
          LDN    /ERR/PBB    * PARAMETER BLOCK BUSY.*
          LJM    ERR         EXIT TO ERROR PROCESSOR
 
 RFI2     LCN    FIPBL-1     CHECK FET LENGTH .GE. MINIMUM LENGTH
          RJM    CFL
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    RFI3        IF FILE FOUND
          LDN    FIPBL-2     CLEAR REMAINDER OF PARAMETER BLOCK
          STD    T4
          RJM    CPA         DETERMINE RETURN ADDRESS
          ADN    2
          CWM    FIPB,T4
          LJM    LFMX        EXIT
 
 RFI3     RJM    SFB         SET FILE BUSY
          ZJN    RFI4        IF NO REJECT ON FILE INTERLOCK
          LDN    0
          STD    FA
          LDN    /ERR/IOE    * I/O SEQUENCE ERROR.*
          LJM    ERR         EXIT TO ERROR PROCESSOR
 
*         DETERMINE FILE TYPE.
 
 RFI4     STD    T4
          LDD    CM+4        GET FILE TYPE FROM FNT
          SHN    -6
          STD    T3
 RFI5     LDM    TAFT,T4     CHECK TABLE FOR MATCH
          LMD    T3
          ZJN    RFI6        IF MATCH
          AOD    T4
          LMN    TAFTL
          NJN    RFI5        IF NOT END OF TABLE
          LDN    77          SET FILE TYPE = OTHER
          STD    T4
 RFI6     LDD    T4
          STM    FIPB+4      PLACE FILE TYPE IN PARAMETER BLOCK
          LDD    CM+3        PICK UP FILE ACCESS MODE
          LPN    35          ISOLATE ACCESS MODE
          STD    EQ          SAVE FILE ACCESS MODE
          LDD    FS          GET EST ORDINAL
          STD    T5          SAVE EST ORDINAL
          STM    FIPB+1*5    PLACE EST ORDINAL IN PARAMETER BLOCK
          ZJN    RFI7        IF NOT ASSIGNED TO MASS STORAGE
          SFA    EST         READ EST ENTRY FOR FILE
          ADK    EQDE
          CRD    CN
          LDD    CN+3        GET DEVICE TYPE
          STM    FIPB
          LDD    CN
          SHN    21-13
          MJN    RFI7        IF MASS STORAGE
          LJM    RFI18       PROCESS NON MASS STORAGE
 
*         CHECK FOR EOI, EOF, AND BOI FOR MASS STORAGE FILES.
 
 RFI7     LDD    FS+4        SET MASS STORAGE AND OPEN BITS
          SHN    -3
          LPN    40
          ADN    10
          STD    ST
          LDD    T5
          ZJN    RFI7.1      IF NOT ASSIGNED TO MASS STORAGE DEVICE
          SETMS  STATUS
          LDM    MSD
          SHN    21-6
          PJN    RFI7.1      IF DEVICE ACCESSIBLE
          LDN    4
          RAD    ST
 RFI7.1   LDD    FS+4        CHECK FOR EOF OR EOI
          SHN    21-3
          PJN    RFI9        IF NOT EOI OR EOF
          SHN    3-2
          MJN    RFI8        IF NOT EOF
          LDN    2           SET BIT TO INDICATE EOF
          UJN    RFI10       SET UP FILE MODE FIELDS
 
 RFI8     LDN    4           SET BIT TO INDICATE EOI
          SHN    11
          RAD    ST
 RFI9     LDD    FS+1        CHECK FOR EMPTY FILE
          ZJN    RFI9.1      IF EMPTY FILE
          LMD    FS+2
          NJN    RFI11       IF FIRST TRACK .NE. CURRENT TRACK
          LDD    FS+3
          LMN    FSMS
          NJN    RFI11       IF CURRENT SECTOR .NE. FSMS
 RFI9.1   LDN    1           SET BIT TO INDICATE BOI
 RFI10    SHN    11
          RAD    ST
 
*         DETERMINE FILE LENGTH.
 
 RFI11    LDD    FS+1        SET FIRST TRACK
          ZJN    RFI13       IF NO FIRST TRACK
          STD    T6
          RJM    SEI         DETERMINE FILE LENGTH
          SOD    T3          SET FILE LENGTH IN PARAMETER BLOCK
          PJN    RFI12       IF NO BORROW
          LDD    T2
          ZJN    RFI12       IF LENGTH IS ZERO
          SOD    T2          BORROW
          LCN    0
 RFI12    STM    FIPB+2*5+1
          LDD    T2
          STM    FIPB+2*5
 
*         DETERMINE RANDOM ADDRESS.
 
 RFI13    LDD    FS+2        SET TRACK
          ZJN    RFI14       IF NO CURRENT TRACK
          STD    T6
          LDD    FS+3        SET SECTOR
          STD    T7
          LDD    FS+1
          RJM    SRA         SET RANDOM ADDRESS
          LDD    RI          SET RANDOM ADDRESS IN PARAMETER BLOCK
          SHN    6
          STM    FIPB+2*5+3
          SHN    -14
          STM    FIPB+2*5+2
          LDD    RI+1
          SHN    6
          STM    FIPB+2*5+4
          SHN    -14
          RAM    FIPB+2*5+3
 
*         DETERMINE FILE ACCESS MODE.
 
 RFI14    AOD    ST          DEFAULT TO EXECUTE MODE
          LDN    0
          STD    T4
 RFI15    LDM    TAFM,T4     CHECK TABLE FOR MATCH
          LMD    EQ
          LPN    77
          ZJN    RFI16       IF MATCH
          AOD    T4
          LMN    TAFML
          NJN    RFI15       IF NOT END OF TABLE
          LDN    SWET        SET SYSTEM SOFTWARE ERROR FLAG
          STD    CM+2
          LDC    *           SET ADDRESS WHERE ERROR DETECTED
          STD    CM+1
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    LFMX        RETURN
 
*         PROGRAMMER NOTE - BECAUSE ALL POSSIBLE FILE MODES
*         SHOULD BE INCLUDED IN TABLE *TAFM*, A MATCH
*         FAILURE INDICATES THAT THE FNT ENTRY FOR THE
*         FILE IS INCORRECT.
 
 RFI16    LDM    TAFM,T4     SET BITS TO INDICATE MODE
          SCN    77
 RFI17    RAM    FIPB+4
          LJM    RFI27       CHECK FOR KEYWORD
 
*         CHECK FOR TAPE OR TTY FILE.
 
 RFI18    LDD    CN+3        CHECK FOR *TTY* OR TAPE FILE
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          MJN    RFI18.1     IF NOT TAPE EQUIPMENT
          SHN    1           SAVE TAPE DEVICE TYPE AND TAPE FLAG
          LMN    1
          STD    SX
          LDD    CN+3
          LMC    2RMT
          ZJN    RFI21       IF *MT*
          LMC    2RNT&2RMT
          ZJN    RFI20       IF *NT*
          UJN    RFI21.1     CHECK IF LABELED TAPE
 
 RFI18.1  LDD    CN+3
          LMC    2RTT
          ZJN    RFI19       IF *TT*
          LDN    20          CLEAR STATUS BYTE
 RFI19    LMN    20          SET BIT TO INDICATE *TT*
          STD    ST
          LJM    RFI23       CHECK ACCESS MODE
 
 RFI20    LDD    HN
 RFI21    ADD    HN
          STD    ST          SET 7-TRACK BIT OR 9-TRACK BIT
 RFI21.1  LDD    FS+4        CHECK IF LABELLED TAPE
          LPC    4000
          SHN    -3
          RAD    ST
 
*         CHECK FOR FILE OPENED.
 
          LDN    /MTX/UVSN
          STD    T1
          LDN    1
          RJM    TUW         TRANSFER UDT WORD
          LDD    MA
          CRD    UD          GET VSN AND OPEN STATUS
          LDD    UD+3        CHECK FOR OPEN BIT
          SHN    21-11
          PJN    RFI22       IF NOT OPEN
          LDN    40          SET OPEN BIT FOR REPLY
          RAD    ST
 
*         CHECK FOR WRITE LOCKOUT.
 
 RFI22    LDN    /MTX/UST1   GET DEVICE STATUS FROM UDT
          STD    T1
          LDN    1
          RJM    TUW
          LDD    MA
          CRD    CN
          LDD    CN+4        CHECK FOR WRITE RING
          SHN    21-7
          PJN    RFI24       IF NO WRITE RING
 
 RFI23    LDD    EQ          PICK UP FILE ACCESS MODE
          SHN    21-0
          PJN    RFI25       IF NOT WRITE LOCKOUT
 RFI24    LDD    HN          SET READ BIT
          UJN    RFI26       SET UP FILE MODE FIELD
 
 RFI25    LDC    300         SET READ AND WRITE BITS
 RFI26    RAM    FIPB+4
 
 RFI27    LDD    ST          SET STATUS BYTES
          STM    FIPB+3
          LDD    SX
          STM    FIPB+2
 
*         RETURN STANDARD PARAMETER BLOCK.
 
          LDN    FIPBL-1     NUMBER OF WORDS TO TRANSFER
          STD    FP
          RJM    CPA         DETERMINE RETURN ADDRESS
          ADN    1
          CWM    FIPB,FP
          LDD    FE          SET KEYWORD COUNT - 1
          SBN    FIPBL-1+1
          STD    FE
          PJN    RFI32       IF KEYWORDS TO PROCESS
 RFI28    LJM    LFMX        RETURN
 
*         PROCESS KEY WORDS.
 
 RFI29    LDN    40          SET KEY NOT DEFINED FLAG
          RAD    CN+4
 RFI30    RJM    CPA         GET PARAMETER BLOCK ADDRESS
          ADD    FP
          CWD    CN          RETURN KEYWORD
 RFI31    SOD    FE
          MJN    RFI28       IF NO MORE KEYS TO PROCESS
 RFI32    AOD    FP          ADVANCE PARAMETER BLOCK POINTER
          RJM    CPA         GET PARAMETER BLOCK ADDRESS
          ADD    FP
          CRD    CM          READ NEXT KEY WORD
          LDN    ZERL        INITIALIZE KEY WORD FIELDS
          CRD    CN
          LDD    CM+4
          LPN    37
          ZJN    RFI31       IF ZERO KEY, IGNORE WORD
          STD    CN+4
          LDN    TAPKL
          STD    T1
 RFI33    LCN    TAPKE       SEARCH FOR KEY
          RAD    T1
          MJN    RFI29       IF END OF TABLE
          LDM    TAPK,T1
          LMD    CN+4
          NJN    RFI33       IF NO MATCH
          LDM    TAPK+1,T1   GET KEY WORD PROCESSOR ADDRESS
          STD    T1
          LJM    0,T1        JUMP TO KEYWORD PROCESSOR
 RFI      SPACE  4,15
**        KEY WORD PROCESSORS.
*
*         ENTRY  (CN - CN+3) = 0.
*                (CN+4) = KEY.
*                (FS - FS+4) = FST ENTRY.
*                (ST) = FILE STATUS
*                (SX) = EXTENDED FILE STATUS
*                (UD - UD+4) = WORD *UVSN* FROM THE UDT
*
*         EXIT   (CN - CN+4) = RETURNED KEY WORD.
*                TO *RFI29*, IF KEY NOT APPLICABLE FOR FILE TYPE.
*                TO *RFI30*, TO PROCESS NEXT KEY WORD.
*
*         NOTES  KEY WORD PROCESSORS CAN USE THE FOLLOWING
*                DIRECT CELLS -
*                EQ, OC, CM - CM+4, CN - CN+4, RI - RI+1.
 RFI      SPACE  4,10
**        KEY 1.
*         RETURN TAPE FORMAT.
 
 
 RFI34    LDD    SX          CHECK FILE TYPE
          LPN    1
          ZJN    RFI35       IF NOT TAPE FILE
          LDD    FS+2        DATA FORMAT
          SHN    -10
          SHN    6
          RAD    CN+4
          LJM    RFI30       GET NEXT WORD
 
 RFI35    LJM    RFI29       SET KEY NOT DEFINED FLAG
 RFI      SPACE  4,10
**        KEY 2.
*         RETURN LABEL TYPE, DENSITY, CONVERSION MODE, AND
*         INHIBIT ERROR PROCESSING BIT.
 
 
 RFI36    RJM    TAI         TRANSFER ADDITIONAL TAPE INFORMATION
          ZJN    RFI35       IF NOT TAPE FILE
          LDM    FIPB+2*5
          SHN    21-12
          PJN    RFI39       IF UNLABELED
          SHN    21-11-21+12
          PJN    RFI37       IF STANDARD LABEL
          LDN    14
          UJN    RFI38       SET LABEL TYPE
 
 RFI37    LDN    1           SET ANSI LABELS
 RFI38    STD    CN+3
 RFI39    LDM    FIPB+2*5+1  ERROR PROCESSING INHIBITED
          LPN    4
          SHN    6-2
          RAD    CN+3
          LDM    FIPB+3*5    CONVERT DENSITY
          SHN    -3
          LPN    7
          STD    T2
          LDM    FIPB+3*5    CONVERT CONVERSION MODE
          LPN    7
          SBN    1
 RFI39.1  LMM    TDEN-1,T2
          SHN    6
          RAD    CN+4        MERGE DENSITY, CONVERSION MODE, AND KEY
          LJM    RFI30       RETURN KEY WORD
 RFI      SPACE  4,20
**        KEY 4.
*         RETURN CURRENT VSN AND REEL NUMBER.
 
 
 RFI40    RJM    TAI         TRANSFER ADDITIONAL TAPE INFORMATION
          ZJN    RFI40.1     IF NOT TAPE FILE
          LDD    UD          MOVE VSN TO KEY WORD
          STD    CN
          LDD    UD+1
          STD    CN+1
          LDD    UD+2
          STD    CN+2
          LDM    FIPB+4*5+3  UDT REEL NUMBER
          ADN    1
          STD    CN+3        ACTUAL REEL NUMBER TO KEY WORD
          LJM    RFI30       RETURN KEY WORD
 
 RFI40.1  LJM    RFI29       SET KEY NOT DEFINED FLAG
 RFI      SPACE  4,15
**        KEY 14B.
*         RETURN BLOCK SIZE, PROCESSING OPTIONS, AND NOISE SIZE.
*
*         NOTES  TO CONVERT NOISE BYTES (NB) AND FILL STATUS FIELDS
*                IN UDT WORD UST4 BACK TO NOISE SIZE (NS) IN FRAMES,
*                THE FOLLOWING FORMULAS ARE USED.
*                7-TRACK FORMULA -
*                    NS = NB * 2
*                    IF FILL STATUS, NS = NS - 1 = NB * 2 - 1
*                9-TRACK FORMULA -
*                    NS = ( NB * 3 ) / 2
*                    IF FILL STATUS, NS = NS - 1 = ( NB * 3 ) / 2 - 1
 
 
 RFI41    RJM    TAI         TRANSFER ADDITIONAL TAPE INFORMATION
          NJN    RFI42       IF TAPE FILE
          LJM    RFI29       SET KEY NOT DEFINED FLAG
 
 RFI42    LDD    SX
          LPN    2
          NJN    RFI44.1     IF CARTRIDGE TAPE (*CT* OR *AT*)
          LDM    FIPB+2*5+2  FILL STATUS BIT
          LPN    40
          STD    T1
          LDM    FIPB+2*5+2  NOISE SIZE IN BYTES
          LPN    37
          STD    T2
          SHN    1           NB * 2
          STD    T3
          LDD    ST
          SHN    21-6
          MJN    RFI43       IF 7-TRACK
          LDD    T2
          ADD    T3          NB + NB * 2
          SHN    -1          ( NB * 3 ) / 2
          STD    T3
 RFI43    LDD    T1
          ZJN    RFI44       IF NO FILL STATUS
          SOD    T3
 RFI44    LDD    T3          MERGE NOISE SIZE AND KEY
          SHN    6
          RAD    CN+4
 RFI44.1  LDM    FIPB+2*5+1  SET PROCESSING OPTIONS
          STD    CN+3
 
*         RETURN BLOCK SIZE (IN CM WORDS).
*         BLOCK SIZE = BLOCK WORD COUNT + CHUNK COUNT * 600B.
 
          LDM    FIPB+2*5+3  BLOCK WORD COUNT
          STD    CN+2
          LDM    FIPB+2*5+4  CHUNK COUNT
          ZJN    RFI46       IF NOT LONG BLOCK
          STD    T2
 RFI45    LDC    /MTX/LBWD
          RAD    CN+2
          SHN    -14
          RAD    CN+1
          SOD    T2
          NJN    RFI45       IF OVERFLOW COUNT NOT EXHAUSTED
 RFI46    LJM    RFI30       RETURN KEY WORD
          SPACE  4,10
**        KEY 15B.
*         RETURN DIRECT ACCESS FILE VALIDATION SIZE AND ACCESS LEVEL.
 
 RFI49    NFA    FA,R
          ADK    FNTL
          CRD    CM          GET FILE TYPE
          ADK    FUTL-FNTL
          CRM    FIPB,ON     GET ACCESS LEVEL/FILE SIZE INDEX
          LDM    FIPB+2      SAVE ACCESS LEVEL IN PARAMETER BLOCK
          LPN    7
          SHN    6
          RAD    CN+4
          LDD    CM+4        CHECK FILE TYPE
          SHN    -6
          LMN    PMFT
          NJN    RFI51       IF NOT A DIRECT ACCESS FILE
          LDM    FIPB+2      CHECK FILE SIZE INDEX
          SHN    -6
          LPN    7
          NJN    RFI50       IF INDEX IS NOT SYSTEM CONTROLLED
          LDD    CP          GET EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      GET SERVICE CLASS
          ADK    SCLE
          CRD    CM
          LDD    CM
          SHN    -6
          RJM    RJC         GET ADDRESS OF JOB CONTROL BLOCK
          ZJN    RFI51       IF NO JCB FOR SERVICE CLASS
          ADK    PFCT        READ DIRECT ACCESS FILE SIZE LIMIT
          CRD    CM
          LDD    CM
          SHN    -11
 RFI50    SHN    1           OFFSET INTO *TDMS*
          STD    T2
          LDM    TMDS,T2     SAVE DIRECT ACCESS VALIDATION
          STD    CN+2
          LDM    TMDS+1,T2
          STD    CN+3
 RFI51    LJM    RFI30       RETURN KEYWORD
 RFI      SPACE  4,10
**        KEY 16B.    SPACE REMAINING ON OPTICAL DISK
*
*         48/ SPACE, 6/ 0, 6/16B
*                SPACE = NUMBER OF SECTORS REMAINING IN FILE IF THIS
*                        FILE IS OPEN FOR WRITE.
*                      = NUMBER OF SECTORS REMAINING IN PARTITION OR
*                        NUMBER OF PRE-ALLOCATED SECTORS REMAINING IF
*                        THIS FILE IS NOT OPEN.
 
 
 RFI60    NFA    FA,A        GET CURRENT POSITION
          ADK    FSTL
          CRD    T0
          ADK    FUTL-FSTL   GET STARTING DISK ADDRESS AND SIZE
          CRD    CM
          LDD    CM+4        COMPUTE SPACE REMAINING
          SBD    T2
          STD    CN+3
          SHN    -12         SAVE REMAINDER
          LPN    1
          ADD    T1
          LDD    CM+3
          SBD    T1
          STD    CN+2
          LJM    RFI30       RETURN KEYWORD
 SLF      SPACE  4,10
***       SLF - FUNCTION 33B.
*         SET LAST FILE EXECUTED.
*
*         SET FNT POINTER IN THE CONTROL POINT AREA TO INDICATE
*         THE FILE FROM WHICH THE LAST MAIN PROGRAM WAS LOADED.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
*                FET MUST BE SET BUSY ON ENTRY.
*
*         EXIT   CPA UPDATED, IF NO ERRORS.
*
*         ERROR  TO *ERR*, IF ERRORS.
*
*         USES   CM - CM+4, FN - FN+4.
*
*         CALLS  CPA, SIF.
 
 
          ENTRY  SLF
          LDD    CP          CHECK FOR SSJ=
          ADC    SEPW
          CRD    CM
          LDD    CM
          SHN    21-2
          MJN    SLF1        IF SSJ= PRESENT
          LDN    /ERR/IUA    * USER ACCESS NOT VALID.*
          UJN    SLF2        PROCESS ERROR
 
 SLF1     RJM    CPA         READ FET+0
          CRD    FN
          LDD    FN+4        CHECK COMPLETE BIT
          LPN    1
          ZJN    SLF3        IF FET BUSY
          LDN    /ERR/PBB    * PARAMETER BLOCK BUSY.*
 SLF2     LJM    ERR         PROCESS ERROR
 
 SLF3     LDD    FF          SEARCH FOR FILE
          RJM    SIF
          LDD    CP          UPDATE CPA
          ADC    EOCW
          CRD    CM
          LDD    FA
          STD    CM
          LDD    CP
          ADC    EOCW
          CWD    CM
          LJM    LFMX        RETURN
 TAFT     SPACE  4,10
**        TAFT - TABLE OF FILE TYPES.
 
 
 TAFT     BSS    0
          LOC    0
          CON    LOFT        LOCAL
          CON    INFT        INPUT
          CON    QFFT        QUEUED
          CON    7777        RESERVED
          CON    PMFT        PERMANENT (DIRECT)
          CON    7777        RESERVED
          CON    PTFT        PRIMARY
          CON    LIFT        LIBRARY
          LOC    *O
 TAFTL    EQU    *-TAFT
 TAFM     SPACE  4,10
**        TAFM - TABLE OF FILE MODES.
*
*         TABLE IS IN THE FOLLOWING FORMAT.
*
*         6/BS,6/FM
*
*         WHERE  BS = BITS TO SET IN PARAMETER BLOCK TO INDICATE
*                     FILE MODE.
*                FM = FILE ACCESS MODE OBTAINED FROM THE *FNT*.
 
 
 TAFM     BSS    0
          LOC    0
          VFD    6/1,6/1     READ
          VFD    6/17,6/0    WRITE
          VFD    6/5,6/20    APPEND
          VFD    6/15,6/30   MODIFY
          VFD    6/61,6/31   READ/ALLOW MODIFY
          VFD    6/41,6/21   READ/ALLOW APPEND
          VFD    6/0,6/4     EXECUTE (INDIRECT ACCESS PERMANENT FILE)
          VFD    6/0,6/5     EXECUTE (DIRECT ACCESS PERMANENT FILE)
          VFD    6/11,6/10   UPDATE
          VFD    6/21,6/11   READ/ALLOW UPDATE
          LOC    *O
 TAFML    EQU    *-TAFM
 TAPK     SPACE  4,10
**        TAPK - TABLE OF PARAMETER BLOCK KEYS.
*
*T        12/ KEY, 12/ PRAD
*         KEY    *FILINFO* ADDITIONAL INFORMATION KEY
*         PRAD   KEY WORD PROCESSOR ADDRESS.
 
 
 TAPK     BSS    0
          LOC    0
          CON    FMTK,RFI34  FORMAT KEY
 TAPKE    EQU    *           ENTRY LENGTH
          CON    LTYK,RFI36  LABEL TYPE, DENSITY, CONVERSION MODE KEY
          CON    VSNK,RFI40  VSN, REEL NUMBER KEY
          CON    BSZK,RFI41  BLOCK SIZE, NOISE SIZE, OPTIONS KEY
          CON    DSVK,RFI49  DIRECT ACCESS FILE SIZE, ACCESS LEVEL
          CON    SPOD,RFI60  SPACE REMAINING ON OPTICAL DISK
          LOC    *O
 TAPKL    EQU    *-TAPK
 TDEN     SPACE  4,10
**        TDEN - TABLE OF DENSITY CONVERSIONS.
 
 
 TDEN     BSS    0
          LOC    1
          CON    2*10B       200 BPI
          CON    1*10B       556 BPI
          CON    3*10B       800 BPI/CPI
          CON    4*10B       1600 CPI
          CON    5*10B       6250 CPI
          CON    6*10B       38000 CPI
          LOC    *O
          SPACE  4,10
**        TMDS - TABLE OF DIRECT ACCESS FILE VALIDATION SIZES.
 
 TMDS     BSS    0
          LOC    0
          CSR    DSRNG7
          CSR    DSRNG1
          CSR    DSRNG2
          CSR    DSRNG3
          CSR    DSRNG4
          CSR    DSRNG5
          CSR    DSRNG6
          CSR    DSRNG7
          LOC    *O
          TITLE  SUBROUTINES.
 CDP      SPACE  4,10
**        CDP - CHECK FOR DMP= PROGRAM.
*
*         ENTRY  (A) = EST ENTRY ADDRESS.
*
*         ERROR  TO *ERR*, IF CALLING PROGRAM IS *DMP=*.
*
*         USES   CN - CN+4.
*
*         CALLS  CTE.
 
 
 CDP      SUBR               ENTRY/EXIT
          CRD    CN          READ EST ENTRY
          LDD    CN+3
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          PJN    CDP1        IF TAPE EQUIPMENT
          LDD    CN+3
          LMC    2RTE
          NJN    CDPX        IF NOT *TE* EQUIPMENT
 CDP1     AOM    RNME        SAVE TAPE STATUS
          LDD    CP          CHECK FOR *SPCW* BUSY
          ADC    SPCW
          CRD    CN
          LDD    CN
          ZJN    CDPX        IF DMP= REQUEST NOT ALREADY PRESENT
          LDN    /ERR/SYE    * SYSTEM ERROR.*
          LJM    ERR         PROCESS ERROR
 CFT      SPACE  4,10
**        CFT - CHECK FILE TYPE.
*
*         ENTRY  (CM - CM+4) = FNT WORD.
*
*         EXIT   (A) .NE. 0, IF INCORRECT FILE TYPE.
*                (RNMB) CHANGED IF RETAINING OLD FILE TYPE.
*
*         USES   T1, T7, CN - CN+4.
 
 
 CFT      SUBR               ENTRY/EXIT
          LDD    CM+4
          SHN    -6
          STD    T7
          LDN    TPFTL+1     SET TABLE LENGTH
          STD    T1
 CFT1     SOD    T1
          ZJN    CFTX        IF END OF TABLE
          LDM    TPFT-1,T1
          LMD    T7
          NJN    CFT1        IF NOT MATCHING FILE TYPE
 CFTA     LDN    0
*         LDN    (A)         (FILE TYPE OF *B*)
          LMN    LOFT
          ZJN    CFT2        IF LOCAL FILE TYPE
          LMD    T7
          LMN    LOFT
          NJN    CFTX        IF NOT SAME TYPE
 CFT2     LDC    **
 CFTB     EQU    *-1         (EST ORDINAL OF FILE *B*)
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CN
          LDD    CM+4        PROPAGATE FILE TYPE OF *A*
          SCN    77
          STM    RNMB
          LDD    CN
          SHN    0-13        GET MASS STORAGE FLAG
          LMN    1
          UJN    CFTX        RETURN
 TPFT     SPACE  4,10
**        TPFT - TABLE OF PROPAGATED FILE TYPES.
 
 
 TPFT     BSS    0
          CON    PTFT        PRIMARY TERMINAL
 TPFTL    EQU    *-TPFT      TABLE LENGTH
 CTE      SPACE  4,10
**        CTE - CHECK FOR TAPE EQUIPMENT.
*
*         ENTRY  (A) = EQUIPMENT MNEMONIC.
*
*         EXIT   (A) < 0 IF NOT TAPE EQUIPMENT.
*                    = 0 IF *MT*.
*                    = 1 IF *CT*.
*                    = 2 IF *NT*.
*                    = 3 IF *AT*.
 
 
 CTE3     LCN    1           INDICATE NON-TAPE EQUIPMENT
 
 CTE      SUBR               ENTRY/EXIT
          LMC    2RMT
          ZJN    CTEX        IF *MT* (*MT* = 0)
          LMC    2RNT&2RMT
          ZJN    CTE1        IF *NT*
          LMC    2RCT&2RNT
          ZJN    CTE2        IF *CT*
          LMC    2RAT&2RCT
          NJN    CTE3        IF NOT *AT*
          LDN    1           *AT* = 3
 CTE1     ADN    1           *NT* = 2
 CTE2     ADN    1           *CT* = 1
          UJN    CTEX        RETURN
 TAI      SPACE  4,15
**        TAI - TRANSFER ADDITIONAL INFORMATION FROM UDT.
*
*         ENTRY  (SX) = EXTENDED FILE STATUS.
*
*         EXIT   (A) = 0, IF NOT TAPE FILE.
*                (FIPB) = UDT WORDS *UST2*, *UST3*, *UST4*, *UST5*,
*                         *UVRI* IF TAPE FILE.
*
*         USES   T1.
*
*         CALLS  TUW.
 
 
 TAI      SUBR               ENTRY/EXIT
          LDD    SX
          LPN    1
          ZJN    TAIX        IF NOT TAPE FILE
 TAIA     LDN    0           UDT WORDS NOT YET TRANSFERRED
*         LDN    1           (UDT WORDS ALREADY TRANSFERRED)
          NJN    TAIX        IF ADDITIONAL INFORMATION TRANSFERRED
          LDN    /MTX/UST2   GET UST2, UST3, UST4, UST5 FROM UDT
          STD    T1
          LDN    4           TRANSFER UDT WORDS
          RJM    TUW
          LDN    4           SET WORD COUNT
          STD    T1
          LDD    MA
          CRM    FIPB,T1     READ UDT WORDS
          LDK    /MTX/UVRI   SET UDT WORD TO READ
          STD    T1
          LDN    1           SET WORD COUNT
          RJM    TUW         TRANSFER UDT WORD
          LDD    MA
          CRM    FIPB+4*5,ON READ UDT WORD
          AOM    TAIA        SET UDT WORDS TRANSFERRED FLAG
          UJN    TAIX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPRJC
*CALL     COMPSOF
 VAL$     SET    0
*CALL     COMPVLC
          SPACE  4,10
**        BUFFER ASSIGNMENTS.
 
 
 FIPB     EQU    *           *FILINFO* PARAMETER BLOCK BUFFER
          LOC    FIPB+FIPBL*5-1*5
          SPACE  4,10
          ERRNG  OVL0-*      CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
          OVERFLOW  OVL
          OVERLAY (EQUIPMENT REQUESTS.)
          SPACE  4,10
****      ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
 
 
 VS       EQU    60 - 64     VSN BUFFER (5 LOCATIONS)
 
****
 REQ      SPACE  4,20
***       FUNCTION 14.
*         REQUEST EQUIPMENT.
*
*T FET+1  12/*EQ*, 48/
*         EQ     EQUIPMENT TYPE.
*
*T FET+7  6/*ID*, 54/
*         ID     CHECKPOINT MODE ID
*                CBID = 75B = CHECKPOINT AT BOI.
*                CKID = 76B = CHECKPOINT AT EOI.
*
*         REQUEST OPERATOR EQUIPMENT ASSIGNMENT TO FILE.
*         IF THE FILE WAS PREVIOUSLY ASSIGNED, FUNCTION IS IGNORED.
*         REQUEST FUNCTION 14 CANNOT BE USED TO ASSIGN TAPE EQUIPMENT.
*         IF *EQ* .NE. 0, EQUIPMENT ASSIGNMENT MUST BE THIS TYPE.
*         IF *EQ* = *MS*, A MASS STORAGE DEVICE MUST BE ASSIGNED.
*         IF *EQ* = *MT*, *NT*, *CT*, *AT* OR *TE*, THE ERROR MESSAGE
*           * INCORRECT EQUIPMENT.* WILL BE ISSUED.
*         FOR REQUEST WITH *EQ* = 0, OPERATOR ASSIGNMENT OF TAPE
*           EQUIPMENT (*MT*, *NT*, *CT*, *AT*, *TE*) WILL BE REJECTED.
 
 
          ENTRY  REQ
          RJM    CPA         READ FIRST
          ADN    1
          CRD    CN
          RJM    GVA         GET AND VALIDATE ACCESS LEVEL
          LDD    CN          CHECK TYPE
          ZJN    REQ3        IF TYPE NOT REQUESTED
 
*         IF EQUIPMENT TYPE IS REQUESTED, CHECK VALIDITY OF TYPE.
 
          LMC    2RMS
          ZJN    REQ3        IF EQUIPMENT TYPE = *MS*
          LDD    CN
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          MJN    REQ2        IF NOT TAPE EQUIPMENT
 REQ1     LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          LJM    ERR         PROCESS ERROR
 
 REQ2     RJM    SEQ         SEARCH FOR EQUIPMENT
 
*         REQUEST OPERATOR ASSIGNMENT.
 
 REQ3     LDN    1
 REQ4     RJM    REA         REQUEST EQUIPMENT ASSIGNMENT
          PJN    REQ4        IF TAPE RELATED EQUIPMENT
          LDD    EQ          RESET OPERATOR EQUIPMENT IF ENTER RECALL
          STM    EFNA
          LDD    FS
          SHN    21-13
          MJN    REQ6        IF MASS STORAGE
          SHN    21-12-21+13
          MJN    REQ5        IF ALLOCATABLE DEVICE
          RJM    VAE         VALIDATE ASSIGNED EQUIPMENT
          UJN    REQ6        ASSIGN FILE
 
 REQ5     RJM    DEQ         RELEASE EQUIPMENT
 REQ6     LJM    ASF         ASSIGN FILE
 AEQ      SPACE  4,25
***       FUNCTION 15.
*         ASSIGN EQUIPMENT.
*
*T FET+1  12/*EQ*, 48/
*         EQ     EQUIPMENT TYPE, *MSAL* DEVICE TYPE, OR DESIRED
*                EST ORDINAL + 7000B.
*
*T FET+7  6/*ID*, 54/
*         ID     CHECKPOINT MODE ID
*                CBID = 75B = CHECKPOINT AT BOI.
*                CKID = 76B = CHECKPOINT AT EOI.
*
*         REQUEST FUNCTION 15 CANNOT BE USED TO ASSIGN TAPE EQUIPMENT.
*         FOR REQUEST WITH *EQ* = *MT*, *NT*, *CT*, *AT* OR *TE* DEVICE
*         TYPE OR SPECIFYING EST ORDINAL OF TAPE RELATED EQUIPMENT,
*         ERROR MESSAGE * INCORRECT EQUIPMENT.* WILL BE ISSUED.
*
*         NO SPECIAL VALIDATION IS REQUIRED TO ASSIGN TT (FROM TXOT
*         ORIGIN), NE OR CC EQUIPMENT OR MASS STORAGE FILE TYPES MS,
*         TP, IN, OT, PY, LO OR LG.
*         NO SPECIAL USER VALIDATION IS REQUIRED WHEN USING MASS
*         STORAGE DEVICE MNEMONICS.  THE MASS STORAGE DEVICE MUST BE
*         A TEMP DEVICE.
*         OTHER REQUESTS ARE VALID ONLY FROM SYSTEM ORIGIN OR TO A
*         USER WHO HAS SYSTEM ORIGIN PRIVILEGES.  SEE TABLE *TAEQ*.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
 
 
          ENTRY  AEQ
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    AEQ1        IF FILE NOT FOUND
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LDN    /ERR/DFN    * DUPLICATE FILE NAME.*
          LJM    ERR         PROCESS ERROR
 
*         CHECK DEVICE SPECIFICATION IN FET.
 
 AEQ1     RJM    CPA         READ FIRST
          ADN    1
          CRD    CN
          RJM    GVA         GET AND VALIDATE ACCESS LEVEL
          LDD    CN          CHECK EQUIPMENT TYPE
          SHN    -11
          LMN    7
          ZJN    AEQ6        IF ASSIGN-BY-ORDINAL REQUEST
 
*         PROCESS DEVICE MNEMONIC.
 
          LDD    CN
          LMC    2RMS
          NJN    AEQ3        IF NOT MASS STORAGE
          STM    ASFA        CLEAR *MSAL* FLAGS
          LDN    NEEQ
          STD    EQ          ASSIGN MASS STORAGE
          LDD    CN          SET CORRECT DAYFILE MESSAGE
          STM    ASFC+1
          AOM    ASFB
 AEQ2     LJM    ASF         ASSIGN FILE
 
 AEQ3     RJM    SEQ         SEARCH FOR EQUIPMENT
          MJN    AEQ2        IF *MSAL* REQUEST
          ZJN    AEQ7        IF EQUIPMENT AVAILABLE
 AEQ4     LDN    /ERR/WEQ    * EQUIPMENT NOT AVAILABLE.*
 AEQ5     LJM    ERR         PROCESS ERROR
 
*         PROCESS EST ORDINAL.
 
 AEQ6     RJM    VSO         VALIDATE SYSTEM ORIGIN PRIVILEGE
          NJN    AEQ9.1      IF USER NOT VALIDATED FOR ASSIGN BY ORDINAL
          LDD    CN          SET EST ORDINAL
          LPC    777
          STD    EQ
          RJM    CEN         CHECK EST ORDINAL
          NJN    AEQ4        IF NOT AVAILABLE
 AEQ7     LDD    FS+3
          STD    T2
          LMC    2RTT
          NJN    AEQ9        IF NOT *TT*
          LDD    OC
          LMK    IAOT
          ZJN    AEQ10       IF INTERACTIVE
 AEQ8     LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          UJN    AEQ5        PROCESS ERROR
 
 AEQ9     RJM    CDT         CHECK DEVICE TYPE
          ZJN    AEQ10       IF DEVICE TYPE ALLOWED
          RJM    VSO         VALIDATE SYSTEM ORIGIN
 AEQ9.1   NJP    VSJ1        IF USER NOT VALIDATED
          LDD    EQ
          RJM    VTE         CHECK FOR TAPE EQUIPMENT
          PJN    AEQ8        IF TAPE RELATED EQUIPMENT
 AEQ10    LDD    FS
          SHN    21-13
          MJN    AEQ11       IF MASS STORAGE
          SHN    21-12-21+13
          MJN    AEQ11       IF ALLOCATABLE
          LDD    EQ          REQUEST EQUIPMENT
          STD    CM+1
          LDK    REQS        REQUEST ACTIVE EQUIPMENT
          STD    CM+2
          MONITOR REQM
          LDD    CM+1        CHECK ASSIGNMENT
          NJN    AEQ11       IF ASSIGNMENT MADE
          LJM    AEQ4        EQUIPMENT NOT AVAILABLE
 
 AEQ11    LJM    ASF         ASSIGN FILE
 LBR      EJECT
***       FUNCTION 24.
*         LABEL TAPE REQUEST.
*         REQUEST AUTOMATIC ASSIGNMENT OF MAGNETIC TAPE BY VOLUME
*         SERIAL NUMBER.
*         IF THE FILE WAS PREVIOUSLY ASSIGNED, FUNCTION IS IGNORED.
*
*T  FET+1 12/EQ,48/
*         EQ     DEVICE TYPE (*MT*, *NT*, *CT*, *AT*, OR ZERO)
*
*T  FET+7 6/ID,54/
*         ID     CHECKPOINT ID, IF TO BE SET ON FILE
*                CBID = 75B = CHECKPOINT AT BOI.
*                CKID = 76B = CHECKPOINT AT EOI.
*
*T  FET+10B 1/R,1/L,1/N,2/TT,1/,3/D,3/CV,12/PO,6/F,6/NS,24/FC
*         R      LABEL PROCESSING
*                0 = READ LABEL   FILE OPENED BY OPEN/ALTER
*                1 = WRITE LABEL  FILE OPENED BY OPEN/WRITE
*
*         L      NOS LABELED IF SET
*
*         N      NON-STANDARD LABELS IF SET
*
*         TT     TAPE DEVICE TYPE
*                0 = 7-TRACK TAPE.
*                1 = CARTRIDGE TAPE.
*                2 = 9-TRACK TAPE.
*                3 = ACS CARTRIDGE TAPE.
*
*         D      DENSITY
*                0 = INSTALLATION DEFAULT
*                1 = 556 BPI
*                2 = 200 BPI
*                3 = 800 BPI/CPI
*                4 = 1600 CPI
*                5 = 6250 CPI
*                6 = 38000 CPI
*
*         CV     CONVERSION MODE
*                0 = INSTALLATION DEFAULT
*                1 = USASI/ASCII CONVERSION 9 TRACK
*                2 = EBCDIC CONVERSION 9 TRACK
*
*         PO     PROCESSING OPTIONS
*                XXX0 = ABORT ON P.E. UNLESS E.P. SET
*                XXX1 = ABORT ON P.E. REGARDLESS OF E.P.
*                XXX2 = NO ABORT ON P.E.
*                XXX4 = INHIBIT ERROR PROCESSING
*                XX1X = ENFORCE RING OUT
*                XX2X = ENFORCE RING IN
*                XX4X = INHIBIT UNLOAD
*                X1XX = TOGGLE INSTALLATION SETTING TO ENABLE/DISABLE
*                       GCR HARDWARE WRITE ERROR CORRECTION
*                X2XX = TOGGLE INSTALLATION SETTING TO ENABLE/DISABLE
*                       ISSUING OF ERROR MESSAGES TO USER DAYFILE
*                0XXX = DEFAULT EOT OPTION SELECTED ACCORDING TO
*                       LABEL AND FORMAT SPECIFICATION
*                1XXX = STOP ON TAPE MARK AFTER EOT (UNLABELED)
*                1XXX = STOP ON TAPE MARK PLUS LABELS (LABELED)
*                2XXX = ACCEPT BLOCK IN PROGRESS ON EOT
*                4XXX = INGORE BLOCK IN PROGRESS ON EOT
*
*         F      DATA FORMAT
*                0 = INTERNAL BINARY
*                1 = NOS/BE INTERNAL BINARY
*                2 = FOREIGN
*                3 = STRANGER
*                4 = LONG BLOCK STRANGER
*                5 = LONG BLOCK INTERNAL BINARY
*
*         NS     NOISE SIZE IN FRAMES
*
*         FS     BLOCK SIZE IN FRAMES
*
*T  FET+11B 36/VSN,6/A,3/0,15/SN
*         VSN    6 CHARACTER VOLUME SERIAL NUMBER  (SPACE FILLED)
*         A      1 CHARACTER ACCESSIBILITY  (DEFAULT = * *)
*         SN     FILE SECTION NUMBER  (DEFAULT = 0001)
*
*T  FET+12B 60/FI
*         FI     FIRST 10 CHARACTERS OF FILE IDENTIFIER
*
*T  FET+13B 42/FI,3/0,15/QN
*         FI     LAST 7 CHARACTERS OF FILE IDENTIFIER  (SPACE FILLED)
*         QN     FILE SEQUENCE NUMBER  (DEFAULT = 0001)
*
*T  FET+14B 36/SI,9/E,15/G
*         SI     6 CHARACTER MULTI-SET IDENTIFIER  (SPACE FILLED)
*         E      GENERATION VERSION NUMBER  (DEFAULT = 00)
*         G      GENERATION NUMBER  (DEFAULT = 0001)
*
*T  FET+15B 30/RTD,30/CRD
*         RTD    RETENTION DATE (JULIAN)  (DEFAULT = TODAY)
*         CRD    CREATION DATE (JULIAN)  (DEFAULT = TODAY)
*
*         FOR AUTOMATIC ASSIGNMENT, A VOLUME SERIAL NUMBER MUST BE
*         SUPPLIED EITHER THROUGH A *VSN* COMMAND OR BY THE VSN
*         FIELD IN FET+11B.  IF THE VSN FIELD IN FET+11B IS ZERO
*         AND NO VSN IS SPECIFIED, THE OPERATOR IS REQUESTED TO
*         MAKE THE APPROPRIATE EQUIPMENT ASSIGNMENT.
 
 
 
 
          ENTRY  LBR
          LDD    CP          CHECK FOR *SPCW* BUSY
          ADC    SPCW
          CRD    CN
          LDD    CN
          NJN    LBR1        IF DMP= REQUEST ALREADY PRESENT
          STD    CM+1        CALL *RESEX*
          MONITOR ROCM       ROLLOUT JOB
          LDD    IA          READ REQUEST
          CRD    CM
          LDD    CM+1
          SCN    77
          ADN    20          SET RECALL PP PROCESSOR BIT
          STD    CM+1
          LDD    RA          REWRITE USER CALL
          SHN    6
          ADN    1
          CWD    CM
          LDD    CM+2        CLEAR UNUSED FIELDS
          LPN    77
          STD    CM+2
          LDD    CM+3
          LPN    77
          STD    CM+3
          LDD    CP          ENTER EXTERNAL CALL
          ADC    SPCW
          CWD    CM
          LJM    DPP         DROP PPU
 
 LBR1     LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LDN    /ERR/SYE    * SYSTEM ERROR.*
          LJM    ERR         PROCESS ERROR
 OAE      SPACE  4,25
***       FUNCTION 26.
*         REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT.
*
*T FET+1  12/*EQ*, 12/, 12/*DD*, 24/
*         EQ     DEVICE TYPE (*MT*, *NT*, *CT*, *AT*,
*                  OR ZERO = ANY EQUIPMENT)
*         DD     DENSITY DISPLAY (*HD*, *PE*, *GE*) IF *EQ* = *NT*
*
*T FET+7  6/*ID*, 48/
*         ID     CHECKPOINT ID, IF TO BE SET ON NON-MAGNETIC TAPE FILE
*                CBID = 75B = CHECKPOINT AT BOI.
*                CKID = 76B = CHECKPOINT AT EOI.
*
*T FET+11B 36/*VSN*, 24/
*         VSN    DUPLICATE VSN CHOICE TO BE DISPLAYED IN OPERATOR
*                REQUEST MESSAGE (FOR FP=1 FUNCTION ONLY)
*
*         EXIT   *EQ* = DEVICE TYPE OF ASSIGNED EQUIPMENT.
*                *DD* = EST ORDINAL OF ASSIGNED UNIT IF TAPE EQUIPMENT.
*
*         THIS FUNCTION IS CALLED BY *RESEX* TO GET THE OPERATOR
*         TO MAKE AN EQUIPMENT ASSIGNMENT.
*
*         CALLER MUST HAVE SSJ= ENTRY POINT SET.
 
 
          ENTRY  OAE
          RJM    VSJ         VALIDATE SSJ=
          RJM    SVF         SEARCH FOR VSN FILE
          ZJN    OAE2        IF VSN FILE OR NO ENTRY
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LDN    /ERR/DFN    DUPLICATE FILE
 OAE1     LJM    ERR         PROCESS ERROR
 
 OAE2     LDD    FA
          ZJN    OAE3        IF NO ENTRY
          RJM    SFB         SET FILE BUSY
          ZJN    OAE3        IF NO REJECT ON FILE INTERLOCK
          LDN    /ERR/IOE    * I/O SEQUENCE ERROR.*
          UJN    OAE1        PROCESS ERROR
 
 OAE3     RJM    CPA         READ FIRST
          ADN    1
          CRD    CN
          ADN    10          READ VSN FROM FET+11B
          CRD    VS
          RJM    GVA         GET AND VALIDATE ACCESS LEVEL
          LDD    FP
          LPN    1
          NJN    OAE4        IF OPERATOR ASSIGNMENT ON DUPLICATE VSN
          STD    VS
 OAE4     LDD    CN
          ZJN    OAE6        IF NO EQUIPMENT SPECIFIED
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          ZJN    OAE5        IF TAPE EQUIPMENT
          LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          UJN    OAE1        PROCESS ERROR
 
 OAE5     RJM    SEQ         SEARCH FOR EQUIPMENT
 
*         REQUEST OPERATOR ASSIGNMENT.
 
 OAE6     LDN    1
          RJM    REA         REQUEST EQUIPMENT ASSIGNMENT
          ZJN    OAE9        IF TAPE EQUIPMENT (MT, NT, CT OR AT)
          LDD    EQ          RESET OPERATOR EQUIPMENT IF ENTER RECALL
          STM    EFNA
          LDD    FS
          SHN    21-13
          MJN    OAE8        IF MASS STORAGE
          SHN    21-12-21+13
          MJN    OAE7        IF ALLOCATABLE DEVICE
          RJM    VAE         VALIDATE ASSIGNED EQUIPMENT
          UJN    OAE8        ASSIGN FILE
 
 OAE7     RJM    DEQ         RELEASE EQUIPMENT
 OAE8     LJM    ASF         ASSIGN FILE
 
*         RETURN TAPE EQUIPMENT.
 
 OAE9     STD    CM          CLEAR REQUEST MESSAGE
          LDD    CP
          ADN    MS2W
          CWD    CM
          LDN    0           CLEAR PAUSE BIT
          RJM    SPB
          RJM    DEQ         RELEASE TAPE EQUIPMENT
          LDD    FS+3        RETURN DEVICE TYPE IN FET
          STD    CN
          LDD    EQ
          STD    CN+2
          RJM    CPA         READ FET+1
          ADN    1
          CWD    CN
          LDD    FA
          ZJN    OAE10       IF NO FNT/FST ENTRY
          NFA    FA,R
          ADN    FSTL
          CRD    FS          READ FST ENTRY
 OAE10    LJM    LFMX        RETURN
 VSN      SPACE  4,30
***       FUNCTION 27.
*         BUILD TAPE FILE FNT/FST.
*
*         ASSIGNMENT OPERATIONS.
*T FET+10 1/R,11/EQ,12/UDT,4/FM,20/0,1/L,11/0
*
*         VSN OPERATIONS.
*T FET+10 30/0,18/VSN,12/0
*
*         R      RELEASE TAPE EQUIPMENT (REASSIGN TO *TE*)
*
*         EQ     EST ORDINAL
*
*         UDT    MAGNET UNIT DESCRIPTOR TABLE ADDRESS
*
*         FM     FORMAT
*
*         L      LABEL BIT
*
*         VSN    VSNFILE RANDOM INDEX
*
*         CALLER MUST HAVE SSJ= ENTRY POINT SET.
*
*         ENTRY  (FN - FN+3) = FILE NAME FROM FET+0.
*                (FF) = FET SPECIFIED FNT ADDRESS.
*
*         EXIT   FET+10B CLEARED IF REQUEST CANNOT BE SATISFIED.
*                TO ERR IF LOCAL FILE LIMIT EXCEEDED.
 
 
          ENTRY  VSN
          RJM    VSJ         VALIDATE SSJ=
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          LDD    FA          SET FILE BUSY
          ZJP    VSN3        IF FILE NOT LOCAL
          RJM    SFB         SET FILE BUSY
          ZJN    VSN1        IF NO REJECT ON FILE INTERLOCK
          LDN    /ERR/IOE    *I/O SEQUENCE ERROR
          LJM    ERR         PROCESS ERROR
 
 
*         VALIDATE ENTRY.
 
 VSN1     LDD    FS
          RJM    VTE         VERIFY TAPE ENTRY
          MJN    VSN2        IF NOT TAPE FILE
          STD    T1          SAVE ENTRY STATUS
          RJM    CPA         READ FET+1
          ADN    1
          CRD    CN
          RJM    GVA         GET AND VALIDATE ACCESS LEVEL
          LDD    AL
          ZJN    VSN1.1      IF *AL* NOT SPECIFIED
          NFA    FA,R        SET ACCESS LEVEL IN FNT
          ADN    FUTL
          CRD    CN
          LDD    AL
          LPN    7
          LMD    CN+2
          LPN    7
          LMD    CN+2
          STD    CN+2
          NFA    FA,R
          ADN    FUTL
          CWD    CN
 VSN1.1   UJN    VSN4        CONTINUE
 
 VSN2     LDN    /ERR/DFN    *DUPLICATE FILE NAME.*
          LJM    ERR         PROCESS ERROR
 
 VSN3     LDN    TEEQ        ASSIGN TO *TE* EQUIPMENT
          STD    EQ
          RJM    CPA         READ FET+1
          ADN    1
          CRD    CN
          RJM    GVA         GET AND VALIDATE ACCESS LEVEL
          RJM    CLF         CREATE LOCAL FILE
          LDN    1           SET VSN STATUS
          STD    T1
 VSN4     RJM    CPA         READ FET+10
          ADN    10
          CRD    CN
          LDD    CN          CHECK TYPE OF OPERATION
          NJN    VSN6        IF ENTERING ASSIGNMENT INFORMATION
          LDD    FS+2        CHECK FOR VSN INDEX PRESENT
          LPN    77
          SHN    14
          LMD    FS+3
          NJN    VSN2        IF VSN INDEX ALREADY ENTERED
          LDD    FS+2        ENTER VSN INDEX
          SCN    77
          STD    FS+2
          LDD    CN+2
          LPN    77
          RAD    FS+2
          LDD    CN+3
          STD    FS+3
 VSN5     LJM    LFMX        EXIT
 
 VSN6     LDD    T1          CHECK ENTRY STATUS
          NJN    VSN7        IF VSN ENTRY PRESENT
          LDD    CN
          LPC    777
          STD    CN
          LMD    FS
          NJN    VSN8        IF EQUIPMENTS DO NOT MATCH
          LDD    CN
          STD    EQ
          UJN    VSN10       ENTER UDT ADDRESS
 
 VSN7     LDD    CN          VALIDATE EQUIPMENT TO BE ASSIGNED
          RJM    VTE         VERIFY TAPE EQUIPMENT
          ZJN    VSN9        IF TAPE EQUIPMENT
 VSN8     LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          LJM    ERR         PROCESS ERROR
 
 VSN9     LDD    CN          ENTER EQUIPMENT
          STD    CM+1        RESERVE EQUIPMENT
          LDK    REQS        REQUEST ACTIVE EQUIPMENT
          STD    CM+2
          MONITOR REQM
          LDD    CM+1
          ZJN    VSN11       IF NOT RESERVED
          LDD    CN          SET EST ORDINAL
          STD    FS
 VSN10    LDD    CN+1        ENTER UDT ADDRESS
          STD    FS+1
          LDD    FS+2
          LPN    77
          STD    FS+2
          LDD    CN+2        ENTER FORMAT
          LPC    7400
          RAD    FS+2
          LDD    CN+4        ENTER LABEL BIT
          LPC    4000
          RAD    FS+4
          UJN    VSN12       EXIT
 
 VSN11    LDN    ZERL        CLEAR FET+10
          CRD    CN
          RJM    CPA
          ADN    10
          CWD    CN
 VSN12    LJM    LFMX        EXIT
 ASF      SPACE  4,15
**        ASF - ASSIGN NON-TAPE FILE.
*
*         ENTRY  (EQ) = EST ORDINAL.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
*         EXIT   (FA) = ADDRESS OF FNT ENTRY.
*                (FN - FN+4) = FILE NAME.
*                (FS - FS+4) = FST ENTRY.
*
*         USES   CN, EQ, FN+3, FS, FS+1, T1, T4, CM - CM+4.
*
*         CALLS  ACS, CLF, CPA, C2D, DFM, STB, UPC.
*
*         MACROS MONITOR, NFA, SFA.
 
 
 ASF      BSS    0           ENTRY
          LDD    TH          REQUEST ASSIGNMENT OF EQUIPMENT
          RAD    EQ
          RJM    CLF         CREATE LOCAL FILE
          LDN    ZERL
          CRD    CM
          LDC    7777        CHECK FOR ASSIGNMENT OF *MSAL* DEVICE
 ASFA     EQU    *-1         (*MSAL* CODE - SET BY *SEQ*)
          STD    CM+2
          SHN    21-13
          MJN    ASF1        IF NOT *MSAL* DEVICE
          LDD    AL          PASS ACCESS LEVEL TO *RTCM*
          LPN    7
          LMN    40
          SHN    6
          STD    CM+3
          MONITOR  RTCM      ASSIGN MASS STORAGE SPACE
          LDD    CM+1        SET EST ORDINAL IN FST
          LPC    777
          STD    FS
          LDD    CM+4        SET FIRST TRACK IN FST
          STD    FS+1
          NFA    FA,R        REWRITE FST
          ADN    FSTL
          CWD    FS
 ASF1     LDD    FS          FETCH EST ENTRY
          STD    EQ
          LPC    777
          ZJP    ASF1.1      IF NO EQUIPMENT ASSIGNED
          LDD    EQ
          SFA    EST         SET EQUIPMENT TYPE
          ADK    EQDE
          CRD    CM
          LDD    CM+3
          STM    ASFC
          STD    CN          SET EQUIPMENT TYPE
          LDD    CM          CHECK FOR MASS STORAGE
          SHN    6
          PJP    ASF2        IF NOT MASS STORAGE
          LDD    FS+1
          ZJN    ASF1.0      IF NO TRACKS ASSIGNED
          RJM    UPC         UPDATE PRU COUNTER
          LJM    ASF3        CONTINUE PROCESSING
 
 ASF1.0   LDD    EQ          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3
          RJM    C2D
          STM    ASFF+1
          LDD    EQ          CONVERT LOWER DIGIT OF EST ORDINAL
          LPN    7
          SHN    6
          ADC    2R0,
          STM    ASFF+2
          LDC    ASFF        *EQXXX, TRACK LIMIT.*
          UJN    ASF1.2      PROCESS TRACK LIMIT
 
 ASF1.1   LDD    CM+3        CHECK *RTCM* REJECT REASON CODE
          LMN    2
          ZJN    ASF1.3      IF REJECT BECAUSE OF ACCESS LEVEL
          LDC    ASFF+3      * TRACK LIMIT.*
 ASF1.2   STD    T7          SAVE MESSAGE ADDRESS
          LDN    /ERR/NMA
          LJM    RCL         RECALL *LFM*
 
 ASF1.3   LDN    /ERR/WEQ    * EQUIPMENT NOT AVAILABLE.*
          LJM    ERR         ABORT
 
 ASF2     LDC    4000        SET NON-MASS STORAGE BIT
          RAD    CN
 ASF3     LDN    0           CLEAR CONSOLE MESSAGE
          STD    CM
          LDD    CP
          ADN    MS2W
          CWD    CM
          RJM    CPA         STORE FIRST
          ADN    1
          CWD    CN
          ADN    4-1         GET FET+4
          CRD    CM
          LDD    FA          SET FNT ADDRESS INTO FET+4
          STD    CM
          RJM    CPA         COMPUTE PARAMETER ADDRESS
          ADN    4
          CWD    CM
          LDD    FE
          SBN    7
          MJN    ASF5        IF FET NOT LONG ENOUGH
          RJM    CPA         COMPUTE PARAMETER ADDRESS
          ADN    7
          CRD    CM
          LDD    CM          GET CHECKPOINT ID
          SHN    -6
          LMN    CBID
          ZJN    ASF4        IF CHECKPOINT BOI ID
          LMN    CKID&CBID   CHECK FOR CHECKPOINT EOI ID
          NJN    ASF5        IF NOT VALID ID
          LDN    CKST&CBST   SET CHECKPOINT AT EOI FILE STATUS
 ASF4     LMN    CBST
          STD    T1
          NFA    FA,R        SET CHECKPOINT ID STATUS IN FNT
          CRD    CN
          LDD    CN+4
          SCN    77
          ADD    T1
          STD    CN+4
          NFA    FA,R
          CWD    CN
 ASF5     LDN    0           CLEAR PAUSE BIT
          RJM    SPB
          LDD    FP
          SHN    21-1
          MJP    LFMX        IF NO DAYFILE MESSAGE TO BE ISSUED
          LDM    ASFC+1
          NJN    ASF7        IF MESSAGE FIELD ALREADY SET
          LDD    EQ          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3
          RJM    C2D
          STM    ASFC+1
          LDD    EQ          CONVERT LOWER DIGIT OF EST ORDINAL
          LPN    7
          ADN    1R0
          SHN    6
          STM    ASFC+2
 ASF7     LDC    ASFC+2      SET BUFFER ADDRESS
          STD    T1
          LDC    =C*, ASSIGNED TO *
          RJM    ACS
          LDD    FN+3
          SCN    77
          STD    FN+3
          LDN    FN          ADD FILENAME TO MESSAGE
          RJM    ACS
          LDC    =C*.*       TERMINATE MESSAGE
          RJM    ACS
          LDC    ASFC        SEND ASSIGNMENT MESSAGE
*         LDC    ASFC+1      (*MSAL* TYPE ASSIGNMENT)
 ASFB     EQU    *-1
          RJM    DFM         ISSUE DAYFILE MESSAGE
          LJM    LFMX        EXIT
 
 
 ASFC     BSSZ   15          MESSAGE BUILD AREA
 ASFF     DATA   C*EQXXX, TRACK LIMIT.*
 CDT      SPACE  4,20
**        CDT - CHECK DEVICE TYPE.
*
*         ENTRY  (T2) = DEVICE TYPE TO CHECK FOR.
*
*         EXIT   (A) = 0, IF DEVICE TYPE FOUND IN TABLE.
*                (A) .NE. 0 IF NOT FOUND.
*
*         USES   T1.
 
 
 CDT2     LCN    0           SET NOT FOUND STATUS
 
 CDT      SUBR               ENTRY/EXIT
          LDN    0
          STD    T1
 CDT1     LDM    CDTA,T1     GET NEXT TABLE ENTRY
          ZJN    CDT2        IF END OF TABLE
          LMD    T2
          ZJN    CDTX        IF MATCH
          AOD    T1
          UJN    CDT1        CHECK NEXT ENTRY
 
 
 
**        TBLM - DEFINE MACRO TO PRODUCE *CDTA* TABLE.
*
*T        12/2R_EQT
 
 
          PURGMAC  TBLM
 TBLM     MACRO  EQT
          CON    2R_EQT
 TBLM     ENDM
 
 
          LIST   G
 CDTA     BSS    0
          TBL    "MSEQ"
          CON    2RTT
          CON    2RNE
          CON    2RCC
          CON    2ROD        OPTICAL DISK
          LIST   *
 
          CON    0           END OF TABLE
          TITLE  SUBROUTINES.
 CEA      SPACE  4,10
**        CEA - CHECK EQUIPMENT ACCESS LEVELS.
*
*         ENTRY  (EQ) = EST ORDINAL.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
*         EXIT   (A) = 0 IF ACCESS LEVEL IN RANGE FOR EQUIPMENT.
*
*         USES   CM+1, CM+2, CM+4.
*
*         MACROS MONITOR.
 
 
 CEA      SUBR               ENTRY/EXIT
          LDD    AL          GET ACCESS LEVEL
          ZJN    CEAX        IF SYSTEM IS UNSECURED
          LPN    7           ACCESS LEVEL
          STD    CM+4
          LDN    VAES        SET SUBFUNCTION CODE
          STD    CM+1
          LDD    EQ          EST ORDINAL
          STD    CM+2
          MONITOR  VSAM      VALIDATE EQUIPMENT ACCESS LEVELS
          LDD    CM+1        GET REPLY
          UJN    CEAX        RETURN
 CEN      SPACE  4,15
**        CEN - CHECK EST ORDINAL.
*
*         ENTRY  (EQ) = EST ORDINAL.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
*         EXIT   (A) = 0 IF AVALIABLE.
*                (FS - FS+4) = EST ENTRY.
*
*         USES   T1, T2, T3, CM - CM+4, FS - FS+4.
*
*         CALLS  CEA, CSJ.
*
*         MACROS SFA.
 
 
 CEN      SUBR               ENTRY/EXIT
          LDN    ESTP        READ EST POINTER
          CRD    CM
          LDD    EQ
          ZJN    CEN2        IF EQUIPMENT 0
          SBD    CM+2
          PJN    CEN2        IF NOT IN LEGAL EST RANGE
          SFA    EST,EQ      READ EST ENTRY
          ADK    EQDE
          CRD    FS
          LDD    FS+3
          ZJN    CEN2        IF EQUIPMENT NOT DEFINED
          LDC    TAEQ+TAEQM-1  SET START OF TABLE
          STD    T2
          ADN    TAEQL-TAEQM+1  SET END OF TABLE
          STD    T3
 CEN1     AOD    T2          SEARCH FOR INCORRECT EQUIPMENT
          LMD    T3
          ZJN    CEN3        IF END OF TABLE
          LDI    T2
          LMD    FS+3
          NJN    CEN1        IF NOT INCORRECT EQUIPMENT
 CEN2     LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          LJM    ERR         PROCESS ERROR
 
 CEN3     LDD    FS          CHECK EQUIPMENT STATUS
          SHN    21-13
          PJN    CEN5        IF NOT MASS STORAGE
          SHN    13-10
          PJN    CEN4        IF NOT REMOVABLE DEVICE
          RJM    CSJ         CHECK FOR SSJ= ENTRY POINT
          PJN    CEN2        IF JOB NOT SYSTEM ORIGIN
 CEN4     LDD    FS
          SHN    21-6
          MJN    CEN2        IF DEVICE UNAVAILABLE
          SHN    6-1
          MJN    CEN2        IF DEVICE OFF
          RJM    CEA         CHECK EQUIPMENT ACCESS LEVELS
          UJN    CEN6        RETURN WITH EQUIPMENT AVAILABLE STATUS
 
 CEN5     SHN    0-12-21+13
          LMN    1
          ZJN    CEN6        IF ALLOCATABLE DEVICE
          RJM    CEA         CHECK EQUIPMENT ACCESS LEVELS
          NJN    CEN6        IF ACCESS LEVEL OUT OF RANGE
          SFA    EST,EQ      CHECK EQUIPMENT ASSIGNMENT
          ADK    EQAE
          CRD    CM
          LDD    CM+4        RETURN WITH JOB ASSIGNMENT STATUS
 CEN6     LJM    CENX        RETURN
 COE      SPACE  4,10
**        COE - CLEAR OR RESET OPERATOR ASSIGNED EQUIPMENT.
*
*         ENTRY  (A) = 0 IF TO CLEAR OPERATOR ASSIGNED EQUIPMENT.
*                    = EQUIPMENT IF TO RESET OPERATOR EQUIPMENT.
*
*         EXIT   (A) = OPERATOR ASSIGNED EQUIPMENT BEFORE CLEAR.
*
*         USES   T0, CM - CM+5.
 
 
          QUAL
 COE      EQU    *+1         DEFINE GLOBAL TAG
          QUAL   *
 
 COE      SUBR               ENTRY/EXIT
          STD    T0          SAVE NEW VALUE FOR *OAEW*
          LDD    CP          GET *OAEW* WORD
          ADN    OAEW
          CRD    CM+1
          CRD    CM
          LDD    T0
          STD    CM+4
          ADD    CM+1+4
          ZJN    COEX        IF NO OPERATOR EQUIPMENT TO CLEAR
          LDD    CP          CLEAR OR RESET OPERATOR EQUIPMENT
          ADN    OAEW
          CWD    CM
          LDD    CM+1+4      RETURN WITH PRIOR VALUE FROM *OAEW*
          UJN    COEX        RETURN
 CSJ      SPACE  4,10
**        CSJ - CHECK FOR SSJ= ENTRY POINT.
*
*         EXIT   (A) .LT. 0, IF JOB HAS SSJ= ENTRY POINT.
*                (CM - CM+4) = *SEPW* WORD FROM CPA.
*
*         USES   CM - CM+4.
 
 
 CSJ      SUBR               ENTRY/EXIT
          LDD    CP
          ADC    SEPW
          CRD    CM          READ SPECIAL ENTRY POINT WORD
          LDD    CM
          SHN    21-2
          UJN    CSJX        RETURN
 CTE      SPACE  4,10
**        CTE - CHECK FOR TAPE EQUIPMENT.
*
*         ENTRY  (A) = EQUIPMENT MNEMONIC.
*
*         EXIT   (A) .EQ. 0 = TAPE EQUIPMENT (MT, NT, CT OR AT).
*                (A) .EQ. 1 = VSN EQUIPMENT (TE).
*                (A) .LT. 0 = NOT TAPE RELATED EQUIPMENT.
 
 
 CTE1     LDN    1           SET VSN EQUIPMENT
 
 CTE      SUBR               ENTRY/EXIT
          LPC    3777
          LMC    2RMT
          ZJN    CTEX        IF *MT*
          LMC    2RNT&2RMT
          ZJN    CTEX        IF *NT*
          LMC    2RCT&2RNT
          ZJN    CTEX        IF *CT*
          LMC    2RAT&2RCT
          ZJN    CTEX        IF *AT*
          LMC    2RTE&2RAT
          ZJN    CTE1        IF *TE*
          LCN    0           SET NOT TAPE RELATED
          UJN    CTEX        RETURN
 GVA      SPACE  4,10
**        GVA - GET AND VALIDATE ACCESS LEVEL.
*
*         ENTRY  (CN - CN+4) = FET+1.
*                (FET+4) = ACCESS LEVEL IN BITS 39-36, IF *SP*
*                (BIT 39) SET IN FET+1.
*
*         EXIT   (AL) = 8/,1/ACCESS LEVEL FLAG,3/ACCESS LEVEL.
*                (FET+4) = VALIDATED ACCESS LEVEL IN BITS 39-36.
*
*         ERROR  TO *ERR* IF SECURITY VIOLATION.
*
*         USES   AL, CM - CM+4.
*
*         CALLS  CPA.
*
*         MACROS MONITOR.
 
 
 GVA1     LDD    CP          GET JOB ACCESS LEVEL
          ADK    JSCW
          CRD    CM
          LDD    CM+1
          SHN    -11
          STD    AL
          RJM    CPA         GET (FET+4)
          ADN    4
          CRD    CM
          LDD    CM+1        SET ACCESS LEVEL IN (FET+4)
          SCN    7
          LMD    AL
          STD    CM+1
          RJM    CPA         SAVE (FET+4)
          ADN    4
          CWD    CM
 GVA2     LDN    10          SET ACCESS LEVEL FLAG
          RAD    AL
 
 GVA      SUBR               ENTRY/EXIT
          LDK    SSML        CHECK SECURITY MODE
          CRD    CM
          LDD    CM
          LPN    7
          ZJN    GVAX        IF SYSTEM IS UNSECURED
          LDD    CN+1        CHECK *SP* BIT
          SHN    21-3
          PJN    GVA1        IF *SP* BIT NOT SET
          RJM    CPA         READ ACCESS LEVEL FROM FET+4
          ADN    4
          CRD    CM
          LDD    CM+1
          LPN    7
          STD    AL
          LDN    ZERL        CLEAR WORD
          CRD    CM
          LDD    AL          SET ACCESS LEVEL FOR *VSAM* CALL
          STD    CM+1
          LDD    MA          WRITE PARAMETER WORD
          CWD    CM
          LDN    1           SET TO VALIDATE ACCESS LEVEL
          STD    CM+4
          LDN    VAJS        SET SUBFUNCTION
          STD    CM+1
          MONITOR  VSAM      VALIDATE ACCESS LEVEL
          LDD    CM+1
          ZJP    GVA2        IF VALID ACCESS LEVEL
          LDN    /ERR/LNV    * ACCESS LEVEL NOT VALID FOR FILE.*
          LJM    ERR         PROCESS ERROR
 RAW      SPACE  4,15
**        RAW - READ ACCESS CONTROL WORD.
*
*         EXIT   (CM - CM+4) = USER ACCESS CONTROL WORD FROM CPA
*                OR FROM SSJ= PARAMETER BLOCK IF SSJ= JOB.
*                (A) = (CM+4).
*
*         USES   CM - CM+4.
*
*         CALLS  CSJ.
*
*         MACROS NFA.
 
 
 RAW1     LDD    CP          READ ACCESS CONTROL WORD FROM CPA
          ADK    AACW
 RAW2     CRD    CM
          LDD    CM+4
 
 RAW      SUBR               ENTRY/EXIT
          RJM    CSJ         CHECK FOR SSJ= ENTRY POINT
          PJN    RAW1        IF NOT SSJ= JOB
          LDD    CM+3        CHECK IF SSJ= PARAMETER BLOCK PRESENT
          LPN    37
          ADD    CM+4
          ZJN    RAW1        IF NO SSJ= PARAMETER BLOCK
          NFA    SSJN+AACS   READ USER,S *AACW* WORD FROM SSJ= BLOCK
          UJN    RAW2        READ ACCESS WORD
 REA      SPACE  4,15
**        REA - REQUEST EQUIPMENT ASSIGNMENT.
*
*         ENTRY  (A) = 0, IF PREVIOUS EQUIPMENT TO BE RELEASED.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*                (EQ) = PREVIOUS EQUIPMENT, IF RELEASE REQUIRED.
*                (CN) = EQUIPMENT TYPE.
*
*         EXIT   (EQ) = ASSIGNED EQUIPMENT.
*                (A) = 0, IF TAPE EQUIPMENT (MT, NT, CT OR AT).
*                (A) .GT. 0, IF VSN EQUIPMENT (TE).
*                (A) .LT. 0, IF NOT TAPE RELATED EQUIPMENT.
*                (FS - FS+4) = ASSIGNED EQUIPMENT EST ENTRY.
*
*         CALLS  CEA, DEQ, ROA, VTE.
 
 
 REA      SUBR               ENTRY/EXIT
          NJN    REA2        IF EQUIPMENT RELEASE NOT REQUIRED
 REA1     RJM    DEQ         RELEASE EQUIPMENT
 REA2     RJM    ROA         REQUEST OPERATOR ASSIGNMENT
          RJM    CEA         CHECK EQUIPMENT ACCESS LEVELS
          NJN    REA1        IF ACCESS LEVEL OUT OF RANGE
          LDD    CN
          ZJN    REA3        IF NO TYPE REQUESTED
          LMD    FS+3        CHECK TYPE
          LPC    3777
          ZJN    REA3        IF CORRECT TYPE
          LDD    CN
          LMC    2RMS
          NJN    REA1        IF NOT *MS*
          LDD    FS
          SHN    21-13
          PJN    REA1        IF NOT MASS STORAGE EQUIPMENT
 REA3     LDD    FS+3        CHECK FOR *DS*
          LMC    2RDS
          ZJN    REA1        IF *DS*
          LDD    EQ
          RJM    VTE         CHECK FOR TAPE EQUIPMENT
          LJM    REAX        RETURN
 ROA      SPACE  4,20
**        ROA - REQUEST OPERATOR ASSIGNMENT.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*                (CN) = EQUIPMENT TYPE.
*                (CN+2) = DISPLAY CODE FOR DENSITY, IF *NT* EQUIPMENT.
*                (VS - VS+2) = VSN, IF TAPE EQUIPMENT.
*                (FA) = FNT ADDRESS, IF VSN ENTRY PRESENT.
*
*         EXIT   (EQ) = ASSIGNED EQUIPMENT.
*                (FS - FS+4) = EST ENTRY OF ASSIGNED EQUIPMENT.
*
*         EXIT   TO *RCL*, IF OPERATOR ASSIGNMENT OF EQUIPMENT
*                STILL PENDING.
*                (FS - FS+4) = FST ENTRY.
*
*         USES   T1, T7, CM - CM+4, FN+3.
*
*         CALLS  ACS, COE, SPB.
*
*         MACROS MONITOR, NFA.
 
 
 ROA10    STD    CM+1
          STD    EQ          SET POSSIBLE EST ORDINAL
          SFA    EST
          ADK    EQDE        READ EST ENTRY
          CRD    FS
          LDN    TAEQM       CHECK FOR INVALID EQUIPMENT
          STD    T1
 ROA10.1  LDM    TAEQ,T1
          LMD    FS+3
          ZJN    ROA11       IF INVALID EQUIPMENT
          AOD    T1
          LMN    TAEQL
          NJN    ROA10.1     IF NOT END OF TABLE
          LDD    FS          CHECK EQUIPMENT STATUS
          SHN    21-1
          MJN    ROA11       IF OFF OR DOWN
          SHN    2+21-13
          MJN    ROAX        IF MASS STORAGE
          LDK    REQS        REQUEST ACTIVE EQUIPMENT
          STD    CM+2
          MONITOR REQM
          LDD    CM+1        CHECK ASSIGNMENT
          NJN    ROAX        IF ASSIGNMENT MADE
 ROA11    LDN    0
          STD    EQ          SET EQUIPMENT
          UJN    ROA1        REQUEST ASSIGNMENT
 
 ROA      SUBR               ENTRY/EXIT
          LDN    0           CLEAR OPERATOR ASSIGNED EQUIPMENT
          RJM    COE
          ZJN    ROA1        IF EQUIPMENT NOT ASSIGNED
          LJM    ROA10       PROCESS EQUIPMENT
 
 ROA1     STD    CM+1
          LDD    FN+3
          SCN    77
          STD    FN+3
          LDD    FA
          ZJN    ROA2        IF NO FNT/FST ENTRY
          NFA    FA,R
          ADN    FSTL
          CRD    FS          READ FST ENTRY
 ROA2     LDC    ROAB        INITIALIZE MESSAGE ADDRESS
          STD    T1
          LDN    FN          ENTER FILE NAME IN REQUEST MESSAGE
          RJM    ACS
          LDD    CN
          NJN    ROA3        IF DEVICE TYPE SPECIFIED
          LJM    ROA7        CHECK FOR *REQUEST* COMMAND
 
 ROA3     LDC    =2C,        ADD *, *
          RJM    ACS
          LDD    CN
          LPC    3777        CLEAR NON-ALLOCATABLE BIT
          STD    CM          SAVE DEVICE TYPE
          LMC    2RMT
          ZJN    ROA4        IF *MT*
          LMC    2RCT&2RMT
          ZJN    ROA4        IF *CT*
          LMC    2RAT&2RCT
          ZJN    ROA4        IF *AT*
          LMC    2RNT&2RAT
          NJN    ROA6        IF NOT *NT*
          LDD    CN+2        GET DISPLAY CODE FOR DENSITY
          STD    CM
 ROA4     LDN    CM          ENTER DEVICE TYPE OR DENSITY DISPLAY
          RJM    ACS
          LDD    VS
          ZJN    ROA5        IF NO VSN SPECIFIED
          LDC    =2C,        ADD *, *
          RJM    ACS
          LDN    0
          STD    VS+3        SET END OF VSN
          LDN    VS          ENTER VSN INTO REQUEST MESSAGE
          RJM    ACS
 ROA5     LDC    ROAA        SET MESSAGE ADDRESS
          STD    T7
          LJM    ROA9        RECALL
 
*         CHECK FOR *REQUEST* CONTROL CARD.
 
 ROA6     LDN    CM          ENTER DEVICE TYPE IN REQUEST MESSAGE
          RJM    ACS
 ROA7     LDD    CP          CHECK FOR *REQUEST* IN *MS1W*
          ADN    MS1W
          CRD    CM
          LDN    2
          STD    T1
 ROA8     LDM    CM,T1
          LMM    ROAA,T1
          ZJN    ROA8.1      IF POSSIBLY *REQUEST*
          LMM    ROAC,T1
          NJN    ROA5        IF NOT *$REQUEST*
 ROA8.1   SOD    T1
          PJN    ROA8        IF MORE CHARACTERS TO CHECK
          LDD    CM+3
          LMM    ROAA+3
          SCN    77
          ZJN    ROA8.2      IF *REQUEST*
          LMC    2RT &2RS
          NJN    ROA5        IF NOT *$REQUEST*
 ROA8.2   STD    T7
          LDN    1
          RJM    SPB         SET PAUSE BIT
 ROA9     LDN    /ERR/WEQ    * EQUIPMENT NOT AVAILABLE.*
          LJM    RCL         RECALL
 
 
 ROAA     DATA   10HREQUEST -
 ROAB     BSSZ   12
 ROAC     VFD    36/6RREQUES&6R$REQUE
 SEQ      SPACE  4,20
**        SEQ - SEARCH FOR EQUIPMENT.
*
*         ENTRY  (CN) = TYPE.
*                (IR+2) = FUNCTION CODE.
*                (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
*         EXIT   (A) .LT. 0, IF MSAL REQUEST.
*                (A) = 0, IF EQUIPMENT PRESENT IN SYSTEM AND AVAILABLE.
*                (A) .GT. 0, IF EQUIPMENT PRESENT IN SYSTEM BUT
*                     UNAVAILABLE.
*                (EQ) = EST ORDINAL.
*                (FS - FS+4) = EST ENTRY.
*                (ASFA) = *RTCM* DEVICE SELECTION PARAMETER.
*
*         ERROR  TO *ERR*, IF EQUIPMENT NOT PRESENT IN SYSTEM.
*
*         USES   EQ, T0, T1, T2, CM - CM+4, FS - FS+4, T3 - T7.
*
*         CALLS  CEA, VSO.
*
*         MACROS SFA.
 
 
 SEQ11    LDN    TTEQ        SET *TT* EQUIPMENT
          STD    EQ
          SFA    EST
          ADK    EQDE
          CRD    FS          GET EST ENTRY
          LDN    0           RETURN AVAILABLE STATUS
 
 SEQ      SUBR               ENTRY/EXIT
          LDN    ESTP        READ EST POINTER
          CRD    CM
          LDD    CM+2        SAVE HIGHEST EST ORDINAL
          STM    SEQB
          LDN    NEEQ-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    EQ
          STD    T1          CLEAR TYPE FOUND FLAG
          LDD    CN          CHECK TYPE
          LPC    3777
          LMC    2RTT
          ZJN    SEQ11       IF *TT*
          LMC    2RDE&2RTT
          ZJN    SEQ4        IF *DE*
          LMN    2RDP&2RDE
          ZJN    SEQ4        IF *DP*
          LDN    0           INITIALIZE TABLE SEARCH
          STD    T2
 SEQ1     LDD    CN          CHECK TABLE FOR MATCH
          LPC    3777
          ZJN    SEQ6        IF FIELD NOT SET
          LMM    TAEQ,T2
          ZJN    SEQ2        IF MATCH
          AOD    T2
          LMN    TAEQL
          NJN    SEQ1        IF NOT END OF TABLE
          UJN    SEQ3        SEARCH EST
 
 SEQ2     LDD    IR+2        CHECK FUNCTION
          LMN    15
          NJN    SEQ6        IF NOT FROM *AEQ*
          LDN    NEEQ
          STD    EQ
          LDD    T2          CHECK LOCATION OF EQUIPMENT IN TABLE
          STM    ASFA        SET FLAG FOR *RTCM* CALL
          SBN    TAEQM
          PJN    SEQ6        IF INCORRECT EQUIPMENT
          LJM    SEQX        RETURN
 
 SEQ3     AOM    SEQA        DO NOT SEARCH FOR EXTENDED MEMORY TYPE
 SEQ4     AOD    EQ
          LMC    0
 SEQB     EQU    *-1
          NJN    SEQ7        IF NOT END OF EST
          LDD    T1
          NJN    SEQ6        IF TYPE NOT FOUND
          LDN    1
 SEQ5     LJM    SEQX        RETURN
 
 SEQ6     LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          LJM    ERR         PROCESS ERROR
 
 SEQ7     SFA    EST,EQ      READ EST ENTRY
          ADK    EQDE
          CRD    FS
          LDD    FS+3        CHECK TYPE
          LMD    CN
          LPC    3777
          ZJN    SEQ8        IF MATCH
          STD    T0
          LDN    0
 SEQA     EQU    *-1
*         LDN    1           (NOT EXTENDED MEMORY TYPE)
 SEQ7.1   NJN    SEQ4        IF NOT CHECKING FOR EXTENDED MEMORY TYPE
          LDD    T0
          LMN    2RDE&2RDP
          NJN    SEQ4        IF NO MATCH
 SEQ8     STD    T1          SET TYPE FOUND
          LDD    FS
          SHN    21-1
          MJN    SEQ4        IF *OFF*
          RJM    CEA         CHECK EQUIPMENT ACCESS LEVELS
          NJN    SEQ7.1      IF ACCESS LEVEL NOT IN RANGE
          LDD    FS
          SHN    21-13
          PJN    SEQ10       IF NOT MASS STORAGE
          LDD    FS+4
          SHN    3
          ADN    ACGL
          CRD    T3
          ADN    DILL-ACGL
          CRD    T2
          LDD    T3+4
          SHN    21-4
          MJN    SEQ9.1      IF ERROR IDLE SET
          RJM    VSO         VALIDATE CALLER
          ZJN    SEQ8.1      IF JOB HAS PROPER VALIDATION
          LDD    T2
          SHN    21-0
          PJN    SEQ9.1      IF NOT *TEMP* DEVICE
 SEQ8.1   LDD    FS
          LPC    500
 SEQ9     NJN    SEQ9.1      IF EQUIPMENT NOT AVAILABLE
          LJM    SEQ5        RETURN
 
 SEQ9.1   LJM    SEQ4        LOOP FOR NEXT EQUIPMENT
 
 SEQ10    SHN    0-12-21+13
          LMN    1
          ZJN    SEQ9        IF ALLOCATABLE DEVICE
          SFA    EST,EQ      CHECK ASSIGNMENT STATUS
          ADK    EQAE
          CRD    T3
          LDD    T3+4
          UJN    SEQ9        CHECK ASSIGNMENT STATUS
 TAEQ     SPACE  4,10
**        TAEQ - TABLE OF EQUIPMENT MNEMONICS.
*
*         A MNEMONIC IN THE TABLE BEFORE *TAEQM* IMPLIES IT IS
*         A SPECIAL MNEMONIC FOR ASSIGNMENT OF *MSAL*
*         DEVICES.  ANY MNEMONIC AFTER *TAEQM* IN THE TABLE
*         IS AN INCORRECT DEVICE TYPE.
 
 
 TAEQ     INDEX
 
          INDEX  TMPS,2RTP   TEMP DEVICE
          INDEX  INPS,2RIN   INPUT DEVICE
          INDEX  OUTS,2ROT   OUTPUT DEVICE
          INDEX  PRIS,2RPY   PRIMARY DEVICE
          INDEX  LOCS,2RLO   LOCAL DEVICE
          INDEX  LGOS,2RLG   LGO DEVICE
 
          INDEX  MXRS
 
 TAEQM    EQU    *-TAEQ      FLAG FOR *RTCM* CALL
          LOC    TAEQM
 
          CON    2RCM        CONTROL MODULE
          CON    2RCP        CARD PUNCH
          CON    2RCR        CARD READER
          CON    2RDS        DISPLAY CONSOLE
          CON    2RLP        LINE PRINTER
          CON    2RLQ        LINE PRINTER
          CON    2RLR        LINE PRINTER
          CON    2RLS        LINE PRINTER
          CON    2RLT        LINE PRINTER
          CON    2RLX        5870 NON-IMPACT PRINTER
          CON    2RLY        5970 NON-IMPACT PRINTER
          CON    2RMP        MAP III/IV
          CON    2RNC        NAD
          CON    2RND        CDCNET DEVICE INTERFACE (MDI/MTI)
          CON    2RNP        255X NETWORK PROCESSING UNIT
          CON    2RRD        REDEFINITION DEVICE
          CON    2RRM        TWO PORT MULTIPLEXER
          CON    2RRP        RING PORT
          CON    2RSS        MSE M860 CONTROLLER
          CON    2RTT        TIME-SHARING MULTIPLEXER
          LOC    *O
 TAEQL    EQU    *-TAEQ
 UPC      SPACE  4,10
**        UPC - UPDATE PRU COUNTER.
*
*         ENTRY  (CM - CM+4) = EST ENTRY.
*
*         EXIT   PRU COUNTER UPDATED IN NFL *SSJ=* BLOCK, IF PRESENT.
*                OTHERWISE, THE COUNT IS SET FOR THE *UADM*
*                FUNCTION TO UPDATE CONTROL POINT AREA WORD *ACLW*.
*
*         USES   T0, T1, T2, T3, CM - CM+4.
*
*         MACROS NFA.
 
 
 UPC3     LDD    T1          SET SECTOR COUNT FOR *UADM*
          STM    DPPB+1
 
 UPC      SUBR               ENTRY/EXIT
          LDD    CM+4        READ MST
          SHN    3
          ADK    MDGL
          CRD    CM
          LDD    CM+4        SAVE SECTOR LIMIT
          STD    T1
          LDD    CP          CHECK FOR *SSJ=* BLOCK PRESENT
          ADK    SEPW
          CRD    CM
          LDD    CM
          SHN    21-2
          PJN    UPC3        IF NO *SSJ=* ENTRY POINT
          LDD    CM+3
          LPN    37
          SHN    14
          ADD    CM+4
          ZJN    UPC3        IF NO *SSJ=* BLOCK PRESENT
          NFA    SSJN+ACLS   READ NFL COPY OF *SSJ=* BLOCK
          CRD    CM
          LDD    CM+3        GET CURRENT PRU COUNT
          LPN    77
          STD    T2
          SHN    14
          LMD    CM+4
          STD    T3
          LMC    777777
          ZJN    UPC2        IF UNLIMITED VALIDATION
          LDD    T3          CALCULATE NEW PRU COUNT
          SBD    T1
          STD    T0
          PJN    UPC1        IF NO BORROW
          SOD    T2
          MJN    UPC2        IF RESULT IS NEGATIVE
          AOD    T0
 UPC1     STD    CM+4        SET NEW PRU COUNT
          LDD    CM+3
          SCN    77
          ADD    T2
          STD    CM+3
          NFA    SSJN+ACLS
          CWD    CM
 UPC2     LJM    UPCX        RETURN
 VAE      SPACE  4,10
**        VAE - VALIDATE ASSIGNED EQUIPMENT.
*
*         ENTRY  (EQ) = EQUIPMENT EST ORDINAL.
*
*         EXIT   RELEASES EQUIPMENT AND EXITS TO *VSJ1*, IF NOT
*                PROPERLY VALIDATED.
*
*         CALLS  DEQ, RAW.
 
 
 VAE      SUBR               ENTRY/EXIT
          RJM    RAW         READ ACCESS CONTROL WORD
          SHN    21-6
          MJN    VAEX        IF PROPERLY VALIDATED FOR ASSIGNED EQUIP
          RJM    DEQ         RELEASE EQUIPMENT
          UJN    VSJ1        * USER ACCESS NOT VALID.*
 VSJ      SPACE  4,15
**        VSJ - VALIDATE SSJ=.
*
*         ENTRY  AT *VSJ1*, IF USER ACCESS NOT VALID ERROR DETECTED.
*
*         EXIT   (FA) = UNCHANGED, IF NO ERROR.
*
*         ERROR  TO *ERR*, IF NOT PROPERLY VALIDATED.
*
*         USES   FA.
*
*         CALLS  CSJ.
 
 
 VSJ      SUBR               ENTRY/EXIT
          RJM    CSJ         CHECK FOR SSJ= ENTRY POINT
          MJN    VSJX        IF JOB HAS SSJ= ENTRY POINT
 VSJ1     LDN    0
          STD    FA
          LDN    /ERR/IUA    * USER ACCESS NOT VALID.*
          LJM    ERR         PROCESS ERROR
 VSO      SPACE  4,10
**        VSO - VALIDATE SYSTEM ORIGIN PRIVLEDGES.
*
*         ENTRY  (OC) = ORIGIN CODE.
*
*         EXIT   (A) = 0 IF JOB IS SYSTEM ORIGIN OR HAS SYSTEM
*                      ORIGIN PRIVILEGES.
*
*         CALLS  RAW.
 
 
 VSO      SUBR               ENTRY/EXIT
          LDD    OC          CHECK FOR SYOT
          LMK    SYOT
          ZJN    VSOX        IF SYOT JOB
          RJM    RAW         READ ACCESS CONTROL WORD
          LPN    20
          LMN    20
          UJN    VSOX        RETURN
 VTE      SPACE  4,10
**        VTE - VERIFY TAPE ENTRY.
*
*         ENTRY  (A) = EST ORDINAL.
*
*         EXIT   (A) .EQ. 0 = TAPE EQUIPMENT (MT, NT, CT OR AT).
*                (A) .EQ. 1 = VSN EQUIPMENT (TE).
*                (A) .LT. 0 = NOT TAPE RELATED EQUIPMENT.
*
*         USES   CM - CM+4.
*
*         CALLS  CTE.
*
*         MACROS SFA.
 
 
 VTE      SUBR               ENTRY/EXIT
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM+3        CHECK EQUIPMENT TYPE
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          UJN    VTEX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPACS
*CALL     COMPC2D
          SPACE  4,10
          ERRNG  OVL0-*      CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
          OVERFLOW  OVL
          OVERLAY (COMMAND FILE FUNCTIONS.)
          SPACE  4,10
          SPACE  4,10
****      ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
 
 
 SP       EQU    60 - 64     COMMAND POINTER (5 LOCATIONS)
 CF       EQU    65          COMMAND FILE FLAGS
 WO       EQU    66          COMMAND SECTOR WORD COUNT OVERLAP
****
 ACS      SPACE  4,20
***       FUNCTION 21.
*         ATTACH COMMAND FILE UNDER NAME FROM FET.
*         ENTER CURRENT COMMAND COUNT IN (FET+6).
*
*         ENTRY  (FN - FN+3) = FILE NAME FROM FET+0.
*
*T FET+6  1/L,41/,18/ ADDR
*
*         L = 1 IF FILE MUST BE CREATED AS A LOCKED LIBRARY FILE.
*         ADDR = IF PRESENT IS ADDRESS TO RECEIVE POSITION INFORMATION.
*
*         EXIT -
*
*T FET+6  42/0, 18/COMMAND COUNT
*
*T ADDR   30/0, 24/CURRENT RANDOM ADDR, 6/WC
*
*         WC = WORD COUNT POSITION IN CURRECT SECTOR.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
 
 
 ACS1     ENTRY  ACS
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          ZJN    ACS2        IF NOT FOUND
          LDN    0           CLEAR FNT ADDRESS
          STD    FA
          LDN    /ERR/DFN
          LJM    ERR         PROCESS ERROR
 
 ACS2     LDD    CP          READ COMMAND FST ENTRY
          ADN    CSSW
          CRD    CM
          LDD    CM          CHECK STATUS
          LPC    777
          ADD    CM+1
          NJN    ACS3        IF FILE DEFINED
          LJM    LFMX        EXIT
 
 ACS3     LDN    NEEQ        SET NULL EQUIPMENT
          STD    EQ
          RJM    EFN         ENTER FILE NAME
          LDD    CP          READ COMMAND POINTER
          ADN    CSPW
          CRD    SP
          ADN    CSSW-CSPW   READ FST ENTRY
          CRD    FS
          LDD    FS          SAVE ORIGINAL COMMAND FILE FLAGS
          STD    CF
          LPC    777         SET EST ORDINAL
          STD    FS
          STD    T5
          LDD    FS+4        SAVE SECTOR WORD COUNT OVERLAP
          LPN    77
          STD    WO
          LDN    4           SET EOR OPERATION
          STD    FS+4
 
*         CHECK IF POSITION INFORMATION TO BE RETURNED.
 
          RJM    CPA         READ FET+6
          ADN    6
          CRD    CN
          LDD    CN+3        CHECK IF ADDRESS PRESENT
          LPN    77
          STD    CN+3
          SHN    14
          LMD    CN+4
          NJN    ACS4        IF ADDRESS PRESENT
          LJM    ACS7        CHANGE TO *LIFT* FILE TYPE
 
 ACS4     SHN    -6          CHECK IF ADDRESS WITHIN FL
          SBD    FL
          MJN    ACS5        IF WITHIN FL
          LDN    /ERR/AOR    * ADDRESS OUT OF RANGE.*
          LJM    ERR         ABORT
 
 ACS5     LDD    CN          SET FILE TYPE OPTION
          SHN    -13
          RAM    ACSA
          LDD    FS+2        CURRENT TRACK
          STD    T6
          LDD    FS+3        CURRENT SECTOR
          STD    T7
          LDD    FS+1        FIRST TRACK
          RJM    SRA         SET RANDOM ADDRESS
          SOD    RI+1        ADJUST ADDRESS TO PREVIOUS SECTOR
          PJN    ACS6        IF NO UNDERFLOW
          SOD    RI
          AOD    RI+1
 ACS6     LDD    RI          RETURN RANDOM ADDRESS
          SHN    6
          STD    CM+3
          SHN    -14
          STD    CM+2
          LDD    RI+1
          SHN    6
          STD    CM+4
          SHN    -14
          RAD    CM+3
          LDC    CSBN        SET WORD COUNT
          SBD    SP+3
          SBD    WO          ADJUST FOR OVERLAP
          RAD    CM+4
          SHN    -14
          RAD    CM+3
          LDN    0           RETURN POSITION INFORMATION
          STD    CM
          STD    CM+1
          LDD    CN+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWD    CM
          LDD    CF          CHECK IF ORIGINAL COMMAND FILE
          SHN    21-13
          MJN    ACS7        IF ORIGINAL JOB INPUT FILE
 
 
*         IF THE USER OF *ACCSF* HAS BIT 59 SET IN FET+6,
*         IT IS NECESSARY FOR THE COMMAND FILE TO BE
*         ACCESSED AS A LOCKED, READ ONLY, LIBRARY FILE.
*
*         *CHKPT* USES THIS OPTION BECAUSE IF THE FILE IS CREATED
*         AS LOCAL, THE *ENCSF* MACRO CAN BE USED TO RESTORE THE
*         COMMAND FILE AND THE CORRESPONDING POINTERS IN THE
*         *CPA*.  WHEN THE COMMAND BUFFER IS SUBSEQUENTLY
*         RESTORED (FROM THE $DM*$ FILE) IT IS POSSIBLE FOR THE
*         POINTERS TO THE COMMAND FILE (NOT RESTORED FROM
*         THE $DM*$ FILE) TO BE INCORRECT IF A COMMAND WAS
*         CONTINUED FROM THE PREVIOUS SECTOR.
*
*         *ENQUIRE* USES THIS OPTION BECAUSE IT ONLY WANTS TO READ
*         THE FILE, NOT REPOSITION OR RESTORE IT.
 
 ACSA     LDN    0
*         LDN    1           (FILE MUST BE LOCKED LIBRARY FILE)
          NJN    ACS7        IF SETTING WRITE LOCKOUT
          SOM    ACSB        DO NOT LOCK FILE
          LDN    ZERL        CLEAR CONTROL POINT AREA POINTERS
          CRD    CM
          CRD    CN
          LDD    SP          RETAIN CSPW BYTE 0
          STD    CM
          LDD    CP
          ADK    CSPW
          CWD    CM
          ADN    CSSW-CSPW
          CWD    CN
          UJN    ACS8        CHECK *SSJ=* VALUE
 
 ACS7     LDC    LIFT*100-LOFT*100  CHANGE FILE TYPE TO *LIFT*
          RAD    FN+4
 ACS8     LDD    CP          CHECK *SSJ=* ADDRESS VALUE
          ADC    SEPW
          CRD    CM
          LDD    CM+3
          LPN    77
          LMN    40
          SHN    14
          LMD    CM+4
          NJN    ACS9        IF *SSJ=* VALUE .NE. 400,000B
          LDD    FN+4        CHANGE FILE STATUS TO *SSST*
          SCN    77
          LMN    SSST
          STD    FN+4
 ACS9     LDD    FS+1        REWIND FILE
          STD    FS+2
          LDN    FSMS
          STD    FS+3
          LDD    FN+3        SET LOCKED FILE
          SCN    77
          LMN    1
 ACSB     EQU    *-1
*         LMN    0           DO NOT LOCK FILE WHEN LOFT
          STD    FN+3
          NFA    FA,R        STORE FNT WORD
          CWD    FN
          LDN    ZERL        SET COMMAND COUNT
          CRD    CN
          LDD    SP+1
          LPN    77
          STD    CN+3
          LDD    SP+2
          STD    CN+4
          RJM    CPA         STORE (FET+6)
          ADN    6
          CWD    CN
          LJM    LFMX        EXIT
 ECS      SPACE  4,20
***       FUNCTION 22.
*         REPLACE COMMAND FILE.
*         IF FILE IS NOT DEFINED, COMMAND FILE WILL BE
*         CLEARED.
*
*         ENTRY  (FN - FN+3) = FILE NAME FROM FET+0.
* FET+6   42/, 18/ADDR
*
*         ADDR = IF PRESENT IS ADDRESS CONTAINING POSITION INFORMATION.
*         THE FORMAT OF THIS ADDRESS IS THE FOLLOWING.
*
*T ADDR   24/CS, 6/0, 24/CURRENT RANDOM ADDR, 6/WC
*
*         CS = COMMAND COUNT.
*         WC = WORD COUNT POSITION IN SECTOR.
*
*         ENTRY  (FF) = FET SPECIFIED FNT ADDRESS.
 
 
          ENTRY  ECS
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    ECS1        IF FOUND
          LDN    ZERL
          CRD    FS          CLEAR FST ENTRY
          LDD    CP          READ COMMAND POINTER
          ADN    CSPW
          CRD    SP
          LDC    4000        SET EOR
          STD    SP+1
          LDD    SP+4        CLEAR BUFFER
          STD    SP+3
          LDD    CP          STORE COMMAND POINTER
          ADN    CSPW
          CWD    SP
          LJM    LFMX        RETURN
 
 ECS1     RJM    SFB         SET FILE BUSY
          ZJN    ECS2        IF NO REJECT ON FILE INTERLOCK
          LDN    /ERR/IOE    *I/O SEQUENCE ERROR.*
          LJM    ERR         ABORT
 
 ECS2     LDD    CM+4        CHECK FILE TYPE
          SHN    -6
          LMN    LOFT
          NJN    ECS3        IF NOT LOCAL FILE TYPE
          LDD    CM+3        CHECK FILE MODE
          SHN    21-2
          MJN    ECS2.1      IF EXECUTE-ONLY FILE
          LJM    ECS6        LOCAL FILE TYPE
 
 ECS2.1   LDN    /ERR/ILM    * INCORRECT FILE MODE.*
          LJM    ERR         ABORT
 
 ECS3     LMN    LIFT&LOFT
          NJN    ECS4        IF NOT LIBRARY FILE TYPE
          LDC    ECS4        MUST HAVE POSITION PARAMETER
          STM    ECSA
 
*         COMPARE TO ORIGINAL JOB INPUT FILE.
 
          NFA    FNTN+FSTL   FETCH INPUT FILE FST INFORMATION
          CRD    CM
          LDD    FS          COMPARE EQUIPMENT AND FIRST TRACK
          LMD    CM
          NJN    ECS4        IF LIBRARY TYPE BUT NOT INPUT
          LDD    FS+1
          LMD    CM+1
          ZJN    ECS5        IF ORIGINAL JOB FILE
 ECS4     LDN    /ERR/IFT    * INCORRECT FILE TYPE.*
          LJM    ERR         PROCESS ERROR
 
 ECS5     LDC    MJNI&UJNI   PREVENT DROPPING TRACKS
          LMM    ECSC
          STM    ECSC
          LDC    4000        SET ORIGINAL INPUT FILE FLAG
          STM    ECSB
 ECS6     SFA    EST,FS      CHECK FOR MASS STORAGE
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-13
          MJN    ECS7        IF ON MASS STORAGE
          LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          UJN    ECS9        ABORT
 
 ECS7     LDD    FS+2
          NJN    ECS10       IF FILE USED
 ECS8     LDN    /ERR/FLE    * FILE EMPTY.*
 ECS9     LJM    ERR         PROCESS ERROR
 
 
*         CHECK IF POSITION INFORMATION TO BE RETRIEVED.
 
 ECS10    RJM    CPA         READ FET+6
          ADN    6
          CRD    CN
          LDD    CN+3        CHECK IF ADDRESS PRESENT
          LPN    77
          STD    CN+3
          SHN    14
          ADD    CN+4
          NJN    ECS11       IF ADDRESS PRESENT
          LJM    ECS13       IF ADDRESS NOT PRESENT
 ECSA     EQU    *-1
*         LJM    ECS4        IF INPUT FILE BUT NO POSITION PARAMETER
 
 ECS11    SHN    -6          CHECK IF ADDRESS WITHIN FL
          SBD    FL
          MJN    ECS12       IF WITHIN FL
          LDN    /ERR/AOR    * ADDRESS OUT OF RANGE.*
          LJM    ERR         ABORT
 
 ECS12    LDD    CN+3        READ POSITION INFORMATION
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM
          LDD    CM+3        GET CURRENT RANDOM ADDRESS
          SHN    6
          STD    RI+1
          SHN    -14
          STD    RI
          LDD    CM+4
          SHN    -6
          RAD    RI+1
          LDD    CM+2
          SHN    6
          RAD    RI
          LDN    0
          STD    CN+3
          LDD    CM          GET COMMAND COUNT
          STD    CN+1
          LDD    CM+1
          STD    CN+2
          LDD    CM+4        SET WORD COUNT
          LPN    77
          STD    CN+4
          LDD    FS          SET EQUIPMENT
          STD    T5
          LMC    0
 ECSB     EQU    *-1
*         LMC    4000        WHEN ORIGINAL JOB INPUT FILE
          STD    FS
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          RJM    PCF         POSITION COMMAND FILE
          LJM    ECS16       STORE NEW FST WORD
 
*         CONTINUE HERE IF POSITION INFORMATION NOT PRESENT.
 
 ECS13    LDD    CP          READ COMMAND POINTER
          ADN    CSPW
          CRD    SP
          LDD    FS          SET EQUIPMENT
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    FS+2
          STD    T6
          LDN    FSMS        SET FIRST SECTOR
          STD    T7
          SETMS  IO
          LDC    BFMS        READ FIRST SECTOR
          RJM    RNS
          ENDMS
          LDD    T1          CHECK WORD COUNT
          NJN    ECS14       IF NOT EMPTY SECTOR
          LJM    ECS8        * FILE EMPTY.*
 
 ECS14    LDN    0           CLEAR COMMAND COUNT
          STD    SP+1
          STD    SP+2
          STD    FS+4
          LDC    CSBN        SET INITIAL COMMAND INDEX
          STD    SP+3
          NFA    SP+3,R      STORE SECTOR
          CWM    BFMS+2,T1
          LDD    SP+3
          SBD    T1
          STD    SP+4
          LDD    T7          SET CURRENT SECTOR IN FST
          STD    FS+3
          LDD    T1          CHECK BUFFER WORD COUNT
          LMD    HN
          ZJN    ECS15       IF NOT SHORT SECTOR
          LDC    4000        SET EOR FLAG
          STD    SP+1
 ECS15    LDD    FS+1
          STD    FS+2
          LDD    CP          STORE COMMAND POINTER
          ADN    CSPW
          CWD    SP
          ADN    CSSW-CSPW   READ FST ENTRY
 ECS16    CRD    CN
          CWD    FS          STORE NEW FST ENTRY
          LDD    CN
          SHN    21-13
          MJN    ECS17       IF OLD FILE WAS INPUT FILE
 ECSC     EQU    *-1
*         UJN    ECS17       (ORIGINAL JOB INPUT FILE)
          LDD    CN          DROP OLD COMMAND FILE
          LPC    777
          STD    CM+1
          LDD    CN+1
          STD    CM+2
          ZJN    ECS17       IF NO FIRST TRACK
          MONITOR DTKM
          LDD    CM+3        SET COUNT OF SECTORS RETURNED
          STM    DPPB
          LDD    CM+4
          STM    DPPB+1
          LDN    CICS        SET INCREMENT SUBFUNCTION
          STM    DPPA
 ECS17    LDD    FA
          ZJN    ECS18       IF NO FNT ENTRY
          STD    CM+4
          LDN    DLFS        CLEAR FNT ENTRY
          STD    CM+1
          MONITOR  PLFM
*         LDN    0           CLEAR FNT ADDRESS
          STD    FA
 ECS18    LJM    LFMX        EXIT
 PCS      SPACE  4,10
***       FUNCTION 23.
*         POSITION COMMAND FILE.
*
*         ENTRY -
*T FET+6  12/,24/  CS,24/  WC
*         CS     COMMAND COUNT
*         WC     WORD COUNT FROM BEGINNING OF FILE
 
 
          ENTRY  PCS
          LDD    CP          READ COMMAND FST ENTRY
          ADN    CSSW
          CRD    FS
          LDD    FS          SET EQUIPMENT
          LPC    777
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          NJN    PCS1        IF FILE EXISTS
          LDN    /ERR/FLE    FILE EMPTY
          LJM    ERR         PROCESS ERROR
 
 PCS1     RJM    CPA         READ (FET+6)
          ADN    6
          CRD    CN
          LDD    CN+4        SET RANDOM INDEX
          SCN    77
          SHN    6
          LMD    CN+3
          SHN    6
          ADN    FSMS
          STD    RI+1
          SHN    -14
          STD    RI
          RJM    PCF         POSITION COMMAND FILE
          CWD    FS
          LJM    LFMX        RETURN
 
 PCF      SPACE  4,25
**        PCF - POSITION COMMAND FILE.
*
*         ENTRY  (RI - RI+1) = CURRENT RANDOM ADDRESS.
*                (CN+1 - CN+2) = COMMAND COUNT.
*                (CN+3 - CN+4) =  WORD COUNT. FROM ECS THIS IS A 6 BIT
*                WORD COUNT IN CN+4 RELATIVE TO THE PRU AND CN+3 = 0.
*                IF FROM PCS THIS IS A 24 BIT WORD COUNT FROM THE
*                BEGINNING OF FILE.
*                (FS - FS+4) = FST ENTRY.
*                (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*
*         EXIT   (SP - SP+4) = WORD CSPW.
*                (FS - FS+4) = UPDATED FST ENTRY.
*                (A) = ADDRESS OF WORD *CSSW*.
*
*         ERROR  TO *ERR*, IF CURRENT RANDOM ADDRESS = 0, OR IF MASS
*                STORAGE DEVICE ENCOUNTERED AN I/O ERROR.
*
*         USES   T2, T4, T6, T7, CN+4.
*
*         CALLS  CRA, RNS.
*
*         MACROS ENDMS, SETMS.
 
 
 PCF      SUBR               ENTRY
          LDD    RI          CHECK CURRENT RANDOM ADDRESS
          ADD    RI+1
          NJN    PCF1        IF CURRENT RANDOM ADDRESS .NE. 0
          LDN    /ERR/IRA    * INCORRECT RANDOM ADDRESS.*
          LJM    ERR         PROCESS ERROR
 
 PCF1     LDD    CP          READ COMMAND POINTER
          ADN    CSPW
          CRD    SP
          RJM    CRA         CONVERT RANDOM ADDRESS
          PJN    PCF3        IF ADDRESS ON FILE
          LDM    ECSB
          ZJN    PCF2        IF NOT ORIGINAL JOB INPUT FILE
          LJM    PCF8        SET *EOR*
 
 PCF2     LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDN    FSMS        SET FIRST SECTOR
          STD    T7
          LDN    0           CLEAR WORD COUNT
          STD    CN+4
 PCF3     LDD    T6          SET CURRENT TRACK
          STD    FS+2
          LDD    T7          SET CURRENT SECTOR
          STD    FS+3
          SETMS  IO
          LDC    BFMS        READ SECTOR
          RJM    RNS
          ENDMS
          LDD    T1
          NJN    PCF4        IF NOT EMPTY SECTOR
          LJM    PCF8        PROCESS *EOR*
 
 PCF4     LDD    CN+4
          ADD    CN+3
          ZJN    PCF5        IF POSITIONING TO BEGINNING
          LDD    CN+4
          LPN    77
          SBD    T1
          SBN    1
          MJN    PCF5        IF WORD COUNT ON FILE
          LJM    PCF8        SET *EOR*
 
 PCF5     LDD    CN+1        SET COMMAND COUNT
          LPC    3777
          STD    SP+1
          LDD    CN+2
          STD    SP+2
          LDC    CSBN        SET FIRST BUFFER ADDRESS
          STD    SP+3
          LDD    T6          UPDATE TRACK
          STD    FS+2
          LDD    T7          UPDATE SECTOR
          STD    FS+3
          LDN    0           CLEAR WORD COUNT
          STD    FS+4
          NFA    SP+3,R      WRITE NEXT SECTOR INTO BUFFER
          CWM    BFMS+2,T1
          LDD    SP+3        SET COMMAND LIMIT
          SBD    T1
          STD    SP+4
          LDD    CN+4        SET POSITION IN BUFFER
          LPN    77
          LMC    -0
          RAD    SP+3
          LDD    T1
          LMD    HN
          ZJN    PCF7        IF NOT SHORT BLOCK
 PCF6     LDC    4000        SET *EOR*
          RAD    SP+1
 PCF7     LDD    CP          STORE COMMAND POINTER
          ADN    CSPW
          CWD    SP
          ADN    CSSW-CSPW   SET ADDRESS OF *CSSW*
          LJM    PCFX        EXIT
 
 PCF8     LDC    CSBN        SET BUFFER EMPTY
          STD    SP+3
          STD    SP+4
          LDN    0           CLEAR COMMAND COUNT
          STD    SP+1
          STD    SP+2
          UJN    PCF6        SET *EOR*
 ERX      SPACE  4,10
**        ERX - EVALUATE MASS STORAGE ERROR RETURN.
*
*         ENTRY  (A) = ERROR RESPONSE FROM DRIVER.
*                (T5) = EST ORDINAL.
*                (FS - FS+4) = FST ENTRY.
*
*         USES   FS, IR+4, T0.
*
*         CALLS  ERR, SNB, *1RJ*.
*
*         MACROS EXECUTE, PAUSE.
 
 
 ERX      PSN                ENTRY
          STD    T0          SAVE ERROR RESPONSE
          LDD    FS          INSURE FST IN CORRECT FORMAT
          LPC    777
          STD    FS
          LDD    T0
          SHN    21-12
          PJN    ERX2        IF ERROR RECOVERABLE
 ERX1     LDN    /ERR/CFE
          LJM    ERR         PROCESS ERROR
 
 ERX2     LDM    MSD         CHECK CALLER
          SHN    21-13
          PJN    ERX1        IF SUBSYSTEM
 ERX3     PAUSE
          LDD    CM+1
          NJP    LFMX        IF ERROR FLAG SET
          RJM    SNB         SET FST NONBUSY
          LDD    T5          SET EST ORDINAL
          STD    IR+4
          EXECUTE  1RJ       RECALL JOB
          SPACE  4,10
**        COMMON DECKS.
 
 
 MSR      EQU    ERX         ERROR PROCESSOR FOR *RNS*
*CALL     COMPCRA
*CALL     COMPRNS
          SPACE  4,10
          ERRNG  OVL0-*      CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
          OVERFLOW  OVL
          OVERLAY (GETFNT AND PRIMARY FUNCTIONS.)
          SPACE  4,10
****      ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
 
 
 CB       EQU    65          CONTROL BITS - GETFNT FUNCTION.
*                            TEMPORARY STORAGE - PRIMARY FUNCTION.
 SB       EQU    66 - 67     FILE SELECTIVITY BITS - GETFNT FUNCTION.
****
          TITLE  GETFNT
 GTF      SPACE  4,50
***       FUNCTION 25.
*         RETURN TABLE WITH FNT/FST ENTRIES (OPTIONALLY MODIFIED)
*         FOR ALL WORKING FILES.
*
*         ENTRY -
*T FET+8  12/NF, 6/, 18/SB, 2/, 1/F, 1/C, 1/M, 1/N, 18/TA
*         WHERE -
*                NF = MAXIMUM NUMBER OF FILE FNT/FST ENTRIES TO
*                     RETURN IN TABLE.  TABLE SIZE MUST BE AT LEAST
*                     NF*2+1.  FOR NEW FORMAT, TABLE MUST BE AT
*                     LEAST NF*2+2.
*                SB = SELECTIVITY BITS.  BIT SET IMPLIES FILE TYPE
*                     SELECTED.  DEFAULT (*SB*=0) IS SELECTION OF
*                     ALL FILE TYPES.  BIT POSITIONS AND CORRESPONDING
*                     FILE TYPES ARE DEFINED AS FOLLOWS -
*
*                       BIT     FILE TYPE
*                     41-38        UNUSED
*                        37          LOFT
*                        36          SYFT
*                        35          FAFT
*                        34          PMFT
*                        33          PTFT
*                        32          LIFT
*                        31      RESERVED
*                        30      RESERVED
*                        29          QFFT
*                        28          TEFT
*                        27          PHQT
*                        26          PRQT
*                        25          ROFT
*                        24          INFT
*                F  = SET INDICATES THE NEW FORMAT TWO-WORD ENTRY IS
*                     TO BE RETURNED.  BITS 18 AND 19 (*M* AND *N*)
*                     ARE NOT CHECKED IF THIS BIT IS SET, SINCE THERE
*                     IS ONLY ONE FORMAT RETURNED IF *F* IS SET.
*                C  = SET IMPLIES TREAT CHECKPOINT FILES NORMALLY
*                     (LIKE ANY OTHER FILE).  NOT SET IMPLIES WRITE
*                     CHECKPOINT FILE FNT/FST ENTRIES IN FET+9, AND
*                     ONWARD.
*                M  = SET IMPLIES MODIFY FST ENTRIES OF MS FILES
*                     WITH LENGTH OF FILE.  NOT SET IMPLIES MODIFY
*                     WITH RANDOM INDEX.
*                N  = SET IMPLIES PERFORM NO MODIFICATION OF FST
*                     ENTRIES.  NOT SET IMPLIES PERFORM PERTINENT
*                     MODIFICATIONS.
*                TA = STARTING CM TABLE ADDRESS.
*
*         IF NEW FORMAT IS REQUESTED (*F* SET) -
*         (TA) = 48/, 12/ADDR
*
*         WHERE -
*                ADDR  = 0, IF FIRST *GETFNT* CALL.
*                      = FWA OF THE LAST FNT ENTRY IN NFL PROCESSED BY
*                        LAST *GETFNT* CALL.
*
*         EXIT   IF *N* NOT SET -
*                (FET+8) .LT. 0 IF AT LEAST 1 ERROR ENCOUNTERED.
*                IF *C* NOT SET -
*                (FET+9) = CHECKPOINT FILE FNT.
*                        = 0 IF NONE PRESENT (USER MUST PRESET).
*                        .LT. 0 IF MORE THAN TWO.
*                (FET+10)= FST.
*                (FET+11)= ALTERNATE CHECKPOINT FILE FNT.
*                        = 0 IF NO ALTERNATE (USER MUST PRESET).
*                (FET+12)= FST.
*
*         WRITES TABLE OF FNT/FST ENTRIES TO A CENTRAL MEMORY TABLE
*         AND TERMINATES WITH A ZERO WORD.  IF THE NEW FORMAT IS
*         REQUESTED (BIT 21 SET), THE FIRST WORD OF THE TABLE
*         CONTAINS AN ADDRESS AND THE FIRST FNT ENTRY
*         BEGINS IN THE SECOND WORD OF THE TABLE.  FOR MASS
*         STORAGE FILES, BYTES 2 AND 3 OF FST ENTRY CAN BE MODIFIED
*         WITH EITHER A RANDOM INDEX (CONVERTED FROM CURRENT TRACK
*         AND SECTOR), OR THE FILE S LENGTH (NUMBER OF SECTORS).
*         OPTIONALLY, FOR TAPE FILES, FST ENTRY CAN BE MODIFIED
*         WITH *MT* IN BYTE 1 AND BLOCK NUMBER IN BYTES 2 AND 3.
*         MODIFICATION CAN BE DONE ONLY IF THE OLD FORMAT
*         IS TO BE RETURNED IN THE TABLE.
*
*         IF NEW FORMAT IS SELECTED (*F* SET) -
*         (TA) = 48/, 12/ADDR
*
*         WHERE -
*                ADDR  = 0, IF SEARCH COMPLETE.
*                      = FWA OF THE LAST FNT ENTRY IN NFL PROCESSED
*                        BY THIS *GETFNT* CALL.
*
*         OLD FORMAT OF TWO-WORD TABLE ENTRY RETURNED (*F* NOT SET) -
*
*T        42/FILENAME, 1/, 3/M, 1/, 1/W, 6/FT, 6/FS
*T,       12/EQ,48/D
*
*         NEW FORMAT OF TWO-WORD TABLE ENTRY RETURNED (*F* SET) -
*
*T        42/ FILENAME,3/ AL,2/ I,1/W,6/ FT,6/ FS
*T+1      24/FL ,24/RB, 3/RES, 1/F ,4/M 3/RS, 1/L
*
*         WHERE -
*                AL = FILE ACCESS LEVEL.
*                D  = INFORMATION DEPENDS ON FILE TYPE AND/OR WHETHER
*                      OR NOT FST MODIFICATION IS SELECTED.
*                     IF TTY FILE -
*                     D = 12/*TT*, 36/
*                     IF TAPE FILE -
*                     D = 12/*MT*, 24/BLOCK COUNT, 12/
*                     IF MS FILE AND *M* SET -
*                     D = 12/, 24/RANDOM INDEX, 12/
*                     IF MS FILE AND *M* NOT SET -
*                     D = 12/, 24/FILE LENGTH, 12/
*                     IF OPTICAL DISK FILE AND *M* SET -
*                     D = 12/*OD*, 24/RANDOM INDEX, 12/
*                     IF OPTICAL DISK FILE AND *M* NOT SET -
*                     D = 12/*OD*, 24/FILE LENGTH, 12/
*                EQ = EST ORDINAL.
*                FL = FILE LENGTH (IF MS).
*                   = 0 (IF TAPE, TTY, OR OTHER).
*                FS = FILE STATUS.
*                FT = FILE TYPE.
*                I  = 0, IF MS FILE.
*                   = 1, IF TAPE FILE.
*                   = 2, IF TTY FILE.
*                   = 3, IF NOT MS, TAPE, OR TTY FILE.
*                L  = SET IF LAST OPERATION WAS WRITE.
*                M  = MODE OF USE ALLOWED.
*                     NEW FORMAT -
*                     0 = READ.
*                     1 = WRITE.
*                     2 = MODIFY.
*                     3 = APPEND.
*                     4 = EXECUTE.
*                     5 = READ ALLOW MODIFY.
*                     6 = READ ALLOW APPEND.
*                     7 = UPDATE.
*                     10 = READ ALLOW UPDATE.
*                     11-17 = RESERVED.
*                     OLD FORMAT -
*                     BIT 16 - SET IF EXTEND-ONLY FILE.
*                     BIT 15 - SET IF ALTER-ONLY FILE.
*                     BIT 14 - SET IF EXECUTE-ONLY FILE.
*                RB = RANDOM INDEX (IF MS).
*                   = BLOCK COUNT (IF TAPE).
*                   = 77777777 (IF TAPE BUT *MAGNET* NOT PRESENT.)
*                   = 0 (IF TTY OR OTHER).
*                F  = THE FILE ERROR STATUS.  SET IF THE FILE IS
*                     ON A DEVICE THAT IS NOT AVAILABLE.
*                RS = READ STATUS (MS ONLY).
*                     0 = INCOMPLETE READ.
*                     1 = EOR.
*                     2 = EOF.
*                     3 = EOI.
*                     4 = BOI.
*                     5-7 = RESERVED.
*                S  = SET IF SYSTEM SECTOR CONTAINS CONTROL
*                     INFORMATION.
*                W  = SET IF WRITE LOCKOUT.
 
 
          ENTRY  GTF
          RJM    CPA         READ FET+CFPN
          ADN    CGNT
          CRD    CN
          RJM    CCP         CRACK CALLING PARAMETERS
          MJN    GTF1        IF ERROR
          LDD    CN+3        CHECK IF TABLE WITHIN RANGE
          SHN    14
          LMD    CN+4
          ADD    CN
          ADD    CN
          ADN    1
          ADD    FT+1
          SHN    -6
          SBD    FL
          MJN    GTF3        IF WITHIN RANGE
          LDN    /ERR/GTL    * GETFNT TABLE TOO LARGE.*
          UJN    GTF2       ABORT
 
 GTF1     LDN    /ERR/FTS    * FET TOO SHORT.*
 GTF2     LJM    ERR         PROCESS ERROR
 
*         DETERMINE FNT ENTRY FROM WHICH TO BEGIN SCAN.
 
 GTF3     LDC    FNTN-LENF   FWA OF FNTS IN NFL
          STD    FT+4
          LDD    FT+1
          ZJN    GTF7        IF OLD FORMAT
          LDD    CN+4        SAVE FWA OF TABLE
          STM    GTFA+1
          LDD    CN+3        READ FIRST WORD OF TABLE
          STM    GTFA
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    FS
          LDD    FS+4
          ZJN    GTF6        IF NO ADDRESS
          SBD    FT+4        (ADDRESS) - (FWA OF FNT-S)
          MJN    GTF4        IF ADDRESS OUT OF RANGE
          LDD    FT
          SHN    6
          SBD    FS+4        (LWA OF FNT-S) - (ADDRESS)
          PJN    GTF5        IF ADDRESS NOT OUT OF RANGE
 GTF4     LDN    /ERR/AOR    * ADDRESS OUT OF RANGE.*
          UJN    GTF2        PROCESS ERROR
 
 GTF5     LDD    FS+4
          STD    FT+4        SAVE ADDRESS (LAST FNT PROCESSED)
 GTF6     AOD    CN+4        ADVANCE TABLE ADDRESS (NEW FORMAT ONLY)
          SHN    -14
          RAD    CN+3
 
*         SCAN FNT FOR FILES REQUESTED.
 
 GTF7     LDN    LENF        GET NEXT FNT ENTRY
          RAD    FT+4
          SHN    -6
          SBD    FT
          MJN    GTF8        IF NOT END OF FNTS
          LDN    0           CLEAR FNT ADDRESS
          STD    FT+4
          LJM    GTF15       TERMINATE SCAN
 
 GTF8     NFA    FT+4,R
          CRD    FN          FNT
          ADN    FSTL
          CRD    FS          FST
          ADN    FUTL-FSTL
          CRD    CM          FUT
          LDD    CM+2        GET FILE ACCESS LEVEL
          SHN    3
          LPN    70
          STD    AL
          LDD    FN
          ZJN    GTF7        IF EMPTY ENTRY
          RJM    CFS         CHECK FILE SELECTIVITY
          PJN    GTF7        IF FILE NOT SELECTED
          LDD    FT+1
          ZJN    GTF9        IF OLD FORMAT
          RJM    RFE         REFORMAT FNT ENTRY (NEW FORMAT ONLY)
          LDD    AL          SET FILE ACCESS LEVEL IN FNT ENTRY
          RAD    FN+3
          UJN    GTF10       MODIFY FST
 
 GTF9     LDD    CB          CHECK IF FST MODIFICATION DESIRED
          SHN    21-0
          MJN    GTF11       IF NO MODIFICATION DESIRED
 GTF10    RJM    MFF
          NJP    GTF7        IF ERROR EXIT
 
*         CHECK FOR CHECKPOINT FILE.
 
 GTF11    LDD    CB          CHECK FOR NORMAL TREATMENT
          SHN    21-2
          MJN    GTF14       IF CHECKPOINT FILES TO BE TREATED NORMALLY
          LDD    FN+4
          LPN    77
          LMN    CBST
          ZJN    GTF12       IF CHECKPOINT FILE TYPE *CB*
          LMN    CKST&CBST
          NJN    GTF14       IF NOT CHECKPOINT FILE TYPE *CK*
 GTF12    RJM    PCF         PROCESS CHECKPOINT FILE
          NJN    GTF15       IF ERROR
 GTF13    LJM    GTF7        GET NEXT FNT ENTRY
 
*         ENTER FNT/FST IN TABLE AND ADVANCE TABLE POINTER.
 
 GTF14    LDD    CN+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWD    FN
          ADN    FSTL
          CWD    FS
          LDN    2           ADVANCE TABLE POINTER
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SOD    CN          DECREMENT FILE COUNTER
          NJN    GTF13       IF TABLE NOT FULL
 
*         TERMINATE SCAN.
 
 GTF15    LDN    ZERL        CLEAR LAST WORD OF TABLE
          CRD    CM
          LDD    CN+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWD    CM
          LDD    FT+1
          ZJN    GTF16       IF OLD FORMAT
          LDD    FT+4        SAVE ZERO OR LAST FNT PROCESSED
          STD    CM+4
          LDM    GTFA        REWRITE FIRST WORD OF TABLE
          SHN    6
          ADD    RA
          SHN    6
          ADM    GTFA+1
          CWD    CM
 GTF16    RJM    CPA         RESET FILE NAME
          CRD    FN
          LJM    LFMX        EXIT
 
 
 GTFA     BSS    2           FWA OF TABLE
          TITLE  PRIMARY
 PRI      SPACE  4,10
***       FUNCTION 31.
*         MAKE FILE PRIMARY.
*         THIS FUNCTION MAKES THE SPECIFIED FILE THE USER S NEW
*         PRIMARY FILE. ANY EXISTING PRIMARY, WHICH IS NOT THE
*         SPECIFIED FILE, IS CHANGED TO TYPE *LOFT*.
*         THE SPECIFIED FILE MUST BE OF TYPE LOCAL AND BE A MASS
*         STORAGE FILE TO BE MADE PRIMARY.
*         THE FILE S FST ADDRESS IS SET INTO THE CPA.
          SPACE  4,10
**        PRI - PROCESS PRIMARY FUNCTION.
*
*         ENTRY  (FN - FN+3) = WORKING FILE NAME TO BE MADE PRIMARY.
*                (FF) = INITIAL FNT ADDRESS FOR SEARCH.
*
*         EXIT   (FN - FN+3) = WORKING FILE NAME TO BE MADE PRIMARY.
*                (FA) = FNT ENTRY ADDRESS.
*                (FS - FS+4) = FST ENTRY.
 
 
          ENTRY  PRI
          LDD    FF          SET INITIAL FNT ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    PRI1        IF FOUND
          LDN    NEEQ        SET NULL EQUIPMENT
          STD    EQ          CREATE NULL PRIMARY FILE
          RJM    EFN         ENTER FILE NAME
          UJN    PRI3        CHECK IF FILE ALREADY PRIMARY
 
 PRI1     RJM    SFB         SET FILE BUSY
          ZJN    PRI3        IF NO REJECT ON FILE INTERLOCK
 PRI2     LDN    /ERR/IOE    * I/O SEQUENCE ERROR.*
          UJN    PRI6        PROCESS ERROR
 
 PRI3     LDD    CP          READ CPA WORD
          ADN    TFSW
          CRD    CN
          LDD    CN+1
          LMD    FA
          ZJP    LFMX        IF SPECIFIED FILE IS ALREADY PRIMARY
          NFA    FA,R        CHECK FILE TYPE
          CRD    CM
          LDD    CM+4
          SHN    -6
          LMN    LOFT
          ZJN    PRI7        IF *LOCAL*
          LDN    /ERR/IFT    * INCORRECT FILE TYPE.*
 PRI6     LJM    ERR         PROCESS ERROR
 
 PRI7     LDD    FS          CHECK FOR MASS STORAGE
          ZJN    PRI8        IF NO EQUIPMENT ASSIGNED
          LMN    NEEQ
          ZJN    PRI8        IF NULL EQUIPMENT
          SFA    EST,FS
          ADK    EQDE
          CRD    T1
          LDD    T1
          SHN    21-13
          MJN    PRI8        IF MASS STORAGE FILE
          LDN    /ERR/IEQ    * INCORRECT EQUIPMENT.*
          UJN    PRI6        PROCESS ERROR
 
 PRI8     LDD    FS+2
          NJP    PRI12       IF NOT AN EMPTY FILE
          LDD    FS+1
          NJP    PRI11       IF NOT A NULL FILE
          LDD    CP          GET JOB ACCESS LEVEL
          ADK    JSCW
          CRD    CM
          LDD    CM+1
          SHN    -11
          STD    AL
          LDN    ZERL        CLEAR *RTCM* PARAMETERS
          CRD    CM
          LDN    FSMS+1      SET SECTORS REQUESTED PARAMETER
          STD    CM+4
          LDN    PRIS        SET *RTCM* PARAMETER FOR PRIMARY FILE
          STD    CM+2
          AOM    PRIA
          LDD    AL          SET ACCESS LEVEL SELECTION
          ADN    40
          SHN    6
          STD    CM+3
          MONITOR RTCM       ASSIGN MASS STORAGE SPACE
          LDD    CM+4        SET FIRST TRACK
          NJN    PRI10       IF MASS STORAGE SPACE AVAILABLE
          LDD    CM+3        CHECK *RTCM* REJECT REASON CODE
          LMN    2
          ZJN    PRI9        IF REJECT BECAUSE OF ACCESS LEVEL
          LDN    /ERR/NMA&/ERR/WEQ  * NO MASS STORAGE AVAILABLE.*
 PRI9     LMN    /ERR/WEQ    * EQUIPMENT NOT AVAILABLE.*
          LJM    ERR         ISSUE ERROR
 
 PRI10    STD    FS+1
          LDD    CM+1        SET EST ORDINAL
          STD    FS
          NFA    FA,R        UPDATE FST FOR *COMPWEI*
          ADN    FSTL
          CWD    FS
          UJN    PRI11.1     WRITE SYSTEM SECTOR AND EOI
 
 PRI11    LPC    3777        ONLY SET SECTOR IN TRACK BYTE
          STD    CM+2
          LDD    FS          SET EST ORDINAL
          STD    CM+1
          LDN    FSMS        SET SECTOR
          STD    CM+3
          MONITOR  DTKM      SET EOI SECTOR IN TRT
 PRI11.1  LDD    FS+1        UPDATE CURRENT TRACK
          STD    T6          SET FIRST TRACK PARAMETER
          LDD    HN          UPDATE STATUS BYTE OF FST
          STD    FS+4
          LDD    FS
          STD    T5
          SETMS  IO
          RJM    WSS         WRITE SYSTEM SECTOR
          RJM    WEI         WRITE EOI
          ENDMS
          NFA    FA,R        RE-READ FNT ENTRY
          CRD    CM
 PRIA     LDN    0
*         LDN    1           (MASS STORAGE SPACE ALLOCATED)
          ZJN    PRI12       IF NO SECTORS ALLOCATED
          LDM    SLM
          STM    DPPB+1
 PRI12    LDD    FS+1        REWIND FILE
          STD    FS+2
          LDN    FSMS
          STD    FS+3
          LDD    FS+4        UPDATE STATUS BYTE OF FST
          SCN    77
          LMN    4
          STD    FS+4
 
*         CHANGE EXISTING PRIMARY FILE TO TYPE *LOFT*.
 
          LDD    CN+1
          ZJP    PRI17       IF NO PRIMARY FILE CURRENTLY EXISTS
          LDD    FA          SAVE LOCAL FILE FNT ADDRESS
          STD    CB
          NFA    FA,R        WRITE FST WORD
          ADN    FSTL
          CWD    FS
          LDD    CN+1        SAVE FST ADDRESS OF EXISTING PRIMARY FILE
          STD    FA
          NFA    FA,R        READ FNT OF EXISTING PRIMARY FILE
          CRD    FS
          LDD    FS+4
          SHN    -6
          LMN    PTFT
          NJN    PRI16       IF NOT PRIMARY FILE
          RJM    SFB         SET PRIMARY FILE BUSY
          ZJN    PRI15       IF NO REJECT ON FILE INTERLOCK
          NFA    CB,R
          ADN    FSTL
          CRD    FS
          AOD    FS+4
          NFA    CB,R
          ADN    FSTL
          CWD    FS
          LJM    PRI2        PROCESS AS I/O SEQ. ERROR
 
 PRI15    LDC    LOFT*100-PTFT*100  CHANGE FILE TYPE TO LOCAL
          RAD    CM+4
          AOD    FS+4        SET FST COMPLETE
          NFA    FA,R        STORE FNT ENTRY
          CWD    CM
          ADN    FSTL
          CWD    FS
 PRI16    LDD    CB          RESTORE LOCAL FILE FNT ADDRESS
          STD    FA
          NFA    FA,R        RESTORE LOCAL FILE FNT ENTRY
          CRD    CM
          ADN    FSTL
          CRD    FS
 
*         SET NEW FILE AS PRIMARY.
 
 PRI17    LDC    PTFT*100-LOFT*100  CHANGE FILE TYPE TO PRIMARY
          RAD    CM+4
          NFA    FA,R        REWRITE FNT
          CWD    CM
          RJM    UPP         UPDATE PRIMARY FILE POINTERS
          LJM    LFMX        EXIT
          TITLE  SUBROUTINES
 CCP      SPACE  4,20
**        CCP - CRACK CALLING PARAMETERS IN FET+CGNT.
*               ALSO, A CHECK IS MADE TO SEE IF FET LENGTH IS
*               CONSISTENT WITH FET LOCATIONS USED.
*
*         ENTRY  (CN) = NUMBER OF FILE ENTRIES TO RETURN IN TABLE.
*                (CN+1 - CN+2) = SELECTIVITY BITS.
*                (CN+3) = 2/,4/CONTROL BITS,6/
*                (FE) = FET LENGTH - 1.
*
*         EXIT   (A) .GE. 0 IMPLIES FET LENGTH OK.
*                (A) .LT. 0 IMPLIES FET LENGTH IN ERROR.
*                (CN) = NUMBER OF FILE ENTRIES.
*                (SB - SB+1) = SELECTIVITY BITS.
*                (CB) = CONTROL BITS - RIGHT JUSTIFIED.
*                (CN+3) - CONTROL BITS CLEARED.
*                (CN+1) - CHECKPOINT FILE COUNTER CLEARED.
*                (FT) = NFL/100B.
*                (FT+1) = FORMAT FLAG.
*
*         USES   CB, CN, CN+1, CN+3, SB, SB+1, T1, FT - FT+4.
 
 
 CCP      SUBR               ENTRY/EXIT
          LDD    CN          SET NUMBER OF FILE ENTRIES
          NJN    CCP1        IF NOT DEFAULT
          LDC    DNFS
          STD    CN
 CCP1     LDD    CN+1        SET SELECTIVITY BITS
          LPN    77
          SHN    14
          LMD    CN+2
          NJN    CCP2        IF NOT DEFAULT
          LCN    0           ALL BITS SET FOR DEFAULT
 CCP2     STD    SB+1
          SHN    -14
          STD    SB
          LDN    0           PRESET CHECKPOINT FILE COUNTER
          STD    CN+1
          LDN    10          PRESET T1 FOR FET LENGTH CHECK
          STD    T1
          LDD    CN+3        EXTRACT CONTROL BITS
          SHN    -6
          STD    CB
          SHN    21-2
          MJN    CCP3        IF TREAT CHECKPOINT FILES NORMALLY
          LDN    4
          RAD    T1
 CCP3     LDD    CP          GET NEGATIVE FL
          ADN    FLSW
          CRD    FT          NEGATIVE FL/100B
*         LDN    0           PRESET FORMAT FLAG
*         STD    FT+1
          LDD    CN+3        CHECK FOR OLD FORMAT
          SHN    21-11
          PJN    CCP4        IF OLD FORMAT
          AOD    FT+1        SET FLAG FOR NEW FORMAT
          LCN    2           RETURN FILE LENGTH TO BYTES 0 AND 1 OF FST
          RAM    MFFA
          SBN    1
          STM    MFFB
 CCP4     LDD    CN+3        CLEAR CONTROL BITS
          LPN    77
          STD    CN+3
          LDD    FE
          SBD    T1
          LJM    CCPX        EXIT
 CFS      SPACE  4,15
**        CFS - CHECK FILE SELECTIVITY.
*
*         ENTRY  (SB) AND (SB+1) = SELECTIVITY BITS.
*                (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*
*         EXIT   (A) .LT. 0  IMPLIES SELECTED.
*                (A) .GE. 0  IMPLIES NOT SELECTED.
*
*         USES   T1.
*
*         CALLS  SDQ.
 
 
 CFS      SUBR               ENTRY/EXIT
          LDD    FN+4        SET FILE TYPE
          SHN    -6
          STD    T1
          SBN    MXFT
          MJN    CFS2        IF TYPE DOES NOT EXCEED MAXIMUM
 CFS1     LDN    /ERR/IFT    * INCORRECT FILE TYPE.*
          LJM    ERR         PROCESS ERROR
 
 CFS2     LDM    TFTS,T1     SET SHIFT INSTRUCTION
          ZJN    CFS1        IF INCORRECT FILE TYPE
          STM    CFSA
          LDD    SB          LOAD SELECTIVITY MASK
          SHN    14
          LMD    SB+1
 CFSA     SHN    **
          MJN    CFSX        IF FILE SELECTED
 
*         FOR COMPATIBILITY, CHECK FOR *PRQT* OR *PHQT*.
 
          LDD    T1
          LMN    QFFT
          NJN    CFSX        IF FILE MAPPING NOT REQUIRED
          LDD    SB+1
          LPN    14
          ZJN    CFSX        IF *PRQT* AND *PHQT* NOT SELECTED
          RJM    SDQ         SET DISPOSITION CODE
          ZJN    CFSX        IF NOT *PRQT* OR *PHQT*
*         LDD    SB
*         SHN    14
*         LMD    SB+1
          LDD    SB+1
 CFSB     SHN    **          (SET BY *SDQ*)
          UJN    CFSX        RETURN
 CMS      SPACE  4,10
**        CMS - CHECK FOR MASS STORAGE RESIDENT FILE.
*
*         ENTRY  (FS - FS+4) = FILE FST ENTRY.
*
*         EXIT   (A) .LT. 0, IF FILE IS ON MASS STORAGE.
*                (CM - CM+4) = EST ENTRY FOR FILE.
*                (T5) = EST ORDINAL.
*
*         USES   T5, CM - CM+4.
*
*         MACROS SFA.
 
 
 CMS      SUBR               ENTRY/EXIT
          LDD    FS          SET EST ORDINAL
          STD    T5
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-13       POSITION MASS STORAGE BIT
          UJN    CMSX        RETURN
 MFF      SPACE  4,20
**        MFF - MODIFY FILE S FST.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*                (FN - FN+4) = FNT WORD, IF NEW FORMAT REQUESTED.
*                (CB) = CONTROL BITS.
*                (FT+1) = FORMAT FLAG.
*                (FT+4) = FNT ADDRESS.
*
*         EXIT   (A) = 0 IMPLIES NORMAL RETURN.
*                (A) .NE. 0 IMPLIES ERROR EXIT.
*                (FS - FS+4) = MODIFIED FST.
*                (FN+3) UPDATED, IF TAPE FILE AND NEW FORMAT REQUESTED.
*
*         USES   T2, T3, T5, T6, T7, CM - CM+4, FN - FN+4 (ONLY IF
*                NEW FORMAT REQUESTED OR IF ERROR RETURN).
*
*         CALLS  CMS, CPA, SEI, SPA.
*
*         MACROS DELAY, MONITOR, PAUSE.
*
*         ERROR  FET+CGNT IS SET NEGATIVE.
 
 
 MFF      SUBR               ENTRY/EXIT
          RJM    CMS         CHECK FOR MASS STORAGE RESIDENT FILE
          PJN    MFF1        IF NOT MASS STORAGE FILE
          LJM    MFF12       PROCESS MASS STORAGE FILE
 
 MFF1     LDD    CM+3
          LMN    1RT
          SHN    14
          LMN    1RM
          ZJN    MFF1.1      IF *MT*
          LMN    1RN&1RM
          ZJN    MFF1.1      IF *NT*
          LMN    1RC&1RN
          ZJN    MFF1.1      IF *CT*
          LMN    1RA&1RC
 MFF1.1   ZJN    MFF6        IF *AT*
          LMN    1RT&1RA
          ZJN    MFF2        IF *TT*
          LDD    CM+3
          LMC    2ROD
          ZJP    MFF21       IF *OD*
 
*         FILE IS NOT MASS STORAGE, TAPE, OPTICAL DISK OR TTY.
 
          LDD    FT+1
          ZJN    MFF4        IF OLD FORMAT
          LDN    3S1         SET NON-MS, TAPE, TTY FILE
          UJN    MFF3        CLEAR FST INFORMATION
 
*         TTY FILE.
 
 MFF2     LDC    2RTT        SHOW TTY FILE
          STD    FS+1
          LDD    FT+1
          ZJN    MFF5        IF OLD FORMAT
          LDN    1S2         SET TTY FILE
 MFF3     RAD    FN+3
          LDN    0           CLEAR FILE LENGTH
          STD    FS
          STD    FS+1
 MFF4     STD    FS+2        CLEAR RANDOM INDEX/BLOCK COUNT
          STD    FS+3
 MFF5     LJM    MFFX        RETURN
 
*         TAPE FILE.
 
 MFF6     LDD    FS+1        GET USER DESCRIPTOR TABLE ADDRESS
          ADN    /MTX/UST2
          STD    CM+4
          LDN    0           SET READ
          STD    CM+1
          LDD    HN          SET WORD COUNT
          STD    CM+3
          LCN    7777-MTSI   SET *MAGNET* SUBSYSTEM ID
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          ZJN    MFF8        IF COMPLETE
          SBN    2
          PJN    MFF7        IF *MAGNET* NOT PRESENT
          PAUSE
          DELAY
          LDD    CM+1
          NJN    MFF11       IF ERROR
          UJN    MFF6        TRY AGAIN
 
 MFF7     LDD    FT+1
          ZJN    MFF11       IF OLD FORMAT
          LCN    0
          STD    FS+2
          STD    FS+3
          UJN    MFF9        SET TAPE FILE
 
*         SET CURRENT BLOCK COUNT.
 
 MFF8     LDD    MA          SAVE BLOCK COUNT
          CRD    CM
          LDD    CM+2
          STD    FS+2
          LDD    CM+3
          STD    FS+3
          LDD    FT+1
          ZJN    MFF10       IF OLD FORMAT
 MFF9     LDN    1S1         SET TAPE FILE
          RAD    FN+3
          LJM    MFF17       CLEAR FILE LENGTH
 
 MFF10    LDC    2RMT        SET TAPE FILE
          STD    FS+1
          UJN    MFF15       RETURN
 
*         SET ERROR PARAMETER IN FET.
 
 MFF11    LCN    0           SET ERROR EXIT
          STD    FN
          RJM    CPA
          ADN    CGNT
          CWD    FN
          LJM    MFFX        RETURN
 
*         MASS STORAGE FILE.
 
 MFF12    LDD    FT+1
          NJN    MFF13       IF NEW FORMAT
          LDD    CB          CHECK TYPE OF MODIFICATION DESIRED
          SHN    21-1
          MJN    MFF16       IF FILE LENGTH REQUESTED
 
*         RETURN RANDOM INDEX.
 
 MFF13    LDD    FS+2        SET TRACK
          STD    RI+1
          ZJN    MFF14       IF FILE NOT USED
          STD    T6
          LDD    FS+3        SET SECTOR
          STD    T7
          LDD    FS+1        SET FIRST TRACK
          RJM    SRA         SET RANDOM ADDRESS
          NJN    MFF11       IF ERROR
          LDD    RI          SET ADDRESS IN FST
 MFF14    STD    FS+2
          LDD    RI+1
          STD    FS+3
          LDD    FT+1
          NJN    MFF16       IF NEW FORMAT
 MFF15    LDN    0
          LJM    MFFX        RETURN
 
*         RETURN FILE LENGTH.
 
 MFF16    LDD    FS+1        SET FIRST TRACK
          ZJN    MFF18       IF FILE NOT USED
          STD    T6
          RJM    SEI         DETERMINE FILE LENGTH
          LCN    FSMS        DO NOT COUNT SYSTEM SECTOR
          RAD    T3
          PJN    MFF20       IF NO UNDERFLOW
          SOD    T2          COMPENSATE FOR UNDERFLOW
          PJN    MFF19       IF SECTORS ASSIGNED TO FILE
 MFF17    LDN    0
 MFF18    STD    T2
          UJN    MFF20       CLEAR FILE LENGTH
 
 MFF19    AOD    T3          COMPENSATE FOR ONES COMPLEMENT SUBTRACTION
 MFF20    STD    FS+3
 MFFA     EQU    *-1
*         STD    FS+1        (NEW FORMAT)
          LDD    T2
 MFFB     STD    FS+2
*         STD    FS          (NEW FORMAT)
          UJN    MFF15      RETURN
 
*         OPTICAL DISK FILE.
 
 MFF21    LDD    FT+1
          NJN    MFF22       IF NEW FORMAT
          LDD    CB          CHECK TYPE OF MODIFICATION DESIRED
          SHN    21-1
          MJN    MFF23       IF FILE LENGTH REQUESTED
 
*         RETURN RANDOM ADDRESS.
 
 MFF22    LDD    FS+2        SET RANDOM ADDRESS
          STD    FS+3
          LDD    FS+1
          STD    FS+2
 MFF23    LDC    2ROD        SET OPTICAL DISK FILE
          STD    FS+1
          LDD    FT+1
          NJN    MFF24       IF NEW FORMAT
          LDD    CB          CHECK MODIFICATION TYPE
          SHN    21-1
          PJP    MFF15       IF FILE LENGTH NOT REQUESTED
 
*         RETURN FILE LENGTH.
 
 MFF24    LDD    FT+4        GET FNT ORDINAL
          NFA    FT+4,R
          ADN    FUTL
          CRD    CM
          LDD    CM+3        SET FILE LENGTH IN FST
          STD    T2
          LDD    CM+4
          LJM    MFF20       RETURN FILE LENGTH
 PCF      SPACE  4,20
**        PCF - PROCESS CHECKPOINT FILE.
*
*         ENTRY  (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*                (CN+1) = CHECKPOINT FILE COUNTER.
*                (IR+3 - IR+4) = FET+0 ADDRESS.
*
*         EXIT   (A) = 0 IMPLIES NORMAL RETURN.
*                (A) .NE. 0 IMPLIES ERROR EXIT - MORE THAN TWO
*                           CHECKPOINT FILES EXIST.
*                FN - FN+4 RESET (ON ERROR RETURN ONLY).
*
*         USES   CM (ON ERROR RETURN ONLY), CN+1.
*
*         CALLS  CPA.
*
*         ON ERROR RETURN, FET+CGNT+1 IS MADE NEGATIVE.
 
 
 PCF      SUBR               ENTRY/EXIT
          LDN    2           INCREMENT CHECKPOINT FILE COUNTER
          RAD    CN+1
          LMN    6
          NJN    PCF1        IF NOT TOO MANY CHECKPOINT FILES
          LCN    0           SET ERROR
          STD    CM
          RJM    CPA         READ FET FILE NAME
          CRD    FN
          ADN    CGNT+1      SET ERROR RETURN
          CWD    CM
          UJN    PCFX        ERROR EXIT
 
*         ENTER CHECKPOINT FILE FNT/FST INTO FET.
 
 PCF1     RJM    CPA
          ADN    CGNT-1
          ADD    CN+1
          CWD    FN
          ADN    1
          CWD    FS
          LDN    0
          UJN    PCFX        EXIT
 RFE      SPACE  4,15
**        RFE - REFORMAT FNT ENTRY.
*
*         ENTRY  (CM+3) = EQUIPMENT MNEMONIC.
*                (FN - FN+4) = FNT.
*
*         ENTRY  (FN - FN+4) = FNT.
*                (FS - FS+4) = FST.
*
*         EXIT   (FN - FN+4) = NEW FORMAT FNT.
*                (FS - FS+4) = NEW FORMAT FST.
*
*         USES   FN+3, FS+4, T4, CM+1 - CM+3.
*
*         CALLS  CMS.
*
*         MACROS MONITOR, SETMS.
 
 
 RFE      SUBR               ENTRY/EXIT
          RJM    CMS         CHECK FOR MASS STORAGE RESIDENT FILE
          MJN    RFE1        IF MS RESIDENT
          LDD    CM+3
          LMC    2ROD
          STD    CM+3
          ZJN    RFE1        IF OPTICAL DISK
          LDD    FS+4        CLEAR READ STATUS AND REFORMAT
          SHN    -1
          LPN    1
          STD    FS+4
          UJN    RFE1.0      REFORMAT ACCESS MODE
 
 RFE1     LDD    FS+4
          SHN    -1
          LPN    7
          STD    FS+4
          LDD    CM+3
          NJN    RFE1.1      IF MASS STORAGE
          LDD    FS+1
          ADD    FS+2
          ZJN    RFE1.2      IF AT BOI
 RFE1.0   UJN    RFE2        REFORMAT ACCESS MODE
 
 RFE1.1   BSS    0
*         LDD    FS          (SET UP BY *CMS*)
*         STD    T5
          SETMS  STATUS      DETERMINE DEVICE ACCESSIBILITY
          LDM    MSD         RETURN STATUS TO CALLER
          SHN    10-6
          LPC    400         SET FILE ACCESSIBILITY FLAG
          RAD    FS+4
          LDD    FS+1
          ZJN    RFE2        IF EMPTY FILE
          LMD    FS+2
          NJN    RFE2        IF FIRST TRACK .NE. CURRENT TRACK
          LDD    FS+3
          LMN    FSMS
          NJN    RFE2        IF CURRENT SECTOR .NE. *FSMS*
 RFE1.2   LDD    FS+4        SET BOI STATUS
          LPC    401
          ADN    10
          STD    FS+4
 RFE2     LDN    0           REFORMAT FILE ACCESS MODE
          STD    T4
 RFE3     LDM    TAFM,T4     CHECK TABLE
          LMD    FN+3
          LPN    35          IGNORE *DIAGNOSTIC*, *UATTACH* STATUS
          ZJN    RFE4        IF MATCH
          AOD    T4
          LMN    TAFML
          NJN    RFE3        IF NOT END OF TABLE
          LDN    SWET        SET SYSTEM SOFTWARE ERROR FLAG
          STD    CM+2
          LDC    *           SET ADDRESS WHERE ERROR DETECTED
          STD    CM+1
          MONITOR  CHGM      CONDITIONALLY HANG PP
*         LDN    0
          UJN    RFE5        RETURN ZERO FOR FILE PERMISSION
 
 RFE4     LDM    TAFM,T4     GET EQUIVALENT MODE VALUE FROM TABLE
          SHN    -6
          SHN    4
 RFE5     RAD    FS+4
          LDD    FN+3        CLEAR FILE ACCESS MODE FROM FNT
          SCN    76
          STD    FN+3
          LJM    RFEX        RETURN
 SDQ      SPACE  4,15
**        SQD - SEARCH QFT FOR DISPOSITION CODE.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*
*         EXIT   (CFSA) = SHIFT COUNT FOR GETFNT SELECTIVITY BITS
*                IF TYPE PHQT OR PRQT.
*                (A) = 0 IF DISPOSITION CODE NOT PHQT OR PRQT.
*
*         USES   T1 - T6, CM - CM+4.
*
*         MACROS  SFA.
 
 
 SDQ5     LDN    0           SET FLAG
 
 SDQ      SUBR               ENTRY/EXIT
          LDN    QFTP        GET NUMBER OF QFT ENTRIES
          CRD    CM
          LDN    0           SET COUNTER
          STD    CM
 
*         SEARCH QFT TO DETERMINE DISPOSITION CODE.
 
 SDQ1     AOD    CM          INCREMENT QFT ORDINAL
          LMD    CM+2
          ZJN    SDQX        IF NO MORE ENTRIES
 SDQ2     SFA    QFT,CM      ACCESS QFT ENTRIES
          CRD    T2
          ADN    ENTQ-JSNQ   GET EQUIPMENT AND FIRST TRACK
          CRD    T1          COMPARE EQUIPMENT
          LDD    FS
          SBD    T1
          NJN    SDQ1        IF NOT SAME EQUIPMENT
          LDD    FS+1        COMPARE FIRST TRACK
          SBD    T2
          NJN    SDQ1        IF NOT SAME FIRST TRACK
          LDD    T2+4        DETERMINE DISPOSITION CODE
          SHN    -11
          LMN    PHQT
          NJN    SDQ3        IF NOT PUNCH QUEUE TYPE
          LDC    SHNI+16
          UJN    SDQ4        STORE COUNT
 
 SDQ3     LMN    PRQT&PHQT
          NJN    SDQ5        IF NOT PRINT OR PUNCH QUEUE TYPE
          LDC    SHNI+17
 SDQ4     STM    CFSB        SET SHIFT INSTRUCTION
          LJM    SDQX        RETURN
 WDS      SPACE  4,10
**        WDS - WRITE MASS STORAGE.
*
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS.
*
*         EXIT   (A) .GE. 0.
*
*         ERROR  TO *EER*.
*
*         CALLS  WDS.
 
 
 WDS      SUBR               ENTRY/EXIT
          RJM    //WDS
          PJN    WDSX        IF SUCCESSFUL WRITE
          LJM    EER         EVALUATE ERROR RETURN
 TAFM     SPACE  4,10
**        TAFM - TABLE OF FILE MODES.
*
*         TABLE IS IN THE FOLLOWING FORMAT.
*
*         6/EV,6/FM
*
*         WHERE  FM = FILE ACCESS MODE OBTAINED FROM THE FNT.
*                EV = EQUIVALENT MODE VALUE TO BE RETURNED TO CALLER.
 
 TAFM     BSS    0
          LOC    0
          VFD    6/0,6/1     READ
          VFD    6/1,6/0     WRITE
          VFD    6/2,6/30    MODIFY
          VFD    6/3,6/20    APPEND
          VFD    6/4,6/4     EXECUTE (INDIRECT ACCESS PERMANENT FILE)
          VFD    6/4,6/5     EXECUTE (DIRECT ACCESS PERMANENT FILE)
          VFD    6/5,6/31    READ/ALLOW MODIFY
          VFD    6/6,6/21    READ/ALLOW APPEND
          VFD    6/7,6/10    UPDATE
          VFD    6/10,6/11   READ/ALLOW UPDATE
          LOC    *O
 TAFML    EQU    *-TAFM
 TFTS     SPACE  4,10
**        TFTS - TABLE OF FILE TYPE SHIFTS.
 
 
 TFTS     INDEX
          INDEX  ROFT,SHNI+20
          INDEX  LIFT,SHNI+11
          INDEX  PTFT,SHNI+10
          INDEX  PMFT,SHNI+7
          INDEX  FAFT,SHNI+6
          INDEX  SYFT,SHNI+5
          INDEX  LOFT,SHNI+4
          INDEX  INFT,SHNI+21
          INDEX  QFFT,SHNI+14
          INDEX  MXFT        END OF TABLE
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPWEI
*CALL     COMPWSS
          SPACE  4,10
          ERRNG  OVL0-*      CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
          OVERFLOW  OVL
          SPACE  4,10
          TTL    LFM - LOCAL FILE MANAGER.
          END