LFM 
          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 
