1AJ 
          IDENT  1AJ,AJS     ADVANCE JOB STATUS 
          PERIPH
          BASE   MIXED
          SST 
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
*COMMENT  1AJ - ADVANCE JOB STATUS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  1AJ - ADVANCE JOB STATUS.
          SPACE  4,10 
***       1AJ - ADVANCE JOB STATUS. 
* 
*         G. R. MANSFIELD.   70/12/20.
*         R. E. TATE.        70/12/20.
*         D. A. HIVELEY.     72/11/20.
*         P. D. FARRELL.     81/03/17.
          SPACE  4,25 
***       *1AJ* IS CALLED TO ADVANCE THE STATUS OF AN EXECUTING 
*         JOB.  THE TYPE OF CALL MAY BE ANY ONE OF THE FOLLOWING: 
* 
*                1.   JOB INITIATION - CALLED BY *1SJ* TO STARTUP 
*                     A JOB AT THE CONTROL POINT. 
* 
*                2.   JOB ADVANCEMENT - CALLED BY *CPUMTR* WHEN 
*                     THERE IS NO ACTIVITY AT THE CONTROL POINT.
* 
*                3.   ROLLOUT REQUEST - CALLED BY *CPUMTR* WHEN 
*                     A PPU HAS REQUESTED THAT THE CONTROL POINT
*                     BE ROLLED OUT (E.G. *ROCM* REQUEST).
* 
*                4.   *SSJ=* AND *DMP=* PROCESSING - CALLED BY *1RO*, 
*                     *1RI*, AND *DIS*. 
* 
*                5.   ERROR PROCESSING - CALLED BY *CPUMTR* WHEN
*                     AN ERROR FLAG IS SET FOR THE JOB. 
* 
*                6.   COMMAND PROCESSING - CALLED BY *DIS*
*                     AND OTHER PPU PROGRAMS TO EXECUTE A CONTROL 
*                     COMMAND FOR THE JOB.
          SPACE  4,10 
***       CALL. 
* 
*T        18/ *1AJ* OR *TCS*, 1/, 5/CP, 12/FC, 24/P 
* 
*                CP = CONTROL POINT NUMBER. 
*                FC = *1AJ* FUNCTION CODE.
*                P  = FUNCTION PARAMETERS.
          SPACE  4,10 
***       FUNCTION CODE 0 - *CPUMTR* CALL.
* 
*T        18/*1AJ*, 1/, 5/CP, 12/0, 12/R, 12/N
* 
*                R = 1       SET BY *1AJ* DURING *DMP=* PROCESSING
*                            IN CASE OF RECALL. 
*                N = 1       SET BY *1RO* UPON COMPLETION OF *DMP=* 
*                            PROCESSING.
*                N = 2       SET BY *DIS* FOR *SSJ=* AND *DMP=* 
*                            PROCESSING.
          SPACE  4,10 
***       FUNCTION CODE 1 - JOB SCHEDULER CALL. 
* 
*T        18/*1AJ*, 1/, 5/CP, 12/1, 12/0, 12/JO 
* 
*                JO          JOB EJT ORDINAL. 
          SPACE  4,15 
***       FUNCTION CODE 2 - *DIS* OR OTHER PP CALL. 
* 
*T        12/*1AJ*, 1/, 5/CP, 12/2, 12/0, 12/DC 
* 
*                DC BIT 0    INDICATES READ COMMAND 
*                            AND STOP PRIOR TO EXECUTION (*RSS* 
*                            INDICATOR).
* 
*                   BIT 1    INDICATES RETURN ERROR MESSAGE TO
*                            *MS2W* WITH NO ERROR FLAG IF INCORRECT 
*                            COMMAND. 
* 
*                   BIT 2    INDICATES TAKE COMMAND 
*                            FROM *MS1W* OF CONTROL POINT AREA. 
          SPACE  4,10 
***       FUNCTION CODE 3 - FROM OTHER PPU PROGRAMS.
* 
*T        18/*1AJ*, 1/, 5/CP, 12/3, 12/0, 12/0
          SPACE  4,15 
***       FUNCTION CODE 4 - COMMAND FETCH.
* 
*T        18/*TCS*, 1/, 5/CP, 12/4, 6/SF, 18/ADDR 
* 
*                SF =        SUBFUNCTION NUMBER FOR READING CONTROL 
*                            COMMAND: 
*                   = 0      ADVANCE POINTERS.
*                   = 1      READ ONLY IF NOT A LOCAL FILE LOAD,
*                            DO NOT ADVANCE POINTERS. 
*                   = 2      SET BIT 17 IN ARGUMENT COUNT IF
*                            LOCAL FILE LOAD, DO NOT ADVANCE POINTERS.
*                   = 4+     IF PARAMETERS ARE TO BE CRACKED IN 
*                            *SCOPE* FORMAT.
*                ADDR =      ADDRESS TO READ/WRITE CONTROL
*                            COMMAND FROM/TO. 
          SPACE  4,10 
***       FUNCTION CODE 5 - COMMAND READ AND EXECUTE. 
* 
*T        18/*TCS*, 1/, 5/CP, 12/5, 6/, 18/ADDR 
* 
*                ADDR =      ADDRESS WITHIN USER FL FROM WHICH TO 
*                            READ COMMAND.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * SECURE MEMORY, DUMP DISABLED.* = ATTEMPT TO DUMP
*         SECURE MEMORY.
* 
*         * SPCW CALL ERROR.* = A *DMP=* TYPE CALL WAS MADE AND THE 
*         PROGRAM CALLED IS EITHER NOT IN THE CLD OR DOES NOT HAVE A
*         *DMP=* ENTRY POINT DEFINED. 
          SPACE  4,10 
**        PROGRAMS CALLED.
* 
*         *1RI* - *DMP=* ROLLIN.
*         *1RO* - ROLLOUT JOB, NORMAL ROLLOUT AND *DMP=* ROLLOUT. 
*         *CIO* - COMPLETE SPECIAL FILES ON ERRORS. 
          SPACE  4,10 
**        ROUTINES USED.
* 
*         *0ST* - TERMINATE SCP CONNECTIONS.
          TITLE  COMMON DECKS AND MACRO DEFINITIONS.
          SPACE  4,10 
**        PRESET QUALIFICATION BLOCK ORDER. 
  
  
          QUAL
          QUAL   IJB
          QUAL   PEF
          QUAL   EFX
          QUAL   TCS
          QUAL   LDR
          QUAL   3AE
          QUAL   3AF
          QUAL   3AG
          QUAL   3AH
          QUAL   3AI
          QUAL   3AJ
          QUAL   3AK
          QUAL   ERR
          QUAL   PFM
          QUAL   REM
          QUAL   MACRO$ 
          QUAL
          SPACE  4,10 
**        DEFINE SYSTEM COMMUNICATIONS SYMBOLS. 
  
  
          SYSCOM             DEFINE SYSTEM COMMUNICATIONS SYMBOLS 
          SPACE  4,10 
**        DEFINITION COMMON DECKS.
  
  
*CALL     COMPMAC 
*CALL     COMSACC 
*CALL     COMSCPS 
*CALL     COMSDSP 
*CALL     COMSEJT 
*CALL     COMSEVT 
*CALL     COMSJCE 
*CALL     COMSJIO 
*CALL     COMSJRO 
*CALL     COMSLFD 
*CALL     COMSMSC 
*CALL     COMSMSP 
*CALL     COMSPIM 
*CALL     COMSPRD 
          QUAL   PFM
*CALL     COMSPFM 
          QUAL   *
          QUAL   REM
*CALL     COMSREM 
          QUAL   *
*CALL     COMSRPV 
*CALL     COMSSCD 
*CALL     COMSSCP 
          QUAL   SCR
*CALL     COMSSCR 
          QUAL   *
*CALL     COMSSRT 
*CALL     COMSSRU 
*CALL     COMSSSD 
*CALL     COMSSSE 
*CALL     COMSSSJ 
*CALL     COMSZOL 
          TITLE  MACRO DEFINITIONS. 
 JMP      SPACE  4,10 
**        JMP - THREADED JUMP.
* 
*         JMP    ADDR 
* 
*         ENTRY  *ADDR* = JUMP DESTINATION ADDRESS. 
* 
*         NOTE   THIS MACRO WILL THREAD BACKWARDS ONLY. 
  
  
 JMP      MACRO  ADDR 
          NOREF  .ADDR
 .A       IF     -DEF,.ADDR 
 .ADDR    MAX    ADDR,*-40
 .A       ENDIF 
 .B       IFGT   .ADDR,*-40 
          UJN    .ADDR       ASSEMBLE SHORT JUMP
 .ADDR    SET    *-1
 .B       ELSE
 .ADDR    SET    *
          LJM    ADDR        ASSEMBLE LONG JUMP 
 .B       ENDIF 
 JMP      ENDM
 LDA      SPACE  4,10 
**        LDA - LOAD ABSOLUTE CM ADDRESS. 
* 
*         LDA    X,M
* 
*         ENTRY  *X* = FIRST OF TWO DIRECT CELLS CONTAINING 
*                      RELATIVE CM ADDRESS. 
*                *M* = (OPTIONAL) IF NON-BLANK, MASK (X) WITH 
*                      5-BIT MASK.
* 
*         EXIT   (A) = ABSOLUTE CM ADDRESS. 
  
  
          PURGMAC  LDA
  
 LDA      MACRO  X,M
          LDD    X
          IFC    NE,$M$$,1
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    X+1
          ENDM
 PROQF    SPACE  4,15 
**        PROQF - PROCESS QUEUED FUNCTIONS. 
* 
*         PROQF  NFL
* 
*         ENTRY  *NFL* = LOCATION CONTAINING ZERO IF NO NFL ASSIGNED. 
* 
*         EXIT   (A) = 0. 
*                (AB) = NUMBER OF FUNCTIONS STILL QUEUED. 
* 
*         USES   AB, AB+1, CM - CM+4. 
* 
*         CALLS  FTN. 
* 
*         MACROS NFA. 
  
  
          PURGMAC  PROQF
  
 PROQF    MACRO  NFL
 PQF2     AOD    AB          INCREMENT COUNT OF FUNCTIONS STILL QUEUED
 PQF3     AOD    AB+1 
          SBN    QFBL 
          MJN    PQF1        IF MORE ENTRIES TO CHECK 
  
 PQF      SUBR               ENTRY/EXIT 
 PQF      EQU    *-1
          LDD    NFL
          STD    AB          PRESET REPLY 
          ZJN    PQFX        IF NO NEGATIVE FL ASSIGNED 
          LDN    0
          STD    AB 
          STD    AB+1 
 PQF1     NFA    QFBN        CHECK FOR QUEUED FUNCTION
          ADD    AB+1 
          CRD    CM 
          LDD    CM+1        GET EST ORDINAL
          ZJN    PQF3        IF NO FUNCTION 
          LPC    -1000
          LMD    TH 
          STD    CM+1        SET RETURN-ON-INACCESSIBLE 
          LDD    CM 
          RJM    FTN         ISSUE FUNCTION 
          LDD    CM+1 
          NJN    PQF2        IF DEVICE INACCESSIBLE 
          LDN    ZERL        CLEAR QUEUE ENTRY
          CRD    CM 
          NFA    QFBN 
          ADD    AB+1 
          CWD    CM 
          LJM    PQF3        CHECK NEXT ENTRY 
 PROQF    ENDM
 SUBSYST  SPACE  4,10 
**        SUBSYST - GENERATE SUBSYSTEM TABLE. 
* 
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT,CPU 
* 
*         ENTRY  *PP* = NAME OF PP PROGRAM TO INITIATE SUBSYSTEM. 
* 
*         GENERATE TABLE OF PP NAMES FOR PP-INITIATED SUBSYTEMS.
  
  
          PURGMAC  SUBSYST
  
 SUBSYST  MACRO  NM,ID,PT,PP,AU,DF,DC,CP,PR,AB,CPU
          LOCAL  C
 .SUB     RMT 
 C        SET    0
          IFC    NE,$CPU$$,1
 C        SET    1
 .A       IFC    NE,$PP$$ 
 PPMIC1   MICRO  1,2,$PP$ 
 PPMIC2   MICRO  3,3,$PP$ 
          INDEX  (2*MXSI-2*ID),(2L"PPMIC1",1L"PPMIC2"+C)
 .A       ELSE
          INDEX  (2*MXSI-2*ID),(0,C)
 .A       ENDIF 
 .SUB     RMT 
 SUBSYST  ENDM
          TITLE  LOCAL DEFINITIONS. 
****      COMMON DIRECT LOCATION ASSIGNMENTS. 
  
  
 T8       EQU    16          SCRATCH
 T9       EQU    17          SCRATCH
 FS       EQU    20 - 24     FST INFORMATION (5 LOCATIONS)
 CN       EQU    25 - 31     CM WORD BUFFER (5 LOCATIONS) 
 AB       EQU    32 - 36     ASSEMBLY BUFFER (5 LOCATIONS)
 EP       EQU    37          ENTRY POINT POINTER
 SP       EQU    40 - 44     COMMAND POINTER
 JO       EQU    45          JOB EJT ORDINAL
 EF       EQU    46          ERROR FLAG 
 RO       EQU    47          ROLLOUT FLAG 
 FA       EQU    57          ADDRESS OF FNT ENTRY 
 CW       EQU    60 - 64     LIBRARY CONTROL WORD 
 RF       EQU    65          REPRIEVE ERROR FLAG
                             = 0 IF NO REPRIEVE.
                             = MASK BITS IF EXTENDED REPRIEVE.
                             = ERROR OPTIONS IF REGULAR REPRIEVE. 
 SC       EQU    67          SCP ACTIVITY FLAG BITS (*0ST*) 
****
          TITLE  MAIN PROGRAM.
 AJS      SPACE  4,10 
**        AJS - MAIN PROGRAM. 
* 
*         ENTRY  (IR+2) = FUNCTION CODE.
* 
*         EXIT   TO FUNCTION CODE PROCESSOR.
* 
*         USES   T9.
* 
*         CALLS  PRS. 
  
  
          ORG    PPFW 
  
 AJS      BSS    0           ENTRY
          RJM    PRS         PRESET PROGRAM 
  
*         EXECUTE FUNCTION CODE PROCESSOR.
  
          STD    T9          SET PROCESSOR ADDRESS
          LJM    0,T9        ENTER FUNCTION CODE PROCESSOR
 AJS      SPACE  4,10 
**        AJS - GLOBAL DATA STORAGE.
  
  
 JBSC     CON    0           JOB SERVICE CLASS
 JBOT     CON    0           JOB ORIGIN TYPE
 JBCS     CON    0           JOB CONNECTION STATUS
 JTOP     CON    0           JOB TERMINATION OPTION 
 JTFG     CON    0           JOB TERMINATION FLAGS
 PRCF     CON    0           PROLOGUE/EPILOGUE CONTROL FLAG 
 SCAF     CON    0           SCP ACTIVITY FLAGS:  
                             BIT 0 = UCP WITH CONNECTION TO AN SCP. 
                             BIT 1 = SCP WITH CONNECTION TO UCP(S). 
                             BIT 3 = *SSIW* IDENTIFICATION MUST 
                                     BE CLEARED.
 TSAF     CON    0           *IAF* CP NUMBER/ACCESSIBILITY FLAG 
          TITLE  MAIN FUNCTION CODE PROCESSORS. 
 MTR      SPACE  4,10 
**        MTR - MONITOR CALL (FUNCTION CODE 0). 
* 
*         EXIT   TO *CSR*.
  
  
* MTR     LJM    CSR         CHECK FOR SPECIAL SYSTEM REQUEST 
 SCH      SPACE  4,15 
**        SCH - SCHEDULER CALL (FUNCTION CODE 1). 
* 
*         EXIT   TO EXIT PROCESSOR DEFINED BY (A) ON RETURN 
*                FROM OVERLAY *3AA*.
* 
*         USES   T9.
* 
*         CALLS  *3AA*. 
* 
*         MACROS EXECUTE. 
  
  
 SCH      BSS    0           ENTRY
          EXECUTE  3AA       EXECUTE BEGIN-JOB PROCESSOR
          STD    T9          STORE *3AA* EXIT CODE
          LDM    SCHA,T9     SET *3AA* EXIT PROCESSOR ADDRESS 
          STD    T9 
          LJM    0,T9        ENTER *3AA* EXIT PROCESSOR 
  
  
 SCHA     INDEX              TABLE OF *3AA* EXIT PROCESSORS 
          INDEX  0,ADJ       ADVANCE JOB
          INDEX  1,ENJ       END JOB
          INDEX  2
 DIS      SPACE  4,10 
**        DIS - *DIS* CALL (FUNCTION CODE 2). 
* 
*         EXIT   TO *CSR*.
  
  
* DIS     LJM    CSR         CHECK FOR SPECIAL SYSTEM REQUEST 
 PPC      SPACE  4,10 
**        PPC - PP CALLS (FUNCTION CODES 2 AND 3).
* 
*         EXIT   TO *DPP* TO DROP PP. 
*                TO *XCS* TO EXECUTE COMMAND. 
* 
*         USES   CM.
* 
*         CALLS  PES. 
  
  
 PPC      BSS    0           ENTRY
          LDD    RF          CHECK REPRIEVE FLAG
          LPC    100
          ADD    EF 
          ADM    PRCF 
          ZJN    PPC1        IF NO ERROR FLAG OR JOB STEP PROCESSING
          RJM    PES         PROCESS ERROR AND SCP CONNECTIONS
          LJM    DPP         DROP PP
  
 PPC1     STD    CM          CLEAR ERROR MESSAGE
          LDD    IR+4 
          SHN    21-1 
          PJN    PPC2        IF NO RETURN OF ERROR MESSAGE
          LDD    CP 
          ADN    MS2W 
          CWD    CM 
 PPC2     LJM    XCS         EXECUTE COMMAND
          TITLE  RESIDENT SUBROUTINES.
 ADJ      SPACE  4,15 
**        ADJ - ADVANCE JOB.
* 
*         PROCESSES ERROR FLAG OR REPRIEVE, IF SET, AND 
*         EXECUTES THE NEXT COMMAND, IF PRESENT.
*         IF NO COMMANDS REMAIN, THE END-OF-JOB 
*         PROCESSOR WILL BE CALLED. 
* 
*         EXIT   TO *ENJ* TO END JOB. 
*                TO *XCS* TO EXECUTE COMMAND. 
*                TO *ROJ* TO ROLLOUT JOB. 
* 
*         CALLS  PES, /3AF/RCF, *3AF*.
* 
*         MACROS EXECUTE. 
  
  
 ADJ      BSS    0           ENTRY
          LDD    RO          CHECK ROLLOUT FLAG 
          ZJN    ADJ1        IF ROLLOUT NOT SET 
          LDN    0           DO NOT PASS ERROR FLAG 
          STD    EF 
          LJM    ROJ         ROLLOUT JOB
  
*         PROCESS REPRIEVE OR ERROR FLAG. 
  
 ADJ1     LDD    RF          CHECK REPRIEVE FLAG
          LPC    100
          ADD    EF 
          ADM    PRCF 
          ZJN    ADJ3        IF NO ERROR FLAG OR JOB STEP PROCESSING
          RJM    PES         PROCESS ERROR AND SCP CONNECTIONS
          LDD    CP 
          ADC    SEPW 
          CRD    CM 
          LDD    CM          CHECK *SSJ=* JOB 
          SHN    21-2 
          PJN    ADJ2        IF NOT *SSJ=*
          EXECUTE  3AF
          LDN    0           INDICATE JOB NOT BOTH *SSJ=* AND *DMP=*
          RJM    /3AF/RCF    RESTORE CONTROL POINT FIELDS 
 ADJ2     LDN    0
*         LDN    1           (CM/CPU PARITY ERROR)
 ADJA     EQU    *-1         (CM/CPU PARITY ERROR FLAG) 
          NJP    TER5        IF CM/CPU PARITY ERROR, FREEZE JOB 
          LDC    **          CHECK FOR TERMINAL JOB 
 TSTN     EQU    *-1         INTERACTIVE TERMINAL NUMBER
                             = 0 IF NOT ONLINE, INTERACTIVE JOB 
          NJN    ADJ5        IF INTERACTIVE JOB 
  
*         ADVANCE TO NEXT COMMAND.
  
 ADJ3     LDC    0
*         LDC    1           (COMMANDS REMAINING IN BUFFER OR CM) 
 ADJB     EQU    *-1         (PENDING COMMANDS FLAG)
          ZJN    ADJ5        IF NO COMMANDS PENDING IN BUFFER OR CM 
 ADJ4     LJM    XCS         EXECUTE COMMAND
  
 ADJ5     LDN    0
*         LDN    1           (NO NFL) 
 ADJC     EQU    *-1
          NJN    ADJ6        IF NO NFL
          LDD    EF 
          ZJN    ADJ5.1      IF NO ERROR FLAG SET 
          SBN    TAET+1 
          MJN    ADJ6        IF TERMINAL INTERRUPT
 ADJ5.1   NFA    SHCN        CHECK *SHELL* CONTROL
          CRD    CM 
          LDD    CM 
          ZJN    ADJ6        IF NO *SHELL* CONTROL
          LDM    TSTN 
          ZJN    ADJ6        IF NOT INTERACTIVE 
          LDD    CM+4 
          SHN    21-2 
          PJN    ADJ6        IF INTERACTIVE COMMANDS NOT MONITORED
          LDC    0
 CRQF     EQU    *-1         (CHARGE REQUIRED FLAG) 
          ZJN    ADJ4        IF CHARGE NOT REQUIRED 
 ADJ6     LJM    ENJ         END JOB
 CPP      SPACE  4,10 
**        CPP - CALL PP PROGRAM.
* 
*         ENTRY  (A) = NAME OF PP PROGRAM TO BE CALLED. 
*                (IR+2 - IR+4) = PROGRAM PARAMETERS.
* 
*         EXIT   TO *PPR* TO EXECUTE PP PROGRAM.
  
  
 CPP      BSS    0           ENTRY
          SHN    14          SET PP NAME IN INPUT REGISTER
          STD    IR 
          SHN    -6 
          LMD    IR+1 
          SCN    77 
          LMD    IR+1 
          STD    IR+1 
          LDD    IA          STORE INPUT REGISTER 
          CWD    IR 
          LJM    PPR         EXIT TO PP RESIDENT
 CSR      SPACE  4,15 
**        CSR - CHECK FOR SPECIAL SYSTEM REQUEST. 
* 
*         EXIT   TO *ADJ* TO ADVANCE JOB. 
*                TO *DPP* TO DROP PP. 
*                TO *PPC* TO PROCESS ERROR REPRIEVE ON *DMP=* JOB.
*                TO */3AF/PSR* OR */3AF/PSR2* TO PROCESS SPECIAL
*                PROCESSOR REQUEST. 
*                TO *TCS* TO TRANSLATE COMMAND. 
* 
*         USES   EF, RO ,T3 , CM - CM+4, CN - CN+4, AB - AB+4.
* 
*         CALLS  /3AE/CLD, CUA, DFM, /3AF/PSR, /3AF/RCF, SCP, TCS.
* 
*         MACROS EXECUTE, MONITOR.
  
  
 CSR      BSS    0           ENTRY
          LDD    CP          READ SPECIAL ENTRY POINT WORD
          ADK    SEPW 
          CRD    CM 
          ADN    SPCW-SEPW   READ SPECIAL CALL WORD 
          CRD    CN 
          LDD    CN 
          NJP    CSR2        IF DMP= REQUEST PRESENT
          LDD    FS 
          ADD    RO 
          NJN    CSR1        IF JOB ACTIVITY OR ROLLOUT REQUESTED 
          LDD    RF 
          LPC    100
          ADD    EF 
          ADM    PRCF 
          NJN    CSR1        IF ERROR FLAG OR JOB STEP PROCESSING 
          LDD    CM 
          SHN    21-2 
          PJN    CSR1        IF NOT *SSJ=*
          EXECUTE  3AF
          LDN    0           JOB IS NOT BOTH *SSJ=* AND *DMP=*
          RJM    /3AF/RCF    RESTORE CONTROL POINT FIELDS 
 CSR1     LDD    IR+2 
          NJP    PPC         IF NOT FUNCTION 0
          LDD    IR+4 
          LMN    2
          ZJP    DPP         IF *DIS* CALL
          LJM    ADJ         ADVANCE JOB
  
 CSR2     LDD    IR+4 
          LMN    1
          NJN    CSR4        IF *1RO* NOT ALREADY CALLED
 CSR3     EXECUTE  TCS
  
 CSR4     LDD    CN+1 
          SHN    21-5 
          PJN    CSR6        IF NO SPECIAL REQUEST ACTIVE 
          LDD    RO 
          NJN    CSR1        IF ROLLOUT SET 
          LDD    EF 
          ZJN    CSR5        IF NO ERROR
 CSRC     LDN    0           CHECK FOR EXTENDED REPRIEVE PROCESSING 
*         LDN    1           (IF EXTENDED REPRIEVE PROCESSING)
          ZJN    CSR5        IF NOT EXTENDED REPRIEVE PROCESSING
          LDD    RF 
          ZJN    CSR5        IF ERROR MASK NOT SET
          LJM    PPC         PROCESS ERROR REPRIEVE ON *DMP=* JOB 
  
 CSR5     RJM    SCP         CLEAR ANY OUTSTANDING SCP CONNECTIONS
          UJN    CSR3        RESTART ORIGINAL JOB 
  
 CSR6     LDD    CN 
          LMN    77 
          NJN    CSR7        IF NOT COMMAND CALL
          LDD    FL 
          ZJP    CSR8        IF NO FL ASSIGNED
          EXECUTE  3AF
          LJM    /3AF/PSR2   PROCESS SPECIAL PROCESSOR REQUEST
  
  
*         CHECK IF *DMP=* PROGRAM CAN BE CALLED FROM PROGRAM WITH 
*         SECURE MEMORY SET.
  
 CSR7     LDC    TLCN-2      CHECK TABLE OF LEGAL CALL NAMES
          STD    T3 
 CSR7.1   LDN    2           CHECK NEXT NAME
          RAD    T3 
          LDI    T3          COMPARE FIRST PART OF CALL NAME
          ZJN    CSR7.2      IF END OF TABLE
          LMD    CN 
          NJN    CSR7.1      IF NOT A MATCH 
          LDM    1,T3        COMPARE SECOND PART OF CALL NAME 
          LMD    CN+1 
          SCN    77 
          NJN    CSR7.1      IF NOT A MATCH 
          UJN    CSR9        PROCESS CALL 
  
 CSR7.2   LDD    CM 
          SHN    21-2 
          MJN    CSR9        IF *SSJ=* JOB
          LDD    CP          CHECK SSM STATUS 
          ADC    DBAW 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          PJN    CSR9        IF NOT SECURE MEMORY 
          RJM    CUA         CHECK USER ACESS 
          ZJN    CSR9        IF ACCESS ALLOWED
 CSR8     LDC    LDNI+PPET   CHANGE ERROR TO *PPET* 
          STM    CSRA 
          LDC    =C* SECURE MEMORY, DUMP DISABLED.* 
          UJN    CSR11       ISSUE ERROR MESSAGE
  
 CSR9     LDN    ZERL        CLEAR NAME 
          CRD    AB 
          LDD    CN          SET CALL NAME
          STD    AB 
          LDD    CN+1 
          SCN    77 
          STD    AB+1 
          EXECUTE  3AE
          RJM    /3AE/CLD    SEARCH CLD 
          NJP    CSR12       IF FOUND 
 CSR10    LDC    =C* SPCW CALL ERROR.*
  
*         ISSUE ERROR MESSAGE.
  
 CSR11    RJM    DFM
          LDN    ZERL 
          CRD    AB 
          LDD    CP          CLEAR SPECIAL CALL WORD
          ADC    SPCW 
          CWD    AB 
          LDD    FL 
          ZJN    CSR11.1     IF NO FL ASSIGNED
          LDD    RA          CLEAR SYSTEM REQUEST 
          SHN    6
          ADN    1
          CWD    AB 
          LDN    ZERL        CLEAR *STSW* ROLLOUT STATUS
          CRD    CM 
          LDN    1
          STD    CM+1 
          LDD    CP 
          STD    CM+4 
          LDD    MA 
          CWM    CSRB,ON
          MONITOR  UTEM 
*         LDN    0           CLEAR ROLLOUT STATUS 
 CSR11.1  STD    RO 
 CSRA     LDN    SYET        SET ERROR FLAG 
*         LDN    PPET        (INCORRECT *DMP=* CALL)
          STD    EF 
          LJM    CSR1        DROP PP
  
 CSR12    CRD    CM          READ PST CONTROL WORD ENTRY
          LDD    MA          SET ENTRY POINT NAME 
          CWD    AB 
          CRM    /3AE/CL,ON 
          LDD    T2          SAVE PST ADDRESS 
          STD    AB+2 
          LDD    T1 
          STD    AB+1 
          EXECUTE  3AF
          LJM    /3AF/PSR    PROCESS SPECIAL PROCESSOR REQUEST
  
  
 CSRB     VFD    6/STSW,6/2,6/24D,42/0  CLEAR ROLLOUT STATUS
 TLCN     SPACE  4,10 
**        TLCN - TABLE OF LEGAL *DMP=* PROGRAM CALL NAMES 
*         FOR PROGRAMS WITH SECURE MEMORY SET.
  
 TLCN     BSS    0
          DATA   3LCPF
          DATA   3LCVL
          DATA   3LLFM
          DATA   3LPFM
          DATA   3LREQ
          CON    0
 DPP      SPACE  4,10 
**        DPP - DROP PP.
* 
*         ISSUES *JACM* REQUEST TO CLEAR THE JOB ADVANCE FLAG 
*         AND TO DROP THE PPU.
* 
*         EXIT   TO *PPR*.
* 
*         MACROS MONITOR. 
  
  
 DPP      LDN    DPPS        CLEAR JOB ADVANCE AND DROP PP
          STD    CM+1 
          MONITOR  JACM 
          LJM    PPR         EXIT TO PP RESIDENT
 ENJ      SPACE  4,10 
**        ENJ - END JOB.
* 
*         ENTRY  (TSTN) = TERMINAL NUMBER IF ONLINE.
* 
*         EXIT   TO *ROJ1* IF ON-LINE INTERACTIVE JOB.
*                TO *TER* OTHERWISE.
* 
*         CALLS  RJF, SCP.
  
  
 ENJ      BSS    0           ENTRY
          RJM    SCP         CHECK SCP ACTIVITY 
          RJM    RJF         RETURN JOB STEP FILES
          LDM    TSTN        CHECK TERMINAL NUMBER
          NJN    ROJ1        IF ONLINE
*         PSN                (NO NFL) 
 ENJB     EQU    *-1
          LJM    TER         TERMINATE JOB
 ROJ      SPACE  4,10 
**        ROJ - ROLLOUT JOB.
* 
*         SETS UP LINKAGE TO ROLLOUT JOB. 
* 
*         EXIT   TO *IRO*.
  
  
 ROJ      BSS    0           ENTRY
          LDM    TSTN        CHECK TERMINAL NUMBER
          ZJN    IRO         IF NOT INTERACTIVE JOB 
 ROJ1     LDD    EF          SET ERROR FLAG FOR *1RO* 
*         UJN    IRO         ROLLOUT INTERACTIVE JOB
 IRO      SPACE  4,15 
**        IRO - EXECUTE *1RO*.
* 
*         LOADS AND EXECUTES *1RO* IN THIS PP.
* 
*         ENTRY  (A) = INTERACTIVE ERROR FLAG.
* 
*         EXIT   TO *CPP*.
* 
*         USES   IR+2, IR+4, CM - CM+4. 
* 
*         CALLS  *1RO*. 
* 
*         MACROS EXECUTE. 
  
  
 IRO      BSS    0           ENTRY
          STD    IR+4        SET INTERACTIVE ERROR FLAG 
          LDN    0           INDICATE NORMAL ROLLOUT
          STD    IR+2 
          LDM    JTOP 
          LMN    SUJT 
          ZJN    IRO1        IF SUSPEND TERMINATION OPTION
          LDD    CP          UNCONDITIONALLY CLEAR SUSPEND FLAG 
          ADN    STSW 
          CRD    CM 
          LDD    CM+2 
          LPC    -100 
          ERRNZ  ROSU*10-100 CODE ASSUMES SUSPENSION FLAG IS BIT 30D
          STD    CM+2 
          LDD    CP 
          ADN    STSW 
          CWD    CM 
 IRO1     EXECUTE  1RO,*
          LJM    CPP         EXECUTE *1RO*
 ITF      SPACE  4,10 
**        ITF - ISSUE *TSEM* FUNCTION.
* 
*         ENTRY  *TSEM* PARAMETERS WRITTEN TO MESSAGE BUFFER. 
* 
*         EXIT   (A) = 0, IF IAF INACCESSIBLE OR ERROR. 
*                (A) .NE. 0, IF REQUEST COMPLETE. 
* 
*         USES   T1, CM - CM+4. 
* 
*         MACROS DELAY, MONITOR, PAUSE. 
  
  
 ITF      SUBR               ENTRY/EXIT 
 ITF1     LDK    ZERL 
          CRD    CM 
          MONITOR  TSEM 
          LDD    CM+1 
          ZJN    ITFX        IF IAF INACCESSIBLE OR ERROR 
          LMC    7777 
          NJN    ITFX        IF REQUEST COMPLETE
          PAUSE  ST          *TSEM* QUEUE FULL - DELAY AND RETRY
          LDC    3600 
          STD    T1 
 ITF2     DELAY 
          SOD    T1 
          ZJN    ITF1        IF TIME TO REISSUE REQUEST 
          UJN    ITF2        CONTINUE TO DELAY
 PES      SPACE  4,10 
**        PES - PROCESS ERROR FLAG AND SCP CONNECTIONS. 
* 
*         CALLS  SCP, *3AB*.
* 
*         MACROS EXECUTE. 
  
  
 PES      SUBR               ENTRY/EXIT 
 PES1     EXECUTE  3AB       EXECUTE ERROR PROCESSOR
          ZJN    PESX        IF ERROR PROCESSING COMPLETE 
          RJM    SCP         PROCESS SCP CONNECTIONS
          UJN    PES1        CONTINUE ERROR PROCESSING
 RJF      SPACE  4,10 
**        RJF - RETURN JOB STEP PRIVATE FILES.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  /3AG/RJF.
* 
*         MACROS EXECUTE. 
  
  
 RJF      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADN    JCIW        GET JOB CONTROL FLAGS
          CRD    CM 
          LDD    CM+3 
          SHN    21-10
          PJN    RJFX        IF NO JOB STEP FILES TO RETURN 
          EXECUTE  3AG       RETURN JOB STEP FILES
          UJN    RJFX        RETURN 
 SCP      SPACE  4,20 
**        SCP - CHECK SYSTEM CONTROL POINT (SCP) ACTIVITY.
* 
*         ENTRY  (SCAF) = SCP ACTIVITY FLAGS: 
*                         BIT 0 = UCP WITH CONNECTION TO SCP. 
*                         BIT 1 = SCP WITH CONNECTION TO UCP. 
*                         BIT 2 = *SF.EXIT* REQUEST ISSUED. 
*                         BIT 3 = *SSIW* IDENTIFICATION MUST
*                                 BE CLEARED. 
* 
*         EXIT   TO *DPP* IF ROLLOUT CPU STATUS PRESENT AND SYSTEM
*                  DEBUG MODE NOT ENABLED.
* 
*         USES   CM - CM+4, SC. 
* 
*         CALLS  *0ST*. 
* 
*         MACROS EXECUTE, MONITOR.
  
  
 SCP      SUBR               ENTRY/EXIT 
          LDM    SCAF        CHECK SCP ACTIVITY FLAGS 
          ZJN    SCPX        IF NO SCP ACTIVITY, RETURN 
          STD    SC          SET FLAGS FOR *0ST*
          LDD    CP 
          ADN    STSW 
          CRD    CM 
          LDD    CM+2 
          LPN    2
          ZJN    SCP1        IF NO ROLLOUT CPU STATUS PRESENT 
          LDC    *           SET ADDRESS WHERE ERROR DETECTED 
          STD    CM+1 
          LDK    SWET        SET SOFTWARE ERROR 
          STD    CM+2 
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    DPP         CLEAR JOB ADVANCE AND DROP PP
  
 SCP1     EXECUTE  0ST,E1AJ  EXECUTE *0ST*
          LDD    SC          RESET SCP FLAGS
          STM    SCAF 
          UJP    SCPX        RETURN 
 SUS      SPACE  4,10 
**        SUS - SUSPEND JOB.
* 
*         SETS THE SUSPENSION-REQUESTED FLAG IN THE CONTROL 
*         POINT AREA AND CALLS *1RO* TO ROLLOUT THE JOB.
* 
*         EXIT   TO *IRO*.
* 
*         USES   CM - CM+4. 
  
  
 SUS      BSS    0           ENTRY
          LDD    CP          READ CP STATUS WORD
          ADN    STSW 
          CRD    CM 
          LDD    CM+2        SET SUSPENSION-REQUESTED FLAG
          LPC    -100 
          LMD    HN 
          STD    CM+2 
          LDD    CP          REWRITE STATUS WORD
          ADN    STSW 
          CWD    CM 
          LDN    0           CLEAR INTERACTIVE ERROR FLAG 
          UJP    IRO         ROLLOUT JOB
 TER      SPACE  4,20 
**        TER - TERMINATE JOB.
* 
*         EXECUTES JOB TERMINATION PROCESSOR OVERLAYS.
* 
*         ENTRY  (EF) = JOB ERROR FLAG. 
* 
*         EXIT   (JTOP) = JOB TERMINATION OPTION. 
*                TO *XCS* TO EXECUTE COMMANDS.
*                TO *SUS* TO SUSPEND JOB. 
*                TO *PPR* TO DROP PPU.
* 
*         USES   CM+1.
* 
*         CALLS  RLS, SCP, *3AJ*, *3AK*.
* 
*         MACROS EXECUTE, MONITOR.
  
  
 TER      BSS    0           ENTRY
          RJM    SCP         CHECK SCP ACTIVITY 
          LDM    JTFG 
          LPC    3000 
          LMK    NOTM*1000
          NJN    TER3        IF TERMINATION IN PROGRESS 
          LDM    JTOP 
          LMN    SUJT 
          NJN    TER2        IF NOT SUSPEND TERMINATION OPTION
          LDM    JBCS 
          LMK    DTCS 
 TER1     ZJP    SUS         IF DETACHED INTERACTIVE JOB
          LMK    OLCS&DTCS
          ZJN    TER1        IF ON-LINE INTERACTIVE JOB 
 TER2     EXECUTE  3AJ       INITIATE JOB TERMINATION 
          NJN    XCS         IF COMMANDS TO BE EXECUTED 
  
*         COMPLETE JOB TERMINATION PROCESSING.
  
 TER3     RJM    RLS         RELEASE CM/EXTENDED MEMORY STORAGE 
          EXECUTE  3AK       COMPLETE JOB TERMINATION 
 TER4     LDK    CCPS+DPPS+CJES  SET *JACM* OPTIONS 
          STD    CM+1 
          MONITOR  JACM 
          LJM    PPR         EXIT TO PP RESIDENT
  
 TER5     LDN    0
*         LDN    1           (180 CLASS MACHINE)
 TERA     EQU    *-1
          ZJN    TER4        IF NOT 180 CLASS MACHINE 
          LDK    CKPS        FORCE SYSTEM CHECKPOINT
          STD    CM+2 
          MONITOR  SEQM 
          UJN    TER4        SET *JACM* OPTIONS 
 XCS      SPACE  4,10 
**        XCS - EXECUTE COMMAND.
* 
*         LOADS AND EXECUTES OVERLAY *TCS* TO PROCESS CONTROL 
*         COMMAND.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  RJF, SCP, *TCS*. 
* 
*         MACROS EXECUTE. 
  
  
 XCS      BSS    0           ENTRY
          LDN    ZERL        CLEAR *SPCW* WORD
          CRD    CM 
          LDD    CP 
          ADK    SPCW 
          CWD    CM 
          RJM    SCP         CHECK SCP STATUS 
          RJM    RJF         RETURN JOB STEP PRIVATE FILES
          EXECUTE  TCS       EXECUTE *TCS*
          SPACE  4,10 
**        ASSEMBLY OPTIONS FOR EXECUTABLE COMMON DECKS. 
  
  
 EJT$     EQU    1           ASSEMBLE EJT ADDRESSING (COMPGFP)
 FNT$     EQU    1           ASSEMBLE FNT ADDRESSING (COMPGFP)
 IFP$     EQU    1           ASSEMBLE REMOTE INITIALIZATION (COMPGFP) 
 QFT$     EQU    1           ASSEMBLE QFT ADDRESSING (COMPGFP)
          SPACE  4,10 
**        EXECUTABLE COMMON DECKS.
  
  
*CALL     COMPAST 
*CALL     COMPGFP 
*CALL     COMPRLS 
          TITLE  OVERLAID PRESET CODE.
          USE    OVERLAY
 E1AJ     EQU    *+5
  
          ERRNG  BFMS-E1AJ-ZSTL  CHECK LENGTH OF *0ST*
 PRS      SPACE  4,30 
**        PRS - PRESET PROGRAM
* 
*         ENTRY  (IR+2) = FUNCTION CODE.
* 
*         EXIT   (A)    = FUNCTION PROCESSOR ADDRESS. 
*                (ADJB) = COMMANDS PENDING FLAG.
*                (CRQF) = CHARGE REQUIRED STATUS. 
*                (EF)   = JOB ERROR FLAG. 
*                (FS)   = JOB ACTIVITY FLAGS. 
*                (JTFG) = JOB TERMINATION FLAGS.
*                (JTOP) = JOB TERMINATION OPTION. 
*                (JO)   = JOB EJT ORDINAL.
*                (PRCF) = PROLOGUE/EPILOGUE CONTROL FLAGS.
*                (RF)   = REPRIEVE OPTION FLAGS.
*                (RO)   = ROLLOUT FLAG. 
*                (JBCS) = JOB CONNECTION STATUS.
*                (JBSC) = JOB SERVICE CLASS.
*                (JBOT) = JOB ORIGIN TYPE.
*                (SCAF) = SUBSYSTEM ACTIVITY FLAGS. 
*                (TSTN) = INTERACTIVE JOB TERMINAL NUMBER.
*                       = ZERO IF NOT INTERACTIVE JOB.
*                (CSRC) = 1, IF EXTENDED REPRIEVE PROCESSING. 
* 
*         USES   FS, RF, RO, AB - AB+4, CM - CM+4, CN - CN+4, 
*                SP - SP+4, T1 - T5.
* 
*         CALLS  CJS, IFP, SCS, SEF, SPF, STS.
* 
*         MACROS MONITOR, SFA.
  
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    IFP         INITIALIZE *COMPGFP* 
          RJM    CJS         CHECK JOB STATUS 
          LDD    CP          READ CONTROL POINT STATUS
          ADN    STSW 
          CRD    CM 
          ADK    EOJW-STSW   READ END OF JOB TERMINATION WORD 
          CRD    CN 
          ADK    FLSW-EOJW
          CRD    AB 
          ADK    EECW-FLSW
          CRD    T1 
          ADK    CSPW-EECW   READ COMMAND POINTERS
          CRD    SP 
          LDD    AB 
          NJN    PRS0        IF NFL ASSIGNED
          STM    ENJB 
          AOM    ADJC 
 PRS0     LDD    CM          SET JOB ACTIVITY 
          SHN    -10
          STD    FS 
          LDD    CM+4        SET RECALL/TAPE ACTIVITY 
          SHN    -4 
          LPN    17 
          RAD    FS 
          LDD    CM+2        SET ROLLOUT FLAG 
          LPN    1
          STD    RO 
          LDD    CN          SET JOB TERMINATION FLAGS
          SHN    -6 
          LPN    37 
          STM    JTFG 
          SHN    0-11+6      SET JOB TERMINATION OPTION 
          LPN    3
          STM    JTOP 
          LDD    SP+3        CHECK COMMAND BUFFER 
          LMD    SP+4 
          NJN    PRS0.1      IF NOT EMPTY 
          LDD    SP+1        CHECK RECORD STATUS
          SHN    21-13
          PJN    PRS0.1      IF NOT EOR 
          LDD    CP          CHECK FOR *TCS* EXECUTE COMMAND
          ADK    RFCW 
          CRD    CN 
          LDD    CN+3 
          SCN    77 
          ADD    CN+2 
          ZJN    PRS1        IF NOT EXECUTE COMMAND FROM CM 
 PRS0.1   AOM    ADJB        SET COMMANDS PENDING 
 PRS1     RJM    SEF         SET ERROR FLAG 
          LDD    SP          SET CHARGE REQUIRED STATUS 
          LPN    4
          STM    CRQF 
          RJM    PQF         PROCESS QUEUED FUNCTIONS 
          LDN    0
          STD    CM+1 
          LDD    CP 
          ADN    SRUW 
          CRD    AB 
          LDD    AB 
          SHN    21-5 
          PJN    PRS2        IF IGNORE RESOURCE LIMITS NOT SET
          LDD    EF          CHECK FOR RESOURCE LIMIT ERROR 
          LMN    TLET 
          ZJP    PRS2.2      IF TIME LIMIT
          LMN    SRET&TLET
          ZJP    PRS2.2      IF SRU LIMIT 
  
*         IF EXTENDED REPRIEVE + *SSJ=* + INTERRUPT PROCESSOR ACTIVE, 
*         OR IF OVERRIDE REQUIRED SET, THE JOB MAY ONLY BE DROPPED
*         VIA *ORET*.  ERROR FLAGS *ODET*, *OKET*, *RRET*,
*         *TIET* AND *TAET* WILL BE IGNORED.
  
 PRS2     LDD    EF          CHECK ERROR FLAG 
          LMK    ODET 
          ZJN    PRS2.1      IF *ODET* ERROR FLAG 
          LMK    OKET&ODET
          ZJN    PRS2.1      IF *OKET* ERROR FLAG 
          LMK    RRET&OKET
          ZJN    PRS2.1      IF *RRET* ERROR FLAG 
          LMK    TIET&RRET
          ZJN    PRS2.1      IF *TIET* ERROR FLAG 
          LMK    TAET&TIET
          NJP    PRS2.3      IF NOT *TAET* ERROR FLAG 
 PRS2.1   LDD    CP          CHECK OVERRIDE REQUIRED
          ADN    SNSW 
          CRD    AB 
          LDD    AB 
          SHN    21-11
          MJN    PRS2.2      IF OVERRIDE REQUIRED SET 
          LDD    T1 
          SHN    21-12
          PJN    PRS2.3      IF EXTENDED REPRIEVE NOT ACTIVE
          SHN    21-11-21+12
          PJN    PRS2.3      IF INTERRUPT PROCESSOR NOT ACTIVE
          LDD    CP 
          ADK    SEPW 
          CRD    AB 
          LDD    AB 
          SHN    21-2 
          PJN    PRS2.3      IF NOT *SSJ=*
 PRS2.2   LDD    FL 
          ZJN    PRS2.3      IF NO FL ASSIGNED
          LDN    **          CHECK FOR PRE-INITIAL JOB STATUS 
 PRSA     EQU    *-1         (JOB STATUS SET BY *CJS*)
          LMK    PRJS*2 
          ZJN    PRS2.3      IF PRE-INITIAL JOB STATUS
          MONITOR  CEFM      CLEAR ERROR FLAG 
          MONITOR  RCPM      REQUEST THE CPU
          LJM    DPP         DROP PP
  
*         SET REPRIEVE STATUS.
  
 PRS2.3   LDD    T1          CHECK EXTENDED REPRIEVE ACTIVE 
          SHN    21-12
          PJN    PRS3        IF NO EXTENDED REPRIEVE
          AOM    CSRC        INDICATE EXTENDED REPRIEVE PRESENT 
          LDD    T1+1        GET EXTENDED REPRIEVE MASK BITS
          UJN    PRS5        SET REPRIEVE FLAGS 
  
 PRS3     LDD    T1+1 
          SHN    21-13
          PJN    PRS4        IF POSSIBLE REPRIEVE OPTIONS 
          LDN    0
 PRS4     SHN    -6          SET REPRIEVE ERROR OPTIONS 
 PRS5     STD    RF          STORE REPRIEVE FLAGS 
  
*         SET SCP CONNECTION STATUS.
  
          RJM    SCS         GET SCP CONNECTION STATUS
          STM    SCAF        STORE SCP ACTIVITY FLAGS 
  
*         SET JOB ORIGIN TYPE AND SERVICE CLASS.
  
          SFA    EJT,JO      SET EJT ADDRESS
          ADK    SCHE        READ JOB TERMINATION STATUS
          CRD    CN 
          ADK    //SCLE-//SCHE  READ SERVICE CLASS WORD 
          CRD    CM 
          LDD    CN+2 
          LPC    3000 
          RAM    JTFG        SET JOB TERMINATION STATUS 
          LDD    CM          SET JOB ORIGIN TYPE
          LPN    17 
          STM    JBOT 
          SBN    MXOT        VALIDATE ORIGIN TYPE 
          PJN    PRS7        IF UNIDENTIFIED ORIGIN TYPE
          LDD    CM          SET JOB SERVICE CLASS
          SHN    -6 
          STM    JBSC 
          SBK    MXSC        VALIDATE SERVICE CLASS 
          PJN    PRS7        IF UNIDENTIFIED SERVICE CLASS
          RJM    STS         SET INTERACTIVE PARAMETERS 
          RJM    SPF         SET PROLOGUE/EPILOGUE FLAGS
  
*         EXIT   TO MAIN PROGRAM WITH (A) = PROCESSOR ADDRESS.
  
          LDD    IR+2        CHECK FUNCTION CODE
          SBN    FUNCL
          PJN    PRS7        IF INCORRECT FUNCTION CODE 
          LDM    FUNC,IR+2
 PRS6     LJM    PRSX        RETURN 
  
*         RETURN TERMINATION PROCESSOR ADDRESS IF ERROR.
  
 PRS7     LDN    0           SET NO ERROR FLAG
          STD    CM+2 
          LDC    *           SET ADDRESS WHERE ERROR OCCURED
          STD    CM+1 
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LDC    TER         SET TERMINATION PROCESSOR ADDRESS
          UJN    PRS6        RETURN 
 FUNC     SPACE  4,10 
**        FUNC - TABLE OF FUNCTION CODE PROCESSORS. 
  
  
 FUNC     BSS    0
          LOC    0
  
          CON    CSR         *CPUMTR* CALL
          CON    SCH         SCHEDULER CALL 
          CON    CSR         *DIS* CALL 
          CON    PPC         OTHER PP CALL
  
          LOC    *O 
 FUNCL    EQU    *-FUNC 
          TITLE  OVERLAID PRESET SUBROUTINES. 
 SPF      SPACE  4,10 
**        SPF - SET PROJECT PROLOGUE/EPILOGUE CONTROL FLAGS.
* 
*         EXIT   (PRCF) = CONTROL FLAGS.
* 
*         USES   T1, CM - CM+4, CN - CN+4.
  
  
 SPF      SUBR               ENTRY/EXIT 
          LDD    CP          READ PROLOGUE/EPILOGUE CONTROL 
          ADN    EOJW 
          CRD    CM 
          ADN    JCDW-EOJW
          CRD    CN 
          LDD    CM+2 
          SHN    -6 
          LPN    7
          STD    T0 
          ZJN    SPFX        IF NO CONTROLS ACTIVE
          LDD    CN+2        CHECK PROCEDURE NESTING LEVEL
          LPN    77 
          STD    T1 
          LDD    CM+2 
          LPN    77 
          SBD    T1 
          PJN    SPF1        IF PROLOGUE OR EPILOGUE *REVERT* 
          LDM    ADJB 
          NJN    SPFX        IF PENDING COMMANDS
 SPF1     LDD    T0          SET OPTION 
          STM    PRCF 
          UJN    SPFX        EXIT 
 CJS      SPACE  4,10 
**        CJS - CHECK JOB STATUS FOR EXCEEDED RESOURCE LIMITS.
* 
*         EXIT   (JO) = JOB EJT ORDINAL.
*                (JBCS) = JOB CONNECTION STATUS.
*                IF RESOURCE LIMITS HAVE BEEN REACHED, THEN - 
*                  IF INTERACTIVE JOB, ISSUE ROLLOUT REQUEST, 
*                  ELSE, CHANGE ERROR FLAG IN CP AREA.
* 
*         USES   JO, AB - AB+4, CM - CM+4, CN - CN+4. 
* 
*         MACROS MONITOR, SFA.
  
  
 CJS5     MONITOR  HNGM 
          UJN    CJS5        HANG PP
  
 CJS      SUBR               ENTRY/EXIT 
          LDD    CP          GET RESOURCE LIMIT FLAGS 
          ADK    STSW 
          CRD    AB 
          ADK    SRUW-STSW
          CRD    CN 
          ADK    TFSW-SRUW   GET JOB EJT ORDINAL
          CRD    CM 
          LDD    CM 
          ZJN    CJS5        IF NO EJT ORDINAL PRESENT
          STD    JO          SAVE EJT ORDINAL 
          SFA    EJT
          ADK    JSNE 
          CRD    CM 
          LDD    CM+4        GET JOB CONNECTION STATUS
          SHN    -7 
          LPN    17 
          STM    JBCS        SAVE CONNECTION STATUS 
          LDD    CM+4        SAVE JOB STATUS
          LPN    76 
          RAM    PRSA 
          LDD    AB+1 
          NJN    CJSX        IF ERROR FLAG SET IN CONTROL POINT AREA
          LDD    CN 
          SHN    21-5 
          MJN    CJSX        IF IGNORE RESOURCE LIMITS SET
          LPN    24 
          ZJN    CJSX        IF RESOURCE LIMITS NOT EXCEEDED
          LPN    4
          ZJN    CJS1        IF SRU LIMIT NOT EXCEEDED
          LDN    SRET-TLET   SET SRU LIMIT EXCEEDED FLAG
          RAM    CJSA 
 CJS1     LDK    ZERL        CLEAR MONITOR REQUEST WORD 
          CRD    CM 
  
*         CHECK FOR INTERACTIVE JOB.
  
          LDM    JBCS        CONNECTION STATUS
          LMN    DTCS 
          ZJN    CJS2        IF DETACHED INTERACTIVE JOB
          LMN    OLCS&DTCS
          NJN    CJS4        IF NOT INTERACTIVE JOB 
          LDN    ROSR&ROSU   SELECT *ROCM* SCHEDULER ROLLOUT
 CJS2     LMN    ROSU        SELECT *ROCM* SUSPEND OPTION 
          STD    CM+1 
          MONITOR  ROCM      ISSUE ROLLOUT REQUEST
 CJS3     LJM    CJSX        RETURN 
  
 CJS4     LDN    TLET        SET TIME LIMIT ERROR FLAG
*         LDN    SRET        (SRU LIMIT ERROR FLAG) 
 CJSA     EQU    *-1
          STD    CM+1 
          MONITOR  CEFM      CHANGE ERROR FLAG
          UJN    CJS3        RETURN 
 SCS      SPACE  4,10 
**        SCS - SET SCP CONNECTION STATUS.
* 
*         EXIT   (A) = SCP CONNECTION STATUS FLAG BITS. 
* 
*         USES   T8, CM - CM+4, CW - CW+4, AB - AB+4. 
  
  
 SCS      SUBR               ENTRY/EXIT 
  
*         CHECK FOR CONNECTION TO SYSTEM CONTROL POINT. 
  
          LDD    CP          READ SUBSYSTEM ID WORD 
          ADK    JCIW 
          CRD    AB 
          ADK    SEPW-JCIW   READ SPECIAL ENTRY POINTS
          CRD    CW 
          ADK    SSCW-SEPW   READ SCP CONNECTIONS 
          CRD    CM 
          LDD    CM 
          ADD    CM+1 
          ADD    CM+2 
          ADD    CM+3 
          ADD    CM+4 
          ZJN    SCS0.1      IF NO CONNECTIONS TO SCP 
          LDN    1           SET CONNECTIONS TO SCP FLAG
 SCS0.1   STD    T8 
  
*         CHECK FOR SCP SUBSYSTEM.
  
          LDD    CW 
          LPN    20 
          LMN    20 
          ZJN    SCS2        IF *DMP=* PROGRAM
          LDC    LSSI 
          SBD    AB+2 
          ADK    DSSI-LSSI
          ZJN    SCS2        IF DEADSTART SEQUENCING JOB
          SBK    DSSI-LSSI
          SHN    0-21 
          ZJN    SCS2        IF NOT A SUBSYSTEM 
          LDD    FL 
          ZJN    SCS1        IF NO CM FL ASSIGNED 
          LDD    RA          CHECK SUBSYSTEM ID WORD IN RA
          SHN    6
          ADK    SSIW 
          CRD    CW 
          LDD    CW+4        GET PROGRAM SUBSYSTEM ID CODE
          LMD    AB+2        COMPARE TO SUBSYSTEM ID IN CPA 
          NJN    SCS1        IF NO MATCH
          LDN    10          SET ID WORD-TO-BE-CLEARED STATUS 
          RAD    T8 
  
*         CHECK FOR OUTSTANDING CONNECTION(S) TO UCP-S. 
  
 SCS1     LDD    CP          READ SCP CONNECTION WORD 
          ADK    SSOW 
          CRD    CW 
          LDD    CW+4        GET CONNECTION COUNT 
          ZJN    SCS2        IF NO CONNECTIONS
          LDN    2           INDICATE OUTSTANDING CONNECTION(S) 
 SCS2     RAD    T8 
          UJP    SCSX        RETURN 
 SEF      SPACE  4,15 
**        SEF - SET ERROR FLAG. 
* 
*         SETS THE ERROR FLAG FROM THE EJT, IF PRESENT, ELSE SETS 
*         THE ERROR FLAG FROM THE CONTROL POINT AREA. 
* 
*         ENTRY  (CM - CM+4) = CONTROL POINT WORD *STSW*. 
*                (JO) = JOB EJT ORDINAL.
* 
*         EXIT   (EF) = ERROR FLAG. 
* 
*         USES   CN - CN+4. 
* 
*         CALLS  ITF. 
* 
*         MACROS MONITOR, SFA.
  
  
 SEF      SUBR               ENTRY/EXIT 
          SFA    EJT,JO      SET EJT ADDRESS
          ADN    PRFE        READ ERROR FLAG WORD 
          CRD    CN 
          LDD    CN+1        CHECK EJT ERROR FLAG 
          NJN    SEF1        IF ERROR FLAG SET IN EJT 
          LDD    CM+1        GET CP ERROR FLAG
          LMN    RSET 
          NJN    SEF0        IF NOT A RECOVERED SUBSYSTEM 
          STD    CM+1        CLEAR ERROR FLAG 
          AOM    SEFA        CHECK FOR IAF
          MONITOR  CEFM 
*         LDN    0
          UJN    SEF1        CONTINUE 
  
 SEF0     LDD    CM+1 
 SEF1     STD    EF          STORE ERROR FLAG 
          ADN    0
*         ADN    1           IF A RECOVERED SUBSYSTEM 
 SEFA     EQU    *-1
          ZJN    SEFX        IF NO ERROR FLAG 
          LDD    CP          READ JOB CONTROL INFORMATION 
          ADK    JCIW 
          CRD    CM 
          LDD    CM+2        CHECK SUBSYSTEM ID FIELD 
          LMK    IFSI 
          NJN    SEFX        IF NOT IAF 
          LDN    ZERL        CLEAR IAF ACCESSIBILITY
          CRD    CM 
          LCN    1
          STD    CM 
          LDD    MA 
          CWD    CM 
          RJM    ITF         ISSUE *TSEM* FUNCTION
          LJM    SEFX        RETURN 
 STS      SPACE  4,20 
**        STS - SET INTERACTIVE PARAMETERS. 
* 
*         ENTRY  (JBCS) = JOB CONNECTION STATUS.
* 
*         EXIT   (TSAF) = *IAF* CP NUMBER IF *IAF* IS ACCESSIBLE. 
*                       = 0 IF NOT AN ON-LINE INTERACTIVE JOB OR *IAF*
*                         IS INACCESSIBLE.
*                (TSTN) = TERMINAL NUMBER IF ON-LINE INTERACTIVE JOB
*                         AND *IAF* IS ACCESSIBLE.
*                       = 0 OTHERWISE.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  AST. 
  
  
 STS      SUBR               ENTRY/EXIT 
          LDM    JBCS        JOB CONNECTION STATUS
          LMK    OLCS 
          NJN    STSX        IF NOT ON-LINE 
          LDM    JBOT        CHECK JOB ORIGIN 
          LMN    TXOT 
          NJN    STSX        IF NOT INTERACTIVE JOB 
          LDD    CP          READ TERMINAL POINTER WORD 
          ADK    TTNW 
          CRD    CM 
          LDD    CM+1        SET TERMINAL NUMBER
          STM    TSTN 
          LDC    FECF*10000+IFSI  GET *IAF/TELEX* SSCT ENTRY
          RJM    AST
          SHN    0-13        SET/CLEAR ACCESSIBILITY FLAG 
          ERRNZ  /REM/VCPT-1  CODE ASSUMES *IAF* CP = 1 
          STM    TSAF 
          UJN    STSX        RETURN 
 IFP      SPACE  4,10 
**        ASSEMBLE *COMPGFP* INITIALIZATION CODE. 
  
  
 IFP      HERE
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCUA 
          PROQF  AB          PROCESS QUEUED FUNCTIONS 
          TTL    1AJ/3AA - INITIATE JOB.
          TITLE  INITIATE JOB.
          QUAL   IJB
          IDENT  3AA,IJBX    INITIATE JOB.
*COMMENT  1AJ - INITIATE JOB. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          ORG    E1AJ 
          SPACE  4,10 
***       3AA - INITIATE JOB. 
* 
*         *3AA* INITIATES JOB PROCESSING AT THE CONTROL POINT 
*         ASSIGNED BY *1SJ*.
          SPACE  4,10 
***       JOB COMMAND DAYFILE MESSAGES. 
* 
*         * JOB COMMAND ERROR.* 
* 
*         * CARD READER ERROR.* 
* 
*         * OPERATOR INPUT TERMINATION.*
* 
*         * DISK FULL.* 
* 
*         * MASS STORAGE ERROR.*
* 
*         * JOB IN NO RERUN STATE ON RECOVERY.* = JOB RECOVERED 
*         DURING DEADSTART IS ABORTED BECAUSE IT WAS IN 
*         NO RERUN MODE.
* 
*         * BINARY SEQ. ERROR,  RECXXXX  CDYYYY.* = ERROR ON BINARY 
*         COMMAND.
* 
*         * UNKNOWN HOLL. CODE, RECXXXX  CDYYYY.* = ERROR ON
*         HOLLERITH CARD. 
* 
*         * OPERATOR DROP.* 
* 
*         * INCORRECT INPUT FILE SYSTEM SECTOR.*
          SPACE  4,10 
**        ACCOUNT FILE MESSAGES.
* 
*         *UCCR, ID, XXXXXX.XXXKCDS.* = MESSAGE INDICATING NUMBER 
*                OF COMMANDS READ.
* 
*         ID     MACHINE ID AND EST ORDINAL OF CARD READER FOR
*                *BCOT* JOBS. 
*                TERMINAL NAME FOR *EIOT* JOBS. 
*         COUNT  NUMBER OF COMMANDS READ. 
          SPACE  4,10 
          SPACE  4,10 
****      DIRECT CELL ASSIGNMENTS.
  
  
 TN       EQU    37          TERMINAL NUMBER
 TA       EQU    57          *IAF* RA 
 TT       EQU    65 - 66     TERMINAL TABLE ADDRESS (2 CELLS) 
  
  
****
          SPACE  4,10 
****      ASSEMBLY CONSTANTS. 
  
  
 DFVL     EQU    7777        DEFAULT VALIDATION 
 DFCP     EQU    100         DEFAULT JOB STEP TIME LIMIT
 DFIJ     EQU    777777      DEFAULT INDEFINITE JOB STEP TIME LIMIT 
 DFBJ     EQU    777777      DEFAULT NON-SYSTEM ORIGIN JOB STEP LIMIT 
 DFBA     EQU    777777      DEFAULT NON-SYSTEM ORIGIN ACCOUNT LIMIT
 DFSO     EQU    777777      DEFAULT SYSTEM ORIGIN SRU LIMIT
 DFSL     EQU    500         DEFAULT SRU LIMIT
 VCPT     EQU    /REM/VCPT
 .IJFL    MAX    AFFL,JTFL   MINIMUM INITIAL JOB FIELD LENGTH 
 IJFL     EQU    .IJFL
  
  
****
          SPACE 4,10
*         COMMON DECKS. 
  
  
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO CALLS 
*CALL     COMSSSD 
 IJB      TITLE  MAIN ROUTINE.
**        IJB - INITIATE JOB. 
* 
*         ENTRY  (EF)   = JOB ERROR FLAG. 
*                (JO)   = JOB EJT ORDINAL.
*                (TSAF) = *IAF* CP NUMBER IF ACCESSIBLE.
*                (JBOT) = JOB ORIGIN TYPE.
* 
*         EXIT   (A) = 0 IF JOB SHOULD BE ADVANCED. 
*                    = 1 IF JOB SHOULD BE TERMINATED. 
*                TO *PPR* TO CALL SUBSYSTEM INITIALIZER PP FOR
*                *SSSC* SERVICE CLASS JOB WHICH DOES NOT USE A
*                PROCEDURE FILE FOR INITIALIZATION. 
* 
*         CALLS  AIF, CCA, IUT, PJB, PNS, PSS.
* 
*         MACROS ENDMS, SFA.
  
  
 IJB      SUBR               ENTRY/EXIT 
          RJM    PJB         PRESET JOB 
          LDM    JBSC 
          LMN    DSSC 
          ZJN    IJB3        IF DEADSTART SEQUENCING JOB
          LMN    DSSC&SSSC
          NJN    IJB4        IF NOT A SUBSYSTEM 
 IJB3     ENDMS 
          LDD    EF 
          ZJN    IJB3.0      IF NO ERROR FLAG IS SET
          LMN    SSET 
          ZJN    IJB3.1      IF *1SJ* SET ERROR FLAG
 IJB3.0   RJM    PSS         PROCESS SUBSYSTEM
          ZJN    IJB5        IF NO ERROR
 IJB3.1   STM    SISS 
          LDK    NOJT        SET *NOJT* QUEUED FILE OPTION
          STM    JTFG 
 IJB4     RJM    PNS         PROCESS NON-SUBSYSTEM JOB
          MJN    IJB6        IF PROBLEMS OCCURRED 
 IJB5     RJM    CCA         COMPLETE CPA INITIALIZATION
  
*         INITIALIZE SERVICE CLASS VALIDATION INFORMATION IN NFL. 
  
          LDD    MA          SET VALIDATION MASK
          CWM    VASS+ASCV*5,ON 
          SBN    1
          CRD    CM 
          LDN    0
          STD    CM 
          STD    CM+1 
          NFA    SCVN 
          CWD    CM 
          LDD    EF 
          NJN    IJB6        IF ERROR FLAG IS SET IN EJT
  
*         CHECK FOR ABORTED INPUT FILE. 
  
          LDM    JASS 
          ZJN    IJB8        IF NOT ABORTED INPUT FILE
          RJM    AIF         PROCESS ABORTED INPUT FILE 
 IJB6     LDN    1           SET TERMINATION EXIT CONDITION 
          STM    IJBA 
  
*         UPDATE EJT ENTRY AS FOLLOWS - 
*                CHANGE JOB STATUS TO *EXJS*. 
*                CLEAR INPUT FILE ADDRESS.
*                CLEAR ERROR FLAG.
  
 IJB7     LDC    IJBL+3*10000 
*         LDC    IJBL+4*10000  (*ORET* ERROR FLAG SET)
 IJBP     EQU    *-2
          RJM    IUT         ISSUE *UTEM* MONITOR FUNCTION
          LDC    ** 
 IJBA     EQU    *-1         (EXIT FLAG)
          LJM    IJBX        RETURN TO *1AJ* RESIDENT 
  
 IJB8     LDM    SISS        CHECK SUBSYSTEM ID 
          SBK    LSSI+1 
          MJN    IJB7        IF NOT A SUBSYSTEM 
          LDC    MXSI 
          SBM    SISS 
          PJN    IJB9        IF NOT THE DEADSTART SEQUENCING JOB
          ERRPL  MXSI-DSSI   CODE ASSUMES VALUE 
          LDK    MXSI-MSSI   INITIATE LIKE *CMS*
 IJB9     SHN    1
          STD    T1 
  
*         DETERMINE IF THE SUBSYSTEM MUST BE FORCED INTO CPU 0 ON A 
*         DUAL CPU MACHINE WITH CACHE.
  
          LDM    TSPP+1,T1
          LPN    77 
          ZJN    IJB10       IF SUBSYSTEM MAY RUN IN EITHER CPU 
          LDN    EIBP 
          CRD    CM 
          LDD    CM 
          SHN    21-12
          PJN    IJB10       IF NOT DUAL CPU MACHINE WITH CACHE 
          LDN    CPUS        SELECT CPU 0 
          STD    CM+1 
          ERRNZ  CPUS-1      CODE DEPENDS ON VALUE
          STD    CM+4 
          MONITOR  SJCM 
  
*         DETERMINE IF THE SUBSYSTEM SHOULD BE INITIATED BY A PP CALL,
*         OR VIA A SET OF COMMANDS ON THE JOB INPUT FILE. 
  
 IJB10    LDM    TSPP,T1
          ZJP    IJB7        IF NOT A PP-INITIATED SUBSYSTEM
          STD    IR          STORE PP NAME IN PP INPUT REGISTER 
          LDM    TSPP+1,T1
          LMD    IR+1 
          SCN    77 
          LMD    IR+1 
          STD    IR+1 
          LDD    IA 
          CWD    IR 
  
*         UPDATE EJT ENTRY AS FOLLOWS - 
*                CHANGE JOB STATUS TO *EXJS*. 
*                CLEAR JOB ADVANCE AND INTERLOCK. 
*                CLEAR INPUT FILE ADDRESS.
*                CLEAR ERROR FLAG.
  
          AOM    IJBL 
          SOM    IJBL+4 
          LDC    IJBL+3*10000 
          RJM    IUT         ISSUE *UTEM* MONITOR FUNCTION
          LJM    PPR         CALL PP TO INITIATE SUBSYSTEM
  
  
**        DEFAULT CONTROL POINT AREA WORD IMAGES. 
  
  
*         *STLW*. 
  
 IJBB     VFD    18/DFBA,42/-0
  
*         *SRJW*. 
  
 IJBC     VFD    12/0,18/DFBJ,30/0
  
*         *CPJW*. 
  
 IJBD     VFD    12/0,18/DFCP,30/0
  
*         *FPFW*. 
  
 IJBE     VFD    12/0,12/DFVL,36/0
  
*         *PFCW*. 
  
 IJBF     VFD    36/0,12/NEEQ,12/0
  
*         *CSPW* (SUBSYSTEMS).
  
 IJBH     VFD    12/0,1/1,23/0,12/CSBN,12/CSBN-3
  
*         *CSPW* (PRESET PRIOR TO I/O IN CASE OF I/O ERROR).
  
 IJBI     VFD    12/0,12/4000,12/0,12/CSBN,12/CSBN
  
*         *CPLW*. 
  
 IJBJ     VFD    1/0,59/-0
          SPACE  4,10 
*         MISCELLANEOUS STORAGE.
  
  
*         MULTIPLIER VALUES FOR *ACTM* FUNCTION.
  
 IJBK     VFD    12/M1SR,12/M2SR,12/M3SR,12/M4SR,12/ADSR
  
*         *UTEM* PARAMETERS.
  
 IJBL     VFD    1/0,5/JSNE,6/6 
          VFD    6/0,6/0
          CON    0
          CON    0
          CON    EXJS*2+1 
  
          VFD    1/0,5/SCHE,6/24D 
          VFD    6/36D,6/0
          CON    0,0,0
  
          VFD    1/0,5/PRFE,6/12D 
          VFD    6/36D,6/0
          CON    0
          CON    0
          CON    0
  
          VFD    1/0,5/SCHE,6/2  UNCONDITIONAL JOB TERMINATION
          VFD    6/33D,6/0
          CON    0,0,UCTM 
  
*         *AACW* AND *ALMW*.
  
 IJBM     VFD    60/-0
  
*         *ACLW*. 
  
*         VFD    36/-0
          VFD    6/0
          VFD    18/-0
  
 IJBN     VFD    60/0L"SYSCHG"
          TITLE  PRIMARY SUBROUTINES. 
 AIF      SPACE  4,15 
**        AIF - PROCESS ABORTED INPUT FILE. 
* 
*         ENTRY  (A) = ABORTED INPUT FILE ERROR CODE. 
*                (TT - TT+1) = TERMINAL TABLE ADDRESS.
*                (TSTN) = TERMINAL NUMBER IF ON-LINE INTERACTIVE JOB
*                         AND *IAF* IS ACCESSIBLE.
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  C2D, DFM, RRR, SRR.
* 
*         MACROS MONITOR. 
* 
*         HANG CONDITIONS - 
*                INCORRECT ERROR CODE.
  
  
 AIF      SUBR               ENTRY/EXIT 
          STD    T1          SAVE ERROR CODE
          SBN    TAIPL+1
          MJN    AIF1        IF LEGAL ERROR CODE
          LDN    0
          STD    CM+2        SET NO ERROR FLAG
          LDC    *
          STD    CM+1        ADDRESS WHERE ERROR DETECTED 
          MONITOR  CHGM      CONDITIONAL HANG 
          LDD    T1 
          STD    CM          SAVE BAD ERROR CODE
          LDN    TAIPL+1     SET PSEUDO ERROR CODE
          STD    T1 
 AIF1     LDM    TAIP,T1     SET PROCESSOR ADDRESS
          STD    T2 
          ZJN    AIF2        IF NO PROCESSOR EXISTS FOR THIS ERROR CODE 
          RJM    0,T2        PROCESS ERROR CODE 
  
*         ISSUE MESSAGE AND TERMINATE JOB.
  
 AIF2     LDM    TAIM,T1
          ZJN    AIF3        IF NO MESSAGE TO ISSUE 
          RJM    DFM         ISSUE MESSAGE
 AIF3     LDM    TSTN 
          ZJN    AIFX        IF NOT ON-LINE INTERACTIVE JOB 
          RJM    SRR         SET R-REGISTER TO IAF RA 
          LDD    TT          READ *VROT*
          SHN    14 
          LMD    TT+1 
          ADK    /REM/VROT
          CRD    CM 
          LDC    6001        SET ABORTED INPUT FILE, COMPLETION FLAGS 
          STD    CM+4 
          LDD    TT          WRITE *VROT* 
          SHN    14 
          LMD    TT+1 
          ADK    /REM/VROT
          CWD    CM 
          RJM    RRR         RESTORE R-REGISTER 
          LJM    AIFX        RETURN 
 AIF      SPACE  4,10 
*         ABORTED INPUT FILE ERROR PROCESSORS.
* 
*         ENTRY  (T1) = ERROR CODE. 
*                *BFMS* CONTAINS SYSTEM SECTOR. 
 PUA      SPACE  4,10 
**        PUA - PROCESS UNKNOWN ABORT CODE. 
* 
*         ENTRY  (T1) = TABLE INDEX TO ABORT MESSAGE. 
*                (CM) = UNKNOWN ABORT CODE. 
* 
*         USES   CM+1.
* 
*         CALLS  C2D. 
  
  
 PUA      SUBR               ENTRY/EXIT 
          LDM    TAIM,T1     GET ADDRESS OF MESSAGE 
          STD    CM+1 
          LDD    CM          STORE ABORT CODE IN MESSAGE
          RJM    C2D         CONVERT TO OCTAL 
          STM    14,CM+1
          UJN    PUAX        RETURN 
          SPACE  4,10 
**        PJC - *JCIE*/*STIE*/*IDIE*/*DBIE*/*VLIE*/*NLIE* PROCESSOR.
  
  
 PJC      SUBR               ENTRY/EXIT 
          LDD    CP          WRITE CREATOR-S USER NAME/INDEX TO CPA 
          ADN    UIDW 
          CWM    ACSS,ON
          UJN    PJCX        RETURN 
          SPACE  4,10 
**        PBC - *BCIE*/*HDIE* PROCESSOR.
* 
*         CALLS  CDD. 
  
  
 PBC      SUBR               ENTRY/EXIT 
          LDM    TAIM,T1     SET CONVERSION TARGET ADDRESSES
          ADN    12D
          STM    PBCA 
          ADN    1
          STM    PBCB 
          ADN    3
          STM    PBCC 
          ADN    1
          STM    PBCD 
          LDM    RNSS        CONVERT RECORD NUMBER
          RJM    CDD         CONVERT TO DECIMAL 
          LDD    CM+3        STORE COMMAND NUMBER IN MESSAGE
          STM    ** 
 PBCA     EQU    *-1
          LDD    CM+4 
          STM    ** 
 PBCB     EQU    *-1
          LDM    CNSS        CONVERT COMMAND NUMBER 
          RJM    CDD         CONVERT TO DECIMAL 
          LDD    CM+3 
          STM    ** 
 PBCC     EQU    *-1
          LDD    CM+4 
          STM    ** 
 PBCD     EQU    *-1
          LJM    PBCX        RETURN 
  
 PHD      EQU    PBC         *HDIE* PROCESSOR ENTRY LOCATION
 TAIM     SPACE  4,10 
**        TAIM - TABLE OF ABORTED INPUT FILE ERROR MESSAGES.
*                INDEXED BY ABORTED INPUT FILE ERROR CODE.
* 
*         NOTE - ADDITION OF ANY ENTRY TO THIS TABLE REQUIRES INCLUSION 
*                OF THE NEW ERROR FLAG IN THE *MAX* PARAMETER LIST. 
  
  
 TAIML    MAX    JCIE,CRIE,OTIE,DFIE,MSIE,NRIE,BCIE,HDIE,ODIE,STIE,IDIE,
,DBIE,VLIE,UNIE,SCIE,USIE,UCIE,HRIE,SWIE
  
 TAIM     INDEX 
          INDEX  JCIE,(=C* JOB COMMAND ERROR.*) 
          INDEX  CRIE,(=C* CARD READER ERROR.*) 
          INDEX  OTIE,(=C* OPERATOR INPUT TERMINATION.*)
          INDEX  DFIE,(=C* DISK FULL.*) 
          INDEX  MSIE,(=C* MASS STORAGE ERROR.*)
          INDEX  NRIE,(=C* JOB IN NO RERUN STATE ON RECOVERY.*) 
          INDEX  BCIE,(=C* BINARY SEQ. ERROR,  REC0000  CD0000.   *)
          INDEX  HDIE,(=C* UNKNOWN HOLL. CODE, REC0000  CD0000.   *)
          INDEX  ODIE,(=C* OPERATOR DROP.*) 
          INDEX  STIE,(=C/ USER NOT VALIDATED TO SPECIFY *ST*./)
          INDEX  IDIE,(=C* INCORRECT LID.*) 
          INDEX  DBIE,(=C* QUEUE LIMITS EXCEEDED ON REMOTE MAINFRAME.*) 
          INDEX  VLIE,(=C* JOB NOT VALID ON REMOTE MAINFRAME.*) 
          INDEX  NLIE,(=C* JOB NOT VALIDATED TO USE LINK.*) 
          INDEX  UNIE,(=C* USER NAME/PASSWORD NOT VALID.*)
          INDEX  SCIE,(=C* INCORRECT SERVICE CLASS.*) 
          INDEX  USIE,(=C* UNDEFINED SERVICE CLASS.*) 
          INDEX  UCIE,(=C* USER SECURITY COUNT EXHAUSTED.*) 
          INDEX  HRIE,(=C* HARDWARE RERUN THRESHOLD EXCEEDED.*) 
          INDEX  SWIE,(=C* SYSTEM SOFTWARE RERUN THRESHOLD EXCEEDED.*)
          INDEX  TAIML+1,(=C* INCORRECT ABORT CODE XX.*)
          INDEX  TAIML+2
 TAIP     SPACE  4,10 
**        TAIP - TABLE OF ABORTED INPUT FILE PROCESSORS.
*                INDEXED BY ABORTED INPUT FILE ERROR CODE.
* 
*         NOTE - ADDITION OF AN ENTRY TO THIS TABLE REQUIRES INCLUSION
*                OF THE NEW ERROR FLAG IN THE *MAX* PARAMETER LIST IN 
*                THE *TAIM* TABLE DEFINITION. 
  
  
 TAIPL    EQU    TAIML       TABLE LENGTH 
  
 TAIP     INDEX 
          INDEX  JCIE,PJC 
          INDEX  BCIE,PBC 
          INDEX  HDIE,PHD 
          INDEX  STIE,PJC 
          INDEX  IDIE,PJC 
          INDEX  DBIE,PJC 
          INDEX  VLIE,PJC 
          INDEX  NLIE,PJC 
          INDEX  TAIPL+1,PUA
          INDEX  TAIPL+2
 CCA      SPACE  4,20 
**        CCA - COMPLETE CONTROL POINT AREA INITIALIZATION. 
* 
*         INITIALIZE FIELDS OF THE CONTROL POINT AREA THAT REQUIRE NO 
*         DISTINCTION BETWEEN SUBSYSTEM AND NON-SUBSYSTEM JOBS. 
* 
*         ENTRY  *BFMS* CONTAINS INPUT FILE SYSTEM SECTOR.
*                (JBOT) = ORIGIN TYPE.
*                (JBSC) = SERVICE CLASS.
*                (FS) = INPUT FILE EQUIPMENT. 
*                (FS+1) = INPUT FILE FIRST TRACK. 
*                (T6) = INPUT FILE CURRENT TRACK. 
*                (T7) = INPUT FILE CURRENT SECTOR.
* 
*         USES   T1, CM - CM+4, AB - AB+4, FS - FS+4, SP - SP+4,
*                CN - CN+4, CW - CW+4.
* 
*         CALLS  CMX, ECS, EOJ, PFC.
* 
*         MACROS MONITOR, NFA.
  
  
 CCA      SUBR               ENTRY/EXIT 
  
*         BUILD INPUT FILE FNT/FST. 
  
          LDD    T6          SET CURRENT TRACK
          STD    FS+2 
          LDD    T7          SET CURRENT SECTOR 
          STD    FS+3 
          LDN    5           SET FILE STATUS = COMPLETED READ 
          STD    FS+4 
          LDN    ZERL 
          CRD    CM 
          LDM    IOSS+5*INSQ+3  SET ACCESS LEVEL
          LPN    70 
          SHN    -3 
          STD    CM+2 
          NFA    FNTN        WRITE INPUT FILE FNT/FST TO NFL
          CWM    CCAA,ON
          ERRNZ  FSTL-1      CODE DEPENDS ON VALUE
          CWD    FS 
          ADN    FUTL-FSTL
          CWD    CM 
  
*         SET JOB STEP AND SRU LIMITS.
  
          LDM    VASS+AHMT*5+2  SET SRU VALIDATION INDEX
          RJM    SLI         SRU LIMIT INDEX
          SHN    -3 
          STM    IJBE+1 
          LDM    JBOT        CHECK ORIGIN TYPE
          LMK    TXOT 
          ZJN    CCA1        IF *TXOT* ORIGIN 
          LDM    JBSC 
          LMN    SSSC 
          NJN    CCA0        IF NOT A SUBSYSTEM 
          LJM    CCA5.1      CONTINUE 
  
 CCA0     LDM    IJBE+1      SET SRU LIMIT
          LJM    CCA5        CONTINUE 
  
 CCA1     LDM    VASS+AHMT*5+2  TIME LIMIT INDEX
          RJM    TLI         TIME LIMIT INDEX 
          LPC    7777 
          SHN    3           MULTIPLY BY 10B
          ADC    -/REM/UTIS*10
          PJN    CCA2        IF DEFAULT .LE. VALIDATION LIMIT 
          ADC    /REM/UTIS*10  USE VALIDATION LIMIT 
          UJN    CCA3        CONTINUE 
  
 CCA2     LDK    /REM/UTIS*10  USE DEFAULT
 CCA3     STM    JTSS+1 
          SHN    -14
          STM    JTSS 
  
*         SET SRU DEFAULT OR VALIDATION LIMIT 
  
          LDM    IJBE+1      GET SRU VALIDATION INDEX 
          ADK    -DFSL/100
          PJN    CCA4        IF DEFAULT .LE. VALIDATION LIMIT 
          ADK    DFSL/100 
          UJN    CCA5        CONTINUE 
  
 CCA4     LDK    DFSL/100    SET DEFAULT SRU LIMIT
 CCA5     LMC    7777 
          NJN    CCA5.0      IF NOT UNLIMITED 
          LDC    770000 
 CCA5.0   LMC    7777 
          STM    IJBB 
          STM    IJBC+1 
          SHN    -6 
          SCN    77 
          STM    IJBC+2 
          LMN    77 
          STM    IJBB+1 
  
*         SET SRU MULTIPLIERS.
  
 CCA5.1   LDD    CP          WRITE *STLW* 
          ADK    STLW 
          CWM    IJBB,ON
          LDD    MA          WRITE PARAMETERS INTO MESSAGE BUFFER 
          CWM    IJBK,ON
          LDN    ABBF        ACCOUNT BLOCK BEGIN (SUBFUNCTION)
          STD    CM+1 
          MONITOR  ACTM 
  
*         SET JOB STEP TIME LIMIT.
  
          LDM    JTSS 
          SHN    14 
          LMM    JTSS+1 
          ZJN    CCA6        IF NO TIME ON JOB COMMAND
          SHN    21-5 
          STM    IJBD+1 
          SHN    -6 
          SCN    77 
          STM    IJBD+2 
  
*         SET PAGE PARAMETERS.
  
 CCA6     LDN    IPPL        GET SYSTEM PAGE PARAMETERS 
          CRD    CM 
          LDN    0
          STD    CM          CLEAR UNRELATED BYTES
          STD    CM+1 
          NFA    JPPN 
          CWD    CM          SYSTEM VALUES AS JOB INITIAL DEFAULTS
  
*         INITIALIZE RECALL AREA LINKS. 
  
          LDN    ZERL 
          CRD    CM 
          CRD    AB          CLEAR *FLCW* IMAGE 
          CRD    FS          CLEAR *EOJW* IMAGE 
          CRD    SP          CLEAR EXCHANGE PACKAGE EXIT WORD IMAGE 
          CRD    CN          CLEAR *ELCW* IMAGE 
          CRD    CW          CLEAR *PFCW* IMAGE 
          LDN    2
          STD    CM+4 
 CCA7     LDC    RCCW-2 
          ADD    CM+4 
          ADD    CP 
          CWD    CM 
          AOD    CM+4 
          LMN    LREC+1 
          NJN    CCA7        IF INITIALIZATION IS INCOMPLETE
  
*         SET ERROR EXIT MODE IN EXCHANGE PACKAGE.
  
          LDK    MABL 
          CRD    CM 
          LDC    7007 
          STD    SP 
          LDD    CM+1 
          SHN    -11
          LMN    7
          NJN    CCA8        IF NOT CYBER 176 
          SOD    SP          DESELECT UNDERFLOW 
 CCA8     LDD    CM+1        CHECK FOR CYBER 170-8X5
          SHN    21-13
          MJN    CCA9        IF NOT CYBER 170-8X5 
          LDK    UEML        CHECK FOR UEM PRESENT
          CRD    CM 
          LDD    CM+4 
          LPN    2
          SHN    10-1 
          RAD    SP          SET/CLEAR UEM PRESENT FLAG 
          LDM    JBOT        DON-T SET PURGING FLAG IF SYSTEM ORIGIN
          LMK    SYOT 
          ZJN    CCA9        IF SYSTEM ORIGIN JOB 
          LDK    SSTL        SET EXTENDED PURGING BIT 
          CRD    CM 
          LDD    CM+3 
          LPN    40 
          LMN    40 
          SHN    4-5
          RAD    SP          SET/CLEAR PURGING FLAG 
 CCA9     LDK    MEFL 
          CRD    CM 
          LDD    CM+2 
          LPC    200         EXPANDED ADDRESSING FLAG 
          RAD    SP 
  
*         DETERMINE MFL AND MAXFL FOR FL BY THE FOLLOWING FORMULA - 
* 
*                A = MIN(JCSS, VALIDATED CM, MAXIMUM MACHINE SIZE). 
*                MFL,MAXFL = MAX(A, AFFL, JTFL).
* 
*                AFFL = *ACCFAM* FIELD LENGTH.
*                JTFL = MAXIMUM OF *DAYFILE, MFILES* FIELD LENGTH.
  
          LDM    JBOT        SET JOB ORIGIN 
          STD    T1 
          LDM    VASS+AHMT*5+3  GET MAXIMUM VALIDATED CM FL 
          RJM    CMX         COMPUTE MAXIMUM VALIDATED CM 
          STD    AB          SET MFL
          STD    AB+2        SET MAXFL
          SBM    JCSS 
          MJN    CCA10       IF SPECIFIED FL .GE. ALLOWABLE FL
          LDM    JCSS        USE SPECIFIED AS MFL AND MAXFL 
          STD    AB 
          STD    AB+2 
  
*         DETERMINE IF FIELD LENGTH CALCULATED ABOVE IS GREATER 
*         THAN OR EQUAL TO THE MINIMUM FL NEEDED TO EXECUTE JOB 
*         TERMINATION.  IF IT IS, USE THE FIELD LENGTH CALCULATED 
*         ABOVE.  IF IT IS NOT, USE THE MINIMUM FIELD LENGTH NEEDED 
*         FOR JOB TERMINATION.
  
 CCA10    LDD    AB          COMPUTE MAX(AB, AFFL, JTFL)
          SBK    IJFL 
          PJN    CCA11       IF CALCULATED FL .GE. TERMINATION FL 
          LDK    IJFL        USE MINIMUM JOB TERMINATION FL 
          STD    AB          SET MFL
          STD    AB+2        SET MAXFL
  
*         DETERMINE MINIMUM OF SPECIFIED ECS FL AND VALIDATION ECS FL.
  
 CCA11    LDM    VASS+AHMT*5+3  GET VALIDATION INDEX FOR ECS
          LPN    77 
          RJM    ECX         CALCULATE VALIDATION EXTENDED MEMORY FL
          STD    CN          SET MFLE TO VALIDATION MAXIMUM 
          STD    CN+2        SET MAXFLE TO VALIDATION MAXIMUM 
          SBM    JESS 
          MJN    CCA12       IF SPECIFIED ECS FL IS TOO BIG 
          LDM    JESS        USE SPECIFIED ECS FL AS MFLE AND MAXFLE
          STD    CN 
          STD    CN+2 
  
*         FINISH BUILDING CPA.
  
 CCA12    RJM    EOJ         BUILD *EOJW* IN *FS - FS+4*
          RJM    PFC         BUILD *PFCW* IN *CW - CW+4*
          ERRNZ  DFBJ-DFSO   CODE REQUIRES BATCH/SYSTEM DEFAULTS EQUAL
          ERRNZ  DFBA-DFSO   CODE REQUIRES BATCH/SYSTEM DEFAULTS EQUAL
          LDD    CP 
          ADN    3
          CWD    SP 
          ADN    SRJW-3      WRITE *SRJW*, *CPJW* AND *FPFW*
          ERRNZ  CPJW-SRJW-1 CODE ASSUMES *SRJW* AND *CPJW* CONTIGUOUS
          ERRNZ  FPFW-CPJW-1 CODE ASSUMES *CPJW* AND *FPFW* CONTIGUOUS
          CWM    IJBC,ON     WRITE *SRJW* 
          CWM    IJBD,ON     WRITE *CPJW* 
          CWM    IJBE,ON     WRITE *FPFW* 
          ADN    FLCW-FPFW-1
          CWD    AB 
          ADN    ELCW-FLCW
          CWD    CN 
          ADN    PFCW-ELCW
          CWD    CW 
          ADN    ALMW-PFCW
          ERRNZ  DFBA-777777 CODE REQUIRES *IJBF - IJBF+4* = 0
          CWM    IJBM,ON     WRITE *ALMW* 
          IFNE   ACLW-ALMW,1,1
          ADN    ACLW-ALMW-1
          CWM    IJBM+2,ON   WRITE *ACLW* 
          IFNE   AACW-ACLW,1,1
          ADN    AACW-ACLW-1
          CWM    IJBM,ON     WRITE *AACW* 
          SBN    AACW+1-EOJW
          CWD    FS          WRITE *EOJW* 
          ADN    TSCW-EOJW   READ *TSCW*
          CRD    CM 
          STD    FS 
          LDK    RTCL        COMPUTE CM SLICE 
          CRD    CN 
          LDD    CN+1 
          RAD    CM+1 
          SHN    -14
          ADD    CN 
          STD    CM 
          LDD    CN+1        COMPUTE CONTROL POINT SLICE
          RAD    CM+4 
          SHN    -14
          ADD    CN 
          STD    CM+3 
          LDD    FS          WRITE *TSCW* 
          CWD    CM 
          ADN    JSCW-TSCW   BUILD *JSCW* 
          STD    FS 
          LDM    IOSS+5*INSQ+3  SET JOB ACCESS LEVEL LIMIT
          LPN    7
          SHN    13-2 
          RAM    VASS+5*ASVW+2
          LDM    IOSS+5*INSQ+3  SET INITIAL JOB ACCESS LEVEL
          LPN    70 
          SHN    13-5 
          RAM    VASS+5*ASVW+1
          LDD    FS          WRITE *JSCW* 
          CWM    VASS+5*ASVW,ON 
          LDD    CP 
          ADK    AALW        READ *AALW*
          CRD    CM 
          STD    FS 
          LDM    VASS+APRN*5+4  GET APPLICATION ACCESS LEVEL
          SHN    -6 
          STD    CM+4 
          LDD    FS 
          CWD    CM          WRITE *AALW* 
          LDN    ZERL 
          CRD    CM 
          LDD    FL 
          ZJN    CCA13       IF NO CM FL IS ASSIGNED
          LDD    RA          CLEAR RA - RA+2
          SHN    6
          CWD    CM 
          ADN    1
          CWD    CM 
          ADN    1
          CWD    CM 
 CCA13    LJM    CCAX        RETURN 
  
  
 CCAA     VFD    42/5LINPUT,6/1,6/INFT,6/NDST 
 CDD      SPACE  4,10 
**        CDD - CONVERT TO DECIMAL DISPLAY CODE.
* 
*         ENTRY  (A) = INTEGER TO CONVERT.
* 
*         EXIT   (CM+3 - CM+4) = DISPLAY CODE VALUE.
* 
*         USES   CM - CM+4, T7. 
* 
*         MACROS MONITOR. 
  
  
 CDD      SUBR               ENTRY/EXIT 
          STD    CM+4        SET UP CALL FOR *RDCM* 
          LDN    ZERL 
          CRD    T7 
          LDD    MA 
          CWD    CM 
          MONITOR  RDCM      CONVERT DATA 
          LDD    MA 
          CRD    CM 
          LDD    CM+2        REMOVE DECIMAL POINT 
          LPN    77 
          SHN    6
          STD    CM+2 
          LDD    CM+3 
          LPN    77 
          LMD    CM+2 
          STD    CM+3 
          UJN    CDDX        RETURN 
 PNS      SPACE  4,20 
**        PNS - PROCESS NON-SUBSYSTEM JOB.
* 
*         PERFORM THAT PART OF JOB INITIATION PECULIAR TO NON-SUBSYSTEM 
*         JOBS. 
* 
*         ENTRY  *BFMS* CONTAINS INPUT FILE SYSTEM SECTOR.
* 
*         EXIT   (A) .GE. 0 IF JOB SHOULD NOT BE TERMINATED.
*                (A) .LT. 0 IF JOB SHOULD BE TERMINATED.
* 
*         USES   TN, AB - AB+4, CM - CM+4.
* 
*         CALLS  BCS, IAM, ISD, RRR, SRR, STA.
* 
*         MACROS SFA. 
  
  
 PNS      SUBR               ENTRY/EXIT 
          RJM    BCS         BUILD COMMAND BUFFER 
  
*         SET 026/029 PUNCH MODE FLAG IN CPA. 
  
          LDN    ZERL 
          CRD    CM 
          LDM    JFSS 
          LPN    1
          SHN    12 
          STD    CM 
          LDD    CP 
          ADN    SNSW 
          CWD    CM 
  
*         ISSUE JOB COMMAND TO DAYFILE. 
  
          LDC    STMT 
          RJM    ISD         ISSUE COMMAND TO DAYFILE 
  
*         ISSUE ACCOUNTING MESSAGE TO DAYFILE.
  
          RJM    IAM         ISSUE ACCOUNTING MESSAGE TO DAYFILE
  
*         CONTINUE BUILDING CONTROL POINT AREA. 
  
          LDD    CP          SET/CLEAR SSID FIELD 
          ADN    JCIW 
          CRD    CM 
          LDM    SISS 
          STD    CM+2 
          LDD    CP 
          ADN    JCIW 
          CWD    CM 
          ADN    UIDW-JCIW   WRITE USER IDENTIFICATION
          CWM    ACSS,ON
  
*         IF THE JOB IS ON-LINE INTERACTIVE, STORE ITS TERMINAL NUMBER
*         IN THE CONTROL POINT AREA AND STORE ITS EJT ORDINAL IN THE
*         TERMINAL TABLE. 
  
          LDM    JBOT        CHECK JOB ORIGIN TYPE
          LMK    TXOT 
          NJN    PNS2        IF NOT INTERACTIVE JOB 
          SFA    EJT,JO      SET EJT ADDRESS
          ADK    JSNE        READ CONNECTION STATUS WORD
          CRD    CM 
          LDD    CM+4        CHECK CONNECTION STATUS
          SHN    -7 
          LPN    17 
          LMK    OLCS 
          ZJN    PNS3        IF ONLINE
 PNS2     LJM    PNSX        EXIT 
  
 PNS3     LDN    ZERL        INITIALIZE *TTNW*
          CRD    CM 
          LDM    TRSS        GET TERMINAL NUMBER FROM SYSTEM SECTOR 
          STM    TSTN        SET JOB TERMINAL NUMBER
          STD    CM+1 
          STD    TN 
          LDM    ISSS        LOAD INITIAL INTERACTIVE SUBSYSTEM 
          LPN    37 
          SHN    6
          STD    CM 
          LDD    CP          WRITE *TTNW* 
          ADK    TTNW 
          CWD    CM 
          LDM    TSAF        GET *IAF* CP NUMBER
          NJN    PNS4        IF *IAF* IS ACCESSIBLE 
          STM    TSTN        CLEAR TERMINAL NUMBER
          LDN    12D         CHANGE CONNECTION STATUS TO *NICS* 
          STM    IJBL+0 
          LDC    100+EXJS*2+1  RESET JOB ADVANCE FLAG 
          STM    IJBL+4 
          LCN    0           INDICATE JOB MUST BE TERMINATED
          UJN    PNS2        EXIT 
  
*         STORE EJT ORDINAL IN TERMINAL TABLE.
  
 PNS4     RJM    SRR         SET R-REGISTER TO IAF RA 
          RJM    STA         SET FWA OF TERMINAL TABLE
          ADK    /REM/VUIT
          CRD    AB 
          LDD    JO          STORE EJT ORDINAL IN TERMINAL TABLE
          STD    AB+4 
          LDD    TT 
          SHN    14 
          LMD    TT+1 
          ADK    /REM/VUIT
          CWD    AB 
          RJM    RRR         RESTORE R-REGISTER 
          LDN    1R*         CHANGE INPUT FILE TO INPUT*
          RAM    CCAA+2 
          JMP    PNSX        RETURN 
 PSS      SPACE  4,15 
**        PSS - PROCESS SUBSYSTEM.
* 
*         PERFORM THAT PART OF JOB INITIATION PECULIAR TO SUBSYSTEMS. 
* 
*         ENTRY *BFMS* CONTAINS INPUT FILE SYSTEM SECTOR. 
* 
*         EXIT   (A) = 0 IF NO ERROR. 
*                    = SSID IF ERROR. 
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         ERROR  PP HUNG IF SCP WITH NO CM FL ASSIGNED. 
* 
*         CALLS  BCS, IAM, ISD. 
* 
*         MACROS MONITOR, NFA.
  
  
 PSS6     LDN    0           SET EXIT CONDITION 
  
 PSS      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADN    JCIW 
          CRD    CM 
          LDM    SISS        PLACE SUBSYSTEM IDENTIFIER IN CPA
          STD    CM+2 
          LMC    RDSI 
          NJN    PSS1        IF NOT *RDF* 
          LDC    IFSI        SET *IAF* IDENTIFIER 
          STD    CM+2 
 PSS1     LDD    CP 
          ADN    JCIW 
          CWD    CM 
          LDD    EF 
          ZJN    PSS2        IF NO ERROR FLAG SET 
          LDD    CM+2        SET EXIT CONDITION 
          UJP    PSSX        RETURN 
  
 PSS2     LDM    SISS        CHECK SUBSYSTEM ID 
          SBK    LSSI+1 
          MJN    PSS3        IF PSEUDO SUBSYSTEM
          LDC    MXSI 
          SBM    SISS 
          SHN    1
          STD    T1 
          LDM    TSPP,T1
          NJP    PSS6        IF PP INITIATED SUBSYSTEM
  
*         READ COMMANDS FOR NON-PP-INITIATED SUBSYSTEM. 
  
 PSS3     RJM    BCS         BUILD COMMAND BUFFER 
          LDC    STMT        ISSUE JOB COMMAND TO DAYFILE 
          RJM    ISD
          RJM    IAM         ISSUE ACCOUNTING MESSAGE 
          LDD    CP          SET UP *UIDW*
          ADN    UIDW 
          CWM    ACSS,ON
  
*         CLEAR THE SUBSYSTEM IDENTIFICATION AND BUFFER POINTER WORDS.
  
          LDM    SISS 
          SBK    LSSI+1 
          MJN    PSS5        IF A PSEUDO SUBSYSTEM
          LDD    FL 
          NJN    PSS4        IF FL IS ASSIGNED
*         LDN    0
          STD    CM+2        SET NO ERROR FLAG
          LDC    *
          STD    CM+1        ADDRESS WHERE ERROR DETECTED 
          MONITOR  CHGM      CONDITIONAL HANG FOR NO FL 
          UJN    PSS5        RETURN WITH NO ERROR 
  
 PSS4     LDN    ZERL 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    SSIW 
          CWD    CM 
          ADN    SSCR-SSIW
          CWD    CM 
 PSS5     LJM    PSS6        RETURN 
          SPACE  4,10 
*         SUBSYSTEM TABLES. 
          SPACE  4,10 
**        TSPP - TABLE OF SUBSYSTEM PP NAMES. 
* 
*         TABLE FORMAT FOR PP-INITIATED SUBSYSTEMS. 
* 
*T        18/ PP NAME,6/ CPU
* 
*         TABLE FORMAT FOR NON-PP-INITIATED SUBSYSTEMS. 
* 
*T        18/ 0,6/ CPU
* 
*         CPU .NE. 0, IF SUBSYSTEM MUST RUN IN CPU 0 ON A DUAL CPU
*         MACHINE WITH CACHE. 
  
  
 TSPP     INDEX 
 .SUB     HERE
          INDEX  MXSI*2-LSSI*2
          TITLE  SECONDARY SUBROUTINES. 
 BCS      SPACE  4,10 
**        BCS - BUILD COMMAND BUFFER. 
* 
*         ENTRY  *BFMS* CONTAINS INPUT FILE SYSTEM SECTOR.
*                I/O SEQUENCE HAS BEEN INITIATED. 
* 
*         USES   CN - CN+4, SP - SP+4.
* 
*         CALLS  MSR, RCS, RNS. 
* 
*         MACROS ENDMS, NFA.
  
  
 BCS      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR *CSPW* IMAGE 
          CRD    SP 
          LDN    0           CLEAR BYTE 4 OF *CSSW* IMAGE 
          STD    CN+4 
          LDN    FSMS        SET POSITION AT FIRST DATA SECTOR
          STD    T7 
          ADN    1           SET CURRENT SECTOR TO 2ND DATA SECTOR
          STD    CN+3 
          LDD    T6          SET FIRST AND CURRENT TRACK
          STD    CN+1 
          STD    CN+2 
          LDD    T5          SET EST ORDINAL AND INPUT FILE FLAG
          LMC    4000 
          STD    CN 
          LDC    SBUF        READ 1ST DATA SECTOR 
          RJM    RNS
          MJN    BCS2.1      IF MASS STORAGE ERROR
          LDC    CSBN        SET NEXT COMMAND INDEX 
          STD    SP+3 
          SBD    T1          SET LIMIT INDEX
          STD    SP+4 
          LDD    T1 
          ZJN    BCS1        IF DATA SECTOR IS EMPTY
          AOM    ADJB        SET COMMANDS PRESENT 
          NFA    SP+3,R      MOVE SECTOR TO COMMAND BUFFER
          CWM    SBUF+2,T1
          LDD    T1 
          SHN    -6 
          NJN    BCS2        IF NOT EOR 
 BCS1     LDC    4000        SET EOR FLAG 
          STD    SP+1 
          UJN    BCS3        AVOID POSITIONING LOOP 
  
*         SKIP TO FIRST EOR SO INPUT FILE FST CAN BE BUILT WITH DISK
*         ADDRESS SET TO THE START OF THE NEXT RECORD.
  
 BCS2     LDC    SBUF 
          RJM    RNS         READ NEXT SECTOR 
 BCS2.1   MJN    BCS4        IF MASS STORAGE ERROR
          SHN    -6 
          NJN    BCS2        IF NOT AT EOR
 BCS3     ENDMS 
          RJM    RCS         READ JOB COMMAND 
          PJN    BCS5        IF NO MASS STORAGE ERROR 
 BCS4     RJM    MSR         PROCESS MASS STORAGE ERROR, NO RETURN
  
*         SET CHARGE REQUIRED FOR NON-SYSTEM ORIGIN JOBS. 
  
 BCS5     LDM    JBOT 
          LMK    SYOT 
          ZJN    BCS6        IF SYSTEM ABORT
          LDN    4           SET CHARGE REQUIRED
          STM    CRQF 
          RAD    SP 
  
*         WRITE UPDATED COMMAND BUFFER WORDS TO CM. 
  
 BCS6     LDD    CP 
          ADN    CSPW 
          CWD    SP 
          ADN    CSSW-CSPW
          CWD    CN 
          LJM    BCSX        RETURN 
 EOJ      SPACE 4,10
**        EOJ - BUILD END OF JOB CONTROL WORD, *EOJW*.
* 
*         ENTRY  (FS - FS+4) = ZERO WORD. 
* 
*         EXIT   (FS - FS+4) = *EOJW* WORD. 
*                (JTFG) = JOB TERMINATION FLAGS.
*                (JTOP) = JOB TERMINATION OPTIONS.
  
  
 EOJ      SUBR               ENTRY/EXIT 
          LDM    IOSS+JSNQ*5+4     GET FILE TYPE FROM QFT ENTRY 
          SHN    -6 
          LMK    INQF        CHECK FILE TYPE
          ZJN    EOJ2        IF *INPUT QUEUE* TYPE
          LMK    NOQF&INQF
          NJN    EOJ1        IF NOT *NO OUTPUT* FILE TYPE 
          LDK    NOJT        SELECT *DROP OUTPUT* 
          UJN    EOJ3        SET QUEUE FILE DISPOSITION 
  
 EOJ1     LMK    TOQF&NOQF   CHECK FILE TYPE
          NJN    EOJ1.1      IF NOT *TERMINAL OUTPUT* 
          LDK    TTJT        SELECT *QUEUE OUTPUT TO TERMINAL*
          UJN    EOJ3        SET QUEUE FILE DISPOSITION 
  
 EOJ1.1   LMK    SOQF&TOQF
          NJN    EOJ2        IF NOT *STATION OUTPUT*
          LDK    SSJT        SELECT *QUEUE OUTPUT TO STATION* 
          UJN    EOJ3        SET QUEUE FILE DISPOSITION 
  
 EOJ2     LDK    QOJT        SELECT *QUEUE ALL OUTPUT*
 EOJ3     SHN    6           STORE QUEUE FILE DISPOSITION 
          STD    FS 
  
*         SET DEFAULT JOB TERMINATION OPTION. 
  
          LDM    JBOT 
          STD    FS+3        SET JOB ORIGIN TYPE
          LMK    TXOT 
          ZJN    EOJ4        IF INTERACTIVE JOB 
          LDK    TJJT&SUJT
 EOJ4     LMK    SUJT 
          SHN    11 
          RAD    FS 
          SHN    -6 
          STM    JTFG        SET JOB TERMINATION FLAGS
          SHN    -3 
          LPN    3
          STM    JTOP 
          LJM    EOJX        RETURN 
 IAM      SPACE  4,10 
**        IAM - ISSUE ACCOUNTING MESSAGE. 
* 
*         ENTRY  *BFMS* CONTAINS INPUT FILE SYSTEM SECTOR.
* 
*         USES   T1, CM - CM+5. 
* 
*         CALLS  ACS, DFM.
* 
*         MACROS MONITOR. 
  
  
 IAM      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDM    CRSS 
          STD    CM+3 
          LDM    CRSS+1 
          STD    CM+4 
          ADD    CM+3 
          ZJN    IAMX        IF NO COMMAND COUNT
          LDD    MA          CONVERT COMMAND COUNT
          CWD    CM 
          MONITOR  RDCM 
*         LDN    0
          STD    CM+5 
          LDC    MBUF        SET ASSEMBLY BUFFER ADDRESS FOR *ACS*
          STD    T1 
          LDC    IAMA        ASSEMBLE *UCCR, * CHARACTER STRING 
          RJM    ACS
          LDM    CMSS        ASSEMBLE CREATION MAINFRAME MACHINE ID 
          STD    CM 
          LPN    77 
          NJN    IAM1        IF NOT SINGLE-CHARACTER MACHINE ID 
          LDN    1R          BLANK-FILL MACHINE ID
          RAD    CM 
 IAM1     LDN    CM 
          RJM    ACS
          LDC    IAMB        ASSEMBLE SEPARATOR 
          RJM    ACS
          LDM    TNSS        ASSEMBLE TERMINAL ID/EST ORDINAL 
          STD    CM 
          LDM    TNSS+1 
          STD    CM+1 
          LDM    TNSS+2 
          STD    CM+2 
          LDM    TNSS+3 
          SCN    77 
          STD    CM+3 
          LDN    CM 
          RJM    ACS
          LDC    IAMB        ASSEMBLE SEPARATOR 
          RJM    ACS
          LDD    MA          ASSEMBLE COMMAND COUNT 
          CRD    CM 
          LDN    CM 
          RJM    ACS
          LDC    IAMC        ASSEMBLE UNITS 
          RJM    ACS
          LDC    MBUF+ACFN   ISSUE MESSAGE TO ACCOUNT DAYFILE 
          RJM    DFM
          LDC    MBUF+CPON   ISSUE MESSAGE TO USER DAYFILE
          RJM    DFM
          LJM    IAMX        RETURN 
  
  
 IAMA     DATA   6CUCCR,
 IAMB     DATA   C*, *
 IAMC     DATA   C*KCDS.* 
 ISD      SPACE  4,10 
**        ISD - ISSUE COMMAND TO DAYFILE. 
* 
*         ENTRY  (A) = ADDRESS OF ZERO FILLED COMMAND.
* 
*         USES   T1, T2, T9.
* 
*         CALLS  DFM. 
  
  
 ISD      SUBR               ENTRY/EXIT 
          STD    T2          SET COMMAND ADDRESS
          ADN    5*5         SET END OF MESSAGE ADDRESS 
          STD    T3 
          LDI    T3          SAVE END OF MESSAGE BYTE 
          STD    T9 
          LDN    0           ENSURE END OF MESSAGE
          STI    T3 
          LDI    T2 
          ZJN    ISDX        IF NO JOB COMMAND
          LDD    T2          ISSUE COMMAND TO DAYFILE 
          RJM    DFM
          LDD    T9 
          ZJN    ISDX        IF COMMAND .LE. 50 CHARACTERS
          STI    T3 
          LDD    T3          ISSUE REMAINDER OF COMMAND 
          LMC    NMSN 
          RJM    DFM
          UJN    ISDX        RETURN 
 IUT      SPACE  4,10 
**        IUT - ISSUE *UTEM* MONITOR FUNCTION TO UPDATE EJT ENTRY.
* 
*         ENTRY  (A) = 6/  C,12/  P 
*                      C = NUMBER OF *UTEM* PARAMETER WORDS.
*                      P = PARAMETER LIST ADDRESS.
* 
*         EXIT   (A) = 0 IF *UTEM* FUNCTION WAS SUCCESSFUL. 
*                    .NE. O IF *UTEM* VERIFICATION FAILED.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR, SFA.
  
  
 IUT      SUBR               ENTRY/EXIT 
          STM    IUTA        PARAMETER LIST ADDRESS 
          SHN    -14
          STD    CM+1        NUMBER OF PARAMETER WORDS
          LDN    0
          STD    CM+2 
          SFA    EJT,JO      CALCULATE EJT ENTRY ADDRESS
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          LDD    CM+1 
          ZJN    IUT1        IF NO PARAMETER WORDS
          LDD    MA          WRITE PARAMETERS TO MESSAGE BUFFER 
          CWM    **,CM+1
 IUTA     EQU    *-1
 IUT1     MONITOR  UTEM 
          LDD    CM+1 
          UJN    IUTX        RETURN 
 MSR      SPACE  4,25 
**        MSR - MASS STORAGE ERROR PROCESSOR. 
* 
*         *MSR* IS CALLED - 
*                1. IF AN UNRECOVERED MASS STORAGE READ ERROR IS
*                   DETECTED BY *RNS* OR *RSS*. 
*                2. IF AN INACCESSIBLE DEVICE IS DETECTED BY *SETMS*. 
*                3. IF AN INCORRECT SYSTEM SECTOR IS ENCOUNTERED BY 
*                   *PJB* (STATUS RETURNED TO *PJB* FROM *RSS*).
* 
*         ENTRY  (A) .LT. 0 IF I/O ERROR OR INACCESSIBLE MASS 
*                           STORAGE DEVICE. 
*                (A) .GE. 0 IF INCORRECT SYSTEM SECTOR. 
* 
*         EXIT   TO *IJB6* TO TERMINATE JOB IF INCORRECT SYSTEM SECTOR
*                OR NON-RECOVERABLE I/O ERROR.
*                TO *PPR* IF RECOVERABLE I/O ERROR.  IN THIS CASE JOB 
*                WILL BE LEFT IN *PWJS* JOB STATUS WAITING FOR THE
*                DEVICE TO BECOME ACCESSIBLE. 
* 
*         USES   CM+1, T1.
* 
*         CALLS  DFM, IUT, NFL, RLS.
* 
*         MACROS MONITOR. 
  
  
 MSR      SUBR               ENTRY
          SHN    0-21 
          STD    T1 
          ZJN    MSR1        IF INCORRECT SYSTEM SECTOR 
          LDM    RDCT        CHECK FOR RECOVERABLE ERROR
          SHN    21-12
          MJN    MSR1        IF NON-RECOVERABLE ERROR, TERMINATE JOB
          LDC    MSRD+MSRDL*10000 
          RJM    IUT         ISSUE *UTEM* MONITOR FUNCTION
          RJM    RLS         RELEASE FL 
*         LDN    0
          RJM    NFL         RELEASE NFL
          LDN    CCPS+DPPS   CLEAR CONTROL POINT, DROP PP 
          STD    CM+1 
          MONITOR  JACM 
          LJM    PPR         EXIT TO PP RESIDENT
  
 MSR1     LDM    MSRA,T1     ISSUE APPROPRIATE DAYFILE MESSAGE
          RJM    DFM
          LDN    TJJT        SET JOB TERMINATION OPTION 
          STM    JTOP 
          LJM    IJB6        TERMINATE JOB
  
  
*         TABLE OF DAYFILE MESSAGE ADDRESSES. 
  
 MSRA     BSS    0
          CON    MSRB 
          CON    MSRC 
  
*         DAYFILE MESSAGES. 
  
 MSRB     DATA   C* INCORRECT INPUT FILE SYSTEM SECTOR.*
 MSRC     DATA   C* MASS STORAGE ERROR.*
  
*         *UTEM* PARAMETERS.
  
 MSRD     VFD    1/0,5/SCHE,6/30D 
          VFD    6/0,6/0
          VFD    6/0,6/77 
          VFD    3/7,9/      EST ORDINAL
          CON    WISE 
  
          VFD    1/0,5/PRFE,6/12D 
          VFD    6/36D,6/0
          CON    0
          CON    0
          CON    0
  
          VFD    1/0,5/JSNE,6/6 
          VFD    6/0,6/0
          CON    0
          CON    0
          CON    PWJS*2+1 
  
          VFD    1/0,5/SCLE,6/1  CLEAR FORCED ROLLIN
          VFD    6/52D,6/0
          CON    0
          CON    0
          CON    0
  
 MSRDL    EQU    */5-MSRD/5 
 PFC      SPACE  4,15 
**        PFC - BUILD PF CONTROL WORD, *PFCW*.
* 
*         SETS FAMILY EST ORDINAL AND INCREMENTS FAMILY 
*         USER COUNT IN THE MST.
* 
*         ENTRY  (CW - CW+4) = ZERO WORD. 
* 
*         EXIT   (CW - CW+4) = *PFCW* WORD. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 PFC      SUBR               ENTRY/EXIT 
          LDM    JBSC        CHECK JOB SERVICE CLASS
          LMK    DSSC 
          NJN    PFC1        IF NOT DEADSTART SEQUENCING JOB
          LDK    NEEQ        SET NULL FAMILY EQUIPMENT
          STD    CW+3 
          UJN    PFCX        RETURN 
  
*         SET DEFAULT FAMILY ORDINAL AND INCREMENT FAMILY COUNT.
  
 PFC1     LDK    PFNL        READ PF ACTIVITY CONTROL 
          CRD    CM 
          LDD    CM+3        SET DEFAULT FAMILY EQUIPMENT 
          STD    CW+3 
          STD    CM+1        FORMAT *STBM* REQUEST
          LDK    IFCS        SET *INCREMENT USER COUNT* FUNCTION
          STD    CM+3 
          MONITOR  SMDM      INCREMENT FAMILY USER COUNT
          UJP    PFCX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPACS 
*CALL     COMPCMX 
 PRR$     EQU    1           FORCE REMOTE ASSEMBLY OF *PRR* AND *PIR* 
 PIR$     EQU    1           SELECT ASSEMBLY OF *PIR* FOR IAF R-REG 
*CALL     COMPSRR 
 CMI$     SET    1           SELECT CENTRAL MEMORY INDEX CONVERSION 
 ECI$     SET    1           SELECT EXTENDED MEMORY INDEX CONVERSION
 SLI$     SET    1           SELECT SRU VALIDATION CONVERSION 
 TLI$     SET    1           SELECT TIME LIMIT CONVERSION 
*CALL     COMPCVI 
*CALL     COMPC2D 
*CALL     COMPECX 
*CALL     COMPNFL 
*CALL     COMPRCS 
*CALL     COMPRNS 
*CALL     COMPSTA 
          SPACE  4,10 
          USE    BUFFERS
 MBUF     CON    0           ACCOUNT MESSAGE ASSEMBLY BUFFER
 STMT     BSS    0           COMMAND BUFFER 
 SBUF     BSS    0
          SPACE  4,10 
          ERRNG  BFMS-1-SBUF-502B  BUFFER OVERFLOW INTO *BFMS*
          TITLE  ROUTINES OVERLAYED BY BUFFERS. 
 CCP      SPACE  4,10 
**        CCP - CLEAR CONTROL POINT AREA. 
* 
*         ENTRY  (CP) = CONTROL POINT AREA ADDRESS. 
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         MACROS PAUSE. 
  
  
 CCP      SUBR               ENTRY/EXIT 
 CCP1     PAUSE              CHECK PP COUNT 
          LDD    CM 
          SBN    1
          NJN    CCP1        IF OTHER PP-S ASSIGNED 
          LDN    CCPAL       INITIALIZE TABLE INDEX 
          STD    T1 
          LDC    200         INITIALIZE WORD OFFSET 
          STD    T2 
          LDN    ZERL 
          CRD    CM 
 CCP2     SOD    T1          DECREMENT TABLE INDEX
 CCP3     SOD    T2          DECREMENT WORD OFFSET
          MJN    CCPX        IF CPA CLEARED 
          LMM    CCPA,T1
          ZJN    CCP2        IF WORD SHOULD NOT BE CLEARED
          LDD    T2          CLEAR CPA WORD 
          ADD    CP 
          CWD    CM 
          UJN    CCP3        CHECK NEXT WORD
  
  
*         TABLE OF PRESERVED CONTROL POINT AREA WORDS.  ENTRIES MUST
*         BE ORDERED BY ASCENDING ADDRESSES.
  
 CCPA     CON    -0 
          CON    6           MA WORD OF EXCHANGE PACKAGE
          CON    7           EEA WORD OF EXCHANGE PACKAGE 
          CON    STSW 
          CON    CWQW 
          CON    FLSW 
          CON    ECSW 
          CON    JCIW 
          CON    TFSW 
          CON    TSCW 
 CCPAL    EQU    *-CCPA      TABLE LENGTH 
 AFL      SPACE  4,10 
**        AFL - ADJUST FL AND RA. 
* 
*         ADJUST RA AND FL TO ACCOUNT FOR NFL.  CLEAR NFL AND 
*         INITIALIZE DAYFILE BUFFER CONTROL WORDS IN NFL. 
* 
*         USES   CM - CM+4, CN - CN+4, RA, FL.
* 
*         MACROS MONITOR, NFA.
  
  
 AFL      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR *FLSW* IMAGE 
          CRD    CN 
          LCN    DNFL        ADJUST FL
          RAD    FL 
          PJN    AFL1        IF SUFFICIENT CM FL ASSIGNED 
          MONITOR  HNGM 
          UJN    *           HANG PP
  
 AFL1     STD    CN+4        SAVE ADJUSTED CM FL
          LDN    0           SET (T1,T2) = RA 
          STD    T1 
          LDD    RA 
          STD    T2 
          SRD    T1          (NO-OP UNLESS CME PRESENT) 
          LDN    DNFL        SET NFL IN *FLSW*
          STD    CN 
          RAD    T2          ADJUST RA IN *FLSW*
          STD    CN+3 
          SHN    -14
          RAD    T1 
          STD    CN+2 
          LDD    CN          FORM *FLSW+1*
          LMC    4000 
          STD    CM+3 
          LDD    CN+4 
          STD    CM+4 
          LDN    0
          STD    CM 
          LDD    CN+2 
          SHN    14 
          ADD    CN+3 
          SBD    CN 
          STD    CM+2 
          SHN    -14
          STD    CM+1 
          LDD    CP          UPDATE *FLSW* AND *FLSW+1* 
          ADN    FLSW 
          CWD    CN 
          ADN    1
          CWD    CM 
  
*         STORE ADJUSTED RA AND FL IN THE EXCHANGE PACKAGE. 
  
          LDN    ZERL 
          CRD    CM 
          CRD    CN 
          LDD    T2          SET RA 
          SHN    6
          STD    CM+1 
          SHN    -14
          SHN    14 
          ADD    T1 
          SHN    6
          STD    CM 
          LDD    FL          SET FL 
          SHN    6
          STD    CN+1 
          SHN    -14
          STD    CN 
          LDD    CP          UPDATE EXCHANGE PACKAGE RA AND FL
          ADN    1
          CWD    CM 
          ADN    1
          CWD    CN 
  
*         CLEAR NFL.
  
          LDN    DNFL        SET NFL LENGTH FOR *CSTM*
          SHN    6
          STD    CM+2 
          LDD    HN          SET RELATIVE CM ADDRESS FLAG 
          STD    CM+1 
          LDC    -DNFL*100
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          MONITOR  CSTM      CLEAR NFL
  
*         INITIALIZE DAYFILE BUFFER CONTROL WORDS.
  
          LDN    ZERL 
          CRD    CM 
          CRD    CN 
          LDC    JDBL        SET DAYFILE BUFFER LENGTH
          STD    CN+2 
          LDN    3           INITIALIZE BUSY AND INTERLOCK FLAGS
          STD    CM+4 
          NFA    DAPN+1 
          CWD    CN 
          ADN    1
          CWD    CM 
          LJM    AFLX        RETURN 
          TITLE  OVERLAID PRESET. 
 PJB      SPACE  4,15 
**        PJB - PRESET JOB. 
* 
*         ENTRY  (EF) = JOB ERROR FLAG. 
*                (JO) = JOB EJT ORDINAL.
* 
*         EXIT   CONTROL POINT AREA PRESET. 
*                *SETMS IO* PERFORMED.
*                SYSTEM SECTOR READ INTO *BFMS*.
* 
*         ERROR  TO *IJB6* TO TERMINATE JOB.
* 
*         CALLS  AFL, CCP, MSR, PIR, RSS. 
* 
*         MACROS MONITOR, NFA, SETMS, SFA.
  
  
 PJB      SUBR               ENTRY/EXIT 
          SFA    EJT,JO      CALCULATE EJT ENTRY ADDRESS
          ADK    JSNE 
          CRD    AB 
          LDD    AB+4 
          SHN    -1 
          LPN    77 
          LMN    PRJS+40
          ZJN    PJB1        IF PRE-INITIAL STATE AND JOB ADVANCE SET 
          MONITOR  HNGM 
          UJN    *           HANG PP
  
 PJB1     STD    FS          CLEAR DIRECT CELLS 
          STD    RF 
          STD    RO 
          STM    SCAF 
          STM    PRCF        CLEAR PROLOGUE/EPILOGUE FLAGS
          STD    IR+2        CONVERT CALL TO *CPUMTR* FORMAT
          STD    IR+4 
          ERRNZ  QOJT        CODE DEPENDS ON VALUE
          ERRNZ  TJJT        CODE DEPENDS ON VALUE
          STM    JTFG        INITIALIZE JOB TERMINATION OPTION
          STM    JTOP        INITIALIZE JOB TERMINATION OPTION
          LDD    IA          REWRITE PP INPUT REGISTER
          CWD    IR 
          RJM    CCP         CLEAR CONTROL POINT AREA 
  
*         IF IAF ACCESSIBLE, PRESET *COMPSRR*.
  
          LDM    TSAF 
          ZJN    PJB1.1      IF IAF NOT ACCESSIBLE
          RJM    PIR         PRESET WITH IAF R-REGISTER 
  
*         ADJUST RA AND FL (ACCOUNT FOR NFL) IN THE EXCHANGE PACKAGE
*         AND WORD *FLSW* OF THE CONTROL POINT AREA.  CLEAR NFL AND 
*         INITIALIZE DAYFILE BUFFER POINTER/STATUS WORDS OF NFL.
  
 PJB1.1   RJM    AFL         ADJUST RA/FL 
  
*         PERFORM MINIMAL PRESET OF CONTROL POINT AREA IN CASE OF I/O 
*         ERROR ON SYSTEM SECTOR READ.
  
          LDD    CP 
          ADN    FPFW 
          CWM    IJBE,ON
          ADN    PFCW-FPFW-1
          CWM    IJBF,ON
          ADN    CSPW-PFCW-1
          CWM    IJBI,ON
          ADN    CPLW-CSPW-1
          CWM    IJBJ,ON
  
*         SET DEFAULT SYSTEM CHARGE FOR *SYOT* JOB
  
          LDM    JBOT 
          LMK    SYOT 
          NJN    PJB2        IF NOT SYSTEM ORIGIN JOB 
          NFA    CHGN        GET NFL ADDRESS
          CWM    IJBN,ON
  
*         READ THE INPUT FILE SYSTEM SECTOR.
  
 PJB2     SFA    EJT,JO      SET EJT ADDRESS
          ADK    SCHE        READ INPUT FILE POINTERS 
          CRD    FS 
          CRD    T5 
          LDD    T5          SAVE EST ORDINAL FOR ERROR PROCESSING
          RAM    MSRD+3 
          LDD    EF          CHECK FOR OVERRIDE 
          LMN    ORET 
          NJN    PJB3        IF NOT OPERATOR OVERRIDE 
  
*         SET *UCTM* JOB TERMINATION MODE TO FORCE THIS JOB TO
*         TERMINATE WITHOUT WAITING FOR INACCESSABLE MASS 
*         STORAGE DEVICES.
  
          AOM    IJBP 
          LJM    IJB6        TERMINATE JOB
  
 PJB3     SETMS  IO 
          LDM    JBSC        CHECK JOB SERVICE CLASS
          LMN    DSSC 
          NJN    PJB4        IF NOT DEADSTART SEQUENCING
          LDN    EPNS 
          RAM    CHRV        ALLOW ACCESS TO SUSPECT DEVICE 
 PJB4     LDN    0
          STD    T7 
          RJM    RSS         READ SYSTEM SECTOR 
          ZJN    PJB5        IF NO I/O ERROR AND SYSTEM SECTOR IS VALID 
          RJM    MSR         PROCESS INCORRECT SYSTEM SECTOR, NO RETURN 
*         LJM    IJB6        TERMINATE JOB
  
 PJB5     LJM    PJBX        RETURN 
  
 PRR      HERE               LOCATE *PRR* CODE HERE 
          SPACE  4,10 
*         PRESET COMMON DECKS.
  
  
*CALL     COMPRSS 
          SPACE  4,10 
*         CHECK FOR OVERFLOW. 
  
  
          ERRNG  BFMS-*  CODE OVERFLOWS INTO SYSTEM SECTOR BUFFER 
  
  
          OVERFLOW  E1AJ,EPFW 
          TTL    1AJ/3AB - PROCESS ERROR FLAG.
          TITLE 
          QUAL   PEF
          IDENT  3AB,PEFX    PROCESS ERROR FLAG.
*COMMENT  1AJ - PROCESS ERROR FLAG. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AB - PROCESS ERROR FLAG. 
* 
*         *3AB* PROCESSES ERROR AND REPRIEVE CONDITIONS AND PROLOGUE
*         AND EPILOGUE TERMINATION. 
* 
*                IF THE ERROR CONDITION IS *SYET* (SYSTEM ERROR) THE
*         JOB IS UNCONDITIONALLY TERMINATED WITH THE DAYFILE MESSAGE
*         * SYSTEM ABORT.*
* 
*                IF THE ERROR CONDITION IS *OKET* (OPERATOR KILL) THE 
*         JOB IS UNCONDITIONALLY TERMINATED WITH THE DAYFILE MESSAGE
*         * OPERATOR KILL.* 
* 
*                IF THE ERROR CONDITION IS *SWET* (SYSTEM SOFTWARE
*         ERROR) THE JOB IS UNCONDITIONALLY TERMINATED WITH THE 
*         MESSAGE * SYSTEM ERROR.*
* 
*                IF ERROR EXIT IS SELECTED, CONTROL IS RETURNED TO THE
*         PROGRAM AT THE ERROR EXIT ADDRESS PROVIDED THAT THE ERROR 
*         EXIT ADDRESS IS WITHIN THE JOB-S FL.
* 
*                IF REPRIEVE IS SELECTED AND THE ERROR CONDITION
*         MATCHES THE REPRIEVE OPTIONS SELECTED, AND THE REPRIEVE 
*         ADDRESS IS WITHIN THE JOB-S FL, CONTROL WILL BE RETURNED TO 
*         THE PROGRAM AT THE REPRIEVE ADDRESS.
* 
*                IF NONE OF THE ABOVE IS TRUE AND THE ERROR CONDITION 
*         IS *SPET* OR ABOVE, A DAYFILE MESSAGE IS ISSUED AND THE JOB 
*         TERMINATED. 
* 
*         FOR ON-LINE INTERACTIVE JOBS, THE FILE *OUTPUT* WILL NOT BE 
*         FLUSHED (THIS FILE IS FLUSHED BY *1RO* AT ROLLOUT TIME IF THE 
*         FILE IS ASSIGNED TO A TERMINAL).
* 
*         IF THE LIST OF FILES POINTER IS NOT SET, THE FILES NAMED IN 
*         TABLE *TSFN* (TABLE OF SPECIAL FILE NAMES) WILL BE FLUSHED. 
*         IF THE JOB IS NOT ON-LINE INTERACTIVE, THE FILE *OUTPUT* WILL 
*         ALSO BE FLUSHED.  IF THE LIST OF FILES POINTER IS SET.
*         THE TABLE OF FILE NAMES INDICATED WILL BE FLUSHED, EXCLUDING
*         *OUTPUT* FOR *TXOT* JOBS, IF THE FLUSH BIT (BIT 36, WORD 1
*         OF THE FET) IS SET.  IF A JOB IS NOT ON-LINE INTERACTIVE, THE 
*         FILE *OUTPUT* WILL ALSO BE FLUSHED. 
* 
*         WHEN THESE OPERATIONS ARE COMPLETE, THE COMMAND 
*         BUFFER IS SEARCHED FOR THE COMMAND *EXIT.*.  IF 
*         THIS COMMAND IS FOUND, *3AB* RETURNS TO *1AJ* TO CONTINUE 
*         COMMAND PROCESSING.  IF AN *EXIT.* IS NOT FOUND,
*         RETURNS TO *1AJ* TO COMPLETE THE JOB PROCESSING.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * JOB HUNG IN AUTORECALL.* = SYSTEM DETECTED AN AUTORECALL
*                CALL TO AN INCOMPLETE WORD AND THERE WAS NO ACTIVITY 
*                TO SET THE WORD COMPLETE.
* 
*         * USER BREAK TWO ENCOUNTERED.* = A USER BREAK TWO (TERMINAL 
*                ABORT) HAS BEEN ENTERED FROM THE TERMINAL BY A 
*                INTERACTIVE USER AND USER RECOVERY PROCESSING WAS NOT
*                SELECTED BY THE USER PROGRAM (REPRIEVE/EREXIT/DISTC).
* 
*         * TIME LIMIT.* = THE MONITOR HAS DETECTED THAT THE TIME LIMIT 
*                FOR THE JOB HAS EXPIRED. 
* 
*         * PP CALL ERROR.* = THE MONITOR HAS DETECTED AN ERROR IN A
*                CPU REQUEST FOR PP ACTION. 
* 
*         * MONITOR CALL ERROR.* = THE MONITOR HAS DETECTED AN ERROR
*                IN AN SYSTEM REQUEST.
* 
*         * OPERATOR DROP.* = THE OPERATOR HAS DROPPED THE JOB. 
* 
*         * PROGRAM STOP AT XXXXXX.* = THE MONITOR DETECTED A PROGRAM 
*                STOP INSTRUCTION AT ADDRESS XXXXXX.
* 
*         * SUBSYSTEM ABORTED.* = SUBSYSTEM HAS ABORTED AND ALL USER
*                JOBS CONNECTED TO THIS SUBSYSTEM WILL HAVE THIS
*                MESSAGE SENT TO THE DAYFILE AND THE *SSET* ERROR FLAG
*                SET. 
* 
*         * SCP INCORRECT TRANSFER ADDRESS.* = THE SCP *SSCR* (RA+51B)
*                WORD CONTAINS INCORRECT PARAMETERS OR THE COMPLETION 
*                ADDRESS FOR AN *SF.REGR* OR *SF.SWPO* FUNCTION 
*                IS NO LONGER WITHIN THE SCP FIELD LENGTH.
* 
*         * JOB STEP LIMIT.* = THE MONITOR HAS DETECTED THAT THE
*                SRU LIMIT FOR THE JOB STEP HAS EXPIRED.
* 
*         * ACCOUNT BLOCK LIMIT.* = THE MONITOR HAS DETECTED THAT 
*                THE SRU LIMIT FOR THE ACCOUNT BLOCK HAS EXPIRED. 
* 
*         * INITIAL COMMAND LIMIT.* = NUMBER OF COMMANDS
*                EXCEEDED THE LIMIT FOR WHICH THE USER WAS VALIDATED. 
*                *DFIN* MORE COMMANDS ARE THEN ALLOWED FOR ERROR
*                PROCESSING.
* 
*         * COMMAND LIMIT.* = NUMBER OF COMMANDS
*                EXCEEDED LIMIT FOR WHICH THE USER WAS VALIDATED AND
*                *DFIN* COMMANDS ALLOWED FOR ERROR PROCESSING ARE ALSO
*                EXCEEDED.  THE JOB IS TERMINATED.
* 
*         * INITIAL MESSAGE LIMIT.* = THE MONITOR HAS DETECTED THAT 
*                THE MESSAGE LIMIT FOR THE JOB HAS EXPIRED.  THE LIMIT
*                IS RESET TO *DMLI* SO AS TO COMPLETE JOB PROCESSING. 
* 
*         * MESSAGE LIMIT.* = THE MONITOR HAS DETECTED THAT THE 
*                (FINAL) MESSAGE LIMIT FOR THE JOB HAS EXPIRED. 
*                THE JOB IS UNCONDITIONALLY TERMINATED. 
* 
*         * LOCAL FILE LIMIT.* = JOB IS NOT ALLOWED TO CREATE 
*                ANOTHER LOCAL FILE, SINCE THE MAXIMUM NUMBER 
*                OF LOCAL FILES (*MXLF*) ARE ALREADY PRESENT. 
* 
*         * LIST OF FILES LENGTH TOO LONG OR ZERO.* = LIST OF FILES 
*                LENGTH EXCEEDED 4096 OR LIST OF FILES STARTED OR 
*                EXTENDED BEYOND THE JOB FIELD LENGTH OR THE LIST OF
*                FILES LENGTH WAS EQUAL TO ZERO.
* 
*         * INCORRECT ERROR EXIT ADDRESS.* = ERROR EXIT ADDRESS 
*                OUTSIDE FL OR OTHERWISE INCORRECT. 
* 
*         * JOB RERUN.* = THE JOB WAS RERUN BY THE OPERATOR.
* 
*         * RECOVERY RERUN.* = JOB WAS RERUN DUE TO A SYSTEM RECOVERY.
* 
*         * SPECIAL REQUEST PROCESSING ERROR.* = ERROR IN *SPCW*
*                CALL WORD. 
* 
*         * SECURE MEMORY, DUMP DISABLED.* = ATTEMPT TO DUMP
*                SECURE MEMORY. 
* 
*         * REPRIEVE BLOCK ERROR.* = THE REPRIEVE BLOCK CONTAINS A
*                BAD PARAMETER OR IS NOT WITHIN THE JOB FIELD LENGTH. 
* 
*         * REPRIEVE CHECKSUM BAD.* = THE COMPUTED CHECKSUM DOES NOT
*                MATCH THE CHECKSUM IN THE REPRIEVE BLOCK.
* 
*         * JOB REPRIEVED.* = JOB REPRIEVED SUCCESSFULLY. 
* 
*         * JOB IN NO RERUN STATE ON RECOVERY.* = JOB RECOVERED 
*                DURING DEADSTART IS ABORTED BECAUSE IT WAS IN
*                NO RERUN MODE. 
* 
*         * PARITY ERROR, JOB HUNG.* = THE CONTROL POINT IS HUNG
*                IN JOB ADVANCE TO FREEZE THE AFFECTED MEMORY.
* 
*         * JOB STEP ABORT.* = JOB STEP WAS ABORTED DUE TO A CONDITION
*                BEYOND THE JOB-S CONTROL SUCH AS A MASS STORAGE ERROR
*                ON THE ROLLOUT FILE. 
* 
* 
*         FOR CPU ERROR EXITS THE FOLLOWING MESSAGES ARE ISSUED.
* 
*         * CPU ERROR EXIT AT YYYYYY.* MONITOR HAS DETECTED A 
*                CPU ERROR EXIT AT ADDRESS YYYYYY DUE TO ONE OR MORE
*                OF THE FOLLOWING CONDITIONS, WHICH ARE ALSO ISSUED 
*                TO THE DAYFILE.
* 
* 
*         * ARITHMETIC UNDERFLOW.*
* 
*         * ARITHMETIC OVERFLOW.* 
* 
*         * ARITHMETIC INDEFINITE.* 
* 
*         * STEP CONDITION.*
* 
*         * BREAKPOINT CONDITION.*
* 
*         * PROGRAM STOP.*
* 
*         * CM OUT OF RANGE.* 
* 
*         * EXTENDED MEMORY OUT OF RANGE.*
* 
*         * CM BLOCK OUT OF RANGE.* 
* 
*         * EXTENDED MEMORY BLOCK OUT OF RANGE.*
* 
*         * CM PARITY ERROR.* 
* 
*         * EXTENDED MEMORY PARITY ERROR.*
* 
*         * EXTENDED MEMORY FLAG REGISTER PARITY.*
* 
*         * CMC PARITY ERROR.*
* 
*         * INCORRECT INSTRUCTION.* 
* 
*         * PROCESSOR DETECTED MALFUNCTION.*
* 
*         * PROCESSOR STATE ERROR.* 
          SPACE  4,10 
***       ACCOUNT DAYFILE MESSAGES. 
* 
* 
*         *AERR, DS.* = JOB WAS RERUN AFTER DEADSTART.
* 
*         *AERR, OP.* = JOB WAS RERUN BY THE OPERATOR.
          SPACE  4,10 
****      DIRECT CELL ASSIGNMENTS.
  
  
 NL       EQU    AB          NEGATIVE FL ASSIGNED 
 FN       EQU    SP - SP+4   FILE NAME (5 LOCATIONS)
  
****
          TITLE  MAIN PROGRAM.
 PEF      SPACE  4,10 
**        PEF - MAIN ROUTINE. 
* 
*         EXIT   (A) .NE. 0 IF SCP CONNECTIONS TO BE PROCESSED. 
  
  
          ORG    E1AJ 
 PEF      SUBR               ENTRY/EXIT 
          RJM    PRS         PRESET PROGRAM 
          ZJN    PEF2.1      IF RECOVERY NOT POSSIBLE 
          MJN    PEF2.2      IF IDLE OF SPECIAL SUBSYSTEM 
  
*         PROCESS EXTENDED REPRIEVE.
  
          LDD    CW          CHECK IF EXTENDED REPRIEVE ACTIVE
          SHN    21-12
          PJN    PEF1        IF NOT ACTIVE
          RJM    CEI         CHECK ERROR INTERRUPT
          LJM    PEF3        ABORT IF JOB NOT RESTARTED 
  
*         PROCESS REPRIEVE/EREXIT.
  
 PEF1     LDD    RF          CHECK REPRIEVE OPTION STATUS 
          ZJN    PEF2        IF NO REPRIEVE OPTIONS SET 
          LDN    22          SET REPRIEVE BLOCK LENGTH
 PEF2     STD    T1 
          ADD    EF 
          ZJP    PEF6        IF NO ERROR FLAG OR REPRIEVE OPTIONS 
          LDD    EF          CHECK ERROR FLAG 
          LMN    OKET 
          NJN    PEF2.3      IF NOT OPERATOR KILL 
 PEF2.1   LDM    SCAF 
          NJN    PEFX        IF SCP CONNECTIONS TO PROCESS
 PEF2.2   LJM    PEF5        COMPLETE ERROR PROCESSING
  
 PEF2.3   LDD    CW+3        CHECK ERROR RETURN ADDRESS 
          LPN    77 
          ADD    CW+4 
          ZJN    PEF3        IF NO ERROR RETURN ADDRESS 
          LDD    T1          SAVE (T1)
          STM    PEFA 
          EXECUTE  3AN
          LDC    *
 PEFA     EQU    *-1
          STD    T1 
          RJM    /CER/CER    CHECK ERROR RETURN 
  
*         PROCESS LIST-OF FILES.
  
 PEF3     LDM    SCAF 
          NJN    PEF2.1      IF SCP CONNECTIONS TO PROCESS
          LDD    EF          CHECK ERROR FLAG 
          SBK    SPET 
          PJN    PEF5        IF *SPET* OR GREATER 
          ADK    SPET-TIET
          ZJN    PEF5        IF *USER BREAK ONE*
          SBK    TAET-TIET
          ZJN    PEF5        IF *USER BREAK TWO*
          LDD    FL          CHECK FIELD LENGTH 
          ZJN    PEF5        IF NO FIELD LENGTH ASSIGNED
          RJM    PLF         PROCESS LIST OF FILES
          ZJN    PEF5        IF LIST OF FILES DEFINED 
          RJM    CMF         COMPLETE JOB FILES 
  
*         COMPLETE ERROR PROCESSING.
  
 PEF5     RJM    EBC         PROCESS ERROR FLAG 
 PEF6     LDM    PRCF 
          ZJN    PEF7        IF NOT PROLOGUE OR EPILOGUE TERMINATION
          RJM    PPT         PROCESS PROLOGUE/EPILOGUE TERMINATION
 PEF7     LDN    0           INDICATE ERROR PROCESSING COMPLETE 
          LJM    PEFX        RETURN 
 PEF      SPACE  4,10 
**        PEF - GLOBAL DATA STORAGE.
  
  
 CPXS     CON    0           CONTROL POINT EXIT STATUS
 PERS     CON    0           HARWARE PARITY ERROR STATUS
          TITLE  PRIMARY SUBROUTINES. 
 CJS      SPACE  4,10 
**        CJS - CHECK JOB STATUS. 
* 
*         ENTRY  (RF) = REPRIEVE OPTIONS. 
* 
*         EXIT   (A) = 0, JOB STEP COMPLETE.
* 
*         USES   CM - CM+4. 
  
  
 CJS      SUBR               ENTRY/EXIT 
          LDD    FL 
          ZJN    CJSX        IF NO FL, JOB STEP IS COMPLETE 
          LDD    RF 
          LPC    100
          NJN    CJSX        IF REPRIEVE ON NORMAL JOB TERMINATION
          LDD    RA          CHECK FOR *END*
          SHN    6
          ADN    1
          CRD    CM 
          LDD    CM+1 
          SCN    77 
          SHN    6
          LMD    CM 
          LMC    3RDEN
          UJN    CJSX        EXIT 
 CMF      SPACE  4,10 
**        CMF - COMPLETE SPECIAL FILES. 
* 
*         ENTRY  (T1) = POINTER TO LAST FILE PROCESSED
*                       (RELATIVE TO RA). 
* 
*         EXIT   TO *CCO2* IF *CIO* IN PROGRESS.
* 
*         USES   T0, T1, T2, CM - CM+4, CN - CN+4, FS - FS+4. 
* 
*         CALLS  CCO, CFP, CFS. 
  
  
 CMF8     LDM    CCOA 
          ZJN    CMFX        IF NO *CIO* CALLS IN PROGRESS
          LJM    CCO2        RESET ERROR FLAG AND DROP PP 
  
 CMF      SUBR               ENTRY/EXIT 
          LDD    T1 
          NJN    CMF1        IF NOT INITIAL CALL
          LDN    1           SET SEARCH ADDRESS 
          STD    T1 
 CMF1     AOD    T1          ADVANCE FILE POINTER ADDRESS 
          LMN    PGNR        LIMIT OF SPECIAL FILES 
          ZJN    CMF8        IF END OF POINTERS 
          STD    T0 
          LDD    RA          READ FILE POINTER
          SHN    6
          ADD    T1 
          CRD    CM 
          LDD    CM 
          ZJN    CMF8        IF END OF ENTRIES
          LDD    CM+3        CHECK ADDRESS
          LPN    77 
          SHN    14 
          LMD    CM+4 
          ZJN    CMF1        IF NO FET SPECIFIED
          SBN    77 
          MJN    CMF1        IF OUT OF RANGE
          ADC    5+77 
          SHN    -6 
          SBD    FL 
          PJN    CMF1        IF \ FL-5
          LDA    CM+3,M 
          CRD    CN 
          ADN    1           READ POSSIBLE FET ADDRESS
          CRD    FS 
          LDD    CN+3        CHECK FOR FIT
          LPN    77 
          ADD    CN+4 
          NJN    CMF2        IF NOT FIT 
          STD    T0 
          LDD    FS+3        MOVE FET ADDRESS 
          STD    CM+3 
          LDD    FS+4 
          STD    CM+4 
 CMF2     RJM    CFP         CHECK FET PARAMETERS 
          NJN    CMF4        IF FET ERRORS
          RJM    CFS         CHECK FET STATUS 
          MJN    CMF5        IF FLUSH STATUS, *OUTPUT* AND NOT *TXOT* 
          ZJN    CMF6        IF FILE TO BE FLUSHED
          NJN    CMF4        IF NO FLUSH STATUS 
 CMF3     LJM    CMF1        CHECK NEXT FILE
  
 CMF4     LDD    T0 
          NJN    CMF3        IF NOT POSSIBLE FIT
          LDD    RA          READ UP FET
          SHN    6
          ADD    T1 
          CRD    CM 
          STD    T0          RESET FIT INDICATOR
          UJN    CMF2        CHECK FET PARAMETERS 
  
 CMF5     RJM    CCO         CALL *CIO* TO DUMP BUFFER
          UJN    CMF3        LOOP FOR NEXT FILE 
  
 CMF6     LDC    TSFN-4      SET SPECIAL FILE NAME TABLE
          STD    T2 
 CMF7     LDN    4           ADVANCE TABLE
          RAD    T2 
          LDI    T2 
          ZJN    CMF4        IF END OF TABLE
          LMD    CN          COMPARE NAMES
          NJN    CMF7        IF NO MATCH
          LDM    1,T2 
          LMD    CN+1 
          NJN    CMF7        IF NO MATCH
          LDM    2,T2 
          LMD    CN+2 
          NJN    CMF7        IF NO MATCH
          LDM    3,T2 
          LMD    CN+3 
          SCN    77 
          NJN    CMF7        IF NO MATCH
          UJN    CMF5        CALL *CIO* TO DUMP FET 
 TSFN     SPACE  4,10 
**        TSFN - TABLE OF SPECIAL FILE NAMES. 
  
  
 TSFN     BSS    0
          VFD    48/0LPUNCH 
          VFD    48/0LPUNCHB
          VFD    48/0LP8
          CON    0           TERMINATE TABLE
 CSF      SPACE  4,10 
**        CSF - CHECK SCR FOR FATAL ERROR.
* 
*         EXIT   (A) = 0 IF NOT FATAL ERROR.
* 
*         USES   CM - CM+4. 
  
  
 CSF2     LDN    0           SET NO FATAL ERROR PRESENT 
  
 CSF      SUBR               ENTRY/EXIT 
          LDD    EF          CHECK FOR PEET ERROR 
          LMN    PEET 
          NJN    CSF2        IF NO POSSIBLE FATAL ERROR 
          LDK    MABL        CHECK MAINFRAME TYPE 
          CRD    CM 
          LDD    CM+1 
          SHN    -6 
          LPN    41 
          LMN    1
          ZJN    CSF1        IF CYBER 170-815/825/835/855 
          LPN    1
          ZJN    CSFX        IF NOT 170 
          LDN    /SCR/FCRD+0
          OAN    CHSC 
          IAN    CHSC 
          LPN    50 
          ZJN    CSFX        IF NO FATAL ERROR
          LPN    40 
          NJN    CSFX        IF *CMC* INPUT ERROR 
          LDC    /SCR/FCTB+/SCR/SDSC
          OAN    CHSC 
          IAN    CHSC 
 CSF0     UJN    CSFX        RETURN WITH DOUBLE BIT ERROR STATUS
  
 CSF1     LDD    CP          GET WORD 3 OF EXCHANGE PACKAGE 
          ADN    3
          CRD    CM 
          LDD    CM 
          LPN    10 
          UJN    CSF0        RETURN WITH ERROR STATUS 
 PLF      SPACE  4,15 
**        PLF - PROCESS LIST OF FILES.
* 
*         EXIT   (A) = 0, IF LIST OF FILES DEFINED. 
*                (T1) = BYTE ZERO OF *LOFW*.
*                TO *CCO2* IF *CIO* IN PROGRESS.
* 
*         USES   T8, T9, CM - CM+4, CN - CN+4, T1 - T1+4. 
* 
*         CALLS  CCO, CFP, CFS, DFM.
  
  
*         LIST OF FILES EXTENDS BEYOND FL OR CONTAINS MORE
*         FILES THAN CAN BE IN NFL. 
  
 PLF9     LDC    =C* LIST OF FILES LENGTH TOO LONG OR ZERO.*
          RJM    DFM
          LDM    CCOA 
          ZJN    PLFX        IF NO *CIO* CALLS STARTED
          LJM    CCO2        RESET ERROR FLAG AND DROP PP 
  
 PLF10    LDN    1           INDICATE NO LIST OF FILES
  
 PLF      SUBR               ENTRY/EXIT 
          LDD    CP          READ LIST-OF-FILES WORD
          ADK    LOFW 
          CRD    T1 
          LDD    T2          CHECK LIST WITHIN FL 
          LPN    77 
          STD    T8 
          SHN    14 
          ADD    T3 
          STD    T9 
          ZJN    PLF10       IF NO LIST OF FILES
          SHN    -6 
          SBD    FL 
 PLF0     PJN    PLF9        IF LIST STARTS BEYOND FL 
          LDA    T2,M        READ LIST LENGTH 
          CRD    CN 
          LDD    CN+3 
          LPN    77 
          SHN    14 
          LMD    CN+4 
          ZJN    PLF0        IF LIST OF FILES LENGTH EQUALS ZERO
          STM    PLFA 
          SHN    -14
          RAM    PLFA-1 
  
*         ADVANCE INDEX.
  
 PLF1     AOD    T1 
          LMC    **          CHECK END OF LIST
 PLFA     EQU    *-1         (LIST LENGTH)
          ZJN    PLF4        IF END OF LIST 
          LDD    T1 
          ZJN    PLF2        IF LIST LENGTH .GT. 4096 
  
*         READ FILE ENTRY.
  
          LDD    T8          CHECK LIST ENTRY WITHIN FL 
          SHN    14 
          ADD    T9 
          ADD    T1          ADD INDEX
          SHN    -6 
          SBD    FL 
          MJN    PLF3        IF LIST ENTRY WITHIN RANGE 
 PLF2     LJM    PLF9        ISSUE DAYFILE MESSAGE
  
 PLF3     LDA    T8          READ LIST ENTRY
          ADD    T1 
          CRD    CM 
          LDD    CM 
          ZJN    PLF4        IF END OF LIST 
          LMC    7777        CHECK NULL ENTRY 
          ZJN    PLF1        IF NULL ENTRY
          UJN    PLF6        CHECK FET PARAMETERS 
  
 PLF4     LDM    CCOA 
          ZJN    PLF5        IF NO *CIO* CALLS STARTED
          LJM    CCO2        RESET ERROR FLAG AND DROP PP 
  
 PLF5     LJM    PLFX        RETURN 
  
*         CHECK FOR FILE NAMED *OUTPUT* OR WITH FLUSH BIT SET.
  
 PLF6     RJM    CFP         CHECK FET PARAMETERS 
          NJN    PLF8        IF FET ERRORS
          RJM    CFS         CHECK FET STATUS 
          MJN    PLF7        IF FLUSH STATUS, *OUTPUT* AND NOT *TXOT* 
          NJN    PLF8        IF NO FLUSH STATUS 
          LDD    CW+1        CHECK FLUSH BIT
          LPN    1
          ZJN    PLF8        IF FLUSH BIT NOT SET 
 PLF7     RJM    CCO         CALL *CIO* TO DUMP BUFFER
 PLF8     LJM    PLF1        ADVANCE INDEX
 PPT      SPACE  4,10 
**        PPT - PROCESS PROLOGUE OR EPILOGUE TERMINATION. 
* 
*         ENTRY  (A) = (PRCF) = CONTROL FLAGS.
* 
*         EXIT   CONTROL FLAGS CLEARED IN CONTROL POINT AREA. 
*                CHARGE REQUIRED SET IF NECESSARY.
*                JOB ACTIVITY TERMINATED IF NECESSARY.
* 
*         USES   (CM - CM+4)
* 
*         CALLS  SCR, CJA.
  
  
 PPT      SUBR               ENTRY/EXIT 
          LMN    CCPT 
          ZJN    PPT3        IF CLEAR CONTROL FIELDS ONLY 
          LMN    LOPT&CCPT
          ZJN    PPT1        IF TERMINATE JOB 
          LMN    CRPT&LOPT
          ZJN    PPT2        IF SET CHARGE REQUIRED 
          LDD    EF 
          ZJN    PPT3        IF NO ERROR FLAG 
          LDM    PRCF        CHECK ABORT CONDITIONAL OPTION 
          LMN    CAPT 
          ZJN    PPT2        IF SET CHARGE REQUIRED ON ABORT
 PPT1     RJM    CJA         CLEAR JOB ACTIVITY 
 PPT2     RJM    SCR         SET CHARGE REQUIRED
 PPT3     LDD    CP          CLEAR CONTROL FIELDS 
          ADN    EOJW 
          CRD    CM 
          LDD    CM+2 
          LPC    7000 
          STD    CM+2 
          LDD    CP 
          ADN    EOJW 
          CWD    CM 
          UJN    PPTX        RETURN 
          TITLE  ERROR FLAG PROCESSORS. 
 EBC      SPACE  4,10 
**        EBC - PROCESS BATCH ERROR.
  
  
 EBC      SUBR               ENTRY/EXIT 
          LDD    EF 
          ZJN    EBCX        IF JOB TERMINATION 
          RJM    SFX         SEARCH FOR EXIT
          LDM    TERM,EF
          ZJN    EBC1        IF NO ERROR MESSAGE
          RJM    DFM         SEND DAYFILE MESSAGE 
 EBC1     LDM    TERP,EF     PROCESS ERROR
          ZJN    EBCX        IF NO SPECIAL PROCESSOR
          STM    EBCA        PROCESS ERROR
          EXECUTE  3AL
          LJM    *
 EBCA     EQU    *-1
 TERM     SPACE  4,10 
**        TERM - TABLE OF ERROR MESSAGES. 
* 
*         INDEXED BY ERROR FLAG.
  
  
 TERM     INDEX 
  
          INDEX  ITET,(=C* SCP INCORRECT TRANSFER ADDRESS.*)
          INDEX  TLET,(=C* TIME LIMIT.*)
          INDEX  FLET,(=C* LOCAL FILE LIMIT.*)
          INDEX  ODET,(=C* OPERATOR DROP.*) 
          INDEX  RRET,(=C* JOB RERUN.*) 
          INDEX  DRET,(=C* RECOVERY RERUN.*)
          INDEX  OKET,(=C* OPERATOR KILL.*) 
          INDEX  RCET,(=C* JOB HUNG IN AUTORECALL.*)
          INDEX  JSET,(=C* JOB STEP ABORT.*)
          INDEX  SVET,(=C* SECURITY CONFLICT.*) 
          INDEX  SSET,(=C* SUBSYSTEM ABORTED.*) 
          INDEX  SYET,(=C* SYSTEM ABORT.*)
          INDEX  RAET,(=C* JOB IN NORERUN STATE ON RECOVERY.*)
          INDEX  SWET,(=C* SYSTEM ERROR.*)
          INDEX  ORET,(=C* OPERATOR OVERRIDE.*) 
  
          INDEX  MXET 
 TERP     SPACE  4,10 
**        TERP - TABLE OF ERROR FLAG PROCESSORS.
* 
*         INDEXED BY ERROR FLAG.
  
  
 TERP     INDEX 
  
          INDEX  TIET,PTI    USER BREAK ONE 
          INDEX  TAET,PTA    USER BREAK TWO 
          INDEX  ARET,/EFX/ARI  ARITHMETIC ERROR
          INDEX  PSET,/EFX/PST  PROGRAM STOP
          INDEX  PPET,/EFX/PPA  PPU ABORT 
          INDEX  PCET,/EFX/MCL  MONITOR CALL ERROR
          INDEX  CLET,/EFX/CML  COMMAND LIMIT 
          INDEX  MLET,/EFX/MSL  MESSAGE LIMIT 
          INDEX  TLET,/EFX/TLE  TIME LIMIT
          INDEX  SRET,SRL    SRU LIMIT
          INDEX  IDET,IDL    IDLEDOWN SUBSYSTEM 
          INDEX  RRET,RER    RERUN JOB
          INDEX  DRET,/EFX/DRE  DEADSTART RERUN 
          INDEX  OKET,TRJ    OPERATOR KILL
          INDEX  SVET,SVE    SECURITY VIOLATION 
          INDEX  PEET,/EFX/ARI  CPU PARITY ERROR
          INDEX  SYET,TRJ    SYSTEM ABORT 
          INDEX  RAET,RAB    RECOVERY ABORT 
          INDEX  SWET,SWE    SYSTEM SOFTWARE ERROR
          INDEX  ORET,/EFX/ORE  OPERATOR OVERRIDE 
  
          INDEX  MXET 
 IDL      SPACE  4,15 
**        IDL - IDLEDOWN SUBSYSTEM. 
* 
*         EXIT   TO *PEF5* IF NOT SPECIAL SUBSYSTEM.
  
  
 IDL      BSS    0           ENTRY
 IDLA     LDN    0           CHECK FOR SUBSYSTEM
*         LDN    1           (SPECIAL SUBSYSTEM IDLE) 
          NJN    IDL1        IF SPECIAL SUBSYSTEM 
  
*         PROCESS NON-SPECIAL SUBSYSTEM JOB.
  
          LDK    ODET        CHANGE ERROR FLAG TO *ODET*
          STD    EF 
          LJM    PEF5        PROCESS AS *ODET* ERROR FLAG 
  
*         IDLEDOWN SUBSYSTEM. 
  
 IDL1     EXECUTE  3AL
          LJM    /EFX/IDL    EXECUTE IDLEDOWN ROUTINE 
 PTA      SPACE  4,10 
**        PTA - PROCESS TERMINAL ABORT (USER BREAK 2).
* 
*         EXIT   TO *EBCX*. 
* 
*         CALLS  CMF, DFM, DTC, PLF.
  
  
 PTA      BSS    0           ENTRY
          RJM    DTC         PROCESS DISABLED TERMINAL CONTROL
  
*         CONTROL WILL RETURN FROM *DTC* ONLY IF DISABLED 
*         TERMINAL CONTROL WAS NOT PROCESSED. 
  
          LDD    FL          CHECK FIELD LENGTH 
          ZJN    PTA2        IF NO FIELD LENGTH ASSIGNED
          RJM    PLF         PROCESS LIST OF FILES
          ZJN    PTA2        IF LIST OF FILES DEFINED 
          RJM    CMF         COMPLETE SPECIAL FILES 
 PTA2     LDC    =C* USER BREAK TWO ENCOUNTERED.*+NMSN
          RJM    DFM         ISSUE DAYFILE MESSAGE
          UJP    EBCX        RETURN 
 PTI      SPACE  4,10 
**        PTI - PROCESS TERMINAL INTERRUPT (USER BREAK 1).
* 
*         EXIT   TO *//ROJ* TO ROLLOUT JOB. 
* 
*         CALLS  DTC. 
  
  
 PTI      BSS    0           ENTRY
          RJM    DTC         PROCESS DISABLED TERMINAL CONTROL
  
*         CONTROL WILL RETURN FROM *DTC* ONLY IF DISABLED 
*         TERMINAL CONTROL WAS NOT PROCESSED. 
  
          LJM    //ROJ       ROLLOUT JOB
 RAB      SPACE  4,10 
**        RAB - PROCESS RECOVERY ABORT. 
* 
*         SETS THE JOB TERMINATION STATUS OF NON-INTERACTIVE
*         JOB TO *TJJT* AND ADVANCES THE JOB TO THE NEXT *EXIT* 
*         COMMAND.
* 
*         EXIT   TO *EBCX*. 
* 
*         CALLS  RSF, SEJ.
  
  
 RAB      BSS    0           ENTRY
          RJM    RSF         RETURN SPECIAL FILES 
          LDM    TSTN        CHECK TERMINAL NUMBER
          NJN    RAB1        IF ON-LINE INTERACTIVE JOB 
          LDM    JBCS        CHECK CONNECTION STATUS
          LMN    DTCS 
          NJN    RAB1        IF BATCH JOB 
          LDN    SUJT        SET JOB OPTION FOR DETACHED JOB
          RJM    SEJ         SET END OF JOB OPTION
 RAB1     LJM    EBCX        RETURN 
 RER      SPACE  4,10 
**        RER - RERUN JOB.
* 
*         SETS THE JOB TERMINATION OPTION FOR NON-INTERACTIVE 
*         JOB TO *RJJT*, ISSUES THE RERUN ACCOUNT FILE MESSAGE, 
*         AND ADVANCES THE JOB TO THE NEXT *EXIT* COMMAND.
* 
*         EXIT   TO *EBCX*. 
* 
*         CALLS  DFM, ESB, SEJ. 
  
  
 RER      BSS    0           ENTRY
          RJM    ESB         EMPTY COMMAND BUFFER 
          LDM    TSTN        CHECK TERMINAL NUMBER
          NJN    RER1        IF ON-LINE INTERACTIVE JOB 
          LDN    RJJT        SELECT RERUN JOB OPTION
          RJM    SEJ         SET END-OF-JOB OPTION
          LDC    RREA+ACFN   ISSUE ACCOUNT FILE MESSAGE 
          RJM    DFM
 RER1     LJM    EBCX        EXIT 
  
  
 RREA     DATA   C*AERR, OP.* 
 SRL      SPACE  4,10 
**        SRL - SRU LIMIT ERROR PROCESSOR.
* 
*         INCREASES USERS SRU LIMIT BY DSLI UNITS SO THAT THE USER MAY
*         FINISH CURRENT PROCESSING.
* 
*         EXIT   TO *EBCX*. 
* 
*         CALLS  DFM, ITL, SCR. 
* 
*         MACROS MONITOR. 
  
  
 SRL      LDD    CP          CHECK IF ACCOUNT BLOCK OR JOB STEP LIMIT 
          ADN    SRUW 
          CRD    CM 
          ADN    STLW-SRUW   COMPARE ACCUMULATOR TO ACCOUNT BLOCK LIMIT 
          CRD    T3 
          LDD    T3+1 
          SCN    77 
          SHN    6
          LMD    T3 
          SHN    6
          STD    T3+4 
          SHN    -14
          STD    T3+3 
          LDN    0
          STD    T3+2 
          LDN    2
          STD    T1 
          LDD    MA 
          CWM    T3,T1
          LDD    CM          CHECK IF VALIDATION LIMIT REACHED
          SHN    21-11
          PJN    SRL1        IF NOT VALIDATION LIMIT
          RJM    SCR         SET CHARGE REQUIRED
 SRL1     LDN    11          3/OPERATION FLAG,3/WORD COUNT
          STD    CM+4 
          LDN    ABIF        SUBFUNCTION CODE 
          STD    CM+1 
          MONITOR  ACTM 
          LDD    MA 
          CRD    CM 
          LDD    CM 
          SHN    6
          MJN    SRL2        IF NOT ACCOUNT BLOCK LIMIT 
          LDN    RLIA-RLIS
          RAM    SRLA 
          LDC    SRLB 
          UJN    SRL3        ISSUE ACCOUNT BLOCK LIMIT MESSAGE
  
 SRL2     LDC    SRLC 
 SRL3     RJM    DFM         ACCOUNT BLOCK LIMIT MESSAGE
          LDN    DSLI 
          STD    CM+4 
          LDN    RLIS        SRU REQUEST
*         LDN    RLIA        (ACCOUNT BLOCK LIMIT)
 SRLA     EQU    *-1
          RJM    ITL         REQUEST LIMIT INCREASE 
          LJM    EBCX        RETURN 
  
  
 SRLB     DATA   C* ACCOUNT BLOCK LIMIT.* 
 SRLC     DATA   C* JOB STEP LIMIT.*
 SVE      SPACE  4,15 
**        SVE - PROCESS SECURITY VIOLATION ERROR. 
* 
*         DECREMENTS THE USER SECURITY COUNT AND TERMINATES THE JOB.
* 
*         EXIT   TO *TRJ*, IF SECURITY COUNT = 0. 
*                TO *EBCX*, OTHERWISE.
* 
*         USES   CM - CM+4, SP - SP+4, 30 - 34, T1. 
* 
*         CALLS  *0AV*. 
* 
*         MACROS EXECUTE, SFA.
  
  
 SVE      BSS    0           ENTRY
          LDD    CP          GET FAMILY EST ORDINAL FROM CPA
          ADN    PFCW 
          CRD    CM 
          ADN    UIDW-PFCW   GET USER NAME FROM CPA 
          CRD    SP 
          SFA    EST,CM+3    READ EST ENTRY FOR FAMILY
          ADK    EQDE 
          CRD    CM 
          LDD    CM+4        READ FAMILY NAME FROM MST
          SHN    3
          ADN    PFGL 
          CRD    30B         (*0AV* ENTRY CONDITION)
          LDD    CP          CHECK FOR *SSJ=* PROGRAM 
          ADK    SEPW 
          CRD    CM 
          LDD    CM 
          LPN    4
          ZJN    SVE0        IF NOT *SSJ=* PROGRAM
          LDD    CM+3 
          LPN    77 
          ADD    CM+4 
          ZJN    SVE0        IF NO *SSJ=* BLOCK 
          NFA    SSJN+UIDS   READ USER NAME FROM SSJ= BLOCK 
          CRD    SP 
 SVE0     LDN    1           SET *DECREMENT SECURITY COUNT* FUNCTION
          STD    SP+4 
          EXECUTE  0AV,L0AV  UPDATE USER VALIDATION VIA *0AV* 
          LDD    T6 
          NJN    SVE1        IF SECURITY COUNT .NE. 0 
          LJM    TRJ         TERMINATE JOB
  
 SVE1     LJM    EBCX        RETURN 
 SWE      SPACE  4,10 
**        SWE - PROCESS SYSTEM SOFTWARE ERROR.
* 
*         SETS THE JOB TERMINATION OPTION TO *SRJT*,
*         ISSUES THE SYSTEM SOFTWARE ERROR ACCOUNT
*         FILE MESSAGE, AND TERMINATES THE JOB. 
* 
*         EXIT   TO *EBCX*. 
* 
*         CALLS  ESB, LOF.
  
  
 SWE      BSS    0           ENTRY
          LDM    JBCS        CHECK JOB CONNECTION STATUS
          LMK    OLCS 
          ZJN    SWE1        IF ON-LINE INTERACTIVE JOB 
          LMK    DTCS&OLCS
          NJN    SWE2        IF NON-INTERACTIVE JOB 
 SWE1     LJM    TRJ         TERMINATE JOB
  
 SWE2     RJM    ESB         EMPTY COMMAND BUFFER 
          LDN    SRJT        SELECT *SOFTWARE ERROR RERUN* OPTION 
          RJM    SEJ
          LJM    EBCX        RETURN 
 TRJ      SPACE  4,10 
**        TRJ - TERMINATE JOB.
* 
*         EXIT   TO *EBCX*. 
* 
*         CALLS  CJA. 
  
  
 TRJ      BSS    0           ENTRY
          RJM    CJA         CLEAR JOB ACTIVITY 
          LJM    EBCX        EXIT 
          TITLE  REPRIEVE/TERMINAL INTERRUPT PROCESSORS.
 CEI      SPACE  4,15 
**        CEI - CHECK ERROR INTERRUPT.
* 
*         ENTRY  (CW - CW+4) = ERROR EXIT CONTROL WORD. 
* 
*         EXIT   TO *RIP* TO SET REPRIEVE PARAMETERS. 
*                TO *SPI* TO SET PENDING INTERRUPT. 
* 
*         USES   T1 - T5, CM - CM+4, AB - AB+4, FS - FS+4.
* 
*         CALLS  CJS,DFM. 
  
  
  
 CEI10    LDN    0           CLEAR REPRIEVE OPTIONS 
 CEI11    STD    CW+1 
          LDD    CP          WRITE EXIT CONTROL WORD
          ADN    EECW 
          CWD    CW 
  
 CEI      SUBR               ENTRY/EXIT 
          LDM    TROF,EF     CHECK REPRIEVE OPTIONS 
          STM    CEIA 
          LDD    RF 
          LPC    *           (REPRIEVE OPTION)
 CEIA     EQU    *-1
          ZJN    CEI11       IF THIS ERROR NOT SELECTED 
          RJM    CJS         CHECK JOB STATUS 
          ZJN    CEI11       IF JOB STEP COMPLETE 
          LDD    EF          CHECK ERROR
          LMN    OKET 
          NJN    CEI1        IF NOT OPERATOR KILL 
          LDD    CW 
          SHN    21-10
          MJN    CEI10       IF PREVIOUS KILL REPRIEVED 
          LDC    400         SET KILL REPRIEVED 
          RAD    CW 
 CEI1     LDD    CW+3        VALIDATE BLOCK ADDRESS 
          LPN    37 
          SHN    6
          SBD    FL 
          SHN    6
          ADD    CW+4 
          ADN    7
          PJN    CEI2        IF BLOCK PARAMETERS OUTSIDE FL 
          SBN    7
          SHN    14 
          ADD    FL 
          ADD    RA 
          SHN    6           READ BLOCK PARAMETERS
          ADK    /COMSRPV/LNTH
          CRD    CM 
          ADN    /COMSRPV/CKLW  READ CHECKSUM LWA 
          CRD    CN 
          ADN    /COMSRPV/CKSM-/COMSRPV/CKLW  READ CHECKSUM 
          CRD    T1 
          ADN    /COMSRPV/ERCD-/COMSRPV/CKSM  READ COMMON ERROR CODES 
          CRD    FS 
          ADN    /COMSRPV/OSEF-/COMSRPV/ERCD  READ SYSTEM ERROR FLAG
          CRD    AB 
          SBN    /COMSRPV/OSEF  VALIDATE OPERATING SYSTEM ERROR FLAG
          SHN    14 
          SBD    RA 
          SBD    FL 
          SHN    6
          ADD    CM+3 
 CEI2     PJN    CEI3        IF BLOCK LWA OUTSIDE FL
          LDD    CM+3 
          SBN    /COMSRPV/REPL
          MJN    CEI3        IF BLOCK LENGTH TOO SHORT
          LDD    CN+3 
          LPN    37 
          STD    CN+3 
          SHN    14 
          ADD    CN+4 
          SBN    2
          MJN    CEI3        IF INCORRECT TRANSFER ADDRESS
          ADN    2
          SHN    -6 
          SBD    FL 
          MJN    CEI4        IF TRANSFER ADDRESS WITHIN FL
 CEI3     LDC    =C* REPRIEVE BLOCK ERROR.* 
          LJM    CEI8        ISSUE DAYFILE MESSAGE
  
 CEI4     LDD    CN+2        CHECK IF CHECKSUM NEEDED 
          SCN    77 
          SHN    6
          ADD    CN+1 
          LPC    773777 
          STD    CM+4        PRESET CHECKSUM GOOD 
          ZJN    CEI6        IF NO CHECKSUM REQUIRED
          SBD    FL 
          SHN    6
 CEI5     PJN    CEI3        IF CHECKSUM LWA OUTSIDE FL 
          SHN    14 
          ADD    FL 
          SHN    6
          ADN    1
          SBD    CN+4        SET WORD COUNT 
          STD    CM+2 
          MJN    CEI3        IF LWA+1 .LT. FWA
          SHN    -14
          SBD    CN+3 
          MJN    CEI3        IF LWA+1 .LT. FWA
          STD    CM+1 
          LDD    CN+3        SET CHECKSUM FWA 
          STD    CM+3 
          LDD    CN+4 
          STD    CM+4 
          LDD    MA 
          CWD    T1 
          MONITOR  CKSM      COMPUTE CHECKSUM 
 CEI6     LDD    CW          CHECK INTERRUPT PROCESSOR ACTIVE 
          SHN    21-11
          PJN    CEI7        IF INTERRUPT PROCESSOR NOT ACTIVE
          LDM    TROF,EF
          LPC    163
          NJN    CEI9        IF INTERRUPT PROCESSOR ABORTED - EXIT
          LDD    EF 
          LMN    TLET 
          ZJN    CEI6.2      IF TIME LIMIT
          LMN    SRET&TLET
          ZJN    CEI6.2      IF SRU LIMIT 
 CEI6.1   LJM    SPI         SET PENDING INTERRUPT
  
 CEI6.2   LDD    CW 
          SHN    21-7 
          MJN    CEI9        IF CONDITION PREVIOUSLY ENCOUNTERED
          LDC    200
          RAD    CW 
          UJN    CEI6.1      SET PENDING INTERRUPT
  
 CEI7     LDD    CM+4        VALIDATE CHECKSUM
          ZJP    RIP         IF CHECKSUM GOOD 
          LDC    =C* REPRIEVE CHECKSUM BAD.*
 CEI8     RJM    DFM         ISSUE ERROR MESSAGE
 CEI9     LJM    CEI10       EXIT 
 DTC      SPACE  4,15 
**        DTC - PROCESS DISABLED TERMINAL CONTROL.
* 
*         PROCESSES ERROR RECOVERY FOR USER BREAKS ONE AND
*         TWO FOR TERMINALS WITH TERMINAL CONTROL DISABLED. 
* 
*         EXIT   TO *STC* TO RESTART JOB IF DISABLED TERMINAL 
*                  CONTROL PROCESSED. 
*                RETURNS TO CALLER IF DISABLED TERMINAL CONTROL 
*                  NOT PROCESSED. 
* 
*         USES   T1 - T3, CM - CM+4, CW - CW+4. 
* 
*         CALL   CJS,VCA. 
  
  
 DTC      SUBR               ENTRY/EXIT 
          RJM    CJS         CHECK JOB STATUS 
          ZJN    DTCX        IF JOB STEP COMPLETE 
          LDD    CP          READ TERMINAL INTERRUPT POINTER
          ADK    TIAW 
          CRD    CW 
          ADK    EECW-TIAW
          CRD    CM          CHECK FOR EXTENDED REPRIEVE
          LDD    CM 
          SHN    21-12
          MJN    DTCX        IF EXTENDED REPRIEVE SET 
          LDD    CW+3        SET INTERRUPT ADDRESS
          SCN    77 
          SHN    6
          LMD    CW+2 
          SHN    6
          ZJN    DTCX        IF TERMINAL CONTROL NOT DISABLED 
          MJN    DTC1        IF EXCHANGE PACKAGE ADDRESS
  
*         SET INTERRUPT FLAG. 
  
          RJM    VCA         VALIDATE CENTRAL ADDRESS 
          ZJN    DTCX        IF ADDRESS INCORRECT 
          LDN    ZERL        READ ZERO WORD 
          CRD    CM 
          LDD    EF          SET ERROR FLAG IN INTERRUPT WORD 
          STD    CM+4 
          LDD    T1          REWRITE INTERRUPT FLAG WORD
          SHN    14 
          ADD    T2 
          CWD    CM 
          LJM    DTC4        RESTART JOB
  
*         VALIDATE EXCHANGE PACKAGE POINTERS. 
  
 DTC1     LPC    377777      CLEAR EXCHANGE PACKAGE FLAG BIT
          RJM    VCA         VALIDATE CM ADDRESS
          ZJN    DTC2        IF ADDRESS INCORRECT 
          ADN    17          CHECK EXCHANGE PACKAGE LENGTH
          SHN    -6 
          SBD    RA 
          SBD    FL 
          MJN    DTC3        IF ADDRESS WITHIN FL 
 DTC2     LJM    DTCX        RETURN 
  
*         STORE EXCHANGE PACKAGE IN USER FL.
  
 DTC3     LDN    20          SET EXCHANGE PACKAGE LENGTH
          STD    T3 
          LDD    CP          READ EXCHANGE PACKAGE
          CRD    CM 
          CRM    EXPA,T3
          LDD    T1          WRITE EXCHANGE PACKAGE TO CM 
          SHN    14 
          LMD    T2 
          CWM    EXPA,T3
  
*         RESTART CPU AT NEW EXECUTION ADDRESS. 
  
          SHN    22-6        SET P-ADDRESS TO END OF EXCHANGE PACKAGE 
          SBD    RA 
          SHN    6
          STD    CM+1 
          SHN    -14
          STD    CM 
          LDD    CP          REWRITE JOB P-REGISTER 
          CWD    CM 
 DTC4     LDD    CP          CLEAR *SKIP TO EXIT* FLAG
          ADK    CSSW 
          CRD    CM 
          LDD    CM 
          LPC    5777 
          STD    CM 
          LDD    CP 
          ADK    CSSW 
          CWD    CM 
          LJM    STC         RESTART CPU
 RIP      SPACE  4,15 
**        RIP - RETURN INTERRUPT PARAMETERS.
* 
*         ENTRY  (CW - CW+4) = ERROR EXIT CONTROL WORD. 
*                (CN+3 - CN+4) = TRANSFER ADDRESS.
*                (FS - FS+4) = WORD /COMSRPV/ERCD OF REPRIEVE BLOCK.
*                (AB - AB+4) = WORD /COMSRPV/OSEF OF REPRIEVE BLOCK.
* 
*         EXIT   TO *SRE*.
*                PARAMETERS SET IN REPRIEVE BLOCK.
* 
*         USES   AB+4, CN, CW, CM - CM+4, FS+2 - FS+4, T1 - T5. 
  
  
 RIP      BSS    0           ENTRY
          LDN    /COMSRPV/EXPL  SET EXCHANGE PACKAGE LENGTH 
          STD    CN 
          LDD    CP          READ (P) 
          CRD    T1 
          CRM    EXPA,CN     READ EXCHANGE PACKAGE
          LDD    CN+3        SET (P) TO TRANSFER ADDRESS
          STD    T1 
          LDD    CN+4 
          STD    T1+1 
          LDD    EF 
          STD    AB+4        SET ERROR IN PARAMETER BLOCK 
          LDD    CP          WRITE (P) TO EXCHANGE PACKAGE
          CWD    T1 
          LDM    TROF,EF     SET ERROR TYPE FOR INTERRUPT PROCESSOR 
          STD    FS+3 
          LDN    0
          STD    FS+2 
          LDM    TCEC,EF     SET COMMON ERROR CODE
          STD    FS+4 
          LDN    ZERL 
          CRD    T1 
          LDD    RA          READ SYSTEM REQUEST
          SHN    6
          ADN    1
          CRD    CM 
          CWD    T1          CLEAR SYSTEM REQUEST 
  
*         IF *1RI* DETECTED A USER BREAK ON A JOB WITH EXTENDED 
*         REPRIEVE, THE TERMINAL INPUT POINTER WILL NOT BE CLEARED, 
*         ALLOWING *3AB* TO RECONSTRUCT THE PENDING INPUT REQUEST 
*         (IF ANY) AND PLACE IT IN THE REPRIEVE BLOCK.
  
          LDC    **          CHECK FOR INPUT PENDING ON USER BREAK
 RIPA     EQU    *-1         (INPUT FET ADDRESS)
          ZJN    RIP2        IF NO TERMINAL INPUT OR NOT USER BREAK 
          STD    T1+4        STORE FET ADDRESS IN *CIO* CALL
          SHN    -14
          STD    T1+3 
          LDC    2RCI        BUILD *CIO* CALL 
          STD    T1 
          LDC    2ROP 
          STD    T1+1 
  
*         CHECK FOR JOB IN RECALL WAITING FOR INPUT FET COMPLETION. 
  
          LDD    CM 
          LMC    2RRC 
          NJN    RIP2        IF NOT *RCL* CALL IN RA+1
          LDD    CM+1 
          LMC    2RLP 
          NJN    RIP2        IF NOT *RCL* CALL IN RA+1
          LDD    CM+3 
          LPN    37 
          LMD    T1+3 
          NJN    RIP2        IF NOT WAITING FOR INPUT FET 
          LDD    CM+4 
          LMD    T1+4 
          NJN    RIP2        IF NOT WAITING FOR INPUT FET 
          LDN    ZERL        CLEAR RA+1 IMAGE 
          CRD    CM 
 RIP2     LDD    CW+3        WRITE PARAMETERS TO REPRIEVE BLOCK 
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CW+4 
          ADN    /COMSRPV/ERCD  WRITE COMMON ERROR CODE 
          CWD    FS 
          ADN    /COMSRPV/PRAR-/COMSRPV/ERCD  WRITE RA+1 CONTENTS 
          CWD    CM 
          ADN    /COMSRPV/ITIO-/COMSRPV/PRAR  SET/CLEAR TERMINAL INPUT
          CWD    T1 
          ADN    /COMSRPV/OSEF-/COMSRPV/ITIO  WRITE SYSTEM ERROR FLAG 
          CWD    AB 
          ADN    /COMSRPV/RPPL-/COMSRPV/OSEF  WRITE EXCHANGE PACKAGE
          CWM    EXPA,CN
          LDD    TH          SET INTERRUPT PROCESSING ACTIVE
          RAD    CW 
          LJM    SRE         SET REPRIEVED ERROR
 SPI      SPACE  4,10 
**        SPI - SET PENDING INTERRUPT.
* 
*         ENTRY  (CW+3 - CW+4) = PARAMETER BLOCK ADDRESS. 
* 
*         EXIT   TO *SRE*.
*                INTERRUPT PENDING STATUS SET IN REPRIEVE BLOCK.
* 
*         USES   T1, T2, CM - CM+4. 
  
  
 SPI      BSS    0           ENTRY
          LDD    CW+3        READ PENDING INTERRUPTS
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CW+4 
          ADN    /COMSRPV/PINT
          CRD    CM 
          LDD    EF          SET CURRENT INTERRUPT PENDING
          STD    T1 
          LDN    CM+5        SELECT BYTE FOR INTERRUPT
          STD    T2 
 SPI1     SOD    T2          ADVANCE BYTE 
          LCN    14 
          RAD    T1 
          PJN    SPI1        IF NOT PROPER BYTE 
          ADN    14          SET BIT POSITION 
          RAM    SPIB        SET SHIFT INSTRUCTIONS 
          LPN    37 
          LMC    777777 
          RAM    SPIA 
          LDI    T2          SET INTERRUPT BIT
 SPIA     SHN    22 
          SCN    1
          LMN    1
 SPIB     SHN    0
          STI    T2 
          LDD    CW+3        WRITE PENDING INTERRUPTS 
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CW+4 
          ADN    /COMSRPV/PINT
          CWD    CM 
*         UJN    SRE         SET REPRIEVED ERROR
 SRE      SPACE  4,10 
**        SRE - SET REPRIEVED ERROR FOR POSSIBLE *RESET* CALL.
* 
*         EXIT   TO *RIJ*.
*                REPRIEVED ERROR UPDATED IF NECESSARY.
* 
*         USES   CM - CM+4. 
  
  
 SRE      BSS    0           ENTRY
          LDD    CP          READ REPRIEVED ERROR 
          ADN    TIAW 
          CRD    CM 
          LDD    EF 
          SBD    CM+2 
          MJN    RIJ         IF OLD ERROR .GT. NEW
          RAD    CM+2        SET REPRIEVED ERROR
          LDD    CP          WRITE REPRIEVED ERROR
          ADN    TIAW 
          CWD    CM 
*         UJN    RIJ         RESTART INTERRUPTED JOB
 RIJ      SPACE  4,10 
**        RIJ - RESTART INTERRUPTED JOB.
* 
*         ENTRY  (CW - CW+4) = ERROR EXIT CONTROL WORD. 
* 
*         EXIT   TO *STC* TO STARTUP CPU. 
* 
*         USES   CM - CM+4, CN - CN+4.
* 
*         CALLS  CPD, ITL.
  
  
 RIJ      BSS    0           ENTRY
          LDD    CP          REWRITE ERROR/EXIT CONTROL WORD
          ADN    EECW 
          CWD    CW 
          LDD    EF          CHECK ERROR FLAG 
          LMN    TLET 
          NJN    RIJ1        IF NOT TIME LIMIT
          LDN    DTLI        SET INCREMENT
          STD    CM+4 
          LDN    RLIT 
          UJN    RIJ2        INCREASE TIME LIMIT
  
 RIJ1     LMN    SRET&TLET
          NJN    RIJ3        IF NOT SRU LIMIT 
          LDN    DSLI        SET INCREMENT
          STD    CM+4 
          LDN    RLIA 
 RIJ2     RJM    ITL         INCREASE LIMIT 
          UJN    STC         START UP CPU 
  
 RIJ3     LMN    PPET&SRET
          NJN    STC         IF NOT PPU ABORT 
          RJM    CPD         CLEAR PPU DUMP WORD
*         UJN    STC         STARTUP CPU
 STC      SPACE  4,10 
**        STC - STARTUP CPU.
* 
*         REQUESTS THE CPU TO RESTART THE JOB.
* 
*         USES   CM - CM+4. 
* 
*         EXIT   TO *DPP*.
* 
*         MACROS MONITOR. 
  
  
 STC      BSS    0           ENTRY
          LDD    CP          CLEAR POSSIBLE *PSD* STATUS
          ADN    3
          CRD    CM 
          LDD    CM+1 
          LPN    10          RETAIN STEP CONDITION
          STD    CM+1 
          LDD    CP 
          ADN    3
          CWD    CM 
          ADK    JCIW-3      READ JOB CONTROL INFORMATION 
          CRD    CM 
          LDD    CM+2        CHECK SUBSYSTEM ID 
          LMK    BISI 
          ZJN    STC1        IF *BATCHIO* 
          MONITOR  RCPM      REQUEST CPU
 STC1     LJM    DPP         DROP PPU 
 TROF     EJECT 
**        TROF - TABLE OF REPRIEVE OPTION CLASS FLAG BITS.
* 
*         INDEXED BY NOS ERROR FLAG.
  
  
 TROF     INDEX 
          INDEX  0,/COMSRPV/NTCL      NORMAL TERMINATION
          INDEX  ARET,/COMSRPV/EECL   CPU ERROR EXIT
          INDEX  CPET,/COMSRPV/CPCL   CPU ABORT 
          INDEX  ECET,/COMSRPV/ECCL   EXTENDED MEMORY PARITY ERROR
          INDEX  FLET,/COMSRPV/FLCL   MASS STORAGE LIMIT
          INDEX  FSET,/COMSRPV/OKCL   OPERATOR KILL 
          INDEX  IDET,/COMSRPV/ODCL   IDLEDOWN
          INDEX  ITET,/COMSRPV/PPCL   PPU ABORT 
          INDEX  MLET,/COMSRPV/ECCL   MESSAGE LIMIT 
          INDEX  ODET,/COMSRPV/ODCL   OPERATOR DROP 
          INDEX  OKET,/COMSRPV/OKCL   OPERATOR KILL 
          INDEX  ORET,/COMSRPV/OKCL   OPERATOR KILL 
          INDEX  PCET,/COMSRPV/PCCL   PP CALL ERROR 
          INDEX  PEET,/COMSRPV/EECL   CPU PARITY ERROR
          INDEX  PPET,/COMSRPV/PPCL   PPU ABORT 
          INDEX  PSET,/COMSRPV/EECL   CPU ERROR EXIT
          INDEX  RCET,/COMSRPV/PCCL   JOB HUNG IN AUTORECALL
          INDEX  RRET,/COMSRPV/RRCL   OPERATOR RERUN
          INDEX  SRET,/COMSRPV/SRCL   I/O LIMITS
          INDEX  SSET,/COMSRPV/OKCL   OPERATOR KILL 
          INDEX  STET,/COMSRPV/ODCL   SUSPENSION TIMEOUT
          INDEX  SYET,/COMSRPV/OKCL   OPERATOR KILL 
          INDEX  TAET,/COMSRPV/TICL   USER BREAK TWO
          INDEX  TIET,/COMSRPV/TICL   USER BREAK ONE
          INDEX  TKET,/COMSRPV/FLCL   MASS STORAGE LIMIT
          INDEX  TLET,/COMSRPV/TLCL   TIME LIMIT
  
          INDEX  MXET 
 TCEC     EJECT 
**        TCEC - TABLE OF REPRIEVE COMMON ERROR CODES.
* 
*         INDEXED BY NOS ERROR FLAG.
  
  
 TCEC     INDEX 
          INDEX  0,/COMSRPV/NTEC      NORMAL TERMINATION
          INDEX  ARET,/COMSRPV/EEEC   CPU ERROR EXIT
          INDEX  CPET,/COMSRPV/CPEC   CPU ABORT 
          INDEX  ECET,/COMSRPV/ECEC   EXTENDED MEMORY PARITY ERROR
          INDEX  FLET,/COMSRPV/MLEC   MASS STORAGE LIMIT
          INDEX  FSET,/COMSRPV/OKEC   OPERATOR KILL 
          INDEX  IDET,/COMSRPV/ODEC   IDLEDOWN
          INDEX  ITET,/COMSRPV/PPEC   PPU ABORT 
          INDEX  MLET,/COMSRPV/PPEC   MESSAGE LIMIT 
          INDEX  ODET,/COMSRPV/ODEC   OPERATOR DROP 
          INDEX  OKET,/COMSRPV/OKEC   OPERATOR KILL 
          INDEX  ORET,/COMSRPV/OKEC   OPERATOR KILL 
          INDEX  PCET,/COMSRPV/PCEC   PP CALL ERROR 
          INDEX  PEET,/COMSRPV/EEEC   CPU ERROR EXIT
          INDEX  PPET,/COMSRPV/PPEC   PPU ABORT 
          INDEX  PSET,/COMSRPV/EEEC   CPU ERROR EXIT
          INDEX  RCET,/COMSRPV/RCEC   JOB HUNG IN AUTORECALL
          INDEX  RRET,/COMSRPV/RREC   OPERATOR RERUN
          INDEX  SRET,/COMSRPV/SREC   I/O LIMITS
          INDEX  SSET,/COMSRPV/OKEC   OPERATOR KILL 
          INDEX  STET,/COMSRPV/ODEC   SUSPENSION TIMEOUT
          INDEX  SYET,/COMSRPV/OKEC   OPERATOR KILL 
          INDEX  TAET,/COMSRPV/TIEC   USER BREAK TWO
          INDEX  TIET,/COMSRPV/TIEC   USER BREAK ONE
          INDEX  TKET,/COMSRPV/MLEC   MASS STORAGE LIMIT
          INDEX  TLET,/COMSRPV/TLEC   TIME LIMIT
  
          INDEX  MXET 
          TITLE  SUBROUTINES. 
 CCO      SPACE  4,20 
**        CCO - CALL CIO TO DUMP FET. 
* 
*         A *WRITER* WILL BE ISSUED TO FLUSH A BUFFER UNLESS
*         THE LAST OPERATION WAS A 204 OR 264 WRITE, IN WHICH 
*         CASE THAT WRITE FUNCTION WILL BE REISSUED.
* 
*         ENTRY  (CM+3 - CM+4) = FET ADDRESS. 
*                (CN - CN+4) = FIRST WORD OF FET. 
*                (T1) = LIST OF FILES INDEX.
*                AT *CCO2* IF *CIO* IN PROGRESS.
* 
*         EXIT   TO *PPR* IF RECALL STACK FULL. 
* 
*         USES   CM - CM+4, CW - CW+4.
* 
*         MACROS LDA, MONITOR.
  
  
 CCO      SUBR               ENTRY/EXIT 
          AOM    CCOA        FLAG *CIO* CALLED
          LDD    CP          UPDATE LIST OF FILES INDEX 
          ADC    LOFW 
          STD    T0 
          CRD    CW 
          LDD    T1 
          STD    CW 
          LDD    T0 
          CWD    CW 
          LDC    3ROCI       SET *CIO* CALL 
          STD    CM 
          SHN    -6 
          SCN    77 
          STD    CM+1 
          LDN    0
          STD    CM+2 
          LDD    MA 
          CWD    CM 
          LDD    CN+4        CHECK FOR CONTROL WORD WRITE 
          LPC    776
          STD    CN+4 
          SHN    -3 
          LMN    204/10 
          ZJN    CCO1        IF 204 WRITE 
          LMN    264/10&204/10
          ZJN    CCO1        IF 264 WRITE 
          LDD    CN+4        SET EOR REQUEST
          LPN    2
          LMN    24 
          STD    CN+4 
 CCO1     LDD    CN+3        CLEAR LEVEL NUMBER AND ERROR STATUS
          SCN    77 
          STD    CN+3 
          LDA    CM+3        STORE FET STATUS 
          CWD    CN 
          LDN    ZERL 
          CRD    CM 
          LDD    MA 
          ADN    1
          CWD    CM 
          MONITOR  RPPM      REQUEST *CIO*
          LDD    CM+1 
          ZJN    CCO2        IF REQUEST NOT PROCESSED 
          LJM    CCOX        RETURN 
  
*         RECALL STACK FULL, DROP PP. 
  
 CCO2     LDD    EF          CHECK ERROR FLAG 
          ZJN    CCO3        IF NO ERROR FLAG 
          STD    CM+1        RESET ERROR FLAG 
          MONITOR  CEFM 
 CCO3     LDN    DPPS        CLEAR JOB ADVANCE AND DROP PP
          STD    CM+1 
          MONITOR  JACM 
          LJM    PPR         EXIT TO PP RESIDENT
  
  
 CCOA     CON    0           *CIO* CALLED FLAG
 CFP      SPACE  4,15 
**        CFP - CHECK FET PARAMETERS. 
* 
*         ENTRY  (CM+3 - CM+4) = FET ADDRESS. 
* 
*         EXIT   (A) = 0, BUFFER PARAMETERS ARE VALID, FET IS WITHIN FL 
*                AND CONTAINS DATA. 
*                (CW+1) = FLUSH BIT.
*                (CN - CN+4) = FIRST WORD OF FET. 
*                (CW+3 - CW+4) = FIRST. 
*                (FS+3 - FS+4) = IN.
*                (AB+3 - AB+4) = OUT. 
*                (T6 - T7) = LIMIT. 
* 
*         USES   T3 - T7, AB - AB+4, CN - CN+4, CW - CW+4, FS - FS+4. 
  
  
 CFP3     LDN    1
  
 CFP      SUBR               ENTRY/EXIT 
          LDD    CM+3        CHECK 5 WORD FET WITHIN RANGE
          LPN    37 
          STD    CM+3 
          SHN    14 
          ADD    CM+4 
          SBN    2
          MJN    CFP3        IF FET ADDRESS .LE. 1
          ADN    2+5
          SHN    -6 
          SBD    FL 
          PJN    CFP3        IF FET OUT OF RANGE
          LDA    CM+3        READ FET PARAMETERS
          CRD    CN 
          ADN    1
          CRD    CW          READ FIRST 
          ADN    1
          CRD    FS          READ IN
          ADN    1
          CRD    AB          READ OUT 
          ADN    1
          CRD    T3          READ LIMIT 
          LDD    CW+3        SET FET LENGTH 
          SHN    14 
          STD    T3 
          SHN    -14
          STD    CW+3 
          LDD    T6          CHECK LIMIT - FL 
          LPN    77 
          STD    T6 
          SHN    14 
          ADD    T7 
          SBN    1
          SHN    -6 
          SBD    FL 
          PJN    CFP1        IF LIMIT .GT. FL 
  
*         CHECK OUT.
  
          LDD    AB+3        OUT - LIMIT
          LPN    77 
          STD    AB+3 
          SBD    T6 
          SHN    14 
          ADD    AB+4 
          SBD    T7 
          PJN    CFP1        IF OUT .GE. LIMIT
          LDD    AB+3        OUT - FIRST
          SBD    CW+3 
          SHN    14 
          ADD    AB+4 
          SBD    CW+4 
          PJN    CFP2        IF OUT .GE. FIRST
 CFP1     LJM    CFP3        RETURN 
  
*         CHECK IN. 
  
 CFP2     LDD    FS+3        IN - LIMIT 
          LPN    77 
          STD    FS+3 
          SBD    T6 
          SHN    14 
          ADD    FS+4 
          SBD    T7 
          PJN    CFP1        IF IN .GE. LIMIT 
          LDD    FS+3        IN - FIRST 
          SBD    CW+3 
          SHN    14 
          ADD    FS+4 
          SBD    CW+4 
          MJN    CFP1        IF IN .LT. FIRST 
          LDD    CM+3        CHECK FET IN RANGE 
          SHN    14 
          ADD    CM+4 
          ADD    T3          FET LENGTH 
          ADN    5
          SHN    -6 
          SBD    FL 
          PJN    CFP1        IF FET EXTENDS BEYOND FL 
          LDD    FS+3        CHECK FOR DATA IN FET
          LMD    AB+3 
          SHN    14 
          LMD    FS+4 
          LMD    AB+4 
          ZJN    CFP1        IF FET CONTAINS NO DATA
          LDN    0
          LJM    CFPX        RETURN 
 CFS      SPACE  4,10 
**        CFS - CHECK FET STATUS. 
* 
*         ENTRY  (CN - CN+4) = FIRST WORD OF FET. 
* 
*         EXIT   (A) = 0, IF FILE FLUSHABLE.
*                    .GT. 0, IF FILE NOT TO BE FLUSHED. 
*                    .LT. 0, IF FILE FLUSHABLE, *OUTPUT*, 
*                    AND NOT ON-LINE INTERACTIVE JOB. 
  
  
 CFS      SUBR               ENTRY/EXIT 
          LDD    CN+3        CHECK FOR *CIO* ERRORS 
          LPN    3
          SHN    14 
          LMD    CN+4 
          SHN    -10D 
          NJN    CFSX        IF *CIO* ERRORS
          LDD    CN+4        CHECK FET STATUS 
          SHN    21-2 
          MJN    CFS1        IF WRITE BIT SET 
          LPC    177
          ZJN    CFS1        IF NO *CIO* CALLS
          SCN    4           CHECK OPEN ALTER 
          LMN    12 
          NJN    CFSX        IF NOT OPEN ALTER
  
*         CHECK FILE = *OUTPUT* 
  
 CFS1     LDD    CN          FILE NAME
          LMC    2ROU 
          NJN    CFS3        IF NOT *OU*
          LDD    CN+1 
          LMC    2RTP 
          NJN    CFS3        IF NOT *TP*
          LDD    CN+2 
          LMC    2RUT 
          NJN    CFS3        IF NOT *UT*
          LDD    CN+3 
          SCN    77 
          NJN    CFS3        IF FILE NOT *OUTPUT* 
          LDM    TSTN        CHECK TERMINAL NUMBER
          NJN    CFS2        IF ON-LINE INTERACTIVE JOB 
          LCN    1
          UJN    CFS4        RETURN 
  
 CFS2     LDN    1
          UJN    CFS4        RETURN 
  
 CFS3     LDN    0
 CFS4     LJM    CFSX        RETURN 
 CPD      SPACE  4,10 
**        CPD - CLEAR PPU DUMP WORD.
* 
*         EXIT   (PPDW) = ZERO. 
* 
*         USES   T1, CM - CM+4. 
  
  
 CPD      SUBR               ENTRY/EXIT 
          LDD    CP          CLEAR PPU DUMP WORD
          ADC    PPDW 
          CRD    CM 
          STD    T1 
          LDN    0
          STD    CM+3 
          STD    CM+4 
          LDD    T1 
          CWD    CM 
          UJN    CPDX        RETURN 
CJA       SPACE  4,10 
**        CJA - CLEAR JOB ACTIVITY. 
* 
*         EXIT   REMAINING JOB ACTIVITY CLEARED.
*                LOGOUT FUNCTION SENT TO *IAF* IF ONLINE STATUS.
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  ESB, ITF, SEJ. 
  
  
 CJA      SUBR               ENTRY/EXIT 
          RJM    ESB         EMPTY COMMAND BUFFER 
          LDN    TJJT        SELECT *TERMINATE JOB* OPTION
          RJM    SEJ
          LDM    TSTN        CHECK TERMINAL NUMBER
          ZJN    CJAX        IF NOT ON-LINE INTERACTIVE JOB 
          LDN    ZERL        CLEAR ZERO WORD
          CRD    CM 
 CJAA     LDN    0
*         LDN    1           (NO NFL) 
          NJN    CJA1        IF NO NFL
          NFA    SHCN        CLEAR *SHELL* CONTROL
          CWD    CM 
 CJA1     LDK    /REM/VTLF   FORMAT LOGOFF REQUEST
          STD    CM 
          LDN    2           SET FORCE LOGOFF 
          STD    CM+2 
          LDM    TSTN        SET TERMINAL NUMBER
          STD    CM+4 
          LDD    MA          ENTER *TSEM* REQUEST PARAMETERS
          CWD    CM 
          RJM    ITF         ISSUE REQUEST
          UJP    CJAX        RETURN 
 DMP      SPACE  4,10 
**        DMP - DUMP PROCESSOR. 
* 
*         EXIT   TO *EBCX* IF NO *DMP* REQUEST. 
*                TO *DPP* IF *DIS* CALL.
*                TO *PPR* IF *DMP* ROLLOUT NEEDED.
* 
*         USES   IR+2 - IR+4, CM - CM+4.
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 DMP      LDD    IR+2 
          LMN    2
          NJN    DMP1        IF NOT A *DIS* CALL
          LJM    DPP         DROP PP
  
 DMP1     LDD    CP          READ QUEUE PRIORITY
          ADN    JCIW 
          CRD    CM 
          LDD    CM+2 
          SBK    LSSI+1 
          MJN    DMP2        IF NOT SUBSYSTEM 
          LJM    EBCX        PROCESS BATCH ERROR
  
 DMP2     LDN    0
          STD    IR+2        CLEAR PARAMETERS 
          STD    IR+3 
          STD    IR+4 
          STD    CM+1        CLEAR JOB ADVANCE
          MONITOR  JACM 
          LDD    CP          CHECK SPECIAL CALL WORD
          ADC    SPCW 
          CRD    CM 
          LDD    CM 
          ZJN    DMP4        IF NO SPECIAL REQUEST PENDING
          LDC    =C* SPECIAL REQUEST PROCESSING ERROR.* 
 DMP3     RJM    DFM
          UJN    DMP6        EXIT 
  
 DMP4     LDD    CP          CHECK SSM STATUS 
          ADC    DBAW 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          PJN    DMP5        IF NOT SECURE MEMORY 
          LDC    *
 DMPB     EQU    *-1
*         LDC    0           (*SYOT*, OR *CSOJ* PERMISSION + DEBUG) 
          ZJN    DMP5        IF ACCESS ALLOWED
          LDC    =C* SECURE MEMORY, DUMP DISABLED.* 
          UJN    DMP3        ISSUE DAYFILE MESSAGE
  
 DMP5     LDD    CP          SET *DMP=* CALL
          ADC    SPCW 
          CWM    DMPA,ON
          LDN    0           SET TO ROLLOUT 
          STD    CM+1 
          MONITOR  ROCM 
 DMP6     MONITOR  DPPM      DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
  
  
 DMPA     VFD    18/3LDMP,6/4,36/0
 ESB      SPACE  4,10 
**        ESB - EMPTY SYSTEM COMMAND BUFFER.
* 
*         USES  CM - CM+4, SP - SP+4. 
  
  
 ESB      SUBR               ENTRY/EXIT 
          LDD    CP          READ COMMAND POINTER 
          ADN    CSPW 
          CRD    SP 
          ADN    RFCW-CSPW   READ EXECUTE COMMAND ADDRESS 
          CRD    CM 
          LDD    SP+3        SET BUFFER EMPTY 
          STD    SP+4 
          LDC    4000        SET EOR ON COMMAND FILE
          STD    SP+1 
          LDD    SP          CLEAR EPILOGUE FLAG
          SCN    10 
          STD    SP 
          LDD    CM+3        CLEAR COMMAND ADDRESS
          LPN    77 
          STD    CM+3 
          LDN    0
          STD    CM+2 
          STM    ADJB        CLEAR COMMANDS PENDING 
          LDD    CP          STORE COMMAND POINTERS 
          ADN    CSPW 
          CWD    SP 
          ADN    RFCW-CSPW
          CWD    CM 
          UJN    ESBX        RETURN 
 ITL      SPACE  4,10 
**        ITL - INCREMENT SPECIFIED LIMIT.
* 
*         ENTRY  (CM+4) = UNITS TO INCREMENT
*                (A) = SUBFUNCTION CODE FOR INCREMENT REQUEST.
* 
*         MACROS MONITOR. 
  
  
 ITL      SUBR               ENTRY/EXIT 
          STD    CM+1 
          LDN    0
          STD    CM+3 
          MONITOR  RLMM 
          LJM    ITLX        RETURN 
 SCR      SPACE  4,10 
**        SCR - SET CHARGE REQUIRED.
* 
*         EXIT   CHARGE REQUIRED SET ON JOB.
*                CHARGE REQUIRED FLAG *CRQF* .NE. 0.
* 
*         USES   (SP - SP+4). 
  
  
 SCR      SUBR               ENTRY/EXIT 
          LDD    CP          SET CHARGE REQUIRED
          ADN    CSPW 
          CRD    SP 
          LDD    SP 
          SCN    4
          LMN    4
          STD    SP 
          STM    CRQF 
          LDD    CP 
          ADN    CSPW 
          CWD    SP 
          UJN    SCRX        RETURN 
 SEJ      SPACE  4,10 
**        SEJ - SET END-OF-JOB TERMINATION OPTION.
* 
*         SETS THE JOB TERMINATION OPTION IN THE CONTROL
*         POINT AREA END-OF-JOB CONTROL WORD. 
* 
*         ENTRY  (A) = END-OF-JOB OPTION. 
* 
*         EXIT   (JTOP) = JOB TERMINATION OPTION. 
* 
*         USES   CM - CM+4. 
  
  
 SEJ      SUBR               ENTRY/EXIT 
          STM    JTOP        STORE OPTION 
          LDD    CP          READ END-OF-JOB CONTROL WORD 
          ADK    EOJW 
          CRD    CM 
          STD    T0          SAVE WORD ADDRESS
          LDD    CM          SET OPTION 
          SHN    22-11
          SCN    7
          LMM    JTOP 
          SHN    11 
          STD    CM 
          LDD    T0          REWRITE WORD 
          CWD    CM 
          UJN    SEJX        RETURN 
 L0AV     EQU    *           LOAD ADDRESS FOR *0AV* 
          ERRNG  7772-L0AV-ZAVL  *0AV* OVERFLOWS *3AB*
          TITLE  OVERLAID SUBROUTINES.
 RSF      SPACE  4,10 
**        RSF - RETURN SPECIAL FILES. 
* 
*         CALLED DURING DEADSTART RERUN PROCESSING TO RETURN
*         *LIFT* FILES WHICH HAVE THE INTERLOCK BIT SET IN
*         THE FST WORD OR THE PF ACTIVITY BIT SET IN THE FUT WORD.
*         THE DM* FILE WILL ALSO BE RETURNED, IF IT EXISTS. 
* 
*         USES   FA, NL, CM - CM+4, CN - CN+4, FN - FN+4, FS - FS+4.
* 
*         CALLS  *0DF*. 
* 
*         MACROS EXECUTE, NFA.
  
  
 RSF      SUBR               ENTRY/EXIT 
          LDC    *           (NEGATIVE FL)
 RSFA     EQU    *-1
          STD    NL 
          LDK    FNTN-LENF   SET FNT FWA
          STD    CN 
  
*         SEARCH FNT FOR *LIFT* FILES WITH INTERLOCK OR PF ACTIVITY.
  
 RSF1     LDK    LENF        ADVANCE FNT INDEX
          RAD    CN 
          STD    FA 
          SBD    NL 
          PJN    RSFX        IF END OF FNT
          NFA    CN,R        SET FNT ADDRESS
          ADK    FNTL        READ FNT WORD
          CRD    FN 
          ADN    FSTL-FNTL   READ FST WORD
          CRD    FS 
          ADN    FUTL-FSTL   READ FUT WORD
          CRD    CM 
          LDD    FN          CHECK FNT ENTRY
          ZJN    RSF1        IF NULL FNT ENTRY
          LDD    FN+4        CHECK FILE TYPE
          SHN    -6 
          LMN    LIFT 
          ZJN    RSF2        IF *LIFT* FILE 
          LMN    LIFT&ROFT
          NJN    RSF1        IF NOT *ROFT* FILE 
          UJN    RSF6        DROP DM* FILE
  
 RSF2     LDD    FS+4        CHECK *LIFT* FILE TRACK INTERLOCK FLAG SET 
          LPC    1000 
          NJN    RSF4        IF INTERLOCK SET 
          LDD    CM+2 
          LPN    10 
          NJN    RSF5        IF PF ACTIVITY FLAG SET
 RSF3     UJN    RSF1        CHECK NEXT FILE
  
*         CLEAR *LIFT* INTERLOCK BIT AND RETURN FILE. 
  
 RSF4     LMD    FS+4        CLEAR INTERLOCK FLAG 
          STD    FS+4 
 RSF5     LDD    CM+2        CLEAR PF ACTIVITY FLAG IF PRESENT
          SCN    10 
          STD    CM+2 
          NFA    CN,R        SET FNT ADDRESS
          ADN    FSTL        REWRITE FST WORD 
          CWD    FS 
          ADN    FUTL-FSTL   REWRITE FUT WORD 
          CWD    CM 
 RSF6     LDN    2           DROP *ROFT* + RETURN FLAGS FOR *0DF* 
          STM    /EFX/L0DF-1
          EXECUTE  0DF,/EFX/L0DF  DROP FILE 
          UJN    RSF3        CHECK NEXT FILE
  
          ERRNG  7772-/EFX/L0DF-ZDFL  *0DF* OVERFLOWS PP
 SFX      SPACE  4,10 
**        SFX - SEARCH FOR EXIT.
  
  
 SFX      SUBR               ENTRY/EXIT 
          LDM    CPXS        CHECK EXIT STATUS
          SHN    21-13
          MJN    SFX1        IF *NOEXIT*
          LDD    CP          SET SKIP TO EXIT COMMAND FLAG
          ADN    CSSW 
          CRD    CM 
          LDD    CM 
          LPC    5777 
          LMC    2000 
          STD    CM 
          LDD    CP 
          ADN    CSSW 
          CWD    CM 
 SFX1     LDD    CP          READ JOB CONTROL REGISTERS 
          ADC    JCRW 
          CRD    CM 
          LDD    CM          ENTER ERROR FLAG 
          LPN    77 
          SHN    14 
          LMD    EF 
          SHN    6
          STD    CM 
          SHN    -6 
          LMN    IDET 
          ZJN    SFX2        IF IDLE DOWN PROCESSING
          LDD    CP          STORE JOB CONTROL REGISTERS
          ADC    JCRW 
          CWD    CM 
 SFX2     LJM    SFXX        RETURN 
 SQD      SPACE  4,10 
**        SQD - SET QUEUE FILE DISPOSITION OPTION.
* 
*         SETS THE QUEUED FILE DISPOSITION OPTION IN THE
*         CONTROL POINT AREA END-OF-JOB CONTROL WORD. 
* 
*         ENTRY  (A) = QUEUE FILE DISPOSTION OPTION.
* 
*         USES   CM - CM+4, T1. 
  
  
 SQD      SUBR               ENTRY/EXIT 
          STD    T1          SAVE DISPOSITION OPTION
          LDD    CP          READ END-OF-JOB CONTROL WORD 
          ADK    EOJW 
          CRD    CM 
          STD    T0          SAVE WORD ADDRESS
          LDD    CM          SET OPTION 
          SHN    22-6 
          SCN    7
          LMD    T1 
          SHN    6
          STD    CM 
          LDD    T0          REWRITE WORD 
          CWD    CM 
          UJN    SQDX        RETURN 
 VCA      SPACE  4,15 
**        VCA - VALIDATE CM ADDRESS.
* 
*         VALIDATES AND SETS AN ABSOLUTE CENTRAL MEMORY ADDRESS.
* 
*         ENTRY  (A) = CM ADDRESS RELATIVE TO RA. 
* 
*         EXIT   (A) = ABSOLUTE CM ADDRESS IF WITHIN FL.
*                    = 0 IF ADDRESS OUTSIDE FL. 
*                (T1,T2) = ABSOLUTE CM ADDRESS. 
* 
*         USES   T1, T2.
  
  
 VCA1     LDN    0           SET INCORRECT ADDRESS EXIT CONDITION 
  
 VCA      SUBR               ENTRY/EXIT 
          SHN    14          SET ABSOLUTE ADDRESS 
          ADD    RA 
          SHN    6
          STD    T2          SAVE LOWER 12 BITS 
          SHN    -6 
          SBD    RA          VALIDATE AGAINST RA+FL 
          SBD    FL 
          PJN    VCA1        IF OUT OF RANGE
          ADD    RA          RESTORE ADDRESS
          ADD    FL 
          SHN    -6          STORE UPPER 6 BITS 
          STD    T1 
          SHN    14          SET (A) = ABSOLUTE ADDRESS 
          ADD    T2 
          UJN    VCAX        RETURN 
          SPACE  4,10 
**        RESIDENT COMMON DECKS.
  
  
*CALL     COMPCVI 
          TITLE  OVERLAID PRESET. 
          USE    BUFFERS
  
 EXPA     BSS    0           EXCHANGE PACKAGE BUFFER
 PRS      SPACE  4,20 
**        PRS - PRESET ERROR PROCESSING OVERLAY.
* 
*         ENTRY  (EF) = ERROR FLAG DETECTED OR SET BY 1AJ.
* 
*         EXIT   (A) = RECOVERABILITY STATUS: 
*                    = ZERO IF REPRIEVE/EREXIT NOT POSSIBLE.
*                    .LT. 0 IF IDLE OF SPECIAL SUBSYSTEM. 
*                (TA) = *IAF* RA IF ON-LINE INTERACTIVE JOB.
*                (TN) = TERMINAL NUMBER IF ON-LINE INTERACTIVE JOB. 
*                (CW - CW+4) = ENTRY/EXIT CONTROL WORD. 
*                (CPXS) = CONTROL POINT EXIT STATUS.
* 
*         USES   CM - CM+4, CN - CN+4, CW - CW+4, EF. 
* 
*         CALLS  CSA, CSE, CSF, CSS, CUA, STP.
* 
*         MACROS MONITOR, PAUSE.
  
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    CUA         CHECK USER ACCESS
          STM    DMPB        SAVE USER ACCESS PERMISSION STATUS 
          RJM    STP         SET TERMINAL TABLE POINTER 
          LDD    CP          CHECK FOR NFL ASSIGNED 
          ADK    FLSW 
          CRD    CM 
          LDD    CM 
          SHN    6           SAVE NEGATIVE FL VALUE 
          STM    RSFA 
          NJN    PRS0.1      IF NFL ASSIGNED
          AOM    CJAA 
          LDD    EF 
          SBN    SYET 
          PJN    PRS0.2      IF SHOULD NOT CHANGE ERROR FLAG
          LDN    SYET        SET SYSTEM ABORT ERROR FLAG
          STD    EF 
          UJN    PRS0.2      CONTINUE 
  
 PRS0.1   RJM    CSA         CHECK SHELL ABORT
 PRS0.2   PAUSE              PAUSE FOR RELOCATION 
          LDD    CM+1        CHECK CONTROL POINT ERROR FLAG 
          ZJN    PRS3        IF NO ERROR FLAG AT CONTROL POINT
          SBN    MXET        VALIDATE ERROR FLAG
          MJN    PRS1        IF VALID ERROR FLAG
          LDN    0
          STD    CM+2        SET NO ERROR FLAG
          LDC    *
          STD    CM+1        ADDRESS WHERE ERROR DETECTED 
          MONITOR  CHGM      CONDITIONAL HANG FOR INCORRECT ERROR FLAG
          LDN    SWET        SET SYSTEM SOFTWARE ERROR
          STD    EF 
  
*         CHECK FOR SPECIAL ERROR PROCESSING. 
  
 PRS1     RJM    CSF         CHECK SCR FOR FATAL ERROR
          ZJN    PRS2        IF NOT FATAL ERROR 
          AOM    PERS        FLAG HARDWARE ERROR DETECTED 
          LDN    0           SET (A) STATUS = RECOVERY IMPOSSIBLE 
          UJP    PRSX        RETURN 
  
*         CLEAR ERROR FLAG IN CPA.
  
 PRS2     STD    CM+1 
          MONITOR  CEFM 
  
*         RESET SENSE SWITCHES. 
  
 PRS3     LDD    CP          READ SENSE SWITCH WORD 
          ADN    SNSW 
          CRD    CN 
          ADN    EECW-SNSW   READ ENTRY/EXIT CONTROL
          CRD    CW 
          LDD    EF 
          LMN    TLET 
          NJN    PRS3.1      IF NOT TIME LIMIT
          LDD    CW 
          SHN    21-0 
          PJN    PRS3.1      IF VALIDATION HAS NOT BEEN EXTENDED
          LDN    ZERL 
          CRD    CW 
          LDD    CP          CLEAR EXIT CONTROL 
          ADK    EECW 
          CWD    CW 
          LDN    0
          STD    RF 
 PRS3.1   LDD    FL          CHECK FIELD LENGTH 
          ZJN    PRS4        IF NO FIELD LENGTH ASSIGNED
          LDD    RA          READ RA+0
          SHN    6
          CRD    CM 
          LDD    CN+4        GET CP SENSE SWITCHES
          LPC    7700 
          STD    CM+4        RESET RA+0 SENSE SWITCHES
          LDD    RA          REWRITE RA+0 
          SHN    6
          CWD    CM 
  
*         CLEAR PAUSE BIT IN CONTROL POINT AREA.
  
 PRS4     LDD    CN+3        CLEAR PAUSE BIT
          SCN    1
          STD    CN+3 
          LDD    CP          REWRITE SENSE SWITCH WORD
          ADN    SNSW 
          CWD    CN 
  
*         CHECK FOR IDLEDOWN OF SPECIAL SUBSYSTEM.
  
          LDD    EF 
          LMK    IDET 
          NJN    PRS5        IF NOT SUBSYSTEM IDLEDOWN
          RJM    CSS         CHECK FOR SPECIAL SUBSYSTEM
          MJN    PRS6        IF SPECIAL SUBSYSTEM 
  
*         RETURN REPRIEVE/EREXIT PERMISSION STATUS. 
  
 PRS5     LDM    TROF,EF
          LMK    /COMSRPV/TICL
          ZJN    PRS5.1      IF USER BREAK
          LDD    CP          CHECK ERROR PROCESSING LIMIT 
          ADK    ACLW 
          CRD    CM 
          LDD    CM 
          LMC    7777B
          ZJN    PRS5.1      IF UNLIMITED ERROR PROCESSING SET
          SOD    CM 
          MJN    PRS7        IF NO MORE RETRIES POSSIBLE
          LDD    CP 
          ADK    ACLW 
          CWD    CM 
 PRS5.1   LDD    CW          SET CP EXIT STATUS 
          STM    CPXS 
          LDD    EF 
          SBN    NRET 
          SHN    0-21 
 PRS6     LJM    PRSX        RETURN 
  
 PRS7     LDC    =C* ERROR PROCESSING LIMIT.* 
          RJM    DFM
          LDN    0
          STD    CW          TURN OFF REPRIEVE OPTIONS
          STD    RF 
          UJN    PRS6        RETURN 
 CSA      SPACE  4,10 
***       CSA - CHECK *SHELL* ABORT.
* 
*         EXIT   NFL WORD *SHCN* CLEARED IF *SHELL* ABORT 
*                AND ABORT FLAG SET IN *SHCN*.
* 
*         USES   CM - CM+4. 
  
  
 CSA      SUBR               ENTRY/EXIT 
          NFA    SHCN        CHECK *SHELL* IN EXECUTION 
          CRD    CM 
          LDD    CM+4 
          SHN    21-13
          PJN    CSAX        IF *SHELL* NOT IN EXECUTION
          SHN    21-6-21+13 
          PJN    CSAX        IF CONTROL NOT TO BE CLEARED 
          LDN    ZERL 
          CRD    CM 
          NFA    SHCN 
          CWD    CM 
          UJN    CSAX        RETURN 
 CSS      SPACE  4,10 
**        CSS - CHECK FOR SPECIAL SUBSYSTEM.
* 
*         EXIT   (A) .LT. 0 IF SPECIAL SUBSYSTEM. 
* 
*         USES   T1, CM - CM+4. 
  
  
 CSS      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADN    JCIW 
          CRD    CM 
          LDC    CSSA-1      SET TABLE ADDRESS
          STD    T1 
 CSS1     AOD    T1          CHECK NEXT TABLE ENTRY 
          LDI    T1 
          ZJN    CSSX        IF END OF TABLE
          LMD    CM+2 
          NJN    CSS1        IF NOT A MATCH 
          AOM    IDLA        SET SPECIAL SUBSYSTEM FLAG 
          LCN    1           SET SPECIAL SUBSYSTEM STATUS 
          UJN    CSSX        RETURN 
  
  
 CSSA     BSS    0           TABLE OF SPECIAL SUBSYSTEMS
          CON    BISI        *BATCHIO*
          CON    MTSI        *MAGNET* 
          CON    ASSI        *MSE*
          CON    MFSI        *MSS*
          CON    SMSI        *SMF*
          CON    TRSI        *TAF*
          CON    0           END OF TABLE 
          TITLE  OVERLAID PRESET SUBROUTINES. 
 STP      SPACE  4,10 
**        STP - SET TERMINAL TABLE POINTER. 
* 
*         ENTRY  (TSTN) = TERMINAL NUMBER IF ON-LINE INTERACTIVE JOB
*                         AND *IAF* IS ACCESSIBLE.
* 
*         USES   CM - CM+4. 
* 
*         NOTE   TERMINAL TABLE POINTER NO LONGER SET.
  
  
 STP      SUBR               ENTRY/EXIT 
          LDD    CP          READ TERMINAL INPUT POINTER
          ADK    TINW 
          CRD    CM 
          LDD    EF 
          LMN    TIET 
          ZJP    STP2        IF USER BREAK ONE
          LMN    TAET&TIET
          ZJP    STP2        IF USER BREAK TWO
          LDD    CM+3 
          SCN    77 
          SHN    6
          LMD    CM+2 
          SHN    6
          ZJP    STPX        IF NO TERMINAL INPUT FET 
          STM    STPA 
          SHN    -14
          RAM    STPA-1 
          LDD    CM+2 
          SBD    FL 
          PJN    STP1.1      IF FET ADDRESS OUT OF RANGE
          LDD    RA 
          SHN    6
          ADC    ** 
 STPA     EQU    *-1
          CRM    STPB,ON     READ FET+0 
          LDM    STPB+4      COMPLETE FET 
          SCN    1
          LMN    1
          STM    STPB+4 
          LDM    STPA-1 
          LPN    77 
          SHN    6
          ADD    RA 
          SHN    6
          ADM    STPA 
          CWM    STPB,ON
 STP1.1   UJN    STP3        CLEAR FET ADDRESS
  
 STP2     LDD    CM+3 
          SCN    77 
          SHN    6
          LMD    CM+2 
          ZJP    STPX        IF NO TERMINAL INPUT PENDING 
          SHN    6           SAVE TERMINAL INPUT POINTER
          STM    RIPA 
          SHN    -14
          RAM    RIPA-1 
 STP3     LDN    0
          STD    CM+2 
          LDD    CM+3 
          LPN    77 
          STD    CM+3 
          LDD    CP 
          ADK    TINW 
          CWD    CM 
          LJM    STPX        RETURN 
  
 STPB     BSS    5
          SPACE  4,10 
**        PRESET EXECUTABLE COMMON DECKS. 
  
  
*CALL     COMPCUA 
  
  
          OVERFLOW /PEF/PEFX
          TTL    1AJ/3AL - ERROR PROCESSING EXTENSION.
          TITLE 
          QUAL   EFX
          IDENT  3AL,ENTX    ERROR PROCESSING EXTENSION.
*COMMENT  1AJ - ERROR PROCESSING EXTENSION. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       *3AL* IS AN EXTENSION TO OVERLAY *3AB*. 
*         TO MAINTAIN DOCUMENTATION CONSISTENCY ALL ERROR MESSAGES
*         WILL BE DOCUMENTED AT THE BEGINNING OF *3AB*. 
 ENT      SPACE  4,10 
          ORG    /PEF/EXPA+5
 ENT      SUBR               ENTRY/EXIT 
          UJN    ENTX        RETURN 
 DRE      SPACE  4,10 
**        DRE - DEADSTART RERUN PROCESSOR.
* 
*         SETS THE JOB TERMINATION STATUS OF NON-INTERACTIVE
*         JOB TO *RJJP*, ISSUES RERUN ACCOUNT FILE MESSAGE, 
*         AND ADVANCES JOB TO THE NEXT *EXIT* COMMAND.
* 
*         CALLS  DFM, RSF, SEJ. 
  
  
 DRE      BSS    0           ENTRY
          LDN    RJJT        SELECT RERUN OPTION
          RJM    /PEF/SEJ    SET END OF JOB OPTION
          LDC    DREA+ACFN   ISSUE ACCOUNT FILE MESSAGE 
          RJM    DFM
          RJM    /PEF/RSF    RETURN SPECIAL FILES 
          LJM    /PEF/EBCX   EXIT 
  
 L0DF     EQU    *+1         *0DF* LOAD ADDRESS 
  
  
 DREA     DATA   C*AERR, DS.* 
 IDL      SPACE  4,15 
**        IDL - IDLEDOWN SUBSYSTEM. 
* 
*         IF JOB IS A SPECIAL SUBSYSTEM (*BATCHIO*, *MAGNET*, *SMF*,
*         *MSS* OR *TAF*), THE SUBSYSTEM IDLEDOWN FLAG (BIT 2**15 OF
*         RA+0 AND BIT 2**15 OF CONTROL POINT AREA WORD *SNSW*) WILL
*         BE SET.  IF THE JOB IS NOT A SPECIAL SUBSYSTEM, IT WILL BE
*         ABORTED WITH THE *ODET* ERROR FLAG. 
* 
*         EXIT   TO *STC* TO RESTART JOB. 
* 
*         USES   CM - CM+4, EF. 
* 
*         CALLS  DFM. 
  
  
 IDL      LDC    =C* OPERATOR IDLEDOWN.*
          RJM    DFM         ISSUE DAYFILE MESSAGE
          LDD    RA          READ RA+0
          SHN    6
          CRD    CM 
          LDD    CM+3        SET IDLEDOWN FLAG IN (RA)
          SCN    10 
          LMN    10 
          STD    CM+3 
          LDD    RA          REWRITE RA+0 
          SHN    6
          CWD    CM 
          LDD    CP          READ CPA WORD *SNSW* 
          ADK    SNSW 
          CRD    CM 
          LDD    CM+3        SET IDLEDOWN FLAG IN CPA 
          SCN    10 
          LMN    10 
          STD    CM+3 
          LDD    CP          REWRITE CPA WORD *SNSW*
          ADK    SNSW 
          CWD    CM 
          ADK    CSSW-SNSW   READ CPA WORD *CSSW* 
          CRD    CM 
          LDD    CM          CLEAR *SKIP-TO-EXIT* FLAG
          LPC    5777 
          STD    CM 
          LDD    CP          WRITE CPA WORD *CSSW*
          ADK    CSSW 
          CWD    CM 
          LJM    /PEF/STC    RESTART CPU
 ARI      SPACE  4,10 
**        ARI - PROCESS CPU ERROR EXIT. 
* 
*         SEND DAYFILE MESSAGE FOR ERROR MODE AND ADDRESS.
* 
*         EXIT   TO *DMP* TO DUMP PROGRAM.
*                TO *TRJ* IF TO TERMINATE JOB.
  
  
 ARI      LDD    RA          READ (RA)
          SHN    6
          CRD    CN 
          CRM    IBMA+12,ON 
          LDD    CN+1        CONVERT ADDRESS
          SHN    -6 
          RJM    C2D
          STM    ARIC 
          LDD    CN+1 
          RJM    C2D
          STM    ARIC+1 
          LDD    CN+2 
          SHN    -6 
          RJM    C2D
          STM    ARIC+2 
          LDC    ARIB        ISSUE ERROR MESSAGE
          RJM    DFM
          LDC    ARID-1 
          STD    T4 
          LDD    CP          CHECK PSD
          ADN    3
          CRD    CM 
          CRD    AB 
          LDN    0           CLEAR PSD CONDITION BITS 
          STD    AB+1 
          LDD    CP 
          ADN    3
          CWD    AB 
          LDD    CM 
          LPN    7
          RAM    ARIA 
          LDD    CM+1 
          LPC    7770 
 ARIA     EQU    *-1
          NJN    ARI1        IF PSD ERRORS
          LJM    ARI5        CONTINUE CHECKING FOR CAUSE
  
 ARI1     STD    T3 
          LDN    0
          STD    T5 
 ARI2     AOD    T4          ADVANCE ERROR INDEX
          LDD    T3          CHECK ERROR BIT
          ZJN    ARI3        IF NO MORE ERRORS
          SHN    21 
          STD    T3 
          PJN    ARI2        IF NO ERROR
          LDI    T4          SEND ERROR MESSAGE 
          RJM    DFM
          UJN    ARI2        CHECK FOR MORE ERRORS
  
 ARI2.1   LJM    /PEF/DMP    EXIT TO DUMP PROGRAM 
  
 ARI3     LDC    ARIE-1      SET UP FOR SECOND SECTION
          STD    T4 
          LDD    T5          CHECK FOR MORE ERRORS
          NJN    ARI1        IF MORE ERRORS TO PROCESS
  
*         PROCESS *PEET* ERROR. 
  
 ARI3.1   LDD    EF 
          LMN    PEET 
          NJN    ARI2.1      IF NOT PARITY ERROR
          LDK    SSTL        CHECK SYSTEM DEBUG ENABLED 
          CRD    CM 
          LDD    CM+3 
          SHN    21-1 
          PJN    ARI3.3      IF SYSTEM DEBUG ENABLED
 ARI3.2   LDN    0           VERIFY THIS CONTROL POINT-S FL 
          STD    CM+1 
          MONITOR  VFLM 
          LDD    CM+1 
          ZJN    ARI4        IF FL VERIFICATION SUCCESSFUL
          SHN    21-0 
          MJN    ARI3.3      IF FL VERIFICATION FAILED
          DELAY 
          UJN    ARI3.2      FUNCTION WAS IN USE, GO RETRY
  
 ARI3.3   LDD    CP 
          ADN    MS1W 
          CWM    ARIH,TR
          LDM    /PEF/PERS   HARDWARE ERROR FLAG
          RAM    ADJA        SET PARITY ERROR FLAG
          LJM    /PEF/TRJ    TERMINATE JOB
  
 ARI4     LDM    /PEF/PERS
          ZJN    ARI4.0      IF ERROR FLAG ALREADY CLEARED IN *3AB* 
          LDN    ZERL        CLEAR ERROR FLAG 
          CRD    CM 
          MONITOR  CEFM 
 ARI4.0   RJM    /PEF/ESB    EMPTY STATEMENT BUFFER 
          LDM    TSTN 
          NJN    ARI4.1      IF ON-LINE INTERACTIVE JOB 
          LDN    HRJT        SELECT HARDWARE RERUN OPTION 
          RJM    /PEF/SEJ    SET END OF JOB OPTION
 ARI4.1   LJM    /PEF/EBCX   EXIT 
  
 ARI5     LDK    MABL        CHECK FOR CYBER 170-8X5
          CRD    CM 
          LDD    CM+1 
          SHN    21-13
          MJN    ARI5.2      IF NOT A CYBER 170-8X5 
          SHN    21-6-21+13 
          PJN    ARI5.2      IF CYBER 170-865/875 
          AOM    TERA        FORCE SYSTEM CHECKPOINT IF PROCESSOR ERROR 
          LDD    CN 
          LMN    20 
          ZJN    ARI5.1      IF PROCESSOR DETECTED MALFUNCTION
          LMN    67&20
          NJN    ARI5.2      IF NOT HARDWARE MALFUNCTION
          LDC    ARIF&ARIG
 ARI5.1   LMC    ARIF 
          RJM    DFM
          RJM    IBM         ISSUE BML MESSAGE
          LJM    ARI3.1      CONTINUE 
  
 ARI5.2   LDD    CN          CONVERT ERROR CODES
          LPN    1           CM RANGE ERROR 
          SHN    6-0
          STD    T3 
          LDD    CN 
          LPN    6           ARITHMETIC OVERFLOW AND INDEFINITE 
          RAD    T3 
          LDD    CN 
          SHN    -3 
          LPN    3           FLAG REGISTER PARITY AND CMC PARITY
          STD    T5 
          LDD    CN 
  
*         THE FOLLOWING MASK ALLOWS FOR THE CASE IN WHICH 
*         A 6000-SERIES CPU STORES THE RETURN INSTRUCTION 
*         *EQ  ADDR* INTO RA+0 AND THEN INTERPRETS THE ZERO WORD
*         AT SYSTEM REQUEST AS A PROGRAM STOP.
  
          LPN    77          EXTRACT BITS 53-48 
          NJN    ARI6        IF NOT INCORRECT INSTRUCTION 
          LDN    4
          RAD    T5 
 ARI6     LDD    CN 
          LPN    40          CM PARITY
          SHN    12-5 
          RAD    T3 
          NJN    ARI7        IF ERRORS IN FIRST SECTION 
          LDC    ARIE-1      SET UP FOR ERRORS IN SECOND SECTION
          STD    T4 
          LDD    T5 
          LJM    ARI1        PROCESS SECOND SECTION ERRORS
  
 ARI7     LJM    ARI2        ISSUE ERROR MESSAGES 
  
  
 ARIB     DATA   H* CPU ERROR EXIT AT * 
 ARIC     DATA   C*000000.* 
  
 ARID     BSS    0
          CON    =C* ARITHMETIC UNDERFLOW.* 
          CON    =C* ARITHMETIC OVERFLOW.*
          CON    =C* ARITHMETIC INDEFINITE.*
          CON    =C* STEP CONDITION.* 
          CON    =C* BREAKPOINT CONDITION.* 
          CON    =C* PROGRAM STOP.* 
          CON    =C* CM OUT OF RANGE.*
          CON    =C* EXTENDED MEMORY OUT OF RANGE.* 
          CON    =C* CM BLOCK OUT OF RANGE.*
          CON    =C* EXTENDED MEMORY BLOCK OUT OF RANGE.* 
          CON    =C* CM PARITY ERROR.*
          CON    =C* EXTENDED MEMORY PARITY ERROR.* 
  
 ARIE     CON    =C* EXTENDED MEMORY FLAG REGISTER PARITY.* 
          CON    =C* CMC PARITY ERROR.* 
          CON    =C* INCORRECT INSTRUCTION.*
  
 ARIF     DATA   C* PROCESSOR DETECTED MALFUNCTION.*
 ARIG     DATA   C* PROCESSOR STATE ERROR.* 
 ARIH     DATA   C* PARITY ERROR, JOB HUNG.*
 CML      SPACE  4,15 
**        CML - PROCESS COMMAND LIMIT.
* 
*         EXIT   TO */PEF/TRJ* IF INITIAL COMMAND LIMIT FLAG HAS
*                ALREADY BEEN SET.
*                TO */PEF/ECBX* IF INITIAL COMMAND LIMIT. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 CML      BSS    0           ENTRY
          LDD    CP          CHECK COMMAND LIMIT FLAG 
          ADN    ACTW 
          CRD    CM 
          LDD    CM 
          SHN    21-7 
          MJN    CML1        IF COMMAND LIMIT PREVIOUSLY OCCURRED 
          LDN    2           SET COMMAND LIMIT FLAG AND INCREMENT 
          STD    CM+1 
          LDN    1
          STD    CM+2 
          LDD    MA 
          CWM    CMLA,CM+1
          MONITOR  UADM 
          LDC    CMLB        * INITIAL COMMAND LIMIT.*
          RJM    DFM
          LJM    /PEF/EBCX   RETURN 
  
 CML1     LDC    CMLC        * COMMAND LIMIT.*
          RJM    DFM
          LJM    /PEF/TRJ    EXIT TO ABORT JOB
  
  
 CMLA     CON    CICS        INCREMENT CP AREA LIMIT FIELD
          CON    ACLW        RELATIVE CP AREA ADDRESS OF LIMIT FIELD
          CON    24D*100+12D POSITION AND WIDTH OF LIMIT FIELD
          CON    0,DCLI      INCREMENT VALUE
  
          CON    CIOS        INCREMENT CP AREA LIMIT FIELD BY ONE 
          CON    ACTW        RELATIVE CP AREA ADDRESS OF LIMIT FIELD
          CON    55D*100+1   POSTION AND WIDTH OF LIMIT FIELD 
          CON    0,0
  
 CMLB     DATA   H* INITIAL*
 CMLC     DATA   C* COMMAND LIMIT.* 
 IBM      SPACE  4,10 
**        IBM - ISSUE *BML* MESSAGE.
* 
*         ENTRY  (CN - CN+4) = RA+0.
* 
*         EXIT   *BML* MESSAGE ISSUED.
* 
*         USES   CM - CM+4. 
  
  
 IBM      SUBR               ENTRY/EXIT 
          LDN    PPCP        STORE LOGICAL PP NUMBER BEING USED 
          CRD    CM 
          LDD    IA 
          SBD    CM+4 
          SHN    -3 
          SHN    6
          STM    IBMA+2 
          LDC    MMFL        READ MACHINE ID
          CRD    CM 
          LDD    CM 
          STM    IBMA+10
          LDD    CN 
          LMN    67 
          NJN    IBM1        IF NOT MODE 67 ERROR 
          AOM    IBMA+1      SYMPTOM CODE 
 IBM1     LDD    CN+2        READ (P) 
          SCN    77 
          SHN    6
          LMD    CN+1 
          ADD    RA 
          SHN    6
          CRM    IBMA+17,ON 
          LDN    ZERL 
          CRD    CM 
          LDN    4*5         SET BYTE COUNT FOR *BML* MESSAGE 
          STD    CM+1 
          LDC    IBMA+BMLN   ISSUE BML MESSAGE
          RJM    DFM
          LJM    IBMX        RETURN 
  
 IBMA     VFD    12/250B,12/1011B,6/0,6/17B,24/0
          VFD    36/0,12/0,12/0 
          VFD    60/0 
          VFD    60/0 
 MSL      SPACE  4,10 
**        MSL - PROCESS MESSAGE LIMIT ERROR.
* 
*         EXIT   TO */PEF/TRJ* IF INITIAL MESSAGE LIMIT FLAG HAS
*                ALREADY BEEN SET.
*                TO */PEF/ECBX* IF INITIAL MESSAGE LIMIT. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 MSL      BSS    0           ENTRY
          LDD    CP          READ ACCOUNTING LIMIT FLAGS
          ADN    ACTW 
          CRD    CM 
          LDD    CM          CHECK INITIAL MESSAGE LIMIT
          SHN    21-6 
          PJN    MSL1        IF INITIAL MESSAGE LIMIT 
          LDC    MSLC        * MESSAGE LIMIT.*
          RJM    DFM
          LJM    /PEF/TRJ    TERMINATE JOB
  
 MSL1     LDN    1           SETUP *UADM* CALL
          STD    CM+2 
          LDN    2
          STD    CM+1 
          LDD    MA          STORE *UADM* PARAMETERS
          CWM    MSLA,CM+1
          MONITOR  UADM      INCREMENT MESSAGE LIMIT
          LDC    MSLB        * INITIAL MESSAGE LIMIT.*
          RJM    DFM
          LJM    /PEF/EBCX   RETURN 
  
  
 MSLA     CON    CICS        INCREMENT CP AREA FIELD
          CON    ACLW        CP AREA WORD 
          CON    36DS6+12D   LOCATION WITHIN WORD + FIELD WIDTH 
          CON    0,DMLI      INCREMENT VALUE
  
          CON    CIOS        INCREMENT CP AREA FIELD BY ONE 
          CON    ACTW        CP AREA WORD 
          CON    54DS6+1     LOCATION WITHIN WORD + FIELD WIDTH 
          CON    0,0
  
 MSLB     DATA   H* INITIAL*
 MSLC     DATA   C* MESSAGE LIMIT.* 
 MCL      SPACE  4,10 
**        MCL - MONITOR CALL PROCESSOR. 
* 
*         CALLS  C2D, DFM.
  
  
 MCL      LDD    RA          READ SYSTEM REQUEST
          SHN    6
          ADN    1
          CRD    CM 
          LDC    /PEF/EXPA+6 SET BUFFER ADDRESS 
          STD    T3 
          LDN    CM          SET BYTE ADDRESS 
          STD    T2 
 MCL1     LDI    T2          REPLACE BLANKS WITH SPACES 
          SCN    77 
          NJN    MCL2        IF UPPER CHARACTER NOT ZERO
          LDN    1R 
          SHN    6
 MCL2     STD    T0 
          LDI    T2 
          LPN    77 
          NJN    MCL3        IF LOWER CHARACTER NOT ZERO
          LDN    1R 
 MCL3     LMD    T0 
          STM    /PEF/EXPA-CM,T2
          LDI    T2          CONVERT DATA 
          SHN    -6 
          RJM    C2D
          STI    T3 
          AOD    T3 
          LDI    T2 
          RJM    C2D
          STI    T3 
          AOD    T3 
          AOD    T2 
          LMN    CM+5 
          NJN    MCL1        IF MORE BYTES TO CONVERT 
          STI    T3 
          LDC    2R 
          STM    /PEF/EXPA-CM,T2
          LDC    /PEF/EXPA   ISSUE SYSTEM REQUEST TO DAYFILE
          RJM    DFM
          LDC    MCLA 
          RJM    DFM         ISSUE *MONITOR CALL ERROR.* TO THE DAYFILE 
          LJM    /PEF/EBCX   RETURN 
  
  
 MCLA     DATA   C* MONITOR CALL ERROR.*
 ORE      SPACE  4,15 
**        ORE - PROCESS OPERATOR OVERRIDE.
* 
*         SETS UNCONDITIONAL TERMINATION MODE AND TERMINATES JOB. 
* 
*         ENTRY  (JO) = EJT ORDINAL.
* 
*         EXIT   TO *TRJ*.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR, SFA.
  
  
 ORE      BSS    0           ENTRY
          LDN    ZERL        SET *UCTM* STATUS
          CRD    CM 
          LDN    1
          STD    CM+1 
          SFA    EJT,JO      CALCULATE EJT ENTRY ADDRESS
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          LDD    MA          WRITE PARAMETER TO MESSAGE BUFFER
          CWM    OREA,ON
          MONITOR  UTEM 
          LJM    /PEF/TRJ    TERMINATE JOB
  
 OREA     VFD    1/0,5/SCHE,6/2,6/33D,42/UCTM 
 PPA      SPACE  4,10 
**        PPA - PROCESS PP ABORT. 
* 
*         EXIT   TO *DMP1* TO PROCESS DUMP. 
*                TO *EBCX* IF NO DUMP REQUIRED. 
* 
*         CALLS  CPD. 
  
  
 PPA      BSS    0           ENTRY
          LDD    CP          CHECK IF *DMP* REQUIRED
          ADC    PPDW 
          CRD    CM 
          LDD    CM+3 
          ADD    CM+4 
          NJN    PPA1        IF PP DUMP CALL
          LJM    /PEF/EBCX   RETURN 
  
 PPA1     LDD    CM+3        SET DUMP CALL
          LPN    77 
          SHN    14 
          ADD    CM+4 
          SHN    14 
          STM    /PEF/DMPA+2
          SHN    -6 
          SCN    77 
          STM    /PEF/DMPA+3
          LDD    CM+3 
          SHN    14 
          ADD    CM+4 
          STM    /PEF/DMPA+4
          SHN    -14
          RAM    /PEF/DMPA+3
          RJM    /PEF/CPD    CLEAR PP DUMP WORD 
          LJM    /PEF/DMP1   PROCESS *DMP* CALL 
 PST      SPACE  4,10 
**        PST - PROGRAM STOP PROCESSOR. 
* 
*         SEND ADDRESS MESSAGE. 
* 
*         EXIT TO *DMP*.
* 
*         CALLS  C2D, DFM.
  
  
 PST      BSS    0           ENTRY
          LDD    CP          READ EXCHANGE PACKAGE P-REGISTER 
          CRD    CM 
          LDD    CM          CONVERT ADDRESS
          RJM    C2D
          STM    PSTB 
          LDD    CM+1 
          SHN    -6 
          RJM    C2D
          STM    PSTB+1 
          LDD    CM+1 
          RJM    C2D
          STM    PSTB+2 
          LDC    PSTA        ERROR MESSAGE TO DAYFILE 
          RJM    DFM
          LJM    /PEF/DMP    EXIT TO DMP
  
  
 PSTA     DATA   H* PROGRAM STOP AT * 
 PSTB     DATA   C*000000.* 
 TLE      SPACE  4,10 
**        TLE - TIME LIMIT ERROR PROCESSOR. 
* 
*         CLEAR TIME LIMIT FLAGS BEFORE ADVANCING TO THE NEXT JOB STEP. 
* 
*         EXIT   TO *EBCX*. 
  
  
 TLE      BSS    0           ENTRY
          LDD    CP          CLEAR THE TIME LIMIT FLAGS 
          ADN    SRUW 
          CRD    CM 
          LDD    CM 
          LPC    1777 
          STD    CM 
          LDD    CP          RESTORE *SRUW* 
          ADN    SRUW 
          CWD    CM 
          LJM    /PEF/EBCX   RETURN 
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMPC2D 
  
          USE    BUFFERS
  
  
          OVERFLOW  /EFX/ENTX 
          TTL    1AJ/3AN - CHECK ERROR RETURN.
          TITLE 
          QUAL   CER
          IDENT  3AN,ENTX    CHECK ERROR RETURN 
*COMMENT  1AJ - ERROR RETURN PROCESSOR. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE 4,10
***       *3AN* IS AN EXTENSION TO OVERLAY *3AB*. 
*         TO MAINTAIN DOCUMENTATION CONSISTENCY ALL ERROR MESSAGES
*         WILL BE DOCUMENTED AT THE BEGINNING OF *3AB*. 
  
  
          ORG    /PEF/EXPA+5
 ENT      SUBR               ENTRY/EXIT 
          UJN    ENTX        RETURN 
 CER      SPACE  4,10 
**        CER - CHECK ERROR RETURN. 
* 
*         ENTRY  (T1) = REPRIEVE BLOCK LENGTH, NON-EXTENDED REPRIEVE. 
*                (T1) = 0, IF ERROR EXIT. 
*                (CW - CW+4) = EXIT CONTROL WORD. 
* 
*         EXIT   TO *RIJ* TO RESTART JOB IF POSSIBLE. 
* 
*         USES   CW+1, CW+3, CW+4, T6, T7, CM - CM+4. 
* 
*         CALLS  /PEF/CJS, DFM, PEX, PRP. 
  
  
 CER3     LDC    =C* INCORRECT ERROR EXIT ADDRESS.* 
          RJM    DFM
 CER4     LDN    0           CLEAR ERROR EXIT ADDRESS/REPRIEVE OPTIONS
          STD    CW+1 
          STD    CW+4 
          LDD    CW+3 
          SCN    77 
          STD    CW+3 
          LDD    CP 
          ADN    EECW 
          CWD    CW 
  
 CER      SUBR               ENTRY/EXIT 
          LDD    CW+3        SAVE ERROR ADDRESS 
          LPN    77 
          STD    T6 
          SHN    14 
          MJN    CER4        IF JOB PREVIOUSLY REPRIEVED
          LDD    CW+4 
          STD    T7 
          RJM    /PEF/CJS    CHECK JOB STATUS 
          ZJN    CER4        IF JOB STEP COMPLETE 
          LDD    T6 
          SHN    14          CHECK IF VALID ADDRESS 
          LMD    T7 
          SBN    2
          MJN    CER3        IF INCORRECT ADDRESS 
          ADN    2
          ADD    T1 
          SHN    -6 
          SBD    FL 
          PJP    CER3        IF ADDRESS OUTSIDE FL
          LDD    RF 
          NJN    CER1        IF REPREIVE
          LDD    EF 
          LMN    CPET 
          ZJN    CERX        IF CPU ABORT 
          LMN    RRET&CPET
          ZJN    CERX        IF RERUN 
          RJM    PEX         PROCESS EXIT 
          UJN    CER2        RESET (P)
  
 CER1     RJM    PRP         PROCESS REPRIEVE 
          ZJN    CER2        IF REPRIEVE POSSIBLE 
          LJM    CER4        CLEAR OPTIONS
  
 CER2     LDD    CP          RESET (P)
          CRD    CM 
          LDD    T6 
          STD    CM 
          LDD    T7 
          STD    CM+1 
          LDD    CP          STORE (P)
          CWD    CM 
          LDN    ZERL        CLEAR SYSTEM REQUEST 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    1
          CWD    CM 
          LJM    /PEF/RIJ    RESTART JOB
 PEX      SPACE  4,10 
**        PEX - PROCESS EXIT. 
* 
*         ENTRY  (CW - CW+4) = ERROR EXIT CONTROL WORD. 
*                (T6 - T7) = ERROR EXIT ADDRESS.
* 
*         EXIT   (CW - CW+4) = UPDATED. 
*                (T6 - T7) = ADDRESS TO SET (P) TO. 
* 
*         USES   CW+3, CW+4, T1 - T3, CM - CM+4.
  
  
 PEX      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR EXIT ADDRESS 
          STD    CW+4 
          LDD    CW+3 
          SCN    77 
          STD    CW+3 
          LDD    CP          READ (P) 
          CRD    T1 
          LDD    RA          READ (RA)
          SHN    6
          CRD    CM 
          LDD    CM+2        ENTER ERROR FLAG 
          SCN    77 
          LMD    EF 
          STD    CM+2 
          LPN    77 
          LMN    ARET 
          ZJN    PEX1        IF ARITHMETIC ERROR
          LDD    T1          SET (P) IN (RA)
          SHN    14 
          LMD    T1+1 
          SHN    14 
          STD    CM+1 
          SHN    -6 
          SCN    77 
          LMD    EF 
          STD    CM+2 
 PEX1     LDD    RA          STORE (RA) 
          SHN    6
          CWD    CM 
          LJM    PEXX        RETURN 
 PRP      SPACE  4,15 
**        PRP - PROCESS REPRIEVE. 
* 
*         ENTRY  (CW - CW+4) = ERROR EXIT CONTROL WORD. 
*                (T6 - T7) = ERROR EXIT ADDRESS.
* 
*         EXIT   (CW - CW+4) = UPDATED. 
*                (T6 - T7) = ADDRESS TO SET (P) TO. 
*                (A) = 0, REPRIEVE POSSIBLE.
* 
*         USES   CW+1, CW+3, T6, T7, T1 - T5, CN - CN+4.
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 PRP      SUBR               ENTRY/EXIT 
          LDM    /PEF/TROF,EF  CHECK IF THIS ERROR SELECTED 
          STM    PRPA 
          LMD    RF 
          LPC    *
 PRPA     EQU    *-1
          NJN    PRPX        IF OPTION NOT SELECTED 
          LDD    T6 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    T7 
          CRD    T1 
          ADN    1           READ CHECKSUM
          CRD    CN 
          LDD    T6          SET FWA OF CHECK SUM AREA
          SHN    14 
          LMD    T7 
          ADN    21 
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          LDD    T1+2        SET WORD COUNT FOR CHECK SUM AREA
          SCN    77 
          SHN    6
          LMD    T1+1 
          LPC    773777 
          ZJP    PRP1        IF NO CHECKSUM REQUIRED
          SBD    FL 
          SHN    6
          PJN    PRP0.1      IF LWA .GE. FL 
          SHN    14 
          ADD    FL 
          SHN    6
          SBD    CM+4 
          MJN    PRP0.1      IF LWA .LT. FWA
          STD    CM+2 
          SHN    -14
          SBD    CM+3 
          STD    CM+1 
          MJN    PRP0.1      IF LWA .LT. FWA
          LDD    MA          SET PREVIOUS CHECKSUM FOR CALL 
          CWD    CN 
          MONITOR  CKSM      CHECK PROGRAM CHECKSUM 
          LDD    CM+4 
          ZJN    PRP1        IF GOOD CHECKSUM 
          LDC    =C* REPRIEVE CHECKSUM BAD.*
 PRP0     RJM    DFM
          LDN    1
          LJM    PRPX        RETURN 
  
 PRP0.1   LDC    =C* REPREIVE BLOCK ERROR.* 
          UJN    PRP0        ISSUE ERROR MESSAGE
  
 PRP1     LDD    EF          SAVE ERROR FLAG FOR RESET
          LMC    4000 
          STD    CW+1 
          LDN    40          SET FLAG FOR EXCHANGE PACKAGE ADDRESS
          RAD    CW+3 
          LDN    21          SET PROPER VALUE OF (P)
          RAD    T7 
          SHN    -14
          RAD    T6 
          LDN    20          READ EXCHANGE PACKAGE
          STD    T1 
          LDD    CP 
          CRM    EXPA,T1
          LDM    /PEF/TCEC,EF  SET EQUIVALENT ERROR FLAG
          NJN    PRP2        IF NOS/BE EQUIVALENT 
          LDD    EF 
 PRP2     STM    EXPA+4 
          LDD    RA          READ SYSTEM REQUEST
          SHN    6
          ADN    1
          CRD    CM 
          LDD    CW+3        STORE EXCHANGE PACKAGE 
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CW+4 
          CWM    EXPA,T1
          CWD    CM          STORE SYSTEM REQUEST 
          LDM    PRPB,EF     ISSUE MESSAGE
          ZJN    PRP3        IF NO MESSAGE
          RJM    DFM
 PRP3     LDC    =C* JOB REPRIEVED.*
          RJM    DFM
*         LDN    0           SET JOB REPRIEVE 
          LJM    PRPX        RETURN 
  
  
*         TABLE OF MESSAGES TO BE ISSUED ON REPRIEVE PROCESSING.
  
 PRPB     INDEX 
  
          INDEX  0,(=C* REPRIEVED NORMAL TERMINATION.*) 
          INDEX  TLET,(=C* TIME LIMIT.*)
          INDEX  ARET,(=C* MODE ERROR.*)
          INDEX  PPET,(=C* PPU ABORT.*) 
          INDEX  CPET,(=C* CPU ABORT.*) 
          INDEX  PCET,(=C* PP CALL ERROR.*) 
          INDEX  ODET,(=C* OPERATOR DROP.*) 
          INDEX  PSET,(=C* PROGRAM STOP.*)
          INDEX  SYET,(=C* SYSTEM ABORT.*)
          INDEX  PEET,(=C* MODE ERROR.*)
          INDEX  ORET,(=C* OPERATOR OVERRIDE.*) 
          INDEX  SSET,(=C* SUBSYSTEM ABORTED.*) 
          INDEX  OKET,(=C* OPERATOR KILL.*) 
          INDEX  ITET,(=C* SCP INCORRECT TRANSFER ADDRESS.*)
          INDEX  MXET 
 PRP      SPACE  4,10 
          USE    BUFFERS
  
  
 EXPA     BSS    0           EXCHANGE PACKAGE BUFFER
 EXPL     EQU    EXPA+20*5   END OF BUFFER
  
  
          OVERFLOW  /CER/ENTX 
          TTL    1AJ/TCS - TRANSLATE COMMAND. 
          TITLE 
          QUAL   TCS
          IDENT  TCS,TCSX    TRANSLATE COMMAND. 
*COMMENT  1AJ - TRANSLATE COMMAND.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       TCS - TRANSLATE COMMAND.
* 
*         *TCS* TRANSLATES COMMANDS IN THE FOLLOWING MANNER.
* 
*         (1.)  READ THE NEXT COMMAND FROM: 
*                (A) THE COMMAND BUFFER IN THE CONTROL POINT AREA.
*                    IF NECESSARY, THE BUFFER IS RELOADED FROM THE
*                    *INPUT* FILE.
*                (B) THE MESSAGE BUFFER FOR *DIS* TYPE PROGRAMS.
*                (C) A CM LOCATION FOR AN EXECUTING PROGRAM.
* 
*         (2.)  PROGRAMS LOADED FROM THE SYSTEM HAVE THEIR PARAMETERS 
*         CRACKED WITH *KRONOS* SEPARATOR EQUIVALENCES (UNLESS A *SC
*         SYSEDIT DIRECTIVE WAS USED WHEN ENTERING THE PROGRAM INTO 
*         THE SYSTEM).
* 
*               LOCAL FILE PROGRAM LOADS HAVE THEIR PARAMETERS CRACKED
*         WITH *SCOPE* SEPARATOR EQUIVALENCES (UNLESS A */* PREFIX
*         CHARACTER EXISTS ON THE COMMAND). 
* 
*                (A) *KRONOS* PARAMETER CRACKING- 
*                    DELETE ALL SPACES IMBEDDED WITHIN THE COMMAND, 
*                    UP TO THE CHARACTER *.* OR *)*.  ANY CHARACTER 
*                    NOT IN THE STANDARD *FORTRAN* SET (I.E. > @ ; ETC) 
*                    ARE NOT ALLOWED WITHIN THE COMMAND.  HOWEVER,
*                    THEY MAY BE USED IN THE COMMENT. 
* 
*                    NOTE - A SEPARATOR CHARACTER IS ONE OF THE SET 
*                           +-/=,($ 
* 
*                (B) *SCOPE* PARAMETER CRACKING-
*                    SPACES ARE TREATED AS SEPARATORS.  ALL SPECIAL 
*                    CHARACTERS ARE TRANSLATED TO A 4 BIT CODE. 
* 
*         (3.)  SEARCH THE LIST OF SPECIAL COMMAND NAMES
*         FOR A MATCH WITH THE COMMAND BEING PROCESSED. 
*         (CTIME, RTIME OR STIME) 
* 
*         (4.)  EXTRACT THE THE FIRST 7 OR LESS CHARACTERS FROM THE 
*         COMMAND UP TO A SEPARATOR CHARACTER AND SEARCH THE FILE 
*         NAME TABLE FOR A FILE ASSIGNED TO THIS JOB WITH THIS NAME.
*         IF A FIND IS MADE, THE FIELD LENGTH WILL BE RESORED IF
*         DIFFERENT FROM THE AMOUNT SET BY THE LAST *RFL* COMMAND 
*         OR BY THE LAST CALL TO *CPM* TO SET RUNNING FIELD LENGTH. 
*         IF THE RUNNING FIELD LENGTH IS ZERO, A SYSTEM DEFINED 
*         FIELD LENGTH (SYSDEF = 50000B) IS USED AS INITIAL FL. 
*         IF SUCH A FILE IS FOUND WHICH IS ON A MASS STORAGE DEVICE,
*         AND IS IN ABSOLUTE CODE FORMAT, THE LOADER IS CALLED
*         TO LOAD AND EXECUTE IT.  IF THE FILE DOES NOT RESIDE ON 
*         MASS STORAGE, THE JOB IS ABORTED.  IF THE FILE IS IN
*         RELOCATABLE CODE FORMAT, CONTROL IS TRANSFERED TO THE 
*         RELOCATABLE LOADER.  THE ARGUMENTS FOR THE PROGRAM CALL 
*         ARE EXTRACTED FROM THE COMMAND AND STORED IN
*         THE ARGUMENT REGION OF CENTRAL MEMORY, (RA+2 - RA+N)
*         THE CPU IS REQUESTED TO BEGIN EXECUTION OF THE PROGRAM. 
* 
*         (5.)  SEARCH THE CENTRAL LIBRARY FOR A PROGRAM WITH THE 
*         NAME ON THE COMMAND.  IF SUCH A PROGRAM 
*         IS FOUND AND THE PROGRAM CONTAINS AN *RFL=* ENTRY POINT,
*         THE FIELD LENGTH WILL BE SET ACCORDINGLY.  OTHERWISE IT WILL
*         BE SET AS IN (4.) ABOVE. THEN THE REQUESTED PROGRAM WILL BE 
*         LOADED AND EXECUTION WILL BEGIN WITH THE ARGUEMENTS STORED
*         AS IN (4.). 
* 
*         (6.)  IF THE COMMAND NAME IS A 3 CHARACTER NAME, WITH 
*         THE FIRST CHARACTER AN ALPHA, SEARCH THE PP LIBRARY 
*         FOR A PROGRAM OF THIS NAME.  IF FOUND, PLACE
*         THIS NAME WITH UP TO 2 OCTAL ARGUMENTS AS A PP PROGRAM
*         REQUEST AND EXIT TO THE PROGRAM.  NO CHANGE WILL BE MADE IN 
*         THE JOB FIELD LENGTH. 
*               PP PROGRAM CALLS VIA COMMAND IS ONLY VALID FROM 
*               SYSTEM ORIGIN OR IF THE CALLER HAS SYSTEM ORIGIN
*               PRIVILEDGES AND THE SYSTEM IS IN DEBUG MODE.
* 
*         (7.)  IF NONE OF THE ABOVE, THE COMMAND IS DECLARED 
*         INCORRECT AND THE JOB IS ABORTED. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
* 
*         * TCS INCORRECT REQUEST.* = TCS CALLED WITH AN INCORRECT
*         REQUEST.
* 
*         * INCORRECT COMMAND.* = THE COMMAND COULD 
*         NOT BE IDENTIFIED BY TCS. 
* 
*         * TOO MANY ARGUMENTS.* = THE NUMBER OF ARGUMENTS ON THE 
*         COMMAND EXCEEDS THAT ALLOWED BY THE PROGRAM.
* 
*         * FORMAT ERROR ON COMMAND.* = AN ERROR HAS BEEN 
*         DETECTED IN THE FORMAT OF THE COMMAND.
* 
*         * PROGRAM FILE EMPTY.* = A LOAD OF AN EMPTY DATA FILE WAS 
*         ATTEMPTED.
* 
*         * LOADER MISSING.* = EITHER *CALL* OR *LDR=* WERE 
*         NOT FOUND IN THE LIBRARY. 
* 
*         * CHARGE COMMAND REQUIRED.* = A CHARGE COMMAND IS REQUIRED
*         BEFORE THE REQUESTED COMMAND CAN BE PROCESSED.
* 
*         * BUFFER ARG. ERROR.* = CM ADDRESS IN CALL IS NOT < FL - WORD 
*         COUNT.
* 
*         * FL BEYOND MFL.* = REQUESTED FL EXCEEDS MFL. 
* 
*         * FL TOO SHORT FOR PROGRAM.* = MINFL IN 54 TABLE .GT. FL. 
* 
*         * INTERACTIVE JOB STEP, DUMP DISABLED.* = DUMP ATTEMPTED
*         VIA A COMMAND FROM AN INTERACTIVE TERMINAL. 
* 
*         * SECURE MEMORY, DUMP DISABLED.* = ATTEMPT TO 
*         DUMP SECURE MEMORY. 
* 
*         * *SHELL* PROGRAM NOT FOUND.*  BASED ON THE *SHELL* PROGRAM 
*         LOAD PARAMETERS *TCS* COULD NOT SATISFY THE PROGRAM LOAD. 
          SPACE  4,10 
***       ACCOUNT FILE MESSAGES.
* 
* 
*         *UEAU, 000000.000UNTS.* = UNITS OF RAW CP SECONDS FOR THE 
*         APPLICATION IN PROCESS. 
          SPACE  4,10 
***       OPERATOR MESSAGES.
* 
* 
*         *WAITING FOR STORAGE.* = JOB PROCESSING IS WAITING FOR MEMORY 
*         TO BE MADE AVAILABLE. 
          SPACE  4,10 
**        ROUTINES USED.
* 
*         *0BF* - BEGIN FILE. 
*         *0DF* - DROP SPECIAL ID FILES.
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 FN       EQU    AB          FILE NAME
 TN       EQU    AB          TERMINAL NUMBER (COMPSTA)
 TT       EQU    AB+1 - AB+2  TERMINAL TABLE ADDRESS (COMPSTA)
 TA       EQU    AB+3        *IAF* RA (COMPSTA) 
 PF       EQU    65          PROGRAM FORMAT 
 CA       EQU    66          CHARACTER ADDRESS
 KA       EQU    67          KEYWORD START ADDRESS
****
          TITLE  MAIN ROUTINE.
 TCS      SPACE  4,10 
**        TCS - MAIN ROUTINE. 
* 
*         CALLS  CGL, SCL, SPF, *3AC*.
* 
*         MACROS EXECUTE. 
  
  
          ORG    PPFW 
 TCSX     LJM    TCS         (REQUIRED FOR USE AS OVERLAY)
  
 TCS      LJM    INT         INITIALIZE *TCS* 
  
 TCSA     CON    0           CHARGE REQUIRED FLAG 
  
 TCS1     LDD    FA          ENTRY
          NJN    TCS2        IF LOAD FROM CENTRAL LIBRARY 
          RJM    CGL         CHECK GLOBAL LIBRARY 
 TCS2     RJM    SCL         SEARCH CENTRAL LIBRARY 
          UJN    TCS6        PROCESS INCORRECT COMMAND ERROR
  
 TCS3     LDD    FA          CHECK PROGRAM FILE 
          NJN    TCS4        IF LOAD FROM CENTRAL LIBRARY 
          RJM    SPF         SEARCH FOR PROGRAM FILE
*         UJN    *+2         (*SHELL* LOCAL FILE LOAD DISABLED) 
 TCSB     EQU    *-2
          RJM    CGL         CHECK FOR GLOBAL LIBRARIES 
*         UJN    *+2         (*SHELL* GLOBAL FILE LOAD DISABLED)
 TCSC     EQU    *-2
 TCS4     RJM    SCL         SEARCH CENTRAL LIBRARY 
          LDC    **          CHECK USER ACCESS
 TCSD     EQU    *-1
          ZJN    TCS5        IF SYSTEM PRIVILEGES ALLOWED 
          LDC    **          CHECK ENGINEERING MODE 
 TCSE     EQU    *-1
          NJN    TCS6        IF NOT ENGINEERING MODE OR NOT *CSOJ*
 TCS5     EXECUTE  3AC
  
 TCS6     LDN    ZERL        CLEAR *SHELL* CONTROL
          CRD    CM 
          NFA    SHCN 
 TCSF     PSN 
*         CWD    CM          (*SHELL* ABORT OPTION SET) 
          LDC    /ERR/EM05   * INCORRECT COMMAND.*
 TCSG     EQU    *-1
*         LDC    /ERR/EM25   * *SHELL* PROGRAM NOT FOUND.*
          LJM    ERR1        PROCESS ERROR
 IST      SPACE  4,10 
**        IST - ISSUE COMMAND TO DAYFILE. 
* 
*         EXIT   TO *DPP* IF PROGRAM NOT LOADED.
*                TO *PPR* IF ERROR FLAG SET.
* 
*         USES   T2.
* 
*         CALLS  CAT, DFM, ISD. 
* 
*         MACROS MONITOR. 
  
  
 IST6     RJM    CAT         CLEAR ADDRESS FOR *TCS* EXECUTE COMMAND
  
 IST      LDM    CSEB 
*         UJN    IST1        (*SHELL* PROCESSING) 
          SHN    21-3 
          MJN    IST1        IF SDM= SET
          LDM    STMT 
          ZJN    IST1        IF NO COMMAND
          LDN    5           WRITE COMMAND TO CP BUFFER 
          STD    T2 
          LDD    CP 
          ADN    MS1W 
          CWM    STMT,T2
          LDC    STMT        ISSUE COMMAND TO DAYFILE 
          RJM    ISD
 IST1     LDN    0
 ISTA     EQU    IST1 
*         LDN    1           (START JOB STEP) 
          ZJN    IST2        IF NOT STARTING JOB STEP 
          LDN    RLJS        START JOB STEP 
          STD    CM+1 
          MONITOR  RLMM 
 IST2     LDD    EF 
          ZJN    IST4        IF ERROR FLAG NOT SET
          RJM    DFM         ERROR MESSAGE TO DAYFILE 
 ISTB     LDN    PPET        SET ERROR FLAG = PP ABORT
*         LDN    SYET        (*SHELL* ABORT OR COMMAND LIMIT) 
*         UJN    IST4        (INCORRECT *DMP=* CALL)
          STD    CM+1 
          MONITOR  CEFM 
 IST3     LDD    CP          STORE COMMAND POINTER
          ADN    CSPW 
          CWD    SP 
          JMP    PPR         EXIT TO PP RESIDENT
  
 IST4     LDD    PF          CHECK PROGRAM FORMAT 
          ZJN    IST5        IF PROGRAM NOT LOADED
          LMN    10 
          NJN    DPP         IF NOT PPU PROGRAM 
          STD    CM+1        CLEAR JOB ADVANCEMENT FLAG 
 ISTC     MONITOR  JACM 
          UJN    IST3        EXIT 
  
 IST5     LDD    CP          STORE COMMAND POINTER
          ADN    CSPW 
          CWD    SP 
*         UJN    DPP         DROP PPU 
  
  
          ERRNG  37+IST-IST1  JUMP OUT OF RANGE 
 DPP      SPACE  4,10 
**        DPP - DROP PP.
* 
*         EXIT   TO *PPR*.
* 
*         MACROS MONITOR. 
  
  
 DPP      LDN    DPPS 
          STD    CM+1        CLEAR JOB ADVANCE FLAG 
 DPPA     MONITOR  JACM 
*         MONITOR  DPPM      (IF *TCS* REQUEST) 
          JMP    PPR         EXIT TO PP RESIDENT
 CPP      SPACE  4,10 
**        CPP - CALL PP PROGRAM.
* 
*         ENTRY  (A) = NAME OF PP PROGRAM TO BE CALLED. 
* 
*         EXIT   TO *PPR*.
  
  
 CPP      SHN    14          SET PP NAME IN INPUT REGISTER
          STD    IR 
          SHN    -6 
          LMD    IR+1 
          SCN    77 
          LMD    IR+1 
          STD    IR+1 
          LDD    IA          STORE INPUT REGISTER 
          CWD    IR 
          JMP    PPR         EXIT TO PP RESIDENT
  
*         *CSEB* LOCATED HERE FOR GLOBAL ACCESS.
  
 CSEB     BSSZ   5           SPECIAL ENTRY POINT WORD 
          SPACE  4
 EOVL     EQU    *+5         LOAD ADDRESS FOR *3AM* 
 CGL      SPACE  4,15 
**        CGL - CHECK FOR GLOBAL LIBRARIES. 
* 
*         ENTRY  (AB - AB+3) = 7 CHARACTER NAME LEFT JUSTIFIED. 
* 
*         EXIT   RETURN TO CALLER IF GLOBAL LIBRARY BIT IN *LB1W* 
*                IS CLEAR OR THE ENTRY IS NOT FOUND.
*                TO *SSC* IF PROGRAM RELOCATABLE OR *CCL* PROC. 
*                TO *SCL* TO CHECK FIELD LENGTH FOR ABS LOAD. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  SCL, *3AI*.
* 
*         MACROS EXECUTE. 
  
  
 CGL      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADC    LB1W 
          CRD    CM          GET FIRST LOADER CONTROL WORD
          LDD    CM 
          SHN    21-12       CHECK GLOBAL LIBRARY BIT 
          PJN    CGLX        IF NO GLOBAL DIRECTORY TO SEARCH 
          EXECUTE  3AI       SEARCH GLOBAL LIBRARY DIRECTORY
          LDC    **          SYSTEM CALL FROM *3AI/SGD* 
 CGLA     EQU    *-1
          LJM    CGLX        ENTRY NOT FOUND, RETURN
 CGLB     EQU    *-1
*         LJM    SSC         IF PROGRAM IS RELOCATABLE OR *CCL* 
*         RJM    SCL         PROGRAM IS ABSOLUTE
  
  
 CGLC     CON    0,0         RANDOM INDEX SET BY *SGD*
          TITLE  PROGRAM CALL PROCESSORS. 
 SPF      SPACE  4,15 
**        SPF - SEARCH FOR PROGRAM FILE.
* 
*         ENTRY  (AB - AB+3) = 7 CHARACTER NAME LEFT JUSTIFIED. 
* 
*         EXIT   IF FILE NOT FOUND, RETURN. 
*                IF FILE FOUND, EXIT TO *SSC*.
*                TO *ERR1* IF FILE NOT ON MASS STORAGE OR EMPTY.
* 
*         USES   CM - CM+4, FS - FS+4, CW - CW+5. 
* 
*         CALLS  SAF. 
* 
*         MACROS NFA. 
  
  
 SPF2     LDC    /ERR/EM27   * PROGRAM FILE EMPTY.* 
          LJM    ERR1        EXIT TO PROCESS ERROR
  
 SPF      SUBR               ENTRY/EXIT 
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          ZJN    SPFX        IF NOT FOUND 
          NFA    FA,R        READ FNT 
          CRD    FS 
          ADN    FSTL        SET EQUIPMENT AND FIRST TRACK
          CRD    CW+1 
          LDD    CW+1        CHECK FOR FILE ON MASS STORAGE 
          SFA    EST
          ADK    EQDE 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          PJN    SPF2        IF NOT MASS STORAGE
          LDD    CW+1+2 
          ZJN    SPF2        IF NO CURRENT TRACK
          LDD    FS+4 
          LPN    77 
          LMN    UPST 
          ZJN    SPFX        IF USER FILE PRIVACY SET 
          LMN    AAST&UPST
          NJN    SPF1        IF NOT APPLICATION ACCOUNTING FILE 
          LDD    CP          READ APPLICATION ACCOUNTING CONTROL WORD 
          ADN    FPFW 
          CRD    CM 
          LDD    CM 
          ADC    400         SET VALIDATED FOR APPLICATION ACCOUNTING 
          STD    CM 
          LDD    CP          REWRITE APPLICATION CONTROL WORD 
          ADN    FPFW 
          CWD    CM 
 SPF1     LDC    UJNI+SCL5-SCLD  NO CHANGE IN PARAMETER CRACKING
          STM    SCLD 
          LDN    LDR=        SET SYSTEM CALL = *LDR=* 
 SPFA     LJM    SSC         SET SYSTEM CALL
*         PSNI   (*SHELL* FILE LOAD)
  
          EXECUTE  3AE       LOAD COPY ROUTINES 
          LDC    6000        SET FL CONTROL TO JOB STEP FL
          STD    CW 
          LDN    0           SET LOCAL FILE LOAD
          STM    /3AE/SLPD
          STD    FS 
          LDN    FSMS 
          STD    CW+4 
          LDD    CW+2 
          STD    FS+4 
          LDC    /3AE/LDU    SET CALL TO *LDU*
          STM    BCPB 
          LJM    SCL7        LOAD PROGRAM 
 SCL      SPACE 4,15
**        SCL - SEARCH CENTRAL LIBRARY. 
* 
*         ENTRY  (AB - AB+3) = 7 CHARACTER NAME LEFT JUSTIFIED. 
* 
*         EXIT   RETURN IF PROGRAM NOT FOUND. 
*                (FA) = 0.
*                TO *BCP* IF FOUND. 
*                TO *SSC* IF SYSTEM CALL. 
* 
*         ERROR  TO *ERR1* IF RFL=/MFL= .GT. MFL. 
*                TO *ERR8* IF CHARGE REQUIRED.
* 
*         USES   FA, CM - CM+4, CN - CN+4, CW - CW+4, AB - AB+4.
* 
*         CALLS  CLD, CSE, *3AE*. 
* 
*         MACROS EXECUTE. 
  
  
 SCL14    LDM    TCSA 
          ZJN    SCLX        IF NO CHARGE REQUIRED
 SCL14.1  LDC    /ERR/EM06   * CHARGE COMMAND REQUIRED.*
          LJM    ERR1        PROCESS ERROR
  
 SCL15    LDN    ZERL        CLEAR SPECIAL CALL 
          CRD    CM 
          LDD    CP 
          ADC    SPCW 
          CWD    CM 
  
 SCL      SUBR               ENTRY/EXIT 
          EXECUTE  3AE       LOAD COPY ROUTINES 
 SCLE     LDN    0           CLEAR FNT ORDINAL
*         UJN    SCLX        (*SHELL* SYSTEM FILE LOAD DISABLED)
          STD    FA 
*         LJM    SCL7        SET BY *3AI* 
 SCLA     EQU    *-2
          RJM    /3AE/CLD    SEARCH CLD 
 SCLB     ZJN    SCL14       IF NOT FOUND 
*         ZJN    SCLX        (TERMINATE IF POSSIBLE CONTINUATION) 
*                             COMMAND AND *ARG=* NOT PRESENT) 
*         ZJN    SCL15       (*DMP=* PROGRAM INITIALIZED) 
          CRD    CW          READ CONTROL WORD
          SBN    1
          CRD    CN 
          LDC    UJNI+/3AE/SPF4.2-/3AE/SPFB 
          STM    /3AE/SPFB   INDICATE SYSTEM FILE LOAD
          LDD    MA          SET ENTRY POINT NAME 
          CWD    AB 
          CRM    /3AE/CL,ON 
          LDD    CW+2        SET ALTERNATE EQUIPMENT
          STD    T5 
          LDD    CN+3        SET ADDRESS ON SYSTEM FILE 
          STM    /3AE/CL+4
          LDD    CN+4 
          STM    /3AE/CL+5
          LDD    CW+1 
          LPN    37 
          LMN    RLRT 
          NJN    SCL1        IF NOT RELOCATABLE ROUTINE 
          LDN    SLDR        SET SYSTEM CALL = *SLDR=*
          UJN    SCL1.1      CONTINUE 
  
 SCL1     LMN    PRRT&RLRT
          NJN    SCL2        IF NOT A *CCL* PROCEDURE 
          LDN    BEGI        SET SYSTEM CALL = *BEGIN*
          UJN    SCL1.2      CONTINUE 
  
 SCL1.1   STD    T0 
          LDM    SCLC 
          ZJN    SCL3        IF POSSIBLE CONTINUATION COMMAND 
          LDD    T0 
 SCL1.2   LJM    SSC         SET SYSTEM CALL
  
 SCL2     RJM    CSE         CHECK FOR SPECIAL ENTRY POINTS 
 SCLC     UJN    SCL4        NO CONTINUATION COMMAND
*         PSN                (IF CONTINUATION COMMAND POSSIBLE) 
          LDM    CSEB 
          SHN    21-5 
          MJN    SCL4        IF *ARG=* PROCESS
 SCL3     LJM    SCLX        RETURN 
  
 SCL4     LDD    CW+1 
          SHN    21-11
          MJN    SCL5        IF SCOPE FORMAT
 SCLD     AOM    ARGA        SET KRONOS FORMAT
*         UJN    SCL5        (IF FILE LOAD) 
  
 SCL5     BSS    0
 SCL7     LDM    TCSA        CHECK CHARGE REQUIRED
          NJP    SCL14.1     IF CHARGE REQUIRED 
          LDD    CP          READ FL CONTROL WORD 
          ADN    FLCW 
          CRD    CM 
          LDD    CM+1        CLEAR ONE JOB STEP RFL FLAG
          LPC    3777 
          STD    CM+1 
          LDD    CW          CHECK CLD FL SPECIFICATION 
          NJN    SCL8        IF FL SPECIFIED
          LJM    BCP         BEGIN CENTRAL PROGRAM
  
 SCL8     LPC    3777 
          STM    RQSD 
          LDD    CW          CHECK FL REQUEST TYPE
          SHN    21-13
          PJN    SCL11.1     IF RFL=/DEFL 
          LDD    CW          SET MFL= VALUE 
          LPC    1777 
          STM    RQSD 
          LDD    CW 
          SHN    21-12
          PJN    SCL11       IF USING MFL= DEFINED FIELD LENGTH 
          LDD    CW+1        CHECK 5400 TABLE FLAG
          SHN    21-7 
          PJN    SCL9        IF NO 5400 TABLE CHECK 
          LDC    ZJNI+BCP7-BCPC 
          STM    BCPC        SET 54 TABLE CHECK INSTRUCTION 
 SCL9     LDD    CW          CHECK LAST JOB COMMAND FIELD LENGTH
          LPC    1777 
          SBD    CM+1 
          PJN    SCL13       IF LAST JOB COMMAND FL .LT. MFL= 
          LDD    CM+1 
          UJN    SCL12       SET LAST JOB COMMAND FL
  
 SCL11    LDD    CW          SET MFL= FL
          LPC    1777 
          SBD    FL 
 SCL11.1  PJN    SCL13       IF LAST JOB CARD FL .LT. MFL=
          LDD    FL 
 SCL12    STM    RQSD        SET CURRENT FL/LAST JOB COMMAND FL 
 SCL13    LDD    CM          CHECK REQUESTED FL AGAINST MFL 
          SBM    RQSD 
          PJN    BCP         IF REQUESTED FL .LE. MFL 
          LDC    /ERR/EM01   * FL BEYOND MFL.*
          LJM    ERR1        PROCESS ERROR
  
          ERRNG  37+SCLX-SCLE  JUMP OUT OF RANGE
          ERRNG  37+SCL15-SCLB IF JUMP OUT OF RANGE 
          ERRNG  37+SCLX-SCLB IF JUMP OUT OF RANGE
          ERRNG  37+SCL5-SCLD IF JUMP OUT OF RANGE
 BCP      SPACE  4,15 
**        BCP - BEGIN CENTRAL PROGRAM.
* 
*         ENTRY  (FA) = FST ADDRESS.
*                (AB - AB+4) = PROGRAM NAME.
*                (CW - CW+4) = LIBRARY CONTROL WORD.
*                (BCPJ - BCPJ+1) = JSN (FOR *0AU*). 
*                (BCPJ+4) = 6/SC,6/0 (FOR *0AU*). 
* 
*         EXIT   TO *IST* AT COMPLETION OF LOAD.
*                TO */3AF/SDP* IF TO INITIATE *DMP=* PROGRAM. 
* 
*         ERROR  TO *ERR1* IF PREVIOUS ERROR PENDING. 
* 
*         USES   CA, IR+4, T1, T2, T7, AB - AB+4, CM - CM+4, CN - CN+4. 
* 
*         CALLS  ARG, ASN, CAT, CLX, CST, /3AE/LCP, /3AE/LDU, 
*                RQS, STK, /3AF/TCA, *0AU*, *3AF*, *3AH*. 
* 
*         MACROS EXECUTE. 
  
  
 BCP      BSS    0           ENTRY
          RJM    RQS         REQUEST STORAGE
          LDN    ZERL        CLEAR *CYBER LOADER* FIELDS
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    LWPR 
          CWD    CM 
          ADN    FWPR-LWPR
          CWD    CM 
          LDM    CSEB 
          SHN    21-4 
          PJN    BCP1        IF NOT *DMP=* ENTRY POINT
 BCPA     LJM    BCP4        LOAD CENTRAL PROGRAM 
*         LJM    BCP3        (COMMAND LOAD AFTER *DMP=* ROLLOUT)
  
*         ENTER PRELIMINARY PROGRAM DATA. 
  
 BCP1     LDD    IR+2 
          LMN    2
          NJN    BCP2        IF NOT *DIS* CALL
          LDD    IR+4        SET *RSS* BIT
          LPN    1
          ADN    2           SET *DIS* BIT
          SHN    6
          STM    /3AE/SLPE
 BCP2     LDD    AB+4        CHECK LOADER CALL
          ZJN    BCP3        IF NOT LOADER CALL 
          LDD    KA          ASSEMBLE PROGRAM NAME
          STD    CA 
          RJM    ASN
          LDD    IR+4 
          SCN    1           CLEAR *RSS* FLAG 
          STD    IR+4 
 BCP3     LDD    RA          STORE PROGRAM NAME 
          SHN    6
          ADN    PGNR 
          CWD    AB 
          UJN    BCP5        LOAD CENTRAL PROGRAM 
  
*         LOAD PROGRAM. 
  
 BCP4     LDM    CSEB+1      CHECK FOR *DPA=* ENTRY POINT 
          SHN    21-13
          PJN    BCP4.1      IF NO ARGUMENTS EXPECTED 
          LDD    RA 
          SHN    6
          ADN    PGNR 
          CRD    CN 
          LDD    CN+4        SAVE ARGUMENT COUNT
          STD    CM+4 
 BCP4.1   LDD    RA 
          SHN    6
          ADN    PGNR 
          CWD    CM 
 BCP5     RJM    /3AE/LCP    LOAD CENTRAL PROGRAM 
 BCPB     EQU    *-1
*         RJM    /3AE/LDU    (USER LIBRARY OR LOCAL *SHELL* FILE LOAD)
          NJN    BCP6        IF LOAD ERROR
          LDM    /3AE/SPFA
 BCPC     UJN    BCP7        NO 54 TABLE CHECK
*         ZJN    BCP7        (IF NO MINFL IN 54 TABLE)
          SBD    FL 
          SBN    1
          MJN    BCP7        IF MINFL .LE. FL 
          LDC    /ERR/EM02   * FL TOO SHORT FOR PROGRAM.* 
 BCP6     LJM    ERR1        PROCESS ERROR
  
 BCP7     LDD    CP          CLEAR ONE JOB STEP RFL IN TXOT JOBS
          ADN    FLCW 
          CRD    CN 
          STD    T1 
          LDD    CN+1 
          SHN    21-13
          PJN    BCP8        IF NOT ONE JOB STEP RFL
          LDN    0           CLEAR ONE JOB STEP RFL 
          STD    CN+1 
          LDD    T1 
          CWD    CN 
  
*         CLEAR EXCHANGE PACKAGE AND ENTER ARGUMENTS. 
  
 BCP8     LDD    CM+3        CLEAR EXCHANGE PACKAGE 
          LPN    37 
          SHN    14 
          LMD    CM+4 
          RJM    CLX
 BCPD     RJM    ARG         ENTER ARGUMENTS
*         LJM    BCP22       (*DMP=* PROCESSING ON SYSTEM REQUEST 
          LDD    PF          CHECK PROGRAM FORMAT 
          SBN    3
 BCPL     MJN    BCP9        IF TYPE OVL OR ABS 
*         MJN    BCP9.1      IF *SHELL* LOAD
          LJM    BCP11       START PROGRAM
  
 BCP9     RJM    STK         SKIP SEQUENCE NUMBER 
          RAM    BCPE        MODIFY BUFFER ADDRESS
 BCP9.1   LDN    10          SET COMMAND WORD COUNT 
          STD    T1 
          LDD    RA          READ PROGRAM NAME
          SHN    6
          ADN    ACTR 
          CRD    AB 
          LDD    T2          SET ARGUMENT COUNT 
          STD    AB+4 
          LDD    AB+3 
          SCN    77 
          STD    AB+3 
          LDD    RA          STORE PROGRAM NAME 
          SHN    6
          ADN    ACTR 
          CWD    AB 
          ADN    CCDR-ACTR   STORE COMMAND
          CWM    STMT,T1
 BCPE     EQU    *-1
 BCPK     UJN    BCP9.2      CONTINUE 
*         LDN    MS2W-MS1W   (*MS1W* COPY ENABLED)
          STD    T1 
          LDD    CP          COPY *MS1W* TO RA+2
          ADN    MS1W 
          CRM    STMT,T1
          LDD    RA 
          SHN    6
          ADN    ARGR 
          CWM    STMT,T1
          LPN    77          ADJUST THE *CSTM* PARAMETERS 
          STM    BCPI+5*2+4 
          LDN    PGNR-ARGR
          SBD    T1 
          STM    BCPI+5*2+2 
 BCP9.2   BSS    0
 BCPF     UJN    BCP10       CHECK *SSJ=* 
*         LDN    CCDR        (PROCESSING *TCS* EXECUTE COMMAND
          STM    ISDA 
          LDN    0
          STM    ISDB+3 
 BCP10    LDM    CSEB        CHECK *SSJ=* 
          SHN    21-2 
          PJN    BCP11       IF NOT SPECIAL SYSTEM JOB
          LDM    CSEB+3 
          LPN    37 
          ADM    CSEB+4 
          ZJN    BCP11       IF NO PARAMETER BLOCK
          EXECUTE  3AF
          RJM    /3AF/TCA    TRANSFER CONTROL POINT AREA FIELDS 
  
*         START PROGRAM.
  
 BCP11    RJM    CAT         CLEAR EXECUTE COMMAND ADDRESS
          ADK    SRUW-RFCW   READ SRU ACCUMULATOR 
          CRD    CM 
          ADN    FPFW-SRUW
          CRM    OVL,ON 
          LDD    CM+1        CHECK IF OVERFLOW OCCURRED 
          SCN    37 
          NJN    BCP11.1     IF OVERFLOW
          LDD    CM 
          LPN    3
          ZJN    BCP12       IF NO OVERFLOW 
 BCP11.1  LDC    BCPJ        SET PARAMETER BLOCK ADDRESS
          STM    OVL+1
          LDM    OVL         SET OVERFLOW FUNCTION CALL 
          SCN    77 
          ADN    1
          STM    OVL
          EXECUTE  0AU,OVL+5
 BCP12    LDD    CP 
          ADC    SEPW 
          CWM    CSEB,ON
          ADK    SPCW-SEPW-1
          CRD    CN 
          STD    T2 
          LDM    CSEB 
          SHN    21-4 
          PJN    BCP13       IF NOT *DMP=*
          LDD    CN+1        CLEAR *1RO* CALLED FLAG
          SCN    2
          STD    CN+1 
          LDD    T2 
          CWD    CN 
 BCP13    LDD    CP 
          ADN    OAEW        GET OPERATOR ASSIGNED EQUIPMENT
          CRD    CN 
          ADN    CSPW-OAEW   STORE COMMAND POINTER
          CWD    SP 
          LDD    CN+4        CHECK ASSIGNED EQUIPMENT 
          ZJN    BCP15       IF NO EQUIPMENT ASSIGNED 
          LDN    0           CLEAR ASSIGNMENT 
          STD    CN+4 
          LDD    CP 
          ADN    OAEW 
          CWD    CN 
 BCP15    LDM    CSEB        CHECK *CLB=* ENTRY POINT 
          SHN    21-6 
          PJN    BCP16       IF NO *CLB=* 
          EXECUTE  3AH
 BCP16    LDD    CP          GET SECURE MEMORY STATUS OF LAST JOB STEP
          ADC    DBAW 
          STD    T1 
          CRD    T7 
          LDN    ZERL 
          CRD    CM 
          LDD    MA          WRITE *CSTM* LIST TO MESSAGE BUFFER
          CWM    BCPI,TR
          CWD    CM          TERMINATE LIST 
          LDM    CSEB        CHECK *SSJ=* OR *SSM=* ENTRY POINTS
          LPN    5
          ZJN    BCP17       IF NOT *SSJ=* OR *SSM=*
          LDC    4000        SET SECURE MEMORY STATUS FOR THIS JOB STEP 
          STD    CM 
 BCP17    LDD    T1          SET SSM STATUS AND CLEAR (DBAW)
          CWD    CM 
 BCPG     LDD    T7 
*         UJN    BCP19       (SUBSYSTEM, END OF JOB, OR *DMP=*) 
          LPC    5000 
          NJN    BCP18       IF LAST JOB STEP SECURE OR INTERACTIVE 
 BCPH     UJN    BCP19       CONTINUE PROCESSING
*         PSN                IF FL INCREASE 
 BCP18    LDK    SSTL 
          CRD    CN 
          LDD    CN 
          SHN    21-12
          PJN    BCP18.1     IF MEMORY CLEARING ENABLED 
          LDM    CSEB 
 BCPN     LPN    1
*         LPN    0           (EXECUTE ONLY GLOBAL LIBRARY ROUTINE)
*         LPN    0           (ECS FL INCREASE)
          NJN    BCP19       IF *SSM=* ENTRY POINT
 BCP18.1  RJM    CST         CLEAR STORAGE
 BCP19    LDD    IR+2 
          LMN    2
          NJN    BCP20       IF NOT DIS CALL
          LDD    IR+4 
          LPN    1
          NJN    BCP21       IF RSS 
 BCP20    AOM    ISTA        ENABLE START JOB STEP
 BCP21    LJM    IST         ISSUE COMMAND TO DAYFILE 
  
 BCP22    EXECUTE  3AF
          LJM    /3AF/SDP    START *DMP=* PROGRAM 
  
  
 BCPI     CON    0,0,0,0,0   CLEAR FROM LWA+1 TO FL-1 
          CON    0,0,0,0,100 CLEAR FROM 100B TO FWA-1 
          CON    0,0,0,0,0   CLEAR UNLOADED ARGUMENT AREA 
  
 BCPJ     BSS    5           *0AU* PARAMETER BUFFER 
  
          ERRNG  37+BCPC-BCP7 IF JUMP OUT OF RANGE
          ERRNG  37+BCPG-BCP19 IF JUMP OUT OF RANGE 
 ARG      TITLE  OVERLAID BY *3AM*. 
***       ARG - ENTER ARGUMENTS.
* 
*         ARGUMENTS STORED 1/WORD LEFT JUSTIFIED STARTING AT (RA+ARGR). 
*         KRONOS FORMAT-
*         LOWER 6 BITS = SEPARATOR CHARACTER. (EXCEPT A COMMA IS
*         PASSED AS 6 BITS OF ZEROS.) 
*         SCOPE FORMAT- 
*         LOWER 4 BITS = SEPARATOR CODE.
* 
*         ENTRY  (PF) = PROGRAM FORMAT. 
* 
*         EXIT   (T2) = ARGUMENT COUNT. 
* 
*         ERROR  TO *ERR1* IF ERROR.
* 
*         USES   T2, AB - AB+4, CM - CM+4.
* 
*         CALLS  ASN, TSS.
  
  
 ARG6     LDN    ZERL        SET BLANK ARGUMENT 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    ARGR 
          ADD    T2 
          CWD    CM 
          LPN    77          SET FWA OF ARGUMENT AREA CLEAR 
          STM    BCPI+5*2+4 
          LDN    PGNR-2      SET WORD COUNT OF ARGUMENT AREA CLEAR
          SBD    T2 
          STM    BCPI+5*2+2 
  
 ARG      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR ARGUMENT COUNTER 
          STD    T2 
          LDM    CSEB 
          SHN    21-5 
          MJN    ARGX        IF *ARG=* PRESENT
*         UJN    ARG6        (*SHELL* PROCESSING) 
 ARGC     EQU    *-1
 ARG1     LDI    CA          CHECK NEXT CHARACTER 
          ZJN    ARG6        IF TERMINATOR
          AOD    CA          SKIP SEPARATOR 
          RJM    ASN         ASSEMBLE ARGUMENT
          LDC    0           PARAMETER CRACKING FORMAT
 ARGA     EQU    *-1
          NJN    ARG2        IF KRONOS FORMAT 
          RJM    TSS         TRANSLATE SCOPE FORMAT 
          UJN    ARG3        STORE ARGUMENT 
  
 ARG2     LDI    CA          CHECK SEPARATOR
          LMN    1R,
          ZJN    ARG4        IF *,* 
          LMN    1R,         ENTER SEPARATOR
 ARG3     STD    AB+4 
 ARG4     LDD    RA          STORE ARGUMENT 
          SHN    6
          ADN    ARGR 
          ADD    T2 
          CWD    AB 
          AOD    T2          ADVANCE ARGUMENT COUNT 
          SBN    1
          LMC    60          CHECK ARGUMENT LIMIT 
 ARGB     EQU    *-1
          NJN    ARG1        IF NOT ARGUMENT LIMIT
          LDN    ZERL        ENSURE ZERO TERMINATED ARGUMENT LIST 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    ARGR+60+1
          CWD    CM 
          LDC    /ERR/EM11   * TOO MANY ARGUMENTS.* 
          LJM    ERR1        PROCESS ERROR
  
  
          ERRNG  37+ARG6-ARGC  JUMP OUT OF RANGE
 CSE      SPACE  4,10 
**        CSE - CHECK FOR SPECIAL ENTRY POINTS. 
* 
*         ENTRY  (T1 - T2)   ADDRESS OF DIRECTORY ENTRY.
*                (CW - CW+4) = LIBRARY CONTROL WORD.
* 
*         EXIT   (CSEB - CSEB+4)  SPECIAL ENTRY POINT WORD. 
*                TO *CPP* TO CALL *1AJ* IF *DMP=* COMMAND CALL. 
* 
*         ERROR  TO *ERR1* IF VALIDATION VIOLATION. 
* 
*         USES   T1, T2, FS - FS+4. 
* 
*         CALLS  CVD, *1AJ*.
* 
*         MACROS EXECUTE. 
  
  
 CSE      SUBR               ENTRY/EXIT 
          LDD    CW+1 
          SHN    21-10
          PJN    CSE1        IF NO SPECIAL ENTRY POINTS 
          LDD    T1          READ SPECIAL ENTRY POINT WORD FROM PST 
          SHN    14 
          LMD    T2 
          ADN    1
          CRM    CSEB,ON
          UJN    CSE2        START PROCESSING 
  
 CSE1     LDN    ZERL        CLEAR SPECIAL ENTRY POINT WORD BUFFER
          CRM    CSEB,ON
 CSE2     LDM    CSEB 
          SHN    21-6 
          PJN    CSE4        IF NO *CLB=* 
          LDD    FL 
          ZJN    CSE3        IF NO FL 
          ADD    RA          CHECK WORD COUNT 
          SBN    1
          SHN    6
          CRD    FS 
          LDD    FS+4 
          ZJN    CSE3        IF NO DATA 
          LDM    IPLB+4      CHECK TERMINAL NUMBER
          ZJN    CSE3        IF NOT ON-LINE INTERACTIVE JOB 
          AOM    /3AE/SLPF
          UJN    CSE4        ALL CONDITIONS MET FOR *CLB=*
  
 CSE3     LDC    -100        CLEAR *CLB=* STATUS
          RAM    CSEB 
 CSE4     LDM    CSEB 
          SHN    21-1 
          PJN    CSE5        IF *VAL=* NOT PRESENT
          LDN    0           CLEAR CHARGE REQUIRED
          STM    TCSA 
 CSE5     LDM    CSEB 
          SHN    21-4 
          PJN    CSE6        IF *DMP=* NOT PRESENT
          LDD    CP          CHECK IF SPECIAL CALL PRESENT
          ADC    SPCW 
          CRD    FS 
          LDD    FS 
          NJN    CSE6        IF CALL PRESENT
          LDM    CSEB+2 
          SHN    21-11
          PJN    CSE7        IF *DMP=* NOT SUPPRESSED ON COMMANDS 
          LDM    CSEB        CLEAR *DMP=* 
          LMN    20 
          STM    CSEB 
 CSE6     LJM    CSEX        RETURN 
  
  
 CSEA     BSS    0
 CSE7     LDN    0           IF NOT POSSIBLE CONTINUATION COMMAND 
*         LDN    1           (POSSIBLE CONTINUATION COMMAND)
          NJN    CSE6        IF POSSIBLE CONTINUATION COMMAND 
          LDM    CSEB+2      CHECK *DMP=* ENTRY POINT VALUE 
          SHN    21-13
          MJN    CSE8        IF *RESTART* 
          RJM    CVD         CHECK VALID *DMP=* CALL
 CSE8     LDD    CP          SAVE INPUT REGISTER
          ADC    SEPW 
          CWD    IR 
          LDN    0
          STD    IR+2        CLEAR INPUT REGISTER 
          STD    IR+3 
          STD    IR+4 
          LDN    77          SET CALL PRESENT 
          STD    FS 
          LDN    24          SET *DMP=* AND NO RA+1 CLEAR FLAGS 
          STD    FS+1 
          LDD    CP          SET *DMP=* CALL
          ADC    SPCW 
          CWD    FS 
          SBN    SPCW-TERW
          CRD    FS 
          LDM    CSEB+2 
          STD    FS+3 
          LDM    CSEB+3 
          STD    FS+4 
          LDD    CP 
          ADN    TERW 
          CWD    FS 
          EXECUTE  1AJ,*     RE-CALL *1AJ*
          LJM    CPP         CALL PP PROGRAM
 CST      SPACE  4,10 
**        CST - CLEAR STORAGE.
* 
*         ENTRY  (CSTB) = 0 IF EXTENDED MEMORY TO BE CLEARED. 
*                (CSTC) = FWA OF EXTENDED MEMORY TO CLEAR.
*                (CSTD) = WORD COUNT OF EXTENDED MEMORY TO CLEAR. 
* 
*         EXIT   CM AND EXTENDED MEMORY CLEARED AS NECESSARY. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 CST      SUBR               ENTRY/EXIT 
 CSTA     LDD    HN          SET CM RELATIVE *CSTM* ADDRESSES 
*         UJN    CSTB        (IF LOADING *LDR=* OR *SLDR=*) 
          STD    CM+1 
          MONITOR  CSTM 
 CSTB     UJN    CSTX        IF EXTENDED MEMORY NOT TO BE CLEARED 
*         PSN                (IF ALSO CLEARING EXTENDED MEMORY) 
  
          LDC    **          FWA OF EXTENDED MEMORY TO CLEAR
 CSTC     EQU    *-1
          STD    CM+4 
          LDC    **          WORD COUNT TO CLEAR
 CSTD     EQU    *-1
          STD    CM+2 
          LDN    0
          STD    CM+3 
          LDC    300         SET ECS RELATIVE *CSTM* ADDRESSES
          STD    CM+1 
          MONITOR  CSTM 
          UJN    CSTX        RETURN 
  
*         DEFINE THE END OF CODE OVERLAYED BY *3AM*.
  
 ECA      EQU    *           END OF CURRENT CODE
 ECB      EQU    EOVL+502B*2+5  END OF *3AM*
 ECC      MAX    ECA,ECB     REQUIRED ORIGIN OF NON-OVERLAYED CODE
          ORG    ECC
          TITLE  SUBROUTINES. 
 AKW      SPACE  4,15 
**        AKW - ASSEMBLE KEYWORD. 
* 
*         ENTRY  (CHAR) = COMMAND STRING. 
*                (FA) = 0.
* 
*         EXIT   (A) = 0 IF NO KEYWORD. 
*                (A) = -0, IF COMMENT COMMAND.
*                (CA) = CHARACTER ADDRESS.
*                (KA) = ADDRESS OF START OF KEYWORD.
*                (AB - AB+4) = KEYWORD. 
*                (FA) .NE. 0 IF FIRST CHARACTER = *$*.
*                (ARGA) .NE. 0 IF FIRST CHARACTER = */*.
*                (ISDA) = 0 IF COMMENT COMMAND. 
* 
*         CALLS  ASN. 
  
  
 AKW2     LMN    1R*&1R/
          NJN    AKW5        IF NOT */* 
          AOM    ARGA        SET KRONOS FORMAT
          UJN    AKW4        SKIP PREFIX CHARACTER
  
 AKW3     AOD    FA          SET PROGRAM FILE BYPASS
 AKW4     AOD    CA          SKIP PREFIX CHARACTER
          STD    KA 
 AKW5     RJM    ASN         ASSEMBLE NAME
          LDI    CA          CHECK SEPARATOR
          LMN    1R$
          ZJN    AKWX        IF INCORRECT SEPARATOR 
          LDD    AB          RETURN WITH KEYWORD STATUS 
  
 AKW      SUBR               ENTRY/EXIT 
          LDC    CHAR        SET CHARACTER ADDRESS
          STD    CA 
          STD    KA 
          LDI    CA          CHECK CHARACTER
          SBN    1R0
          MJN    AKW5        IF ALPHA 
          SBN    1R9+1-1R0
          PJN    AKW1        IF NOT DIGIT 
          RJM    ASN         ASSEMBLE NAME
          AOD    CA          SKIP SEPARATOR 
          STD    KA 
 AKW1     LDI    CA          CHECK CHARACTER
          LMN    1R$
          ZJN    AKW3        IF *$* 
          LMN    1R*&1R$
          NJP    AKW2        IF NOT (*) 
          STM    ISDA 
          LDN    ZERL 
          CRD    AB 
          LCN    0           INDICATE COMMENT COMMAND 
          UJN    AKWX        RETURN 
 ASN      SPACE  4,15 
**        ASN - ASSEMBLE NAME.
* 
*         ENTRY  (CA) = FIRST ADDRESS OF CHARACTER STRING.
*                (ARGA) = 0  IF SCOPE FORMAT. 
* 
*         EXIT   (AB - AB+4) = ASSEMBLED NAME.
* 
*         ERROR  TO *ERR* IF ERROR. 
*                TO *ATX1* IF ERROR AND EXIT FLAG SET.
*                TO *RCA10* IF ERROR ON *ARG=* READ AHEAD.
* 
*         USES   T1.
* 
*         CALLS  IOC. 
  
  
 ASN      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR ASSEMBLY 
          CRD    AB 
          LDN    AB          SET BYTE ADDRESS 
          STD    T1 
 ASN1     RJM    IOC         INTERROGATE ONE CHARACTER
          ZJN    ASNX        IF END OF STRING 
          SHN    6
          STI    T1 
          RJM    IOC         INTERROGATE ONE CHARACTER
          ZJN    ASNX        IF END OF STRING 
          RAI    T1 
          AOD    T1          ADVANCE BYTE 
          LMN    AB+4 
          NJN    ASN1        IF MORE CHARACTERS TO PROCESS
          LJM    ERR         FORMAT ERROR 
 ASNA     EQU    *-1         (ATX)
*         LJM    RCA10       (*ARG=* ON READ AHEAD) 
*         LJM    ATX1        (EXIT FLAG SET)
*         LJM    ERR         (END OF EXIT. CARD SEARCH, EXIT FLAG SET)
 CAT      SPACE  4,10 
**        CAT - CLEAR ADDRESS FOR *TCS* EXECUTE COMMAND.
* 
*         EXIT   (A) = (T1) = (CP) + *RFCW*.
*                (CM - CM+4) = (*RFCW*).
* 
*         USES   T1, CM - CM+4. 
  
  
 CAT      SUBR               ENTRY/EXIT 
          LDD    CP          READ ADDRESS FOR EXECUTE COMMAND FROM CM 
          ADN    RFCW 
          STD    T1 
          CRD    CM 
          LDN    0           CLEAR ADDRESS
          STD    CM+2 
          LDD    CM+3 
          LPN    77 
          STD    CM+3 
          LDD    T1 
          CWD    CM 
          UJN    CATX        RETURN 
 CVD      SPACE  4,10 
**        CVD - CHECK VALID *DMP=* CALL 
* 
*         EXIT   TO CALLING ROUTINE IF *DMP=* CALL VALID. 
* 
*         ERROR  TO *ERR1* IF *DMP=* CALL INCORRECT.
* 
*         USES   CM - CM+4. 
  
  
 CVD      SUBR               ENTRY/EXIT 
          LDD    FL 
          ZJN    CVD2        IF NO FL PRESENT 
          LDD    CP          CHECK SSM STATUS 
          ADC    DBAW 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          MJN    CVD1        IF SECURE MEMORY 
          SHN    21-11-21+13
          PJN    CVDX        IF NOT INTERACTIVE JOB STEP INITIATION 
          LDC    /ERR/EM04   * INTERACTIVE JOB STEP, DUMP DISABLED.*
          STM    CVDA 
 CVD1     LDM    TCSD        CHECK USER ACCESS
          ZJN    CVDX        IF ACCESS ALLOWED
          LDC    UJNI+IST4-ISTB 
          STM    ISTB        SET JUMP 
 CVD2     LDC    /ERR/EM09   * SECURE MEMORY, DUMP DISABLED.* 
 CVDA     EQU    *-1
          UJN    ERR1        ISSUE ERROR MESSAGE
  
          ERRNG  37+ISTB-IST4 IF JUMP OUT OF RANGE
 ERR      SPACE  4,10 
**        ERR - PROCESS ERROR.
* 
*         ENTRY  AT *ERR* IF *FORMAT ERROR ON COMMAND.* 
*                MESSAGE TO BE ISSUED.
*                AT *ERR1* IF (A) = ADDRESS OF ERROR MESSAGE. 
* 
*         USES   EF, EP.
* 
*         CALLS  *3AM*. 
* 
*         MACROS EXECUTE. 
  
  
 ERR      LDC    /ERR/EM03   * FORMAT ERROR ON COMMAND.*
 ERR1     STD    EF 
          LDN    0           INDICATE *TCS* CALL
          STD    EP 
          EXECUTE  3AM       EXECUTE ERROR PROCESSOR
 IOC      SPACE  4,10 
**        IOC - INTERROGATE ONE CHARACTER.
* 
*         ENTRY  (CA) = ADDRESS OF CHARACTER STRING.
* 
*         EXIT   A = 0 IF END OF PARAMETER. 
*                  = NEXT CHARACTER OF PARAMETER. 
*                (CA) = CA + 1. 
  
  
 IOC1     AOD    CA 
          LDM    -1,CA
  
 IOC      SUBR
          LDI    CA 
          ZJN    IOCX        IF END OF PARAMETERS 
          SBN    1R9+1
          MJN    IOC1        IF NOT SEPARATOR 
          SBN    1R*-1R9-1
          ZJN    IOC1        IF ASTERISK
          LDN    0
          UJN    IOCX        RETURN 
 IPL      SPACE  4,10 
**        IPL - INITIALIZE PROGRAM LOAD.
* 
*         USES   T1, CM - CM+4, CN - CN+4, FS - FS+4. 
* 
*         CALLS  RRR, SRR.
* 
*         MACROS DELAY, MONITOR, NFA, PAUSE.
  
  
 IPL      SUBR               ENTRY/EXIT 
          LDD    CP          READ SENSE SWITCH WORD 
          ADN    SNSW 
          CRD    CN 
          ADN    EECW-SNSW   READ ENTRY/EXIT CONTROL
          CRD    CM 
          ADN    TERW-EECW   CLEAR EVENT DESCRIPTOR 
          CRD    FS 
          LDD    FS+2 
          SCN    77 
          STD    FS+2 
          LDN    0
          STD    FS+3 
          STD    FS+4 
          LDD    CP 
          ADN    TERW 
          CWD    FS 
          LDD    CM          SAVE NO EXIT FLAG, KILL REPRIEVED FLAG 
          LPC    4400 
          STD    T1 
          LDN    ZERL 
          CRD    FS 
          CRD    CM          PRESERVE NO EXIT FLAG
          LDD    T1 
          STD    CM 
          LDD    CN+3        CLEAR PAUSE BIT
          SCN    1
          STD    CN+3 
          LDD    CN          CLEAR *OVERRIDE* REQUIRED
          LPC    6777 
*         LPC    7777        (DMP= LOAD)
 IPLC     EQU    *-1
          STD    CN 
          LDD    CP          STORE SENSE SWITCH WORD
          ADN    SNSW 
          CWD    CN 
          ADN    MS2W-SNSW   CLEAR CONSOLE MESSAGE
          CWD    FS 
          ADN    TIAW-MS2W   READ TERMINAL INTERRUPT ADDRESS WORD 
          CRD    CN 
          ADN    EECW-TIAW   STORE ENTRY/EXIT CONTROL 
          CWD    CM 
          ADN    LOFW-EECW   CLEAR LIST OF FILES ADDRESS
          CRD    FS 
          STD    T0 
          LDN    0
          STD    FS 
          STD    FS+1 
          STD    FS+2 
          LDD    T0 
          CWD    FS 
          LDN    0           RESET TERMINAL INTERRUPT ADDRESS WORD
          STD    CN+2 
          STD    CN+3 
          STD    CN+4 
          LDD    CP 
          ADN    TIAW 
          CWD    CN 
          LDD    CP          READ FL CONTROL
          ADN    FLCW 
          CRD    CM 
          LDD    CM+1        SET LAST RFL 
          NJN    IPL2        IF SET 
          LDC    SYSDEF      NEW FL = MIN(DEFAULT FL, MFL)
          SBD    CM 
          MJN    IPL1        IF MAX FL .GT. DEFAULT FL
          LDN    0           SET NEW FL = MFL 
 IPL1     ADD    CM          SET NEW FL = DEFAULT FL
 IPL2     LPC    3777        SET STORAGE REQUEST
          STM    RQSD 
          LDN    **          INTERACTIVE INDICATOR
 IPLE     EQU    *-1
          ZJP    IPL5.1      IF NOT ON-LINE INTERACTIVE JOB 
          RJM    SRR         SET R-REGISTER TO IAF RA 
          LDC    ** 
 IPLA     EQU    *-1         (TERMINAL TABLE ADDRESS) 
          ADK    /REM/VSTT
          CRD    CN 
          RJM    RRR         RESTORE R-REGISTER 
          LDD    IR+4 
          LMN    1
          ZJN    IPL4.1      IF *DMP=* JOB BEING EXECUTED 
          LDD    CN          CHECK TERINAL INTERRUPT BIT
          SHN    21-13
          MJN    IPL4        IF INTERRUPT SELECTED
 IPL3     LDD    CN 
          SHN    21-5 
          PJN    IPL4.1      IF PROMPT ALREADY ON 
          LDD    CN 
          SCN    40          CLEAR BIT
          STD    CN 
          LDN    53D         SET BIT IN *VSTT* TO CLEAR 
          STM    IPLB+3 
 IPL4     LDD    MA 
          CWM    IPLB,ON
          LDK    ZERL 
          CRD    CM 
          MONITOR  TSEM 
          LDD    CM+1 
          NJN    IPL4.2      IF NOT IAF INACCESSABLE OR ERROR 
 IPL4.1   LJM    IPL6        PROCESS ERROR
  
 IPL4.2   LMC    7777 
          NJN    IPL3        IF REQUEST COMPLETE
          PAUSE  ST 
          LDC    3600        *TSEM* QUEUE FULL - DELAY AND RETRY
          STD    T1 
 IPL5     DELAY 
          SOD    T1 
          ZJN    IPL4        IF TIME TO REISSUE REQUEST 
          UJN    IPL5        CONTINUE TO DELAY
  
 IPL5.1   LDC    ** 
 IPLD     EQU    *-1         (CONNECTION STATUS)
          LMK    DTCS 
          NJN    IPL6        IF NOT DETACHED JOB
          NFA    RC1N        READ NFL RECOVERY WORD 
          CRD    CM 
          LDD    CM+4 
          LPC    7676        CLEAR TERMINAL INTERRUPT/PROMPT OFF
          STD    CM+4 
          NFA    RC1N        REWRITE NFL RECOVERY WORD
          CWD    CM 
 IPL6     LDD    CP          CLEAR USER LIBRARY AND RELOCATABLE FLAGS 
          ADC    LB1W 
          STD    T1          SAVE ADDRESS 
          CRD    CM 
          LDD    CM 
          SCN    3
          STD    CM 
          LDD    T1 
          CWD    CM 
          LDD    IR+4 
          LMN    1
          ZJN    IPL7        IF *DMP=* JOB BEING EXECUTED 
          LDD    CP          CLEAR LAST FILE EXECUTED 
          ADC    EOCW 
          CRD    CM 
          LDN    0
          STD    CM 
          LDD    CP 
          ADC    EOCW 
          CWD    CM 
 IPL7     LJM    IPLX        RETURN 
  
  
 IPLB     CON    /REM/VCDT   CLEAR TERMINAL INTERRUPT 
          CON    0,/REM/VSTT WORD TO CLEAR
          CON    59D         BIT TO CLEAR 
          CON    0           TERMINAL NUMBER
 ISD      SPACE  4,15 
**        ISD - ISSUE COMMAND TO DAYFILE. 
* 
*         ENTRY  (A) = ADDRESS OF ZERO FILLED COMMAND.
*                (FL) = JOB FIELD LENGTH. 
*                (EF) = ERROR STATUS. 
* 
*         EXIT   (A) = 0 IF COMMAND ISSUED VIA *DFM* CALL.
* 
*         USES   T2, T3, T9.
* 
*         CALLS  DFM. 
  
  
 ISD2     STM    ISDB+4      SET MESSAGE ADDRESS
          LDD    FL 
          ZJN    ISD1        IF NO FIELD LENGTH 
          LDD    EF 
          NJN    ISD1        IF ERROR FLAG SET
          LDD    RA          STORE *MSG* REQUEST
          SHN    6
          ADN    1
          CWM    ISDB,ON
  
 ISD      SUBR               ENTRY/EXIT 
          STD    T2          SET COMMAND ADDRESS
          ADN    5*5         SET END OF MESSAGE ADDRESS 
          STD    T3 
          LDC    0
 ISDA     EQU    *-1
          NJN    ISD2        IF COMMAND BEING ISSUED VIA *MSG* CALL 
 ISD1     LDI    T3          SAVE END OF MESSAGE BYTE 
          STD    T9 
          LDN    0           ENSURE END OF MESSAGE
          STI    T3 
          LDD    T2          ISSUE COMMAND TO DAYFILE 
          RJM    DFM
          LDD    T9 
          ZJN    ISDX        IF COMMAND .LE. 50 CHARACTERS
          STI    T3 
          LDD    T3          ISSUE REMAINDER OF COMMAND 
          LMC    NMSN 
          RJM    DFM
*         LDN    0
          UJN    ISDX        RETURN 
  
  
 ISDB     VFD    18/0LMSG,6/0,12/0,12/4000,12/0 
 MSR      SPACE  4,10 
**        MSR - MASS STORAGE ERROR PROCESSING.
* 
*         EXIT   TO *1RJ* IF JOB ROLLABLE AND RECOVERABLE ERROR.
*                TO CALLER IF JOB NOT ROLLABLE OR NONRECOVERABLE
*                ERROR. 
  
 MSR      SUBR               ENTRY/EXIT 
          ENDMS 
          LDM    RDCT        CHECK NON-RECOVERABLE MASS STORAGE ERROR 
          SHN    21-12
          MJN    MSRX        IF NON-RECOVERABLE 
          LDM    MSD         CHECK FOR SUBSYSTEM
          SHN    21-13
          PJN    MSRX        IF A SUBSYSTEM, ABORT JOB
          LDD    T5          SET EQUIPMENT TO WAIT FOR
          STD    IR+4 
 MSRA     LDN    0
*         LDN    1           (JOB ADVANCE NOT SET)
          NJN    MSR1        IF JOB ADVANCE NOT SET 
          STD    CM+1        CLEAR JOB ADVANCE
          MONITOR  JACM 
 MSR1     EXECUTE  1RJ       ROLL JOB 
*         LJM    PPR         DOES NOT RETURN
 RAS      SPACE  4,10 
**        RAS - RESET AFTER *SSJ=* JOB. 
* 
*         EXIT   IF *SSJ=* JOB, CONTROL POINT AREA RESTORED,
*                FILES WITH SPECIAL ID SET ARE DROPPED. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  /3AF/RCF, *3AF*. 
* 
*         MACROS EXECUTE. 
  
  
 RAS      SUBR               ENTRY/EXIT 
          LDD    CP          CHECK FOR *SSJ=* STATUS
          ADC    SEPW 
          CRD    CM 
          LDD    CM 
          SHN    21-2 
          PJN    RASX        IF NOT *SSJ=* JOB
          EXECUTE  3AF
          LDN    1           JOB IS BOTH *SSJ=* AND *DMP=*
          RJM    /3AF/RCF    RESTORE CONTROL POINT FIELDS 
          UJN    RASX        RETURN 
 RQC      SPACE  4,15 
**        RQC - REQUEST CENTRAL MEMORY. 
* 
*         ENTRY  (A) = STORAGE REQUEST. 
* 
*         EXIT   (A) = 0 IF STORAGE ASSIGNED. 
*                (A) .LT. 0 IF STORAGE NOT AVAILABLE. 
*                (A) .GT. 0 IF STORAGE REQUEST PENDING. 
* 
*         USES   T1.
* 
*         CALLS  RSI. 
  
  
 RQC      SUBR               ENTRY/EXIT 
          NJN    RQC1        IF NOT 0 FL
          LDN    1
 RQC1     STD    T1 
          SBD    FL 
          ZJN    RQCX        IF NO CHANGE 
          MJN    RQC2        IF DECREASE
          LDN    PSNI        FORCE CLEAR OF MEMORY
          STM    BCPH 
 RQC2     LDD    T1          SET FL REQUIRED
          RJM    RSI         REQUEST STORAGE
          UJN    RQCX        RETURN 
 RQE      SPACE  4,15 
**        RQE - REQUEST EXTENDED CORE STORAGE.
* 
*         ENTRY  (A) = STORAGE REQUEST. 
*                (RQSF) = ROLLOUT ALLOWED FLAG. 
* 
*         EXIT   (A) = 0 IF STORAGE ASSIGNED. 
*                (A) .LT. 0 IF STORAGE UNAVAILABLE. 
*                (A) .GT. 0 IF STORAGE REQUEST PENDING. 
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  REI. 
  
  
 RQE      SUBR               ENTRY/EXIT 
          STD    T1          SAVE REQUEST 
          ZJN    RQE1        IF RELEASE OF STORAGE
          LDM    RQSF 
          NJN    RQE1        IF JOB NOT ROLLABLE
          LDN    SSTL        CHECK EXTENDED MEMORY CONTROL
          CRD    CM 
          LDD    CM 
          SHN    21-5 
          MJN    RQEX        IF USER EXTENDED MEMORY DISABLED 
 RQE1     LDD    CP          FETCH EXTENDED MEMORY STATUS WORD
          ADN    ECSW 
          CRD    CM 
          LDD    T1 
          SBD    CM+4 
          ZJN    RQEX        IF NO CHANGE 
          MJN    RQE2        IF DECREASE
          STM    CSTD        SET WORD COUNT FOR CLEAR 
          LDD    CM+4 
          STM    CSTC        SET FWA FOR CLEAR
          LDN    PSNI 
          STM    CSTB        ENABLE CLEARING OF EXTENDED MEMORY 
          STM    BCPH        FORCE MEMORY CLEARING
          LDC    LPNI 
          STM    BCPN 
 RQE2     LDD    T1          SET EXTENDED MEMORY FL REQUIRED
          RJM    REI         REQUEST STORAGE
          LJM    RQEX        RETURN 
 RQS      SPACE  4,15 
**        RQS - REQUEST STORAGE.
* 
*         ENTRY  (RQSD) = STORAGE REQUEST.
*                (RQSE) = EXTENDED MEMORY REQUEST FOR *DMP=* ROLLIN.
*                (RQSF) = ROLLOUT ALLOWED FLAG. 
* 
*         EXIT   IF STORAGE ASSIGNED. 
*                TO *DPP* IF REQUEST PENDING OF UNAVAILABLE.
* 
*         USES   T1, CM - CM+4, CN - CN+4.
* 
*         CALLS  RLS, RQC, RQE. 
* 
*         MACROS MONITOR. 
  
  
 RQS      SUBR               ENTRY/EXIT 
 RQSA     LDN    0
*         LDN    1           (*DMP=* PROCESSING)
          NJN    RQS4        IF *DMP=* ROLLIN 
          LDD    CP          READ ECS STATUS AND CONTROL WORDS
          ADN    ECSW 
          CRD    CM 
          ADN    ELCW-ECSW
          CRD    CN 
          LDD    CN+1 
 RQSB     NJN    RQS1        IF EXTENDED MEMORY REQUEST PRESENT 
*         PSN                (*DMP=* PROGRAM LOAD)
          LDD    CM+4 
 RQSC     NJN    RQS2        IF EXTENDED MEMORY CURRENTLY ASSIGNED
*         UJN    RQS3        (*DMP=* PROGRAM LOAD)
*         NJN    RQS0        (EXTENDED MEMORY PROTECT SELECTED) 
          UJN    RQS4        PROCESS CENTRAL MEMORY REQUEST 
  
 RQS0     STD    CN+1        SET REQUESTED FLE TO CURRENT FLE 
 RQS1     LDC    MCMX/100 
          SBM    RQSD 
          MJN    RQS2        IF REQUEST .GE. MINIMUM CM WITH ECS
          LDC    MCMX/100 
          STM    RQSD        FORCE FL UP TO MINIMUM 
 RQS2     LDD    CN+1 
 RQS3     STM    RQSE        SET EXTENDED MEMORY REQUEST
 RQS4     LDC    ** 
 RQSD     EQU    *-1
          RJM    RQC         REQUEST CENTRAL MEMORY 
          NJN    RQS5        IF CM NOT ASSIGNED 
          LDC    0
 RQSE     EQU    *-1
          RJM    RQE         REQUEST EXTENDED MEMORY
          NJN    RQS5        IF EXTENDED MEMORY NOT ASSIGNED
          LJM    RQSX        RETURN WITH STORAGE ASSIGNED 
  
 RQS5     SHN    -21
          STD    T1 
          LDC    ** 
 RQSF     EQU    *-1         (= 0 IF ROLLOUT ALLOWED) 
          ZJN    RQS7        IF JOB ROLLABLE
 RQS6     LJM    RQS10       RECALL *1AJ* 
  
 RQS7     LDD    T1 
          ZJN    RQS6        IF REQUEST PENDING 
          LDN    0           IF NOT *TCS* CALL
*         LDN    1           IF *TCS* CALL
 RQSG     EQU    *-1
          NJN    RQS9        IF *TCS* CALL, DO NOT RELEASE STORAGE
 RQSJ     PSN 
*         UJN    RQS8        (EXTENDED MEMORY PROTECT SELECTED) 
          RJM    RLS         RELEASE STORAGE
          UJN    RQS9        ROLLOUT JOB
  
 RQS8     LDC    MCMX/100    REDUCE TO MINIMUM CM 
          RJM    RQC
 RQS9     LDD    CP          SET ROLLIN FL
          ADN    FLSW 
          CRD    CM 
          ADN    FLIW-FLSW
          CRD    CN 
          LDD    CM 
          ADM    RQSD 
          STD    CN+4 
          LDM    RQSE 
          STD    CN+3 
          LDD    CP 
          ADN    FLIW 
          CWD    CN 
          LDN    0           ROLLOUT CP 
          STD    CM+1 
          MONITOR  ROCM 
  
*         ENTER PP INTO RECALL. 
  
 RQS10    LDN    0           SET *JACM* OPTIONS 
          STD    CM+1 
          MONITOR  JACM      CLEAR JOB ADVANCE
          LDN    ZERL        CLEAR RECALL PARAMETERS
          CRD    CM 
          LDN    CFIR        INDICATE STORAGE MOVE PENDING
          STD    CM 
          LDD    MA          ENTER PP INTO RECALL 
          CWD    IR 
          ADN    1
          CWD    CM 
          MONITOR  RECM      RECALL *1AJ* 
          LJM    PPR         EXIT TO PP RESIDENT
  
  
          ERRNG  37+RQSC-RQS3 IF JUMP OUT OF RANGE
 SSC      SPACE  4,15 
**        SSC - SET SYSTEM CALL.
* 
*         ENTRY  (A) = CALL INDEX.
* 
*         ERROR  HANG IF PROGRAM NOT FOUND. 
* 
*         USES   AB - AB+4, CM+1, CM+2. 
* 
*         CALLS  SCL. 
* 
*         MACROS MONITOR. 
  
  
 SSC      ADC    SSCB        SET NAME ADDRESS 
          STM    SSCA 
          LDC    /ERR/EM22   * UNIDENTIFIED PROGRAM FORMAT.*
 SSCC     LDD    MA 
*         UJN    SSC2        (SHELL LOAD IN PROGRESS) 
          CWM    *,ON 
 SSCA     EQU    *-1
          SBN    1
          CRD    AB 
          LDN    1           SET SYSTEM CALL FLAG 
          STD    AB+4 
          LDM    SSCA        CHECK PROGRAM TO BE LOADED 
          ADC    -SSCB
          LMN    BEGI 
          ZJN    SSC1        IF *BEGIN* 
          LDC    UJNI+CSTB-CSTA 
          STM    CSTA 
 SSC1     RJM    SCL         SEARCH CENTRAL LIBRARY 
          LDN    0
          STD    CM+2        SET NO ERROR FLAG
          LDC    *
          STD    CM+1        ADDRESS WHERE ERROR DETECTED 
          MONITOR  CHGM      CONDITIONAL HANG 
          LDC    /ERR/EM26   * SYSTEM ROUTINE MISSING - XXXXXXX    *
 SSC2     LJM    ERR1        ISSUE ERROR MESSAGE
  
          ERRNG  37+CSTA-CSTB IF JUMP OUT OF RANGE
  
  
 SSCB     BSS    0
          LOC    0
  
 LDR=     VFD    48/0LLDR=
 BEGI     VFD    48/0LBEGIN 
 SLDR     VFD    48/0LSLDR= 
  
          LOC    *O 
 STK      SPACE  4,10 
**        STK - SKIP TO KEYWORD.
* 
*         ENTRY  (KA) = KEYWORD ADDRESS.
* 
*         EXIT   (A) = AMOUNT TO INCREASE BUFFER ADDRESS BY IF BUFFER 
*                REASSEMBLED. 
*                (CBUF) = REASSEMBLED COMMAND IF COMMAND DOES NOT 
*                BEGIN WITH KEYWORD.
* 
*         USES   T0, T1, T3.
  
  
 STK8     LDN    0           NO BUFFER ADDRESS INCREMENT
  
 STK      SUBR               ENTRY/EXIT 
          LDM    CSEB 
          LPN    50 
          NJN    STK8        IF *ARG=* OR *SDM=* PRESENT
          LDC    CHAR-1 
          STD    T3 
          LDD    KA 
          ADC    -CHAR
          ZJN    STKX        IF COMMAND BEGINS WITH KEY WORD
          STD    T0          NUMBER OF CHARACTERS TO SKIP 
          LDC    STMT-1 
          STD    T1 
 STK1     AOD    T1          ADVANCE BYTE INDEX 
          LDI    T1 
          SHN    -6 
          LMN    1R 
          ZJN    STK2        IF UPPER CHARACTER IS A BLANK
          SOD    T0          DECREMENT SKIP COUNT 
          ZJN    STK5        IF END OF SEQUENCE NUMBER
 STK2     LDI    T1 
          LPN    77 
          LMN    1R 
          ZJN    STK1        IF LOWER CHARACTER IS A BLANK
          SOD    T0          DECREMENT SKIP COUNT 
          NJN    STK1        IF NOT END OF SEQUENCE NUMBER
  
*         MOVE COMMAND THAT STARTS WITH UPPER CHARACTER OF BYTE.
  
 STK3     AOD    T3          ADVANCE BYTE ADDRESS 
          AOD    T1 
          LDI    T1 
          STI    T3 
          NJN    STK3        IF NOT END OF COMMAND
          UJN    STK6        ZERO FILL REMAINDER OF BUFFER
  
*         MOVE COMMAND THAT STARTS WITH LOWER CHARACTER OF BYTE.
  
 STK4     AOD    T1 
 STK5     AOD    T3          ADVANCE BYTE ADDRESS 
          LDM    1,T1 
          SHN    6
          LMI    T1 
          SHN    6
          STI    T3 
          LDI    T1 
          NJN    STK4        IF NOT END OF BUFFER 
  
*         ZERO FILL REMAINDER OF COMMAND BUFFER.
  
 STK6     AOD    T3 
          LMC    CHAR+55*2
          ZJN    STK7        IF END OF BUFFER 
          LDN    0           CLEAR BYTE 
          STI    T3 
          UJN    STK6        CLEAR NEXT BYTE
  
 STK7     LDN    CHAR-STMT   BUFFER ADDRESS INCREMENT 
          LJM    STKX        RETURN 
 TSS      SPACE  4,10 
**        TSS - TRANSLATE SCOPE PARAMETER.
* 
*         ENTRY  (AB - AB+4) PARAMTER.
*                ((CA))      SEPARATOR. 
* 
*         EXIT   (A)         4 BIT SCOPE SEPARATOR CODE.
* 
*         USES   T1.
  
  
 TSS2     ADN    17 
  
 TSS      SUBR               ENTRY/EXIT 
          LDI    CA 
          ZJN    TSS2        IF TERMINATOR
          LDN    TSSL        TABLE LIMIT
          STD    T1 
 TSS1     SOD    T1 
          MJN    TSS2        IF END OF TABLE
          LDM    TSSA,T1     TABLE ENTRY
          LPN    77 
          LMI    CA 
          NJN    TSS1        IF NO MATCH
          LDM    TSSA,T1     SET CODE 
          SHN    -6 
          UJN    TSSX        RETURN 
  
  
****      SCOPE SEPARATOR EQUIVALENCES. 
 TSSA     VFD    6/1,6/1R,
          VFD    6/2,6/1R=
          VFD    6/3,6/1R/
          VFD    6/4,6/1R(
          VFD    6/5,6/1R+
          VFD    6/6,6/1R-
          VFD    6/7,6/1R 
          VFD    6/10B,6/1R;
 TSSL     EQU    *-TSSA 
****
          SPACE  4,15 
**        RESIDENT COMMON DECKS.
  
  
*CALL     COMPCLX 
 PRR$     EQU    1           SELECT REMOTE ASSEMBLY OF *PRR* AND *PIR*
 PIR$     EQU    1           SELECT ASSEMBLY OF *PIR* FOR IAF R-REG 
 SRR$     EQU    1           DISABLE SAVE AND RESTORE OF T1 AND T2
*CALL     COMPSRR 
*CALL     COMPREI 
*CALL     COMPRLS 
*CALL     COMPRSI 
          SPACE  4,10 
          QUAL
          USE    BUFFERS
  
 STMT     CON    0           COMMAND BUFFER 
*                            (STMT) = 0 IF NO COMMAND 
  
 CHAR     EQU    STMT+55     COMMAND STRING BUFFER
 CHARE    EQU    CHAR+55*2   END OF COMMAND STRING BUFFER 
  
 OVL      EQU    CHARE       OVERLAY LOAD ADDRESS 
          ERRNG  EPFW-OVL-5-ZAUL CHECK LENGTH OF *0AU*
          QUAL   *
          TITLE  TCS PRESET ROUTINES. 
 INT      SPACE  4,10 
**        INT - CONTINUATION OF INITIALIZATION ROUTINE. 
  
  
 INT7     RJM    CES         CHECK FOR *TCS* EXECUTE COMMAND
          ZJN    INT8        IF NOT EXECUTE COMMAND 
          AOM    RQSG        SET *TCS* FLAG 
 INT8     RJM    CIJ         CHECK FOR INTERACTIVE JOB
          RJM    CSC         CHECK *SHELL* CONTROL
          RJM    CCF         CLEAR CONTROL FIELDS 
 INT9     UJP    INT15       PROCESS *DMP=* 
  
 INT10    LDD    CN+1        CHECK ERROR FLAG 
          ZJN    INT11       IF NO ERROR FLAG 
          LJM    DPP         DROP PPU 
  
 INT11    LDD    CW          CHECK *DMP=* JOB 
          SHN    21-4 
          MJN    INT12       IF *DMP=* PRESENT
          LDD    IR+2 
          LMN    4
          ZJN    INT13       IF READ FUNCTION 
          LMN    5&4
          ZJN    INT9        IF EXECUTE FUNCTION
 INT12    LDC    INTA        TCS INCORRECT REQUEST
          RJM    DFM
          MONITOR  ABTM      ABORT JOB
          LJM    PPR
  
 INTA     DATA   C* TCS INCORRECT REQUEST.* 
  
 INT13    LDD    IR+3        CHECK ARGUMENT FORMAT
          SHN    21-13
          PJN    INT14       IF NOT SCOPE FORMAT
          LDC    -4000B      CLEAR SCOPE FLAG 
          RAD    IR+3 
          UJN    INT15       PROCESS *DMP=* 
  
 INT14    AOM    ARGA        SET KRONOS ARGUMENT CRACKING 
  
*         *DMP=* PROCESSING.
  
 INT15    LDD    IR+2 
          ZJN    INT18       IF MONITOR CALL
          LMN    2
          NJN    INT17       IF NOT *DIS* CALL
 INT16    LDD    CW 
          SHN    21-4 
          PJN    INT17       IF NO *DMP=* PRESENT 
          RJM    RAS         RESET AFTER *SSJ=* JOB 
          EXECUTE  3AF
          LJM    /3AF/RFJ    RESET FORMER JOB 
  
 INT17    UJP    INT21       CONTINUE 
  
 INT18    LDD    CP 
          ADC    SPCW        READ CALL WORD 
          CRD    CN 
          CRD    AB 
          LDD    CN+1 
          SHN    21-1 
          PJN    INT16       IF NOT *1RO* COMPLETION
          LDN    0           DISABLE *RFL* EXTENDED MEMORY CONTROL
          STM    RQSB 
          LDC    UJNI+RQS3-RQSC PRESERVE ECS FOR *DMP=* PROGRAM 
          STM    RQSC 
          LDD    CN 
          LMN    77 
          ZJN    INT20       IF COMMAND CALL
          EXECUTE  3AF
          LJM    /3AF/IDP    INITIALIZE *DMP=* PROGRAM LOAD 
  
 INT20    LDC    UJNI+BCP19-BCPG
          STM    BCPG        BYPASS CLEAR OF MEMORY 
          LDD    CP          RESET INPUT REGISTER 
          ADC    SEPW 
          CRD    IR 
          LDD    IR+1 
          SCN    77 
          STD    IR+1 
          LDD    CP 
          SHN    -7 
          RAD    IR+1 
          LDC    BCP3 
          STM    BCPA+1 
 INT21    LDD    IR+2 
          LMN    4
          NJN    INT22       IF NOT COMMAND READ
          LJM    RCA         READ COMMAND TO ADDRESS
  
 INT22    LDD    CP          READ APPLICATION ACCOUNTING CONTROL WORD 
          ADN    FPFW 
          CRD    T3 
          LDD    T3          CHECK FOR ACCOUNTING IN PROCESS
          LPC    1400 
          ZJN    INT22.1     IF APPLICATION ACCOUNTING NOT SET
          RJM    IAA         ISSUE APPLICATION ACCOUNTING MESSAGE 
  
*         THE CODE FOLLOWING THE *RJM RNC* AT *INT22.1* MUST NOT
*         BE DESTROYED WHEN COMMANDS ARE READ.  THE FOLLOWING CODE
*         PREVENTS OVERLAP OF THE COMMAND BUFFERS INTO THIS AREA. 
  
          IFMI   *-CHARE+2,2
          UJN    INT22.1     READ NEXT COMMAND
          ORG    CHARE-2     ALLOW ROOM FOR COMMAND BUFFERS 
  
 INT22.1  RJM    RNC         READ NEXT COMMAND
          RJM    CSL         CHECK COMMAND LIMIT
          LDM    STMT 
          NJN    INT23       IF NOT EMPTY COMMAND BUFFER
 INT22.2  BSS    0
 INTB     RJM    CAT         CLEAR ADDRESS FOR *TCS* EXECUTE COMMAND
*         LJM    INT25       (INTERACTIVE COMMANDS MONITORED) 
          LJM    IST5        STORE POINTERS 
  
*         CLEAR *0ST* SCP FLAG IN EJT ENTRY.
  
 INT23    SFA    EJT,JO 
          ADK    JSNE 
          CRD    CM 
          LDD    CM+4 
          LPC    3777        CLEAR CHECK CONNECTIONS FLAG 
          STD    CM+4 
          SFA    EJT,JO 
          ADK    JSNE 
          CWD    CM 
  
*         REWIND PRIMARY FILE.
  
          LDD    CP          READ FST ADDRESS FOR PRIMARY FILE
          ADN    TFSW 
          CRD    FS 
          LDD    FS+1 
          ZJN    INT23.1     IF NO PRIMARY FILE 
          NFA    FS+1,R      READ FST ENTRY FOR PRIMARY FILE
          ADN    FSTL 
          CRD    CN 
          LDD    CN+2 
          ZJN    INT23.1     IF NULL FILE 
          LDD    CN+1        REWIND FILE
          STD    CN+2 
          LDN    FSMS 
          STD    CN+3 
          LDD    CN+4        RESET STATUS 
          SCN    77 
          LMN    5
          STD    CN+4        SET FILE STATUS BYTE 
          NFA    FS+1,R      WRITE UPDATED FST ENTRY FOR PRIMARY FILE 
          ADN    FSTL 
          CWD    CN 
 INT23.1  LDD    CP          RESET ERROR PROCESSING LIMIT 
          ADK    ACLW 
          CRD    CM 
          LDK    EPRL 
          STD    CM 
          LDD    CP 
          ADK    ACLW 
          CWD    CM 
 INTC     RJM    UPS         UNPACK COMMAND 
*         LJM    INT26       (*SHELL* CONTROL IN FORCE) 
          ZJN    INT24       IF NOT POSSIBLE CONTINUATION COMMAND 
          LDM    CHAR 
          ZJP    INT22.2     IF NULL LINE 
          LDN    0           FLAG POSSIBLE CONTINUATION COMMAND 
          STM    SCLC 
          AOM    CSEA        FLAG POSSIBLE CONTINUATION COMMAND 
          RJM    AKW         ASSEMBLE KEYWORD 
 INT23.2  ZJP    TCS6        IF NO KEYWORD
          MJN    INT24.1     IF COMMENT COMMAND 
          ISTORE SCLB,(ZJN SCLX)  TERMINATE IF NOT *ARG=* 
          RJM    IPL         INITIALIZE PROGRAM LOAD
          LJM    TCS1        CONTINUE PROCESSING
  
 INT24    RJM    AKW         ASSEMBLE KEYWORD 
          ZJN    INT23.2     IF NO KEYWORD
          MJN    INT24.1     IF COMMENT COMMAND 
          RJM    SSF         SEARCH FOR SPECIAL FORMAT
          RJM    IPL         INTIALIZE PROGRAM LOAD 
          LJM    TCS3        LOAD PROGRAM 
  
 INT24.1  LDM    TCSA 
          ZJP    IST6        IF NO CHARGE REQUIRED
          LDC    /ERR/EM06   * CHARGE COMMAND REQUIRED.*
          LJM    ERR1        PROCESS ERROR
  
 INT25    LDC    LDNI+MS2W-MS1W  ENABLE *MS1W* COPY 
          STM    BCPK 
 INT26    NFA    SHCN        SET *SHELL* CONTROLS 
          CRD    AB 
          ISTORE SSCC,(UJN SSC2)
          LDD    AB+4        SET *SHELL* PROGRAM ACTIVE 
          LPC    3777 
          LMC    4000 
          STD    AB+4 
          NFA    SHCN 
          CWD    AB 
          LDD    AB+4 
          SHN    21-5 
          MJN    INT27       IF LOCAL FILE LOAD ALLOWED 
          LDC    UJNI+2      DISABLE LOCAL FILE LOAD
          STM    TCSB 
 INT27    LDD    AB+4 
          SHN    21-4 
          MJN    INT28       IF GLOBAL FILE LOAD ALLOWED
          LDC    UJNI+2      DISABLE GLOBAL FILE LOAD 
          STM    TCSC 
 INT28    LDD    AB+4 
          SHN    21-3 
          MJN    INT29       IF SYSTEM FILE LOAD ALLOWED
          LDC    UJNI+77+SCLX-SCLE  DISABLE SYSTEM FILE LOAD
          STM    SCLE 
 INT29    LDC    UJNI+77-ARGC+ARG6  DISABLE ARGUMENT PROCESSING 
          STM    ARGC 
          LDC    UJNI+IST1-IST  DISABLE COMMAND MESSAGE 
          STM    IST
          LDC    MJNI+BCP9.1-BCPL  DISABLE SEQUENCE NUMBER SKIP 
          STM    BCPL 
          LDN    0
          STM    SPFA 
          STM    SPFA+1 
          LDC    /ERR/EM25   SET *SHELL* ERROR TERMINATION MESSAGE
          STM    TCSG 
          LDD    AB+4        SET *SHELL* ABORT OPTION 
          SHN    21-7 
          PJN    INT31       IF ABORT OPTION NOT SELECTED 
          LDC    CWDI+CM
          STM    TCSF 
 INT30    LDN    0           ZERO FILL PROGRAM NAME 
          STD    AB+4 
          RJM    IPL         INITIALIZE PROGRAM LOAD
          LJM    TCS3        PROCESS *SHELL* CONTROL
  
 INT31    LDC    LDNI+SYET   ABORT JOB IF *SHELL* LOAD ERROR
          STM    ISTB 
          UJN    INT30       PROCESS *SHELL* CONTROL
          TITLE  OVERLAID SUBROUTINES.
          SPACE  4,10 
          SPACE  4,10 
**        DEFINE ORIGIN OF OVERLAY *3AF*. 
  
  
 O3AF     EQU    *
          SPACE  4,10 
**        DEFINE ORIGIN OF ROUTINES.
  
  
          ERRPL  OVL-*       OVERLAY CONFLICT 
 ATX      SPACE  4,15 
**        ATX - ADVANCE TO EXIT COMMAND IF EXIT FLAG SET AND
*         CLEAR FLAG.  IF EXIT FOUND DAYFILE MESSAGE IS ISSUED. 
* 
*         ENTRY  (SP - SP+4) = COMMAND POINTER. 
* 
*         EXIT   (SP - SP+4) = UPDATED. 
*                TO *IST* IF EXIT FOUND.
*                TO *IST5* IF NON-RECOVERABLE MASS STORAGE ERROR. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  AKW, MSR, RCS, UPS.
  
  
 ATX2     LDD    SP+3 
          LMD    SP+4 
          NJN    ATX1        IF BUFFER NOT EMPTY
          LDD    SP+1 
          SHN    21-13
          PJN    ATX1        IF NOT EOR ON COMMAND FILE 
          LDC    ERR         RESET ERROR EXIT FROM *ASN*
          STM    ASNA 
  
 ATX      SUBR               ENTRY/EXIT 
          LDD    CP          CHECK EXIT FLAG
          ADN    CSSW 
          CRD    CM 
          LDD    CM 
          SHN    21-12
          PJN    ATXX        IF EXIT FLAG NOT SET 
          LDC    -2000       CLEAR SKIP TO EXIT FLAG
          RAD    CM 
          LDD    CP 
          ADN    CSSW 
          CWD    CM 
          LDC    ATX1        RESET ERROR EXIT FROM ASN
          STM    ASNA 
 ATX1     RJM    RCS         READ COMMAND 
          PJN    ATX1.1      IF NO MASS STORAGE ERROR 
          RJM    MSR         PROCESS MASS STORAGE ERROR 
          LJM    IST5        EXIT 
  
 ATX1.1   LDM    STMT 
          ZJP    ATX2        IF POSSIBLE END OF COMMANDS
          RJM    UPS         UNPACK COMMAND 
          NJN    ATX1        IF NO TERMINATOR 
          RJM    AKW         ASSEMBLE KEYWORD 
          LDD    AB 
          LMC    2REX 
          NJN    ATX1        IF NOT *EX*
          LDD    AB+1 
          LMC    2RIT 
          NJN    ATX1        IF NOT *IT*
          LDD    AB+2 
          NJN    ATX1        IF NOT SEPARATOR 
          LDC    ERR         RESET EXIT ADDRESS 
          STM    ASNA 
          LJM    IST         ISSUE COMMAND
 CCF      SPACE  4,10 
**        CCF - CLEAR CONTROL FIELDS. 
* 
*         EXIT   REPRIVE, ERROR EXIT, PP DUMP AND K-DISPLAY CONTROL 
*                FIELDS CLEARED.
* 
*         USES   CN - CN+4, FS - FS+4.
  
  
 CCF      SUBR               ENTRY/EXIT 
          LDD    CP          CLEAR ERROR EXIT CONTROL WORD
          ADN    EECW 
          CRD    FS 
          ADN    PPDW-EECW   CLEAR PP DUMP WORD 
          CRD    CN 
          LDD    FS+3 
          SCN    77 
          STD    FS+3 
          LDN    0
          STD    FS+4 
          STD    FS+1        CLEAR REPRIEVE OPTIONS 
          STD    CN+3 
          STD    CN+4 
          LDD    FS          CLEAR EXTENDED REPRIEVE FLAGS
          LPC    4777 
          STD    FS 
          LDD    CP          WRITE UPDATED EECW 
          ADN    EECW 
          CWD    FS 
          ADN    PPDW-EECW
          CWD    CN 
          LDN    ZERL 
          CRD    CN 
          LDD    CP          READ K-DISPLAY WORD
          ADC    DBAW 
          CRD    FS 
          LDD    FS          PRESERVE MEMORY FLAGS
          SCN    77 
          STD    CN 
          LDD    CP          CLEAR K-DISPLAY INFORMATION
          ADC    DBAW 
          CWD    CN 
          LJM    CCFX        RETURN 
 CES      SPACE  4,10 
**        CES - CHECK FOR *TCS* EXECUTE COMMAND.
* 
*         EXIT   (A) = ADDRESS OF COMMAND IF ONE EXISTS.
* 
*         USES   CM - CM+4. 
  
  
 CES      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADN    RFCW 
          CRD    CM 
          LDD    CM+3        FORM ADDRESS OF COMMAND
          SCN    77 
          SHN    6
          LMD    CM+2 
          SHN    6
          UJN    CESX        RETURN 
 CIJ      SPACE  4,20 
**        CIJ - CHECK FOR INTERACTIVE JOB.
* 
*         ENTRY  (JO) = EJT ORDINAL.
* 
*         EXIT   (BCPJ - BCPJ+1) = JOB SEQUENCE NUMBER. 
*                (BCPJ+4) = SERVICE CLASS.
*                (TSTN) = TERMINAL NUMBER IF ORIGIN TYPE = *TXOT*,
*                         CONNECTION STATUS = *OLCS* AND *IAF* IS 
*                         ACCESSIBLE. 
*                       = 0 OTHERWISE.
* 
*         USES   TN, CM - CM+4, T1 - T5.
* 
*         CALLS  AST, PIR, RRR, SRR, STA. 
* 
*         MACROS SFA. 
  
  
 CIJ      SUBR               ENTRY/EXIT 
          SFA    EJT,JO      READ JSN WORD OF EJT ENTRY 
          ADK    JSNE 
          CRD    CM 
          CRM    BCPJ,ON     SAVE JSN 
          ADN    //SCLE-JSNE-1     READ SERVICE CLASS/ORIGIN TYPE 
          CRD    T1 
          LDD    T1          SET SERVICE CLASS
          SCN    77 
          STM    BCPJ+4 
          LDD    T1 
          LPN    17 
          LMK    IAOT 
          NJN    CIJX        IF NOT INTERACTIVE JOB 
          LDD    CM+4        CHECK CONNECTION STATUS
          SHN    -7 
          LPN    17 
          STM    IPLD 
          LMK    OLCS 
          NJN    CIJX        IF NOT ON-LINE 
          LDC    FECF*10000+IFSI   CHECK *IAF* ACCESSIBILITY
          RJM    AST
          SHN    21-13
 CIJ1     PJN    CIJX        IF *IAF* NOT ACCESSIBLE
          RJM    PIR         PRESET WITH IAF R-REGISTER 
          LDD    CP          SET TERMINAL NUMBER
          ADK    TTNW 
          CRD    CM 
          LDD    CM+1 
          STM    IPLB+4 
          STD    TN          SAVE TERMINAL NUMBER FOR *STA* 
          RJM    SRR         SET R-REGISTER TO IAF RA 
          RJM    STA         COMPUTE TERMINAL TABLE ADDRESS 
          STM    IPLA        SAVE TERMINAL TABLE ADDRESS
          SHN    -14
          RAM    IPLA-1 
          LDN    1           SET INTERACTIVE INDICATOR
          RAM    IPLE 
          RJM    RRR         RESTORE R-REGISTER 
          UJN    CIJ1        RETURN 
  
 PRR      HERE               FORCE ASSEMBLY OF *PRR* HERE 
 CKA      SPACE  4,15 
**        CKA - CHECK ADDRESS.
* 
*         ENTRY  (A) = ADDRESS TO VALIDATE. 
*                (T1) = WORD COUNT. 
* 
*         EXIT   (A) = ABSOLUTE ADDRESS.
* 
*         ERROR  TO *IST2* IF ADDRESS ERROR.
* 
*         USES   CM+3, CM+4.
* 
*         CALLS  CAT. 
  
  
 CKA2     LDA    CM+3,M      LOAD ABSOLUTE ADDRESS
  
 CKA      SUBR               ENTRY/EXIT 
          MJN    CKA1        IF .GT. 131K 
          STD    CM+4        SAVE ADDRESS 
          SHN    -14
          STD    CM+3 
          SHN    14          VALIDATE ADDRESS 
          LMD    CM+4 
          ADD    T1 
          SHN    -6 
          SBD    FL 
          MJN    CKA2        IF ADDRESS .LT. FL - WORD COUNT
 CKA1     LDC    CKAA        SET MESSAGE ADDRESS
          STD    EF 
          RJM    CAT         CLEAR ADDRESS FOR *TCS* EXECUTE COMMAND
          LJM    IST2        ISSUE DAYFILE MESSAGE
  
  
 CKAA     DATA   C* BUFFER ARG. ERROR.* 
 CSL      SPACE  4,20 
**        CSL - CHECK COMMAND LIMIT. DECREMENT THE
*         COMMAND LIMIT FIELD IN THE CONTROL POINT AREA.
* 
*         ENTRY  (SP - SP+4) = COMMAND POINTER. 
* 
*         EXIT   TO *PPR*, IF COMMAND LIMIT EXCEEDED. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 CSL1     SOD    SP 
  
 CSL      SUBR               ENTRY/EXIT 
          LDD    SP 
          LPN    1
          NJN    CSL1        IF INHIBIT DECREMENT FLAG SET
          LDN    3           DECREMENT COMMAND LIMIT
          STD    CM+1        SPECIFY MESSAGE BUFFER LENGTH
          LDN    1
          STD    CM+2        SPECIFY NO DROPPING OF PP
          LDD    MA 
          CWM    CSLA,CM+1
          MONITOR  UADM 
          LDD    CM+1        STATUS RETURNED FROM UADM FUNCTION 
          LPN    1
          ZJN    CSLX        IF COMMAND LIMIT NOT EXCEEDED
          LDN    CLET        SET COMMAND LIMIT ERROR
          STD    CM+1 
          MONITOR  CEFM 
          LJM    PPR         EXIT TO PROCESS ERROR
  
  
*         MESSAGE BUFFER STRUCTURE FOR UADM FUNCTION. 
  
 CSLA     CON    CDOS        DECREMENT CP AREA LIMIT FIELD BY ONE 
          CON    ACLW        RELATIVE CP AREA ADDRESS OF LIMIT FIELD
          CON    24D*100+12D POSITION AND WIDTH OF LIMIT FIELD
          CON    0,0
  
          CON    AISS        INCREMENT ACCOUNTING REGISTER, I/O SRU 
          CON    IOAW        CP AREA WORD TO UPDATE 
          CON    40D*100+20D MS ACCUMULATOR FIELD 
          VFD    6/,18/IMCS  INCREMENT VALUE
  
          CON    CIOS        INCREMENT INHIBIT LIMIT CHECK
          CON    CSPW        CP AREA WORD ADDRESS 
          CON    48D*100+1   POSITION AND FIELD WIDTH 
          CON    0,0
  
 RCA      SPACE  4,15 
**        RCA - READ COMMAND TO ADDRESS.
* 
*         ENTRY  (IR+3) = SUBFUNCTION CODE IN BITS 11 - 6.
*                         BIT 11 = SCOPE CRACKING FLAG. 
*                         BIT 7 = LOCAL/GLOBAL FILE CALL FLAG.
*                         BIT 6 = NO COMMAND ADVANCE FLAG.
*                (CW - CW+4) = *SEPW* WORD. 
* 
*         EXIT   IS MADE TO *DPP*.
* 
*         USES   T1, AB - AB+4. 
* 
*         CALLS  AKW, ARG, CKA, CRS, CSL, DFM, ISD, MSR, RCS, 
*                SAF, STK, UPS. 
* 
*         MACROS MONITOR. 
  
  
 RCA      BSS    0           ENTRY
          NFA    SHCN        FETCH *SHELL* CONTROL WORD 
          CRD    CM 
          LDD    CM 
          ZJN    RCA0        IF NO *SHELL* CONTROLS 
          LDD    CW 
          SHN    21-2 
          MJN    RCA0        IF *SSJ=*
          LJM    RCA8        RETURN EOR STATUS ON COMMAND READ
  
 RCA0     RJM    RCS         READ COMMAND 
          PJN    RCA0.1      IF NO MASS STORAGE ERROR 
          RJM    MSR         PROCESS MASS STORAGE ERROR 
          LJM    RCA8        CLEAR COMMAND BUFFER 
  
 RCA0.1   STM    ISDA        SET COMMAND ADDRESS
          LDD    CP          READ SPECIAL ENTRY POINT WORD
          ADC    SEPW 
          CRM    CSEB,ON
          LDM    CSEB        SAVE *ARG=* ENTRY POINT INDICATORS 
          LPN    40 
          STD    EP 
          LDD    IR+3        CHECK ADVANCE
          SHN    -6 
          NJN    RCA1        IF NOT ADVANCE 
          LDD    CW 
          SHN    21-2 
          MJN    RCA1        IF *SSJ=* PRESENT
          RJM    CSL         CHECK COMMAND LIMIT
 RCA1     LDD    EP          CHECK FOR *ARG=* 
          ZJN    RCA2        IF NOT *ARG=*
          LDC    RCA10       SET EXIT ADDRESS IF ERROR
          STM    ASNA 
 RCA2     RJM    UPS         UNPACK COMMAND 
          ZJN    RCA3        IF NO ERRORS IN COMMAND
          LDM    CSEB        CHECK FOR *ARG=* JOB STEP
          SHN    21-5 
          MJN    RCA3        IF *ARG=* JOB STEP 
          LJM    RCA8        NOT AN *ARG=* JOB STEP 
  
 RCA3     RJM    AKW         ASSEMBLE KEYWORD 
          PJN    RCA4        IF NOT (*) COMMENT COMMAND 
          LDC    1R**100
          STD    AB 
          LJM    RCA12       PROCESS COMMENT LINE 
  
 RCA4     LDD    IR+3 
          SHN    -6 
          NJN    RCA5        IF NOT ADVANCE 
          LJM    RCA11       ADVANCE
  
 RCA5     LDD    FA 
          NJN    RCA6        IF NOT PROGRAM FILE FLAG 
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          ZJN    RCA7        IF NO LOCAL FILE THAT MATCHES KEYWORD
          LDN    40          SET LOCAL FILE FLAG
          RAD    AB+3 
          LDD    IR+3 
          SHN    -6 
          LMN    2
          ZJN    RCA6        IF RETURN COMMAND CALLING FOR LOCAL FILE 
          LDD    EP 
          ZJN    RCA8        IF NO *ARG=* IS PRESENT
 RCA6     LJM    RCA11       RETURN LOCAL FILE
  
*         CHECK FOR PRESENCE OF A GLOBAL LIBRARY SET. 
  
 RCA7     LDD    CP          CHECK FOR A GLOBAL LIBRARY SET 
          ADC    LB1W 
          CRD    CN 
          LDD    CN          CHECK GLOBAL LIBRARY SET BIT 
          SHN    21-12
          PJN    RCA11       IF GLOBAL LIBRARY NOT FOUND
          LDD    IR+3 
          SHN    21-7 
          MJN    RCA11       IF LOCAL/GLOBAL FILE CALL
  
  
*         CLEAR COMMAND BUFFER. 
  
 RCA8     LDC    STMT        CLEAR COMMAND BUFFER 
          STD    T1 
 RCA9     LDN    0
          STI    T1 
          AOD    T1 
          LMC    STMT+55
          NJN    RCA9        IF NOT END OF BUFFER 
          LDN    ZERL 
          CRD    AB          CLEAR PROGRAM NAME 
          UJN    RCA12       SET UP RA
  
*         REENTER HERE IF *ARG=* AND ERROR IN *ASN*.
  
 RCA10    LDD    AB+3        CLEAR 8TH CHARACTER
          SCN    77 
          STD    AB+3 
          LDN    0           CLEAR ARGUMENT COUNT 
          STD    T2 
          UJN    RCA12       SET UP RA
  
 RCA11    LDD    MA          SAVE NAME
          CWD    AB 
          RJM    ARG         ENTER ARGUMENTS
          LDD    MA 
          CRD    AB 
          LDD    T2          SET ARGUMENT COUNT 
          STD    AB+4 
          RJM    STK         SKIP TO KEYWORD
          RAM    RCAA 
 RCA12    LDD    RA          ENTER PROGRAM NAME 
          SHN    6
          ADN    ACTR 
          CWD    AB 
          LDN    10          STORE COMMAND
          STD    T1 
          LDD    IR+3        SET ADDRESS TO VALIDATE
          LPN    37 
          SHN    14 
          LMD    IR+4 
          RJM    CKA         CHECK ADDRESS
          CWM    STMT,T1
 RCAA     EQU    *-1
          LDD    IR+3 
          SHN    -6 
          NJP    RCA14       IF NO ADVANCE
          LDD    CP          UPDATE COMMAND POINTER 
          ADN    CSPW 
          CWD    SP 
          LDM    CSEB 
          SHN    21-3 
          MJN    RCA14       IF SDM= PRESENT
          LDC    STMT        ISSUE COMMAND TO DAYFILE 
          RJM    ISD
          ZJN    RCA14       IF COMMAND ISSUED VIA *DFM* CALL 
          RJM    CRS         CHECK RECALL STATUS
          ZJN    RCA14       IF AUTO RECALL NOT SET 
          LCN    40          CLEAR AUTO RECALL IN *IR*
          RAD    CM+1 
          LDD    IA 
          CWD    CM 
          MONITOR  RCPM      REMOVE *I* STATUS
 RCA14    LJM    DPP         DROP PPU 
 RNC      SPACE  4,15 
**        RNC - READ NEXT COMMAND.
* 
*         ENTRY  (SP - SP+4) = COMMAND POINTER. 
* 
*         EXIT   COMMAND STORED BEGINNING AT *STMT* AND 
*                CONTINUING TO A 0000 BYTE. 
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  ATX, CES, CKA, MSR, RCS. 
* 
*         MACROS MONITOR. 
  
  
 RNC5     RJM    ATX         CHECK EXIT FLAG
          RJM    RCS         READ COMMAND 
          PJN    RNC6        IF NO MASS STORAGE ERROR 
          RJM    MSR         PROCESS MASS STORAGE ERROR 
 RNC6     STM    ISDA        SET COMMAND ADDRESS
  
 RNC      SUBR               ENTRY/EXIT 
          LDN    10 
          STD    T1 
          RJM    CES         CHECK FOR *TCS* EXECUTE COMMAND
          ZJN    RNC1        IF NOT EXECUTE COMMAND FROM CM 
          LDC    LDNI+CCDR   ISSUE COMMAND FROM *CCDR*
          STM    BCPF 
          RJM    CES         RESET ADDRESS OF EXECUTE COMMAND 
          RJM    CKA         CHECK ADDRESS
          UJN    RNC2        READ COMMAND 
  
 RNC1     LDD    IR+2        CHECK FOR *DIS* CALL 
          LMN    2
          NJN    RNC5        IF NOT *DIS* CALL
          LDD    IR+4        CHECK FOR COMMAND IN MESSAGE BUFFER
          SHN    21-2 
          PJN    RNC5        IF COMMAND NOT IN MESSAGE BUFFER 
          LDN    MS1W        SET COMMAND ADDRESS
          STM    ISDA 
          ADD    CP 
 RNC2     CRM    STMT,T1     READ COMMAND 
          MONITOR  DCPM      DROP CPU 
          LDN    0           INSURE TERMINATOR
          STM    STMT+10*5
          LDC    STMT-1      FIND END OF COMMAND
          STD    T1 
 RNC3     AOD    T1 
          LDI    T1 
          NJN    RNC3        IF NOT END OF COMMAND
 RNC4     LDN    0           CLEAR REMAINDER OF BUFFER
          STI    T1 
          AOD    T1 
          LMC    STMT+55
          NJN    RNC4        IF NOT END OF BUFFER 
          LJM    RNCX        RETURN 
 SSF      SPACE  4,20 
**        SSF - SEARCH FOR SPECIAL FORMAT.
*         PROCESS SPECIAL COMMANDS - *CTIME*, *HTIME*, *RTIME*, 
*         AND *STIME*.
* 
*         ENTRY  (AB - AB+4) = PROGRAM NAME.
*                (TCSA) .NE. 0, IF CHARGE REQUIRED. 
* 
*         EXIT   TO *IST1*, IF SPECIAL COMMAND. 
*                TO *ERR1* IF PREVIOUS ERROR CONDITION. 
* 
*         USES   T1, CM - CM+4, CN - CN+4.
* 
*         CALLS  CAT, DFM.
* 
*         MACROS MONITOR. 
  
  
 SSF      SUBR               ENTRY/EXIT 
          LDM    TCSA 
          NJN    SSFX        IF CHARGE REQUIRED 
          LDD    AB+2        CHECK FOR *E*
          LMC    1RE*100
          NJN    SSFX        IF NO MATCH
          LDD    AB+1        CHECK FOR *IM* 
          LMC    2RIM 
          NJN    SSFX        IF NO MATCH
          LCN    0
          STD    T1 
 SSF1     AOD    T1 
          LDM    SOPT,T1
          STM    SSFB        STORE FIRST TWO CHARACTERS OF MESSAGE
          ZJN    SSFX        IF NOT SPECIAL FORMAT COMMAND
          LMD    AB 
          NJN    SSF1        IF NO MATCH
          LDM    SFCT,T1
          STD    T1 
          LJM    0,T1        JUMP TO SPECIAL FORMAT PROCESSOR 
  
 CTIME    LDN    1           CPU TIME 
          STD    CM+1 
          LDD    HN 
          UJN    HTI1        COMPLETE PROCESSING
  
 HTIME    LDK    MABL        CPU CLOCK CYCLES 
          CRD    CM 
          LDD    CM+1 
          SHN    -11
          LMN    7
          NJN    HTI2        IF NOT CYBER 176 
          AOM    SSFA 
          LDN    7           SET *HTIME* SUBFUNCTION
          STD    CM+1 
 HTI1     STD    CM+2 
          LDN    CPTW        READ CP ACCUMULATOR
          LJM    SSF2        COMPLETE PROCESSING
  
 HTI2     RJM    CAT         CLEAR *TCS* ADDRESS
          LDC    =C* HTIME NOT AVAILABLE.*
 HTI3     RJM    DFM
          LDD    FL 
          ZJN    HTI4        IF NO FL ASSIGNED
          LDN    ZERL        CLEAR RA+2 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    ARGR 
          CWD    CM 
 HTI4     LJM    IST1        CHECK STARTING JOB STEP
  
 RTIME    LDN    0           REAL TIME
          STD    CM+1 
          STD    CM+2 
          LDC    RTCL        READ REAL TIME ACCUMULATOR 
          UJN    SSF3        COMPLETE PROCESSING
  
 STIME    AOD    T2          SYSTEM RESOURCE TIME 
          LDC    2R U 
          STM    SSFD 
          LDC    2RNT 
          STM    SSFD+1 
          LDN    1
          STD    CM+1 
          STD    CM+2 
          LDN    SRUW 
  
*         COMPLETE SPECIAL FORMAT COMMAND PROCESSING. 
  
 SSF2     ADD    CP 
 SSF3     CRD    CN 
          LDD    MA          REQUEST CONVERSION 
          CWD    CN 
          MONITOR  RDCM 
 SSFA     LDN    1           SET NUMBER OF WORDS
*         LDN    2           (IF *HTIME* REQUEST) 
          STD    T1 
          LDD    MA          READ CONVERSION TO MESSAGE 
          CRD    CM 
          LDD    CM 
          NJN    SSF4        IF CONVERSION COMPLETED
          LDD    T1          PROCESS MESSAGE FOR NO CONVERSION
          LMN    2
          NJN    SSF5        IF NOT *HTIME* REQUEST 
          LDD    MA 
          CWM    SSFC,ON
          SBN    1
          CRM    SSFC+5,ON
          LDC    2R00 
          STM    SSFC+3 
          UJN    SSF5        DISPLAY MESSAGE
  
 SSF4     LDD    MA 
          CRM    SSFC,T1
 SSF5     RJM    CAT         CLEAR *TCS* ADDRESS
          LDC    SSFB        DISPLAY MESSAGE
          LJM    HTI3        ISSUE DAYFILE MESSAGE
  
  
 SSFB     DATA   H*  IME*    *CTIME*, *HTIME*, *RTIME*, OR *STIME*
 SSFC     DATA   H*000000.000*
 SSFD     DATA   C* SECS.*
          DATA   C*   KCYCLES.* 
  
 SOPT     BSS    0           PREFIX FOR TIME COMMANDS 
          CON    2RCT 
          CON    2RHT 
          CON    2RRT 
          CON    2RST 
          CON    0
  
 SFCT     BSS    0           JUMP ADDRESS FOR PROCESSORS
          CON    CTIME
          CON    HTIME
          CON    RTIME
          CON    STIME
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCRS 
 EJT$     EQU    1           ASSEMBLE EJT ADDRESSING (COMPGFP)
*CALL     COMPGFP 
*CALL     COMPRCS 
*CALL     COMPRNS 
*CALL     COMPSAF 
*CALL     COMPUPS 
          SPACE  4,10 
**        COMMON DECKS AND CODE WHICH MAY BE OVERLAID BY
*         THE MASS STORAGE BUFFER, *BFMS*.
  
  
          ERRNG  BFMS-2-*    CODE OVERLAYS *BFMS* 
 CSC      SPACE  4,10 
***       CSC - CHECK *SHELL* CONTROLS. 
* 
*         EXIT   IF *SHELL* CONTROL SET IN NFL WORD *SHCN*, *TCS* 
*                WILL BE PRESET TO PROCESS THE *SHELL* PROGRAM. 
* 
*         USES   CM - CM+4, CN - CN+4.
  
  
 CSC      SUBR               ENTRY/EXIT 
          LDM    TCSA 
          NJN    CSCX        IF CHARGE REQUIRED SET 
          NFA    SHCN        FETCH *SHELL* CONTROL WORD 
          CRD    CN 
          LDM    RQSG 
          LPN    1
          ZJN    CSC0        IF NOT A *TCS* CALL
          LDD    CN+4 
          SHN    21-13
          PJN    CSC0        IF CALL NOT MADE FROM A *SHELL* PROGRAM
          LDD    CN+4        CLEAR *SHELL* EXECUTING FLAG 
          LPC    3777 
          STD    CN+4 
          NFA    SHCN 
          CWD    CN 
          LDD    SP          INHIBIT COMMAND LIMIT DECREMENT
          SCN    1
          LMN    1
          STD    SP 
          UJN    CSCX        RETURN 
  
 CSC0     LDD    CN          CHECK *SHELL* CONTROLS 
          ZJN    CSCX        IF *SHELL* CONTROL NOT SET 
          LDD    CN+4 
          SHN    21-2 
          PJN    CSC1        IF TERMINAL COMMANDS NOT MONITORED 
          LDM    IPLB+4 
          ZJN    CSC1        IF NOT INTERACTIVE 
          LDC    LJMI        ENABLE TERMINAL COMMAND MONITORING 
          STM    INTB 
          LDC    INT25
          STM    INTB+1 
 CSC1     LDD    CP          GET CCL CONTROL
          ADC    JCDW 
          CRD    CM 
          LDD    CN+4 
          SHN    21-1 
          PJN    CSC2        IF BATCH COMMANDS NOT MONITORED
          LDD    CM+2 
          ZJN    CSC2.1      IF NOT IN CCL PROCEDURE
 CSC2     LDD    CN+4 
          SHN    21-0 
          PJN    CSC3        IF CCL COMMANDS NOT MONITORED
          LDD    CM+2 
          ZJN    CSC3        IF NOT IN CCL PROCEDURE
 CSC2.1   LDC    INT26       ENABLE CCL COMMAND MONITORING
          STM    INTC+1 
          LDC    LJMI 
          STM    INTC 
 CSC3     LJM    CSCX        RETURN 
 IAA      SPACE  4,15 
***       IAA - ISSUE APPLICATION ACCOUNTING MESSAGE. 
* 
*         ENTRY  (T3 - T3+4) = (CP) + *FPFW*. 
*                (A) = APPLICATION ACCOUNTING BITS. 
* 
*         EXIT   APPLICATION ACCOUNTING BITS CLEARED. 
*                APPLICATION ACCOUNTING MESSAGE ISSUED. 
* 
*         USES   FS, CM - CM+4, T3 - T3+4.
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 IAA      SUBR               ENTRY/EXIT 
          STD    FS          TEMPORARY SAVE 
          LDD    T3          CLEAR APPLICATION ACCOUNTING BITS
          LPC    6377 
          STD    T3 
          LDD    CP          REWRITE ACCOUNTING CONTROL WORD
          ADN    FPFW 
          CWD    T3 
          SBN    FPFW-CPTW   READ CP ACCUMULATOR WORD 
          CRD    T3 
          ADN    CPJW-CPTW   READ CP TIME JOB STEP WORD 
          CRD    CM 
          LDD    FS          CHECK FOR ACCOUNTING IN PROCESS
          SHN    21-11
          PJN    IAAX        IF APPLICATION ACCOUNTING NOT IN PROCESS 
          LDD    MA          WRITE WORDS TO MESSAGE BUFFER
          CWD    T3 
          ADN    1
          CWD    CM 
          LDN    ABUS 
          STD    CM+1        SET *ACTM* SUB-FUNCTION (ABUS) 
          MONITOR  ACTM      CALCULATE CP TIME USED FOR JOB STEP
          LDD    MA          READ CONVERSION INTO MESSAGE AREA
          CRM    IAAA+3,ON
          LDC    ACFN+IAAA
          RJM    DFM         DISPLAY IN ACCOUNT DAYFILE 
          LJM    IAAX        EXIT 
  
  
*         DAYFILE MESSAGE.
  
 IAAA     DATA   C*UEAU, 000000.000UNTS.* 
 INT      SPACE  4,10 
**        INT - INTIALIZE DIRECT CELLS. 
* 
*         EXIT   (JO) = JOB EJT ORDINAL.
*                (RQSF) = ROLLOUT ALLOWED FLAG. 
* 
*         USES   EF, EP, FA, IR, PF, AB - AB+4, CM - CM+4,
*                CN - CN+4, CW - CW+4, FS - FS+4, SP - SP+4,
*                T1 - T7. 
* 
*         CALLS  AKW, CAT, CCF, CUA, IAA, IFP, IPL, SSF.
* 
*         MACROS MONITOR, NFA, SFA. 
* 
*         NOTE   THE INITIALIZATION CODE IS SPLIT INTO TWO PARTS. 
*                THIS PART IS OVERLAYED BY THE DISK BUFFER. 
  
  
 INT      BSS    0           ENTRY
          RJM    IFP         INITIALIZE *COMPGFP* 
          RJM    CUA         GET USER ACCESS PRIVILEGES 
          STM    TCSD 
          LDD    CM 
          STM    TCSE 
          LDD    CP          READ STATUS WORD 
          ADN    STSW 
          CRD    CN 
          ADN    JCIW-STSW   READ JOB CONTROL INFORMATION 
          CRD    AB 
          ADK    TFSW-JCIW   READ EJT ORDINAL WORD
          CRD    T1 
          ADK    CSPW-TFSW   READ COMMAND POINTER 
          CRD    SP 
          ADN    SEPW-CSPW   READ SPECIAL ENTRY POINT WORD
          CRD    CW 
          LDD    AB+3 
          SHN    21-6 
          PJN    INT0        IF EXTENDED MEMORY PROTECT NOT SELECTED
          ISTORE RQSC,(NJN RQS0)
          ISTORE RQSJ,(UJN RQS8)
 INT0     LDD    T1          SET EJT ORDINAL
          STD    JO 
          LDD    SP          SET CHARGE REQUIRED STATUS 
          LPN    4
          STM    TCSA 
          SFA    EJT,JO 
          ADK    SCHE 
          CRD    CM          READ END OF JOB STATUS 
          ADK    //SCLE-SCHE
          CRD    T1          READ FORCED ROLLIN FLAG
          LDD    CM+2 
          LPC    3000 
          LMK    NOTM*1000
          NJN    INT1        IF END OF JOB
          LDD    AB+2 
          SBK    LSSI+1 
          MJN    INT2        IF NOT A SUBSYSTEM 
 INT1     LDC    UJNI+BCP19-BCPG  BYPASS CLEAR OF MEMORY
          STM    BCPG 
 INT2     LDD    AB+2        SET/CLEAR ROLLOUT ALLOWED FLAG 
          NJN    INT3        IF ROLLOUT NOT ALLOWED 
          LDD    AB+3 
          LPC    1000 
          NJN    INT3        IF *DIS* ASSIGNED TO JOB 
          LDD    AB+1 
          LPN    10 
          NJN    INT3        IF *CPUPFM* ACTIVE 
          LDD    T1 
          LPN    20 
 INT3     STM    RQSF 
          LDN    0
          STD    PF          CLEAR PROGRAM FORMAT 
          STD    FA          CLEAR FNT ADDRESS
          STD    EF          CLEAR/SET ERROR FLAG 
          STD    EP          CLEAR ENTRY POINT
          LDD    IR          CHECK FOR *TCS* CALL 
          LMC    2RTC 
          ZJN    INT5        IF *TCS* CALL
 INT4     LJM    INT7        DETERMINE ORIGIN TYPE
  
 INT5     LDC    LDNI+DPPM
          STM    DPPA 
          AOM    MSRA        SET NO JOB ADVANCE FLAG
          LDD    IR+2 
          LMN    5
          ZJN    INT6        IF EXECUTE COMMAND FROM CM 
          LJM    INT10       CHECK ERROR FLAG 
  
*         THE JOB ADVANCE FLAG IS SET FOR A *TCS* CALL (TO
*         EXECUTE A COMMAND FROM CM) BY SAVING THE REQUEST, 
*         DROPPING THE CPU, AND WAITING FOR THE SYSTEM TO ADVANCE 
*         THE JOB.  WHEN THE JOB IS ADVANCED, *1AJ* THEN ATTEMPTS TO
*         START UP THE COMMAND FROM THE CM ADDRESS POINTED
*         TO BY THE ORIGINAL *TCS* REQUEST WITH JOB ADVANCE SET.
  
 INT6     RJM    CAT         CLEAR ADDRESS FOR *TCS* EXECUTE COMMAND
          RJM    CCF         CLEAR CONTROL FIELDS 
          LDD    IR+3        SAVE *TCS* REQUEST ADDRESS 
          LPN    77 
          SHN    14 
          LMD    IR+4 
          SHN    14 
          STD    CM+2 
          SHN    -6 
          SCN    77 
          RAD    CM+3 
          LDD    T1 
          CWD    CM 
          LDN    1           SELECT CLEAR CPU STATUS
          STD    CM+1 
          MONITOR  DCPM 
          LJM    DPP         DROP PP
  
 IFP      HERE               ASSEMBLE *COMPGFP* INITIALIZATION
*CALL     COMPAST 
*CALL     COMPCUA 
*CALL     COMPSTA 
          SPACE  4,10 
          OVERFLOW
          TTL    1AJ/3AC - SEARCH PERIPHERAL LIBRARY. 
          TITLE 
          IDENT  3AC,SPLX    SEARCH PERIPHERAL LIBRARY. 
*COMMENT  1AJ - SEARCH PERIPHERAL LIBRARY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AC - SEARCH PERIPHERAL LIBRARY.
* 
*         *3AC* SEARCHES FOR PROGRAM NAME IN THE PERIPHERAL LIBRARY.
 SPL      SPACE  4,15 
**        SPL - MAIN ROUTINE. 
* 
*         ENTRY  (AB - AB+4) = ASSEMBLED NAME.
* 
*         EXIT   RETURN IF NOT FOUND. 
*                TO CALLED PROGRAM. 
*                (ISDA) = 0 IF PROGRAM FOUND. 
* 
*         USES   T2, T3, AB - AB+4, CM - CM+4.
* 
*         CALLS  AOD. 
* 
*         MACROS MONITOR. 
  
  
          ORG    OVL+5
  
 SPL      SUBR               ENTRY/EXIT 
          LDD    AB          CHECK FIRST CHARACTER OF NAME
          SHN    -6 
          STD    CM+2 
          SBN    1R0
          PJN    SPLX        IF NOT LETTER
          LDD    AB+1 
          LPN    77 
          NJN    SPLX        IF MORE THAN 3 CHARACTERS
          LDD    AB+1        SET PROGRAM NAME IN REQUEST
          SHN    6
          LMD    AB 
          SHN    6
          STD    CM+3 
          MONITOR  SPLM      SEARCH PERIPHERAL LIBRARY
          LDD    CM+1 
          SHN    -6-1 
          NJN    SPLX        IF NOT FOUND 
          STM    ISDA 
  
*         ENTER NUMERIC ARGUMENTS.
  
          LDI    CA          CHECK NEXT CHARACTER 
          ZJN    SPL2        IF TERMINATOR
          AOD    CA 
          RJM    AOD         ASSEMBLE DIGITS
          LDI    CA          CHECK NEXT CHARACTER 
          ZJN    SPL1        IF TERMINATOR
          LDD    T3          SET PARAMETER 1
          SHN    6
          STD    AB+3 
          ADD    T2 
          SHN    6
          STD    AB+2 
          AOD    CA          ASSEMBLE DIGITS
          RJM    AOD
 SPL1     LDD    T2          SET PARAMETER 2
          RAD    AB+3 
          LDD    T3 
          STD    AB+4 
 SPL2     LDD    IR+1        SET CP NUMBER
          LPN    37 
          RAD    AB+1 
          LDD    IA          WRITE INPUT REGISTER 
          CWD    AB 
          LDN    10          SET PP PROGRAM FORMAT
          STD    PF 
          LJM    IST6        ISSUE COMMAND TO DAYFILE 
 AOD      SPACE  4,10 
**        AOD - ASSEMBLE OCTAL DIGITS.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
* 
*         EXIT   (T2 - T3) = ASSEMBLED DIGITS.
* 
*         ERROR  TO *ERR* IF MORE THAN 6 DIGITS.
* 
*         USES   T1, T4.
* 
*         CALLS  ARG, ASN.
  
  
 AOD3     SOD    T4          RESET CHARACTER ADDRESS
          STD    CA 
          RJM    ARG         PROCESS ARGUMENTS
          LDD    KA          SET KEYWORD ADDRESS
          STD    CA 
          RJM    ASN         ASSEMBLE NAME
          LDN    0           CLEAR OCTAL ASSEMBLY 
          STD    T2 
          STD    T3 
  
 AOD      SUBR               ENTRY/EXIT 
          LDD    CA          SAVE CHARACTER ADDRESS 
          STD    T4 
          LDN    0           CLEAR ASSEMBLY 
          STD    T2 
          STD    T3 
 AOD1     LDI    CA          CHECK CHARACTER
          ZJN    AODX        IF TERMINATOR
          SBN    1R0
          STD    T1 
          MJN    AOD3        IF ALPHA 
          SBN    1R+-1R0
          PJN    AODX        IF SEPARATOR 
          ADN    1R+-1R8
          PJN    AOD3        IF OCTAL 
          LDD    T2          CHECK ASSEMBLY 
          SCN    7
          NJN    AOD2        IF TOO MANY DIGITS 
          LDD    T2          SHIFT ASSEMBLY 
          SHN    14 
          ADD    T3 
          SHN    3
          ADD    T1          ADD NEW DIGIT
          STD    T3          STORE ASSEMBLY 
          SHN    -14
          STD    T2 
          AOD    CA          ADVANCE CHARACTER
          UJN    AOD1        LOOP 
  
 AOD2     LJM    ERR         FORMAT ERROR 
          SPACE  4,10 
          ERRNG  BFMS-* 
          TTL    1AJ/LDR - LOAD CENTRAL PROGRAM.
          TITLE 
          QUAL   LDR
          IDENT  LDR,LDR     LOAD CENTRAL PROGRAM.
*COMMENT  1AJ - LOAD CENTRAL PROGRAM. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       LDR - OVERLAY LOADER. 
* 
*         *LDR* LOADS OVERLAYS IN RESPONSE TO CPU PROGRAM REQUESTS. 
          SPACE  4,10 
***       CALL. 
* 
*         18/  *LDR*,1/ ,1/A,22/,18/ADDR
*         A      AUTO RECALL IF DESIRED 
*         ADDR   ADDRESS OF REQUEST 
* 
*         THE LOAD REQUEST CONSISTS OF 2 - 4 WORDS. 
* 
*T ADDR   42/  *NAME*,18/0
*T,       6/L1,6/L2,2/N,3/0,1/U,1/V,4/0,1/E,18/LWA,18/FWA 
*T,       42/  *OVLNAME*,18/0 
*T,       42/  *EPTNAME*,18/0 
* 
*         *NAME* SOURCE OF NAME DEPENDING ON *U* AND *N*. 
*         L1     FIRST OVERLAY LEVEL. 
*         L2     SECOND OVERLAY LEVEL.
*         N      NUMBER OF WORDS IN REQUEST - 2.
*         U      LOAD OPTION (SEE BELOW). 
*         V      OVERLAY FLAG (MUST BE SET TO 1). 
*         E      CALL COMPLETION FLAG (SEE BELOW).
*         FWA    FIRST WORD ADDRESS OF OVERLAY. 
*         LWA    LAST WORD ADDRESS AVAILABLE FOR LOAD.
*         *OVLNAME*  NAME OF OVERLAY TO BE LOADED (IF N"0). 
*         *EPTNAME*  ENTRY POINT NAME WHEN LOADING MULTIPLE ENTRY 
*                  POINT OVERLAY (IF N=2).
* 
*         IF U=0      N IS IGNORED AND *NAME* IS THE NAME OF THE
*                     FILE CONTAINING OVERLAY (L1 AND L2 ARE REQUIRED). 
* 
*         IF U=1 AND N=0  *NAME* IS THE NAME OF THE OVERLAY FROM
*                         SYSTEM (L1 AND L2 ARE IGNORED). 
* 
*         IF U=1 AND N"0  *OVLNAME* IS THE NAME OF THE OVERLAY FROM 
*                         SYSTEM (L1 AND L2 ARE IGNORED). 
* 
*         IF FWA=0,  OVERLAY IS LOADED AT ADDRESS SPECIFIED BY OVERLAY. 
* 
*         IF L1=L2=0, CONTROL IS TO CALLED OVERLAY, OTHERWISE, CONTROL
*                     IS RETURNED TO CALLER WITH *FWA* = ENTRY ADDRESS. 
* 
*         IF E=1,  CONTROL TRANSFERS TO THE SPECIFIED ENTRY POINT 
*                  (*EPTNAME*) IN THE OVERLAY.
* 
* 
*         UPON COMPLETION OF THE LOAD, INFORMATION IS RETURNED IN THE 
*         CALL BLOCK AS FOLLOWS-
* 
*T ADDR   42/  *NAME*,18/0
*T,       6/L1,6/L2,30/0,18/EPTADDR 
*T,       42/  *OVLNAME*,18/0 
*T,       42/  *EPTNAME*,18/0 
* 
*         EPTADDR  ENTRY POINT ADDRESS OF OVERLAY.
*                  IF N=2, EPTADDR IS ADDRESS OF *EPTNAME*. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * OVERLAY NOT FOUND IN LIBRARY - OVLNAME* REQUESTED 
*         OVERLAY *OVLNAME* WAS NOT FOUND IN THE SYSTEM LIBRARY.
* 
*         * ARG ERROR.* = LDR PARMAETERS WERE OUTSIDE FL. 
* 
*         * FILE NOT OVERLAY FORMAT.* = FIRST RECORD OF FILE WAS NOT
*         AN OVERLAY. 
* 
*         * LDR ERROR.*  ISSUED BEFORE ONE OF ABOVE ERRORS. 
  
*         * I/O ON EXECUTE-ONLY FILE.* = AN OVERLAY LOAD HAS BEEN 
*         ATTEMPTED FOR AN EXECUTE-ONLY FILE OTHER THAN THAT
*         FROM WHICH THE MAIN PROGRAM WAS LOADED. 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
          QUAL   MSP
*CALL     COMSMSP 
          QUAL   *
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 WC       EQU    T8          SECTOR WORD COUNT
 PF       EQU    /TCS/PF
 LV       EQU    /TCS/CA
****
          TITLE  MAIN PROGRAM.
 LDR      SPACE  4,10 
**        LDR - MAIN PROGRAM. 
* 
*         CALLS  /3AE/CLD, /3AE/LCP, *3AD*. 
* 
*         MACROS EXECUTE, LDA, NFA. 
  
  
          ORG    PPFW 
 LDR      LDN    0           CLEAR FNT ADDRESS
          STD    EP          CLEAR ENTRY POINT
          STD    FA 
  
*         LOAD COPY ROUTINES. 
  
          EXECUTE  3AE
          AOM    /3AE/MSRA   SET NON JOB ADVANCE TYPE ERROR PROCESSING
          AOM    /3AE/SLPB   SET LDR CALL FLAG
  
*         CHECK REQUEST ADDRESS.
  
          LDD    IR+3        CHECK ARGUMENT ADDRESS 
          SHN    14 
          LMD    IR+4 
          MJN    LDR1        IF OUT OF RANGE
          ADN    1
          SHN    -6 
          SBD    FL 
          PJN    LDR1        IF \ FL-1
  
*         CHECK REQUEST.
  
          LDA    IR+3        READ FILE/PROGRAM NAME 
          CRD    AB 
          CRM    LDRD,ON     SET NAME IN MESSAGE
          CRD    CM          READ REQUEST WORD
          LDD    CM+3        CHECK FWA
          LPN    37 
          RAM    /3AE/CMSA
          STM    /3AE/CCMA
          LPN    37 
          SHN    14 
          LMD    CM+4 
          STM    /3AE/CMSA+1
          STM    /3AE/CCMA+1
          SHN    -6 
          SBD    FL 
          MJN    LDR2        IF NOT OUT OF RANGE
 LDR1     LDC    =C* ARG. ERROR.* 
          LJM    LDE         PROCESS ERROR
  
 LDR2     LDD    CM+3        CHECK LWA
          SHN    -6 
          STD    LV          SAVE LWA 
          SHN    14 
          LMD    CM+2 
          NJN    LDR3        IF LWA SPECIFIED 
          LJM    LDR4        SET OVERLAY LEVELS 
  
 LDR3     SHN    6
          SHN    -6 
          SBD    FL 
          PJN    LDR1        IF LWA BEYOND FL 
          ADD    FL 
          SHN    6
          LMD    LV          RESTORE LWA
          ADN    1           ALLOW LOAD UP TO AND INCLUDING LWA 
          STM    /3AE/CMSE+1
          STM    LDRB+4      SET LWA + 1 FOR LOAD COPY ROUTINES 
          LMC    777777 
          STM    /3AE/CMSB+1
          STM    /3AE/CPHA+1
          LMC    777777 
          SHN    -14
          STM    LDRB+3 
          LMC    ADCI+77
          STM    /3AE/CMSB
          STM    /3AE/CPHA
          LMC    LDCI&ADCI+77 
          STM    /3AE/CMSE
          AOM    /3AE/CCMB   FLAG FWA SPECIFIED 
 LDR4     LDD    CM          SET OVERLAY LEVELS 
          STD    LV 
          LDD    CM+1 
          LPN    1           SET RETURN FLAG
          RAM    LDRA 
          LDN    1           SET FLAG FOR USER LIBRARY LOAD FALSE 
          STD    CW 
          LDD    CM+1        CHECK REQUEST
          SHN    21-6 
          MJN    LDR5        IF LIBRARY LOAD
          LJM    LDR10       PROCESS LOCAL FILE LOAD
  
 LDR5     SHN    -3 
          LPN    3
          ZJN    LDR6        IF TWO WORD REQUEST
          ADN    1
          SHN    6
          ADD    IR+3 
          SHN    6
          ADD    RA          READ OVERLAY/ENTRY NAME
          SHN    6
          ADD    IR+4 
          CRD    AB 
          CRM    LDRD,ON     SET NAME IN MESSAGE
  
*         PROCESS LIBRARY SEARCH. 
  
 LDR6     LDD    AB+3        CLEAR EIGHTH CHARACTER 
          SCN    77 
          STD    AB+3 
          STM    LDRE 
          LDN    0           TERMINATE MESSAGE
          STM    LDRE+1 
          LDD    CP          CHECK USER LIBRARY LOAD FLAG 
          ADC    LB1W 
          CRD    CW 
          LDD    CW 
          LPN    1
          ZJN    LDR7        IF NOT USER LIBRARY LOAD 
          LDD    CP          GET ADDRESS OF USER LIBRARY
          ADC    EOCW 
          CRD    AB 
          NFA    AB,R        GET LIBRARY NAME 
          CRD    AB 
          LDN    0           SET FLAG FOR USER LIBRARY LOAD 
          STD    CW          FLAG FOR USER LIBRARY LOAD 
          LDD    AB+3        CLEAR EIGHTH CHARACTER 
          SCN    77B
          STD    AB+3 
          LDD    CM+1        SAVE CALL BLOCK SIZE 
          SHN    -12
          LJM    LDR11       PROCESS LOCAL FILE LOAD
  
 LDR7     RJM    /3AE/CLD    SEARCH CENTRAL LIBRARY DIRECTORY 
          ZJN    LDR8        IF NOT FOUND 
          CRD    CW          READ CONTROL WORD
          SBN    1
          CRD    CN          READ FIRST WORD
          LDD    MA          SET ENTRY POINT NAME 
          CWD    AB 
          CRM    /3AE/CL,ON 
          LDN    0           CLEAR EST ORDINAL
          STD    T5 
          LDD    CW+1        CHECK PROGRAM LOCATION 
          LPC    2000 
          NJN    LDR12       IF PROGRAM CM RESIDENT 
          LDD    CW+2        SET ALTERNATE EQUIPMENT
          STD    T5 
          LDD    CN+3        SET ADDRESS OF PROGRAM ON SYSTEM DEVICE
          STM    /3AE/CL+4
          LDD    CN+4 
          STM    /3AE/CL+5
          LDD    CW+3        CHECK TRACK
          SHN    6
          MJN    LDR12       IF NOT SPECIAL FORM
 LDR8     LDC    LDRC        * OVERLAY NOT FOUND IN LIBRARY - OVLNAME.* 
 LDR9     LJM    LDE         PROCESS ERROR
  
*         PROCESS FILE SEARCH.
  
 LDR10    SHN    -3          SAVE CALL BLOCK SIZE 
 LDR11    LPN    3
          STD    EP 
          EXECUTE  3AD       SEARCH FILE FOR OVERLAY
  
*         LOAD OVERLAY. 
  
 LDR12    RJM    /3AE/LCP    LOAD OVERLAY 
          ZJN    LDR12.1     IF NO ERROR
          LMC    400000 
          UJN    LDR9        PROCESS LOAD ERROR 
  
 LDR12.1  LDD    CM+3 
          LPN    37 
          STD    CM+3 
 LDRA     LDN    0
*         LDN    1           (*RETURN TO ENTRY POINT* SET)
          NJN    LDR13       IF RETURN TO OVERLAY LOADED
          LDD    LV 
          ZJN    LDR13       IF (0,0) LEVEL OVERLAY 
          LJM    LDR15       NOT (0,0) LEVEL OVERLAY
  
*         SET (P) = ENTRY ADDRESS 
  
 LDR13    LDA    AB+3        READ HEADER WORD 
          CRD    CN 
          LDM    /3AE/CSFD   CHECK FOR FWA FROM 53 TABLE
          ADM    /3AE/CSFD+1
          ZJN    LDR14       IF NO FWA FROM 53 TABLE
          LDM    /3AE/CSFD   USE FWA FROM 53 TABLE
          STD    CN+2 
          LDM    /3AE/CSFD+1
          STD    CN+3 
 LDR14    LDD    CN+3        CALCULATE ENTRY ADDRESS
          SHN    -6 
          STD    CN+3 
          LDD    AB+3        CALCULATE RELOCATION 
          SHN    14 
          ADD    AB+4 
          SBD    CN+3 
          SHN    14 
          SBD    CN+2 
          SHN    6
          RAD    CM+4 
          SHN    -14
          RAD    CM+3 
          LDD    CP          ENTER (P)
          CRD    CN 
          LDD    CM+3 
          STD    CN 
          LDD    CM+4 
          STD    CN+1 
          LDD    CP 
          CWD    CN 
          UJN    LDR16       DROP PPU 
  
*         ENTER ENTRY ADDRESS IN SECOND REQUEST WORD FOR (I,J). 
  
 LDR15    STD    CM          SET OVERLAY LEVEL
          LDN    0
          STD    CM+1 
          STD    CM+2 
          LDA    IR+3        STORE USER REPLY 
          ADN    1
          CWD    CM 
  
*         SET COMPLETION BIT IN *LDRR*. 
  
 LDR16    LDD    RA 
          SHN    6
          ADN    LDRR 
          CRD    CM 
          LDN    40          SET COMPLETION BIT 
          STD    CM+2 
          LDD    RA 
          SHN    6
          ADN    LDRR 
          CWD    CM 
          MONITOR  DPPM      DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
  
  
 LDRB     CON    0,0,0,0,0   LWA ALLOWED FOR LOAD 
  
 LDRC     DATA   C* OVERLAY NOT FOUND IN LIBRARY - OVLNAME.*
 LDRD     EQU    *-5
 LDRE     EQU    *-2
 LDE      SPACE  4,10 
**        LDE - PROCESS *LDR* ERROR.
* 
*         ENTRY  (A)  = ADDRESS OF MESSAGE. 
*                (A) = ADDRESS + 400000B IF COMMON ERROR MESSAGE. 
*                (FA) = ADDRESS OF FNT ENTRY. 
* 
*         EXIT   TO *PPR*.
* 
*         USES   EF, EP, FS+4.
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR, NFA.
  
  
 LDE      STD    EF          SAVE ERROR MESSAGE ADDRESS 
          SHN    -14
          STD    EP 
          LDD    FA          CHECK LOAD MODE
          ZJN    LDE1        IF NOT LOAD FILE 
          LDD    FS+4        SET OPERATION COMPLETE 
          SCN    77 
          LMN    5
          STD    FS+4 
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL 
          CWD    FS 
 LDE1     LDC    =C* LDR ERROR.*
          RJM    DFM         ISSUE DAYFILE MESSAGE
          LDD    EP 
          NJN    LDE2        IF *3AM* CALL REQUIRED 
          LDC    CPON        DIAGNOSTIC TO CP DAYFILE 
          LMD    EF 
          RJM    DFM
          MONITOR  ABTM      ABORT CONTROL POINT
          LJM    PPR         EXIT TO PP RESIDENT
  
 LDE2     EXECUTE  3AM       PROCESS ERROR MESSAGE
          SPACE  4,10 
          USE    MESSAGES 
 ELDR     EQU    *+5
          TTL    1AJ/3AD - SEARCH FOR OVERLAY.
          TITLE 
          IDENT  3AD,SFOX    SEARCH FOR OVERLAY.
*COMMENT  1AJ - SEARCH FOR OVERLAY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AD - SEARCH FOR OVERLAY. 
* 
*         *3AD* SEARCHES A LOCAL FILE FOR AN OVERLAY. 
* 
*         IF THE FILE TO BE SEARCHED IS A USER LIBRARY, THE SEARCH
*         IS MADE RANDOMLY VIA THE *OPLD* DIRECTORY.  THE OVERLAY IS
*         SEARCHED FOR BY NAME AND TYPE (0,0 VS. NON-0,0).  WHEN AN 
*         ENTRY IS FOUND THE FILE IS POSITIONED RANDOMLY AND THE
*         OVERLAY IS THEN CHECKED FOR THE CORRECT LEVEL.
* 
*         IF THE FILE TO BE SEARCHED IS NOT A USER LIBRARY OR THE 
*         *OPLD* CANNOT BE LOCATED, AN END AROUND SEARCH OF THE 
*         FILE IS MADE FOR AN OVERLAY OF THE REQUESTED LEVEL. 
* 
*         WARNING - IF A NON-LIBRARY FILE IS NOT POSITIONED AT THE
*         BEGINNING OF A LOGICAL RECORD, RANDOM DATA COULD POSSIBLY BE
*         INTERPRETED AS A VALID OVERLAY HEADER.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * OVERLAY FILE NOT FOUND.* = REQUESTED FILE IS NOT AVAILABLE. 
* 
*         * OVERLAY FILE EMPTY.* = NO DATA APPEARS IN REQUESTED FILE. 
* 
*         * OVERLAY NOT FOUND.* = REQUESTED OVERLAY IS NOT ON FILE. 
* 
*         * FILE NOT ON MASS STORAGE.*
* 
*         * ENTRY POINT NOT FOUND.* = REQUESTED ENTRY POINT IS NOT
*         ON FILE.
* 
*         * I/O SEQUENCE ERROR.* = UNABLE TO SET OVERLAY FILE BUSY. 
 SFO      SPACE  4,10 
**        SFO - MAIN ROUTINE. 
* 
*         ENTRY  (CW) = 1, IF LOCAL FILE LOAD.
*                (CW) = 0, IF LIBRARY LOAD. 
* 
*         EXIT   (T1) = CM WORD COUNT OF SECTOR IN *BFMS*.
*                TO */3AE/MSR*, IF MASS STORAGE ERROR.
* 
*         CALLS  CEL, /3AE/CPF, /3AE/RNS, SAF, SFB, SOD.
* 
*         MACROS ENDMS, SETMS, SFA. 
  
  
          ORG    ELDR 
 SFO      SUBR               ENTRY/EXIT 
          LDD    CW          CHECK FOR USER LIBRARY LOAD
          ZJN    SFO0        IF USER LIBRARY LOAD 
          LDN    0           CLEAR LIBRARY LOAD FLAG
          STM    /3AE/SLPD
          UJN    SFO1        SEARCH FOR FILE
  
 SFO0     LDC    LDNI+1      FORCE LOAD FROM USER LIBRARY 
          STM    SFOA 
 SFO1     RJM    SAF         SEARCH FOR ASSIGNED FILE 
          NJN    SFO2        IF FOUND 
          LDC    =C* OVERLAY FILE NOT FOUND.* 
          UJN    SFO3        PROCESS ERROR
  
 SFO2     RJM    SFB         SET FILE BUSY
          ZJN    SFO4        IF FILE SET BUSY 
          LDN    0
          STD    FA          CLEAR FNT ADDRESS
          LDC    =C* I/O SEQUENCE ERROR.* 
 SFO3     LJM    LDE         PROCESS ERROR
  
 SFO4     LDD    CM+3        SAVE FILE STATUS 
          STD    T2 
          LDD    FS          SET EST ORDINAL
          STD    T5 
          SFA    EST         READ EST ENTRY 
          ADK    EQDE 
          CRD    CM 
          LDD    CM          CHECK EQUIPMENT
          SHN    6
          MJN    SFO5        IF MASS STORAGE
          LDC    =C* FILE NOT ON MASS STORAGE.* 
          UJN    SFO3        PROCESS ERROR
  
 SFO5     LDD    T2          CHECK FILE STATUS
          LPN    4
          ZJN    SFO7        IF NOT EXECUTE-ONLY
          LDD    CP          CHECK VALID ACCESS 
          ADC    EOCW 
          CRD    CM 
          LDD    CM 
          LMD    FA 
          ZJN    SFO7        IF VALID ACCESS
          LDD    LV 
          NJN    SFO5.1      IF NOT MAIN OVERLAY LOAD 
          LDD    FA          RESET FILE ADDRESS 
          STD    CM 
          LDD    CP 
          ADC    EOCW 
          CWD    CM 
          RJM    CEL         CLEAR ERROR PROCESSING 
          UJN    SFO7        CONTINUE 
  
 SFO5.1   LDC    =C* I/O ON EXECUTE-ONLY FILE.* 
 SFO6     LJM    LDE         ABORT
  
 SFO7     LDD    FS+3        SET SECTOR 
          STD    T7 
          LDD    FS+2        SET TRACK
          STD    T6 
          NJN    SFO8        IF FILE USED 
          LDC    =C* OVERLAY FILE EMPTY.* 
          UJN    SFO6        ABORT
  
 SFO8     LDN    40          SET ERROR EXIT FLAG
          RAM    /3AE/MSRB
          LDC    LDE         SET EXIT ADDRESS ON DISK ERROR 
          STM    /3AE/MSRC
          SETMS  READSTR
 SFOA     LDD    EP          CHECK CALL BLOCK SIZE
*         LDN    1           FORCE LOAD FROM USER LIBRARY 
          ZJN    SFO9        IF NOT 3 OR 4 WORD CALL BLOCK
          RJM    SOD         SEARCH *OPLD* DIRECTORY
          LDD    EP          SET ENTRY POINT FLAG 
          SHN    -1 
          STD    EP 
          ZJN    SFO9        IF NOT 4 WORD CALL BLOCK 
          LDA    IR+3        READ ENTRY POINT WORD
          ADN    3
          CRD    CW 
 SFO9     LJM    SFO18       ENTER LOOP 
  
*         SEARCH FILE.
  
 SFO10    LDM    BFMS        CHECK FOR EOI
          ADM    BFMS+1 
          NJN    SFO11       IF FILE NOT AT EOI 
          LDD    FS+1        REWIND FILE
          STD    T6 
          LDN    FSMS 
          STD    T7 
          UJN    SFO12       PAUSE AT EOI 
  
 SFO11    LDD    T7          CHECK SECTOR NUMBER
          NJN    SFO13       IF NOT START OF NEW TRACK
 SFO12    ENDMS 
 SFO13    LDD    T7          CHECK STARTING POSITION
          LMD    FS+3 
          NJN    SFO14       IF NOT AT STARTING SECTOR NUMBER 
          LDD    T6 
          LMD    FS+2 
          ZJN    SFO16       IF AT STARTING POSITION
 SFO14    LDD    WC          CHECK WORD COUNT 
          SHN    -6 
          ZJN    SFO18       IF NOT FULL PRU
          LDC    BFMS        READ NEXT SECTOR 
          RJM    /3AE/RNS    READ NEXT SECTOR 
          MJP    /3AE/MSR    IF MASS STORAGE ERROR
          STD    WC          SAVE WORD COUNT
 SFO15    LJM    SFO10       CHECK FOR EOI
  
*         ISSUE ERROR MESSAGE.
  
 SFO16    ENDMS 
          LDC    =C* OVERLAY NOT FOUND.*
          LJM    LDE         PROCESS ERROR
  
 SFO17    LDN    0           RESET ENTRY POINT BIAS 
          STM    /3AE/SLPA
          UJN    SFO15       CHECK FOR EOI
  
*         CHECK RECORD FOR OVERLAY OF CORRECT LEVEL.
  
 SFO18    RJM    /3AE/CPF    CHECK PROGRAM FORMAT 
          NJN    SFO17       IF ERROR 
          LDM    3,T3        CHECK LEVEL
          LMD    LV 
          NJN    SFO17       IF NOT REQUESTED OVERLAY 
  
*         CHECK PROGRAM FORMAT. 
  
          LDD    PF 
          ADD    EP 
          LMN    3
          ZJN    SFO19       IF *ABS* AND 4 WORD *LDR* CALL 
          LJM    SFOX        RETURN 
  
 SFO19    LDN    77          SET MAXIMUM ENTRY COUNT
          SBM    /3AE/SLPA   SUBTRACT 5400 TABLE HEADER IF PRESENT
          STD    CM 
          SBN    77 
          ZJN    SFO20       IF NO 54 TABLE 
          LDC    LDNI+2+10*5 ADVANCE SEARCH ADDRESS 
          STM    SFOB 
 SFO20    LDD    T3 
          LMC    BFMS 
          ZJN    SFO21       IF NO *7700* TABLE 
          LDD    CM 
          SBM    BFMS+3      ADJUST MAXIMUM ENTRY COUNT 
          STD    CM 
 SFO21    LDM    5,T3 
          LPN    77 
          SHN    14          CHECK ENTRY COUNT
          LMM    6,T3 
          PJN    SFO22       IF COUNT POSITIVE
          LMC    -0 
 SFO22    STD    T2          SET ENTRY COUNT
          SBD    CM 
          PJN    SFO25       IF ENTRIES NOT ALL ON 1ST SECTOR 
          ADD    CM 
          RAM    SFOC 
 SFOB     LDN    2+5
*         LDN    2+10*5      (54 TABLE) 
          ADD    T3          SET INDEX TO 1ST ENTRY 
          STD    CM 
 SFO23    LDI    CM          CHECK BYTE 0 
          LMD    CW 
          NJN    SFO24       IF NO MATCH
          LDM    1,CM 
          LMD    CW+1 
          NJN    SFO24       IF NO MATCH ON BYTE 1
          LDM    2,CM 
          LMD    CW+2 
          NJN    SFO24       IF NO MATCH ON BYTE 2
          LDM    3,CM 
          LMD    CW+3 
          SCN    77 
          ZJN    SFO26       IF ENTRY FOUND 
 SFO24    LDN    5
          RAD    CM          ADVANCE INDEX
          SOD    T2          DECREMENT ENTRY COUNT
          NJN    SFO23       IF NOT END OF ENTRIES
 SFO25    ENDMS 
          LDC    =C* ENTRY POINT NOT FOUND.*
          LJM    LDE         PROCESS ERROR
  
 SFO26    LDN    0
 SFOC     EQU    *-1
          SBD    T2          SET INDEX TO ENTRY 
          STD    EP 
          LJM    SFOX        RETURN 
 CEL      SPACE  4,10 
**        CEL - CLEAR ERROR PROCESSING. 
* 
*         EXIT   EREXIT, DISTC AND REPRIEVE PROCESSING CLEARED. 
*                SECURE MEMORY STATUS SET.
* 
*         USES   CM - CM+4. 
  
  
 CEL      SUBR               ENTRY/EXIT 
          LDD    CP          CLEAR EREXIT AND REPRIEVE PROCESSING 
          ADN    EECW 
          CRD    CM 
          LDN    0
          STD    CM+4 
          STD    CM+1 
          LDD    CM 
          LPC    4000 
          STD    CM 
          LDD    CM+3 
          SCN    37 
          STD    CM+3 
          LDD    CP 
          ADN    EECW 
          CWD    CM 
          ADN    DBAW-EECW   SET SECURE MEMORY STATUS 
          CRD    CM 
          LDD    CM 
          LPC    3777 
          LMC    4000 
          STD    CM 
          LDD    CP 
          ADC    DBAW 
          CWD    CM 
          SBN    DBAW-TIAW   CLEAR TERMINAL INTERRUPT ADDRESS 
          CRD    CM 
          LDN    0
          STD    CM+2 
          LDD    CM+3 
          LPN    77 
          STD    CM+3 
          LDD    CP 
          ADN    TIAW 
          CWD    CM 
          LJM    CELX        RETURN 
 SOD      SPACE  4,20 
**        SOD - SEARCH *OPLD* DIRECTORY FOR OVERLAY.
* 
*         *SOD* LOOKS FOR AN *OPLD* RECORD ON THE OVERLAY FILE. 
*         IF FOUND THE *OPLD* IS SEARCHED FOR AN OVERLAY OF THE 
*         CORRECT NAME AND TYPE.
* 
*         ENTRY  (FS - FS+3) = OVERLAY FILE FST ENTRY.
* 
*         EXIT   TO *SFO16* IF OVERLAY NOT FOUND IN *OPLD*. 
*                (T6 - T7) = TRACK AND SECTOR OF OVERLAY. 
* 
*         USES   FS+2, FS+3, RI, RI+1, T2, T3, T6, T7, AB - AB+4. 
* 
*         CALLS  CRA, /3AE/RNS. 
* 
*         MACROS SETMS. 
  
  
 SOD      SUBR               ENTRY/EXIT 
          LDD    EP          FIND OVERLAY NAME IN CALL BLOCK
          ZJN    SOD1        IF OVERLAY NAME IN FIRST WORD OF BLOCK 
          LDN    2           READ NAME FROM THIRD WORD OF CALL BLOCK
          SHN    6
 SOD1     ADD    IR+3 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    IR+4        (A) = ABSOLUTE CM ADDRESS OF *OVLNAME* 
          CRD    AB          (AB - AB-4) CONTAINS OVERLAY NAME
          LDD    FS+1        SET FILE TO *BOI*
          STD    T6          FIRST TRACK
          LDN    FSMS        SET FIRST SECTOR 
          STD    T7 
          SETMS  POSITION    NOTE RANDOM POSITION 
          LDC    BFMS        BUFFER ADDRESS 
          RJM    /3AE/RNS    READ NEXT SECTOR 
          MJN    SOD3.1      IF MASS STORAGE ERROR
          NJN    SOD3        IF DATA TRANSFERED 
 SOD2     LDD    FS+3        RESTORE ORIGINAL FILE POSITION 
          STD    T7          STORE SECTOR 
          LDD    FS+2 
          STD    T6          SET TRACK
          LJM    SODX        RETURN 
  
 SOD3     SBN    20B         CHECK FOR VALID PREFIX/ULIB RECORD 
          MJN    SOD2        IF LESS THAN 20B WORDS TRANSFERED
          LDM    BFMS+2+5*17 FIRST WORD OF ULIB TABLE 
          LMC    7600B
          NJN    SOD2        IF NOT A ULIB RECORD 
          LDM    BFMS+2+5*17+2  STORE OPLD RANDOM ADDRESS IN RI - RI+1
          STD    RI 
          LDM    BFMS+2+5*17+3
          STD    RI+1 
          RJM    CRA         CONVERT RANDOM ADDRESS 
          MJN    SOD2        IF RANDOM ADDRESS NOT ON TRT CHAIN 
          SETMS  POSITION    NOTE RANDOM POSITION 
          LDC    BFMS        BUFFER ADDRESS 
          RJM    /3AE/RNS    READ NEXT SECTOR 
 SOD3.1   MJN    SOD6.1      IF MASS STORAGE ERROR
          NJN    SOD4        IF *OPLD* NOT EMPTY
          LJM    SOD2        RESTORE ORIGINAL FILE POSITION 
  
 SOD4     LDM    BFMS+2      CHECK FOR VALID OPLD TABLE 
          LMC    7700B
          NJN    SOD5        IF NOT VALID OPLD TABLE
          LDC    BFMS+2+5*20 FIRST ENTRY IN BUFFER
          STD    T2 
          LDN    20          CM WORD IN BUFFER
          STD    T3 
          UJN    SOD9        ENTER MAIN LOOP
  
 SOD5     LJM    SOD2        RESTORE ORIGINAL FILE POSITION 
  
*         SEARCH OPLD FOR OVERLAY.
  
 SOD6     LDC    BFMS        BUFFER ADDRESS 
          RJM    /3AE/RNS    READ NEXT SECTOR 
 SOD6.1   MJP    /3AE/MSR    IF MASS STORAGE ERROR
          NJN    SOD8        IF NOT EMPTY SECTOR
 SOD7     LJM    SFO16       IF OVERLAY NOT FOUND 
  
*         SEARCH DIRECTORY. 
  
 SOD8     LDC    BFMS+2      PP WORD TO START SEARCH
          STD    T2 
          LDN    1           CM WORD TO START SEARCH
          STD    T3 
 SOD9     LDD    T1          READ WORDS TRANSFERRED 
          SBD    T3          CM WORD POSITION 
          PJN    SOD10       IF MORE ENTRIES IN BUFFER
          LDD    T1 
          SHN    -6          CHECK FOR SHORT PRU
          NJN    SOD6        IF FULL PRU
          UJN    SOD7        ENTRY NOT FOUND
  
 SOD10    LDI    T2          CHECK OVERLAY NAME 
          LMD    AB 
          NJN    SOD11       IF NO MATCH
          LDM    1,T2 
          LMD    AB+1 
          NJN    SOD11       IF NO MATCH
          LDM    2,T2 
          LMD    AB+2 
          NJN    SOD11       IF NO MATCH
          LDM    3,T2 
          LMD    AB+3 
          SCN    77 
          ZJN    SOD12       IF OVERLAY FOUND 
 SOD11    LDN    2           INCREMENT CM WORD COUNT
          RAD    T3 
          LDN    10D         INCREMENT BUFFER POINTER 
          RAD    T2 
          UJN    SOD9        CHECK NEXT ENTRY 
  
*         CHECK PROGRAM FOR PROPER LEVEL. 
  
 SOD12    LDM    4,T2        CHECK PROGRAM TYPE 
          LMN    ABRT 
          NJN    SOD13       IF NOT 0,0(ABS)
          LDD    LV          CHECK LEVEL REQUESTED
          NJN    SOD11       IF REQUEST NOT FOR 0,0 
          UJN    SOD14       FIND RANDOM ADDRESS
  
 SOD13    LMN    OVRT&ABRT
          NJN    SOD11       IF NOT AN OVERLAY
          LDD    LV          CHECK LEVEL REQUESTED
          ZJN    SOD11       IF REQUEST IS FOR 0,0
  
*         FOUND OVERLAY OF PROPER LEVEL, CONVERT ITS RANDOM ADDRESS.
  
 SOD14    LDM    1*5+3,T2    SET RANDOM INDEX 
          STD    RI 
          LDM    1*5+4,T2 
          STD    RI+1 
          ADD    RI 
          ZJN    SOD15       IF RANDOM INDEX IS ZERO
          LDD    FS+1        SET TO FIRST TRACK 
          STD    T6 
          RJM    CRA         CONVERT RANDOM ADDRESS 
          MJN    SOD15       IF RANDOM ADDRESS NOT ON DISK
  
*         SET FILE POSITION TO *BOI* TO MINIMIZE SEARCH TIME
*         IN CASE OVERLAY NAME FOUND IN *OPLD* IS NOT THE 
*         CORRECT LEVEL.  THIS WILL ALSO MINIMIZE THE POSSIBILITY 
*         OF AN OVERLAY OF THE CORRECT LEVEL AND WRONG NAME 
*         BEING LOADED. 
  
          LDD    FS+1        SET CURRENT TRACK = FIRST TRACK
          STD    FS+2 
          LDN    FSMS        SET FIRST SECTOR 
          STD    FS+3 
          LJM    SODX        RETURN 
  
 SOD15    LJM    SFO16       OVERLAY NOT FOUND
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 FN       EQU    AB          FILE NAME
 RI       EQU    T8          RANDOM INDEX (2 WORDS) 
*CALL     COMPSAF 
*CALL     COMPSFB 
*CALL     COMPCRA 
  
          USE    LITERALS 
  
          ERRNG  OVL-5-*-500 OVERFLOWS INTO OVERLAY AREA
          TTL    1AJ/3AE - LOAD COPY ROUTINES.
          TITLE 
          QUAL   3AE
          IDENT  3AE,LCRX    LOAD COPY ROUTINES.
*COMMENT  1AJ - LOAD COPY ROUTINES. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AE - LOAD COPY ROUTINES. 
* 
*         *3AE* CONTAINS SUBROUTINES USED TO LOAD PROGRAMS. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * OVERLAY NOT FOUND.* = REQUESTED OVERLAY WAS NOT FOUND.
* 
*         * FL TOO SHORT FOR PROGRAM.*
* 
*         * FLE TOO SHORT FOR LOAD.* = EXTENDED MEMORY FL TOO SHORT FOR 
*         REQUIRED LOAD.
* 
*         * INCORRECT LOAD ADDRESS.* = LOAD ADDRESS .LT. 2
* 
*         * LDR - ENTRY POINT NOT FOUND.* = ENTRY POINT 
*         SPECIFIED COULD NOT BE LOCATED BY *1AJ*.
* 
*         * UNIDENTIFIED PROGRAM FORMAT.* = THE FILE REQUESTED TO BE
*         LOADED WAS NOT IN A RECOGNIZED FORMAT.
* 
*         * EXTENDED MEMORY LOAD ERROR.* = BAD LOAD ADDRESS FROM
*         EXTENDED MEMORY.
* 
*         * UNRECOVERED MASS STORAGE ERROR.* = UNRECOVERED READ 
*         ERROR ENCOUNTERED ON LOAD.
* 
*         * OVERLAY LOST.* = OVERLAY NOT FOUND ON *CLD*.
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 WC       EQU    T8          SECTOR WORD COUNT
 PF       EQU    /TCS/PF     PROGRAM FORMAT 
****
          SPACE  4,10 
          TITLE  LOAD SUBROUTINES.
 LCR      SPACE  4,10 
**        LCR - ENTRY/EXIT. 
* 
*         CALLS  PRS. 
  
  
          ORG    OVL+5
 LCR      SUBR               ENTRY/EXIT 
          RJM    PRS         PRESET OVERLAY 
          UJN    LCRX        RETURN FROM LOAD 
 LCP      SPACE 4,20
**        LCP - LOAD CENTRAL PROGRAM. 
* 
*         ENTRY  (T5) = ALTERNATE DEVICE EST ORDINAL. 
*                (T1) = CM WORD COUNT OF SECTOR IN *BFMS*.
*                (FA) = FNT ADDRESS IF LOCAL FILE LOAD. 
*                (FA) = 0 IF LOAD FROM SYSTEM.
*                (CW - CW+4) LIBRARY CONTROL WORD.
*                (FS - FS+4) FST ENTRY IN FILE LOAD.
*                (/3AE/MSRA) = 1 IF JOB ADVANCE NOT SET.
* 
*         EXIT   (A) = ADDRESS OF ERROR MESSAGE.
*                (PF) = PROGRAM FORMAT. 
*                TO *MSR*, IF MASS STORAGE ERROR. 
* 
*         USES   T1, T5 - T7, CM - CM+4.
* 
*         CALLS  CDP, CSA, CCM, CPF.
* 
*         MACROS ENDMS, SETMS.
  
  
 LCP      SUBR               ENTRY/EXIT 
          LDD    FA          CHECK FNT ADDRESS
          ZJN    LCP1        IF NOT FILE LOAD 
          LJM    CMS         COPY MS RESIDENT PROGRAM 
  
 LCP1     LDD    CW+1        CHECK LIBRARY RESIDENCE
          LPC    6000 
          ZJN    LCP2        IF RESIDENT ON SYSTEM DEVICE ONLY
          RJM    CSA
          ZJN    LCP2        IF SYSEDIT ACTIVE
          RJM    CCM         CHECK PROGRAM RESIDENCE
          NJN    LCP3        IF ON ALTERNATE SYSTEM 
 LCP2     LDN    FNTP        GET SYSTEM DEVICE FROM SYSTEM FST
          CRD    CM 
          LDD    CM 
          SHN    14 
          ADD    CM+1 
          ERRNZ  SYFO        (SYSTEM FILE ORDINAL NONZERO.) 
          ADN    FSTG 
          CRD    CM 
          LDD    CM 
          LPC    777
          STD    T5 
          RJM    CDP         CHECK DEVICE PARAMETERS
 LCP3     LDD    CW+3        SET TRACK
          STD    T6 
          LDD    CW+4        SET SECTOR 
          STD    T7 
          SETMS  READSYS
 LCP4     RJM    CPF         CHECK PROGRAM FORMAT 
          ZJN    CMS         IF LOADABLE FORMAT 
 LCP5     STD    T1 
          ENDMS 
          LDD    T1 
          JMP    LCPX        RETURN 
 CMS      SPACE  4,25 
**        CMS - COPY MS RESIDENT PROGRAM. 
* 
*         ENTRY  (T4 - T7) = MS PARAMETERS. 
*                (T1) = CM WORD COUNT OF SECTOR IN *BFMS*.
*                (T3) = ADDRESS-2 OF PROGRAM HEADER IN *BFMS*.
*                (CN - CN+1) = LOAD ADDRESS, IF NONE SPECIFIED BY USER. 
*                (FA) = ADDRESS OF FST ENTRY. 
*                (FS - FS+4) = FST ENTRY. 
*                (PF) = PROGRAM FORMAT. 
*                FIRST SECTOR READ AND *CPF* CALLED.
* 
*         EXIT   TO *LCP5* IF LOAD ERROR WITH - 
*                (A) = ERROR MESSAGE ADDRESS. 
*                TO *SLP* AFTER LOAD WITH - 
*                (AB+3 - AB+4) = FWA OF PROGRAM.
*                (CN+3 - CN+4) = LWA+1 OF PROGRAM.
*                TO *MSR*, IF MASS STORAGE ERROR. 
* 
*         USES   AB+3 - AB+4, CN+3 - CN+4, FS+2 - FS+4. 
* 
*         CALLS  CSF, DDT, MSR, RNS.
* 
*         MACROS ENDMS, LDA, MONITOR, NFA.
  
  
*         INCORRECT LOAD ADDRESS ERROR. 
  
 CMS9     LDC    /ERR/EM20   * INCORRECT LOAD ADDRESS.* 
          UJN    LCP5        EXIT 
  
*         FL TOO SHORT ERROR. 
  
 CMS10    LDC    /ERR/EM02   * FL TOO SHORT FOR PROGRAM.* 
          UJN    LCP5        EXIT 
  
 CMS      LDC    0
 CMSA     EQU    *-2
          NJN    CMS1        IF USER SPECIFIED LOAD ADDRESS 
          LDD    CN          SET LOAD ADDRESS 
          SHN    14 
          LMD    CN+1 
 CMS1     SBN    2           CHECK LOAD ADDRESS 
          MJN    CMS9        IF .LE. 1
          ADN    2
          STD    CN+2 
          STD    CN+4 
          SHN    -14
          STD    CN+1 
          STD    CN+3 
  
*         COPY PROGRAM FROM MASS STORAGE. 
  
          RJM    CSF         CHECK SPECIAL FORMAT 
 CMS2     LDD    T3          SET WRITE ADDRESS
          ADN    2
          STM    CMSC 
          LDD    CN+3        CHECK WRITE LENGTH 
          SHN    14 
          ADD    CN+4 
          ADD    T1 
          SBN    1           GENERATE LWA FROM LWA+1
 CMSB     SHN    -6          NO LWA FOR LOAD SPECIFIED
          SBD    FL 
*         ADC    -(LWA+1)    (LWA FOR LOAD SPECIFIED) 
          PJN    CMS10       IF WRITE LENGTH .GT. FL
          LDA    CN+3        STORE SECTOR 
          CWM    BFMS+2,T1
 CMSC     EQU    *-1
          LDD    T1          ADVANCE ADDRESS
          RAD    CN+4 
          SHN    -14
          RAD    CN+3 
          LDM    BFMS+1      CHECK SECTOR WORD COUNT
          SHN    -6 
          ZJN    CMS3        IF SHORT SECTOR
 CMSD     LDN    0           CHECK EXTENDED MEMORY BUFFERED FLAG
*         LDN    2&3         (DEVICE BUFFERED IN EXTENDED MEMORY) 
          NJN    CMS4        IF DEVICE BUFFERED IN EXTENDED MEMORY
          LDC    BFMS        READ NEXT SECTOR 
          RJM    RNS
          MJN    CMS5        IF MASS STORAGE READ ERROR 
          ZJN    CMS3        IF WORD COUNT = 0
          LDN    IMLL 
          RAM    CMSF+4 
          LJM    CMS2        READ NEXT SECTOR 
  
 CMS3     UJN    CMS7        CONTINUE 
  
 CMS4     LDD    MA          COPY CM ADDRESS
          CWD    CN 
          CRD    CM 
 CMSE     LDC    **          SET LWA OF LOAD
*         LDC    LWA         (LWA OF LOAD IF SPECIFIED) 
          SHN    14 
          STD    CM+2 
          SHN    -6 
          SCN    77 
          RAD    CM+3 
          LDC    RDDS*10000+7777  READ TO EOR 
          RJM    DDT
          PJN    CMS6        IF NO ERROR OCCURED
          SHN    21-20
          PJN    CMS5        IF NOT A LOAD ERROR
          LJM    CMS10       ISSUE LOAD ERROR MESSAGE 
  
 CMS5     LJM    MSR         PROCESS READ ERROR 
  
 CMS6     LDD    CM+3        SET LWA+1 OF LOAD
          LPN    77 
          STD    CN+3 
          LDD    CM+4 
          STD    CN+4 
          LDD    T4 
          RAM    CMSF+4 
          ERRNZ  IMLL-1      CODE DEPENDS ON VALUE
 CMS7     ENDMS 
          LDD    CN+2        SET FWA OF LOAD
          STD    AB+4 
          LDD    CN+1 
          STD    AB+3 
          LDD    FA 
          ZJN    CMS8        IF NOT FILE LOAD 
          LDD    T6          SET CURRENT TRACK
          STD    FS+2 
          LDD    T7          SET CURRENT SECTOR 
          STD    FS+3 
          LDD    FS+4        SET OPERATION COMPLETE 
          SCN    77 
          LMN    5
          STD    FS+4 
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL 
          CWD    FS 
  
*         INCREMENT CHARGES FOR LOAD. 
  
 CMS8     LDD    MA          WRITE UADM PARAMETER TO MB 
          CWM    CMSF,ON
          LDN    1           SET WORD COUNT AND NO DROP FLAG
          STD    CM+1 
          STD    CM+2 
          MONITOR  UADM 
          UJN    SLP         SET LOAD PARAMETERS
  
  
 CMSF     CON    AISS        SUB FUNCTION 
          CON    IOAW        WORD TO UPDATE 
          CON    40D*100+20D FIELD TO UPDATE
          CON    0           INCREMENT
          CON    IMLL 
 SLP      SPACE  4,15 
**        SLP - SET LOAD PARAMETERS.
* 
*         ENTRY  AT *SLP* FROM ROUTINES *CMS* AND *CCM*.
*                (PF) = PROGRAM FORMAT. 
*                (AB+3 - AB+4) = FWA PROGRAM. 
*                (CN+3 - CN+4) = LWA+1 OF PROGRAM.
* 
*         EXIT   (CM+3 - CM+4) = ENTRY ADDRESS. 
*                (AB+3 - AB+4) = FWA OF PROGRAM.
*                */TCS/BCPI* SET WITH PARAMETERS FOR *CSTM* 
*                MONITOR CALL.
* 
*         USES   CM - CM+4, AB - AB+2, CN - CN+4, CW - CW+4.
* 
*         CALLS  REP. 
  
  
 SLP      LDA    AB+3,M      READ ENTRY POINTS
          ADC    0           TABLE OFFSET FOR *5400* TABLE
 SLPA     EQU    *-1
*         ADC    7           (*5400* TABLE AND 00,00 OVERLAY) 
*         ADC    4           (*5400* TABLE AND NOT 00,00 OVERLAY) 
          CRM    BFMS,HN
          LDK    MABL        CHECK MAINFRAME TYPE 
          CRD    CM 
          LDD    CM+1 
          SHN    21-13
          PJN    SLP1        IF CYBER 170-8X5 TYPE MAINFRAME
          LDD    CP          CHECK JOB STATUS 
          ADN    STSW 
          CRD    CM 
          LDD    CM 
          SHN    -11
          LMN    ICPS 
          NJN    SLP1        IF JOB NOT IN *I* STATUS 
          LDD    CP          CLEAR EXIT MODE FLAGS FROM XP
          ADN    3
          CRD    CM 
          LDD    CM 
          SCN    30          CLEAR ERROR EXIT STATUS BITS 
          STD    CM 
          LDD    CP 
          ADN    3
          CWD    CM 
 SLP1     BSS    0
 SLPB     LDN    0           CHECK LDR CALL 
*         LDN    1           (LDR CALL) 
          NJN    SLP2        IF LDR CALL
          LDD    CN+3        SET FWA OF CLEAR MEMORY FUNCTION 
          STM    /TCS/BCPI+3
          LDD    CN+4 
          STM    /TCS/BCPI+4
          LDD    FL          COMPUTE WORD COUNT OF CLEAR
          SHN    6
          SBD    CN+4 
          SHN    6
          SBD    CN+3 
          SHN    14 
          STM    /TCS/BCPI+2
          SHN    -14
          STM    /TCS/BCPI+1
          LDD    AB+3        SET CLEAR OF AREA FROM 100B TO FWA 
          SHN    14 
          ADD    AB+4 
          SBD    HN 
          MJN    SLP2        IF LOADED BEFORE 100B
          STM    /TCS/BCPI+5+2
          SHN    -14
          STM    /TCS/BCPI+5+1
 SLP2     LDM    CL 
          NJN    SLP3        IF ENTRY POINT SPECIFIED 
          AOM    SLPH        DO NOT SEARCH ENTRY POINTS 
 SLP3     LDD    RA          MERGE *CYBER LOADER* FIELDS
          SHN    6
          ADN    FWPR 
          CRD    CW 
          LDD    CW 
          LPC    3777 
          ADC    4000        SET CEJ/MEJ ENABLED FLAG IN (FWPR) 
          STD    AB 
          LDD    CW+1 
          STD    AB+1 
          LDN    0           SET LOAD ORIGIN TYPE 
 LDOT     EQU    *-1         (PRS)
          STD    AB+2 
          LDD    RA          MERGE *CYBER LOADER* FIELDS
          SHN    6
          ADN    LWPR 
          CRD    CW 
          LDK    MABL        GET HARDWARE OPTIONS 
          CRD    CM 
          LDD    CM+1        SET CMU BIT IN (LWPR)
          LPN    10 
          LMN    10 
          SHN    10 
          STD    CN 
          LDN    IPRL        SET CHARACTER SET MODE 
          CRD    CM 
          LDD    CM+2 
          LPN    1
          SHN    21-6        POSITION CHARACTER SET MODE FLAG 
          STD    CM 
          LDN    0
          STD    CN+2 
          LDD    CW 
          LPC    3777 
          RAD    CN 
          LDD    CW+1 
          STD    CN+1 
          LDN    ZERL 
          CRD    CM+1 
          LDC    0
 SLPC     EQU    *-1
          SBN    3
          NJN    SLP5        IF NO *ACPM* CONTROL INFORMATION 
          SOD    CN+4 
          PJN    SLP4        IF NO UNDERFLOW
          SOD    CN+3 
          AOD    CN+4 
 SLP4     LDA    CN+3 
          CRD    CW          READ CONTROL WORD
          LDD    CW+3 
          SCN    77 
          ADD    CW+2 
          ZJN    SLP5        IF *ENDS* FIELD NULL 
          LDA    AB+3 
          CWD    CW 
          UJN    SLP6        SKIP 54 TABLE PROCESSING 
  
 SLP5     SBN    1
          NJN    SLP6        IF NOT 54 TABLE
          LDA    AB+3,M      READ MINFL WORD
          ADN    1
          CRD    T0 
          LDD    T0+3 
          LPN    77 
          STD    CN+3 
          LDD    T0+4 
          STD    CN+4 
 SLP6     LDD    CN+3 
 SLPD     LMD    HN          SET LIBRARY LOAD FLAG
*         PSN                (IF LOCAL FILE LOAD) 
          STD    CN+3        SET LOAD ORIGIN
          LDC    0           SET RSS AND DIS BITS 
 SLPE     EQU    *-1
          RAD    AB+3 
          LDD    RA 
          SHN    6
          ADN    LWPR 
          CWD    CN          STORE LWA OF PROGRAM 
          ADN    FWPR-LWPR
          CWD    AB          STORE FWA OF PROGRAM 
          ADN    LDRR-FWPR
          CWD    CM          STORE LDR STATUS 
 SLPF     LDN    0
*         LDN    1           (*CLB=* PRESENT) 
          NJN    SLP7        IF *CLB=* PRESENT
          LJM    SLP11       SKIP *CLB=* PROCESSING 
  
 SLP7     LDN    0
          STD    CW 
 SLP8     RJM    REP         READ ENTRY POINT 
          CRD    CN 
          LDD    CN 
          LMC    2RCL 
          NJN    SLP9        IF NOT *CLB=*
          LDD    CN+1 
          LMC    2RB= 
          NJN    SLP9        IF NOT *CLB=*
          LDD    CN+3 
          SCN    77 
          ADD    CN+2 
          ZJN    SLP10       IF *CLB=* FOUND
 SLP9     AOD    CW 
          LMC    *
 SLPG     EQU    *-1
          NJN    SLP8        IF SEARCH INCOMPLETE 
          LDM    /TCS/CSEB
          LPC    7677 
          STM    /TCS/CSEB
          LJM    SLP13       RETURN 
  
 SLP10    LDD    CP          SAVE *CLB=* FET RELATIVE ADDRESS IN *TINW* 
          ADN    TINW 
          CRD    CM 
          LDD    CM+3 
          LPN    77 
          SHN    14 
          ADD    CN+4 
          SHN    6
          STD    CM+3 
          LDD    CN+4 
          SCN    77 
          SHN    6
          ADD    CN+3 
          SHN    6
          STD    CM+2 
          LDD    CP 
          ADN    TINW 
          CWD    CM 
  
*         SET ENTRY ADDRESS 
  
 SLP11    LDN    0
          STD    CW 
 SLP12    RJM    REP         READ ENTRY POINT 
          CRD    CM          READ ENTRY POINT FROM CM 
          LDC    0
 SLPH     EQU    *-1         SEARCH ENTRY POINTS FLAG 
          NJN    SLP13       IF NOT SEARCHING TABLE 
          LDM    CL 
          SBD    CM 
          NJN    SLP14       IF NOT A MATCH 
          LDM    CL+1 
          SBD    CM+1 
          NJN    SLP14       IF NOT A MATCH 
          LDM    CL+2 
          SBD    CM+2 
          NJN    SLP14       IF NOT A MATCH 
          LDD    CM+3 
          SCN    77 
          SBM    CL+3 
          NJN    SLP14       IF NOT A MATCH 
 SLP13    LDN    0
          UJN    SLP16       RETURN 
  
 SLP14    AOD    CW 
          LMM    SLPG        NUMBER OF ENTRY POINTS 
          ZJN    SLP15       IF DONE WITH SEARCH
          LJM    SLP12       CONTINUE PROCESSING
  
 SLP15    LDC    /ERR/EM12   * LDR - ENTRY POINT NOT FOUND.*
 SLP16    LJM    LCPX        RETURN 
 REP      SPACE  4,10 
**        REP - READ ENTRY POINT. 
* 
*         ENTRY  (CW) = CURRENT ENTRY POINTER.
*                (PF) = PROGRAM FORMAT. 
*                (AB+3 - AB+4) = FWA OF PROGRAM.
* 
*         EXIT   (A) = ADDRESS OF ENTRY POINT.
* 
*         USES   T1.
  
  
 REP      SUBR               ENTRY/EXIT 
          LDD    PF          MULTIPLY TABLE OFFSETS BY 5
          SBN    1
          ADD    CW 
          STD    T1 
          SHN    2
          ADD    T1 
          ADC    BFMS        ENTRY POINT BUFFER 
          STM    REPA 
          LDD    MA          WRITE ENTRY POINT TO MESSAGE BUFFER
          CWM    *,ON 
 REPA     EQU    *-1
          SBN    1
          UJN    REPX        RETURN 
 CSF      SPACE  4,20 
**        CSF - CHECK SPECIAL FORMAT
*         CHECK FOR VALID *ACPM* FORMAT AND, IF VALID, COPY UPDATED 
*         HEADER/ENTRY POINTS TO CM LOAD ADDRESS. 
* 
*         ENTRY  (T1) = WORD COUNT IN *BFMS*. 
*                (T3) = ADDRESS-2 OF PROGRAM HEADER IN *BFMS*.
*                (CN+3 - CN+4) = CM LOAD ADDRESS. 
*                (AB+3 - AB+4) = *FWA* OF LOAD. 
* 
*         EXIT   TO *LCP3* IF UNIDENTIFIED PROGRAM FORMAT.
*                IF VALID *ACPM* FORMAT - 
*                (T1) = WORD COUNT IN *BFMS*-HEADER LENGTH. 
*                (T3) = FWA OF CODE IN *BFMS*.
*                (CN+3 - CN+4) = CM LOAD ADDRESS UPDATED. 
*                (CSFD - CSFD+1) = *FWA* FROM 53 TABLE. 
* 
*         USES   T1, T3, CM - CM+1, CN+3 - CN+4.
* 
*         CALLS  CPH, LEC.
  
  
 CSF5     LMC    5400&5300
          NJN    CSFX        IF NOT A 54 TABLE
          LDC    *           COMPUTE TABLE LENGTH 
 CSFB     EQU    *-1
*         LDC    7           (54 TABLE AND 00,00 OVERLAY (ABS)) 
*         LDC    7+DL        (00,00 OVERLAY WITH *FOL* DIRECTORY) 
*         LDC    3           (54 TABLE AND NOT 00,00 OVERLAY (OVL)) 
          ADN    1
          ADM    2+4,T3      ADD *K* FROM HEADER
          STD    T2 
          LDD    T3          SET ADDRESS OF *ECS* CONTROL WORD
          ADN    2+12 
          STM    CSFC 
          LDD    MA          MOVE *EXTENDED MEMORY* LOADER CONTROL WORD 
          CWM    *,ON 
 CSFC     EQU    *-1
          SBN    1
          CRD    CW 
          RJM    CPH         COPY HEADER DATA 
          LDD    CW+3        CHECK FOR *EXTENDED MEMORY* LOAD REQUIRED
          ADD    CW+4 
          ZJN    CSFX        IF NO *EXTENDED MEMORY* LOAD DATA
          RJM    LEC         LOAD *EXTENDED MEMORY* DATA
  
 CSF      SUBR               ENTRY/EXIT 
          LDM    2,T3        CHECK TABLE TYPE 
          LMC    5300 
          NJN    CSF5        IF NOT 53 TABLE
          LDM    5,T3        CHECK 53 TABLE TYPE
          LPN    40 
          ZJN    CSF2        IF SINGLE ENTRY POINT (TYPE 1) 
          LDM    6,T3        COMPLEMENT ENTRY COUNT 
          LMC    7777 
 CSF2     ADN    1
          STD    T2          SET WORD COUNT FOR COPY
          LDM    4,T3        SAVE *FWA* FROM 53 TABLE 
          STM    CSFD 
          LDM    5,T3 
          STM    CSFD+1 
          RJM    CPH         COPY HEADER DATA 
          LDD    T3          MOVE *EM* LOADER CONTROL WORD
          STM    CSFA 
          LDD    MA 
          CWM    *,ON 
 CSFA     EQU    *-1
          SBN    1
          CRD    CW 
          LDN    5           SKIP *EXTENDED MEMORY* CONTROL WORD
          RAD    T3 
          SOD    T1 
          LDD    CW+3        CHECK IF *EXTENDED MEMORY* LOAD REQUIRED 
          ADD    CW+4 
          ZJN    CSF3        IF NO *EXTENDED MEMORY* LOAD REQUIRED
          RJM    LEC         LOAD *EXTENDED MEMORY* DATA
 CSF3     LDA    AB+3,M      UPDATE HEADER WORD 
          CRD    CM 
          LDM    2+3,T3      CHECK *ENDS* FIELD 
          SCN    77 
          STD    T2 
          SHN    6
          ADM    2+2,T3 
          ZJN    CSF4        IF EMPTY FIELD 
          STD    CM+2        REPLACE *FWAS* FIELD IN HEADER 
          LDD    CM+3 
          LPN    77 
          LMD    T2 
          STD    CM+3 
          LDA    AB+3,M      REWRITE HEADER WORD
          CWD    CM 
 CSF4     LDN    5           SKIP CONTROL WORD
          RAD    T3 
          SOD    T1 
          LDN    0           CLEAR CONTROL FLAG 
          STM    SLPC 
          LJM    CSFX        RETURN 
  
  
 CSFD     CON    0,0         FWA FROM 53 TABLE
 LEC      SPACE  4,15 
**        LEC - LOAD *EXTENDED MEMORY* DATA BLOCK.
* 
*         ENTRY  (T1) = PP BUFFER WORD COUNT. 
*                (T3) = PP BUFFER ADDRESS-2.
*                (T4 - T7) = DISK PARAMETERS. 
*                (CW - CW+4) = *EXTENDED MEMORY* LOAD CONTROL WORD. 
* 
*         EXIT   TO *MSR* IF MASS STORAGE ERROR.
*                TO *LCPX* IF ANY OTHER ERROR.
*                (T1, T3, T6, T7) UPDATED.
* 
*         USES   T1, T3, CM - CM+6, CW+3 - CW+4.
* 
*         CALLS  RNS. 
* 
*         MACROS ENDMS, MONITOR.
  
  
 LEC      SUBR               ENTRY/EXIT 
          UJN    LEC2        COPY DATA TO EXTENDED MEMORY 
  
 LEC1     LDC    BFMS        READ NEXT SECTOR 
          RJM    RNS
          MJP    MSR         IF DEVICE ERROR
 LEC2     LDD    T1          SAVE WORD COUNT
          STD    WC 
          ENDMS 
          LDD    WC 
          ZJP    LEC8        IF SECTOR EMPTY
          LDD    T3          SET BUFFER ADDRESS 
          ADN    2
          STM    LECA 
          LDD    CW+3        CHECK *WCL*
          NJN    LEC4        IF FULL BUFFER LOAD
          ADD    CW+4 
          ZJN    LECX        IF END OF LOAD 
          SBD    WC 
          PJN    LEC4        IF FULL BUFFER LOAD
          LDD    CW+4        SET REMAINDER OF LOAD
 LEC3     STD    WC 
          ZJN    LEC1        IF END OF BUFFER 
 LEC4     LDD    WC 
          SBN    6
          MJN    LEC5        IF LESS THAN 6 WORDS IN BUFFER 
          LDN    0
 LEC5     ADN    6
          STD    T2 
          SBN    1
          SHN    6
          STD    CM+1 
          LDD    CW+2        SET RELATIVE EXTENDED MEMORY ADDRESS 
          STD    CM+4 
          LDD    CW+1 
          LMC    WRES*1000   WRITE RELATIVE EXTENDED MEMORY 
          STD    CM+3 
          LDD    MA 
          STD    CM+2        SET CM ADDRESS 
          CWM    *,T2 
 LECA     EQU    *-1
          MONITOR  ECSM      COPY DATA TO EXTENDED MEMORY 
          LDD    CM+1 
          ZJN    LEC6        IF NO ERROR
          LMN    1
          NJN    LEC6        IF NOT OUT OF EXTENDED MEMORY FL 
          LDC    /ERR/EM21   * FLE TOO SHORT FOR LOAD.* 
          JMP    LCPX        RETURN ERROR 
  
 LEC6     LDD    T2 
          SHN    2
          ADD    T2 
          RAM    LECA 
          LDD    T2          INCREMENT EXTENDED MEMORY ADDRESS
          RAD    CW+2 
          SHN    -14
          RAD    CW+1 
          LDD    CW+4        DECREMENT *WCL*
          SBD    T2 
          STD    CW+4 
          PJN    LEC7        IF NO UNDERFLOW
          AOD    CW+4        ADJUST RESULT
          SOD    CW+3 
          MJN    LEC8        IF NO UNDERFLOW
 LEC7     LDD    T1          DECREMENT SECTOR WORD COUNT
          SBD    T2 
          STD    T1 
          LDD    CW+4        CHECK FOR END OF LOAD
          ADD    CW+3 
          ZJN    LEC9        IF END OF LOAD 
          LDD    WC          DECREMENT LOAD BUFFER WORD COUNT 
          SBD    T2 
          LJM    LEC3        SET NEW WORD COUNT 
  
 LEC8     LDC    /ERR/EM22   * UNIDENTIFIED PROGRAM FORMAT.*
          JMP    LCPX        RETURN ERROR 
  
 LEC9     LDM    LECA        RESET LOAD BUFFER ADDRESS
          SBN    2
          STD    T3 
          LDD    T1 
          NJN    LEC10       IF SECTOR NOT EMPTY
          LJM    LEC1        GO READ NEXT SECTOR
  
 LEC10    LJM    LECX        RETURN 
 MSR      SPACE  4,25 
**        MSR - MASS STORAGE READ ERROR PROCESSOR 
* 
*         *MSR* IS CALLED-
*                1) IF AN INACCESSIBLE MASS STORAGE DEVICE OR AN I/O
*                   ERROR IS ENCOUNTERED. 
*                2) IF A BAD ECS LOAD ADDRESS IS ENCOUNTERED. 
* 
*         ENTRY  (AB - AB+4) = PROGRAM NAME.
*                (T4) = CHANNEL NUMBER. 
*                (T5) = EST ORDINAL OF EQUIPMENT WITH ERROR.
*                (FA) .NE. 0 IF FILE LOAD.
*                (FA) .NE. 0 IF LOCAL FILE LOAD.
*                (FS - FS+4) = FST ENTRY IN FILE LOAD.
* 
*         EXIT   TO *LCPX* TO ABORT JOB IF LOCAL FILE LOAD. 
*                TO *LCP1* TO RETRY LOAD. 
*                TO *LDE* TO ABORT OVERLAY LOAD FROM LOCAL FILE.
*                TO *1RJ* IF A RECOVERABLE MASS STORAGE ERROR OR
*                INACCESSIBLE DEVICE IS ENCOUNTERED.
* 
*         USES   FS+4, IR+4, T5, CM - CM+4, CW - CW+4.
* 
*         CALLS  CLD, *1RJ*.
* 
*         MACROS ENDMS, EXECUTE, MONITOR, NFA.
  
  
 MSR      BSS    0           ENTRY
          ENDMS 
          LDM    RDCT        CHECK NON-RECOVERABLE MASS STORAGE ERROR 
          SHN    21-12
          MJN    MSR2        IF NON-RECOVERABLE 
          LDM    MSD         CHECK FOR SUBSYSTEM
          SHN    21-13
          PJN    MSR2        IF A SUBSYSTEM, ABORT JOB
          LDD    T5          SET EQUIPMENT TO WAIT FOR
          STD    IR+4 
          LDD    FA          CHECK REQUEST
          ZJN    MSR1        IF NOT LOCAL FILE LOAD 
          LDD    FS+4        SET OPERATION COMPLETE 
          SCN    77 
          LMN    5
          STD    FS+4 
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL 
          CWD    FS 
 MSR1     LDN    0
*         LDN    1           (JOB ADVANCE NOT SET)
 MSRA     EQU    *-1
          NJN    MSR1.1      IF NON JOB ADVANCE TYPE ERROR PROCESSING 
          STD    CM+1        CLEAR JOB ADVANCE
          MONITOR  JACM 
 MSR1.1   EXECUTE  1RJ       ROLL JOB 
*         LJM    PPR         DOES NOT RETURN
  
 MSR2     LDD    FA          CHECK REQUEST
          ZJN    MSR4        IF NOT LOCAL FILE LOAD 
 MSR3     LDC    /ERR/EM23   * UNRECOVERED MASS STORAGE ERROR.* 
*         LDC    /ERR/EM23+400000  (LOCAL FILE LOAD PROCESSING) 
 MSRB     EQU    *-2
          LJM    LCPX        ABORT LOCAL FILE LOAD
*         LJM    LDE         (OVERLAY LOAD FROM LOCAL FILE) 
 MSRC     EQU    *-1
  
 MSR4     RJM    CLD         SEARCH CENTRAL DIRECTORY 
          NJN    MSR5        IF ENTRY FOUND 
          LDC    /ERR/EM24   * OVERLAY LOST.* 
          LJM    LCPX        EXIT 
  
 MSR5     CRD    CW          READ CONTROL WORD
          SBN    1
          CRD    CM          READ LIBRARY ENTRY 
          LDD    CW+2        SET ALTERNATE EQUIPMENT
          STD    T5 
          LDD    CW+1 
          LPC    4000 
          ZJN    MSR3        IF NOT AN ALTERNATE SYSTEM DEVICE
          LDD    CM+2        SET ADDRESS OF PROGRAM ON SYSTEM DEVICE
          STD    CW+2 
          LDD    CM+3 
          STD    CW+3 
          LDD    CM+4 
          STD    CW+4 
          LDD    CW+1        CLEAR *ASR* FLAG 
          LPC    3777 
          STD    CW+1 
          LDD    T1 
          SHN    14 
          ADD    T2 
          CWD    CW 
          LDC    LDNI        RESET *CMS*
          STM    CMSD 
          LDN    0
          STM    CMSF+4      CLEAR MASS STORAGE INCREMENT 
          LJM    LCP1        RETRY READ 
 SPF      SPACE  4,15 
**        SPF - SET PROGRAM FORMAT. 
* 
*         ENTRY  (T3) = ADDRESS OF PROGRAM HEADER - 2.
* 
*         EXIT   (A) = (PF) = PROGRAM FORMAT
*                            1 = *OVL*
*                            2 = *ABS*
*                           .GT. 2 = ADDRESS OF MESSAGE.
*                (SPFA) = MINFL FROM 54 TABLE.
*                       = 0, IF NO MINFL. 
* 
*         USES   PF, T2, CM - CM+4. 
  
  
 SPF7     LDC    /ERR/EM22   * UNIDENTIFIED PROGRAM FORMAT.*
 SPF8     STD    PF 
  
 SPF      SUBR               ENTRY/EXIT 
          LDM    2,T3 
          SHN    -6 
          SBN    50 
          STM    SLPC 
          MJN    SPF7        IF NOT *OVL*/*ABS* 
          SBN    2
          ZJN    SPF7        IF TYPE PPU
          SBN    1
          NJN    SPF3        IF NOT *ACPM* TABLE
          LDM    2+3,T3 
          LPN    40 
          NJN    SPF2        IF MULTIPLE ENTRY POINTS 
*         LDN    0
 SPF1     STM    SLPG        SET NUMBER OF ENTRY POINTS 
          LDN    1           DO NOT SEARCH ENTRY POINTS 
          STM    SLPH 
          UJN    SPF8        RETURN 
  
 SPF2     LDM    6,T3        SET NUMBER OF ENTRY POINTS 
          STM    SLPG 
          LDN    2           SET PROGRAM FORMAT 
          UJN    SPF8        RETURN 
  
 SPF3     LDM    2,T3 
          SHN    -6 
          SBN    50 
          ZJN    SPF1        IF 50 TABLE
          SBN    1
          ZJN    SPF2        IF 51 TABLE
          SBN    3
          ZJN    SPF4        IF 54 TABLE
          LJM    SPF7        PROCESS ERROR
  
 SPF4     LDM    6,T3 
          STM    SLPG 
          LDM    2+1,T3      CHECK OVERLAY LEVEL
          NJP    SPF5        IF NOT 00,00 LEVEL OVERLAY 
          LDM    2+5*1+3,T3  MINFL
          LPN    77 
          SHN    14 
          LMM    2+5*1+4,T3 
          ADN    77 
          SHN    -6 
          STM    SPFA        INDICATE FL ERROR
          LDN    7           BIAS ENTRY POINT FOR 54 TABLE (ABS)
          STM    SLPA 
          STM    CSFB 
          RAM    SLPG        ADD OFFSET TO NUMBER REGULAR EP-S
  
*         PROCESS *FOL* CONTROL WORDS.
  
          LDN    ZERL 
          CRD    CM 
          LDM    /TCS/CGLC   SET RANDOM INDEX 
          STD    CM+2 
          LDM    /TCS/CGLC+1
          STD    CM+3 
          LDD    MA          SAVE RANDOM INDEX IN MB+1
          ADN    1
          CWD    CM 
          LDD    RA          GET PROGRAM NAME TO FORM *FOL* LOAD DATA 
          SHN    6
          ADN    PGNR 
          CRD    CM 
          LDM    2+5*6+3,T3  MERGE DIRECTORY LENGTH WITH LFN
          LPN    77 
 SPF4.1   NJP    SPF7        IF DIRECTORY TOO LONG
          LDM    2+5*6+4,T3 
          ZJN    SPF4.2      IF *FOL* DIRECTORY NOT PRESENT 
          STD    CM+4 
          RAM    CSFB 
          SHN    -14
          NJN    SPF4.1      IF DIRECTORY TOO LONG
 SPFB     LDN    2
*         UJN    SPF4.2      (SYSTEM FILE LOAD) 
  
          STD    T2 
          LDD    T3          READ *FOL* DATA TO HEADER
          ADN    2+5*6
          STM    SPFC 
          LDD    MA 
          CWD    CM 
          CRM    *,T2 
 SPFC     EQU    *-1
 SPF4.2   LDN    2           SET PROGRAM FORMAT = ABS 
          UJN    SPF6        RETURN 
  
 SPF5     LDN    3           SET HEADER LENGTH FOR 54 TABLE (OVL) 
          STM    CSFB 
          LDN    4           BIAS ENTRY POINT FOR 54 TABLE (OVL)
          STM    SLPA 
          RAM    SLPG        ADD OFFSET TO NUMBER REGULAR EP-S
          LDN    1           SET PROGRAM FORMAT = OVL 
 SPF6     LJM    SPF8        RETURN 
  
  
 SPFA     CON    0           MINFL FROM 54 TABLE
  
          ERRNG  37+SPFB-SPF4.2  IF JUMP OUT OF RANGE 
 CDP      SPACE  4,10 
**        CDP - CHECK DEVICE PARAMETERS.
* 
*         ENTRY  (A) = EST ORDINAL. 
* 
*         EXIT   (A) .EQ. 0, NOT BUFFERED DEVICE. 
*                    .GT. 0, EXTENDED MEMORY DEVICE.
*                    .LT. 0, BUFFERED DISK. 
*                (CM - CM+4) = EST ENTRY. 
* 
*         USES   CM - CM+4, CN - CN+4.
* 
*         MACROS SFA. 
  
  
 CDP      SUBR               ENTRY/EXIT 
          SFA    EST
          ADK    EQDE 
          CRD    CM          READ EST ENTRY 
          LDD    CM+4 
          SHN    3
          ADN    DILL 
          CRD    CN 
          LDD    CN+3 
          SHN    0-12 
          ZJN    CDPX        IF DEVICE NOT BUFFERED 
          RAM    CMSD 
          SHN    21-0 
          UJN    CDPX        RETURN 
 CPD      SPACE  4,15 
**        CPD - COPY DATA.
* 
*         ENTRY  (T1) = WORDS IN BUFFER.
*                (T2) = WORD COUNT TO COPY. 
*                (T3) = PP BUFFER ADDRESS-2.
*                (CN+3 - CN+4) = *CM* ADDRESS.
* 
*         EXIT   (T1, T3, CN+3 - CN+4) UPDATED. 
* 
*         USES   T1, T3, CN+3 - CN+4. 
  
  
 CPD      SUBR               ENTRY/EXIT 
          LDD    T3          SET WRITE ADDRESS
          ADN    2
          STM    CPDA 
          LDA    CN+3        COPY HEADER
          CWM    *,T2 
 CPDA     EQU    *-1
          LDD    T2          ADVANCE *CM* ADDRESS 
          RAD    CN+4 
          SHN    -14
          RAD    CN+3 
          LDD    T2          ADVANCE PP BUFFER ADDRESS
          SHN    2
          ADD    T2 
          RAD    T3 
          LDD    T1          DECREMENT WORD COUNT 
          SBD    T2 
          STD    T1 
          UJN    CPDX        RETURN 
 CPF      SPACE  4,25 
**        CPF - CHECK PROGRAM FORMAT. 
* 
*         ENTRY  (T4 - T7) = MASS STORAGE PARAMETERS. 
* 
*         EXIT   (A) = 0 IF CORRECT FORMAT. 
*                (A) = ERROR MESSAGE ADDRESS. 
*                (WC) = SECTOR WORD COUNT.
*                (T1) = WORD COUNT OF DATA IN SECTOR. 
*                (T3) = ADDRESS OF PROGRAM START. 
*                (CN - CN+1) = CENTRAL LOAD ADDRESS.
*                (PF) = PROGRAM FORMAT. 
*                            1 = *OVL*
*                            2 = *ABS*
*                            .GT. 2 = UNIDENTIFIED FORMAT.
*                                     CONTAINS MESSAGE ADDRESS. 
*                MASS STORAGE ERROR PROCESSING SELECTED.
*                TO *MSR* IF MASS STORAGE ERROR 
* 
*         USES   T1 - T3, CN - CN+1.
* 
*         CALLS  RNS, SPF.
* 
*         MACROS SETMS. 
  
  
 CPF4     LDC    /ERR/EM22   * UNIDENTIFIED PROGRAM FORMAT.*
  
 CPF      SUBR               ENTRY/EXIT 
          SETMS  =,READSTR   SET STREAMED READ FLAG 
          LDM    CHRV 
          LPC    -1000
          LMD    TH 
          STM    CHRV 
          SETMS  POSITION    FORCE *LDAM* ON NEXT READ
          LDC    BFMS        READ SECTOR
          RJM    RNS
          MJP    MSR         IF MASS STORAGE ERROR
          STD    WC          SAVE SECTOR WORD COUNT 
          ZJN    CPF4        IF EMPTY SECTOR
  
*         DELETE 7700 TABLE IF PRESENT. 
  
          LDM    BFMS+2      CHECK FIRST WORD 
          LMC    7700 
          NJN    CPF1        IF NOT 7700 TABLE
          LDM    BFMS+2+1    SKIP 7700 TABLE
          ADN    1
          STD    T2 
          SHN    2
          ADD    T2 
          RAD    T3 
          LDD    T1          ADJUST WORD COUNT
          SBD    T2 
          STD    T1 
  
*         PROCESS *OVL*/*ABS*.
  
 CPF1     RJM    SPF         SET PROGRAM FORMAT 
          SBN    3
          MJN    CPF2        IF LEGAL FORMAT
          ADN    3
          UJN    CPF3        RETURN WITH INCORRECT FORMAT 
  
 CPF2     LDM    5,T3 
          SHN    -6          SET LOAD ADDRESS 
          STD    CN+1 
          LDM    4,T3 
          SHN    6
          RAD    CN+1 
          SHN    -14
          STD    CN 
          LDN    0           EXIT WITH (A) = 0
 CPF3     LJM    CPFX        RETURN 
 CPH      SPACE  4,15 
**        CPH - COPY HEADER DATA. 
* 
*         ENTRY  (T1) = WORDS IN BUFFER.
*                (T2) = WORD COUNT TO COPY. 
*                (T3) = PP BUFFER ADDRESS-2.
*                (CN+3 - CN+4) = *CM* ADDRESS.
* 
*         EXIT   (T1, T3, CN+3 - CN+4) UPDATED. 
*                TO *CMS2* IF HEADER DATA OUT OF RANGE. 
* 
*         USES   T1, T2, T3, CN - CN+4. 
* 
*         CALLS  CPD, RNS.
  
  
 CPH      SUBR               ENTRY/EXIT 
          LDD    CN+3        CURRENT *CM* LOAD ADDRESS
          SHN    14 
          LMD    CN+4 
          ADD    T2          ADD WORD COUNT OF TABLE
          SBN    1
 CPHA     SHN    -6 
          SBD    FL 
*         ADC    -(LWA+1)    (LWA FOR LOAD SPECIFIED) 
          MJN    CPH1        IF TABLE WILL FIT IN LOADABLE FL 
          LJM    CMS10       ABORT LOAD 
  
 CPH1     LDD    T2          CHECK MULTIPLE SECTOR TABLE
          SBD    T1 
          MJN    CPH2        IF ALL DATA IN ONE BUFFER
          ZJN    CPH2        IF ALL DATA IN ONE BUFFER
          STM    CPHB        SAVE REMAINDER 
          LDD    T1          SET NEW WORD COUNT 
          STD    T2 
          RJM    CPD         COPY DATA
          LDC    BFMS        READ NEXT SECTOR 
          STD    T3 
          RJM    RNS
          MJP    MSR         IF MASS STORAGE ERROR
          LDC    **          SET REMAINING WORD COUNT 
 CPHB     EQU    *-1
          STD    T2 
          SBD    HN 
          PJN    CPH1        IF ANOTHER FULL PRU TO COPY
 CPH2     RJM    CPD         COPY DATA
          LJM    CPHX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 CL       BSS    6           RESERVED FOR CLD INFORMATION 
*CALL     COMPCLD 
*CALL     COMPDDT 
*CALL     COMPRNS 
          SPACE  4,10 
          ERRNG  BFMS-* 
  
  
**        CODE OVERLAYED BY *BFMS*. 
          TITLE  LOAD SUBROUTINES OVERLAID BY *BFMS*. 
 LDU      SPACE  4,20 
**        LDU - LOAD CENTRAL PROGRAM FROM USER LIBRARY. 
* 
*         ENTRY  (FA) = FNT ADRESS OF USER LIBRARY. 
*                (CW) = FIELD LENGTH REQUIREMENT. 
*                (CW+1) = EST ORDINAL.
*                (CW+3) = TRACK.
*                (CW+4) = SECTOR. 
*                (FS - FS+3) = ENTRY POINT NAME.
*                (FS+4) = TRACK.
* 
*         EXIT   TO *LCP* TO LOAD PROGRAM.
*                (CL - CL+5) = USER LIBRARY LOAD INFORMATION. 
* 
*         USES   FS - FS+4, T5 - T7.
* 
*         MACROS NFA, SETMS.
  
  
 LDU      SUBR               ENTRY/EXIT 
          LDD    MA          SET ENTRY POINT NAME 
          CWD    FS 
          CRM    CL,ON
          NFA    FA,R        RESTORE USER LIBRARY FST ENTRY 
          ADN    FSTL 
          CRD    FS 
          LDD    CW+1        SET EST ORDINAL
          STD    T5 
          LDD    CW+3        SET TRACK
          STD    T6 
          LDD    CW+4        SET SECTOR 
          STD    T7 
          STM    CL+5 
          SETMS  IO 
          LDM    LDUX,ON     LINK UP RETURN JUMP FROM *LCP* 
          STM    LCPX,ON
          LJM    LCP4        LOAD CENTRAL PROGRAM 
 CSA      SPACE  4,20 
**        CSA - CHECK FOR *SYSEDIT* ACTIVITY. 
*         INSURE *SYSEDIT* IS NOT ACTIVE BEFORE REQUESTING LOAD OF A
*         CM OR ALTERNATE DEVICE RESIDENT PROGRAM.  IF *SYSEDIT* IS 
*         ACTIVE,  FORCE LOAD FROM SYSTEM DEVICE. 
* 
*         ENTRY  (CW - CW+4) = LIBRARY CONTROL WORD.
*                (T5) = ALTERNATE DEVICE EST ORDINAL. 
* 
*         EXIT   IF *SYSEDIT* ACTIVE, 
*                (A) = 0. 
*                (CW+3 - CW+4) = TRACK/SECTOR OF PROGRAM ON SYSTEM
*                                DEVICE.
*                IF *SYSEDIT* NOT ACTIVE. 
*                (A) .NE. 0.
*                (CW - CW+4) = UNCHANGED. 
*                (CM - CM+4) = (RPLP).
* 
*         USES   CM - CM+4, CN - CN+4, CW+3 - CW+4. 
  
  
 CSA      SUBR               ENTRY/EXIT 
          LDK    RPLP        READ RPL POINTER 
          CRD    CM 
          LDD    CM          CHECK FOR SYSEDIT ACTIVE 
          ADD    CM+1 
          NJN    CSAX        IF SYSEDIT NOT ACTIVE
          LDM    CL+4        SET ADDRESS OF PROGRAM ON SYSTEM DEVICE
          STD    CW+3 
          LDM    CL+5 
          STD    CW+4 
          LDN    0
          UJN    CSAX        RETURN 
 CCM      SPACE  4,25 
**        CCM - LOAD CM/ALTERNATE DEVICE (ECS) RESIDENT PROGRAMS. 
* 
*         ENTRY  (CW+3 - CW+4)  RCL ADDRESSOF *OVL*/*ABS* HEADER. 
*                (T5) = ALTERNATE DEVICE EST ORDINAL, IF ANY. 
* 
*         EXIT   TO *CCMX* WITH (A) = ALTERNATE DEVICE EST ORDINAL
*                IF ALTERNATE DEVICE NOT EXTENDED MEMORY OR DDP.
*                TO *CCMX* WITH (A) = 0 IF FORCE LOAD 
*                FROM SYSTEM MS DEVICE. 
*                TO *LCPX* IF LOAD ERRORS.
*                TO *MSR* IF BUFFERED DISK ERROR. 
*                TO *MSR4* IF EXTENDED MEMORY ERROR.
*                TO *SLP* IF SUCCESSFUL LOAD. 
*                IF SUCCESSFUL LOAD,
*                (AB+3 - AB+4) = FWA OF LOAD. 
*                (CN+3 - CN+4) = LWA+1 OF LOAD. 
*                (CM - CM+4) = PROGRAM HEADER.
*                (PF) = PROGRAM FORMAT. 
* 
*         USES   T1, T2, AB+2 - AB+4, CM - CM+4, CN - CN+4. 
* 
*         CALLS  CDP, DDT, DFM, MSR, SPF. 
* 
*         MACROS ENDMS, MONITOR, SETMS. 
  
  
 CCM9     SETMS  STATUS 
          LDM    MSD
          SHN    21-6 
          PJN    CCM10       IF DEVICE IS ACCESSIBLE
          LDN    0           CLEAR ALTERNATE DEVICE EQUIPMENT 
          STD    T5 
          LDM    CL+4        SET ADDRESS OF PROGRAM ON SYSTEM DEVICE
          STD    CW+3 
          LDM    CL+5 
          STD    CW+4 
 CCM10    LDD    T5 
  
 CCM      SUBR               ENTRY/EXIT 
          LDD    T5 
          ZJN    CCM1        IF CM RESIDENT CODE
          RJM    CDP         CHECK DEVICE PARAMETERS
          MJN    CCM10       IF BUFFERED DISK 
          ZJN    CCM9        IF DIRECT TRANSFER NOT SUPPORTED 
          SETMS  IO 
          LDC    LDCI+RDDS   SET READ DIRECT SUBFUNCTION
          STM    CCMC 
          LDD    CW+4        SET SECTOR FOR EXTENDED MEMORY 
          STD    T7 
          LDD    CW+3        SET TRACK
          STD    T6 
          LDC    SCRB        GET LOAD ADDRESS 
          RJM    RDS
          MJP    MSR4        IF ERROR 
          ENDMS 
          LDD    MA          SET LOAD ADDRESS 
          CWM    SCRB+2,ON
          SBN    1
          UJN    CCM2        CONTINUE LOAD
  
 CCM1     LDD    CW+4 
          STD    T7 
          LDD    CW+3 
          STD    T6 
          SHN    14          GET LOAD ADDRESS 
          LMD    T7 
          ADN    1
 CCM2     CRD    AB 
          LDD    AB+3        SET LOAD ADDRESS FROM PROGRAM
          SCN    77 
          SHN    6
          LMD    AB+2 
          SHN    6
          STD    AB+4 
          SHN    -14
          STD    AB+3 
          LDC    0
 CCMA     EQU    *-2
          ZJN    CCM4        IF NO USER SPECIFIED LOAD ADDRESS
          SBN    2
          PJN    CCM3        IF LOAD ADDRESS .GE. 2 
          LDC    /ERR/EM20   * INCORRECT LOAD ADDRESS.* 
          LJM    LCPX        EXIT 
  
 CCM3     ADN    2
          STD    AB+4 
          SHN    -14
          STD    AB+3 
 CCM4     LDD    MA          COPY LOAD ADDRESS
          CWD    AB 
          CRD    CM 
 CCMB     LDN    0           CHECK FOR LWA SPECIFIED
          ZJN    CCM5        IF NOT SPECIFIED 
          LDM    /LDR/LDRB+3
          SHN    14 
          LMM    /LDR/LDRB+4
 CCM5     SHN    14 
          STD    CM+2 
          SHN    -6 
          SCN    77 
          RAD    CM+3 
 CCMC     LDC    LCRS*10000+7777  LOAD CM RESIDENT CODE 
*         LDC    RDDS*10000+7777  (EXTENDED MEMORY LOAD)
          RJM    DDT
          MJN    CCM7        IF ERROR 
          LDD    T5 
          ZJN    CCM6        IF CM LOAD 
          ENDMS 
 CCM6     LDN    7           SET WORD COUNT FOR PROGRAM HEADER READ 
          STD    T1 
          LDD    AB+3        READ PROGRAM HEADER
          SHN    6
          ADD    RA 
          SHN    6
          ADD    AB+4 
          CRM    SCRB,T1
          LDC    SCRB-2 
          STD    T3 
          RJM    SPF         SET PROGRAM FORMAT 
          LDD    OA          SET LWA OF LOAD
          CRD    CN 
          LDD    CN+3 
          LPN    77 
          STD    CN+3 
          LJM    SLP         SET LOAD PARAMETERS
  
 CCM7     SHN    21-10
          PJP    MSR2        IF MASS STORAGE ERROR
          LDD    T5 
          ZJN    CCM8        IF CM LOAD 
          ENDMS 
 CCM8     LDC    /ERR/EM02   * FL TOO SHORT FOR PROGRAM.* 
          LJM    LCPX        EXIT 
          TITLE  3AE - OVERLAID PRESET. 
 SCRB     EQU    *           SCRATCH BUFFER 
 SCRBL    EQU    SCRB+502    LWA+1 OF BUFFER
          ERRPL  SCRBL-7777+5*3  BUFFER OVERFLOW
 PRS      SPACE  4,10 
**        PRS - PRESET *3AE* LOAD SUBROUTINES.
* 
*         EXIT   (LDOT) = *LDN* INSTRUCTION + ORIGIN TYPE.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  IFP. 
* 
*         MACROS SFA. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    IFP         INITIALIZE *COMPGFP* 
          LDD    CP          READ EJT ORDINAL WORD
          ADK    TFSW 
          CRD    CM 
          SFA    EJT,CM      SET EJT ADDRESS
          ADK    //SCLE      READ JOB ORIGIN TYPE WORD
          CRD    CM 
          LDD    CM          SET JOB ORIGIN TYPE
          LPN    17 
          ADC    LDNI        FORMAT INSTRUCTION 
          STM    LDOT        STORE INSTRUCTION
          UJN    PRSX        RETURN 
          SPACE  4,10 
**        ASSEMBLY CONSTANTS FOR COMMON DECKS.
  
  
 EJT$     EQU    1           ASSEMBLE EJT ADDRESSING (COMPGFP)
          SPACE  4,10 
**        OVERLAID PRESET COMMON DECKS. 
  
  
*CALL     COMPGFP 
          SPACE  4,10 
**        ASSEMBLE *COMPGFP* INITIALIZATION CODE. 
  
  
 IFP      HERE
          SPACE  4,10 
  
  
          OVERFLOW  OVL,7777
          TTL    1AJ/3AF - SPECIAL ENTRY POINT PROCESSING.
          TITLE 
          QUAL   3AF
          IDENT  3AF,SEPX    SPECIAL ENTRY POINT PROCESSING.
*COMMENT  1AJ - SPECIAL ENTRY POINT PROCESSING. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
 FN       EQU    AB 
          SPACE  4,10 
***       3AF - SPECIAL ENTRY POINT PROCESSING. 
* 
*         *3AF* CONTAINS SUBROUTINES FOR PROCESSING *DMP=* AND *SSJ=* 
*         ENTRY POINTS. 
          SPACE  4,10 
          ORG    /TCS/O3AF+5
 SEP      SUBR               ENTRY/EXIT 
          RJM    IFP         INITIALIZE *COMPGFP* 
          UJN    SEPX        RETURN 
 RCF      SPACE  4,15 
**        RCF - RESTORE CONTROL POINT AREA FIELDS.
* 
*         ENTRY  (A) .NE. 0, IF JOB IS BOTH *SSJ=* AND *DMP=*.
*                NO JOB ACTIVITY. 
* 
*         EXIT   CONTROL POINT AREA FIELDS RESTORED.
*                FILES WITH *SSST* STATUS ARE DROPPED.
*                ABORTED (NO WRITE LOCKOUT) DM* FILE DROPPED. 
* 
*         CALLS  SPR, *0DF*.
* 
*         USES   T1, FA, CM - CM+4, CN - CN+4, CW - CW+4, FS - FS+4.
* 
*         MACROS EXECUTE, LDA, MONITOR, NFA.
  
  
 RCF9     LDD    CP          CLEAR SPECIAL ENTRY POINTS 
          ADC    SEPW 
          CWD    FS 
          ADN    SPCW-SEPW
          CRD    FS 
          LDD    FS+1 
          SHN    21-0 
          MJN    RCF10       IF *DMP=*, *SSJ=* JOB CALLED BY *SSJ=* JOB 
          LDD    CM+3+SSJD*  CHECK *SSJ=* DROP FILES OPTION 
          SHN    21-5 
          MJN    RCF11       IF DROP FILES OPTION 
 RCF10    LJM    RCFX        RETURN 
  
 RCF11    AOM    RCFA        FLAG DROP FILES OPTION 
  
*         DROP FILES WITH *SSST* STATUS AND ABORTED DM* FILE. 
  
 RCF12    LDD    CP          READ FL STATUS WORD
          ADN    FLSW 
          CRD    CW 
          LDD    CW 
          SHN    6
          ADN    1
          STD    CW          LWA+1 OF FNT ENTRIES 
          LDC    FNTN        SET FIRST ENTRY
          STD    CN 
          LDN    3           SET *UNLOAD* AND *ROFT* OPTIONS FOR *0DF*
          STM    ODFL-1 
 RCF13    NFA    CN,R        READ FNT ENTRY 
          CRD    FS 
          LDD    FS+4 
          SHN    -6 
          LMN    ROFT 
          NJN    RCF13.1     IF NOT ROLLOUT FILE
          LDD    FS+3        CHECK WRITE LOCKOUT
          LPN    1
          UJN    RCF13.2     DROP FILE IF NOT WRITE LOCKOUT 
  
 RCF13.1  LDD    FS+4        CHECK FILE STATUS
          LPN    77 
          LMN    SSST 
 RCF13.2  NJN    RCF14       IF NOT TO DROP FILE
          LDD    CN 
          STD    FA          SET RELATIVE FNT ADDRESS IN NFL
          EXECUTE  0DF,ODFL 
 RCF14    LDN    LENF        INCREMENT TO NEXT ENTRY
          RAD    CN 
          SBD    CW 
          MJN    RCF13       IF NOT END OF LOCAL FILES
 RCFA     LDN    0
*         LDN    1           (NOT *SSJ=* SPECIAL FILES OPTION)
          NJN    RCF15       IF NOT *SSJ=* SPECIAL FILES OPTION 
          LDD    CP          RESTORE VALIDATION PARAMETERS
          ADN    ALMW 
          CWM    RCFB+ALMS*5,TR 
 RCF15    UJN    RCFX        RETURN 
  
 RCFB     BSS    SSJL*5+1*5  CONTROL POINT AREA BUFFER
  
 RCF      SUBR               ENTRY/EXIT 
          STD    T1          JOB IS BOTH *SSJ=* AND *DMP=* FLAG 
          LDD    CP 
          ADK    SRUW        CLEAR IGNORE LIMITS FLAG 
          CRD    CW 
          ADK    SEPW-SRUW
          CRD    CM 
          CRD    FS 
          LDD    CW 
          SCN    40 
          STD    CW 
          LDD    CP 
          ADK    SRUW 
          CWD    CW 
          LDD    FS          CLEAR *SSJ=* FLAG
          SCN    4
          STD    FS 
          LDD    T1 
          NJN    RCF1        IF JOB IS BOTH *SSJ=* AND *DMP=* 
          LDN    ZERL        JOB IS ONLY *SSJ=*, CLEAR *SEPW* 
          CRD    FS 
 RCF1     LDN    SSJL 
          STD    T1 
          LDD    CM+3+SSJP*  CHECK IF *SSJ=* BLOCK PRESENT
          LPN    37 
          ADD    CM+4 
          NJN    RCF2        IF *SSJ=* BLOCK PRESENT
          LJM    RCF9        NO *SSJ=* BLOCK PRESENT
  
 RCF2     LDD    CP 
          ADC    SPCW 
          CRD    CN 
          LDD    CN+1 
          SHN    21-0 
          PJN    RCF3        IF NOT DMP=/SSJ= JOB CALLED BY SSJ= JOB
          NFA    SSDN        RESTORE *DMP=* PARAMETERS
          UJN    RCF4        RESTORE PARAMETERS 
  
 RCF3     NFA    SSJN 
 RCF4     CRM    RCFB,T1
          LDD    CP          READ USER IDENTIFICATION 
          ADN    UIDW        USER IDENTIFICATION
          CWM    RCFB+UIDS*5,ON 
          ADN    SEPW-UIDW-1 CLEAR SPECIAL ENTRY POINTS 
          CWD    FS 
          LDM    RCFB+4      CHECK SUBSYSTEM IDENTIFICATION 
          SBK    LSSI+1 
          PJN    RCF7        IF SUBSYSTEM 
          LDN    0           SET END OF JOB STEP
          RJM    SPR         SET PRIORITIES 
 RCF7     LDD    CP          READ SPECIAL CALL WORD 
          ADC    SPCW 
          CRD    CM 
          LDD    CM+1 
          SHN    21-0 
          MJN    RCF8        IF *DMP=*, *SSJ=* JOB CALLED BY *SSJ=* JOB 
          LJM    RCF12       DROP ALL FILES WITH SPECIAL FILE STATUS
  
 RCF8     LJM    RCFX        RETURN 
          SPACE  4,10 
 ODFL     EQU    RCF+2       *0DF* LOAD ADDRESS 
          ERRNG  BFMS-ODFL-ZDFL 
 PSR      SPACE  4,15 
**        PSR - PROCESS SPECIAL PROCESSOR REQUEST.
* 
*         PROCESSES *DMP=* REQUEST. 
* 
*         ENTRY  (AB - AB+1) = PST ADDRESS. 
* 
*         EXIT   TO *CSR10* IF *SPCW* CALL ERROR. 
*                TO *DPP* IF ERROR FLAG SET.
*                TO *CPP* TO ROLLOUT JOB. 
* 
*         USES   AB - AB+4, CM - CM+4, CN - CN+4, FS - FS+4,
*                SP - SP+4, T1 - T6.
* 
*         CALLS  *1RO*. 
* 
*         MACROS DELAY, EXECUTE, MONITOR, PAUSE.
  
  
 PSR      BSS    0           ENTRY
          LDD    AB+1        SET PST ADDRESS
          SHN    14 
          LMD    AB+2 
          CRD    CM          READ LIBRARY CONTROL WORD
          ADN    1           READ SPECIAL ENTRY POINT WORD
          CRD    CN 
          LDD    CM+1        CHECK CONTROL WORD FLAGS 
          SHN    21-10
          PJN    PSR1        IF NO SPECIAL ENTRY POINTS 
          LDD    CN          CHECK FOR *DMP=* ENTRY POINT 
          SHN    21-4 
          MJN    PSR3        IF *DMP=* PRESENT
 PSR1     LJM    CSR10       ISSUE SPCW CALL ERROR
  
 PSR2     LDD    CP 
          ADN    TERW 
          CRD    CN 
          CRD    AB 
          LDN    0
          STD    AB+3 
          STD    AB+4 
          LDD    AB+2 
          SCN    77 
          STD    AB+2 
          LDD    CP 
          ADN    TERW 
          CWD    AB 
          LDD    CN+3        POSITION *DMP=* PARAMETER
          STD    CN+2 
          LDD    CN+4 
          STD    CN+3 
 PSR3     LDD    CP          READ FIELD LENGTH STATUS WORDS 
          ADN    FLSW 
          CRD    FS 
          ADN    ECSW-FLSW
          CRD    T2 
          ADN    JCIW-ECSW   READ JOB CONTROL WORD
          CRD    SP 
          ADN    SEPW-JCIW   READ SPECIAL ENTRY POINT WORDS 
          CRD    T1 
          ADN    PPDW-SEPW   READ PP DUMP WORD
          CRD    AB 
          LDD    T2+4 
          STD    AB+1 
  
*         CHECK FOR SPECIAL CASE WHEN SUBSYSTEM REDUCES ITS FL BELOW
*         *MCMX* AND EXTENDED MEMORY IS ASSIGNED. 
  
          LDC    MCMX/100 
          STD    T7 
          LDD    SP+2        CHECK SSID 
          SBK    LSSI+1 
          MJN    PSR6        IF NOT SUBSYSTEM 
          LDD    T2+4 
          ZJN    PSR6        IF NO EXTENDED MEMORY ASSIGNED 
          LDD    FS+4 
          SBD    T7 
          PJN    PSR6        IF ENOUGH FL 
 PSR4     DELAY 
          PAUSE 
          LDD    CM+1 
          ZJN    PSR5        IF NO ERROR FLAG 
          LJM    DPP         DROP PP
  
 PSR5     STD    CM+2        REQUEST FL 
          LDD    T7 
          STD    CM+1 
          STD    FS+4 
          MONITOR  RSTM 
          LDD    CM+1 
          NJN    PSR4        IF FL NOT AVAILABLE
 PSR6     LDD    CP 
          ADK    SPCW 
          CRD    CM 
          LDD    FS+4 
          STD    AB+2 
          LDD    CM+1        SET *DMP=* ACTIVE AND *1RO* CALLED 
          SCN    43 
          LMN    42 
          STD    CM+1 
          LDD    CM 
          LMN    77 
          ZJN    PSR7        IF COMMAND *DMP=* CALL 
          LDD    T1 
          SHN    21-2 
          PJN    PSR7        IF NOT CALLED BY *SSJ=* JOB
          AOD    CM+1        SET CALLED BY *SSJ=* JOB FLAG
 PSR7     LDD    CP          WRITE SPECIAL CALL WORD
          ADC    SPCW 
          CWD    CM 
          ADN    PPDW-SPCW   WRITE PPU DUMP WORD
          CWD    AB 
          LDN    1           *DMP=* FUNCTION
          STD    IR+2 
          LDD    CN+3        SET *DMP=* PARAMETER 
          SCN    77 
          SHN    6
          LMD    CN+2 
          SHN    6
          STD    IR+4 
          SHN    -14
          STD    IR+3 
          MONITOR  DCPM 
          LDD    CM+1 
          ZJN    PSR8        IF NO CPU ACTIVITY 
  
*         THE FOLLOWING CODE IS NEEDED ONLY FOR CALLS FROM *DIS*
*         LIKE PROCESSORS.
  
          LDN    1           SET CPU ACTIVITY 
          STD    CM+1 
          LDN    0
          STD    CM+2 
          LDD    MA 
          CWM    PSRA,ON
          MONITOR  UADM      UPDATE CONTROL POINT AREA WORD 
 PSR8     EXECUTE  1RO,*
          LJM    CPP         CALL *1RO* 
  
  
*         *UADM* PARAMETERS.
  
 PSRA     CON    CSFS        SET CONTROL POINT AREA FIELD 
          CON    STSW        WORD CONTAINING FIELD
          CON    25D*100+1   POSITION AND WIDTH OF FIELD
          CON    0
          CON    1           SET FIELD TO 1 
 RFJ      SPACE  4,12 
**        RFJ - RESET FORMER JOB. 
* 
*         ENTRY  IF *DMP=* JOB TO BE RESTARTED. 
* 
*         EXIT   TO */TCS/CPP* TO CALL *1RI* FOR *DMP=* ROLLIN. 
*                TO */TCS/DPP* TO DROP PP.
* 
*         USES   T1, CM - CM+4, CN - CN+4, FN - FN+4, FS - FS+4.
* 
*         CALLS  /TCS/RQS, SAF, *1RI*.
* 
*         MACROS EXECUTE, NFA, SFA. 
  
  
 RFJ      BSS    0           ENTRY
          LDD    CP 
          ADC    SPCW 
          CRD    CN 
          SBN    SPCW-SEPW
          CRD    CM 
          LDD    CM+2        CHECK FOR RESTART
          SHN    21-13
          MJN    RFJ3        IF RESTART 
          LDD    IR+3        CHECK PARAMETER BLOCK MOVED
          LMN    1
          ZJN    RFJ2        IF PARAMETER BLOCK MOVED 
          LDD    FL 
          ZJN    RFJ2        IF NO FL 
          LDN    1
          STD    T1 
          LDD    CN+1 
          SHN    21-3 
          MJN    RFJ1        IF NO PARAMETER BLOCK
          LDD    CN+3 
          LPN    37 
          ADD    CN+4 
          ZJN    RFJ1        IF NO PARAMETER BLOCK ADDRESS
          LDN    DMPL        PROCESS *DMP=* COMPLETION
          STD    T1 
 RFJ1     BSS    0
          LDD    RA          MOVE PARAMETER BLOCK 
          SHN    6
          ADN    SPPR 
          CRM    BUF,T1 
          NFA    DMPN        STORE PARAMETER BLOCK
          CWM    BUF,T1 
 RFJ2     LDD    CM+2 
          SHN    21-13
 RFJ3     MJN    RFJ4        IF RESTART 
          LDD    CP 
          ADC    PPDW        PPU DUMP WORD
          CRD    FN 
          LDD    FN+2        SET FL 
          STM    /TCS/RQSD
          LDD    FN+1        SET FLE
          STM    /TCS/RQSE
          AOM    /TCS/RQSA   FLAG *DMP=* PROCESSING 
          LDN    1           FLAG PARAMETER BLOCK MOVED 
          STD    IR+3 
          RJM    /TCS/RQS    REQUEST STORAGE
 RFJ4     LDN    ZERL 
          CRD    FN 
          LDC    3R*DM       FIND *DMP=* FILE 
          STD    FN 
          SHN    -6 
          SCN    77 
          STD    FN+1 
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          LDD    FA 
          NJN    RFJ6        IF FILE FOUND
 RFJ5     LDN    ZERL 
          CRD    FS 
          LDD    CP 
          ADC    SEPW        CLEAR ENTRY POINTS 
          CWD    FS 
          ADN    SPCW-SEPW   CLEAR SPECIAL CALL 
          CWD    FS 
          SFA    EJT,JO 
          ADK    SCHE 
          CRD    CM 
          LDD    CM+2 
          LPC    7377        CLEAR *DMP=* ROLLOUT COMPLETE
          STD    CM+2 
          SFA    EJT,JO 
          ADK    SCHE 
          CWD    CM 
          LJM    /TCS/DPP    DROP PPU 
  
 RFJ6     STD    IR+4 
          NFA    FA,R 
          ADN    FSTL 
          CRD    FN          CHECK FST ENTRY
          LDD    FN+2 
          ZJN    RFJ5        IF FILE NOT USED 
          LDN    1
          STD    IR+2 
          EXECUTE  1RI,*
          LJM    /TCS/CPP    CALL *1RI* 
 SDP      SPACE  4,10 
**        SDP - START-UP *DMP=* JOB.
* 
*         ENTRY  UPON RETURN FROM *1RO* AT *DMP=* ROLLOUT COMPLETION. 
* 
*         USES   T1, T2, CN - CN+4. 
* 
*         CALLS  TCA. 
* 
*         MACROS MONITOR, NFA.
  
  
 SDP      LDM    /TCS/CSEB
          SHN    21-2 
          PJN    SDP1        IF NO *SSJ=* 
          RJM    TCA         TRANSFER CONTROL POINT AREAS 
 SDP1     LDN    DMPL-1 
          STD    T1 
          LDD    CP 
          ADC    SEPW        SET ENTRY POINTS 
          CRD    CM          GET PREVIOUS PROGRAM SPECIAL ENTRY POINTS
          CWM    /TCS/CSEB,ON 
          ADN    SPCW-SEPW-1 STORE CALL WORD
          STD    T2 
          CRD    CN 
          CRM    BUF,ON 
          NFA    DMPN 
          CRM    BUF+5,T1 
          LDD    CN+1        CLEAR *1RO* CALLED 
          SCN    2
          STD    CN+1 
          LDN    0           CLEAR FIRST PARAMETER
          STD    CN+2 
          LDD    CN+3 
          LPN    77 
          STD    CN+3 
          LDD    T2 
          CWD    CN 
          LDN    ZERL 
          CRD    CN 
          LDM    BUF+1       CLEAR *SSJ=* PARAMETER BLOCK FLAG
          SCN    2
          STM    BUF+1
          LDD    CM+3        CHECK IF *SSJ=* BLOCK DEFINED
          LPN    37 
          ADD    CM+4 
          ZJN    SDP2        IF NO *SSJ=* PARAMETER BLOCK 
          LDN    2           SET *SSJ=* PARAMETER BLOCK FLAG
          RAM    BUF+1
 SDP2     LDM    /TCS/CSEB+2 CHECK IF *OVERRIDE REQUIRED* BIT NEEDED
          SHN    21-12
          PJN    SDP3        IF *OVERRIDE REQUIRED* BIT NOT TO BE SET 
          LDD    CP          SET *OVERRIDE REQUIRED* BIT
          ADN    SNSW 
          CRD    CM 
          LDD    CM 
          LPC    6777 
          LMD    TH 
          STD    CM 
          LDD    CP 
          ADN    SNSW 
          CWD    CM 
 SDP3     LDM    /TCS/CSEB+2 CHECK FOR IGNORE RESOURCE LIMIT LOAD 
          SHN    21-7 
          PJN    SDP4        IF RESOURCE LIMITS NOT TO BE IGNORED 
          LDD    CP          SET IGNORE RESOURCE LIMITS FLAG
          ADK    SRUW 
          CRD    CM 
          LDD    CM 
          SCN    40 
          LMN    40 
          STD    CM 
          LDD    CP 
          ADK    SRUW 
          CWD    CM 
 SDP4     AOD    T1 
          LDD    RA 
          SHN    6
          ADN    1           CLEAR SYSTEM REQUEST 
          CWD    CN 
          ADN    SPPR-1      SET PARAMETER BLOCK
          CWM    BUF,T1 
          MONITOR  RCPM      REQUEST CPU
          LJM    /TCS/DPP    DROP PP
 SPR      SPACE  4,15 
**        SPR - SET PRIORITIES. 
* 
*         ENTRY  (RCFB - RCFB+4) *SSJ=* PRIORITY VALUES.
*                (A) = 1, IF BEGINNING OF JOB STEP. 
*                (A) = 0, IF END OF JOB STEP. 
* 
*         EXIT   PRIORITIES SET ACCORDING TO VALUES.
* 
*         USES   T1, CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 SPR      SUBR               ENTRY/EXIT 
          STD    T1          SAVE BEGIN/END JOB STEP STATUS 
  
*         PROCESS SUBSYSTEM ID. 
  
          NJN    SPR1        IF AT BEGINNING OF JOB STEP
          LDM    RCFB+4      GET *SSID* FROM *SSJ=* BLOCK 
          STD    CM+4 
          SBN    IRSI+1 
          MJN    SPR2        IF NOT *IRSI* OR *UJSI*
          LDN    IRSI        INHIBIT ROLLOUT
          STD    CM+4 
          UJN    SPR2        CHANGE SUBSYSTEM ID
  
 SPR1     LDM    RCFB+4      GET *SSID* FROM *SSJ=* BLOCK 
          ZJN    SPR3        IF NO *SSID* SPECIFIED 
          STD    CM+4 
 SPR2     LDN    SSIS        FORM *SET SSID* REQUEST
          STD    CM+1 
          MONITOR  SJCM      SET JOB CONTROL
  
*         PROCESS CPU PRIORITY. 
  
 SPR3     LDM    RCFB+3 
          NJN    SPR3.1      IF TO SET FIXED CPU PRIORITY 
          LDD    T1 
          NJN    SPR4        IF BEGINNING OF JOB STEP 
*         LDN    0           RESTORE SERVICE CLASS CPU PRIORITY 
 SPR3.1   STD    CM+4        SET NEW CPU PRIORITY 
          LDN    CPRS        CHANGE CPU PRIORITY
          STD    CM+1 
          MONITOR  SJCM 
  
*         PROCESS TIME LIMIT. 
  
 SPR4     LDM    RCFB+2      CHECKING TIME LIMIT = INFINITE 
          STD    CM+4 
          ADM    RCFB+1 
          ZJN    SPR7        IF NO CHANGE IN TIME LIMIT 
          LDM    RCFB+1 
          STD    CM+3 
          SBN    7           CHECK TIME LIMIT .GE. 70000B 
          MJN    SPR6        IF TIME LIMIT .LT. 70000B
          NJN    SPR5        IF TIME LIMIT .GT. 77777B
          LDD    CM+4 
          ADC    -7770
          MJN    SPR6        IF TIME LIMIT .LT. 77770B
 SPR5     LCN    0           SET INFINITE TIME LIMIT
          STD    CM+3 
          STD    CM+4 
 SPR6     LDN    RLTL        SET TIME LIMIT SUBFUNCTION 
          STD    CM+1 
          MONITOR  RLMM 
 SPR7     LJM    SPRX        RETURN 
 TCA      SPACE  4,10 
**        TCA - TRANSFER CONTROL POINT AREA FIELDS (*SSJ=*).
* 
*         ENTRY  (CSEB - CSEB+4)  SPECIAL ENTRY POINT WORD. 
* 
*         USES   T1, CM - CM+4, CN - CN+4.
* 
*         CALLS  SPR. 
* 
*         MACROS NFA. 
  
  
 TCA      SUBR               ENTRY/EXIT 
          LDM    /TCS/CSEB+3
          LPN    37 
          ADM    /TCS/CSEB+4
          ZJN    TCAX        IF NO PARAMETER BLOCK
          LDN    SSJL 
          STD    T1 
          LDD    CP 
          ADN    CWQW 
          CRD    CN 
          ADN    JCIW-CWQW
          CRM    RCFB+SPPS*5+1*5+2,ON 
          ADN    CPJW-JCIW-1
          CRD    CM 
          LDD    CN+1 
          SHN    -11
          LPN    1
          ZJN    TCA0.1      IF CPU PRIORITY SET FROM SERVICE CLASS 
          LDD    CN          SET CPU PRIORITY 
          SHN    -3 
          LPC    177
 TCA0.1   STM    RCFB+SPPS*5+1*5+3
          LDD    CM+2        MOVE JOB STEP TIME LIMIT 
          SCN    77 
          SHN    6
          LMD    CM+1 
          SHN    6
          STM    RCFB+SPPS*5+1*5+2
          SHN    -14
          STM    RCFB+SPPS*5+1*5+1
          LDD    CP          READ USER IDENTIFICATION 
          ADN    UIDW 
          CRM    RCFB+UIDS*5+1*5,ON 
          ADN    ALMW-UIDW-1
          CRM    RCFB+ALMS*5+5,TR VALIDATION PARAMETERS 
          ADN    SPCW-ALMW-3
          CRD    CN 
 TCA1     LDM    /TCS/CSEB+3
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADM    /TCS/CSEB+4
          CRM    RCFB,ON     RETRIEVE PRIORITY PARAMETERS 
          SBN    1
          CWM    RCFB+1*5,T1 STORE ACCOUNT PARAMETERS 
          LDD    CN+1 
          SHN    21-0 
          MJN    TCA1.5      IF DMP=/SSJ= JOB CALLED BY SSJ= JOB
          NFA    SSJN 
          UJN    TCA1.8      STORE PARAMETERS 
  
 TCA1.5   NFA    SSDN 
 TCA1.8   CWM    RCFB+1*5,T1 STORE ACCOUNT PARAMETERS 
          LDM    RCFB+ALMS*5+1*5+1
          LPN    7           RETAIN ORIGINAL INDEX VALUE
          RAM    TCAC+1 
          LDM    RCFB+ACLS*5+1*5+3  SAVE USER DETACH LIMIT
          SCN    77 
          RAM    TCAD+3 
          LDD    CP 
          ADN    JCIW        GET SSID 
          CRD    CN 
          ADN    UIDW-JCIW
          CWM    TCAB,ON     SET USER INDEX TO 377777 (SYUI)
          ADN    ALMW-UIDW-1
          CWM    TCAC,ON     -0 TO ALL LIMITS EXCEPT LOCAL FILE LIMIT 
          CWM    TCAD,ON     -0 TO ALL LIMITS EXCEPT USER DETACH LIMIT
          CWM    TCAA,ON
          LDD    CN+2 
          SBK    LSSI+1 
          PJN    TCA2        IF SUBSYSTEM 
          LDN    1           SET BEGINNING OF JOB STEP
          RJM    SPR         SET PRIORITIES 
 TCA2     LJM    TCAX        RETURN 
  
  
 TCAA     VFD    60/-0
 TCAB     VFD    42/0LSYSTEMX,18//PFM/SYUI
 TCAC     VFD    21/-0,3/0,36/-0
 TCAD     VFD    36/-0,6/0,18/-0  *ACLW*
 IDP      SPACE  4,10 
**        IDP - INITIALIZE *DMP=* PROGRAM LOAD ON SYSTEM REQUEST CALL.
* 
*         ENTRY  IF *DMP=* CP PROGRAM TO BE LOADED. 
* 
*         EXIT   TO */TCS/TCS2* TO LOAD PROGRAM.
* 
*         CALL   /TCS/IPL.
  
  
 IDP      LDC    ZJNI+77+/TCS/SCL15-/TCS/SCLB 
          STM    /TCS/SCLB
          LDC    LJMI 
          STM    /TCS/BCPD
          LDC    /TCS/BCP22 
          STM    /TCS/BCPD+1
          LDD    AB+1        SET PROGRAM NAME 
          SCN    77 
          STD    AB+1 
          LDN    0
          STD    AB+2 
          STD    AB+3 
          STM    /TCS/TCSA   ALLOW DMP= EVEN IF CHARGE REQUIRED 
          LCN    0           PRESERVE OVERRIDE-REQUIRED FLAG
          STM    /TCS/IPLC
          RJM    /TCS/IPL    INITIALIZE PROGRAM LOAD
          LJM    /TCS/TCS2   LOAD PROGRAM 
  
  
*         COMMON DECKS. 
  
  
 EJT$     EQU    1           ASSEMBLE EJT ADDRESSING
*CALL     COMPGFP 
*CALL     COMPSAF 
  
  
 BUF      BSS    0           PARAMETER BLOCK BUFFER 
  
 IFP      HERE               ASSEMBLE *COMPGFP* INITIALIZATION CODE 
  
          IFLT   *,BUF+DMPL*5,1 
          ORG    BUF+DMPL*5  LWA OF OVERLAY 
  
  
          OVERFLOW  /TCS/O3AF 
          TTL    1AJ/3AG - RETURN JOB STEP FILES. 
          TITLE 
          QUAL   3AG
          IDENT  3AG,RJFX    RETURN JOB STEP FILES. 
*COMMENT 1AJ - RETURN JOB STEP FILES. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AG - RETURN JOB STEP FILES.
* 
*         *3AG* RETURNS ALL FILES WITH USER PRIVACY STATUS AND FILES
*         WHICH HAVE BEEN PARTIALLY RETURNED BY *1AJ* OR ANOTHER PP.
*         PARTIALLY RETURNED FILES ARE MASS STORAGE OR TAPE FILES FOR 
*         WHICH THE MASS STORAGE OR TAPE RESOURCE HAS BEEN RETURNED BUT 
*         FURTHER PROCESSING SUCH AS UPDATING THE RESOURCE DEMAND FILE
*         COULD NOT BE COMPLETED BECAUSE OF A RECOVERABLE MASS STORAGE
*         ERROR.  IF A DEVICE INACCESSIBLE ERROR IS RETURNED BY *0DF*,
*         *1AJ* WILL GO INTO RECALL AND ADVANCEMENT TO THE NEXT JOB 
*         STEP WILL BE INHIBITED UNTIL ALL USER PRIVACY AND PARTIALLY 
*         RETURNED FILES HAVE BEEN RETURNED.
          SPACE  4,15 
**        RJF - RETURN JOB STEP FILES.
* 
*         EXIT   TO CALLER IF NO REMAINING USER PRIVACY FILES OR
*                  INCOMPLETELY RETURNED FILES REMAINING. 
*                TO *1RJ* TO RECALL *1AJ* IF INACCESSIBLE DEVICE ERROR
*                  RETURNED BY *0DF*. 
* 
*         USES   FA, IR+4, CM - CM+4, CW - CW+4, FS - FS+4. 
* 
*         CALLS  CFS, *0DF*.
* 
*         MACROS EXECUTE, MONITOR, NFA. 
  
  
          ORG    E1AJ 
  
 RJF      SUBR               ENTRY/EXIT 
          LDD    CP          READ FIELD LENGTH STATUS WORD
          ADN    FLSW 
          CRD    CW 
          LDD    CW 
          SHN    6
          ADN    1
          STD    CW          LAST WORD + 1 FOR FNT-S
          LDC    FNTN        START OF FNT-S 
          STD    CW+1 
          LDN    0           INITIALIZE INACCESSIBLE DEVICE FLAG
          STD    CW+2 
          LDN    1           SET *UNLOAD* OPTION FOR *0DF*
          STM    ODFL-1 
 RJF2     LDN    LENF        ADVANCE RELATIVE ADDRESS 
          RAD    CW+1 
          SBD    CW 
          PJN    RJF3        IF END OF LOCAL FILE FNT 
          NFA    CW+1,R 
          ADK    FNTL        READ FILE NAME 
          CRD    CM 
          ADK    FSTL-FNTL   READ FILE STATUS 
          CRD    FS 
          LDD    CM 
          ZJN    RJF2        IF EMPTY ENTRY 
          RJM    CFS         CHECK FILE STATUS
          NJN    RJF2        IF NOT FILE TO BE RETURNED 
          LDD    CW+1 
          STD    FA          SET RELATIVE FNT ADDRESS IN NFL
          EXECUTE  0DF,ODFL 
          ZJN    RJF2        IF FILE RETURNED 
          LDD    T5          SET INACCESSIBLE DEVICE EST ORDINAL
          STD    CW+2 
          UJN    RJF2        CHECK NEXT FILE
  
*         CLEAR JOB STEP FILE CONTROL FLAGS IF ALL FILES RETURNED.
  
 RJF3     LDD    CW+2 
          NJN    RJF4        IF INACCESSIBLE DEVICE ERROR 
          LDN    SPMS+RPMS   SET JOB STEP PRIVATE FILES FLAGS 
          STD    CM+4 
          LDN    CCTS        SET TO CLEAR CONTROL FLAGS 
          STD    CM+1 
          MONITOR  SJCM      CLEAR CONTROL FLAGS
          LJM    RJFX        RETURN 
  
*         RECALL *1AJ* ON INACCESSIBLE DEVICE ERROR.
  
 RJF4     STD    IR+4        SET EST ORDINAL OF INACCESSIBLE DEVICE 
          LDN    0           CLEAR JOB ADVANCE
          STD    CM+1 
          MONITOR  JACM 
          EXECUTE  1RJ       RECALL *1AJ* 
 CFS      SPACE  4,10 
**        CFS - CHECK FILE STATUS.
* 
*         ENTRY  (CM - CM+4) = LOCAL FNT ENTRY *FNTL* WORD. 
*                (FS - FS+4) = LOCAL FNT ENTRY *FSTL* WORD. 
* 
*         EXIT   (A) = 0 IF FILE TO BE RETURNED.
* 
*         USES   T3 - T3+4. 
  
  
 CFS3     LDD    FS+1 
          ZJN    CFS1        IF NULL TRACK FIELD
          SHN    0-13 
  
 CFS      SUBR               ENTRY/EXIT 
          LDD    CM+4 
          LPN    77          ISOLATE STATUS FIELD 
          LMN    UPST 
          ZJN    CFSX        IF USER PRIVACY STATUS 
          SFA    EST,FS      READ EST ENTRY 
          ADK    EQDE 
          CRD    T3 
          LDD    T3          CHECK DEVICE TYPE
          SHN    21-13
          MJN    CFS3        IF MASS STORAGE
          LDD    T3+3 
          LMC    2RNT 
          ZJN    CFS2        IF *NT* (9 TRACK TAPE) 
          LMC    2RMT&2RNT
          ZJN    CFS2        IF *MT* (7 TRACK TAPE) 
          LMC    2RCT&2RMT
          ZJN    CFS2        IF *CT* (CARTRIDGE TAPE) 
          LMC    2RAT&2RCT
          ZJN    CFS2        IF *AT* (ACS CARTRIDGE TAPE) 
 CFS1     LMC    2RTE&2RAT
          NJN    CFSX        IF NOT *TE* (TAPE PSEUDO EQUIPMENT)
 CFS2     LDD    FS+4 
          LPN    4           EXTRACT DEMAND FILE ERROR FLAG 
          LMN    4
          UJP    CFSX        RETURN 
          SPACE  4,10 
 ODFL     EQU    *+1         *0DF* LOAD ADDRESS 
          ERRNG  BFMS-ODFL-ZDFL  CHECK LENGTH OF *0DF*
          TTL    1AJ/3AH - *CLB=* SPECIAL ENTRY POINT PROCESSING. 
          TITLE 
          QUAL   3AH
          IDENT  3AH,PCLX    *CLB=* ENTRY POINT PROCESSING. 
*COMMENT  1AJ - *CLB=* ENTRY POINT PROCESSING.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AH - PROCESS *CLB=* ENTRY POINT. 
          SPACE  4,10 
          ORG    /TCS/O3AF+5
 PCL      SPACE  4,15 
**        PCL - PROCESS COMMAND LINE. 
* 
*         ENTRY  (*TINW*, BITS 35-18) = RELATIVE ADDRESS OF *CLB=* FET. 
*                (FL-100B) = WORD COUNT FOLLOWED BY 
*                            COMMAND LINE TEXT. 
* 
*         EXIT   (TINW, BITS 35-18) = ZERO. 
*                COMMAND LINE TEXT IN INPUT BUFFER. 
* 
*         USES   T1, T2, T3, T4, CM-CM+4, CN-CN+4.
* 
*         MACROS MONTIOR. 
  
  
 PCL      SUBR               ENTRY/EXIT 
          LDD    CP          GET ADDRESS OF FET 
          ADN    TINW 
          CRD    CN 
          LDD    CN+2        SAVE FET ADDRESS 
          SHN    14 
          STD    T1 
          STD    CM+3 
          LMD    CN+3 
          SHN    -6 
          STD    T2 
          STD    CM+4 
          LDN    3           SET VALIDATION OPTION
          STD    CM+1 
          LDN    0           CLEAR BITS 30-18 IN TINW 
          STD    CN+2 
          LDD    CN+3 
          LPN    77 
          STD    CN+3 
          LDD    CP 
          ADN    TINW 
          CWD    CN 
          MONITOR  VFPM 
          LDD    CM+1 
          ZJN    PCL1        IF NO ERROR
          LDC    /ERR/EM13   * IEDIT BUFFER ERROR.* 
          LJM    /TCS/ERR1   PROCESS ERROR
  
 PCL1     LDD    RA          GET WORD COUNT 
          ADD    FL 
          SBN    1
          SHN    6
          CRD    CM 
          LDD    CM+4 
          NJN    PCL3        IF WORDS TO TRANSFER 
 PCL2     LJM    PCLX        RETURN 
  
 PCL3     STD    T3          STORE WORD COUNT 
          SBN    77 
          PJN    PCL2        IF INCORRECT WORD COUNT
          LDD    MA          READ FET PARAMETERS
          ADN    2
          CRD    CM 
          ADN    1
          CRD    CN 
          LDD    CN+3 
          SHN    14 
          LMD    CN+4 
          SBD    CM+2 
          SHN    6
          SBD    CM+1 
          SHN    14 
          SBD    T3 
          PJN    PCL4        IF ROOM IN BUFFER
          RAD    T3          TRUNCATE LINE
 PCL4     LDD    RA          TRANSFER TO PP BUFFER
          ADD    FL 
          SBN    1
          SHN    6
          ADN    1
          CRM    CLBF,T3
          LDD    CM+1 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CM+2 
          CWM    CLBF,T3     TRANSFER WORDS TO INPUT BUFFER 
          LDD    T3          UPDATE FET 
          ADD    CM+2 
          STD    CM+4 
          SHN    -14
          ADD    CM+1 
          STD    CM+3 
          LDN    0
          STD    CM 
          STD    CM+1 
          STD    CM+2 
          LDD    T1 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    T2 
          CRD    CN 
          ADN    2
          CWD    CM 
          LDD    CN+4 
          LPC    7002 
          LMN    21 
          STD    CN+4 
          LDD    T1 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    T2 
          CWD    CN 
          LJM    PCLX        EXIT 
  
  
 CLBF     EQU    *
          ERRNG  BFMS-CLBF-100*5
          TTL    1AJ/3AI - SEARCH GLOBAL LIBRARY DIRECTORY. 
          TITLE 
          QUAL   3AI
          IDENT  3AI,SGDX    SEARCH GLOBAL LIBRARY DIRECTORY. 
*COMMENT  1AJ - SEARCH GLOBAL LIBRARY DIRECTORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AI - SEARCH GLOBAL LIBRARY DIRECTORY.
* 
* 
*         *3AI* SEARCHES FOR A NAME IN THE GLOBAL LIBRARY 
*         DIRECTORY FILE, *ZZZZZLD*.
*         THE FORMAT OF THE DIRECTORY FILE IS AS FOLLOWS. 
*T        42/  ENTRY POINT NAME,12/  0,6/  RT 
*T,       24/  RANDOM ADDRESS,36/  0
*T,       42/  LIBRARY NAME,18/  0
*T,       12/ FL, 11/ 0, 1/N, 12/ SEPF, 24/ 0 
* 
*         RT = RECORD TYPE. 
*         FL = FIELD LENGTH.
*         N = PARAMETER CRACKING FORMAT.
*             SET IF *NPC=* ENTRY POINT DEFINED.
*         SEPF = SPECIAL ENTRY POINT FLAGS
*               (SEE BYTE 0 OF *SEPW* IN *PPCOM*).
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * GLOBAL LIBRARY DIRECTORY DEFECTIVE.*
*         THE *ZZZZZLD* FILE IS NOT A GLOBAL LIBRARY DIRECTORY, 
*         OR THE INFORMATION CONTAINED IN THE DIRECTORY IS
*         INCONSISTENT WITH THE CONTENTS OF THE GLOBAL LIBRARY SET. 
* 
*         * GLOBAL LIBRARY DIRECTORY NOT FOUND.*
*         THE GLOBAL LIBRARY BIT IN *LB1W* IS SET TO INDICATE 
*         GLOBAL LIBRARY PROCESSING, BUT THE *ZZZZZLD* FILE 
*         WAS NOT FOUND.
* 
*         * I/O SEQUENCE ERROR.*
*         THE *ZZZZZLD* DIRECTORY FILE IS BUSY. 
* 
*         * USER LIBRARY NOT FOUND.*
*         THE ENTRY POINT WAS FOUND IN THE *ZZZZZLD* DIRECTORY
*         FILE, BUT THE USER LIBRARY IT RESIDES IN WAS NOT FOUND. 
* 
*         * USER LIBRARY NOT ON MASS STORAGE.*
*         THE ENTRY POINT WAS FOUND IN THE *ZZZZZLD* DIRECTORY
*         FILE, BUT THE USER LIBRARY IT RESIDES IN DOES NOT 
*         RESIDE ON MASS STORAGE. 
* 
*         * ZZZZZLD NOT ON MASS STORAGE.* 
*         THE DIRECTORY FILE DOES NOT RESIDE ON A MASS STORAGE DEVICE.
          SPACE  4,10 
***       DIRECT LOCATION ASSIGNMENTS.
* 
  
 RI       EQU    CW+3        RANDOM INDEX (2 LOCATIONS) 
 FN       EQU    AB          FILE NAME
 SGD      SPACE  4,30 
**        SGD - SEARCH GLOBAL LIBRARY DIRECTORY.
* 
*         ENTRY  (AB - AB+3) = ASSEMBLED NAME LEFT JUSTIFIED. 
* 
*         EXIT   LJM IN *CGLB* SET TO - 
*                  *SSC* IF PROGRAM RELOCATABLE OR *CCL* PROCEDURE, 
*                  *SCL7* TO CHECK FIELD LENGTH IF PROGRAM ABSOLUTE,
*                  TO *TCS*, IF ENTRY NOT FOUND.
*                IF PROGRAM IS ABSOLUTE - 
*                  (AB - AB+3) = USER LIBRARY WHERE ENTRY POINT IS
*                                FOUND. 
*                  (FS - FS+3) = ENTRY POINT NAME.
*                  (FS+4) = TRACK.
*                  (CW) = REQUIRED FIELD LENGTH.
*                  (CW+1) = EST ORDINAL THE LIBRARY RESIDES ON. 
*                  (CW+3) = TRACK.
*                  (CW+4) = SECTOR. 
* 
*         ERROR  TO */TCS/ERR1* IF ERROR IN DIRECTORY FILE OR 
*                USER LIBRARY.
*                TO *MSR*, IF MASS STORAGE ERROR. 
* 
*         USES   FA, RI+1, AB - AB+4, CM - CM+4, CW - CW+4, FS - FS+4,
*                T1 - T3, T5 - T7.
* 
*         CALLS  CRA, RNS, SAF, SFB.
* 
*         MACROS ENDMS, MONITOR, NFA, SETMS, SFA. 
  
  
          ORG    OVL+5
  
 SGD      SUBR               ENTRY/EXIT 
          LDD    MA          PP MESSAGE BUFFER ADDRESS
          CWD    AB          SWAP NAME FROM (AB - AB+3) TO *SGDC* 
          CRM    SGDC,ON
          SBN    1
          CWM    SGDB,ON     PUT *ZZZZZLD* INTO (AB - AB+3) 
          SBN    1           RESET (A) TO BUFFER ADDRESS
          CRD    AB          (AB - AB+3) CONTAINS *ZZZZZLD* 
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          STD    T6          STORE FILE NOT FOUND FLAG
          LDD    MA          SWAP NAME BACK INTO (AB - AB+3)
          CWM    SGDC,ON
          SBN    1
          CRD    AB 
          LDD    T6          CHECK FILE NOT FOUND FLAG
          ZJN    SGD2        IF DIRECTORY FILE MISSING
          RJM    SFB         SET FILE BUSY
          ZJN    SGD3        IF FILE SET BUSY 
          LDC    /ERR/EM15   * I/O SEQUENCE ERROR.* 
 SGD1     STM    SGDA        SET ERROR MESSAGE
 SGD2     LDD    CP          CLEAR GLOBAL LIBRARY BITS
          ADC    LB1W 
          STD    T1 
          CRD    CM 
          LDD    CM 
          LPC    5774 
          STD    CM 
          LDD    T1 
          CWD    CM 
          LDN    0           CLEAR FNT ADDRESS
          STD    FA 
          LDC    /ERR/EM14   * GLOBAL LIBRARY DIRECTORY NOT FOUND.* 
*         LDC    /ERR/EM15   (* I/O SEQUENCE ERROR.*) 
*         LDC    /ERR/EM16   (* ZZZZZLD NOT ON MASS STORAGE.*)
 SGDA     EQU    *-1         (ERROR MESSAGE TO BE ISSUED) 
          LJM    /TCS/ERR1   PROCESS ERROR
  
 SGD3     LDD    FS          SET EST ORDINAL
          LPC    777
          STD    T5 
          SFA    EST         READ EST ENTRY 
          ADK    EQDE 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          MJN    SGD4        IF MASS STORAGE
          AOD    FS+4        SET FILE NOT BUSY
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL 
          CWD    FS 
          LDC    /ERR/EM16   * ZZZZZLD NOT ON MASS STORAGE.*
          LJM    SGD1        PROCESS ERROR
  
 SGD4     SETMS  IO 
          LDD    FS+1        SET TO FIRST TRACK AND SECTOR
          STD    T6          FIRST TRACK
          LDN    FSMS 
          STD    T7          FIRST SECTOR(SKIP SYSTEM SECTOR) 
 SGD5     LDC    BFMS 
          RJM    RNS         READ NEXT SECTOR 
          MJP    MSR         IF MASS STORAGE ERROR
          NJN    SGD7        IF NOT EMPTY SECTOR
  
*         NAME NOT FOUND IN DIRECTORY, SET FILE NOT BUSY AND RETURN.
  
 SGD6     ENDMS 
          LDD    FS+4        SET OPERATION COMPLETE 
          SCN    77 
          LMN    5
          STD    FS+4 
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL 
          CWD    FS 
          LJM    SGDX        RETURN 
  
*         SEARCH THROUGH DIRECTORY. 
  
 SGD7     LDC    BFMS+2      INITIAL PP WORD IN BUFFER
          STD    T2 
          LDN    1           INITIAL CM WORD IN BUFFER
          STD    T3 
 SGD8     LDD    T1          READ WORDS TRANSFERRED 
          SBD    T3          CM WORD LOCATION IN BUFFER 
          PJN    SGD9        IF MORE ENTRIES IN BUFFER
          LDD    T1          CHECK FOR SHORT SECTOR(EOR OR EOF) 
          SHN    -6 
          NJN    SGD5        IF FULL SECTOR WAS TRANSFERRED 
          UJN    SGD6        EXIT, ENTRY NOT FOUND
  
 SGD9     LDI    T2          COMPARE ENTRY POINT NAME 
          LMD    AB 
          NJN    SGD10       IF NO MATCH
          LDM    1,T2 
          LMD    AB+1 
          NJN    SGD10       IF NO MATCH
          LDM    2,T2 
          LMD    AB+2 
          NJN    SGD10       IF NO MATCH
          LDM    3,T2 
          LMD    AB+3 
          SCN    77 
          ZJN    SGD11       IF ENTRY POINT FOUND 
 SGD10    LDN    4           INCREMENT CM WORD COUNT
          RAD    T3 
          LDN    20D         INCREMENT PP WORD COUNT
          RAD    T2 
          UJN    SGD8        CHECK NEXT ENTRY 
  
*         ENTRY FOUND IN DIRECTORY, CHECK ITS TYPE. 
  
 SGD11    ENDMS 
          AOD    FS+4        SET FILE NOT BUSY
          NFA    FA,R 
          ADN    FSTL 
          CWD    FS 
          LDM    3*5+1,T2    SET PARAMETER CRACKING FORMAT
          LPN    1
          RAM    /TCS/ARGA
          LDC    UJNI+/TCS/SCL5-/TCS/SCLD  DISABLE CHANGE IN CRACKING 
          STM    /TCS/SCLD
          LDM    4,T2        CHECK FOR VALID RECORD TYPES 
          LMN    ABRT 
          NJN    SGD12       IF NOT AN ABSOLUTE OVERLAY 
 SGD11.1  LJM    SGD17       PROCESS *ABS* OR *OVL* LOAD
  
 SGD12    LMN    OVRT&ABRT
          ZJN    SGD11.1     IF *OVL* LEVEL (0,0) 
          LMN    RLRT&OVRT
          NJN    SGD13       IF PROGRAM NOT RELOCATABLE 
          LDM    /TCS/SCLC
          NJN    SGD12.1     IF NOT POSSIBLE CONTINUATION CARD
          LDC    /ERR/EM05   * INCORRECT COMMAND.*
          LJM    SGD16       ISSUE ERROR MESSAGE
  
 SGD12.1  LDD    CP          SET RELOCATABLE LOAD FLAG
          ADC    LB1W 
          STD    T1 
          CRD    CM 
          LDD    CM 
          LMN    2
          STD    CM 
          LDD    T1 
          CWD    CM 
          LDN    /TCS/LDR=   SET SYSTEM CALL TO CYBER LOADER
          UJN    SGD14       SET SYSTEM CALL
  
 SGD13    LMN    PRRT&RLRT
          NJN    SGD15       IF NOT VALID RECORD TYPE 
          LDC    4040        SET *ARG=* ENTRY POINT 
          STM    /TCS/CSEB
          LDN    /TCS/BEGI   SET SYSTEM CALL TO BEGIN *CCL* PROC
 SGD14    STM    /TCS/CGLA   SAVE SYSTEM CALL 
          LDC    /TCS/SSC    SET JUMP TO SET SYSTEM CALL
          STM    /TCS/CGLB
          LDC    LDNI+0      ENABLE *SCL* 
          STM    /TCS/SCLE
          LJM    SGDX        RETURN 
  
*         GLOBAL LIBRARY DIRECTORY ERROR. 
  
 SGD15    LDN    0
          STD    FA 
          LDC    /ERR/EM17   * GLOBAL LIBRARY DIRECTORY DEFECTIVE.* 
 SGD16    LJM    /TCS/ERR1   PROCESS ERROR
  
*         COLLECT NECESSARY INFORMATION OUT OF DIRECTORY. 
  
 SGD17    LDM    1*5+0,T2    SET RANDOM ADDRESS 
          STD    T6 
          LDM    1*5+1,T2 
          STD    T7 
          ADD    T6 
          ZJN    SGD15       IF RANDOM INDEX IS ZERO
  
*         LOCATE LIBRARY FNT/FST. 
  
          LDM    2*5+0,T2    SET LIBRARY NAME 
          STD    AB 
          LDM    2*5+1,T2 
          STD    AB+1 
          LDM    2*5+2,T2 
          STD    AB+2 
          LDM    2*5+3,T2 
          STD    AB+3 
          LDN    0
          STD    AB+4 
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          NJN    SGD18       IF USER LIBRARY FOUND
          LDC    /ERR/EM19   * USER LIBRARY NOT FOUND.* 
          UJN    SGD16       PROCESS ERROR
  
 SGD18    LDM    3*5+2,T2    GET SPECIAL ENTRY POINTS 
          LPC    4050        ALLOW *ARG=* AND *SDM=* ONLY 
          STM    /TCS/CSEB
          LDD    CP          SET FNT ADDRESS INTO CONTROL POINT AREA
          ADC    EOCW 
          CRD    CW 
          LDD    FA 
          STD    CW 
          LDD    CP 
          ADC    EOCW 
          CWD    CW 
          LDD    FS+3 
          SHN    21-2 
          PJN    SGD19       IF NOT EXECUTE-ONLY FILE 
          LDM    /TCS/CSEB   SET *SSM=* ENTRY POINT 
          LPC    -4001
          LMC    4001 
          STM    /TCS/CSEB
          LDC    LPNI        ALLOW MEMORY CLEARING BEFORE LOAD
          STM    /TCS/BCPN
 SGD19    LDM    /TCS/SCLC
          NJN    SGD19.1     IF NOT POSSIBLE CONTINUATION CARD
          LDM    /TCS/CSEB
          SHN    21-5 
          MJN    SGD19.1     IF *ARG=* ENTRY POINT
          LDC    /ERR/EM05   * INCORRECT COMMAND.*
          LJM    SGD16       ISSUE ERROR MESSAGE
  
 SGD19.1  LDM    3*5+0,T2    SET REQUIRED FIELD LENGTH
          STD    CW 
  
*         SET UP CALL TO CONVERT RANDOM ADDRESS.
  
          NFA    FA,R        GET FST ENTRY
          ADN    FSTL 
          CRD    FS 
          LDD    FS          SET EQUIPMENT
          LPC    777
          STD    T5 
          STD    CW+1        STORE EQUIPMENT IN CONTROL WORD
          SFA    EST         READ EST ENTRY 
          ADK    EQDE 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          PJN    SGD20       IF NOT ON MASS STORAGE 
          LDD    T6          STORE RANDOM ADDRESS IN RI - RI+1
          STD    RI 
          SHN    14 
          LMD    T7 
          SHN    14 
          STM    /TCS/CGLC
          SHN    -6 
          SCN    77 
          STM    /TCS/CGLC+1
          LDD    T7 
          STD    RI+1 
          LDD    FS+1        SET FIRST TRACK
          STD    T6 
          RJM    CRA         CONVERT RANDOM ADDRESS 
          PJN    SGD21       IF RANDOM ADDRESS FOUND
          LJM    SGD15       PROCESS ERROR
  
 SGD20    LDC    /ERR/EM18   * USER LIBRARY NOT ON MASS STORAGE.* 
          LJM    /TCS/ERR1   PROCESS ERROR
  
 SGD21    LDD    T6          STORE TRACK AND SECTOR IN CW+3 - CW+4
          STD    CW+3        TRACK
          STM    SGDC+4 
          LDD    T7 
          STD    CW+4 
          LDN    0
          STD    CW+2        CLEAR OUT REST OF CONTROL WORD 
          LDC    /TCS/SCL7   SET IF PROGRAM ABSOLUTE
          STM    /TCS/SCLA+1
          LDC    LJMI 
          STM    /TCS/SCLA
          LDC    RJMI        SET RETURN JUMP IN */TCS/CGL*
          STM    /TCS/CGLB-1
          LDC    /TCS/SCL 
          STM    /TCS/CGLB
          LDC    /3AE/LDU    SET *RJM* ADDRESS IN *BCP* 
          STM    /TCS/BCPB
          LDD    CP          SET USER LIBRARY LOAD FLAG 
          ADC    LB1W 
          STD    T1 
          CRD    CM 
          LDD    CM 
          LMN    1
          STD    CM 
          LDD    T1 
          CWD    CM 
          LDD    MA          SET ENTRY POINT NAME 
          CWM    SGDC,ON
          SBN    1
          CRD    FS 
          LJM    SGDX        RETURN 
  
  
 SGDB     VFD    48/0LZZZZZLD,12/0  GLOBAL DIRECTORY
 SGDC     BSS    5           TEMPORARY STORAGE FOR ASSEMBLED NAME 
 MSR      SPACE  4,10 
**        MSR - MASS STORAGE READ ERROR PROCESSOR.
* 
*         ENTRY  (A) = DRIVER REPLY.
*                (T5) = EST ORDINAL OF EQUIPMENT WITH ERROR.
*                (FA) .NE. 0 IF LOCAL FILE LOAD.
*                (FS - FS+4) = FST ENTRY. 
* 
*         EXIT   TO *1RJ* IF TO ROLL JOB. 
*                TO */TCS/DPP* IF NOT TO ROLL OUT JOB.
* 
*         USES   CM+1, FS+4, IR+4.
* 
*         MACROS EXECUTE, MONITOR NFA.
  
  
 MSR      BSS    0           ENTRY
          SHN    21-12
          MJN    MSR2        IF NON-RECOVERABLE 
          LDM    MSD         CHECK FOR SUBSYSTEM
          SHN    21-13
          PJN    MSR2        IF A SUBSYSTEM, ABORT JOB
          LDD    T5          SET EQUIPMENT TO WAIT FOR
          STD    IR+4 
          LDD    FA          CHECK REQUEST
          ZJN    MSR1        IF NOT LOCAL FILE LOAD 
          LDD    FS+4        SET OPERATION COMPLETE 
          SCN    77 
          LMN    5
          STD    FS+4 
          NFA    FA,R        STORE FST ENTRY
          ADN    FSTL 
          CWD    FS 
 MSR1     LDM    /TCS/MSRA   CHECK JOB ADVANCE SET FLAG 
          LPN    1
          NJN    MSR1.1      IF JOB ADVANCE NOT SET 
          STD    CM+1        CLEAR JOB ADVANCE
          MONITOR  JACM 
 MSR1.1   EXECUTE  1RJ       ROLL JOB 
*         LJM    PPR         DOES NOT RETURN
  
 MSR2     LDK    PPET        ABORT CONTROL POINT
          STD    CM+1 
          MONITOR  CEFM 
          LJM    /TCS/DPP    DROP PP
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCRA 
*CALL     COMPRNS 
*CALL     COMPSAF 
*CALL     COMPSFB 
  
          ERRNG  BFMS-* 
          QUAL
          TTL    1AJ/3AJ - INITIATE JOB TERMINATION.
          TITLE 
          QUAL   3AJ
          IDENT  3AJ,IJTX    INITIATE JOB TERMINATION.
*COMMENT  1AJ - INITIATE JOB TERMINATION. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AJ - INITIATE JOB TERMINATION. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         ACCOUNT FILE. 
* 
*         *UEAC, XXXXXX.XXXUNTS.* = AUC ACTIVITY (UNITS). 
* 
*         *UEMP, XXXXXX.XXXKUNS.* = MAP III ACTIVITY (KILO-UNITS).
* 
*         *UECO, XXXXXX.XXXKCHS.* = TERMINAL CHARACTERS OUTPUT. 
* 
*         *UECI, XXXXXX.XXXKCHS.* = TERMINAL CHARACTERS INPUT.
* 
*         *UECT, XXXXXX.XXXKCHS.* = TOTAL TERMINAL CHARACTERS.
* 
*         *UEAD, XXXXXX.XXXKUNS.* = APPLICATION UNITS (KILO-UNITS). 
* 
*         *UEPF, XXXXXX.XXXKUNS.* = PERMANENT FILE USAGE (KILO-UNITS).
* 
*         *UEMT, XXXXXX.XXXKUNS.* = MAGNETIC TAPE USAGE (KILO-UNITS). 
* 
*         *UEMS, XXXXXX.XXXKUNS.* = MASS STORAGE USAGE (KILO-UNITS).
* 
*         *UEOD, XXXXXX.XXXKUNS.* = OPTICAL DISK USAGE (KILO-UNITS).
* 
*         *UECP, XXXXXX.XXXSECS.* = ACCUMULATED CPU TIME (SECONDS). 
* 
*         *AESR, XXXXXX.XXXUNTS.* = ACCUMULATED SRUS (UNITS). 
* 
*         *AUSR, 000000.000UNTS.* = ACCUMULATED SRUS (UNITS) NOT
*         UPDATED INTO PROJECT PROFILE FILE.
* 
*         *UEAU, 000000.000UNTS.* = APPLICATION ACCUMULATOR (UNITS).
          SPACE  4,10 
**        ROUTINES USED.
* 
*         *0AU* - UPDATE PROJECT PROFILE FILE.
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 NL       EQU    37          NEGATIVE FL ASSIGNED 
 FN       EQU    40 - 44     FILE NAME (5 LOCATIONS)
 RC       EQU    66          *0AU* RE-TRY COUNT 
          SPACE  4,10 
**        ASSEMBLY CONSTANTS. 
  
  
 IMES     EQU    4           *0AU* RE-TRY THRESHOLD FOR MESSAGE ISSUE 
 MTRY     EQU    50D         MAXIMUM *0AU* RE-TRY COUNT 
 DELY     EQU    100000/2    DELAY FOR *0AU* RETRY
  
  
**        DEFINITION COMMON DECKS.
  
  
          QUAL   COMSHIO
*CALL     COMSHIO 
          QUAL   *
  
****
          TITLE  MAIN PROGRAM.
 IJT      SPACE  4,10 
**        IJT - INITIATE JOB TERMINATION. 
* 
*         EXIT   (A) = 0 IF NO COMMANDS TO EXECUTE. 
*                (A) .NE. 0 IF COMMANDS TO EXECUTE. 
* 
*         CALLS  CAC, CEP, ITS, IUA, PTR, RLF, SUV. 
  
  
          ORG    E1AJ 
 IJT      SUBR               ENTRY/EXIT 
          RJM    PTR         PRESET JOB TERMINATION 
          LDD    NL 
          ZJN    IJTX        IF NO NFL, RETURN
          RJM    CEP         CHECK EPILOGUE REQUIRED
          RJM    RLF         RELEASE LOCAL FILES
          RJM    IUA         ISSUE USER ACCOUNTING MESSAGES 
          RJM    CAC         CLEAR ACCOUNTING ACCUMULATORS
          RJM    SUV         SET USER VALIDATION LIMITS 
          RJM    ITS         ISSUE TERMINATION COMMANDS 
          UJP    IJTX        EXIT 
  
  
 PFUF     CON    0           PROFILE FILE UPDATE FAILURE FLAG 
          TITLE  SUBROUTINES. 
 CAC      SPACE  4,10 
**        CAC - CLEAR USER ACCOUNTING ACCUMULATORS. 
* 
*         CLEARS ACCUMULATORS TO PREVENT OVERFLOW DURING
*         JOB TERMINATION PROCESSING. 
* 
*         EXIT   CPA ACCOUNTING ACCUMULATORS CLEARED. 
* 
*         USES   T0, CM - CM+4, SP - SP+4.
  
  
 CAC      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR ZERO WORD
          CRD    CM 
          LDD    CP          CLEAR ACCUMULATORS 
          ADK    SRUW 
          CWD    CM 
          ADK    CPTW-SRUW
          CWD    CM 
          ADK    IOAW-CPTW
          CWD    CM 
          ADK    ADAW-IOAW
          CWD    CM 
          ADK    CSPW-ADAW
          STD    T0 
          CRD    SP 
          LDD    SP          CLEAR CHARGE REQUIRED FLAG 
          SCN    4
          STD    SP 
          LDD    T0 
          CWD    SP 
          UJN    CACX        RETURN 
 CEP      SPACE  4,10 
**        CEP - CHECK EPILOGUE REQUIRED.
* 
*         EXIT   TO IJTX WITH (A) .NE. 0 IF EPILOGUE REQUIRED.
*                TO CALLER IF EPILOGUE NOT REQUIRED.
* 
*         USES   CM - CM+4, SP - SP+4, T1.
* 
*         CALLS  ICS. 
* 
*         MACROS NFA. 
  
  
 CEP      SUBR               ENTRY/EXIT 
          LDD    CP          READ COMMAND POINTERS
          ADN    CSPW 
          CRD    SP 
          LDD    SP 
          SHN    21-3 
          PJN    CEPX        IF NO EPILOGUE REQUIRED
          LDN    CEPAL/5     SET WORD COUNT 
          STD    T1 
          LDC    CEPA        SET BUFFER ADDRESS 
          RJM    ICS         ISSUE LOGOUT COMMAND 
          LJM    IJTX        EXIT TO EXECUTE EPILOGUE 
  
 CEPA     BSS    0           LOGOUT COMMAND 
          VFD    60/8L$LOGOUT.
 CEPAL    EQU    *-CEPA 
 CUF      SPACE  4,10 
**        CUF - CHECK FOR PROFILE FILE UPDATE FAILURE.
* 
*         ISSUES ACCOUNTING DAYFILE MESSAGE IF PROFILE FILE 
*         UPDATE FAILED.
* 
*         ENTRY  (PFUF) = SET IF PROFILE FILE UPDATE FAILURE. 
* 
*         USES   T1.
* 
*         CALLS  DFM. 
  
  
 CUF      SUBR               ENTRY/EXIT 
          LDM    PFUF        CHECK UPDATE FAILURE FLAG
          ZJN    CUFX        IF NO UPDATE FAILURE 
          LDM    IUAB+ABSR   CHANGE MESSAGE PREFIX TO *AUSR*
          STD    T1 
          STM    CUFA 
          LDC    2RAU 
          STI    T1 
          LDC    ACFN+* 
 CUFA     EQU    *-1
          RJM    DFM         ISSUE DAYFILE MESSAGE
          UJN    CUFX        RETURN 
 DAM      SPACE  4,10 
**        DAM - DISPLAY ACCOUNT MESSAGES. 
* 
*         ENTRY  (A) = MESSAGE ADDRESS. 
*                (T4) = NUMBER OF MESSAGES - 1 TO DISPLAY.
* 
*         USES   T4, T5.
* 
*         CALLS  DFM. 
  
  
 DAM      SUBR               ENTRY/EXIT 
          STM    DAMA        SAVE ADDRESS OF MESSAGE
 DAM1     LDM    *,T4        GET MESSAGE ADDRESS
 DAMA     EQU    *-1
          STD    T5 
          LDM    3,T5 
          ZJN    DAM2        IF QUANTITY ZERO (NO MESSAGE DISPLAYED)
          LDD    T5 
          LMC    CPON 
          RJM    DFM         DISPLAY IN USERS DAYFILE 
          LDD    T5 
          LMC    ACFN 
          RJM    DFM         DISPLAY IN ACCOUNT FILE
 DAM2     SOD    T4          DECREMENT MESSAGE COUNT
          PJN    DAM1        IF MORE MESSAGES 
          UJN    DAMX        RETURN 
 IAA      SPACE  4,10 
***       IAA - ISSUE APPLICATION ACCOUNTING MESSAGE. 
* 
*         ENTRY  (CM - CM+4) = CONTROL POINT WORD *FPFW*. 
*                (A) = APPLICATION ACCOUNTING FLAGS.
* 
*         EXIT   *UEAU* ACOUNTING MESSAGE ISSUED. 
* 
*         USES   CM - CM+4, T2 - T7.
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 IAA      SUBR               ENTRY/EXIT 
          STD    T2          SAVE FLAGS 
          LDD    CM          CLEAR APPLICATION ACCOUNTING FLAGS 
          LPC    6377 
          STD    CM 
          LDD    CP 
          ADK    FPFW 
          CWD    CM 
          SBN    FPFW-CPTW   CP ACCUMULATOR WORD
          CRD    T3 
          ADN    CPJW-CPTW   CP TIME JOB STEP WORD
          CRD    CM 
          LDD    T2          CHECK APPLICATION ACCOUNTING IN PROGRESS 
          SHN    21-11
          PJN    IAAX        IF APPLICATION ACCOUNTING NOT IN PROGRESS
          LDD    MA          WRITE WORDS TO MESSAGE BUFFER
          CWD    T3 
          ADN    1
          CWD    CM 
          LDN    ABUS 
          STD    CM+1        SET *ACTM* SUB-FUNCTION (ABUS) 
          MONITOR  ACTM      CALCULATE CP TIME USED FOR JOB STEP
          LDD    MA          READ CONVERSION INTO MESSAGE AREA
          CRM    IAAA+3,ON
          LDC    ACFN+IAAA
          RJM    DFM         DISPLAY IN ACCOUNT FILE
          LJM    IAAX        EXIT 
  
  
*         DAYFILE MESSAGE.
  
 IAAA     DATA   C*UEAU, 000000.000UNTS.* 
 ICS      SPACE  4,15 
**        ICS - ISSUE COMMANDS. 
* 
*         ISSUES COMMANDS SPECIFIED BY CALLER.
* 
*         ENTRY  (A) = COMMAND ADDRESS. 
*                (T1) = WORD COUNT OF COMMANDS. 
* 
*         EXIT   (A) .NE. 0.
*                COMMANDS ENTERED IN COMMAND
*                BUFFER.
*                *SHELL* CONTROL CLEARED. 
* 
*         USES   CM - CM+4, SP - SP+4.
* 
*         MACROS NFA. 
  
  
 ICS      SUBR               ENTRY/EXIT 
          STM    ICSA        SET COMMAND ADDRESS
          LDD    CP          READ COMMAND POINTERS
          ADN    CSPW 
          CRD    SP 
          ADN    CSSW-CSPW
          CRD    CM 
          LDD    CM          CLEAR SKIP TO EXIT 
          LPC    5777 
          STD    CM 
          LDC    4000        SET EOR ON COMMANDS
          STD    SP+1 
          LDC    CSBN        SET COMMAND ADDRESS
          STD    SP+3 
          SBD    T1          SET LIMIT
          STD    SP+4 
          LDD    CP          WRITE COMMAND POINTERS 
          ADN    CSPW 
          CWD    SP 
          ADN    CSSW-CSPW
          CWD    CM 
          NFA    SP+3,R      WRITE COMMANDS TO BUFFER 
          CWM    *,T1 
 ICSA     EQU    *-1         (ADDRESS OF COMMANDS)
          LDN    ZERL        CLEAR *SHELL* CONTROL
          CRD    CM 
          NFA    SHCN 
          CWD    CM 
          LJM    ICSX        RETURN 
 ITS      SPACE  4,15 
**        ITS - ISSUE JOB TERMINATION COMMANDS. 
* 
*         ISSUES JOB TERMINATION COMMANDS BASED ON THE
*         DISPOSITION OF THE JOB. 
* 
*         ENTRY  (JTFG) = JOB TERMINATION FLAGS.
*                (JTOP) = JOB TERMINATION OPTION. 
*                (ITSA) = QUEUED FILES FLAG.
* 
*         EXIT   (A) = 0, IF NO JOB TERMINATION COMMANDS TO PROCESS.
* 
*         USES   CM - CM+4, T1 - T7.
* 
*         CALLS  ICS, MSR, RSS. 
* 
*         MACROS ENDMS, NFA, SETMS. 
  
  
 ITS      SUBR               ENTRY/EXIT 
          LDN    ITSCL/5     PRESET WORD COUNT
          STD    T1 
          LPN    7
          LDM    JTOP        GET JOB TERMINATION OPTION 
          SBN    NXJT 
          PJN    ITS1        IF BAD TERMINATION CODE
          ADN    NXJT 
          STD    CM 
          LDM    ITSE,CM
          NJN    ITS4        IF TERMINATION COMMAND PREPROCESSOR
 ITS1     LDM    JTFG 
          LPN    7
          LMN    NOJT 
          NJN    ITS2        IF OUTPUT NOT TO BE DROPPED
          LDC    0
 ITSA     EQU    *-1         (QUEUED FILES FLAG)
          ZJN    ITSX        IF NO QUEUED FILES 
          LDN    ITSBL/5     SET WORD COUNT 
          STD    T1 
 ITS2     LDC    ITSB        SET BUFFER ADDRESS 
*         LDC    ITSD        (RERUN OF JOB) 
 ITSC     EQU    *-1
          RJM    ICS         ISSUE COMMANDS 
 ITS3     LJM    ITSX        RETURN 
  
 ITS4     STD    CM 
          LJM    0,CM        PREPROCESS TERMINATION COMMAND 
  
*         *RJJT* TERMINATION PREPROCESSING. 
  
 ITS5     LDM    JTFG        CHECK QUEUE FILE DISPOSITION 
          LPN    7
          LMN    NOJT 
          ZJN    ITS3        IF OUTPUT TO BE DROPPED
          LDN    ITSDL/5     SET UP RERUN COMMANDS
          STD    T1 
          LDC    ITSD 
          STM    ITSC 
          LJM    ITS2        ISSUE RERUN COMMANDS 
  
*         *SRJT* OR *HRJT* TERMINATION PREPROCESSING. 
  
 ITS6     NFA    FNTN        READ INPUT FILE FST
          CRD    T1 
          ADN    FSTL 
          CRD    CM 
          LDD    T1 
 ITS7     ZJN    ITS3        IF NULL ENTRY
          LDD    T1+4        CHECK FILE TYPE
          SHN    -6 
          LMK    INFT 
          NJN    ITS8        IF NOT INPUT FILE
          LDD    CM 
          STD    T5          SET INPUT FILE EST ORDINAL 
          LDD    CM+1 
          STD    T6          SET FIRST TRACK
          ZJN    ITS7        IF NO FIRST TRACK ASSIGNED 
          SETMS  IO 
*         LDN    0           OMIT FILE NAME COMPARE 
          RJM    RSS         READ SYSTEM SECTOR 
          MJN    ITS9        IF MASS STORAGE ERROR
 ITS8     NJN    ITS10       IF SYSTEM SECTOR READ ERROR
          ENDMS 
          LDM    JTOP 
          STD    CM 
          LDM    HRSS-HRJT,CM 
          ERRNZ  SRJT-HRJT-1 CODE REQUIRES *SRJT* = *HRJT* + 1
          ERRNZ  SESS-HRSS-1 CODE REQUIRES *SESS* = *HRSS* + 1
          ADN    1
          SBM    ITSF-HRJT,CM 
          MJN    ITS10       IF RERUN LIMIT NOT EXCEEDED
          LDN    ITSCL/5     PRESET WORD COUNT
          STD    T1 
          LJM    ITS5        TREAT AS *RJJT* TERMINATION
  
 ITS9     RJM    MSR         PROCESS MASS STORAGE ERROR 
 ITS10    LDN    0           FLAG NO COMMANDS 
          LJM    ITSX        RETURN DROPPING OUTPUT 
  
  
*         TERMINATION COMMANDS. 
  
 ITSB     VFD    60/10L$OUT(*/OP= 
          VFD    60/2LE)
          VFD    60/10L$UNLOAD(*/ 
          VFD    60/5LOP=O) 
 ITSBL    EQU    *-ITSB 
          VFD    60/10L$DAYFILE(O 
          VFD    60/10LUTPUT,JT=D 
          VFD    60/1L) 
 ITSCL    EQU    *-ITSB 
  
*         RERUN JOB TERMINATION COMMANDS. 
  
 ITSD     VFD    60/10L$RETURN(OU 
          VFD    60/5LTPUT) 
          VFD    60/10L$DAYFILE.
          VFD    60/0 
          VFD    60/10L$ROUTE,OUT 
          VFD    60/4LPUT.
 ITSDL    EQU    *-ITSD 
  
 ITSE     INDEX 
          INDEX  RJJT,ITS5   *RJJT* TERMINATION COMMAND PREPROCESSOR
          INDEX  HRJT,ITS6   *HRJT* TERMINATION COMMAND PREPROCESSOR
          INDEX  SRJT,ITS6   *SRJT* TERMINATION COMMAND PREPROCESSOR
          INDEX  NXJT 
  
 ITSF     CON    HRTL+1 
          CON    MSER+1 
 IUA      SPACE  4,10 
**        IUA - ISSUE USER ACCOUNTING DAYFILE MESSAGES. 
* 
*         USES   T1 - T7, CM - CM+4.
* 
*         CALLS  CUF, DAM, IAA, SCM, UPF. 
* 
*         MACROS MONITOR. 
  
  
 IUA5     RJM    CUF         CHECK FOR PROFILE FILE UPDATE FAILURE
  
 IUA      SUBR               ENTRY/EXIT 
          LDD    CP          READ JOB CONTROL INFORMATION 
          ADK    CWQW 
          CRD    CM 
          LDD    CM          CHECK CPU PRIORITY 
          LPC    1770 
          ZJN    IUAX        IF CPU PRIORITY = 0
          RJM    UPF         UPDATE PROJECT PROFILE FILE
  
*         ISSUE APPLICATION ACCOUNTING MESSAGE
  
          LDD    CP          READ APPLICATION ACCOUNTING CONTROL WORD 
          ADN    FPFW 
          CRD    CM 
          LDD    CM          CHECK FOR APPLICATION ACCOUNTING 
          LPC    1400 
          ZJN    IUA1        IF APPLICATION ACCOUNTING NOT ACTIVE 
          RJM    IAA         ISSUE APPLICATION ACCOUNTING MESSAGE 
 IUA1     LDN    ACTWL
          STD    T4 
          LDD    CP 
          ADN    ACTW 
          CRM    ACCT,T4     STORE IN TEMPORARY AREA
  
*         SPECIAL CHECK FOR SYSTEM JOB. 
  
          LDM    JBOT        CHECK JOB ORIGIN 
          LMK    SYOT 
          NJN    IUA3        IF NOT SYSTEM ORIGIN 
          LDN    4
          STD    T5          CHECK SRU ACCUMULATOR
 IUA2     LDM    ACCT+5*SRUW-5*ACTW,T5
          NJN    IUA3        IF SRU ACCUMULATOR NOT ZERO
          SOD    T5 
          NJN    IUA2        IF MORE TO CHECK 
          UJP    IUA5        CHECK PROFILE FILE UPDATE FAILURE
  
*         CONVERT CONTROL POINT AREA ACCUMULATORS.
  
 IUA3     LDD    MA 
          CWM    ACCT,T4     TRANSFER FROM TEMPORARY STORAGE
          LDN    ABVF 
          STD    CM+1        SET *ACTM* SUB-FUNCTION (ABVF) 
          MONITOR  ACTM      CONVERT ACCUMULATORS 
          LDN    ABNA-1 
          STD    T4          STORE CONVERSIONS IN MESSAGES
          LDC    IUAB        SET MESSAGE ADDRESS
          RJM    SCM         STORE CONVERSIONS IN MESSAGE 
  
*         CONVERT TERMINAL CHARACTER COUNTS.
  
          NFA    RC2N        READ CHARACTER COUNTS
          CRD    CM 
          LDD    CM+4        SET OUTPUT COUNT 
          STM    IUAG+7 
          LDD    CM+3        SET INPUT COUNT
          STM    IUAF+7 
          ADD    CM+4        SET COMBINED COUNT 
          STM    IUAE+7 
          SHN    -14
          ADD    CM+2 
          STM    IUAE+6 
          LDD    MA          SET COUNTS FOR CONVERSION
          CWM    IUAE+3,ON
          CWM    IUAF+3,ON
          CWM    IUAG+3,ON
          LDN    RCIS+3      SET F10.3 CONVERSION AND REQUEST COUNT 
          STD    CM+1 
          LDN    0
          STD    CM+2 
          MONITOR RDCM       CONVERT CHARACTER COUNTS 
          LDD    MA 
          CRM    IUAE+3,ON   READ CONVERSIONS TO MESSAGE
          CRM    IUAF+3,ON
          CRM    IUAG+3,ON
  
*         READ AND CONVERT NEXT ACCOUNTING BLOCK. 
  
          LDN    AC1WL
          STD    T4 
          LDD    CP          READ ACCUMULATORS
          ADK    AC1W 
          CRM    ACCT,T4
          LDD    MA 
          CWM    ACCT,T4
          LDN    ABOF        SET *ACTM* SUB-FUNCTION
          STD    CM+1 
          MONITOR  ACTM      CONVERT OTHER ACCUMULATORS 
          LDN    ABNB-1 
          STD    T4 
          LDC    IUAD        SET MESSAGE ADDRESS
          RJM    SCM         STORE CONVERSIONS IN MESSAGE 
  
*         DISPLAY MESSAGES. 
  
          LDN    ABNB-1 
          STD    T4 
          LDM    IUAB+ABSR
          ADN    3
          STD    T5          GET ADDRESS OF SRU ACCUMULATOR 
          STM    IUAA 
          LDI    T5 
          NJN    IUA4        IF SRU ACCUMULATOR NONZERO 
          LDD    MA 
          CWM    IUAC,ON     STORE DISPLAY FORMAT ZERO IN SRU MESSAGE 
          SBN    1
          CRM    *,ON 
 IUAA     EQU    *-1
 IUA4     LDC    IUAD        SET MESSAGE ADDRESS
          RJM    DAM         DISPLAY ACCOUNTING MESSAGES
          LDN    ABNA+3-1    NUMBER OF MESSAGES 
          STD    T4 
          LDC    IUAB        SET MESSAGE ADDRESS
          RJM    DAM         DISPLAY ACCOUNTING MESSAGES
          LJM    IUA5        EXIT 
  
  
*         DAYFILE MESSAGES. 
* 
*         THE MESSAGE ADDRESSES IN THE FOLLOWING TABLE AND THE
*         ACCUMULATORS RETURNED BY *ACTM* SUB-FUNCTION *ABVF*, ARE
*         MAINTAINED IN THE SAME ORDER TO INSURE THAT THE CORRECT 
*         QUANTITY IS STORED IN THE APPROPRIATE MESSAGE.  THE MESSAGES
*         ARE DISPLAYED IN THE REVERSE ORDER SO THAT SRUS ARE ALWAYS
*         THE LAST TO BE DISPLAYED.  IF SRUS ARE NOT RETURNED FIRST,
*         THE ABOVE CODE MUST BE CHANGED SO THAT THEY ARE DISPLAYED 
*         LAST. 
  
 IUAB     INDEX 
  
          INDEX  ABSR,(=C*AESR, 000000.000UNTS.*) 
          INDEX  ABCP,(=C*UECP, 000000.000SECS.*) 
          INDEX  ABMS,(=C*UEMS, 000000.000KUNS.*) 
          INDEX  ABMT,(=C*UEMT, 000000.000KUNS.*) 
          INDEX  ABPF,(=C*UEPF, 000000.000KUNS.*) 
          INDEX  ABAD,(=C*UEAD, 000000.000KUNS.*) 
          INDEX  ABNA+0,IUAE TOTAL CHARACTERS TRANSFERRED 
          INDEX  ABNA+1,IUAF CHARACTERS IN
          INDEX  ABNA+2,IUAG CHARACTERS OUT 
  
          INDEX  ABNA+3 
  
 IUAC     DATA   C*     0.000*  DISPLAY FORMAT ZERO 
  
 IUAD     INDEX              SECOND ACCOUNT BLOCK MESSAGES
  
          INDEX  ABMP,(=C*UEMP, 000000.000KUNS.*) 
          INDEX  ABAC,(=C*UEAC, 000000.000UNTS.*) 
          INDEX  ABOD,(=C*UEOD, 000000.000KUNS.*) 
  
          INDEX  ABNB 
  
 IUAE     DATA   6HUECT, ,0,0,0,0,0,6HKCHS. ,0
 IUAF     DATA   6HUECI, ,0,0,0,0,0,6HKCHS. ,0
 IUAG     DATA   6HUECO, ,0,0,0,0,0,6HKCHS. ,0
 MSR      SPACE  4,15 
**        MSR - MASS STORAGE ERROR PROCESSING.
* 
*         ENTRY  (A) = MASS STORAGE DRIVER RETURN IF .LT. 0.
*                (A) = 0 TO FORCE *1RJ* CALL. 
*                (T5) = EST ORDINAL OF INACCESSIBLE DEVICE. 
* 
*         EXIT   TO *1RJ* IF NOT NON-RECOVERABLE ERROR. 
*                TO CALLER IF NON-RECOVERABLE ERROR.
* 
*         USES   CM+1, IR+4.
* 
*         MACROS EXECUTE, MONITOR.
  
  
 MSR      SUBR               ENTRY
          SHN    21-12
          MJN    MSRX        IF NON-RECOVERABLE ERROR 
          LDD    T5          SET EQUIPMENT TO WAIT FOR
          STD    IR+4 
          LDN    0           CLEAR JOB ADVANCE
          STD    CM+1 
          MONITOR  JACM 
          EXECUTE  1RJ       RECALL *1AJ* AND ROLL OUT JOB IF POSSIBLE
 RLF      SPACE  4,25 
**        RLF - RELEASE LOCAL FILES.
* 
*         1. RETURN ALL FILES THAT WILL NOT BE PROCESSED BY THE *OUT* 
*            OR *DAYFILE* COMMANDS AT JOB TERMINATION.
*         2. RETURN ANY FILE THAT WOULD BE PROCESSED BY *OUT* IF THAT 
*            FILE IS NOT MASS STORAGE.
*         3. DO NOT RETURN FILE *INPUT* (TYPE *INFT*).
*         4. IF THE JOB IS SYSTEM ORIGIN AND THERE ARE NO FILES TO
*            BE PRINTED, SET *EOJW* TO *NOJT* STATUS. 
*         5. SET JOB TERMINATION IN PROGRESS FLAG IN EJT. 
* 
*         ENTRY  (NL) = NEGATIVE FIELD LENGTH.
*                (RLFB) = EJT ORDINAL.
* 
*         EXIT   FILES RETURNED.
* 
*         USES   CN, CN+1, FA, T1, T5, CM - CM+4, FN - FN+4, FS - FS+4. 
* 
*         CALLS  MSR, *0DF*.
* 
*         MACROS EXECUTE, NFA, SFA. 
  
  
 RLF7     LDC    0
 RLFC     EQU    *-1         EST ORDINAL OF INACCESSIBLE DEVICE 
          ZJN    RLF7.1      IF NO INACESSIBLE DEVICE 
          STD    T5 
          LDN    0           FORCE *1RJ* CALL 
          RJM    MSR         PROCESS MASS STORAGE ERROR (NO RETURN) 
  
 RLF7.1   LDC    **          SET JOB TERMINATION MODE 
 RLFB     EQU    *-1         (EJT ORDINAL)
          SFA    EJT         SET JOB TERMINATION MODE 
          ADK    SCHE 
          CRD    FS 
          LDD    FS+2 
          LPC    3000 
          STM    JTFG 
          LMK    NOTM*1000
          NJN    RLF8        IF TERMINATION MODE ALREADY SET
          LDD    TH 
          ERRNZ  1000*NLTM-1000  CODE ASSUMES *NLTM* = 1
          STM    JTFG 
          RAD    FS+2 
          LDM    RLFB 
          SFA    EJT
          ADK    SCHE 
          CWD    FS 
 RLF8     LDD    CP          SET TERMINATION/QUEUED FILE DISPOSITION
          ADK    EOJW 
          CRD    CM 
          LDD    CN+1 
          STM    ITSA        SET QUEUED FILES FLAG
          NJN    RLF9        IF QUEUED FILES PRESENT
          LDM    JBOT 
          LMN    SYOT 
          NJN    RLF9        IF NOT SYSTEM ORIGIN 
          LDD    CP          SET *NOJT* JOB TERMINATION OPTION
          ADK    EOJW 
          CRD    CM 
          LDD    CM 
          LPC    7077 
          LMD    HN 
          ERRNZ  NOJT-1      CODE ASSUMES *NOJT* = 1
          STD    CM 
          LDD    CP          REWRITE END OF JOB STATUS
          ADK    EOJW 
          CWD    CM 
 RLF9     LDD    CM          SET TERMINATION/QUEUED FILE DISPOSITION
          SHN    -6 
          LPN    37 
          RAM    JTFG 
  
 RLF      SUBR               ENTRY/EXIT 
  
*         INITIALIZE FNT SEARCH INDEX AT *FNTN* + *LENF* SO THE 
*         *INPUT* FILE IS NOT RETURNED.  THE *INPUT* FILE 
*         IS ALWAYS THE FIRST FNT ENTRY.
  
          LDK    FNTN        INITIALIZE FNT INDEX 
          STD    CN 
          LDN    0           INITIALIZE QUEUED FILES PRESENT FLAG 
          STD    CN+1 
 RLF1     LDK    LENF        ADVANCE FNT INDEX
          RAD    CN 
          SBD    NL 
          PJP    RLF7        IF END OF FNT-S
          NFA    CN,R        SET FNT ADDRESS
          CRD    FN          READ FNT WORD
          ADN    FSTL        READ FST WORD
          CRD    FS 
          LDD    FN 
          ZJN    RLF1        IF NULL ENTRY
          LDD    FN+4 
          SHN    -6 
          LMK    QFFT 
          NJN    RLF3        IF NOT QUEUED FILE 
 RLF2     AOD    CN+1        SET QUEUED FILE PROCESSED FLAG 
 RLF2.1   UJN    RLF1        PROCESS NEXT FNT ENTRY 
  
 RLF3     SFA    EST,FS      READ EST ENTRY FOR THIS FNT
          ADK    EQDE 
          CRD    CM 
          LDD    CM 
          SHN    21-13
          PJN    RLF5        IF NOT MASS STORAGE
  
*         SEARCH TABLE FOR MATCH ON SPECIAL FILE NAME.
  
          LDC    RLFA-RLFAL  SET TABLE INDEX
          STD    T1 
 RLF4     LDN    RLFAL       ADVANCE TABLE ADDRESS
          RAD    T1 
          LDI    T1 
          ZJN    RLF5.0      IF END OF TABLE (RETURN FILE)
          LMD    FN 
          NJN    RLF4        IF NO MATCH
          LDM    1,T1 
          LMD    FN+1 
          NJN    RLF4        IF NO MATCH
          LDM    2,T1 
          LMD    FN+2 
          NJN    RLF4        IF NO MATCH
          LDM    3,T1 
          LMD    FN+3 
          SCN    77 
          NJN    RLF4        IF NO MATCH
 RLF4.1   UJP    RLF2        SET QUEUED FILE PROCESSED FLAG 
  
 RLF4.2   UJP    RLF2.1      PROCESS NEXT FNT ENTRY 
  
 RLF5     LDD    CM+3 
          LMC    2ROD 
          NJN    RLF5.0      IF NOT OPTICAL DISK FILE 
          LDD    FS+4 
          SHN    21-5 
          MJN    RLF4.1      IF LABELING REQUIRED (DO NOT RETURN) 
 RLF5.0   LDD    CN          SET FNT INDEX
          STD    FA 
          LDN    2           SET *DROP ROFT*, *RETURN* FLAGS FOR *0DF*
          STM    OVL-1
          EXECUTE  0DF,OVL   DROP FILE
          PJN    RLF5.1      IF NO INACCESSIBLE DEVICE ERROR
          LDD    T5 
          STM    RLFC        FLAG MASS STORAGE RECOVERABLE ERROR
 RLF5.1   LDD    CP          CHECK FOR TAPE ACTIVITY
          ADN    STSW 
          CRD    CM 
          LDD    CM+4 
          SHN    -7 
          ZJN    RLF4.2      IF NOT EXCESSIVE ACTIVITY
          LJM    DPP         DROP PP TO WAIT FOR NO ACTIVITY
  
  
 RLFA     VFD    42/0LOUTPUT,6/0
 RLFAL    EQU    *-RLFA 
          VFD    42/0LPUNCH,6/0 
          VFD    42/0LPUNCHB,6/0
          VFD    42/0LP8,6/0
          VFD    42/0LZZZZZOD,6/0  OPTICAL DISK CONTROL FILE
          CON    0           END OF TABLE 
 SCM      SPACE  4,10 
**        SCM - STORE CONVERSIONS IN MESSAGE. 
* 
*         ENTRY  (T4) = MESSAGE COUNT - 1.
*                (A) = LOCATION OF MESSAGE. 
* 
*         USES   T4.
  
  
 SCM      SUBR               ENTRY/EXIT 
          STM    SCMA        SAVE MESSAGE ADDRESS 
 SCM1     LDM    *,T4        GET MESSAGE ADDRESS
 SCMA     EQU    *-1
          ADN    3
          STM    SCMB 
          LDD    MA 
          ADD    T4 
          CRM    *,ON        READ CONVERSIONS 
 SCMB     EQU    *-1
          SOD    T4          DECREMENT MESSAGE COUNT
          PJN    SCM1        IF MORE ACCUMULATORS 
          UJN    SCMX        RETURN 
 SUV      SPACE  4,10 
**        SUV - SET USER VALIDATION LIMITS. 
* 
*         SETS USER VALIDATION LIMITS TO UNLIMITED, EXCEPT
*         FOR THE PRINT, PUNCH AND DEFERRED BATCH OUTPUT LIMITS.
* 
*         USES   CM - CM+4. 
  
  
 SUV      SUBR               ENTRY/EXIT 
          LDD    CP          READ ACCOUNT LIMIT INDEX WORD
          ADK    ALMW 
          CRD    CM 
          LDD    CM+1        SET TAPES, PACKS, LOCAL FILES
          LPN    70 
          LMC    7707 
          STD    CM+1 
          LCN    0           SET TIME, SRU
          STD    CM+2 
          STD    CM+3        SET FL, EXTENDED MEMORY FL 
          LDD    CP          REWRITE ACCOUNT LIMIT INDEX WORD 
          ADK    ALMW 
          CWD    CM 
          ADK    ACLW-ALMW   READ ACCOUNTING LIMITS WORD
          CRD    CM 
          LCN    0           SET DAYFILE MESSAGE LIMIT
          STD    CM+1 
          STD    CM+2        SET COMMAND LIMIT
          STD    CM+4        SET MASS STORAGE PRU LIMIT 
          LDD    CM+3 
          SCN    77 
          LMN    77 
          STD    CM+3 
          LDD    CP          REWRITE ACCOUNTING LIMITS WORD 
          ADK    ACLW 
          CWD    CM 
          UJP    SUVX        RETURN 
 TLD      SPACE  4,10 
**        TLD - TERMINATE *L* DISPLAY.
* 
*         EXIT   *JSN* FIELD OF *L* DISPLAY BUFFER CLEARED IF 
*                IT MATCHES THAT OF JOB WHICH IS TERMINATING. 
* 
*         USES   AB - AB+4, CM - CM+5, CN - CN+4. 
* 
*         MACROS MONITOR, SFA.
  
  
 TLD      SUBR               ENTRY/EXIT 
          SFA    EJT,JO      SET EJT ADDRESS
          ADK    JSNE        READ JSN 
          CRD    CN 
          LDK    LDSP        READ *L* DISPLAY POINTER 
          CRD    AB 
          LDD    AB+2        SET *L* DISPLAY BUFFER ADDRESS 
          STD    CM+3 
          SHN    14 
          LMD    AB+3 
          STD    CM+4 
          CRD    AB          READ *L* DISPLAY BUFFER
          LDD    CN          SET JSN IN *UTEM* PARAMETERS 
          STM    TLDA+3 
          LMD    AB          COMPARE TO *L* DISPLAY JSN 
          NJN    TLDX        IF NO MATCH
          LDD    CN+1 
          STM    TLDA+4 
          LMD    AB+1 
          NJN    TLDX        IF NO MATCH
          LDN    2           SET REQUEST LENGTH 
          STD    CM+1 
          LDN    0
          STD    CM+2 
          LDD    MA          STORE REQUEST PARAMETERS 
          CWM    TLDA,CM+1
          MONITOR  UTEM      CLEAR *JSN* FIELD
          UJP    TLDX        RETURN 
  
  
*         *UTEM* MONITOR FUNCTION BUFFER. 
  
 TLDA     VFD    1/1,5/0,6/24D,6/36D,6/0  VERIFY *JSN*
          CON    0,0,0
          VFD    1/0,5/0,6/24D,6/36D,6/0  CLEAR *JSN* 
          CON    0,0,0
 UPF      SPACE  4,15 
**        UPF - UPDATE PROJECT PROFILE FILE.
* 
*         EXIT   (PFUF) = SET IF PROJECT FILE UPDATE FAILURE
*                         AND MAXIMUM RETRY REACHED.
* 
*         CALLS  DFM, MSR, *0AU*. 
* 
*         USES   RC.
* 
*         MACROS DELAY, EXECUTE, PAUSE, SFA.
  
  
 UPF      SUBR               ENTRY/EXIT 
          LDN    0           INITIALIZE RE-TRY COUNT
          STD    RC 
 UPF1     SFA    EJT,JO      SET EJT ADDRESS
          ADK    JSNE        READ JSN 
          CRM    AUPB,ON
          LDM    JBSC        SET JOB SERVICE CLASS
          SHN    6
          STM    AUPB+4 
          LDD    CP          READ SRU ACCUMULATOR 
          ADK    SRUW 
          CRM    AUPB+5,ON
          ADN    FPFW-SRUW-1
          CRM    OVL,ON 
          LDC    AUPB 
          STM    OVL+1
          LDM    OVL         SET END OF ACCOUNT BLOCK CALL
          SCN    77 
          STM    OVL
          EXECUTE  0AU,OVL+5
          MJP    UPF5        IF MASS STORAGE ERROR
          SBN    2
          NJP    UPFX        IF PROFILE FILE NOT BUSY 
          AOD    RC          INCREMENT AND CHECK RE-TRY COUNT 
          LMN    MTRY+1 
          ZJN    UPF3        IF MAXIMUM RE-TRY COUNT REACHED
          LMN    MTRY+1&IMES
          NJN    UPF2        IF NOT CONSOLE MESSAGE THRESHOLD 
          LDD    CP          CONSOLE MESSAGE
          ADN    MS1W 
          CWM    UPFA,TR
 UPF2     DELAY              DELAY 130 USECS
          PAUSE 
          LDD    CM+1 
          LMN    ORET 
          ZJN    UPF6        IF OVERRIDE SET
          LJM    UPF1        TRY AGAIN
  
 UPF3     STM    OVL+3       CLEAR PROFILE FILE PRESENT 
          EXECUTE  0AU,OVL+5 PROCESS ANY OVERFLOWS
          MJN    UPF5        IF MASS STORAGE ERROR
          LDM    OVL+4       CHECK FOR SRU ACCUMULATOR OVERFLOW 
          SHN    21-0 
          PJN    UPF6        IF NOT SRU OVERFLOW
          LDC    ACFN+UPFB   OVERFLOW MESSAGE 
          RJM    DFM
          UJN    UPF6        RETURN 
  
 UPF5     LDN    0           FORCE *1RJ* CALL 
          RJM    MSR         PROCESS MASS STORAGE ERROR (NO RETURN) 
  
 UPF6     LDN    1           SET UPDATE FAILURE FLAG
          STM    PFUF 
          UJP    UPFX        RETURN 
  
  
 UPFA     DATA   C* WAITING - PROFILE FILE.*
 UPFB     DATA   C*AUSR, 219902.325UNTS.* 
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMPRSS 
          SPACE  4,10 
          USE    OVERLAY
 AUPB     BSS    0           *0AU* PARAMETER BLOCK
 ACCT     EQU    AUPB+5*2    CONTROL POINT AREA ACCUMULATORS
 OVL      EQU    ACCT+3      ZERO LEVEL OVERLAY LOAD ADDRESS
          ERRNG  EPFW-OVL-ZAUL
          ERRNG  BFMS-OVL-ZDFL
          ERRNG  BFMS-*      I/O BUFFER OVERLAYS CODE 
          TITLE  OVERLAID PRESET. 
 PRS      SPACE  4,10 
**        PTR - PRESET JOB TERMINATION. 
* 
*         EXIT   (NL) = NEGATIVE FL.
* 
*         USES   CM - CM+4, CN - CN+4, NL.
* 
*         CALLS  FLF, TLD.
* 
*         MACROS MONITOR. 
  
  
 PTR      SUBR               ENTRY/EXIT 
  
*         SET NO-EXIT FLAG IN CONTROL POINT AREA. 
  
          RJM    TLD         TERMINATE *L* DISPLAY
          LDD    CP          READ ENTRY/EXIT CONTROL WORD 
          ADK    EECW 
          CRD    CM 
          LDD    CM          SET NO-EXIT FLAG 
          LPC    3777 
          ADC    4000 
          STD    CM 
          LDD    CP          REWRITE ENTRY/EXIT CONTROL WORD
          ADK    EECW 
          CWD    CM 
  
*         CLEAR CCL NESTING IN CONTROL POINT AREA.
  
          ADK    JCDW-EECW   READ JOB CONTROL DATA
          CRD    CM 
          LDN    0           CLEAR CCL DATA 
          STD    CM+2 
          LDD    CP          REWRITE JOB CONTROL DATA 
          ADK    JCDW 
          CWD    CM 
  
*         PRESET MISCELLANEOUS DATA.
  
          ADK    FLSW-JCDW   READ NFL CONTROL WORD
          CRD    CN 
          ADK    FLCW-FLSW   READ FL CONTROL WORD 
          CRD    CM 
          ADK    ELCW-FLCW
          CRD    AB 
          ADK    TFSW-ELCW
          CRD    FS 
          LDD    FS          SET EJT ORDINAL
          STM    RLFB 
          LDD    CM+2        SET MFL = MAXFL
          STD    CM 
          LDN    0           CLEAR EM JOB STEP FL 
          STD    AB+1 
          LDD    CP          REWRITE FL CONTROL WORD
          ADK    FLCW 
          CWD    CM 
          ADK    ELCW-FLCW
          CWD    AB 
          LDD    CN          SET NFL
          SHN    6
          STD    NL 
          ZJN    PTR1        IF NFL NOT ASSIGNED
  
*         FLUSH 819 BUFFERS.
  
          RJM    FLF         FLUSH BUFFERS
 PTR1     LJM    PTRX        EXIT 
          SPACE  4,10 
**        EXECUTABLE COMMON DECKS.
  
  
*CALL     COMPFLF 
          OVERFLOW
          TTL    1AJ/3AK - COMPLETE JOB TERMINATION.
          TITLE 
          QUAL   3AK
          IDENT  3AK,CJTX    COMPLETE JOB TERMINATION.
*COMMENT  1AJ - COMPLETE JOB TERMINATION. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       3AK - COMPLETE JOB TERMINATION. 
* 
*         3AK PERFORMS JOB TERMINATION PROCEDURES.
*         THESE INCLUDE - 
* 
*         (1)   RELEASE STORAGE.
*         (2)   RELEASE ASSIGNED EQUIPMENT. 
*         (3)   RELEASE ANY COMMON FILES USED BY JOB. 
*         (4)   DROP ANY SCRATCH FILES USED BY JOB. 
*         (5)   UPDATE THE RESOURCE DEMAND FILE.
*         (6)   REQUEUE THE JOB FOR RERUN IF REQUIRED.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         SYSTEM AND JOB DAYFILES.
* 
*         * JOB RERUN.* = JOB TERMINATED AND INPUT FILE REQUEUED. 
          SPACE  4,10 
***       ACCOUNT DAYFILE MESSAGES. 
* 
* 
*         *AERR, HW.* = JOB WAS RERUN DUE TO A HARDWARE ERROR.
          SPACE  4,10 
***       OPERATOR MESSAGES.
* 
*         * JOB RERUN.* = JOB TERMINATED AND INPUT FILE REQUEUED. 
          SPACE  4,10 
**        ROUTINES USED.
* 
*         *0DF* - DROP FILE.
*         *0BQ* - BEGIN QUEUED FILE.
*         *0RF* - UPDATE RESOURCE FILES.
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 NL       EQU    37          NEGATIVE FL ASSIGNED 
 FN       EQU    40 - 44     FILE NAME (5 LOCATIONS)
 RC       EQU    66          *0AU* RE-TRY COUNT 
          SPACE  4,10 
**        ASSEMBLY CONSTANTS. 
  
  
 IORC     EQU    9D-1        QFT RESERVATION RETRY COUNT
****
          TITLE  MAIN PROGRAM.
 CJT      SPACE  4,10 
**        CJT - MAIN PROGRAM. 
* 
*         ENTRY  (EF)   = ERROR FLAG. 
*                (JO)   = EJT ORDINAL.
*                (JTOP) = JOB TERMINATION OPTION. 
* 
*         USES   CM+1, CM+2.
* 
*         CALLS  DAC, ISE, PRS, RCS, RDF, REQ, RIF, RLF, RLN, RQF, RRJ, 
*                URF. 
* 
*         MACROS MONITOR. 
  
  
          ORG    E1AJ 
 CJT      SUBR               ENTRY/EXIT 
          RJM    PRS         PRESET PROGRAM 
          RJM    RLF         RELEASE LOCAL FILES
          RJM    RIF         RELEASE INPUT FILE 
          RJM    RDF         RELEASE DAYFILE TRACKS 
          RJM    REQ         RELEASE EQUIPMENT
          RJM    URF         UPDATE RESOURCE DEMAND FILE
          RJM    RRJ         RERUN JOB
          RJM    RCS         RELEASE COMMAND FILE 
          RJM    DAC         DECREMENT ACTIVITY COUNTS
          RJM    RQF         RETRY QUEUED FUNCTIONS 
          RJM    RLN         RELEASE NEGATIVE FL
          RJM    ISE         ISSUE SUBSYSTEM TERMINATION EVENT
          LDM    CJTA        CHECK FOR DEADSTART SEQUENCING JOB 
          LMC    DSSI 
          NJN    CJTX        IF NOT DEADSTART SEQUENCING JOB
          LDN    1           CLEAR DEADSTART SEQUENCING FLAG
          STD    CM+1 
          STD    CM+2 
          LDD    MA 
          CWM    CJTB,ON
          MONITOR  UADM 
          UJP    CJTX        RETURN 
  
  
 CJTA     CON    0           SUBSYSTEM ID OF JOB
  
*         PARAMETERS FOR *UADM* FUNCTION. 
  
 CJTB     CON    LDOS        DECREMENT LOW CORE FIELD 
          CON    INWL        WORD ADDRESS 
          CON    15D*100+1   POSITION AND FIELD SIZE
          SPACE  4,10 
**        GLOBAL DATA STORAGE.
  
  
 IFFN     CON    0           INPUT FILE FNT INDEX 
          TITLE  SUBROUTINES
 DAC      SPACE  4,10 
**        DAC - DECREMENT ACTIVITY COUNTS.
* 
*         DECREMENTS THE FAMILY AND PROFILE FILE ACTIVITY 
*         COUNTS. 
* 
*         USES   CM - CM+4, CN - CN+4.
* 
*         MACROS MONITOR, SFA.
  
  
 DAC      SUBR               ENTRY/EXIT 
  
*         DECREMENT FAMILY COUNT. 
  
          LDD    CP          READ FAMILY PROFILE FILE DATA
          ADK    FPFW 
          CRD    CN 
          ADK    PFCW-FPFW   READ PERMANENT FILE CONTROL
          CRD    FN 
          LDD    FN+3        GET FAMILY DEVICE ORDINAL
          ZJN    DAC1        IF NULL FAMILY 
          STD    CM+1 
          LMK    NEEQ 
          ZJN    DAC1        IF NULL EQUIPMENT
          LMK    7777&NEEQ
          ZJN    DAC1        IF NULL FAMILY 
          LDK    DFCS        SET *DECREMENT FAMILY COUNT* FUNCTION
          STD    CM+3 
          MONITOR  SMDM      ISSUE MONITOR REQUEST
*         LDN    0
          STD    FN+3        CLEAR FAMILY DEVICE ORDINAL
          LDD    CP 
          ADK    PFCW 
          CWD    FN 
  
*         DECREMENT DAF USER COUNT. 
  
 DAC1     LDD    CN+2        CHECK PROFILE FILE FNT ORDINAL 
          ZJP    DACX        IF PROFILE FILE NOT ATTACHED 
          SFA    FNT,CN+2    SET FNT ADDRESS
          ADN    FSTG        READ FST ENTRY 
          CRD    CN 
          LDN    ZERL 
          CRD    CM 
          LDD    CN          SET EST ORDINAL
          STD    CM+1 
          LDK    DUCS        SET DECREMENT DAF USER COUNT FUNCTION
          STD    CM+3 
          MONITOR  SMDM      ISSUE MONITOR REQUEST
*         LDN    0
          STD    CN+2        CLEAR PROFILE FILE FNT ORDINAL 
          LDD    CP 
          ADK    FPFW 
          CWD    CN 
          UJP    DACX        RETURN 
 DRF      SPACE  4,10 
**        DRF - DROP FILE.
* 
*         ENTRY  (CN) = INDEX OF FNT ENTRY. 
* 
*         EXIT   (A) .LT. 0 IF MASS STORAGE ERROR OR INACCESSIBLE 
*                           DEVICE PREVENT FILE FROM BEING DROPPED. 
* 
*         USES   FA.
* 
*         CALLS  *0DF*. 
* 
*         MACROS EXECUTE. 
  
  
 DRF      SUBR               ENTRY/EXIT 
          LDD    CN          SET FNT INDEX
          STD    FA 
          LDN    2           SET *DROP ROFT*, *RETURN* FLAGS FOR *0DF*
          STM    OVL-1
          EXECUTE  0DF,OVL
          UJN    DRFX        RETURN 
 ISE      SPACE  4,10 
**        ISE - ISSUE SUBSYSTEM TERMINATION EVENT.
* 
*         WAKE UP SUBSYSTEM POSSIBLY WAITING FOR THIS CONTROL POINT.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 ISE      SUBR               ENTRY/EXIT 
 ISEA     LDN    0
*         LDN    1           (SUBSYSTEM TERMINATION)
          ZJN    ISEX        IF NOT SUBSYSTEM 
          LDK    ZERL        WAKE UP ANY SUBSYSTEM WAITING FOR THIS CP
          CRD    CM 
          LDK    SSWE 
          STD    CM+4 
          MONITOR  EATM 
          UJN    ISEX        RETURN 
 MSR      SPACE  4,15 
**        MSR - MASS STORAGE ERROR PROCESSING.
* 
*         ENTRY  (A) = MASS STORAGE DRIVER RETURN IF .LT. 0.
*                (A) = 0 TO FORCE *1RJ* CALL. 
*                (T5) = EST ORDINAL OF INACCESSIBLE DEVICE. 
* 
*         EXIT   TO *1RJ* IF NOT NON-RECOVERABLE ERROR. 
*                TO CALLER IF NON-RECOVERABLE ERROR.
* 
*         USES   CM+1, IR+4.
* 
*         CALLS  *1RJ*. 
* 
*         MACROS EXECUTE, MONITOR.
  
  
 MSR      SUBR               ENTRY/EXIT 
          SHN    21-12
          MJN    MSRX        IF NON-RECOVERABLE ERROR 
          LDD    T5          SET EQUIPMENT TO WAIT FOR
          STD    IR+4 
          LDN    0           CLEAR JOB ADVANCE
          STD    CM+1 
          MONITOR  JACM 
          EXECUTE  1RJ       RECALL *1AJ* AND ROLL OUT JOB IF POSSIBLE
 RCS      SPACE  4,10 
**        RCS - RELEASE COMMAND TRACKS. 
* 
*         USES   CM - CM+4, CN - CN+4.
* 
*         MACROS MONITOR. 
  
  
 RCS      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR ZERO WORD
          CRD    CN 
          LDD    CP          READ COMMAND POINTER 
          ADK    CSPW 
          CRD    CM 
          LDD    CM+1        SET EOR ON COMMAND FILE
          LPC    3777 
          LMC    4000 
          STD    CM+1 
          LDK    CSBN        SET BUFFER EMPTY 
          STD    CM+3 
          STD    CM+4 
          LDD    CP          REWRITE COMMAND POINTER WORD 
          ADK    CSPW 
          CWD    CM 
          ADK    CSSW-CSPW   READ COMMAND FILE STATUS 
          CRD    CM+1 
          CWD    CN          CLEAR FILE STATUS WORD 
          LDD    CM+1        CHECK FILE SOURCE
          SHN    21-13
          MJN    RCSX        IF INPUT FILE
          LDD    CM+2        CHECK TRACK
          ZJN    RCSX        IF NO TRACKS ASSIGNED
          LDD    CM+1        SET EQUIPMENT
          LPC    777
          LMD    TH          SET RETURN-ON-INACCESSIBLE 
          STD    CM+1 
          MONITOR  DTKM      DROP TRACKS
  
*         NOTE - THE *DTKM* STATUS IS NOT CHECKED.  IF TRACKS CANNOT
*         BE DROPPED ON AN INACCESSIBLE ISHARED DEVICE, THEY WILL JUST
*         BE LEFT RESERVED UNTIL THE NEXT TIME THE DEVICE IS RECOVERED
*         BY *MSM*. 
  
          UJP    RCSX        RETURN 
 RDF      SPACE  4,10 
**        RDF - RELEASE DAYFILE TRACKS. 
* 
*         ENTRY  (NL) = NFL SIZE. 
* 
*         USES   CM+1 - CM+5, CN - CN+4.
* 
*         MACROS MONITOR, NFA.
  
  
 RDF      SUBR               ENTRY/EXIT 
          LDD    NL          CHECK NEGATIVE FL
          ZJN    RDFX        IF NO NFL ASSIGNED 
          LDN    ZERL        CLEAR ZERO WORD
          CRD    CN 
          NFA    DAPN+2      READ DAYFILE BUFFER POINTER
          CRD    CM+1 
          CWD    CN          CLEAR DAYFILE BUFFER POINTERS
          SBN    1
          CWD    CN 
          SBN    1
          CWD    CN 
          LDD    CM+2        CHECK FIRST TRACK
          ZJN    RDFX        IF NO DAYFILE TRACKS ASSIGNED
          LDD    TH          SET RETURN-ON-INACCESSIBLE 
          RAD    CM+1 
          MONITOR  DTKM      DROP TRACKS
  
*         NOTE - THE *DTKM* STATUS IS NOT CHECKED.  IF TRACKS CANNOT
*         BE DROPPED ON AN INACCESSIBLE ISHARED DEVICE, THEY WILL JUST
*         BE LEFT RESERVED UNTIL THE NEXT TIME THE DEVICE IS RECOVERED
*         BY *MSM*. 
  
          UJN    RDFX        RETURN 
 REQ      SPACE  4,10 
**        REQ - RELEASE EQUIPMENT.
* 
*         RELEASES ALL EQUIPMENT AND CHANNELS ASSIGNED
*         TO THE JOB. 
* 
*         USES   T1 - T4, CM - CM+4, CN - CN+4, FS - FS+4.
* 
*         MACROS MONITOR. 
  
  
 REQ      SUBR               ENTRY/EXIT 
          LDD    CP          READ EQUIPMENT ASSIGNED COUNTER
          ADN    EACW 
          CRD    CM 
          LDD    CM 
          ZJN    REQX        IF NO EQUIPMENT ASSIGNED 
          STD    T2          SAVE COUNT OF EQUIPMENT ASSIGNED 
          LDN    ESTP        READ EST POINTER 
          CRD    FS 
          LDN    DSEQ-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T1 
  
*         RELEASE EQUIPMENT ASSIGNED TO JOB.
  
 REQ1     AOD    T1          ADVANCE EST ORDINAL
          STD    CM+1 
          LMD    FS+2 
          ZJN    REQ2        IF ALL EQUIPMENT PROCESSED 
          SFA    EST,T1      READ EQUIPMENT ASSIGNMENT
          ADK    EQAE 
          CRD    CN 
          LDD    CN+4        CHECK IF EQUIPMENT ASSIGNED
          STD    CM+2        NON-ZERO FOR POSSIBLE DOWNED DEVICE
          LMD    JO          COMPARE EJT ORDINALS 
          NJN    REQ1        IF NOT ASSIGNED TO THIS JOB
          MONITOR  DEQM      RELEASE EQUIPMENT
          SOD    T2 
          NJN    REQ1        IF MORE EQUIPMENT TO CHECK 
          LJM    REQ5        CLEAR EQUIPMENT/CHANNEL ASSIGNMENT COUNT 
  
*         SET CHANNEL TABLE POINTERS. 
  
 REQ2     STD    T1          INITIALIZE EJTO TABLE INDEX
          LDK    CHTP        READ CHANNEL TABLE POINTER 
          CRD    CM 
          LDK    CTALL       SET LENGTH OF CHANNEL TABLE
          STD    T4 
          LDD    CM+2        SET FWA OF CTIL TABLE
          SHN    14 
          LMD    CM+3 
          ADK    CTALL       SET FWA OF EJTO TABLE
          CRM    TREQ,T4     READ EJTO TABLE
  
*         RELEASE ALL CHANNELS ASSIGNED TO JOB. 
  
 REQ3     LDM    TREQ,T1     CHECK CHANNEL EJT ASSIGNMENT 
          LMD    JO 
          NJN    REQ4        IF NOT ASSIGNED TO THIS JOB
          STD    CM+4        CLEAR CP ASSIGNMENT IN REQUEST 
          LDD    T1          SET CHANNEL NUMBER 
          STD    CM+3 
          LDN    CCNS        SET SUBFUNCTION
          LDN    CCNS        SET SUBFUNCTION
          STD    CM+2 
          LDD    CP          SET CONTROL POINT NUMBER 
          SHN    -7 
          STD    CM+1 
          MONITOR  SEQM      ISSUE MONITOR REQUEST
          SOD    T2          DECREMENT CHANNEL COUNT
          ZJN    REQ5        IF ALL CHANNELS RELEASED 
 REQ4     AOD    T1          ADVANCE CHANNEL NUMBER 
          SBK    MXCH+1 
          MJN    REQ3        IF NOT END OF EJTO TABLE 
  
*         CLEAR EQUIPMENT/CHANNEL ASSIGNED COUNT IN CP AREA.
  
 REQ5     LDD    CP          READ CP COUNT WORD 
          ADK    EACW 
          CRD    CM 
          LDN    0           CLEAR EQUIPMENT/CHANNEL COUNT
          STD    CM 
          LDD    CP          REWRITE COUNT WORD 
          ADK    EACW 
          CWD    CM 
          LJM    REQX        RETURN 
 RIF      SPACE  4,15 
**        RIF - RELEASE INPUT FILE. 
* 
*         ENTRY  (NL) = NFL SIZE. 
*                (JTOP) = JOB TERMINATION OPTION
*                (IFFN) = INPUT FILE FNT INDEX. 
* 
*         EXIT   INPUT FILE TRACKS RELEASED.
* 
*         USES   CN, CM - CM+4, FS - FS+4.
* 
*         CALLS  *0DQ*. 
* 
*         MACROS EXECUTE, MONITOR, NFA. 
  
  
 RIF      SUBR               ENTRY/EXIT 
          LDD    NL          CHECK NEGATIVE FL
          ZJN    RIFX        IF NO NFL ASSIGNED 
          LDM    JTOP        CHECK TERMINATION OPTION 
          LMK    RJJT 
          ZJN    RIFX        IF JOB TO BE RERUN 
          LMN    HRJT&RJJT
          ZJN    RIFX        IF HARDWARE RERUN
          LMN    SRJT&HRJT
          ZJN    RIFX        IF JOB TO BE RERUN 
          LDM    IFFN        CHECK FNT INDEX
          ZJN    RIFX        IF NO INPUT FILE 
          STD    CN 
          NFA    CN,R        READ INPUT FILE FST
          ADN    FSTL 
          CRD    FS 
          LDN    2           SELECT DROP QUEUE FILE NOT IN QFT
          STM    OVL-1
          LDK    ZERL        CLEAR LOCAL FNT/FST ENTRY
          CRD    CM 
          LDD    CN 
          STD    CM+4 
          LDN    DLFS        DELETE LOCAL FILE ENTRY
          STD    CM+1 
          MONITOR  PLFM 
          EXECUTE  0DQ,OVL   DROP INPUT FILE
  
*         NOTE - THE *DTKM* STATUS IS NOT CHECKED.  IF TRACKS CANNOT
*         BE DROPPED ON AN INACCESSIBLE ISHARED DEVICE, THEY WILL JUST
*         BE LEFT RESERVED UNTIL THE NEXT TIME THE DEVICE IS RECOVERED
*         BY *MSM*. 
  
          LJM    RIFX        RETURN 
 RLF      SPACE  4,15 
**        RLF - RELEASE LOCAL FILES.
* 
*         ENTRY  (NL) = NEGATIVE FL.
* 
*         EXIT   LOCAL FILES RELEASED.
*                (IFFN) = INPUT FILE FNT INDEX. 
*                TO *DPP* IF WAIT FOR TAPE ACTIVITY COMPLETION. 
* 
*         USES   CN, T5, CM - CM+4, FN - FN+4.
* 
*         CALLS  DRF, MSR.
* 
*         MACROS NFA. 
  
  
 RLF4     LDD    CP          CHECK FOR TAPE ACTIVITY
          ADN    STSW 
          CRD    CM 
          LDD    CM+4 
          SHN    -4 
          NJP    RLF2        IF TAPE ACTIVITY OUTSTANDING 
          LDC    0           IF NO MASS STORAGE ERROR 
*         LDC    **          EQUIPMENT IF RECOVERABLE ERROR 
 RLFA     EQU    *-1
          ZJN    RLFX        IF NO RECOVERABLE MASS STORAGE ERROR 
          STD    T5 
          LDN    0           FORCE *1RJ* CALL 
          RJM    MSR         PROCESS MASS STORAGE ERROR 
  
 RLF      SUBR               ENTRY/EXIT 
          LDD    NL          CHECK NEGATIVE FL
          ZJN    RLFX        IF NO NFL ASSIGNED 
          LDK    FNTN-LENF   SET FNT FWA
          STD    CN 
 RLF1     LDK    LENF        ADVANCE FNT INDEX
          RAD    CN 
          SBD    NL 
          PJN    RLF4        IF END OF FNT
          NFA    CN,R        SET FNT ADDRESS
          CRD    FN          READ FNT ENTRY 
          LDD    FN 
          ZJN    RLF1        IF NULL ENTRY
          LDD    FN+4        CHECK FILE TYPE
          SHN    -6 
          LMK    INFT 
          ZJN    RLF3        IF INPUT FILE
          RJM    DRF         DROP FILE
          PJN    RLF1.1      IF NO INACCESSIBLE DEVICE ERROR
          LDD    T5          SET INACCESSIBLE DEVICE EST ORDINAL
          STM    RLFA 
 RLF1.1   LDD    CP          CHECK FOR TAPE ACTIVITY
          ADN    STSW 
          CRD    CM 
          LDD    CM+4 
          SHN    -7 
          ZJN    RLF1        IF NOT EXCESSIVE ACTIVITY
 RLF2     LJM    DPP         DROP PP TO WAIT FOR NO ACTIVITY
  
*         SET INPUT FILE FNT INDEX. 
  
 RLF3     LDD    CN          SET FILE INDEX 
          STM    IFFN 
          UJP    RLF1        LOOP FOR NEXT FILE 
 RLN      SPACE  4,10 
**        RLN - RELEASE NEGATIVE FIELD LENGTH.
* 
*         CALLS  NFL. 
  
  
 RLN      SUBR               ENTRY/EXIT 
          LDD    NL          CHECK NEGATIVE FL ASSIGNED 
          ZJN    RLNX        IF NO NEGATIVE FL ASSIGNED 
          LDN    0           RELEASE NEGATIVE FL
          RJM    NFL
          UJN    RLNX        RETURN 
 RQI      SPACE  4,10 
**        RQI - REQUEUE INPUT FILE. 
* 
*         ENTRY  (BFMS) = INPUT FILE ORIGINAL QFT ENTRY 
*                         IN SYSTEM SECTOR BUFFER.
*                (CM+1) = ORDINAL OF NEW QFT ENTRY. 
*                (CM+3 - CM+4) = CM ADDRESS OF NEW QFT ENTRY. 
* 
*         EXIT   (A) .LT. 0 IF MASS STORAGE ERROR OR INACCESSIBLE 
*                           DEVICE. 
* 
*         USES   FA, CM - CM+4, CN - CN+4.
* 
*         CALLS  WSS. 
* 
*         MACROS ENDMS, SETMS, SFA. 
  
  
 RQI      SUBR               ENTRY/EXIT 
          LDD    CM+1        SET NEW QFT ORDINAL IN SYSTEM SECTOR 
          STM    GQSS 
          LDN    QFTE-1      SET ENTRY SIZE - 1 
          STD    CM+2 
          LDK    RTCL        READ REAL TIME CLOCK 
          CRD    CN 
          LDD    CN          SET QUEUE ENTRY TIME (SECONDS) 
          STM    IOSS+ENTQ*5+3
          LDD    CN+1 
          STM    IOSS+ENTQ*5+4
          LDM    JTOP        CHECK JOB TERMINATION OPTION 
          SBK    HRJT 
          ERRNG  SRJT-HRJT   CODE REQUIRES *SRJT* .GE. *HRJT* 
          MJN    RQI1        IF NOT HARDWARE/SOFTWARE ERROR RERUN 
          LDM    HRSS 
          ADM    SESS 
          LMN    1
          ZJN    RQI1        IF FIRST ATTEMPT 
          LDN    0           SET QUEUE PRIORITY TO ZERO 
          STM    IOSS+ENTQ*5+4
          STM    IOSS+ENTQ*5+3
 RQI1     SFA    QFT,CM+1    GET QFT ENTRY ADDRESS
          ADN    ENTQ        WRITE LAST 3 WORDS OF ENTRY
          CWM    IOSS+ENTQ*5,CM+2 
          LDM    IOSS+JSNQ*5+4  CLEAN UP STATUS FIELD 
          SCN    17 
          STM    IOSS+JSNQ*5+4
          LDD    CM+1        SAVE QFT ORDINAL 
          STD    CN 
          LDN    0           REWRITE SYSTEM SECTOR
          STD    FA 
          SETMS  IO,RW
          RJM    WSS
          MJN    RQI2        IF MASS STORAGE ERROR
          ENDMS 
          SFA    QFT,CN      WRITE FIRST WORD OF THE QFT ENTRY
          CWM    IOSS+JSNQ*5,ON 
*         LDN    0
 RQI2     UJP    RQIX        RETURN 
 RQF      SPACE  4,10 
**        RQF - RETRY QUEUED FUNCTIONS. 
* 
*         ENTRY  (EF) = ERROR FLAG. 
*                (JO) = JOB EJT ORDINAL.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  MSR, PQF.
* 
*         MACROS MONITOR, SFA.
  
  
 RQF      SUBR               ENTRY/EXIT 
          RJM    PQF         PROCESS QUEUED FUNCTIONS 
          LDD    AB 
          ZJN    RQFX        IF NO QUEUED FUNCTIONS REMAIN
          LDD    EF 
          LMK    ORET 
          ZJN    RQFX        IF OPERATOR OVERRIDE REQUESTED 
          LDN    1           CHANGE JOB OWNER TO *SYSTEMX*
          STD    CM+1 
          LDD    MA 
          CWM    RQFA,CM+1
          SFA    EJT,JO 
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          MONITOR  UTEM 
          LDN    0           FORCE *1RJ* CALL 
          RJM    MSR         ROLLOUT IF POSSIBLE
          UJP    RQFX        RETURN 
  
  
 RQFA     VFD    1/0,5/JSNE,6/24D,6/12D,42/01377777 
 RRJ      SPACE  4,10 
**        RRJ - RERUN JOB.
* 
*         ENTRY  (NL) = NFL SIZE. 
* 
*         USES   RC, T5, T6, T8, CM - CM+7. 
* 
*         CALLS  CTE, DFM, MSR, RFI, RIF, RQI, RSS. 
* 
*         MACROS DELAY, ENDMS, MONITOR, NFA, PAUSE, SETMS.
  
  
 RRJ      SUBR               ENTRY/EXIT 
          LDD    NL          CHECK NEGATIVE FL
          ZJN    RRJX        IF NO NFL ASSIGNED 
          LDM    JTOP        CHECK JOB TERMINATION OPTION 
          SBK    RJJT 
          MJN    RRJX        IF NOT SOME TYPE OF RERUN TERMINATION
          ERRNZ  HRJT-RJJT-1 CODE REQUIRES *HRJT* = *RJJT* + 1
          ERRNZ  SRJT-HRJT-1 CODE REQUIRES *SRJT* = *HRJT* + 1
          ERRNZ  NXJT-SRJT-1 CODE ASSUMES *SRJT* IS MAXIMUM RERUN TYPE
          LDM    IFFN 
          ZJN    RRJX        IF NO INPUT FILE 
          NFA    IFFN,R      READ INPUT FILE FST
          ADN    FSTL 
          CRD    CM 
          LDD    CM          SET INPUT FILE EQUIPMENT 
          STD    T5 
          LDD    CM+1        SET FIRST TRACK
          STD    T6 
          ZJN    RRJ1        IF NO TRACKS ASSIGNED
          SETMS  IO          SET MASS STORAGE 
*         LDN    0           OMIT FILE NAME COMPARE 
          RJM    RSS         READ SYSTEM SECTOR 
          ZJN    RRJ2        IF NO ERRORS 
          MJP    RRJ9        IF MASS STORAGE ERROR
 RRJ1     UJP    RRJ4        PROCESS NO RERUN SITUATION 
  
 RRJ2     ENDMS 
          LDN    ZERL        CLEAR INPUT FILE FST 
          CRD    CM+3 
          NFA    IFFN,R 
          ADN    FSTL 
          CWD    CM+3 
          LDD    CM+3        INDICATE NO INPUT FILE 
          STM    IFFN 
  
*         RESERVE NEW QFT ENTRY FOR INPUT FILE. 
  
          LDK    IORC        SET RETRY COUNT
          STD    RC 
          LDN    7           SET FLAGS FOR NEW QFT ENTRY
          STD    CM+7 
          LDM    JTOP 
          SBK    RJJT-1      SET INDEX
          STD    T8 
 RRJ3     LDC    PQFT+10000  REQUEST QFT ENTRY WITH NO JSN
          RJM    CTE
          LDD    CM+3        CHECK ADDRESS ASSIGNED 
          ADD    CM+4 
          NJN    RRJ5        IF ENTRY ASSIGNED
          SOD    RC          DECREMENT RETRY COUNT
          MJN    RRJ4        IF RETRY LIMIT EXCEEDED
          DELAY              DELAY 130 USECS
          PAUSE 
          LDD    CM+1        CHECK ERROR FLAG 
          NJN    RRJ4        IF ERROR FLAG PRESENT
          UJN    RRJ3        RETRY
  
 RRJ4     LDN    TJJT        RESET JOB TERMINATION OPTION 
          STM    JTOP 
          RJM    RIF         RELEASE INPUT FILE 
          LDN    0
          STD    T8          SELECT JOB NOT RERUN DAYFILE MESSAGE 
          UJN    RRJ7        ISSUE MESSAGE
  
 RRJ5     LDC    FLSS        SET QFT FILE SIZE INDEX
          RJM    RFI
          LDD    T8 
          SHN    -1 
          ZJN    RRJ6        IF NOT HARDWARE/SOFTWARE RERUN 
          LDN    ACFN/10000  SET ACCOUNT FILE PARAMETER 
          RAM    RRJA 
          AOM    HRSS-HRJT+RJJT-1,T8
          ERRNZ  HRJT-RJJT-1 CODE REQUIRES *HRJT* = *RJJT* + 1
          ERRNZ  SESS-HRSS-1 CODE REQUIRES *SESS* = *HRSS* + 1
          SBM    RRJC-HRJT+RJJT-1,T8
          MJN    RRJ6        IF RERUN LIMIT NOT EXCEEDED
          LDK    HRIE-HRJT+RJJT-1 
          ADD    T8 
          STM    JASS        SET JOB ABORT CODE 
          LDN    0           SET JOB NOT RERUN
          STD    T8 
          ERRNZ  SWIE-HRIE-1 CODE REQUIRES *SWIE* = *HRIE* + 1
 RRJ6     RJM    RQI         REQUEUE INPUT FILE 
          MJN    RRJ8        IF MASS STORAGE ERROR
 RRJ7     LDM    RRJB,T8     ISSUE MESSAGE
          LMC    0
*         LMC    ACFN        HARDWARE/SOFTWARE RERUN
 RRJA     EQU    *-2
          RJM    DFM
          LJM    RRJX        RETURN 
  
 RRJ8     LDK    PQFT        RETURN QFT ENTRY 
          STD    CM+2 
          MONITOR  MTRM 
 RRJ9     LDM    RDCT        GET ERROR STAUS
          RJM    MSR         PROCESS MASS STORAGE ERROR 
          LJM    RRJ4        RELEASE INPUT FILE 
  
 RRJB     CON    =C* JOB NOT RERUN.*
          CON    =C* JOB RERUN.*
          CON    =C*AERR, HW.*
          CON    =C*AERR, SW.*
  
 RRJC     CON    HRTL+1 
          CON    MSER+1 
 URF      SPACE  4,10 
**        URF - UPDATE RESOURCE DEMAND FILE.
* 
*         EXIT   RESOURCE DEMAND FILE ENTRY CLEARED.
* 
*         USES   FA, FS+1, AB - AB+4. 
* 
*         CALLS  MSR, *0RF*.
* 
*         MACROS EXECUTE. 
  
  
 URF      SUBR               ENTRY/EXIT 
          LDD    CP          READ RESOURCE CONTROL WORD 
          ADK    RFCW 
          CRD    AB 
          LDD    AB+3        CHECK DEMAND FILE RANDOM INDEX 
          LPN    77 
          ADD    AB+4 
          ZJN    URFX        IF NO RANDOM INDEX 
          LDN    0
          STD    FA          SET NO FNT ENTRY 
          STD    AB+3        CLEAR DEMAND FILE RANDOM INDEX 
          STD    AB+4 
          LDN    4
          STD    FS+1        CLEAR RESOURCE DEMAND FILE ENTRY 
          EXECUTE  0RF,OVL
          PJN    URF1        IF NO INACCESSIBLE DEVICE ERROR
          LDN    0           FORCE *1RJ* CALL 
          RJM    MSR         PROCESS MASS STORAGE ERROR 
 URF1     LDD    CP          CLEAR RESOURCE CONTROL WORD
          ADK    RFCW 
          CWD    AB 
          UJN    URFX        RETURN 
          SPACE  4,10 
**        EXECUTABLE COMMON DECKS.
  
  
*CALL     COMPCTE 
*CALL     COMPNFL 
          PROQF  NL          PROCESS QUEUED FUNCTIONS 
*CALL     COMPRFI 
*CALL     COMPRSS 
*CALL     COMPWSS 
          ERRNG  BFMS-* 
          SPACE  4,10 
          USE    OVERLAY
 TREQ     BSSZ   CTALL*5     CHANNEL STATUS TABLE BUFFER
 OVL      EQU    TREQ+3      ZERO LEVEL OVERLAY LOAD ADDRESS
          ERRNG  BFMS-OVL-ZDFL  CHECK LENGTH OF *0DF* 
          ERRNG  BFMS-OVL-ZDQL  CHECK LENGTH OF *0DQ* 
          ERRNG  BFMS-OVL-ZRFL  CHECK LENGTH OF *0RF* 
          TITLE  OVERLAID PRESET. 
 PRS      SPACE  4,10 
**        PRS - PRESET. 
* 
*         ENTRY  (JO) = EJT ORDINAL.
* 
*         EXIT   (NL) = NEGATIVE FL.
* 
*         USES   T0, CM - CM+4, CN - CN+4, FN - FN+4. 
* 
*         CALLS  TSS. 
* 
*         MACROS SFA. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADK    EOJW        READ END OF JOB CONTROL WORD 
          CRD    CM 
          STD    T0          SAVE ADDRESS 
          ADK    FLSW-EOJW   READ FL CONTROL WORD 
          CRD    CN 
          ADK    JCIW-FLSW   READ SUBSYSTEM ID
          CRD    FN 
          LDD    FN+2 
          STM    CJTA 
          LDD    CN          SET NFL
          SHN    6
          STD    NL 
          LDD    CM          SET TO NOT QUEUE OUTPUT
          SHN    -6 
          SCN    7
          ADN    NOJT 
          SHN    6
          STD    CM 
          LDD    T0          UPDATE END OF JOB CONTROL WORD 
          CWD    CM 
          SFA    EJT,JO      GET SERVICE CLASS FROM EJT 
          ADK    //SCLE 
          CRD    CM 
          LDD    CM 
          SHN    -6 
          LMN    SSSC 
          NJN    PRS1        IF NOT SUBSYSTEM 
          AOM    ISEA        SET SUBSYSTEM FLAG 
          RJM    TSS         PROCESS SUBSYSTEM TERMINATION
 PRS1     UJP    PRSX        RETURN 
          TITLE  OVERLAID PRESET SUBROUTINES. 
 TSS      SPACE  4,10 
**        TSS - PROCESS SUBSYSTEM TERMINATION.
* 
*         IF THE JOB IS A SUBSYSTEM, CLEARS THE SUBSYSTEM FROM
*         THE SUBSYSTEM ACTIVITY TABLE AND SETS THE SUBSYSTEM 
*         INACCESSIBLE IN THE SUBSYSTEM CONTROL TABLE.
* 
*         ENTRY  (CJTA) = SUBSYSTEM ID. 
* 
*         CALLS  AST. 
  
  
 TSS      SUBR               ENTRY/EXIT 
          LDM    CJTA        GET SUBSYSTEM ID 
          SBK    LSSI+1 
          MJN    TSSX        IF NOT SUBSYSTEM 
          LDC    PLSI        CHECK FOR CYBIS
          LMM    CJTA 
          NJN    TSS1        IF NOT CYBIS 
          LDC    FEAF*10000  FETCH *SSAT* ENTRY (EJT ORDINAL) 
          ADM    CJTA 
          RJM    AST
          LMD    JO          CHECK IF CURRENT JOB 
          NJN    TSSX        IF NO MATCH, DONT UPDATE TABLES
  
 TSS1     LDC    CEAF*10000  SET *CLEAR SSAT ENTRY* REQUEST 
          ADM    CJTA 
          RJM    AST         CLEAR SSAT ENTRY 
          LDC    CSCF*10000  CLEAR SUBSYSTEM ACCESSIBLE FLAG IN SSCT
          ADM    CJTA 
          RJM    AST
          UJP    TSSX        RETURN 
          SPACE  4,10 
**        ASSEMBLY OPTIONS FOR OVERLAID COMMON DECKS. 
  
  
 AST$     EQU    1           ASSEMBLE TABLE UPDATE CODE (COMPAST) 
          SPACE  4,10 
**        OVERLAID COMMON DECKS.
  
  
*CALL     COMPAST 
          OVERFLOW
 3AM      TTL    1AJ/3AM - TCS ERROR PROCESSOR. 
 ERR      TITLE  MAIN ROUTINE.
          QUAL   ERR
          IDENT  3AM,ERRX    TCS ERROR PROCESSOR. 
*COMMENT  1AJ - TCS ERROR PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       3AM - TCS ERROR PROCESSOR.
* 
*         *3AM* PROCESSES ERROR MESSAGES AND TERMINATION PROCESSING 
*         FOR *TCS*.
          SPACE  4
          ORG    /TCS/EOVL+5
 ERR      SPACE  4,10 
**        ERR - PROCESS ERROR MESSAGE.
* 
*         ENTRY  (EF) = ERROR MESSAGE ADDRESS.
*                (EP) = CALL FLAG, 0 = *TCS* CALL.
*                (AB - AB+4) = CENTRAL LIBRARY DIRECTORY NAME 
*                              IF *EM26*. 
* 
*         EXIT   TO *DPP*, *IST* OR *RCA8* IF NOT *SSJ=* REQUEST. 
*                TO */3AF/RFJ* IF TO RESTORE *SSJ=* JOB.
*                TO *PPR* IF *LDR* CALL.
* 
*         CALLS  AKW, CAT, DFM, IPL, RAS, *3AF*.
  
  
 ERR      SUBR               ENTRY
          LDD    EP 
          ZJN    ERR1        IF *TCS* CALL
          LJM    ERR9        PROCESS *LDR* CALL 
  
 ERR1     LDD    EF 
          STM    ERRA 
          LMC    EM06 
          NJN    ERR2        IF NOT *CHARGE COMMAND REQUIRED.*
          LDC    4000        SET EOR
          STD    SP+1 
          LDD    SP+4        SET BUFFER EMPTY 
          STD    SP+3 
          LDD    CP          STORE COMMAND POINTER
          ADN    CSPW 
          CWD    SP 
 ERR2     LDD    AB+3        INSURE NAME ENDS WITH A ZERO 
          SCN    77 
          STD    AB+3 
          LDN    0
          STD    AB+4 
          LDD    MA          COPY CENTRAL LIBRARY DIRECTORY NAME
          CWD    AB 
          CRM    EM26+15,ON 
          RJM    /TCS/IPL    CLEAR *EECW* AND *TIAW*
          LDN    ZERL 
          CRD    CM 
          STM    /TCS/TCSF
          LMC    CWDI+10
          NJN    ERR2.1      IF *SHELL* ABORT OPTION NOT SET
          NFA    SHCN 
          CWD    CM 
 ERR2.1   LDD    FL 
          ZJN    ERR3        IF NO FL 
          LDD    RA 
          SHN    6
          ADN    ARGR 
          CWD    CM 
 ERR3     RJM    /TCS/CAT    CLEAR ADDRESS FOR *TCS* EXECUTE COMMAND
          ADN    SPCW-RFCW
          CRD    CM 
          LDD    CM 
          ZJN    ERR4        IF NOT SPECIAL REQUEST 
          LDD    CM 
          LMN    77 
          NJN    ERR3.1      IF NOT A COMMAND CALL
          STM    /TCS/ISDA   ISSUE DAYFILE MESSAGE VIA *DFM*
          LDC    STMT 
          RJM    /TCS/ISD 
 ERR3.1   LDD    CP          UPDATE COMMAND POINTER 
          ADN    CSPW 
          CWD    SP 
          LDD    EF          ISSUE MESSAGE
          RJM    DFM
          LDN    PPET        SET ERROR FLAG 
          STD    CM+1 
          MONITOR  CEFM 
          RJM    /TCS/RAS    RESET AFTER *SSJ=* JOB 
          EXECUTE  3AF
          LJM    /3AF/RFJ    RESET FORMER JOB 
  
 ERR4     LDM    /TCS/CSEB
          SHN    21-3 
          PJN    ERR5        IF SDM= NOT PRESENT
          SHN    3+1
          SCN    10          CLEAR SDM= 
          STM    /TCS/CSEB
          RJM    /TCS/AKW    ASSEMBLE KEYWORD 
          LDN    0           CLEAR END OF PROGRAM NAME
          STD    AB+4 
          STM    STMT+5*5    PREVENT ISSUING REMAINDER OF MESSAGE 
          LDD    MA 
          CWD    AB 
          CRM    STMT,ON
 ERR5     LDD    IR+2 
          SBN    4
          ZJN    ERR7        IF COMMAND READ
          SBN    5-4
          ZJN    ERR6        IF COMMAND EXECUTE FROM CM 
          ADN    5-2
          NJN    ERR6        IF NOT *DIS* CALL
          LDD    IR+4        CHECK CALL 
          SHN    21-2 
          MJN    ERR8        IF *DIS* X. CALL 
 ERR6     LJM    /TCS/IST    ISSUE COMMAND
  
 ERR7     LJM    /TCS/RCA8   CLEAR COMMAND BUFFER 
  
 ERR8     LDN    MS2W-MS1W   COMMAND TO MESSAGE AREA 1
          STD    T1 
          LDD    CP 
          ADN    MS1W 
          CWM    STMT,T1
          CWM    *,TR        STATUS MESSAGE TO MESSAGE AREA 2 
 ERRA     EQU    *-1
          LJM    /TCS/DPP    DROP PP
  
*         PROCESS *LDR* ERRORS. 
  
 ERR9     LDC    CPON        ISSUE MESSAGE TO CP DAYFILE
          LMD    EF 
          RJM    DFM
          MONITOR  ABTM 
          LJM    PPR         RETURN TO RESIDENT 
          SPACE  4
*         ERROR MESSAGES. 
  
  
 EM01     DATA   C* FL BEYOND MFL.* 
 EM02     DATA   C* FL TOO SHORT FOR PROGRAM.*
 EM03     DATA   C* FORMAT ERROR ON COMMAND.* 
 EM04     DATA   C* INTERACTIVE JOB STEP, DUMP DISABLED.* 
 EM05     DATA   C* INCORRECT COMMAND.* 
 EM06     DATA   C* CHARGE COMMAND REQUIRED.* 
 EM07     DATA   C* RESERVED.*
 EM08     DATA   C* RESERVED.*
 EM09     DATA   C* SECURE MEMORY, DUMP DISABLED.*
 EM10     DATA   C* TCS INCORRECT REQUEST.* 
 EM11     DATA   C* TOO MANY ARGUMENTS.*
 EM12     DATA   C* LDR - ENTRY POINT NOT FOUND.* 
 EM13     DATA   C* IEDIT BUFFER ERROR.*
 EM14     DATA   C* GLOBAL LIBRARY DIRECTORY NOT FOUND.*
 EM15     DATA   C* I/O SEQUENCE ERROR.*
 EM16     DATA   C* ZZZZZLD NOT ON MASS STORAGE.* 
 EM17     DATA   C* GLOBAL LIBRARY DIRECTORY DEFECTIVE.*
 EM18     DATA   C* USER LIBRARY NOT ON MASS STORAGE.*
 EM19     DATA   C* USER LIBRARY NOT FOUND.*
 EM20     DATA   C* INCORRECT LOAD ADDRESS.*
 EM21     DATA   C* FLE TOO SHORT FOR LOAD.*
 EM22     DATA   C* UNIDENTIFIED PROGRAM FORMAT.* 
 EM23     DATA   C* UNRECOVERED MASS STORAGE ERROR.*
 EM24     DATA   C* OVERLAY LOST.*
 EM25     DATA   C$ *SHELL* PROGRAM NOT FOUND.$ 
 EM26     DATA   C* SYSTEM ROUTINE MISSING - XXXXXXX   *
 EM27     DATA   C* PROGRAM FILE EMPTY.*
  
  
          OVERFLOW  /TCS/EOVL+5,/TCS/ECC
          TTL    1AJ - ADVANCE JOB STATUS.
          END 
