Retro1.org codex

          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