Retro1.org codex

          IDENT  CPM,CPM 
          PERIPH
          BASE   MIXED
          SST
          SYSCOM
*COMMENT  CPM - CONTROL POINT MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  CPM - CONTROL POINT MANAGER.
          SPACE  4,10
***       CPM - CONTROL POINT MANAGER.
*         G. R. MANSFIELD.   70/10/20.
*         M. E. MADDEN.      73/04/24.
*         R. A. JAPS.        76/12/03.  (RESEQUENCED)
          SPACE  4,10
***              *CPM* IS A GENERAL PP PROGRAM TO BE USED BY CPU
*         PROGRAMS TO REFERENCE OR ALTER JOB CONTROL INFORMATION IN
*         THE CONTROL POINT AREA.
          SPACE  4,10
***       CALL.
*
*
*T        18/  *CPM*,6/  AR,12/  CODE,24/  PARAM
*         AR     AUTO RECALL
*         CODE   FUNCTION CODE
*         PARAM  PARAMETER FOR FUNCTION
*
*         NOTE - *CPUMTR* WILL PROCESS THE FOLLOWING *CPM* FUNCTIONS-
*                16, 24, 25, 32, 33, 37, 43, 45, 50, 55, 61 - 72.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*
*         * CM NOT VALIDATED.* = AN ATTEMPT WAS MADE TO CHANGE THE JOB
*         CM LIMIT OUTSIDE OF THE USER-S LEGAL BOUNDS.
*
*
*         * CM RANGE EXIT MODE NOT DESELECTABLE.* = USER
*         SELECTION/DESELECTION OF *CM RANGE* MODE ERRORS IS NOT
*         POSSIBLE ON THE CYBER 176.
*
*
*         * CPM - ACCESS LEVEL NOT VALID FOR JOB.*
*         A USER ATTEMPTED TO CHANGE THE JOB ACCESS LEVEL TO A VALUE
*         FOR WHICH THE JOB IS NOT VALIDATED.
*
*
*         * CPM - ARGUMENT ERROR.*
*         CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
*         1. ADDRESS OUT OF RANGE.
*         2. INCORRECT EXIT MODE SPECIFIED. (FUNCTION 2).
*         3. EVENT DESCRIPTOR SPECIFIED HAS EST ORDINAL GREATER THAN
*            777B, OR A MULTIPLIER GREATER THAN 77B.  (FUNCTION 6).
*         4. USER INDEX IS OUT OF RANGE.  (FUNCTION 21).
*         5. INCORRECT SUBSYSTEM SPECIFIED.  (FUNCTION 26).
*         6. INCORRECT CPU SELECTION.  (FUNCTION 31).
*         7. INCORRECT BYTE COUNT, INCORRECT BYTE POSITION OR INCORRECT
*            BUFFER ADDRESS TO RECEIVE VERSION NAME.  (FUNCTION 44).
*         8. CM REQUESTED WAS MORE THAN 377700B WORDS.
*            (FUNCTIONS 23 AND 52).
*         9. USER JOB NAME, OUTPUT DISPOSITION OPTION, OR
*            END OF JOB OPTION INCORRECT.
*         10. INCORRECT SUBFUNCTION SPECIFIED.  (FUNCTION 107)
*
*
*         * CPM - INCORRECT PACKNAME.*
*         1. AN INCORRECT PACKNAM HAS BEEN SPECIFIED.
*         2. AN INCORRECT DEVICE TYPE HAS BEEN ENTERED ON A *PACKNAM*.
*
*
*         * CPM - INCORRECT REQUEST.*
*         CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
*         1. INCORRECT SUBFUNCTION. (FUNCTION 3).
*         AN *SSM=* JOB ATTEMPTED TO CLEAR THE SECURE
*         SYSTEM MEMORY FLAG.
*
*
*         * CPM - INCORRECT *SHELL* FILE.*
*         1. *SHELL* FILE NOT ON MASS STORAGE.
*         2. *SHELL* FILE NOT FOUND IN THE LOCAL FNT AND THE LOCAL
*            FILE LOAD OPTION WAS SELECTED.
*
*
*         * CPM - USER ACCESS NOT VALID.*
*         CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
*         1. USER NOT VALIDATED FOR SPECIFIED SUBSYSTEM (FUNCTION 26).
*         2. USER NOT VALIDATED TO PROTECT EXTENDED MEMORY
*            (FUNCTION 75).
*         3. USER NOT VALIDATED TO SET PAUSE BIT (FUNCTION 100).
*         4. USER DOES NOT HAVE SYSTEM ORIGIN PRIVILEGES - NO STATUS
*            REQUESTED (FUNCTION 101).
*         5. THE *L* DISPLAY JSN FIELD IS NOT INTERLOCKED
*            (FUNCTIONS 102 AND 103).
*
*
*         * CPM - LIBRARY NOT FOUND = LNAME.*
*         THE INDICATED LIBRARY *LNAME* WAS NOT FOUND IN THE
*         SYSTEM DIRECTORY OR IN THE LOCAL FNT OF THE CALLER.
*
*
*         * CPM - MASS STORAGE ERROR.*
*         A MASS STORAGE ERROR WAS ENCOUNTERED WHEN PERFORMING I/O
*         ON A DEVICE.
*
*
*         * CPM - MISSING *SHELL* LOAD OPTION.*
*         WHEN SETTING THE *SHELL* CONTROL FIELD IN NFL AT LEAST
*         ONE LOAD OPTION FLAG MUST BE SET.
*
*
*         * CPM - EPILOGUE AND SHELL CONFLICT.*
*         AN EPILOGUE WAS PENDING AT THE TIME AN ATTEMPT WAS MADE TO
*         ACTIVATE A *SHELL* PROGRAM WITH THE NO-ABORT OPTION SET.
*
*
*         * CPM - SYSTEM ERROR.*
*         1. *CPM* WAS UNABLE TO READ THE JOB INPUT FILE.
*            (FUNCTION 106 - SET JOB CHARACTERISTICS).
*         2. *CPM* ENCOUNTERED A PROBLEM (OTHER THAN A READ) WITH THE
*            SYSTEM SECTOR.
*
*
*         * EC NOT VALIDATED.* = AN ATTEMPT WAS MADE TO CHANGE THE JOB
*         EC LIMIT OUTSIDE OF THE USER-S LEGAL BOUNDS.
*
*
*         * ERROR ON FILE - PROFILX.* = ONE OF THE FOLLOWING OCCURRED-
*                1) BAD PROFILE FILE LEVEL-3 BLOCK RANDOM ADDRESS.
*                2) PROFILE FILE NOT FOUND.
*               (THIS MESSAGE ALSO ISSUED TO ERROR LOG).
*
*
*         * INCORRECT APPLICATION ACCOUNTING REQUEST.*
*         CAN INDICATE ONE OF THE FOLLOWING CONDITIONS, ALL
*         ARE FROM FUNCTION 77 -
*         1. NOT CALLED FROM VALID PROGRAM.
*         2. INCORRECT PARAMETER WORD.
*
*
*         * INCORRECT USER COMMAND.*
*         AN ATTEMPT WAS MADE TO ENTER A SECONDARY USER COMMAND
*         TO A DIFFERENT FAMILY WHEN SUCH COMMANDS WERE DISABLED,
*         OR AN INCORRECT OR EXPIRED PASSWORD WAS ENTERED.
*
*
*         * INCORRECT END OF JOB OPTION SPECIFIED.*
*         A BATCH JOB ENTERED A *SETJOB,OP=SU.*.  OP=SU
*         IS INCORRECT FOR NON-INTERACTIVE JOBS.  THIS IS A
*         NON-FATAL ERROR.  NO CHANGES ARE MADE TO ANY
*         ARGUMENTS (UJN, DC, OP).
*
*
*         * MFL REQUEST TOO SMALL, MINIMUM USED.*
*         AN ATTEMPT WAS MADE TO *SETMFL* TO A FIELD LENGTH SMALLER
*         THAN *CTFL*, THE FIELD LENGTH OF *CONTROL*.  *CTFL* WAS USED
*         INSTEAD.
*
*
*         * RFL BEYOND MFL.* = RFL REQUEST EXCEEDS MFL.
*
*
*         * STACK PURGING NOT DESELECTABLE.*
*         STACK PURGING IS SELECTABLE/DESELECTABLE ONLY ON CYBER
*         170-8X5 MAINFRAMES.
*
*
*         * TL NOT VALIDATED.* = AN ATTEMPT WAS MADE TO CHANGE THE JOB
*         TIME LIMIT OUTSIDE OF THE USER-S LEGAL BOUNDS.
*
*
*         * USER SECURITY COUNT EXHAUSTED.*
*         THE USER HAS EXCEEDED THE SECURITY COUNT.  THE USER MUST
*         CONTACT SITE PERSONNEL TO HAVE THE SECURITY COUNT RESET.
*         THE USER WILL NOT BE ALLOWED ACCESS TO THE SYSTEM UNTIL
*         THE SECURITY COUNT IS RESET.
          SPACE  4,10
***       ACCOUNT FILE MESSAGES -
*
*
*         *UDOD, 000000.000KUNS.* = OPTICAL DISK ACTIVITY (KILO-UNITS).
*
*         *UDAC, 000000.000UNTS.* = APPLICATION UNIT CHARGE (UNITS).
*
*         *UDMP, 000000.000KUNS.* = MAP III ACTIVITY (KILO-UNITS).
*
*         *UDCO, 000000.000KCHS.* = TERMINAL CHARACTERS OUTPUT.
*
*         *UDCI, 000000.000KCHS.* = TERMINAL CHARACTERS INPUT.
*
*         *UDCT, 000000.000KCHS.* = TOTAL TERMINAL CHARACTERS.
*
*         *UDAD, 000000.000KUNS.* = APPLICATION UNITS (KILO-UNITS).
*
*         *UDPF, 000000.000KUNS.* = PERMANENT FILE ACTIVITY(KILO-UNITS)
*
*         *UDMT, 000000.000KUNS.* = MAGNETIC TAPE ACTIVITY (KILO-UNITS).
*
*         *UDMS, 000000.000KUNS.* = MASS STORAGE ACTIVITY (KILO-UNITS).
*
*         *UDCP, 000000.000SECS.* = ACCUMULATED CP TIME (SECONDS).
*
*         *ACSR, 000000.000UNTS.* = ACCUMULATED SRUS (UNITS).
*
*         NOTE - THE PRECEDING MESSAGES ARE ISSUED IN THE ABOVE ORDER.
*
*
*         *ABCN, CHARGENUMBER, PROJECTNUMBER.* = BEGINNING OF A
*         CHARGE SEQUENCE.
*
*         *ACCN, CHARGENUMBER, PROJECTNUMBER.* = CHANGE OF CHARGE.
*
*         *ACSC, SC, NEWJSN, SRUUNITS.* =  SERVICE CLASS CHANGE.
*         NEWJSN IS PRESENT IF CHANGING FROM SUBSYSTEM SERVICE CLASS.
*
*         *APPN, PACKNAM.* = DEFAULT PACK NAME ENTERED.
*
*         *APPN.* = DEFAULT PACK NAME CLEARED.
*
*         *AUSR, 000000.000UNTS.* = ACCUMULATED SRU-S (UNITS) NOT
*         UPDATED INTO PROJECT PROFILE FILE.
*
*         *MJJI, OLDLEVEL, NEWLEVEL.* = DENOTES AN INCORRECT ATTEMPT
*         BY THE USER TO CHANGE THE JOB ACCESS LEVEL FROM LEVEL
*         *OLDLEVEL* TO LEVEL *NEWLEVEL*.
*
*         *SIUN, USERNUM.* = AN ATTEMPT WAS MADE TO ENTER A
*         SECONDARY USER COMMAND WHEN DISALLOWED, OR THE
*         ACCOUNT/PASSWORD WAS INCORRECT.
*
*         *UBAU, XXXX.* = BEGIN APPLICATION ACCOUNTING FOR
*         APPLICATION XXXX.
          SPACE  4,10
***       ERROR LOG MESSAGES.
*
*         *MAINTENANCE ACCESS BY UN = XXXXXXX.* = A USER HAS LOGGED IN
*         WITH MAINTENANCE PRIVILEGES.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*
*         +REQUEST *K* DISPLAY.+ = B-DISPLAY MESSAGE INDICATING
*         THAT CONTROL POINT IS REQUESTING OPERATOR TO ASSIGN THE
*         K-DISPLAY TO THE CONTROL POINT.
          SPACE  4,10
**        ROUTINES CALLED.
*
*
*         0AU - ACCOUNTING UPDATE.
*         0AV - ACCOUNT VALIDATION.
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPMAC
*CALL     COMSACC
          QUAL   BIO
*CALL     COMSBIO
          QUAL   *
*CALL     COMSCPS
*CALL     COMSEJT
          QUAL   EVENT
*CALL     COMSEVT
          QUAL   *
*CALL     COMSJCE
*CALL     COMSMLS
*CALL     COMSMSC
*CALL     COMSMSP
*CALL     COMSLFD
*CALL     COMSPIM
*CALL     COMSPRD
*CALL     COMSPRO
*CALL     COMSREM
*CALL     COMSSSE
*CALL     COMSSSJ
*CALL     COMSVER
*CALL     COMSZOL
          SPACE  4,10
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 PA       EQU    T1          POT ADDRESS
 T8       EQU    16          SCRATCH
 T9       EQU    17          SCRATCH
 CN       EQU    20 - 24     CM WORD BUFFER (5 LOCATIONS)
 OT       EQU    25          JOB ORIGIN TYPE
 SM       EQU    26          SYSTEM SECURITY MODE
 FN       EQU    30 - 34     FAMILY NAME (5 LOCATIONS)
 PP       EQU    FN+3        POT POINTER
 TN       EQU    FN+4        TERMINAL NUMBER
 TT       EQU    35          TERMINAL TABLE ADDRESS (FOR STA)
 TA       EQU    36          IAF RA (FOR STA)
 UN       EQU    40 - 44     USER NAME (5 LOCATIONS)
 EP       EQU    57          ENTRY POINTS
 BA       EQU    60 - 64     SCRATCH
 RC       EQU    65          RECALL COUNT
 FA       EQU    RC          LOCAL FNT POINTER
 RI       EQU    66 - 67     PROFILE FILE RANDOM ADDRESS
 
 
**        ASSEMBLY CONSTANTS.
 
 
 MRCL     EQU    5           MAXIMUM RECALL COUNT (MUST BE .LT. 100B)
****
          TITLE  MACRO DEFINITIONS.
 ABORT    SPACE  4,10
**        ABORT - ERROR PROCESSING MACRO.
*
*         ABORT  PARAM
*
*         ENTRY  PARAM = 6/DFOP, 12/ADDR.
*                DFOP = 0 FOR MESSAGE TO USER AND SYSTEM
*                       DAYFILE.
*                     = *ERLN* FOR MESSAGE TO ERROR LOG,
*                       USER, AND SYSTEM DAYFILE.
*                ADDR = DAYFILE MESSAGE ADDRESS.
 
 
          PURGMAC  ABORT
 
 ABORT    MACRO  A
          MACREF ABORT
          LDC    A
          LJM    ERR
          ENDM
 ENTRY    SPACE  4,10
**        ENTRY - DEFINE OVERLAY ENTRY POINT.
*
*
*         ENTRY  NAME
*         ENTRY  *NAME* = NAME OF ENTRY ADDRESS.
 
 
          PURGMAC ENTRY
 
          MACRO  ENTRY,NAME
          MACREF ENTRY
          IF     -MIC,.M
 NAME     EQU    *
          ELSE
          QUAL
 NAME     EQU    *+1R".M"*10000
          QUAL   ".O"
          ENDIF
          ENDM
 FCN      SPACE  4,10
**        FCN - DEFINE FUNCTION PROCESSOR.
*
*
* CODE    FCN    NAME,(JOB CODES),SSJ
*         ENTRY  *CODE* = OPTIONAL FUNCTION CODE SYMBOL TO BE DEFINED.
*                *NAME* = NAME OF FUNCTION PROCESSOR.
*                *JOB CODES* IF USED, FUNCTION IS ALLOWED BY ONLY
*                            THOSE JOB TYPES.
*                *SSJ* IF USED, FUNCTION IS ALLOWED BY ONLY THOSE
*                            JOBS WITH *SSJ=* ENTRY POINTS OR
*                            SUBSYSTEM ID-S.
 
 
 .3       SET    0
          MACRO  FCN,F,A,B,C
          LOC    .3/3
 F        CON    A/10000B,A-A/10000B*10000B
 .1       SET    0
          IFC    NE,$B$$,1
 .1       BITSET (B)
          IFC    NE,$C$$,1
 .1       SET    .1+4000
          CON    .1
 .3       SET    .3+3
          ENDM
 OVERLAY  SPACE  4,10
**        OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
*         OVERLAY (TEXT)
*         ENTRY  *TEXT* = TEXT OF SUBTITLE.
 
 
 .N       SET    0
 OVLB     MICRO  1,, 3C      BASE OVERLAY NAME
 
 
          PURGMAC OVERLAY
 
 OVERLAY  MACRO  TEXT
          QUAL
 .N       SET    .N+1
 .M       MICRO  .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
 .O       MICRO  1,3, "OVLB"".M"
          QUAL   ".O"
          TTL    CPM/".O" - TEXT
          TITLE
          IDENT  ".O",OVL    TEXT
*COMMENT  CPM - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          ORG    OVL
          LJM    *
          UJN    *-2
          ENDM
 SCLASS   SPACE  4,15
**        SCLASS - DEFINE SERVICE CLASS TABLE.
*
*         SCLASS NM,MN,DF,ST,TX
*
*         ENTRY  *NM* = SERVICE CLASS NAME.
*                *MN* = TWO CHARACTER MNEMONIC.
*                *DF* = DAYFILE MESSAGE CHARACTER.
*                *ST* = SHORT TEXT FOR *QFTLIST*.
*                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE.
*
*         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
*                THIS MACRO.
 
 
          PURGMAC  SCLASS
 
 SCLASS   MACRO  NM,MN,DF,ST,TX
 .SCL     RMT
          INDEX  NM,2R_MN    TX
 .SCL     RMT
 .A       IFC    NE,$NM$SSSC$
 .SCLVSP  RMT
          INDEX  NM,MN_MK    TX
 .SCLVSP  RMT
 .A       ENDIF
 SCLASS   ENDM
 SUBSYST  SPACE  4,10
**        SUBSYST - GENERATE SUBSYSTEM TABLE.
*
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT,CPU
 
 
          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
          INDEX  (ID-LSSI),(C)
 .SUB     RMT
 SUBSYST  ENDM
          SPACE 4,10
*         COMMON DECKS.
 
 
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO CALLS
*CALL     COMSSSD
          TITLE  MAIN PROGRAM.
 CPM      SPACE  4,10
**        CPM - MAIN PROGRAM.
 
 
          ORG    PPFW
 
 
 CPM      RJM    PRS         PRESET CONTROL POINT MANAGER
          LDC    0
 CPMA     EQU    *-1         (OVERLAY NAME)
          ZJN    CPM1        IF NO OVERLAY NAME
          LMC    2L"OVLB"    LOAD OVERLAY
          RJM    EXR
 CPM1     LDN    0           CLEAR ADDRESS WORD COUNT
          STD    T1
          LJM    *
 CPMB     EQU    *-1         (ENTRY ADDRESS FOR FUNCTION)
 
 CPMX     MONITOR DPPM       DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
          SPACE  4,10
**        PROGRAMMING NOTE.
*
*         (T1) = 0, ON ENTRY TO ALL FUNCTION PROCESSORS TO ASSURE
*         THE ROUTINE *CKA* WILL CHECK THE PROPER CM ADDRESSES.
          TITLE  ERROR PROCESSOR.
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
*
*         ENTRY  (A) = 6/ DFOP, 12/ ADDR
*
*                DFOP = DAYFILE OPTION.
*                     = 0 FOR MESSAGE TO USER AND SYSTEM DAYFILE.
*                     = *ERLN* FOR MESSAGE TO ERROR LOG, USER, AND
*                       SYSTEM DAYFILES.
*
*                ADDR = ADDRESS OF MESSAGE.
*
*                (ERRA) = RESOURCE TYPE FOR *ERNV* MESSAGE.
*
*         EXIT   ERROR PROCESSOR OVERLAY EXECUTED.
*                (CN) = ERROR MESSAGE ADDRESS.
*
*         USES   CN.
 
 
 ERR      BSS    0           ENTRY
          STD    CN          SET ERROR MESSAGE ADDRESS
          SHN    -14         SET DAYFILE OPTION
          STD    CN+1
          LDC    0           SET RESOURCE TYPE
 ERRA     EQU    *-1         (RESOURCE TYPE)
          STD    CN+2
          EXECUTE  3CA
          LJM    /3CA/ERR    PROCESS ERROR
          TITLE  RESIDENT ROUTINES.
 CFN      SPACE  4,10
**        CFN - COMPARE NAMES.
*
*         ENTRY  (FN - FN+4) = REQUESTED NAME.
*                (CN - CN+4) = LEGAL NAME.
*
*         EXIT   (A) = 0 IF MATCH.
 
 
 CFN      SUBR               ENTRY/EXIT
          LDD    FN
          LMD    CN
          NJN    CFNX        IF NO MATCH
          LDD    FN+1
          LMD    CN+1
          NJN    CFNX        IF NO MATCH
          LDD    FN+2
          LMD    CN+2
          NJN    CFNX        IF NO MATCH
          LDD    FN+3
          LMD    CN+3
          SCN    77
          UJN    CFNX        RETURN
 CJR      SPACE  4,20
**        CJR - CHECK IF THE JOB IS ROLLABLE.
*
*         AN I/O ERROR WAS ENCOUNTERED ON A MASS STORAGE DEVICE.  THE
*         JOB IS ROLLABLE IS IT IS NOT A SUBSYSTEM, THE I/O ERROR IS
*         RECOVERABLE, AND THERE IS NOT AN ERROR FLAG IN THE CONTROL
*         POINT AREA.
*
*         ENTRY  (T5) = EST ORDINAL.
*                (RDCT) = RECOVERABLE ERROR STATUS (BIT 2**10 CLEAR IF
*                         RECOVERABLE ERROR).
*
*         EXIT   TO *1RJ* IF THE JOB IS ROLLABLE.
*                TO *CPMX* IF ERROR FLAG SET.
*                OTHERWISE, TO CALLER.
*
*         USES   IR+4, CM - CM+4.
*
*         MACROS EXECUTE, PAUSE.
 
 
 CJR      SUBR               ENTRY/EXIT
          LDD    CP          CHECK IF SUBSYSTEM CALLER
          ADK    JCIW
          CRD    CM
          LDD    CM+2
          SBK    LSSI+1
          PJN    CJRX        IF SUBSYSTEM
          LDM    RDCT
          SHN    21-12
          MJN    CJRX        IF ERROR NOT RECOVERABLE
          PAUSE
          LDD    CM+1
          NJP    CPMX        IF ERROR FLAG SET
          LDD    T5          SET EST ORDINAL
          STD    IR+4
          EXECUTE  1RJ       RECALL JOB
 CKA      SPACE  4,10
**        CKA - CHECK ADDRESS.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS.
*                (T1) = WORD COUNT MINUS ONE.
*
*         EXIT   (A) = ABSOLUTE ADDRESS.
 
 
 CKA2     LDD    IR+3        LOAD ABSOLUTE ADDRESS
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
 
 CKA      SUBR               ENTRY/EXIT
          LDD    IR+3
          SCN    37
          NJN    CKA1        IF OUT OF RANGE
          LDD    IR+3
          SHN    14
          LMD    IR+4
          ADD    T1
          SHN    -6
          SBD    FL
          MJN    CKA2        IF < FL - WORD COUNT
 CKA1     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 RCL      SPACE  4,10
**        RCL - RECALL *CPM*.
*
*         ENTRY  (IR - IR+4) = *CPM* REQUEST.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 RCL      BSS    0
          LDN    ZERL        RECALL REQUEST
          CRD    CM
          LDD    MA
          CWM    IR,ON
          CWD    CM
          MONITOR  RECM
          LJM    PPR         EXIT
 UFC      SPACE  4,10
**        UFC - UPDATE FAMILY ACTIVITY COUNTS.
*
*         ENTRY  (CN+3) = CURRENT FAMILY EST ORDINAL.
*                (T2) = NEW FAMILY EST ORDINAL.
*
*         EXIT   CURRENT FAMILY ACTIVITY COUNT DECREMENTED.
*                NEW FAMILY ACTIVITY COUNT INCREMENTED.
*                *PUCN* CLEARED IF FAMILY CHANGED.
*
*         USES   CM - CM+4.
 
 
 UFC      SUBR               ENTRY/EXIT
          LDD    CN+3        CHECK OLD = NEW
          LMD    T2
          ZJN    UFCX        IF OLD = NEW
          LDD    CN+3        DECREMENT OLD FAMILY ACTIVITY COUNT
          STD    CM+1
          LMN    NEEQ        CHECK FOR NULL FAMILY
          ZJN    UFC1        IF NULL FAMILY
          LDN    DFCS
          STD    CM+3
          MONITOR  SMDM
 UFC1     LDD    T2          INCREMENT NEW FAMILY ACTIVITY COUNT
          STD    CM+1
          LDN    IFCS
          STD    CM+3
          MONITOR  SMDM
          LDN    ZERL        CLEAR *PUCN*
          CRD    CM
          NFA    PUCN
          CWD    CM
          UJN    UFCX        RETURN
          SPACE  4,10
**        COMMON DECKS NOT TO BE OVERLAID.
 
 
 TLI$     SET    1           SELECT TIME LIMIT INDEX CONVERSION
 CLI$     SET    1           SELECT CONVERSION FROM INDEX TO COUNT
 SLI$     SET    1           SELECT SRU LIMIT CONVERSION
*CALL     COMPCVI
 EJT$     EQU    1           DEFINE EJT PROCESSOR
 FNT$     EQU    1           DEFINE SYSTEM FNT PROCESSOR
 IFP$     EQU    1           DEFINE REMOTE INITIALIZATION CODE
 JCB$     EQU    1           DEFINE JCB PROCESSOR
*CALL     COMPGFP
*CALL     COMPRJC
*CALL     COMPRSS
*CALL     COMPVFN
          SPACE  4,10
**        OVERLAY DEFINITIONS.
 
 
 OVL      EQU    *+5         OVERLAY  LOAD ADDRESS
 L0AV     EQU    BFMS-ZAVL   LOAD ADDRESS FOR *0AV*
          TITLE  FUNCTION PROCESSORS.
 SPR      SPACE  4,10
***       FUNCTION 1.
*         SET CPU PRIORITY = PARAMETER.
*
*         ENTRY  (IR+4) = REQUESTED CPU PRIORITY IF .NE. 0.
*                (IR+4) = 0 TO SET CPU PRIORITY TO SERVICE CLASS VALUE.
 
 
 SPR      ENTRY
          LDD    OT          CHECK ORIGIN TYPE
          LMK    SYOT
          ZJN    SPR1        IF SYSTEM ORIGIN JOB
          LDD    EP          CHECK FOR SSJ= JOB
          SHN    21-2
          PJN    SPR4        IF NOT SSJ=
 SPR1     LDD    IR+4
          ZJN    SPR3        IF SET PRIORITY TO SERVICE CLASS VALUE
          SBK    LJCS
          PJN    SPR1.1      IF REQUESTED PRIORITY NOT TOO LOW
          LDN    LJCS        SET LOWEST JOB PRIORITY
          UJN    SPR3        SET PRIORITY
 
 SPR1.1   SBK    LSCS-LJCS
          MJN    SPR2        IF REQUESTED PRIORITY NOT TOO HIGH
          LDN    LSCS-1      SET HIGHEST USER JOB PRIORITY
          UJN    SPR3        SET PRIORITY
 
 SPR2     LDD    IR+4        SET PRIORITY
 SPR3     STD    CM+4
          LDN    CPRS        SELECT CPU PRIORITY
          STD    CM+1
          MONITOR  SJCM
 SPR4     LJM    CPMX        RETURN
 SEM      SPACE  4,20
***       FUNCTION 2.
*         SET EXIT MODE.
*
*         ENTRY  (IR+3) = 12/ MASK.
*                (IR+4) = 12/ MODE.
*                WHERE - MASK DEFINES BIT POSITIONS TO BE CHANGED
*                        IN WORD 3 OF THE EXCHANGE PACKAGE.
*                      - MODE DEFINES THE NEW VALUES.
*
*         EXIT   EXIT MODE CHANGED.
*
*         USES   CM - CM+4.
*
*         CALLS  DFM.
*
*         MACROS ABORT.
 
 
 SEM      ENTRY
          LDK    MABL        CHECK MAINFRAME TYPE
          CRD    CM
          LDD    CM+1
          SHN    -11
          LMN    7
          ZJN    SEM1        IF CYBER 176 MAINFRAME
          LDD    IR+3        CLEAR UNDERFLOW MASK
          SCN    10
          UJN    SEM3        PROCESS NON C176
 
 SEM1     LDD    IR+3
          LPN    1
          ZJN    SEM2        IF CM RANGE MASK NOT SET
          LDD    IR+4
          LPN    1
          NJN    SEM2        IF CM RANGE NOT DESELECTED
          LDC    =C* CM RANGE EXIT MODE NOT DESELECTABLE.*
          RJM    DFM
 SEM2     LDD    IR+4        REPOSITION UNDERFLOW BIT
          LPN    10
          SHN    -3
          STD    T1
          LDD    IR+4
          SCN    11
          LMD    T1
          STD    IR+4
          LDD    IR+3        REPOSITION UNDERFLOW MASK BIT
          LPN    10
          SHN    -3
          STD    T1
          LDD    IR+3
          SCN    11
          LMD    T1
 SEM3     STD    IR+3
          LPN    20
          ZJN    SEM5        IF NOT CHANGING THE PURGING BIT
          LDK    MABL
          CRD    CM
          LDD    CM+1
          SHN    21-13
          PJN    SEM5        IF CYBER 170-8X5 MAINFRAME
          LDC    =C* STACK PURGING NOT DESELECTABLE.*
          RJM    DFM         PROCESS DAYFILE MESSAGE
          LDD    IR+3        CLEAR STACK PURGING MASK
          SCN    20
          UJN    SEM6        PROCESS EXIT MODE BITS
 
 SEM4     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 SEM5     LDD    IR+3        MASK OF BITS TO BE CHANGED
          NJN    SEM6        IF EXIT MODE MASK SPECIFIED
          LDN    7           DEFAULT MASK
 SEM6     LPN    27
          RAM    SEMB
          LPN    27          RETRIEVE MASK
          RAM    SEMA
          LDD    IR+3        ORIGINAL MASK
          LPC    750
          NJN    SEM4        IF NOT CHANGING LEGAL EXIT MODE BITS
          LDD    CP          GET CURRENT EXIT MODE
          ADN    3           READ MODE
          CRD    CM
          LDD    CM          CURRENT MODE
 SEMA     SCN    0           CLEAR THOSE BITS CHANGING
          STD    CM
          LDD    IR+4        NEW VALUE FOR THOSE BITS CHANGING
 SEMB     LPN    0           EXTRACT THOSE BITS CHANGING
          ADD    CM          FORM NEW EXIT MODE
          LPC    0777        CLEAR HARDWARE MODE BITS
          LMC    7000        FORCE HARDWARE MODE BITS ON
          STD    CM
          LDN    0           CLEAR UNPROCESSED *PSD* ERRORS
          STD    CM+1
          LDD    CP
          ADN    3
          CWD    CM          WRITE NEW EXIT MODE
          LJM    CPMX        EXIT
 SDA      SPACE  4,20
***       FUNCTION 5.
*         SET *K* DISPLAY CONTROLS.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD IF TO
*                                ACTIVATE *K* DISPLAY.
*                              = 0 IF TO DEACTIVATE *K* DISPLAY.
*
*T,ADDR   1/0,1/U,1/0,1/S,2/0,18/  KB,18/  RS,18/  LS
*
*         U      = 1, IF UPDATE OF STATUS WORD IS NOT REQUIRED
*         S      = 1, IF K-DISPLAY INPUT TO BE SUPPRESSED FROM DAYFILE
*         KB     KEYBOARD BUFFER ADDRESS
*         RS     RIGHT SCREEN BUFFER ADDRESS
*         LS     LEFT SCREEN BUFFER ADDRESS
*
*         EXIT   *K* DISPLAY CONTROLS UPDATED.
 
 
 SDA      ENTRY
          LDD    IR+3        CHECK PARAMETER
          LPN    37
          SHN    14
          LMD    IR+4
          NJN    SDA1        IF AN ADDRESS WAS SPECIFIED
          LDK    ZERL
          LJM    SDA6        CLEAR DISPLAY REGISTER (DBAW)
 
 SDA1     LDK    PPCP        CHECK IF K-DISPLAY IS ACTIVE
          CRD    CN
          LDD    CN+4
          ADN    10
          CRD    CN          READ *DSD*-S INPUT REGISTER
          LDD    CN+2
          SHN    -6
          LMN    1RK
          ZJN    SDA2        IF K-DISPLAY IS UP ON THE LEFT SCREEN
          LDD    CN+2
          LPN    77
          LMN    1RK
          NJN    SDA3        IF K-DISPLAY IS NOT UP
          LDN    1
 SDA2     STD    T2          GET EJTO FROM *DSD*-S INPUT REGISTER
          LDM    CN+3,T2
          ZJN    SDA3        IF DISPLAY IS NOT ASSIGNED TO A JOB
          STD    T2
          LDD    CP          READ THE CALLER-S EJTO
          ADK    TFSW
          CRD    CN
          LDD    CN
          LMD    T2
          ZJN    SDA5        IF K-DISPLAY IS ASSIGNED TO THIS JOB
 SDA3     LDD    OT          CHECK ORIGIN TYPE
          LMK    SYOT
          NJN    SDA4        IF NOT SYSTEM ORIGIN
          LDC    SDAB        FLASH *REQUEST *K* DISPLAY.* MESSAGE
          STM    SDAC
 SDA4     LDD    CP          CONSOLE MESSAGE = * REQUEST *K* DISPLAY.*
          ADN    MS2W
          CWM    SDAA,TR
 SDAC     EQU    *-1
 SDA5     RJM    CKA         CHECK ADDRESS
 SDA6     CRD    CN          READ DISPLAY REGISTER
          LDD    CP          STORE DISPLAY REGISTER
          ADC    DBAW
          STD    T1
          CRD    CM          PRESERVE SSM STATUS
          LDD    CN
          LMD    CM
          LPC    2477
          LMD    CM
          STD    CN
          LDD    T1          UPDATE DBAW
          CWD    CN
          LJM    CPMX        EXIT
 
 SDAA     DATA   C+REQUEST *K* DISPLAY.+
 SDAB     DATA   C+$REQUEST *K* DISPLAY.+
 ROC      SPACE  4,20
***       FUNCTION 6.
*         ROLLOUT JOB.
*         IF PARAMETER .NE 0 PERFORM TIMED/EVENT ROLLOUT WITH
*         (RA + PARAMETER) OF FOLLOWING FORMAT -
*
*T        27/ 0,21/ EVENT DESCRIPTOR,12/ TIME
*
*         EVENT DESCRIPTOR FORMAT -
*
*                 9/ *EQ* DESCRIPTOR.
*                12/ *EVD* (EVENT CODE) DESCRIPTOR.
*
*         IF THE USER ENTERS AN EVENT DESCRIPTOR, THE EVENT TIME
*         MUST ALSO BE ENTERED OR A SYSTEM DEFAULT WILL BE USED.
*
*         ERROR  TO *ERR*.
*
*         CALLS  CKA.
*
*         MACROS MONITOR.
 
 
 ROC      ENTRY
          LDD    IR+3        CHECK IF USER PARAMETERS SPECIFIED
          LPN    77
          ADD    IR+4
          ZJN    ROC1        IF NO USER PARAMETERS SPECIFIED
 
*         CHECK USER ROLLOUT PARAMETER WORD.
 
          RJM    CKA         SET PARAMETER WORD ADDRESS
          CRD    CM          READ PARAMETER WORD
          LDD    CP          READ TIMED/EVENT CONTROL WORD *TERW*
          ADK    TERW
          CRD    CN
          LDD    CM+2        CHECK USER *EQ* DESCRIPTOR
          LPC    777
          NJN    ROC4        IF NON-SYSTEM EVENT
          LDD    CM+3        CHECK *EVD* DESCRIPTOR
          NJN    ROC4        IF SYSTEM EVENT
          LDD    CM+4        CHECK IF TIME SPECIFIED
          NJN    ROC5        IF TIMED ROLLOUT
 
*         PROCESS ZERO PARAMETER WORD ROLLOUT.
 
          LDD    CN+2        CHECK FOR EVENT IN *TERW*
          LPN    77
          ADD    CN+3
          ADD    CN+4
          ZJN    ROC1        IF NO EVENT WAITING IN *TERW*
          LJM    ROC12       ISSUE TIMED/EVENT ROLLOUT
 
*         ROLLOUT JOB TO JOB SCHEDULER QUEUE.
 
*         LDK    ROSR        SELECT JOB SCHEDULER ROLLOUT
          ERRNZ  ROSR        CODE DEPENDS ON VALUE
 ROC1     LJM    ROC13       ISSUE ROLLOUT REQUEST
 
*         PROCESS ARGUMENT ERROR.
 
 ROC3     LDC    ERAE        * CPM - ARGUMENT ERROR.*
          LJM    ERR         PROCESS ERROR
 
*         PROCESS EVENT ROLLOUT.
 
 ROC4     LDD    CM+2        CHECK *EQ* DESCRIPTOR
          SBK    /EVENT/EXTM/10000
          ZJN    ROC6        IF EXTENDED TIME ROLLOUT
          LDN    ESTP        CHECK FOR INCORRECT EST ORDINAL
          CRD    T0
          LDD    CM+2
          SBD    T0+2
          PJN    ROC3        IF INCORRECT *EQ* DESCRIPTOR
 ROC5     UJN    ROC7        SET ROLLOUT TIME
 
*         PROCESS EXTENDED TIME ROLLOUT.
 
 ROC6     LDD    CM+4        SAVE ADD-ON TIME
          STD    T0
          ADD    CM+3
          ZJN    ROC1        IF NO TIMES SPECIFIED
          LDD    CM+3        SET CYCLE MULTIPLIER
          STD    CM+4
          SHN    0-6         CHECK VALUE
          NJN    ROC3        IF MULTIPLIER .GT. 77
          LDD    T0          SET ADD-ON TIME
          STD    CM+3
          NJN    ROC9        IF NONZERO
          LCN    0           ADJUST ADD-ON TIME FOR *1SJ*
          STD    CM+3
          SOD    CM+4        ADJUST CYCLE MULTIPLIER FOR *1SJ*
          UJN    ROC10       SET TIME AND EVENT
 
*         SELECT, VALIDATE, AND ADJUST ROLLOUT TIME VALUE.
 
 ROC7     LDD    CM+4        CHECK TIME SPECIFIED
          NJN    ROC8        IF NONZERO
          LDD    CN+2        CHECK FOR TIME IN *TERW*
          SHN    21-5
          SCN    77
          LMD    CN+3
          SHN    0-11
          NJN    ROC11       IF TIME IN *TERW*
          LDK    CRT         SELECT DEFAULT TIME
          UJN    ROC10       SET TIME AND EVENT
 
 ROC8     SHN    0-11        VALIDATE TIME SPECIFIED
          ZJN    ROC9        IF .LE. 777
          LDC    777         SELECT MAXIMUM ROLLOUT TIME
          UJN    ROC10       SET TIME AND EVENT
 
 ROC9     LDD    CM+4        SELECT TIME SPECIFIED
*         UJN    ROC10       SET TIME AND EVENT
 
*         SET ROLLOUT TIME IN *TERW* IMAGE.
*
*                (A) = ROLLOUT TIME.
 
 ROC10    SHN    21-10       INSERT LOWER 3 BITS OF TIME
          LMD    CN+3        MERGE WITH EVENT DESCRIPTOR
          LPC    777000
          LMD    CN+3
          STD    CN+3
          SHN    5-21        INSERT UPPER 6 BITS OF TIME
          LMD    CN+2
          LPN    77
          LMD    CN+2
          STD    CN+2
          LDD    CM+2        CHECK FOR A NEW EVENT DESCRIPTOR
          ADD    CM+3
          ZJN    ROC12       IF NO EVENT SPECIFIED
 
*         SET ROLLOUT EVENT.
 
 ROC11    LDD    CN+3        SET *EQ* DESCRIPTOR
          LPC    7000
          LMD    CM+2
          STD    CN+3
          LDD    CM+3        SET *EVD* DESCRIPTOR
          STD    CN+4
 ROC12    LDD    CN+2        SET UP *ROCM* PARAMETERS
          LPN    77
          SHN    14
          LMD    CN+3
          SHN    -11
          STD    CN+2
          LDD    CN+3
          LPC    777
          STD    CN+3
          LDD    MA          WRITE *ROCM* PARAMETER WORD TO MB
          CWD    CN
 
*         ROLLOUT JOB TO TIMED/EVENT QUEUE.
 
          LDK    ROTE        SELECT TIMED/EVENT ROLLOUT OPTION
 
*         ISSUE MONITOR REQUEST TO ROLLOUT JOB.
*
*                (A) = ROLLOUT OPTION.
 
 ROC13    STD    CM+1        SET REQUEST OPTION
          MONITOR ROCM       ISSUE MONITOR REQUEST
          LJM    CPMX        EXIT
 NEX      SPACE  4,10
***       FUNCTION 7.
*         NOEXIT.
*         SUPPRESS PROCESSING OF *EXIT* COMMAND IF JOB ABORTS.
*         ONEXIT.
*         RESET PROCESSING OF *EXIT* COMMAND.
 
 
 NEX      ENTRY
          LDD    CP          READ ENTRY/EXIT CONTROL
          ADN    EECW
          CRD    CM
          LDD    CM          ENSURE *NOEXIT* FLAG CLEAR
          LPC    3777
          STD    CM
          LDD    IR+4        CHECK INPUT PARAMETER
          ZJN    NEX1        IF ONEXIT
          LDC    4000        SET *NOEXIT* FLAG
 NEX1     RAD    CM
          LDD    CP          STORE ENTRY/EXIT CONTROL
          ADN    EECW
          CWD    CM
          LJM    CPMX        EXIT
 SSM      SPACE  4,10
***       FUNCTION 10.
*         SET/CLEAR SECURE SYSTEM MEMORY FLAG.
 
 
 SSM      ENTRY
          LDD    CP          READ CP AREA WORD *DBAW*
          ADC    DBAW
          STD    T2
          CRD    CN
          LDD    IR+4        CHECK OPTION
          NJN    SSM1        IF SET REQUEST
          STM    SSMA
          LDD    EP
          LPN    1
          ZJN    SSM1        IF NOT SSM=
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 SSM1     LDD    CN          SET/CLEAR SECURE SYSTEM MEMORY BIT
          LPC    3777
          LMC    4000
*         LMC    0
 SSMA     EQU    *-1
          STD    CN          WRITE *DBAW*
          LDD    T2
          CWD    CN
          LJM    CPMX        EXIT
 ONS      SPACE  4,10
***       FUNCTION 11.
*         TURN ON SENSE SWITCHES FOR BITS 0 - 5 IN PARAMETER.
 
 
 ONS      ENTRY
          LDD    IR+4        SET SWITCH BITS
          SHN    6
          STD    T1
 ONS1     LDD    IR+4        FORM SWITCH MASK
          LPN    77
          SHN    6
          LMC    -0
          STM    ONSA
          LDD    CP          READ SWITCH WORD
          ADN    SNSW
          CRD    CM
          LDD    CM+4        CLEAR/SET SENSE SWITCHES
          LPC    *
 ONSA     EQU    *-1
          LMD    T1
          STD    CM+4
          LDD    CP          STORE SWITCH WORD
          ADN    SNSW
          CWD    CM
          LDD    RA          STORE SWITCHES IN (RA)
          SHN    6
          CRD    CN          READ (RA)
          LDD    CN+4        SET NEW SENSE SWITCHES
          LMD    CM+4
          LPN    77
          LMD    CM+4
          STD    CN+4
          LDD    RA          STORE (RA)
          SHN    6
          CWD    CN
          LJM    CPMX        EXIT
 OFS      SPACE  4,10
***       FUNCTION 12.
*         TURN OFF SENSE SWITCHES FOR BITS 0 - 5 IN PARAMETER.
 
 
 OFS      ENTRY
          LDN    0           CLEAR SWITCH BITS
          STD    T1
          LJM    ONS1
 RJN      SPACE  4,10
***       FUNCTION 13.
*         READ JSN TO (PARAMETER).
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*
*         EXIT   JOB SEQUENCE NUMBER RETURNED IN FORMAT -
*T ADDR   24/ JSN, 36/ 0
 
 
 RJN      ENTRY
          LDD    CP          GET JOB EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      GET JSN
          ERRNZ  JSNE        CHECK IF WORD 0 IF EJT ENTRY
          CRD    CM
          LDN    ZERL
          CRD    CM+2
          UJN    RPR1        RETURN JSN
 RPR      SPACE  4,10
***       FUNCTION 15.
*         READ CPU PRIORITY TO (PARAMETER).
 
 
 RPR      ENTRY
          LDN    ZERL
          CRD    CM
          LDD    CP
          ADN    CWQW        GET CPU PRIORITY
          CRD    CN
          LDD    CN          GET JOB CPU PRIORITY
          SHN    -3
          LPC    177
          STD    CM+4
 RPR1     RJM    CKA         CHECK PARAMETER ADDRESS
          CWD    CM          STORE RESPONSE
          LJM    CPMX        EXIT
 EDI      SPACE  4,10
***       FUNCTION 20.
*         ENTER DEMAND FILE RANDOM INDEX.
*
*         ENTRY  (IR+3 - IR+4) = DEMAND FILE RANDOM INDEX.
*
*         CALLER MUST HAVE SSJ= ENTRY POINT SET.
 
 
 EDI      ENTRY
          LDD    CP          READ DEMAND FILE INDEX WORD
          ADN    RFCW
          CRD    CN
          LDD    IR+3
          LMD    CN+3
          LPN    77
          LMD    CN+3
          STD    CN+3
          LDD    IR+4
          STD    CN+4
          LDD    CP          UPDATE DEMAND FILE INDEX WORD
          ADN    RFCW
          CWD    CN
          LJM    CPMX        RETURN
 SLC      SPACE  4,10
***       FUNCTION 22.
*         SET LOADER CONTROL WORD.
 
 
 SLC      ENTRY
          RJM    CKA         CHECK ADDRESS
          CRD    CM          READ CONTROL WORD
          LDD    CP          STORE CONTROL WORD
          ADC    LB1W
          CWD    CM
          LJM    CPMX        EXIT
 RFL      SPACE  4,10
***       FUNCTION 23.
*         SET LAST RFL = PARAMETER.
*
*         ENTRY  (IR+3, IR+4) = RFL REQUEST.
*                BIT 2**11 IN IR+3 IS SET FOR EXTENDED MEMORY REQUEST
*                AND ZERO FOR CM REQUEST.  EXTENDED MEMORY REQUESTS
*                ARE MULTIPLES OF 1000B.
 
 
 RFL      ENTRY
          RJM    PMP         PROCESS ARGUMENT
          STD    CM+1        SET NFL
          LDD    CM
          SBD    CM+1
          MJN    RFL1        IF NFL .GT. MFL
          LDD    T7          WRITE FL CONTROL WORD
          CWD    CM
          LJM    CPMX        EXIT
 
 RFL1     ABORT  ERFL        * RFL BEYOND MFL.*
 SSB      SPACE  4,10
***       FUNCTION 26.
*         SET SUBSYSTEM FLAG = PARAMETER.
 
 
 SSB      ENTRY
          LDD    IR+3        CHECK SUBSYSTEM INDEX
          NJN    SSB1        IF INCORRECT PARAMETER
          LDD    IR+4
          SBN    MSYS
          PJN    SSB1        IF INCORRECT SUBSYSTEM
          ADN    MSYS
          RJM    SSF         SET SUBSYSTEM FLAG
          MJN    SSB2        IF NOT VALIDATED
          LJM    CPMX        RETURN
 
 SSB1     ABORT  ERAE        * CPM ARGUMENT ERROR.*
 
 SSB2     ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
 ROT      SPACE  4,10
***       FUNCTION 27.
*         READ ORIGIN TYPE TO (PARAMETER).
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*
*         EXIT   JOB ORIGIN TYPE (OT) RETURNED IN FORMAT -
*T ADDR   54/0, 6/OT
 
 
 ROT      ENTRY
 ROT1     LDD    CP          GET JOB EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      SET ORIGIN TYPE
          ADN    SCLE
          CRD    CM
          LDD    CM
          LPN    17          MASK ORIGIN TYPE
*         SCN    60          USED BY FUNCTION 111
 ROTA     EQU    *-1
          STD    CM+4
          LDN    ZERL
          CRD    CM-1
          RJM    CKA         CHECK ADDRESS
          CWD    CM          STORE ORIGIN TYPE
          LJM    CPMX        EXIT
 SCP      SPACE  4,10
***       FUNCTION 31.
*         SELECT CPU(S) ALLOWABLE FOR JOB TO USE.
*         PARAM = 0, RUN JOB IN ANY CPU.
*         PARAM = 1,RUN JOB IN CPU - 0 ONLY.  (6600 CPU ON 6700)
*         PARAM = 2, RUN JOB IN CPU - 1 ONLY.
*         IF THE CPU SELECTED IS NOT AVAILABLE, THEN NO SELECTION
*         IS PERFORMED, AND THE JOB IS ALLOWED TO CONTINUE.
*
*         NOTE - ON A DUAL CPU MACHINE WITH CACHE, CERTAIN SUBSYSTEMS
*         MAY ONLY RUN IN CPU 0.  FOR THESE SUBSYSTEMS, THIS REQUEST
*         WILL BE IGNORED.
 
 
 SCP      ENTRY
          LDN    EIBP
          CRD    CM
          LDD    CM
          SHN    21-12
          PJN    SCP1        IF NOT A DUAL CPU MACHINE WITH CACHE
          LDD    CP
          ADK    JCIW
          CRD    CM
          LDD    CM+2
          ADK    -LSSI
          MJN    SCP1        IF NOT A SUBSYSTEM
          STD    T1
          LDM    SCPA,T1
          NJN    SCP2        IF JOB MUST RUN IN CPU 0, IGNORE REQUEST
 SCP1     LDN    CPUS        SELECT CPU(S) ALLOWABLE FOR JOB EXECUTION
          STD    CM+1
          LDD    IR+4        CHECK LEGAL CPU SELECTION
          STD    CM+4
          SBN    3
          PJN    SCP3        IF INCORRECT REQUEST
          MONITOR  SJCM
 SCP2     LJM    CPMX        EXIT
 
 SCP3     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 
 SCPA     INDEX              TABLE OF SUBSYSTEMS FORCED INTO CPU 0
 .SUB     HERE
          INDEX  MXSI-LSSI
 EET      SPACE  4,10
***       FUNCTION 34.
*         ENTER EVENT IN SYSTEM EVENT TABLE.
 
 
 EET      ENTRY
          LDN    0
          STD    CM+1
          LDD    IR+3
          STD    CM+3
          LDD    IR+4
          STD    CM+4
          MONITOR EATM       ENTER EVENT
          LDD    CM+1
          NJP    RCL         IF EVENT TABLE IS FULL
          LJM    CPMX        RETURN
 SPN      SPACE  4,10
***       FUNCTION 35.
*         SET PACKNAME AND PACK TYPE.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PACKNAME PARAMETER WORD.
*
*T ADDR   42/NAME,18/TYPE
*         WHERE *NAME* IS A LEFT-JUSTIFIED PACKNAME WITH ZERO FILL,
*         AND *TYPE* IS A DISPLAY CODE PACK TYPE (E.G. *DI3*).
 
 
 SPN      ENTRY
          RJM    CKA         CHECK ADDRESS
          CRD    FN          READ UP PACK NAME
          LDD    FN+3
          SCN    77
          ADD    FN+2
          ADD    FN+1
          ADD    FN
          ZJN    SPN2        IF NO PACK NAME
          RJM    VFN         VERIFY PACK NAME
          NJN    SPN3        IF LEGAL PACK NAME
 SPN1     ABORT  ERPN        * CPM - INCORRECT PACK NAME.*
 
 SPN2     LDN    ZERL        CLEAR PACK TYPE
          CRD    FN
 SPN3     LDD    FN+3        VERIFY PACK TYPE
          LPN    77
          SHN    14
          ADD    FN+4
          ZJN    SPN4        IF PACK TYPE NOT SPECIFIED
          LPN    77          CHECK NUMBER OF SPINDLES
          SBN    1R0
          MJN    SPN1        IF LAST CHARACTER NOT NUMERIC
          SBN    1R9-1R0+1
          PJN    SPN1        IF LAST CHARACTER NOT NUMERIC
          LDD    FN+4
          SHN    -6
          ZJN    SPN1        IF SECOND CHARACTER MISSING
          SBN    1R0
          PJN    SPN1        IF SECOND CHARACTER NOT ALPHABETIC
          LDD    FN+3
          LPN    77
          ZJN    SPN1        IF FIRST CHARACTER MISSING
          SBN    1R0
          PJN    SPN1        IF FIRST CHARACTER NOT ALPHABETIC
 
*         ENTER PACK NAME AND TYPE INTO CONTROL POINT AREA.
 
 SPN4     LDD    CP
          ADC    PKNW
          CWD    FN
 
*         ISSUE ACCOUNT FILE MESSAGE.
 
          LDC    SPNA+2
          STD    T1
          LDD    FN
          ZJN    SPN5        IF PACKNAME NOT SPECIFIED
          LDN    0           SET EOL ON PACKNAME
          STD    FN+4
          LDD    FN+3
          SCN    77
          STD    FN+3
          LDC    =C*, *      ADD COMMA TO MESSAGE
          RJM    ACS
          LDN    FN          SET PACKNAME IN MESSAGE
          RJM    ACS
 SPN5     LDC    =C*.*       TERMINATE MESSAGE
          RJM    ACS
          LDC    SPNA+ACFN
          RJM    DFM         ISSUE MESSAGE TO ACCOUNT FILE
          LJM    CPMX        EXIT
 
 
 SPNA     DATA   C*APPN*
          BSSZ   6
 RPN      SPACE  4,10
***       FUNCTION 36.
*         RETURN PACKNAME AND PACK TYPE.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS TO RETURN PACKNAME TO.
*
*         EXIT   CURRENT CONTROL POINT VALUE RETURNED IN FORMAT -
*
*T ADDR   42/ PACK NAME,18/ PACK TYPE
 
 
 
 RPN      ENTRY
          LDD    CP          RETURN PACKNAME AND PACK TYPE
          ADC    PKNW
          CRD    CM
          RJM    CKA         CHECK ADDRESS
          CWD    CM
          LJM    CPMX        EXIT
 RVN      SPACE  4,15
***       FUNCTION 44.
*         RETURN VERSION NAME.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*
*T  ADDR  1/ F, 11/ BC, 12/ SB, 12/ BP, 6/ 0, 18/ WADDR
*
*         F = 0, TO RETURN VERSION NAME (*SVNL*) FROM SOURCE FIELD.
*           = 1, TO RETURN VERSION NAME(*SVNL*) AND SYSTEM TITLE LINE
*                (*SYTL*) FROM SOURCE FIELD.
*
*         BC = NUMBER OF BYTES TO RETURN FROM SOURCE FIELD.
*              IF F=0, 1 - 10D BYTES.
*              IF F=1, 1 - 30D BYTES.
*
*         SB = BYTE IN SOURCE FIELD AT WHICH TO BEGIN TRANSFER.
*              IF F=0, BYTE 0 - 9D.  (BC + SB .LT. 11D)
*              IF F=1, BYTE 0 - 29D.  (BC + SB .LT. 31D)
*
*         BP = BYTE POSITION WITHIN RECEIVING FIELD (WADDR) AT
*              WHICH TO BEGIN TRANSFER.  (BYTE 0 - 4)
*
*         WADDR = BEGINNING ADDRESS OF BLOCK TO RECEIVE DATA.
*
*         EXIT   IF F=0, VERSION NAME IS TRANSFERRED FROM CMR TO
*                   SPECIFIED ADDRESS.
*                IF F=1, SYSTEM TITLE LINE AND VERSION NAME ARE BOTH
*                   TRANSFERRED FROM CMR TO SPECIFIED ADDRESS.
 
 
 RVN      ENTRY
          RJM    CKA         READ PARAMETER WORD
          CRD    CM
          LDN    2
          STD    T1          SAVE WORD COUNT
          LDD    CM
          SHN    21-13
          PJN    RVN1        IF FLAG NOT SET
          LDN    6
          STD    T1          SAVE WORD COUNT
 RVN1     LDD    CM+3        VALIDATE RETURN ADDRESS
          LPN    77
          STD    CM+3
          SHN    14
          LMD    CM+4
          MJN    RVN2        IF ADDRESS OUT OF RANGE
          ADD    T1          ADD WORD COUNT
          SHN    -6
          SBD    FL
          MJN    RVN3        IF .LT. FL - WORD COUNT
 RVN2     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 RVN3     LDD    CM+2        VALIDATE BYTE POSITION
          SBN    5
          PJN    RVN2        IF INCORRECT BYTE POSITION
          LDD    CM          VALIDATE BYTE COUNT
          SHN    21-13
          MJN    RVN4        IF FLAG SET
          SHN    13-21
          ZJN    RVN2        IF INCORRECT BYTE COUNT
          SBN    11D
          PJN    RVN2        IF INCORRECT BYTE COUNT
          LDD    CM
          ADD    CM+1
          SBN    11D
          PJN    RVN2        IF INCORRECT COMBINATION
          LDN    SVNL
          UJN    RVN5        READ VERSION NAME
 
 RVN4     SHN    13-21
          LPC    3777        CLEAR FLAG
          STD    CM
          ZJN    RVN2        IF INCORRECT BYTE COUNT
          SBN    31D
          PJN    RVN2        IF INCORRECT BYTE COUNT
          LDD    CM
          ADD    CM+1
          SBN    31D
          PJP    RVN2        IF INCORRECT COMBINATION
          LDN    SYTL        READ SYSTEM TITLE AND VERSION NAME
 RVN5     CRM    RVNA,T1
          AOD    T1
          LDD    CM+3        READ RETURN FIELD
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          CRM    RVNB,T1
 
*         MERGE VERSION NAME WITH RETURN FIELD.
 
 RVN6     SOD    CM          DECREMENT BYTE COUNT
          MJN    RVN10       IF MERGE COMPLETE
          LDM    RVNA,CM+1   CHECK FOR ZERO CHARACTERS
          STM    RVNB,CM+2
          ZJN    RVN7        IF ZERO BYTE
          LPN    77
          NJN    RVN9        IF NO ZERO CHARACTER
          LDM    RVNA,CM+1   BLANK FILL ZERO CHARACTERS
          LMN    1R
          UJN    RVN8        CONTINUE
 
 RVN7     LDC    2R          BLANK FILL ZERO CHARACTERS
 RVN8     STM    RVNB,CM+2
 RVN9     AOD    CM+1        INCREMENT INDICES
          AOD    CM+2
          UJN    RVN6        CHECK NEXT BYTE
 
*         REWRITE MERGED RETURN FIELD.
 
 RVN10    LDD    CM+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          CWM    RVNB,T1
          LJM    CPMX        RETURN
 RAC      SPACE  4,30
***       FUNCTION 51.
*         RETURN JOB ACTIVITY INFORMATION.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS FOR RETURN OF A ONE WORD
*                            REPLY BLOCK.
*
*         EXIT   PARAMETER BLOCK RETURNED IN THE FOLLOWING FORMAT.
*
*T ADDR   12/SHORT , 1/L , 23/0 , 12/INS , 12/0
*
*         SHORT  SHORT TERM ACTIVITY COUNTS. INCREMENTED BY ONE
*                FOR EACH OF THE FOLLOWING.
*                PPU ACTIVITY, NOT INCLUDING *DIS* FLAG.
*                *RECW* REQUESTS (INCLUDES PPU IN RECALL AND TAPE
*                  ACTIVITY).
*                ROLLOUT REQUESTED.
*                SCP WAIT RESPONSE INDICATORS.
*                TERMINAL OUTPUT FET ADDRESS PRESENT.
*                TERMINAL INPUT FET ADDRESS PRESENT.
*         L      LONG TERM ACTIVITY COUNTS.  FIELD IS ONE IF ANY OF
*                THE FOLLOWING CONDITIONS ARE MET.
*                *K* OR *L* DISPLAY INTERFACE ACTIVE.
*                *CFO* ENTRY ENABLED.
*                SCP LONG TERM CONNECTION ESTABLISHED.
*                *DIS* PACKAGE ENABLED.
*         INS    RESERVED FOR INSTALLATIONS.
*
*         USES   T1, T3 - T7, BA - BA+4, CM - CM+4,
*                CN - CN+4, FN - FN+4, UN - UN+4.
*
*         CALLS  CKA.
 
 
 RAC      ENTRY
          LDN    ZERL        PRESET REPLY WORD
          CRD    CN
 
*         COMPUTE SHORT TERM ACTIVITIES.
 
          LDD    CP          READ CONTROL POINT AREA WORDS
          ADN    STSW        READ PPU AND TAPE ACTIVITY
          CRD    CM
          ADN    JCIW-STSW   READ JOB CONTROL INFORMATION
          CRD    T3
          ADN    TIOW-JCIW   READ TERMINAL OUTPUT FET ADDRESS
          CRD    UN
          ADN    TINW-TIOW   READ TERMINAL INPUT FET ADDRESS
          CRD    FN
          ADN    SSCW-TINW   READ WAIT RESPONSE INDICATORS
          CRD    BA
          LDD    T3+3        CHECK *DIS* FLAG
          SHN    -11         RIGHT JUSTIFY *DIS* BIT
          LPN    1
          STD    T3
          LDD    CM          CHECK PPU ACTIVITY
          LPN    37
          SBD    T3          SUBTRACT OFF *DIS* ACTIVITY
          SBN    1           COMPENSATE FOR THIS PPU
          ZJN    RAC1        IF NO PPU ACTIVITY
          AOD    CN          INCREMENT SHORT TERM ACTIVITY COUNT
 RAC1     LDD    CM+4        CHECK FOR *RECW* REQUESTS
          SHN    -4
          LPN    17
          ZJN    RAC2        IF NO RECALL/TAPE ACTIVITY
          AOD    CN          INCREMENT SHORT TERM ACTIVITY COUNT
 RAC2     LDD    CM+2        READ ROLLOUT FLAG
          LPN    1           INCREMENT SHORT TERM ACTIVITY IF SET
          RAD    CN
          LDN    5           CHECK WAIT RESPONSE INDICATORS
          STD    T1
 RAC3     SOD    T1
          MJN    RAC4        IF CHECK COMPLETE
          LDM    BA,T1
          LPN    7           CHECK WAIT RESPONSE INDICATOR
          ZJN    RAC3        IF NO WAIT RESPONSE SET
          AOD    CN          INCREMENT SHORT TERM ACTIVITY COUNT
 RAC4     LDD    UN+3        CHECK TERMINAL OUTPUT FET ADDRESS
          LPN    37
          ADD    UN+4
          ZJN    RAC5        IF NO TERMINAL OUTPUT
          AOD    CN          INCREMENT SHORT TERM ACTIVITY COUNT
 RAC5     LDD    FN+3        CHECK TERMINAL INPUT FET ADDRESS
          SCN    77
          SHN    6
          LMD    FN+2
          ZJN    RAC6        IF NO TERMINAL INPUT
          AOD    CN          INCREMENT SHORT TERM ACTIVITY COUNT
 
*         COMPUTE LONG TERM ACTIVITIES.
 
 RAC6     LDD    T3          CHECK *DIS* FLAG
          NJP    RAC9        IF *DIS* PACKAGE ENABLED
          LDD    CP          READ CONTROL POINT AREA WORDS
          ADC    DBAW        READ *K* DISPLAY INTERFACE WORD
          CRD    CM
          LDD    CM          CHECK FOR *K* DISPLAY ACTIVITY
          LPN    77
          ADD    CM+1
          ADD    CM+2
          ADD    CM+3
          ADD    CM+4
          NJN    RAC8        IF *K* DISPLAY ACTIVITY
          LDN    4           CHECK LONG TERM CONNECTION SET
          STD    T1
          LDC    LDSP        GET FWA *L* DISPLAY BUFFER
          CRD    CM
          LDD    CM+2        GET *L* DISPLAY JOB INTERLOCK
          SHN    14
          ADD    CM+3
          CRD    CM
          LDD    CM
          ZJN    RAC7        IF NO JOB ASSIGNED TO *L* DISPLAY
          LDD    CP          GET JOB EJT ORDINAL
          ADN    TFSW
          CRD    FN
          SFA    EJT,FN      GET JOB SEQUENCE NUMBER
          ERRNZ  JSNE        CODE DEPENDS ON VALUE
          CRD    FN
          LDD    CM          COMPARE JOB SEQUENCE NUMBERS
          LMD    FN
          NJN    RAC7        IF THIS JOB NOT ASSIGNED TO *L* DISPLAY
          LDD    CM+1
          LMD    FN+1
          ZJN    RAC9        IF THIS JOB IS ASSIGNED TO *L* DISPLAY
 RAC7     LDM    BA,T1
          LPC    4210
 RAC8     NJN    RAC9        IF LONG TERM CONNECTION SET
          SOD    T1
          NJN    RAC7        IF CHECK NOT COMPLETE
          LDD    RA          CHECK *CFO* ENABLED
          SHN    6
*         ADN    0           READ RA+0
          CRD    CM
          LDD    CM+3
          SHN    21-2
          PJN    RAC10       IF *CFO* ENTRY NOT ENABLED
 RAC9     LDC    4000        SET LONG TERM ACTIVITY INDICATION
          STD    CN+1
 
*         RETURN RESPONSE TO CALLER.
 
 RAC10    LDN    0           WORD COUNT - 1
          STD    T1
          RJM    CKA         CHECK FOR VALID PARAMETER ADDRESS
          CWD    CN          RETURN ACTIVITY INFORMATION TO CALLER
          LJM    CPMX        EXIT
 MFL      SPACE  4,10
***       FUNCTION 52.
*         SET MFL = PARAMETER.
*
*         ENTRY  (IR+3, IR+4) = RFL REQUEST.
*                BIT 2**11 IN IR+3 IS SET FOR EXTENDED MEMORY REQUEST
*                AND ZERO FOR CM REQUEST.  EXTENDED MEMORY REQUESTS
*                ARE MULTIPLES OF 1000B.
 
 
 MFL      ENTRY
          LDC    NJNI-UJNI   SET ZERO CM PARAMETER CHECK
          RAM    PMPA
          RJM    PMP         PROCESS ARGUMENT
          NJN    MFL1        IF MFL ARGUMENT NON-ZERO
          LDD    CM+2        SET MFL TO MAX FL
 MFL1     STD    CM          SET MFL
          LDD    CM+2
          SBD    CM
          MJN    MFL4        IF MFL .GT. MAX FL
          LDD    IR+3
          SHN    21-13
          MJN    MFL2        IF PROCESSING EXTENDED MEMORY MFL
          LDD    CM
          SBN    CTFL
          PJN    MFL2        IF MFL VALID
          LDN    CTFL
          STD    CM
          AOM    MFLA        SET *ISSUE MESSAGE* FLAG
 MFL2     LDN    0           CLEAR *RFL* VALUE
          STD    CM+1
          LDD    T7          WRITE FL CONTROL WORD
          CWD    CM
          LDN    0
*         LDN    1           (MFL .LT. *CTFL* REQUESTED)
 MFLA     EQU    *-1
          ZJN    MFL3        IF NO MESSAGE TO BE ISSUED
          LDC    =C* MFL REQUEST TOO SMALL, MINIMUM USED.*
          RJM    DFM         ISSUE DAYFILE MESSAGE
 MFL3     LJM    CPMX        EXIT
 
 MFL4     ABORT  ERNV        * XX NOT VALIDATED.*
 CSC      SPACE  4,10
***       FUNCTION 53.
*         ENABLE/DISABLE SRU CALCULATION.
*
*         ENTRY  (IR+3 - IR+4) = 12/FLAG,12/PARAM
*
*                            FLAG = 0 IF DISABLE REQUESTED.
*                                 .NE. 0 IF ENABLE REQUESTED.
*
*                            PARAM = UNIT CHARGE.
 
 
 CSC      ENTRY
          LDD    CP          CLEAR DISABLE SRU CALCULATION
          ADN    MP3W
          CRD    CN
          STD    T1
          LDD    CN          CLEAR DISABLE FLAG
          LPC    3777
          STD    CN
          LDD    T1
          CWD    CN
          LDD    IR+4        CHECK INCREMENT
          ZJN    CSC1        IF NO INCREMENT REQUESTED
          STM    CSCA+4      STORE INCREMENT
          LDD    MA
          CWM    CSCA,ON
          LDN    1
          STD    CM+1
          STD    CM+2
          MONITOR  UADM
 CSC1     LDD    IR+3
          NJN    CSC2        IF ENABLE REQUESTED
          LDC    4000        SET DISABLE
          RAD    CN
          LDD    T1
          CWD    CN
 CSC2     LJM    CPMX        EXIT
 
 CSCA     CON    AIAD        SUBFUNCTION
          CON    ADAW        WORD TO UPDATE
          CON    0D*100+20D  FIELD POSITION AND WIDTH
          CON    0
          CON    0           INCREMENT VALUE
 GPF      SPACE  4,15
***       FUNCTION 57.
*         GET PERMANENT FILE PARAMETERS FROM CONTROL POINT AREA.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS *ADDR* OF 3 WORD BLOCK FOR
*                RESPONSE.
*
*         EXIT   CURRENT CONTROL POINT PARAMETERS RETURNED IN FORMAT -
*
*T ADDR   42/ FAMILY NAME,18/ 0
*T,       42/ PACK NAME,18/ PACK TYPE
*T,       42/ USER NAME,18/ USER INDEX
 
 
 GPF      ENTRY
          LDD    CP          READ PF CONTROL WORD
          ADN    PFCW
          CRD    CM
          ADN    UIDW-PFCW   READ USER NAME AND USER INDEX
          CRD    UN
          ADN    PKNW-UIDW   READ PACKNAME AND PACK TYPE
          CRD    CN
 
*         GET FAMILY NAME.
 
          SFA    EST,CM+3
          ADK    EQDE
          CRD    CM
          LDD    CM+4        READ FAMILY NAME
          SHN    3
          ADN    PFGL
          CRD    FN
 
*         SET UP WORDS FOR PARAMETER BLOCK.
 
          LDN    0           CLEAR LOWER PORTION OF FAMILY NAME WORD
          STD    FN+4
          LDD    FN+3
          SCN    77
          STD    FN+3
          LDD    UN+3        SET USER INDEX
          SCN    40
          STD    UN+3
 
*         WRITE WORDS TO PARAMETER BLOCK.
 
          LDN    2           CHECK ADDRESS
          STD    T1
          RJM    CKA
          CWD    FN          WRITE FAMILY NAME
          ADN    1           WRITE PACKNAME AND PACK TYPE
          CWD    CN
          ADN    1           WRITE USER NAME AND USER INDEX
          CWD    UN
          LJM    CPMX        EXIT
 JCI      SPACE  4,30
***       FUNCTION 74.
*         JOB CONTROL INFORMATION.
*
*         ENTRY  (IR+3 - IR+4) = 6/FN,1/0,17/ADDRESS OF PARAMETER BLOCK
*                                FN = 0 FOR GETJCI
*                                FN = 1 FOR SETJCI
*
*         EXIT   TWO-WORD PARAMETER BLOCK CONTAINS
*
*T,              6/EFG,18/REG,12/CCL,12/EM,6/SSW,6/0
*T,              6/EF,18/R3,18/R2,18/R1
*                       WHERE
*                       EFG = GLOBAL ERROR FLAG.
*                       REG = GLOBAL REGISTER.
*                       CCL = RESERVED FOR CCL USE.
*                       EM = EXIT MODE.
*                       SSW = SENSE SWITCHES.
*                       EF = LAST ERROR FLAG ENCOUNTERED.
*                       R3 = JOB CONTROL REGISTER 3.
*                       R2 = JOB CONTROL REGISTER 2.
*                       R1 = JOB CONTROL REGISTER 1.
*
*         USES   EP, IR+3, T1, BA - BA+4, CM - CM+4, CN - CN+4,
*                FN - FN+4.
*
*         CALLS  CKA.
 
 JCI      ENTRY
          LDD    IR+3        SAVE SUBFUNCTION CODE
          STD    EP
          LPN    77          CLEAR OUT SUBFUNCTION CODE
          STD    IR+3
          LDN    2           WORD COUNT
          STD    T1
          RJM    CKA         CHECK ADDRESS
          CRD    FN
          CRD    BA
          ADN    1           READ SECOND WORD
          CRD    CN
          LDD    EP          CHECK FOR SUBFUNCTION
          SHN    -6
          ZJN    JCI1        IF GET JOB CONTROL INFORMATION
          LJM    JCI2        SET JOB CONTROL INFORMATION
 
*         GET JOB CONTROL INFORMATION TO RETURN TO USER.
 
 JCI1     LDD    CP          GET JOB CONTROL INFORMATION
          ADC    JCDW
          CRM    TJCI,T1
          LDD    CP          GET EXIT MODE FROM EXCHANGE PACKAGE
          ADN    3
          CRD    CN
          ADN    SNSW-3      GET SENSE SWITCHES
          CRD    CM
          LDD    CN
          STM    TJCI+3
          LDD    CM+4
          SCN    77
          STM    TJCI+4
 
*         RETURN PARAMETER BLOCK TO SPECIFIED ADDRESS.
 
          RJM    CKA         GET ADDRESS
          CWM    TJCI,T1
          LJM    CPMX
 
*         RETURN JOB CONTROL INFORMATION.
 
 JCI2     LDD    CP          SET SENSE SWITCHES
          ADN    SNSW
          CRD    CM
          LDD    CM+4
          LPN    77
          STD    CM+4
          LDD    FN+4
          SCN    77
          RAD    CM+4
          LDD    CP          REWRITE WORD SNSW
          ADN    SNSW
          CWD    CM
          ADN    SEPW-SNSW   GET SPECIAL ENTRY POINT WORD
          CRD    CM
          ADN    JCRW-SEPW   REPLACE JOB CONTROL REGISTERS
          CWD    CN
          SBN    JCRW-JCDW   GET JOB CONTROL DATA
          CRD    CN
          LDD    FN          REPLACE GLOBAL ERROR FLAG
          STD    CN
          LDD    FN+1        REPLACE GLOBAL REGISTER
          STD    CN+1
          LDD    CM          CHECK IF SSJ=
          SHN    21-2
          PJN    JCI3        IF NOT *SSJ=*
          LDD    FN+2        SET CCL DATA
          STD    CN+2
 JCI3     LDD    CP          REPLACE WORD *JCDW*
          ADC    JCDW
          CWD    CN
          LJM    CPMX        RETURN
 
 TJCI     BSS    2*5
 PRO      SPACE  4,15
***       FUNCTION 75.
*         *PROTECT* MACRO PROCESSOR TO SET/CLEAR JOB CONTROL FLAGS
*         IN WORD *JCIW* OF THE CONTROL POINT AREA.
*
*         ENTRY  (IR+3 - IR+4) = 6/ , 6/OFF , 6/ , 6/ ON
*                OFF = FLAGS TO CLEAR IN JOB CONTROL FIELD OF *JCIW*.
*                ON = FLAGS TO SET IN JOB CONTROL FIELD OF *JCIW*.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         MACROS ABORT, MONITOR.
 
 
 PRO      ENTRY
          LDD    IR+4        CHECK FOR ECS PROTECTION REQUEST
          LPN    1
          ZJN    PRO1        IF NOT EXTENDED MEMORY PROTECTION
          LDD    CP          READ ACCOUNT ACCESS CONTROL WORD
          ADK    AACW
          CRD    CN
          LDD    CN+3        CHECK PROTECT FUNCTION VALIDATION
          SHN    21-2
          MJN    PRO1        IF USER VALIDATED TO PROTECT ECS
          ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
 
*         CLEAR JOB CONTROL FLAGS IN *JCIW*.
 
 PRO1     LDD    IR+3
          LPN    77
          ZJN    PRO2        IF NO CLEAR REQUEST
          STD    CM+4
          LDN    CCTS        SELECT CLEAR JOB CONTROL FLAG(S)
          STD    CM+1
          MONITOR  SJCM
 
*         SET JOB CONTROL FLAGS IN *JCIW*.
 
 PRO2     LDD    IR+4
          LPN    77
          ZJN    PRO3        IF NO SET REQUEST
          STD    CM+4
          LDN    SCTS        SELECT SET JOB CONTROL FLAG(S)
          STD    CM+1
          MONITOR  SJCM
 PRO3     LJM    CPMX        DROP PP AND EXIT TO PP RESIDENT
 SOV      SPACE  4,10
***       FUNCTION 76.
*         SET/CLEAR *OVERRIDE* REQUIRED TO DROP JOB FLAG.
*         CALLER MUST HAVE SSJ= ENTRY POINT.
*
*         ENTRY  (IR+4) = 0, IF CLEAR *OVERRIDE* FLAG, .NE. 0, IF
*                            SET *0VERRIDE* FLAG.
*
*         USES   CN - CN+4.
 
 
 SOV      ENTRY
          LDD    CP          READ *SNSW* WORD FROM CPA
          ADN    SNSW
          CRD    CN
          LDD    CN          CLEAR *OVERRIDE* FLAG
          LPC    6777
          STD    CN
          LDD    IR+4        CHECK OPTION
          ZJN    SOV1        IF CLEAR REQUEST
          LDD    TH          SET *OVERRIDE* FLAG
          RAD    CN
 SOV1     LDD    CP          WRITE *SNSW*
          ADN    SNSW
          CWD    CN
          LJM    CPMX        EXIT
 RNR      SPACE  4,10
***       FUNCTION 107.
*         SET ROLLOUT ALLOWED OR ROLLOUT INHIBITED.
*
*         CALLER MUST HAVE *SSJ=* ENTRY POINT.
*
*         ENTRY  (IR+4) = 0 IF JOB ROLLOUT TO BE ALLOWED.
*                       = 1 IF JOB ROLLOUT TO BE INHIBITED.
*                       = 2 IF OPERATOR ROLLOUT TO BE ALLOWED.
 
 
 RNR      ENTRY
          LDD    IR+4        VALIDATE SUBFUNCTION
          SBN    TRNRL
          MJN    RNR1        IF LEGAL SUBFUNCTION
          ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 RNR1     LDD    CP          GET SUBSYSTEM IDENTIFICATION
          ADN    JCIW
          CRD    CM
          LDN    TRNRL       CHECK FOR CURRENT ID IN TABLE
          STD    T1
 RNR2     SOD    T1
          MJN    RNR3        IF END OF TABLE
          LDM    TRNR,T1
          LMD    CM+2
          NJN    RNR2        IF NO MATCH
          LDM    TRNR,IR+4   GET NEW SUBSYSTEM IDENTIFICATION
          STD    CM+4
          LDN    SSIS        CHANGE SUBSYSTEM ID
          STD    CM+1
          MONITOR  SJCM
 RNR3     LJM    CPMX        EXIT
 
 
 TRNR     BSS    0           TABLE OF ROLL/NO ROLL IDENTIFICATIONS
          LOC    0
          CON    0           ALLOW JOB ROLLOUT
          CON    IRSI        INHIBIT JOB ROLLOUT
          CON    ORSI        ALLOW OPERATOR ROLLOUT
          LOC    *O
 TRNRL    EQU    *-TRNR      TABLE LENGTH
 GSI      SPACE  4,10
***       FUNCTION 110.
*         GET SUBSYSTEM ID.
*
*         ENTRY  (IR+3 - IR+4) = 7/0, 17/ ADDRESS OF PARAMETER WORD.
*
*         EXIT   PARAMETER WORD CONTAINS -
*T        48/0, 12/ SSID
*         SSID = SUBSYSTEM ID (VALUES DEFINED IN *COMSSSD*).
 
 
 GSI      ENTRY
          LDD    CP          GET SUBSYSTEM ID
          ADN    JCIW
          CRD    CM+2
          LDN    ZERL
          CRD    CM-1
          LDN    1           SET WORD COUNT OF PARAMETER BLOCK
          STD    T1
          RJM    CKA         GET ADDRESS OF PARAMETER WORD
          CWD    CM
          LJM    CPMX        RETURN
 RSO      SPACE  4,15
***       FUNCTION 111.
*
*         READ SERVICE CLASS AND ORIGIN TYPE TO (PARAMETER).
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMTER WORD.
*
*         EXIT   SERVICE CLASS (SC) AND ORIGIN TYPE (OT) RETURNED
*                IN THE FORMAT -
*T ADDR   48/0, 6/SC, 6/OT
*         SC     JOB SERVICE CLASS.
*         OT     JOB ORIGIN TYPE.
 
 
 RSO      ENTRY
          LDC    SCNI+60
          STM    ROTA
          LJM    ROT1        BEGIN PROCESSING
 GAL      SPACE  4,20
***       FUNCTION 116.
*
*         RETURN JOB ACCESS LEVEL AND ACCESS LEVEL LIMITS
*         TO THE CALLING PROGRAM.
*
*         ENTRY  (IR+3 - IR+4) = ADDR (ADDRESS OF REPLY WORD).
*
*         EXIT   REPLY WORD UPDATED.
*
*T ADDR   42/ , 6/ LAL, 6/ UAL, 6/ JAL.
*         LAL = JOB LOWER ACCESS LEVEL LIMIT.
*         UAL = JOB ACCESS LEVEL UPPER LIMIT.
*         JAL = JOB ACCESS LEVEL.
*
*         USES   BA - BA+4, CM - CM+4, CN - CN+4.
*
*         CALLS  CKA.
*
*         MACROS SFA.
 
 
 GAL      ENTRY
          LDN    ZERL        CLEAR REPLY WORD
          CRD    CM
          LDD    CP
          ADK    TERW        GET EJT ORDINAL
          CRD    BA
          ADK    JSCW-TERW   READ SECURITY CONTROL WORD
          CRD    CN
          SFA    EJT,BA      GET JOB ACCESS LEVEL LIMITS
          ADK    PRFE
          CRD    BA
          LDD    BA+2        EXTRACT JOB ACCESS LEVEL UPPER LIMIT
          LPN    7
          SHN    6
          STD    CM+4
          LDD    BA+2        EXTRACT JOB ACCESS LEVEL LOWER LIMIT
          SHN    -3
          LPN    7
          STD    CM+3
          LDD    CN+1        GET JOB ACCESS LEVEL
          SHN    -11
          RAD    CM+4
          RJM    CKA         WRITE REPLY WORD
          CWD    CM
          LJM    CPMX        RETURN
 SAL      SPACE  4,20
***       FUNCTION 117.
*
*         SETS THE JOB ACCESS LEVEL TO THE VALUE REQUESTED.
*
*         ENTRY  (IR+3 - IR+4) = ADDR (ADDRESS OF REQUEST WORD).
*
*T ADDR   57/0, 3/AL
*         AL = ACCESS LEVEL.
*
*         EXIT   JOB ACCESS LEVEL RESET IF VALID.
*                *SVET* ERROR CODE SET IF INCORRECT AND JOB ABORTED.
*
*         USES   T1, CM - CM+4, CN - CN+4.
*
*         CALLS  ACS, CKA, DFM.
*
*         MACROS ABORT, MONITOR.
 
 
 SAL      ENTRY
          RJM    CKA         READ REQUEST WORD
          CRD    CM
          LDD    CM+4        GET LEVEL REQUESTED
          SBN    10
          MJN    SAL1        IF LEVEL IN RANGE 0-7
          ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 SAL1     LDD    SM
          NJN    SAL2        IF SYSTEM IN SECURE MODE
          LJM    CPMX        RETURN
 
*         VALIDATE ACCESS LEVEL OF JOB.
 
 SAL2     LDK    VJAS        SET SUBFUNCTION CODE
          STD    CM+1
          MONITOR  VSAM      VALIDATE AND SET JOB ACCESS LEVEL
          LDD    CM+1
          NJN    SAL3        IF SECURITY VIOLATION
          LJM    CPMX        RETURN
 
*         SET ERROR FLAG AND ABORT.
 
 SAL3     LDC    SALA+3      SET POINTER TO END OF ERROR MESSAGE
          STD    T1
          LDD    CP          READ JOB SECURITY PARAMETERS
          ADC    JSCW
          CRD    CN
          LDD    CN+1        GET CURRENT ACCESS LEVEL
          SHN    -7
          LPN    34
          ADC    TALV        FORM INDEX INTO LEVEL STRING TABLE
          RJM    ACS         APPEND STRING TO MESSAGE
          LDC    =C*, *      APPEND COMMA AND SPACE TO MESSAGE
          RJM    ACS
          LDD    CM+4        GET REQUESTED ACCESS LEVEL
          SHN    2           FORM INDEX INTO LEVEL STRING TABLE
          ADC    TALV
          RJM    ACS         APPEND STRING TO MESSAGE
          LDC    =C*. *      APPEND PERIOD TO MESSAGE
          RJM    ACS
          LDC    SALA+ACFN   ISSUE ACCOUNT FILE MESSAGE
          RJM    DFM
          LDN    SVET        SET SECURITY VIOLATION ERROR FLAG
          ERRPL  PPET-SVET   *SVET* MUST BE HIGHER PRIORITY THAN *PPET*
          STD    CM+1
          MONITOR  CEFM
          ABORT  ERIJ        *CPM - INCORRECT JOB ACCESS LEVEL.*
 
 SALA     DATA   C*MJJI, *
 SALB     BSSZ   9D
 USV      SPACE  4,20
***       FUNCTION 120.
*
*         RETURNS CONTROL POINT AREA WORD *JSCW* TO THE REQUESTING
*         PROGRAM.  THE CALLER MUST HAVE AN SSJ= ENTRY POINT OR
*         A SUBSYSTEM ID.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF REPLY WORD.
*
*         EXIT   (REPLY WORD) = CONTROL POINT WORD *JSCW*.
*
*         USES   CM - CM+4.
*
*         CALLS  CKA.
*
*         MACROS ABORT.
 
 
 USV      ENTRY
          LDD    CP          READ *JSCW*
          ADC    JSCW
          CRD    CM
          RJM    CKA         SET ADDRESS
          CWD    CM          WRITE REPLY WORD
          LJM    CPMX        RETURN
 IPD      SPACE  4,10
***       FUNCTION 121.
*
*         INCREMENT CURRENT PACKED DATE BY SPECIFIED TERM.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T ADDR   48/0, 12/ TERM
*
*         EXIT   NEW PACKED DATE SET IN PARAMETER WORD.
*T ADDR   42/0, 18/ DATE
 
 
 IPD      ENTRY
          RJM    CKA
          CRD    CM          READ PARAMETER WORD
          LDN    RIDS
          STD    CM+1
          MONITOR  RDCM      REQUEST DATA CONVERSION
          LDD    MA          RETURNED UPDATED DATE
          CRD    CN
          RJM    CKA
          CWD    CN
          LJM    CPMX        EXIT
 EPW      SPACE  4,10
***       FUNCTION 122.
*
*         ENCRYPT PASSWORD.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T  ADDR  60/ PASSWORD
*
*         EXIT
*T  ADDR  60/ ENCRYPTED PASSWORD
 
 
EPW       ENTRY
          RJM    CKA         READ PASSWORD
          CRD    CM
          LDD    MA          SET *RDCM* PARAMETERS
          CWD    CM
          LDN    ZERL
          CRD    CM
          LDN    REPS
          STD    CM+1
          MONITOR  RDCM      REQUEST DATA CONVERSION
          LDD    MA          RETURN ENCRYPTED PASSWORD
          CRD    CM
          RJM    CKA
          CWD    CM
          LJM    CPMX        EXIT
 LOG      SPACE  4,10
***       FUNCTION 132.
*
*         PROCESS LOGOUT.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
*T PARAM  42/ANAME, 18/
*                ANAME = NEXT NAM APPLICATION NAME.
*
*         EXIT   LOGOUT REQUEST SENT TO *IAF* IF JOB ONLINE.
 
 
 LOG      ENTRY
          RJM    CKA         READ APPLICATION NAME
          CRD    BA
          LDD    CP          READ TERMINAL NUMBER
          ADN    TTNW
          CRD    CN
          ADN    TFSW-TTNW   READ EJT ORDINAL
          CRD    CM
          SFA    EJT,CM      READ CONNECTION STATUS
          ADK    JSNE
          CRD    CM
          LDD    CM+4
          SHN    -7
          LPN    17
          LMN    OLCS
          NJP    CPMX        IF NOT ONLINE CONNECTION STATUS
          LDC    VCPT*200+FLSW  SET *IAF* RA
          CRD    FN+3
          LDN    ZERL
          CRD    CM
          CRD    FN
          LDC    VTLF        SET LOGOUT REQUEST
          STD    FN
          LDD    CN+1        SET TERMINAL NUMBER
          STD    TN
 LOG1     LDN    1           SET POTS REQUIRED COUNT
          STD    CM+1
          MONITOR  TGPM      MAKE POT REQUEST
          LDD    CM+1
          ZJP    LOG5        IF *IAF* NOT ACTIVE
          LMC    7777
          NJN    LOG3        IF POTS AVAILABLE
          LDC    600         SET DELAY
          STD    T1
 LOG2     DELAY
          SOD    T1
          NJN    LOG2        IF DELAY NOT COMPLETE
          UJN    LOG1        REISSUE REQUEST
 
 LOG3     LDD    CM+1        SET POT POINTER
          STD    PP
          RJM    PIR         PRESET WITH IAF R-REGISTER
          RJM    SRR         SET R-REGISTER TO IAF RA
          RJM    SPA         SET POT ADDRESS
          CWD    BA
          RJM    RRR         RESTORE R-REGISTER
 LOG4     LDD    MA
          CWD    FN
          LDK    ZERL
          CRD    CM
          MONITOR  TSEM      ENTER *IAF* REQUEST
          LDD    CM+1
 LOG5     ZJN    LOG7        IF *IAF* NOT ACTIVE
          LMC    7777
          NJN    LOG7        IF REQUEST ENTERED
          PAUSE  ST
          LDC    600         SET DELAY TIME
          STD    T1
 LOG6     DELAY
          SOD    T1
          NJN    LOG6        IF DELAY NOT COMPLETE
          UJN    LOG4        REISSUE REQUEST
 
 LOG7     LJM    CPMX        EXIT
 GLV      SPACE  4,10
***       FUNCTION 133.
*         GET SYSTEM PSR LEVEL.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF WORD TO RECEIVE LEVEL.
*
*         EXIT   SYSTEM PSR LEVEL SET IN SPECIFIED WORD
*                (RIGHT JUSTIFIED, ZERO FILLED).
 
 
 GLV      ENTRY
          LDN    ZERL
          CRD    CM
          LDC    NOSLVL      GET SYSTEM PSR LEVEL
          STD    CM+4
 GLV1     RJM    CKA         RETURN LEVEL TO CALLER
          CWD    CM
          LJM    CPMX        EXIT
          SPACE  4,30
***       FUNCTION 134.
*
*         RETURN REPRIEVE INFORMATION.
*
*         ENTRY  (IR+3 -IR+4) = PARAMETER WORD ADDRESS.
*
*         EXIT   THE FOLLOWING INFORMATION WILL BE RETURNED.
*
*T PARAM  5/FLAGS,19/0,12/MASK,6/0,18/ADDR
*
*         FLAGS = ZERO, IF NO REPRIEVE CONDITION SET.
*               = BIT 59 SET, IF *EREXIT* SET
*                 (*EECW* BITS 58 AND 46-36 ZERO, BITS 17-0 NONZERO).
*               = BIT 58 SET, IF NORMAL REPRIEVE CONDITIONS SET
*                 (*EECW* BITS 58 AND 47 NOT SET, BITS 46-36 NONZERO).
*               = BIT 57 SET, IF EXTENDED REPRIEVE CONDITIONS SET
*                 (*EECW* BIT 58 SET, BIT 57 NOT SET).
*               = BIT 56 SET, IF NORMAL REPRIEVE IN PROGRESS
*                 (*EECW* BIT 58 NOT SET, BIT 47 SET, AND BITS 46-36
*                 NONZERO).
*               = BIT 55 SET, IF EXTENDED REPRIEVE IN PROGRESS
*                 (*EECW* BITS 58 AND 57 SET).
*         MASK  = NORMAL REPRIEVE MASK BITS (IF NORMAL REPRIEVE
*                 CONDITION SET).
*               = ZERO (OTHERWISE).
*         ADDR  = ADDRESS OF EXTENDED REPRIEVE PARAMETER BLOCK
*                 (IF EXTENDED REPRIEVE CONDITION SET).
*               = ERROR EXIT RETURN ADDRESS (IF NORMAL REPRIEVE
*                 CONDITION SET OR *EREXIT* SET).
*               = ZERO (OTHERWISE).
 
 
 RRI      ENTRY
          LDD    CP          READ *EECW*
          ADN    EECW
          CRD    CM
          LDD    CM          ISOLATE EXTENDED REPRIEVE FLAG
          SHN    21-12
          MJN    RRI5        IF EXTENDED REPRIEVE SET
          LDD    CM+1        ISOLATE REPRIEVE MASK
          SHN    21-13
          MJN    RRI1        IF NORMAL REPRIEVE IN PROGRESS
          ZJN    RRI2        IF MASK ZERO
 RRI1     LJM    RRI9        PROCESS NORMAL REPRIEVE CONDITION
 
 RRI2     LDD    CM+3        TEST REPRIEVE ADDRESS
          LPN    37
          STD    CM+3        CLEAN UP REPRIEVE ADDRESS
          ADD    CM+4
          ZJN    RRI3        IF NO REPRIEVE ADDRESS
 
*         PROCESS ERROR CONDITION SET.
 
          LDC    4000        SET BIT 59
          STD    CM
          UJN    RRI4        RETURN INFORMATION
 
*         PROCESS NO REPRIEVE CONDITION.
 
 RRI3     LDN    ZERL        RETURN A WORD OF ZERO
          CRD    CM
 
*         RETURN INFORMATION.
 
 RRI4     RJM    CKA         CHECK PARAMETER ADDRESS
          CWD    CM          WRITE WORD
          LJM    CPMX        EXIT
 
*         PROCESS EXTENDED REPRIEVE CONDITION SET.
 
 RRI5     LDD    CM          CHECK FOR EXTENDED REPRIEVE IN PROGRESS
          SHN    21-11
          MJN    RRI7        IF EXTENDED REPRIEVE IN PROGRESS
          LDD    CM+3
          LPN    37
          STD    CM+3        CLEAN UP REPRIEVE ADDRESS
          LDC    1000        SET BIT 57
          STD    CM
 RRI6     LDN    0
          STD    CM+1        CLEAR CM+1 - CM+2
          STD    CM+2
          UJN    RRI4        RETURN INFORMATION
 
*         PROCESS EXTENDED REPRIEVE IN PROGRESS.
 
 RRI7     LDC    200         SET BIT 55
          STD    CM
 RRI8     LDN    0
          STD    CM+3        CLEAR CM+3 - CM+4
          STD    CM+4
          UJN    RRI6        RETURN INFORMATION
 
*         PROCESS NORMAL REPRIEVE CONDITION SET.
 
 RRI9     MJN    RRI10       IF NORMAL REPRIEVE IN PROGRESS
          LDD    CM+3
          LPN    37
          STD    CM+3        CLEAN UP REPRIEVE ADDRESS
          LDD    CM+1
          STD    CM+2        SAVE MASK IN NEW BYTE
          LDN    0
          STD    CM+1        CLEAR CM+1
          LDC    2000        SET BIT 58
          STD    CM
          LJM    RRI4        RETURN INFORMATION
 
*         PROCESS NORMAL REPRIEVE IN PROGRESS.
 
 RRI10    LDC    400         SET BIT 56
          STD    CM
          UJN    RRI8        RETURN INFORMATION
 RCT      SPACE  4,10
***       FUNCTION 137.
*         RETURN CONSOLE TYPE.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
*         EXIT   CONSOLE TYPE RETURNED TO PARAMETER WORD ADDRESS.
 
 
 RCT      ENTRY
          LDN    DSEQ        FETCH EST ENTRY FOR DISPLAY
          SFA    EST
          ADK    EQAE        CONSOLE TYPE TO (CM)
          CRD    T6
          LDN    ZERL        INSERT TRAILING ZERO FILL
          CRD    CM+1
          UJP    GLV1        RETURN TYPE TO CALLER
          TITLE  SUBROUTINES.
 PMP      SPACE  4,20
**        PMP - PROCESS MEMORY PARAMETERS.
*
*         ENTRY  (IR+3 - IR+4) = RFL REQUEST.
*                BIT 2**11 IN IR+3 IS SET FOR EXTENDED MEMORY REQUEST
*                AND ZERO FOR CM REQUEST.  EXTENDED MEMORY REQUESTS
*                ARE MULTIPLES OF 1000B.
*
*         EXIT   (A) = FL REQUEST (CM/100B OR EM/*UEBS*).
*                (CM - CM+4) = FL CONTROL WORD (FLCW OR ELCW).
*                (T7) = ADDRESS OF FL CONTROL WORD TO UPDATE.
*                (ERRA - ERRA+1) = REQUEST TYPE.
*
*         ERROR  TO *ERR*, IF ARGUMENT ERROR.
*
*         USES   T6, T7, CM - CM+4, CN - CN+4.
*
*         MACROS ABORT.
 
 
 PMP2     ABORT  ERNV        * XX NOT VALIDATED.*
 
 PMP3     LDC    2REC        SET *EC* RESOURCE TYPE
          STM    ERRA
          LDD    CP          READ EXTENDED MEMORY FL CONTROL WORD
          ADN    ELCW
          STD    T7
          CRD    CM
          LDN    17          ROUND BY BLOCKING FACTOR
 PMPB     SHN    0
*         SHN    UESC-4
          ADD    IR+4
          STD    T6
          SHN    -14
          ADD    IR+3
          LPN    37
          SHN    14
          LMD    T6
 PMPC     SHN    0
*         SHN    -UESC
          STD    T6
          SHN    -13
 PMP4     NJN    PMP2        IF .GT. 3777B BLOCKS
 PMP5     LDD    T6
 
 PMP      SUBR               ENTRY/EXIT
          LDD    IR+3        CHECK IF CM OR EXTENDED MEMORY REQUEST
          SHN    21-13
          MJN    PMP3        IF EXTENDED MEMORY REQUEST
          LDC    2RCM        SET *CM* RESOURCE TYPE
          STM    ERRA
          LDD    CP          READ CM FL CONTROL WORD
          ADN    FLCW
          STD    T7
          CRD    CM
          SBN    FLCW-ECSW   READ EXTENDED MEMORY STATUS WORD
          CRD    CN
          LDD    IR+3        ROUND CM FL REQUEST
          LPN    37
          SHN    14
          LMD    IR+4
          ADN    77
          MJN    PMP4        IF CM FL REQUEST TOO LARGE
          SHN    -6
          STD    T6
          LDD    CN+4
          ZJN    PMP5        IF NO EXTENDED MEMORY CURRENTLY ASSIGNED
          LDD    T6
 PMPA     UJN    PMP1        PROCESS *RFL* PARAMETER
*         NJN    PMP1        (PROCESS *MFL* NON-ZERO PARAMETER)
          LDD    CM+2        CHECK MAXFL
 PMP1     ADC    -MCMX/100
          PJN    PMP5        IF AT LEAST *MCMX* WORDS REQUESTED
          LDC    MCMX/100    SET *MCMX* WORDS
          STD    T6
          LJM    PMPX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPACS
 VAL$     EQU    1
*CALL     COMPVLC
          SPACE  4,10
**        BUFFER DEFINITIONS.
 
 
          USE    BUFFERS
 
 RVNA     EQU    *           VERSION NAME
 RVNB     EQU    RVNA+6*5    RECEIVING FIELD
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET CONTROL POINT MANAGER.
*
*         EXIT   (CN - CN+4) = (JCIW) = JOB CONTROL INFORMATION.
*                (EP) = SPECIAL ENTRY POINT FLAGS.
*                (OT) = JOB ORIGIN TYPE.
*                (SM) = SYSTEM SECURITY MODE.
*
*         ERROR  TO *ERR*, IF INCORRECT REQUEST.
*
*         MACROS ABORT.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDK    MEFL        PRESET SHIFT INSTRUCTIONS
          CRD    CM
          LDD    CM+2
          SHN    -11
          STD    T0
          ADC    SHNI+77-4
          STM    PMPB
          LDC    SHNI+77
          SBD    T0
          STM    PMPC
          LDD    CP          READ SPECIAL ENTRY POINT WORD
          ADN    STSW        CHECK ERROR FLAG
          CRD    CM
          ADN    SEPW-STSW
          CRD    CN
          LDD    CM+1
          SBN    SPET
          MJN    PRS0        IF NOT SPECIAL ERROR FLAG
          LJM    CPMX        EXIT *CPM*
 
 PRS0     LDD    CN          SAVE ENTRY POINTS
          STD    EP
          LDD    IR+2
          LMC    ACPF
          ZJN    PRS0.1      IF ASSIGN CIO PPU FUNCTION
          RJM    CRS         CHECK RECALL STATUS
          ZJN    PRS1        IF NO AUTO RECALL
 PRS0.1   RJM    IFP         INITIALIZE MANAGED TABLE PROCESSORS
          LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      CALCULATE EJT ENTRY ABSOLUTE ADDRESS
          ADN    SCLE        GET JOB ORIGIN TYPE
          CRD    CM
          LDD    CM
          LPN    17
          STD    OT
          LDD    IR+2        CHECK FUNCTION CODE
          SHN    1
          ADD    IR+2
          STD    T7
          ADC    -TFCNL
          MJN    PRS2        IF LEGAL CODE
 PRS1     ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 PRS2     LDM    TFCN+1,T7
          ZJN    PRS1        IF UNDEFINED FUNCTION CODE
          STM    CPMB        SAVE THE ADDRESS OF FUNCTION
          LDD    CP          READ JOB CONTROL INFORMATION
          ADK    JCIW
          CRD    CN
          LDM    TFCN+2,T7   CHECK ORIGIN CONTROL
          LPC    3777
          ZJN    PRS3        IF NO CONTROL BITS
          STD    T1
          LCN    0           SET BIT SHIFT
          LMD    OT
          RAM    PRSA
          LDD    T1          CHECK BITS
 PRSA     SHN    21
          MJN    PRS4        IF LEGAL FUNCTION FOR JOB ORIGIN TYPE
          LDM    TFCN+2,T7   GET FUNCTION PROCESSOR ADDRESS
          SHN    21-13
          MJN    PRS3.1      IF *SSJ=* REQUIRED
          UJN    PRS1        ABORT
 
 PRS3     LDM    TFCN+2,T7   GET FUNCTION PROCESSOR ADDRESS
          SHN    21-13
          PJN    PRS4        IF SSJ= NOT REQUIRED
 PRS3.1   LDD    EP          CHECK *SSJ=* ENTRY POINT
          SHN    21-2
          MJN    PRS4        IF *SSJ=*
          LDD    CN+2
          ADK    -LSSI
          MJP    PRS1        IF NOT SUBSYSTEM
 PRS4     LDK    SSML        GET SYSTEM SECURITY MODE
          CRD    CM
          LDD    CM
          LPN    3
          STD    SM
          LDM    TFCN,T7     SET OVERLAY NAME
          STM    CPMA
          LJM    PRSX        RETURN
 TFCN     SPACE  4,15
**        TFCN - TABLE OF FUNCTION CODE PROCESSORS.
*         ENTRY = 3 WORDS.
*
*T,       12/ NAME , 12/ ADDR , 12/ BITS
*
*         NAME   OVERLAY NAME
*         ADDR   ADDRESS OF FUNCTION PROCESSOR
*         BITS   BITS FOR JOB ORIGIN CONTROL
*                BIT         MEANING
*                11          SET IF SSJ= ENTRY POINT REQUIRED.
*                10 - 0      SET IF CORRESPONDING ORIGIN TYPE REQUIRED.
 
 
 TFCN     BSS    0
 
          FCN    PRS1        SET QUEUE PRIORITY (SUPPORT REMOVED)
          FCN    SPR         SET CPU PRIORITY
          FCN    SEM         SET EXIT MODE
          FCN    SLL         SET LIMIT
          FCN    SEE         SET ERROR EXIT ADDRESS
          FCN    SDA         SET *K* DISPLAY CONTROLS
          FCN    ROC         ROLLOUT JOB
          FCN    NEX         NOEXIT
          FCN    SSM         SECURE SYSTEM MEMORY
          FCN    ONS         TURN ON SENSE SWITCHES
          FCN    OFS         TURN OFF SENSE SWITCHES
          FCN    RJN         READ JSN
          FCN    PRS1        GET QUEUE PRIORITY (SUPPORT REMOVED)
          FCN    RPR         READ CPU PRIORITY
          FCN    PRS1        READ EXIT MODE
          FCN    RLM         RETRIEVE LIMIT
          FCN    EDI,,SSJ    ENTER DEMAND INDEX
          FCN    SUI,(SYOT)  SET USER INDEX
          FCN    SLC         SET LOADER CONTROL WORD
          FCN    RFL         SET LAST RFL
          FCN    PRS1        READ JOB CONTROL WORD
          FCN    PRS1        SET JOB CONTROL WORD
          FCN    SSB         SET SUBSYSTEM FLAG
          FCN    ROT         READ JOB ORIGIN
          FCN    RAI         READ ACCOUNTING INFORMATION
          FCN    SCP         SELECT CPU TO RUN IN
          FCN    PRS1        RETURN USER NAME
          FCN    PRS1        READ FL CONTROL WORD
          FCN    EET,(SYOT),SSJ  ENTER EVENT IN SYSTEM EVENT TABLE
          FCN    SPN         SET PACKNAME
          FCN    RPN         RETURN PACKNAME
          FCN    PRS1        GET SUBSYSTEM FLAG
          FCN    VAN,,SSJ    VALIDATE ACCOUNT NUMBER
          FCN    FAM,(SYOT)  ENTER FAMILY NAME
          FCN    BAB,,SSJ    BEGIN ACCOUNT BLOCK
          FCN    PRS1        DISABLE SSJ=
          FCN    RVN         RETURN VERSION NAME
          FCN    PRS1        GET LOADER CONTROL WORD
          FCN    GLS         GET GLOBAL LIBRARY SET
          FCN    SLS         SET GLOBAL LIBRARY SET
          FCN    PRS1        RETURN MACHINE ID
          FCN    RAC         RETURN JOB ACTIVITY INFORMATION
          FCN    MFL         SET MAXIMUM FIELD LENGTH
          FCN    CSC,,SSJ    TOGGLE SRU CALCULATION
          FCN    PRS1        RESERVED
          FCN    PRS1        READ EXTENDED MEMORY FL CONTROL WORD
          FCN    VAL         VALIDATE USER
          FCN    GPF         GET PERMANENT FILE PARAMETERS
          FCN    SPF,,SSJ    SET PERMANENT FILE PARAMETERS
          FCN    CKA1        GET LIST OF FILES ADDRESS
          FCN    CKA1        SET LIST OF FILES ADDRESS
          FCN    PRS1        GET END OF JOB INFORMATION
          FCN    CKA1,,SSJ   INCREMENT AUC ACCUMULATOR
          FCN    PRS1        SET/CLEAR *UTL=* ENTRY POINT
          FCN    PRS1        RESERVED FOR CPUMTR
          FCN    PRS1        RESERVED FOR CPUMTR
          FCN    PRS1        RESERVED FOR CPUMTR
          FCN    PRS1        RESERVED FOR CPUMTR
          FCN    PRS1        RESERVED FOR CPUMTR
          FCN    DFC,(SYOT)  DECREMENT FAMILY USER COUNT
          FCN    JCI         JOB CONTROL INFORMATION
          FCN    PRO         SET/CLEAR JOB CONTROL FLAGS
          FCN    SOV,,SSJ    SET/CLEAR *OVERRIDE* FLAG
          FCN    IAA         INITIATE APPLICATION ACCOUNTING
          FCN    SPB         SET PAUSE BIT
          FCN    SPS         SYSTEM ORIGIN PRIVILEGES STATUS
          FCN    TDC         TRANSFER *L* DISPLAY DATA TO CMR
          FCN    TDU         TRANSFER *L* DISPLAY COMMAND TO USER-S FL
          FCN    SPC,,SSJ    SET PROLOGUE/EPILOGUE CONTROLS
          FCN    PRS1        RESERVED
          FCN    SJB         SET JOB CHARACTERISTICS
          FCN    RNR,,SSJ    SET ROLL/NO ROLL
          FCN    GSI         GET SUBSYSTEM ID
          FCN    RSO         READ SERVICE CLASS AND JOB ORIGIN
          FCN    SOD         SET OPERATOR DISPLAY MESSAGE
          FCN    SSC         SET *SHELL* CONTROL
          FCN    SCC,,SSJ    DECREMENT SECURITY COUNT
          FCN    UCS,,SSJ    UPDATE USER ACCESS WORDS
          FCN    GAL         GET JOB ACCESS LEVEL LIMITS
          FCN    SAL         SET JOB ACCESS LEVEL
          FCN    USV,,SSJ    GET USER SECURITY VALIDATION
          FCN    IPD         INCREMENT PACKED DATE
          FCN    EPW,,SSJ    ENCRYPT PASSWORD
          FCN    RSC         RETURN SERVICE CLASS INFORMATION
          FCN    CSV         CHANGE SERVICE CLASS
          FCN    PRS1        RESERVED
          FCN    RUA,,SSJ    RETURN USER ACCOUNT BLOCK
          FCN    GPG         GET PAGE PARAMETERS
          FCN    SPG         SET PAGE PARAMETERS
          FCN    GPS,,SSJ    GET PROLOGUE/EPILOGUE STATUS
          FCN    LOG,,SSJ    PROCESS LOGOUT
          FCN    GLV         GET SYSTEM PSR LEVEL
          FCN    RRI         RETURN REPRIEVE INFORMATION
          FCN    ERM         ENABLE/DISABLE TERMINAL ERROR MESSAGES
          FCN    GCN         GET CHARGE NUMBER
          FCN    RCT         RETURN CONSOLE TYPE
 ACPF     FCN    ACP         ASSIGN A CONCURRENT PP
          FCN    PAM         PRIVILEGED ANALYST STATUS
          FCN    GSL         GET SYSTEM LIBRARY STATUS
          FCN    GSC         GET *SHELL* CONTROLS
          FCN    SIC         SET INTER-CP COMMUNICATION CONTROLS
          FCN    GTD         GET TAPE DEFAULTS
          FCN    STD         SET TAPE DEFAULTS
          FCN    GFN,,SSJ    GET FAMILY NAME AND FAMILY ORDINAL
          FCN    PRS1        (150) RESERVED FOR CDC
          FCN    PRS1        (151) RESERVED FOR INSTALLATION
          FCN    PRS1        (152) RESERVED FOR INSTALLATION
          FCN    PRS1        (153) RESERVED FOR INSTALLATION
          FCN    PRS1        (154) RESERVED FOR INSTALLATION
          FCN    PRS1        (155) RESERVED FOR INSTALLATION
          FCN    PRS1        (156) RESERVED FOR INSTALLATION
          FCN    PRS1        (157) RESERVED FOR INSTALLATION
          FCN    PRS1        (160) RESERVED FOR INSTALLATION
          LOC    *O
 TFCNL    EQU    *-TFCN
 
 
 IFP      HERE               GLOBAL FNT PROCESSORS INITIALIZATION CODE
          SPACE  4,10
**        COMMON DECKS.
 
 
 PIR$     EQU    1           SELECT ASSEMBLY OF *PIR* FOR IAF R-REG
*CALL     COMPSRR
*CALL     COMPCRS
*CALL     COMPSPA
*CALL     COMPSSF
          SPACE  4,10
          OVERFLOW
          OVERLAY  (ERROR PROCESSOR.)
 ERR      SPACE  4,10
**        ERR - PROCESS ERROR.
*
*         ENTRY  (CN) = ERROR MESSAGE ADDRESS.
*                (CN+1) = DAYFILE OPTION.
*                       = 0 FOR MESSAGE TO USER AND SYSTEM
*                         DAYFILE.
*                       = *ERLN* FOR MESSAGE TO ERROR LOG,
*                         USER, AND SYSTEM DAYFILE.
*                (CN+2) = RESOURCE TYPE FOR *ERNV* MESSAGE.
*
*         EXIT   TO PPR.
*
*         CALLS  DFM.
*
*         MACROS MONITOR.
 
 
 ERR      BSS    0           ENTRY
          LDD    CN          CHECK MESSAGE TYPE
          LMC    ERNV
          NJN    ERR1        IF NOT VALIDATION ERROR MESSAGE
          LDD    CN+2        SET RESOURCE TYPE
          SHN    6
          LMN    1R
          STM    ERNV+1
          SHN    6
          STM    ERNV
 ERR1     LDD    CN          ISSUE DAYFILE MESSAGE
          RJM    DFM
          LDD    CN+1        CHECK ERROR LOG OPTION
          ZJN    ERR2        IF NO MESSAGE TO ERROR LOG
          SHN    14          ISSUE ERROR LOG MESSAGE
          LMD    CN
          RJM    DFM
 ERR2     MONITOR  ABTM
          LJM    PPR         EXIT
 
 
*         ERROR MESSAGES.
 
 
          QUAL
 
 ERAE     DATA   C* CPM - ARGUMENT ERROR.*
 ERFL     DATA   C* RFL BEYOND MFL.*
 ERIR     DATA   C* CPM - INCORRECT REQUEST.*
 ERNV     DATA   C* XX NOT VALIDATED.*
 ERIJ     DATA   C* CPM - ACCESS LEVEL NOT VALID FOR JOB.*
 ERIU     DATA   C* CPM - USER ACCESS NOT VALID.*
 ERMS     DATA   C* CPM - MASS STORAGE ERROR.*
 ERPN     DATA   C* CPM - INCORRECT PACK NAME.*
 ERPV     DATA   C* CPM - INCORRECT PAGE VALUE.*
 EREF     DATA   C* ERROR ON FILE - "PPFN".*
 ERAU     DATA   C* INCORRECT APPLICATION ACCOUNTING REQUEST.*
 ERSY     DATA   C* CPM - SYSTEM ERROR.*
 ERSC     DATA   C$ CPM - MISSING *SHELL* LOAD OPTION.$
 ERSE     DATA   C* CPM - EPILOGUE AND SHELL CONFLICT.*
 ERSF     DATA   C$ CPM - INCORRECT *SHELL* FILE.$
 ERCI     DATA   C* CPM - HARDWARE DOES NOT SUPPORT CPP-S.*
 
          QUAL   *
          OVERLAY  (USER VALIDATION FUNCTIONS.)
 SUI      SPACE  4,10
***       FUNCTION 21.
*         SET USER INDEX = PARAMETER.
*         SYSTEM ORIGIN ONLY.
*         ON A SECURED SYSTEM, MUST BE CALLED BY *SSJ=* PROGRAM.
 
 
 SUI      ENTRY
          LDD    SM
          ZJN    SUI1        IF SYSTEM UNSECURED
          LDD    EP
          SHN    21-2
          MJN    SUI1        IF CALLER HAS *SSJ=* ENTRY POINT
          LDD    IR+3
          SHN    14
          LMD    IR+4
          ZJN    SUI2        IF USER INDEX OF ZERO SPECIFIED
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 SUI1     LDD    IR+3        CHECK USER INDEX
          SCN    37
          ZJN    SUI2        IF NOT OUT OF RANGE
          ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 SUI2     LDN    ZERL        SET USER INDEX
          CRD    CM
          CRD    CN
          LDD    IR+3
          STD    CM+3
          LDD    IR+4
          STD    CM+4
          LDD    CP          STORE USER IDENTIFICATION
          ADN    UIDW
          CWD    CM
          ADN    PKNW-UIDW   CLEAR PACK NAME AND TYPE
          CWD    CN
          LJM    CPMX        RETURN
 VAN      SPACE  4,60
***       FUNCTION 40.
*         VALIDATE USER/ACCOUNT COMMAND.
*         THE CALLER MUST HAVE AN *SSJ=* ENTRY POINT SPECIFYING A
*         PARAMETER BLOCK.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER BLOCK.
*
*T ADDR+0 42/ USER NAME ,18/
*T,ADDR+1 42/ PASSWORD ,14/ ,1/U ,1/N ,1/ ,1/P
*T,ADDR+2 42/ FAMILY NAME ,18/
*T,ADDR+3 60/
*T,ADDR+4 60/
*T,ADDR+5 60/
*T,ADDR+6 60/
*T,ADDR+7 60/
*T,ADDR+10 60/
*T,ADDR+11 60/
*T,ADDR+12 60/
*
*                WHERE -
*                U=1, IF USER NAMES FOR USER INDEXES .GE. *AUIMX* ARE
*                     TO BE ALLOWED (FOR *SYOT* CALLERS ONLY).
*                N=1, IF JOB IS NOT TO BE ABORTED.
*                P=1, IF PASSWORD IS NOT TO BE VALIDATED.
*
*         EXIT   PARAMETER BLOCK IS RETURNED AS FOLLOWS.
*
*T ADDR+0 42/ USER NAME ,18/ USER INDEX
*T,ADDR+1 18/ ,18/ PED ,6/ ,18/ UNCHANGED
*T,ADDR+2 42/ FAMILY NAME ,6/ SC,6/ ,3/EC ,1/ ,1/C,1/S
*T,ADDR+3 60/ (ALMW)
*T,ADDR+4 60/ (ACLW)
*T,ADDR+5 60/ (AACW)
*T,ADDR+6 60/ (APRN)
*T,ADDR+7 60/ (APJN)
*T,ADDR+10 60/ (APJ1)
*T,ADDR+11 60/ (ACGN)
*T,ADDR+12 42/ TERMINAL NAME, 18/ TERMINAL NUMBER
*
*                WHERE -
*                USER INDEX = 0, IF USER NAME NOT VALID.
*                PED = PASSWORD EXPIRATION DATE.
*                FAMILY NAME = PREVIOUS FAMILY NAME.
*                SC = SERVICE CLASS.
*                EC = ERROR CODE IF NOT USER NAME VALIDATION ERROR.
*                   = 1 IF SECONDARY *USER* COMMAND AND CHARGE
*                       REQUIRED.
*                   = 2 IF SECONDARY *USER* COMMAND, SECONDARY *USER*
*                        COMMANDS DISABLED, AND NOT SECURE MODE.
*                   = 3 IF ALTERNATE FAMILY SPECIFIED ON SECONDARY
*                       *USER* COMMAND AND USER NOT VALIDATED FOR
*                       ALTERNATE FAMILY SPECIFICATION.
*                   = 4 IF ALTERNATE USER NAME SPECIFIED ON SECONDARY
*                       *USER* COMMAND AND USER NOT VALIDATED FOR
*                       ALTERNATE USER NAME SPECIFICATION.
*                C = 1, IF SECURITY COUNT EXHAUSTED.
*                S = 1, IF SECONDARY USER COMMAND.
*                SEE *PPCOM* AND *COMSACC* FOR DEFINITIONS OF THE
*                OTHER WORDS.
*
*         THE JOB WILL BE ABORTED FOR THE FOLLOWING REASONS -
*         1) THE SPECIFIED USER NAME/PASSWORD IS NOT VALID, UNLESS
*         *N* HAS BEEN SPECIFIED.
*         2) A MASS STORAGE ERROR WAS ENCOUNTERED.
 
 
 VAN      ENTRY
          RJM    GPV         GET PARAMETERS
          ZJN    VAN3        IF NOT SECONDARY USER COMMAND
          RJM    CSU         CHECK SECONDARY USER COMMAND
          ZJN    VAN3        IF NO ERROR
 VAN1     LDN    1           SET ERROR TYPE
 VAN2     LJM    PIU         PROCESS ERROR
 
*         VALIDATE USER AND FAMILY NAMES.
 
 VAN3     RJM    SFE         SET FAMILY EST ORDINAL
          NJN    VAN2        IF FAMILY NOT FOUND
          LDD    CP          SET CURRENT FAMILY EST ORDINAL
          ADN    PFCW
          CRD    CN
          RJM    UFC         UPDATE FAMILY ACTIVITY COUNT
          LDD    T2          SAVE FAMILY EST ORDINAL
          STM    VANB
          RJM    RUB         RETURN USER BLOCK
          ZJN    VAN1        IF INCORRECT USER
          PJN    VAN3.1      IF NO MASS STORAGE ERROR ENCOUNTERED
          ABORT  ERMS        * CPM - MASS STORAGE ERROR.*
 
 VAN3.1   LDD    T4
          ZJN    VAN4        IF USER INDEX .LT. *AUIMX*
 VANA     LDN    0
*         LDN    10          (SPECIAL USER NAMES OK FOR SYOT)
          ZJN    VAN1        IF SPECIAL USER NAME FLAG NOT SET
          LDD    OT
          LMK    SYOT
          NJN    VAN2        IF NOT *SYOT*
 VAN4     LDN    VANE-VAND   SET ADDRESS OF USER BLOCK WORDS
          STD    T1
 VAN5     LDD    T3          SET ADDRESS
          RAM    VAND,T1
          LCN    2
          RAD    T1
          PJN    VAN5        IF MORE ADDRESSES TO SET
          LDN    VANK-VANJ   SET ADDRESS OF USER BLOCK WORDS
          STD    T1
 VAN5.1   LDD    T3          SET ADDRESS
          RAM    VANJ,T1
          LCN    2
          RAD    T1
          PJN    VAN5.1      IF MORE ADDRESSES TO SET
          LDC    **          RESTORE FAMILY EST ORDINAL
 VANB     EQU    *-1
*         LDC    (EQ)        (FAMILY EST ORDINAL)
          STD    T5
          LDD    BA+4        SET STATUS FLAGS
          STD    FN+4
          LDD    BA+3
          LMD    FN+3
          LPN    77
          LMD    FN+3
          STD    FN+3
          LDN    11
          STD    T1
          RJM    CKA
          ADN    2           RETURN FAMILY NAME AND STATUS FLAGS
          CWD    FN
          SBN    1           READ PASSWORD
          CRD    FN
 
*         IF THE CURRENT USER NAME IS ALREADY NONZERO ON A PRIMARY
*         USER COMMAND, THE PASSWORD HAS ALREADY BEEN VALIDATED BY
*         *0VJ*, *NVF* OR *1TA* (AND SHOULD NOT BE VALIDATED NOW).
*         HOWEVER, FOR SOME *SYOT* JOBS (SUCH AS *DIS* AND *PTFS*),
*         THE PASSWORD FOR THE PRIMARY USER COMMAND MUST BE VALIDATED
*         AT THIS TIME.
 
          LDM    VANC
          NJN    VAN6        IF NOT FIRST USER COMMAND
          LDM    RUIA
          NJN    VAN9        IF USER NONZERO (PASSWORD ALREADY CHECKED)
 VAN6     LDD    OT
          LMK    IAOT
          ZJN    VAN7        IF INTERACTIVE JOB
          LDC    APSW*5      USE BATCH PASSWORD
          STM    VPWA
 VAN7     RJM    VPW         VALIDATE PASSWORD
          NJN    VAN8        IF INCORRECT PASSWORD
          LDD    CN+3        SAVE PASSWORD EXPIRATION DATE
          STM    PESS
          LDD    CN+4
          STM    PESS+1
          LDD    T6          CHECK SECURITY COUNT
          NJN    VAN9        IF SECURITY COUNT NOT YET EXHAUSTED
 VAN8     LJM    VAN2        PROCESS ERROR
 
 VAN9     LDM    AHFC*5,T3   SAVE PERMANENT FILE VALIDATIONS
          STD    T2
          LDC    0
*         LDC    1           (SECONDARY USER COMMAND)
 VANC     EQU    *-1         (VALUE OF PRIMARY USER FLAG)
          NJN    VAN10       IF SECONDARY USER COMMAND
          LJM    VAN11       PROCESS PRIMARY USER COMMAND
 
*         UPDATE PARAMETER BLOCK FOR SECONDARY USER COMMAND.
 
 VAN10    LDM    APRN*5+3,T3
          LPN    77
          SBN    SSPMN
          MJN    VAN10.1     IF NO SECURITY SYSTEM PROLOGUE
          LJM    VAN1        PROCESS ERROR
 
 VAN10.1  NFA    SSJN+ALMS   GET CURRENT USER LIMITS
          CRM    ALMT,TR
          LDM    AAWC*5+4,T3 SET NEW *CCNR*/*CSPF*/*CLPF*/*CPWC* VALUES
          LMM    AACT+4
          LPC    215
          LMM    AACT+4
          STM    AACT+4
          LDM    AAWC*5+3,T3 SET NEW *COPR*/*CNRD* VALUES
          LMM    AACT+3
          LPC    6000
          LMM    AACT+3
          STM    AACT+3
          LDM    AAWC*5+2,T3 SET NEW *CRAF*/*CRAU* VALUES
          LMM    AACT+2
          LPC    140
          LMM    AACT+2
          STM    AACT+2
          LDN    12
          STD    T1
          RJM    CKA         SET PARAMETER BLOCK ADDRESS
          ADN    3           RETURN *ALMW*, *ACLW*, AND UPDATED *AACW*
          CWM    ALMT,TR
          LJM    VAN12       RETURN FIELDS FROM VALIDATION BLOCK
 
*         UPDATE NFL AND PARAMETER BLOCK FOR PRIMARY USER COMMAND.
 
 VAN11    LDM    ACGN*5,T3
          ZJN    VAN11.0     IF NO DEFAULT CHARGE
          NFA    CHGN        SET DEFAULT CHARGE AND PROJECT IN NFL
          CWM    ACGN*5,ON
 VANJ     EQU    *-1
          CWM    APJN*5,ON
          CWM    APJ1*5,ON
 VANK     EQU    *-1
 VAN11.0  LDM    RUIA
          NJN    VAN11.1     IF USER NAME NONZERO (*JSCW* ALREADY SET)
          RJM    PSV         PROCESS SECURITY VALIDATIONS
          NJP    VAN2        IF ERROR
 VAN11.1  LDD    T3
          ADN    AHFC*5
          RJM    CLI         CONVERT COUNTING LIMITS
          LDN    12
          STD    T1
          RJM    CKA         SET ADDRESS
          ADN    12          RETURN TERMINAL NAME
          CWM    TNSS,ON
          ADK    3-13        RETURN ALMW, ACLW, AND AACW TO CALLER
          CWM    AHMT*5,ON
 VAND     EQU    *-1
          CWM    AHDS*5,ON
          CWM    AAWC*5,ON
 VAN12    CWM    APRN*5,ON
          CWM    APJN*5,ON
          CWM    APJ1*5,ON
          CWM    ACGN*5,ON
 VANE     EQU    *-1
          SBN    11          SET PASSWORD EXPIRATION DATE
          CRD    FN
          LDM    PESS
          STD    FN+1
          LDM    PESS+1
          STD    FN+2
          RJM    CKA         RETURN PASSWORD EXPIRATION DATE
          ADN    1
          CWD    FN
          SBN    1           RETURN USER NAME AND USER INDEX
          CWD    UN
          ADN    3           READ *ALMW*, *ACLW*, AND *AACW*
          CRM    ALMT,TR
 
*         SET VALIDATION PARAMETERS.
 
          LDD    CP          READ *AALW*
          ADK    AALW
          CRD    CM
          STD    CN          SAVE ADDRESS
          LDD    CM+4        CLEAR OLD APPLICATION ACCESS LEVEL
          SCN    77
          STD    CM+4
          LDM    APRN*5+4,T3 GET NEW APPLICATION ACCESS LEVEL
          SHN    -6
          RAD    CM+4
          LDD    CN          UPDATE *AALW*
          CWD    CM
          LDD    CP          READ PERMANENT FILE CONTROLS
          ADN    PFCW
          CRD    CN
          ADN    CSPW-PFCW   READ PRIMARY USER COMMAND FLAG
          CRD    CM
          LDD    T5          SET FAMILY EST ORDINAL
          STD    CN+3
          LDD    T2          SET PERMANENT FILE CONTROLS
          STD    CN+4
          LDM    AAWC*5+4,T3 GET *CCNR* ACCESS PRIVILEGE FLAG
          SHN    2-7
          LPN    4
          LMN    6           SET PRIMARY USER AND CHARGE REQUIRED FLAGS
          LMD    CM
          LPN    6
          LMD    CM
          STD    CM
          LDD    CP          WRITE PERMANENT FILE CONTROLS
          ADN    PFCW
          CWD    CN
          ADN    CSPW-PFCW   WRITE USER AND CHARGE COMMAND FLAGS
          CWD    CM
          NFA    SSJN+UIDS   SET VALIDATION WORDS IN SSJ= BLOCK
          CWD    UN
          ADN    ALMS-UIDS
          CWM    ALMT,TR
 
*         SET SERVICE CLASS VALIDATION MASK.
 
          LDM    VANC
          NJN    VAN12.1     IF SECONDARY USER COMMAND
          LDD    T3          SET ADDRESS OF VALIDATION MASK
          ADK    ASCV*5
          STM    VANI
          NFA    SCVN
          CWM    **,ON
 VANI     EQU    *-1         (ADDRESS OF VALIDATION MASK)
 
*         CHECK FOR *SHELL* CONTROL.
 
 VAN12.1  LDM    ASHN*5,T3
          ZJN    VAN14       IF NO *SHELL* CONTROL
          LDM    AAWC*5+3,T3
          SHN    21-7
          PJN    VAN13       IF NOT *CMNT* ACCESS
          LDN    SSTL
          CRD    CM
          LDD    CM+3
          SHN    21-7
          PJN    VAN14       IF PRIVILEGED *RDF* ENABLED
 VAN13    LDD    T3          SET *SHELL* CONTROL
          ADN    ASHN*5
          STM    VANF
          NFA    SHCN
          CWM    **,ON
 VANF     EQU    *-1
 
*         CHECK *CMNT* ACCESS.
 
 VAN14    LDM    AAWC*5+3,T3
          SHN    21-7
          PJN    VAN15       IF NOT *CMNT* ACCESS
          LDN    UN          SPACE FILL USER NAME
          RJM    SFN
          LDD    UN+3
          LMN    1R.&1R
          STD    UN+3
          LDN    0
          STD    UN+4
          LDD    MA          SET USER NAME IN MESSAGE
          CWD    UN
          CRM    VANH,ON
          LDC    VANG+MDON   ISSUE MESSAGE TO SYSTEM DAYFILE ONLY
          RJM    DFM
 VAN15    LJM    CPMX        EXIT
 
 
 VANG     DATA   H*MAINTENANCE ACCESS BY UN = *
 VANH     BSS    5
 FAM      SPACE  4,15
***       FUNCTION 41.
*         ENTER FAMILY.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF FAMILY NAME.
*                IF FAMILY NAME = 0, THE DEFAULT WILL BE USED.
*
*         EXIT   ((IR+3 - IR+4)) = 48/OLD FAMILY NAME,12/FLAG.
*                      FLAG .EQ. 0 IF DEFAULT FAMILY NOT USED.
*                           .LT. 0 IF FAMILY NOT FOUND.
*                           .GT. 0 IF SAME AS SYSTEM DEFAULT FAMILY.
*
*         MUST BE CALLED BY SYSTEM ORIGIN JOB.
*         ON A SECURED SYSTEM, MUST BE CALLED BY *SSJ=* PROGRAM.
 
 
 FAM      ENTRY
          LDD    SM
          ZJN    FAM0        IF SYSTEM UNSECURED
          LDD    EP
          SHN    21-2
          MJN    FAM0        IF CALLER HAS *SSJ=* ENTRY POINT
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 FAM0     RJM    CKA         READ FAMILY NAME
          CRD    FN
          LDC    PFNL        READ DEFAULT FAMILY NAME
          CRD    CN
          LDD    CN+3
          STD    T5
          LDD    FN          CHECK ENTERED FAMILY
          NJN    FAM1        IF FAMILY SPECIFIED
          LDD    T5          SET SYSTEM DEFAULT FAMILY
          STD    T2
          STD    FN+3
          UJN    FAM3
 
 FAM1     RJM    SFE         SET FAMILY EST ORDINAL
          SBN    2
          MJN    FAM2        IF FAMILY FOUND
          LCN    0           SET FAMILY NOT FOUND STATUS
          STD    FN+4
          LJM    FAM5        RETURN STATUS
 
 FAM2     LDN    0           SET FAMILY FOUND STATUS
          STD    FN+4
          LDD    T2          CHECK DEFAULT FAMILY
          SBD    T5
          NJN    FAM4        IF NOT DEFAULT FAMILY
 FAM3     LDN    1           SET DEFAULT FAMILY STATUS
          STD    FN+4
 FAM4     LDD    CP
          ADN    PFCW        SET FAMILY EST ORDINAL AND RETURN
          CRD    CN
          RJM    UFC         UPDATE FAMILY COUNT
          LDD    CN+3
          STD    T3          SAVE OLD FAMILY EST ORDINAL
          LDD    T2          INSERT NEW FAMILY EST ORDINAL
          STD    CN+3
          LDD    CP
          ADN    PFCW
          CWD    CN
          LDD    FN+4
          STD    T4
          SFA    EST,T3      READ OLD FAMILY EST ENTRY
          ADK    EQDE
          CRD    CN
          LDD    CN+4
          SHN    3
          ADN    PFGL
          CRD    FN          READ OLD FAMILY NAME
          LDD    T4
          STD    FN+4        RESET STATUS
 FAM5     LDN    0           SET RETURN ADDRESS
          STD    T1
          RJM    CKA
          CWD    FN
          LJM    CPMX        RETURN
 VAL      SPACE  4,50
***       FUNCTION 56.
*         VALIDATE USER.
*         MUST BE CALLED FROM SYSTEM ORIGIN OR *SSJ=* JOB.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF CALL BLOCK *ADDR*.
*
*T ADDR   42/ FAMILY NAME, 15/ 0, 1/R, 1/E, 1/D
*T,       42/ PASSWORD, 15/ , 1/ B, 1/ I, 1/ P
*T,       42/ USER NAME, 17/ ,1/ U
*T,       42/ APPLICATION NAME, 18/ 0
*T,       60/
*T,       60/
*T,       60/
*T,       60/
*T,       60/
*T,       60/
*T,       60/
*T,       60/
*T,       60/
*
*         FAMILY NAME = FAMILY NAME OR 0, THE SYSTEM DEFAULT FAMILY
*                WILL BE RETURNED IF NO FAMILY NAME IS SUPPLIED.
*         R = 1, IF JOB SHOULD NOT BE ROLLED ON A MASS STORAGE ERROR.
*         E = 1, IF THE PED FIELD TO BE RETURNED.
*         D = 1, IF THE PID FIELD TO BE RETURNED.
*         PASSWORD = OPTIONAL PASSWORD FOR VALIDATION.
*         B = 1, IF PASSWORD IS TO BE VALIDATED FOR BATCH ACCESS.
*         I = 1, IF INCREMENT OF FAMILY ACTIVITY COUNT IS REQUIRED.
*         P = 1, IF PASSWORD NOT TO BE VALIDATED.
*         USER NAME = USER NAME TO VALIDATE.
*         U = 1, IF USER NAME FOR USER INDEXES .GE. *AUIMX* ARE
*                TO BE ALLOWED.
*         APPLICATION NAME = 0 OR DESIRED APPLICATION NAME.
*
*         EXIT   THE PARAMETER BLOCK IS RETURNED AS FOLLOWS.
*
*T ADDR   42/FAMILY NAME, 3/, 9/FO, 5/ST, 1/C
*T,       42/ PASSWORD, 16/ 0, 1/ I, 1/ P
*T,       42/ USER NAME, 18/ USER INDEX
*T,       42/ APPLICATION NAME, 18/ 0
*T,       54/ 0, 6/ AL
*T,       60/ *AHMT*
*T,       60/ *AHDS*
*T,       60/ *AAWC*
*T,       60/ *ATPA*
*T,       60/ *AAVW*
*T,       60/ *ACGN*
*T,       60/ *APJN*
*T,       60/ *APJ1*
*T,       60/ PERSONAL IDENTIFICATION PART 1 (*APID*)
*T,       60/ PERSONAL IDENTIFICATION PART 2 (*API2*)
*T,       42/ 0, 18/ PASSWORD EXPIRATION DATE
*
*         FO = EST ORDINAL OF FAMILY.
*         ST = STATUS-
*              BIT 0 = 0  VALID FAMILY, USER NAME, PASSWORD
*              BIT 0 = 1  INCORRECT LOGIN (OTHER BITS UNDEFINED)
*              BIT 1 = 0  SECURITY COUNT OK
*              BIT 1 = 1  SECURITY COUNT EXHAUSTED
*              BIT 2 = 0  NO MASS STORAGE ERROR ENCOUNTERED
*              BIT 2 = 1  MASS STORAGE ERROR ENCOUNTERED
*         C = COMPLETION BIT.
*         USER INDEX = RETURNED USER INDEX ON VALID LOGIN.
*         AL = APPLICATION ACCESS LEVEL.
*         PERSONAL IDENTIFICATION = RETURNED IF VALID LOGIN AND D = 1.
*         PASSWORD EXPIRATION DATE = EXPIRATION DATE OF THE PASSWORD
*         BEING VALIDATED, RETURNED IF VALID PASSWORD AND E = 1.
*
*         IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE READ/WRITE
*         ERROR ON THE DEVICE, THE JOB IS ROLLED OUT TO WAIT FOR THE
*         DEVICE TO BECOME ACCESSIBLE.
*
*
*         THE FAMILY ACTIVITY COUNT IS NOT INCREMENTED (EVEN
*         IF *I* IS ONE) IF VALIDATION IS NOT SUCCESSFUL OR THE
*         SECURITY COUNT IS EXHAUSTED.
 
 
 VAL      ENTRY
          LDD    OT
          LMK    SYOT
          ZJN    VAL1        IF SYSTEM ORIGIN
          LDD    EP
          SHN    21-2
          MJN    VAL1        IF *SSJ=* JOB
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 VAL1     LDN    10          CHECK PARAMETER ADDRESS
          STD    T1
          RJM    CKA
          CRD    FN          READ FAMILY NAME
          CRD    BA
          ADN    2
          CRD    UN          READ USER NAME
          LDD    UN+4        SAVE SPECIAL USER NAMES ALLOWED FLAG
          LPN    1
          RAM    VALA
          LDD    FN+4        SAVE ROLL/PID/PED FLAGS
          LPN    77
          RAM    VALH
 
*         VALIDATE USER AND FAMILY.
 
          LDN    0           SET VALIDATE USER FUNCTION FOR *0AV* CALL
          STD    UN+4
          STD    BA+4
          LDD    UN+3
          SCN    77
          STD    UN+3
          EXECUTE 0AV,L0AV   VALIDATE USER
          PJN    VAL2        IF NO MASS STORAGE ERROR ENCOUNTERED
          LDM    VALH        CHECK ROLLOUT INHIBIT FLAG
          LPN    4
          NJN    VAL1.1      IF NOT TO ROLL JOB ON MASS STORAGE ERROR
          RJM    CJR         CHECK IF JOB IS ROLLABLE
 VAL1.1   LDN    10-2
          RAM    VALG
          UJN    VAL4        RETURN ERROR TO CALLER
 
 VAL2     LDD    T4
          ZJN    VAL3        IF USER INDEX .LT. *AUIMX*
 VALA     LDN    0
*         LDN    1           (SPECIAL USER NAMES ALLOWED)
          ZJN    VAL4        IF SPECIAL USER NAMES NOT ALLOWED
 VAL3     LDD    T1
          SHN    14
          LMD    T2
          NJN    VAL5        IF LEGAL USER NAME
 VAL4     LJM    VAL11       TERMINATE REQUEST
 
 VAL5     STD    UN+4        ENTER USER INDEX IN PARAMETER BLOCK
          SHN    -14
          RAD    UN+3
          LDD    T3          SAVE ADDRESS OF ACCOUNT BLOCK
          STM    VALD
          RAM    VALI
          LDN    VALC-VALB   SET ADDRESSES OF USER BLOCK WORDS
          STD    T1
 VAL6     LDD    T3          SET ADDRESS
          RAM    VALB,T1
          LCN    2
          RAD    T1
          PJN    VAL6        IF MORE ADDRESSES TO SET
          RJM    SFE         SET FAMILY EST ORDINAL
          NJP    VAL4        IF FAMILY NOT FOUND
 
*         RETURN USER RECORD PARAMETERS.
 
          LDD    MA          TRANSFER (FN - FN+4) TO (BA - BA+4)
          CWD    FN          RETURN FAMILY NAME
          CRD    BA
          LDD    FN+4        SET FAMILY EST ORDINAL FOR *STBM*
          STM    VALF
          SHN    6
          STD    BA+4
          SHN    -14         INSERT REMAINING BITS IN (BA+3)
          RAD    BA+3
          LDN    14          SET WORD COUNT
          STD    T1
          RJM    CKA
          ADN    1
          CRD    FN
          ADN    5-1
          CWM    AHMT*5,ON
 VALB     EQU    *-1
          CWM    AHDS*5,ON
          CWM    AAWC*5,ON
          CWM    ATPA*5,ON
          CWM    AAVW*5,ON
          CWM    ACGN*5,ON
          CWM    APJN*5,ON
          CWM    APJ1*5,ON
 VALC     EQU    *-1
          LDD    FN+4        SAVE PARAMETER FLAGS
          STM    VALE
 
*         EXPANDED BLOCK PERSONAL IDENTIFICATION.
 
 VALH     LDN    **          EXPANDED BLOCK FLAGS
          LPN    1
          ZJN    VAL6.1      IF PERSONAL ID BIT NOT SET
          LDN    2
          STD    T2
          RAD    T1
          RJM    CKA         SET PARAMETER ADDRESS
          ADN    15
          CWM    APID*5,T2   RETURN PERSONAL IDENTIFICATION
 VALI     EQU    *-1         (ADDR. OF PERSONAL ID IN VALIDATION BLOCK)
 
*         VALIDATE PASSWORD.
 
 VAL6.1   LDC    **          SET ACCOUNT BLOCK ADDRESS
 VALD     EQU    *-1         (ADDRESS OF ACCOUNT BLOCK)
          STD    T3
          LDD    FN+4
          SHN    21-2
          PJN    VAL7        IF NOT TO USE BATCH PASSWORD
          LDC    APSW*5      USE BATCH PASSWORD
          STM    VPWA
          STM    RPEA
 VAL7     RJM    VPW         VALIDATE PASSWORD
          NJP    VAL11       IF PASSWORD NOT VALID
 
*         EXPANDED BLOCK PASSWORD EXPIRATION DATE.
 
          LDM    VALH        EXPANDED BLOCK FLAGS
          LPN    2
          ZJN    VAL8        IF PASSWORD EXPIRATION BIT NOT SET
          AOD    T1
          RJM    RPE         RETURN PASSWORD EXPIRATION DATE
          RJM    CKA         SET PARAMETER ADDRESS
          ADD    T1
          CWD    CM          SET PASSWORD EXPIRATION DATE
 
*         CHECK SECURITY COUNT.
 
 VAL8     LDD    T6          CHECK SECURITY COUNT
          NJN    VAL9        IF SECURITY COUNT NOT EXHAUSTED
          LDN    4
          RAD    BA+4        SET SECURITY EXHAUSTION FLAG
          UJN    VAL10       TERMINATE REQUEST
 
*         INCREMENT FAMILY ACTIVITY COUNT.
 
 VAL9     LDC    *           CHECK FAMILY COUNT INCREMENT FLAG
 VALE     EQU    *-1
          LPN    2
          ZJN    VAL10       IF NO FAMILY COUNT INCREMENT
          LDN    IFCS        INCREMENT FAMILY ACTIVITY COUNT
          STD    CM+3
          LDC    *           SET FAMILY EST ORDINAL
 VALF     EQU    *-1         (EST ORDINAL OF FAMILY)
          STD    CM+1
          MONITOR  SMDM
 
*         TERMINATE REQUEST.
 
 VAL10    AOD    BA+4        SET COMPLETION BIT
          RJM    CKA
          ADN    4
          CRD    FN
          LDM    VASS+APRN*5+4  APPLICATION ACCESS LEVEL
          SCN    77
          STD    FN+4
          RJM    CKA         CHECK CENTRAL ADDRESS
          CWD    BA
          ADN    2
          CWD    UN
          ADN    2
          CWD    FN
          LJM    CPMX        RETURN
 
 VAL11    LDN    0           CLEAR USER INDEX
          STD    UN+4
          LDD    UN+3
          SCN    77
          STD    UN+3
          LDN    2           SET INCORRECT LOGIN FLAG
*         LDN    10          (MASS STORAGE ERROR)
 VALG     EQU    *-1
          RAD    BA+4
          UJN    VAL10       RETURN ERROR TO CALLER
 SPF      SPACE  4,25
***       FUNCTION 60.
*         SET PERMANENT FILE PARAMETERS IN CONTROL POINT AREA.
*         MUST BE CALLED BY SYSTEM ORIGIN JOB.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS *ADDR* OF PARAMETER BLOCK
*                WHICH HAS THE FOLLOWING FORMAT -
*
*T ADDR   42/ FAMILY NAME,14/ ,4/ FG
*T,       42/ PACK NAME,18/ PACK TYPE
*T,       42/ USER NAME,1/ ,17/ USER INDEX
*         FG = FLAG BITS DENOTING WHICH FIELDS TO SET.
*                BIT 3 - FAMILY NAME.
*                BIT 2 - PACKNAME.
*                BIT 1 - USER NAME.
*                BIT 0 - USER INDEX.
*
*         EXIT   PARAMETERS SET IN CONTROL POINT AREA IF FLAGGED.
*                STATUS OF SPECIFIED FAMILY RETURNED AS FOLLOWS -
*
*T ADDR   42/ FAMILY NAME,6/ ST,8/ 0,4/ FG
*         ST = 0 IF FAMILY NAME SET IN CONTROL POINT AREA.
*            = 1 IF SPECIFIED FAMILY WAS NOT FOUND (CURRENT FAMILY
*                REMAINS UNCHANGED).
 
 
 SPF      ENTRY
          LDN    2           CHECK PARAMETER BLOCK ADDRESS
          STD    T1
          RJM    CKA
          CRD    FN          READ FAMILY NAME
          LDD    CP          READ PF CONTROL WORD
          ADN    PFCW
          CRD    UN
          LDD    FN+4        CHECK FAMILY NAME BIT
          STD    T7
          SHN    21-3
          PJN    SPF2        IF NO FAMILY NAME CHANGE
 
*         FIND EST ORDINAL OF SPECIFIED FAMILY.
 
          RJM    SFE         SET FAMILY EST ORDINAL
          ZJN    SPF0        IF FAMILY FOUND
          LDN    1           SET FAMILY NOT FOUND STATUS
 SPF0     STD    T3
          NJN    SPF1        IF FAMILY NOT FOUND
 
*         SET FAMILY ORDINAL IN CONTROL POINT AREA.
 
          LDD    UN+3        SET OLD FAMILY EST ORDINAL FOR *UFC*
          STD    CN+3
          LDD    T2
          STD    UN+3
          RJM    UFC         UPDATE FAMILY COUNTS
          LDD    CP          UPDATE FAMILY ORDINAL IN CPA
          ADN    PFCW
          CWD    UN
 
*         SET STATUS OF SPECIFIED FAMILY NAME.
 
 SPF1     LDD    FN+3        ADD STATUS TO NAME
          SCN    77
          LMD    T3
          STD    FN+3
          LDD    T7          RESET FLAG BITS
          STD    FN+4
          LDN    2           SET STATUS IN BLOCK
          STD    T1
          RJM    CKA
          CWD    FN
 
*         CHANGE PACKNAME.
 
 SPF2     LDD    T7          CHECK PACK NAME FLAG
          SHN    21-2
          PJN    SPF3        IF NO PACK NAME CHANGE
          RJM    CKA         READ PACKNAME AND PACK TYPE
          ADN    1
          CRD    FN
          LDD    CP          UPDATE PACK NAME AND TYPE IN CPA
          ADC    PKNW
          CWD    FN
 
*         READ USER NAME AND USER INDEX.
 
 SPF3     RJM    CKA         READ USER NAME AND USER INDEX
          ADN    2
          CRD    UN
          CRD    CM
          LDD    CP          READ CONTROL POINT AREA PARAMETERS
          ADN    UIDW
          CRD    FN
 
*         CHANGE USER NAME.
 
          LDD    T7          CHECK USER NAME FLAG
          SHN    21-1
          PJN    SPF4        IF USER NAME FLAG NOT SET
          LDD    CM+3        SET NEW USER NAME
          SCN    77
          STD    CM+3
          LDD    FN+3
          LPN    77
          LMD    CM+3
          STD    CM+3
          LDD    FN+4
          STD    CM+4
          LDD    MA          RESET CONTROL POINT AREA WORD
          CWD    CM
          CRD    FN
 
*         CHANGE USER INDEX.
 
 SPF4     LDD    T7          CHECK USER INDEX FLAG
          SHN    21-0
          PJN    SPF5        IF USER INDEX FLAG NOT SET
          LDD    FN+3        SET NEW USER INDEX
          SCN    37
          STD    FN+3
          LDD    UN+3
          LPN    37
          LMD    FN+3
          STD    FN+3
          LDD    UN+4
          STD    FN+4
 
*         SET NEW USER NAME AND USER INDEX.
 
 SPF5     LDD    CP          WRITE NEW PARAMETERS
          ADN    UIDW
          CWD    FN
          LJM    CPMX        EXIT
 DFC      SPACE  4,10
***       FUNCTION 73.
*         DECREMENT FAMILY USER COUNT (*SYOT* ONLY).
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF FAMILY DESCRIPTOR WORD.
*
*T,       42/ FAMILY NAME, 17/ 0, 1/ 0
*
*         EXIT   FAMILY DESCRIPTOR WORD UPDATED.
*T,       42/ , 6/ RES, 11/ STATUS, 1/ C
*
*         STATUS = NON-ZERO IF FAMILY NOT FOUND.
*         C      = COMPLETION BIT. (ZERO ON REQUEST, ONE ON REPLY)
*         RES    = RESERVED FOR CDC.
 
 
 DFC      ENTRY
          RJM    CKA         CHECK PARAMETER ADDRESS
          CRD    FN          READ FAMILY NAME
          LDN    20          SET RETURN STATUS FOR FAMILY NOT FOUND
          STD    FN+4
          RJM    SFE         SET FAMILY EST ORDINAL
          SBN    2
          PJN    DFC1        IF FAMILY NOT FOUND
          LDN    0           SET RETURN STATUS FOR FAMILY FOUND
          STD    FN+4
          LDD    T2
          STD    CM+1        SET FAMILY EST ORDINAL
          LDN    DFCS        DECREMENT FAMILY USER COUNT
          STD    CM+3
          MONITOR  SMDM
 DFC1     LDD    FN+3        CLEAR RESERVED BITS
          SCN    77
          STD    FN+3
          AOD    FN+4        SET COMPLETE BIT
          LDN    0
          STD    T1
          RJM    CKA
          CWD    FN          WRITE STATUS
          LJM    CPMX        RETURN
 SPC      SPACE  4,20
***       FUNCTION 104.
*         SET PROLOGUE/EPILOGUE CONTROLS.
*         CALLER MUST HAVE *SSJ=* ENTRY POINT.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS *ADDR* OF PARAMETER BLOCK.
*
*T ADDR   32/ , 1/E, 3/TO, 18/ FL
*
*         E = EPILOGUE PENDING FLAG.  THE CHARGE REQUIRED FLAG
*              IS CLEARED IF CLEARING EPILOGUE PENDING FLAG.
*         TO = SYSTEM/PROJECT PROLOGUE/EPILOGUE TERMINATION OPTION
*              (SEE *COMSJCE*).
*         FL = OPTIONAL PROCESSING FLAGS.
*              BIT 1 = SET/CLEAR EPILOGUE PENDING FLAG.
*              BIT 0 = SET/CLEAR PROLOGUE/EPILOGUE TERMINATION OPTION.
 
 
 SPC      ENTRY
          RJM    CKA         READ PARAMETER WORD
          CRD    BA
          LDD    CP          READ PROLOGUE/EPILOGUE CONTROL
          ADN    EOJW
          CRD    CM
          ADN    CSPW-EOJW   READ EPILOGUE PENDING AND CHARGE REQUIRED
          CRD    FN
          ADN    JCDW-CSPW   READ PROCEDURE NESTING LEVEL
          CRD    UN
          LDD    BA+4
          SHN    21-0
          PJN    SPC1        IF NOT TO SET/CLEAR TERMINATION OPTION
          LDD    CM+2        SAVE CURRENT OPTION
          LPC    700
          STD    T1
          LDD    BA+3        SET TERMINATION OPTION
          LPC    700
          LMD    CM+2
          LMD    T1
          STD    CM+2
          LPC    700
          ZJN    SPC0.1      IF CLEARING OPTION, CLEAR NESTING LEVEL
 
*         IF A TERMINATION OPTION IS SET ON ENTRY AND IS NOT BEING
*         CLEARED, A PROJECT PROLOGUE IS TO BE EXECUTED FOLLOWING A
*         SYSTEM PROLOGUE IN THE PROLOGUE SEQUNCING PROCEDURE.  IN THIS
*         CASE, THE NESTING LEVEL CONTROL WILL NOT BE CHANGED.
 
          LDD    T1
          NJN    SPC1        IF ALREADY SEQUENCING PROLOGUES
          LDD    UN+2        SET NESTING LEVEL CONTROL
 SPC0.1   LMD    CM+2
          LPN    77
          LMD    CM+2
          STD    CM+2
 SPC1     LDD    BA+4
          SHN    21-1
          PJN    SPC2        IF NOT PROCESS EPILOGUE PENDING
          LDD    BA+3
          SHN    -6
          LPN    10
          LMD    FN
          LPN    10
          LMD    FN
          STD    FN
          LPN    10
          NJN    SPC2        IF SET EPILOGUE PENDING
          LDD    FN
          SCN    4           CLEAR CHARGE REQUIRED
          STD    FN
 SPC2     LDD    CP          WRITE PROLOGUE/EPILOGUE CONTROL
          ADN    EOJW
          CWD    CM
          ADN    CSPW-EOJW   WRITE EPILOGUE PENDING AND CHARGE REQUIRED
          CWD    FN
          LJM    CPMX        RETURN
 SCC      SPACE  4,40
***       FUNCTION  114.
*
*         DECREMENT SECURITY COUNT (MUST BE CALLED FROM AN *SSJ=*
*         PROGRAM).  IF THE SECURITY COUNT IS UNLIMITED OR IF A MASS
*         STORAGE ERROR IS ENCOUNTERED, THE SECURITY COUNT WILL NOT BE
*         DECREMENTED.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF THE 3-WORD BLOCK *ADDR*.
*
*T ADDR   42/ USER NAME, 18/
*T,       42/, 14/, 1/D, 3/
*T,       42/ FAMILY NAME, 18/
*
*                USER NAME IS SUPPLIED BY THE CALLER, IF D=0.
*                FAMILY NAME = 0, IF DEFAULT FAMILY USED.
*                D = 0, IF PARAMETER BLOCK PROVIDED BY CALLER.
*                D = 1, IF PARAMETER BLOCK MUST BE BUILT FROM
*                    THE CONTROL POINT AREA.
*
*         EXIT   THE PARAMETER BLOCK IS RETURNED AS FOLLOWS.
*
*T ADDR   42/ USER NAME, 18/
*T,       42/, 14/, 1/, 1/S, 2/
*T,       42/ FAMILY NAME, 18/
*
*                S = 1, IF SECURITY COUNT EXHAUSTED.
*
*         THE JOB IS ROLLED OUT TO WAIT FOR THE DEVICE TO BECOME
*         ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
*         RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
 
 
 SCC      ENTRY
          LDN    2           CHECK PARAMETER ADDRESS
          STD    T1
          RJM    CKA
          CRD    UN          READ USER NAME
          ADN    1
          CRD    CM          READ SECOND WORD
          ADN    1
          CRD    FN          READ FAMILY NAME
          LDD    CM+4
          SHN    21-3
          PJN    SCC1        IF NOT TO USE CONTROL POINT AREA
          LDN    0           SET DEFAULT FAMILY NAME
          STD    FN
          LDD    CP          READ USER NAME
          ADN    UIDW
          CRD    UN
 
*         DECREMENT SECURITY COUNT.
 
 SCC1     LDN    1           SET REQUEST TO DECREMENT SECURITY COUNT
          STD    UN+4
          EXECUTE  0AV,L0AV  DECREMENT SECURITY COUNT
          PJN    SCC1.1      IF NO MASS STORAGE ERROR ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          UJN    SCC2        IGNORE CALL
 
 SCC1.1   RJM    SFE         SET FAMILY EST ORDINAL
          ZJN    SCC3        IF FAMILY FOUND
 SCC2     LJM    CPMX        IGNORE CALL
 
 
*         CHECK SECURITY COUNT.
 
 SCC3     LDN    ZERL
          CRD    CM
          LDD    T6          CHECK SECURITY COUNT
          NJN    SCC4        IF SECURITY COUNT NOT EXHAUSTED
          LDN    4           SET COUNT EXHAUSTED FLAG
          STD    CM+4
 SCC4     LDN    2
          STD    T1
          RJM    CKA         SET PARAMETER ADDRESS
          CWD    UN          RETURN USER NAME
          ADN    1
          CWD    CM          RETURN STATUS
          ADN    1
          CWD    FN          RETURN FAMILY NAME
          UJN    SCC2        RETURN
 UCS      SPACE  4,15
***       FUNCTION 115.
*
*         UPDATE USER ACCESS WORDS IN CONTROL POINT AREA
*         AND THE SSJ= BLOCK IN NFL.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF 3-WORD PARAMETER
*                                BLOCK *ADDR*.
*
*T ADDR   60/ NEW *ALMW*
*T,       60/ NEW *ACLW*
*T,       60/ NEW *AACW*
*
*         EXIT   (ALMW) = *ALMW* FROM PARAMETER BLOCK.
*                (ACLW) = *ACLW* FROM PARAMETER BLOCK.
*                (AACW) = *AACW* FROM PARAMETER BLOCK.
 
 
 UCS      ENTRY
          LDN    2           SET LENGTH OF BLOCK
          STD    T1
          RJM    CKA         CHECK ADDRESS
          ERRNZ  ACLW-ALMW-1 CODE REQUIRES CONTIGUOUS WORDS
          ERRNZ  AACW-ACLW-1
          CRM    ALMT,TR
          LDD    CP          SET WORDS IN CONTROL POINT AREA
          ADN    ALMW
          CWM    ALMT,TR
          NFA    SSJN+ALMS   SET WORDS IN NFL
          CWM    ALMT,TR
          LJM    CPMX        RETURN
 RUA      SPACE  4,15
***       FUNCTION 126.
*         RETURN USER ACCOUNT BLOCK.
*
*         ENTRY  (IR+3 - IR+4) = FWA OF PARAMETER REPLY BLOCK.
*
*         EXIT   IF THERE ARE NO ERRORS, THE USER ACCOUNT BLOCK IS
*                WRITTEN TO THE PARAMETER REPLY BLOCK.
*
*                IF THE SPECIFIED USER NAME IS NOT FOUND, THE PARAMETER
*                BLOCK IS CLEARED.
*
*                IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
*                READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED TO
*                WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.  OTHERWISE,
*                THE PARAMETER BLOCK IS CLEARED.
 
 
 RUA      ENTRY              ENTRY/EXIT
          LDK    ARBS
          STD    T1
          RJM    CKA         VALIDATE PARAMETER BLOCK ADDRESS
          RJM    RUI         GET USER NAME
          NJN    RUA1        IF USER COMMAND FOUND
          LJM    RUA3        CLEAR PARAMETER BLOCK
 
 RUA1     LDK    ZERL        SET FAMILY NAME
          CRD    FN
          LDD    MA          SET USER NAME
          CWD    CM
          CRD    UN
          LDD    UN+3
          SCN    77
          STD    UN+3
          LDN    0           VALIDATE USER NAME FUNCTION
          STD    UN+4
          EXECUTE  0AV,L0AV
          PJN    RUA1.1      IF NO MASS STORAGE ERROR ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          UJN    RUA3        CLEAR THE PARAMETER BLOCK
 
 RUA1.1   LDD    T1
          LPN    37
          SHN    14
          LMD    T2
          ZJN    RUA3        IF USER NAME NOT FOUND
 
*         WRITE DATA TO PARAMETER BLOCK.
 
          LDD    T3          FWA OF USER ACCOUNT BLOCK
          STM    RUAA
          LDK    ARBS        NUMBER OF CM WORDS TO WRITE
          STD    T1
          RJM    CKA         GET PARAMETER BLOCK ADDRESS
          CWM    **,T1       WRITE USER ACCOUNT BLOCK
 RUAA     EQU    *-1
 RUA2     LJM    CPMX        RETURN
 
*         CLEAR PARAMETER BLOCK.
 
 RUA3     LDK    ZERL
          CRD    CM
          LDK    ARBS-1      LWA OF PARAMETER BLOCK
          STD    T1
 RUA4     RJM    CKA         GET PARAMETER BLOCK ADDRESS
          ADD    T1
          CWD    CM
          SOD    T1
          PJN    RUA4        IF MORE WORDS TO CLEAR
          UJN    RUA2        RETURN
 GPS      SPACE  4,20
***       FUNCTION 131.
*         GET PROLOGUE/EPILOGUE STATUS.
*         CALLER MUST HAVE *SSJ=* ENTRY POINT.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS *ADDR* OF PARAMETER BLOCK.
*
*T ADDR   60/
*
*         EXIT
*
*T ADDR   2/PR, 1/S, 32/0, 1/I, 24/RI
*
*         PR = 0 IF NO SYSTEM/PROJECT PROLOGUE OR EPILOGUE
*                ACTIVE.
*            = 1 IF IN SYSTEM/PROJECT PROLOGUE OR EPILOGUE
*                SEQUENCING PROCEDURE.
*            = 2 IF IN SYSTEM/PROJECT PROLOGUE OR EPILOGUE.
*         S  = 1 IF SHELL PROGRAM LOAD CANNOT BE SUSPENDED IN
*                PROLOGUE OR EPILOGUE.
*         I  = ENTRY INDEX IN PROFILE LEVEL-3 BLOCK IF PROJECT
*                EPILOGUE PENDING.
*         RI = RANDOM INDEX OF PROFILE LEVEL-3 BLOCK IF PROJECT
*                EPILOGUE PENDING.
 
 
 GPS      ENTRY
          RJM    CKA         READ PARAMETER WORD
          CRD    BA
          LDN    ZERL
          CRD    CN
          LDD    CP          READ PROLOGUE/EPILOGUE CONTROL
          ADN    EOJW
          CRD    CM
          ADN    CSPW-EOJW   READ EPILOGUE PENDING AND CHARGE REQUIRED
          CRD    FN
          ADN    JCDW-CSPW   READ PROCEDURE NESTING LEVEL
          CRD    UN
          LDD    CM+2
          LPC    777
          ZJN    GPS2        IF NO PROLOGUE OR EPILOGUE ACTIVITY
          ADN    1
          LMD    UN+2
          LPN    77
          ZJN    GPS1        IF IN SEQUENCING PROCEDURE
          LDC    6000        SET NOT IN SEQUENCING PROCEDURE
 GPS1     LMC    2000        SET SEQUENCING FLAGS
          STD    CN
 GPS2     NFA    SHCN        READ SHELL CONTROL
          CRD    CM
          LDD    CM
          ZJN    GPS3        IF NO SHELL PROGRAM ACTIVE
          LDD    CM+4
          SHN    21-6
          MJN    GPS3        IF SHELL CONTROLS SUSPENDABLE (*A* OPTION)
          LDC    1000        SET NON-SUSPENDABLE SHELL CONTROLS
          RAD    CN
 GPS3     LDD    FN
          SHN    21-3
          PJN    GPS4        IF NO EPILOGUE REQUIRED
          LDD    CP
          ADN    FPFW        READ PROFILE FILE POINTERS
          CRD    T3
          LDD    T3          RETURN ENTRY INDEX
          SHN    0-12
          LPN    1
          STD    CN+2
          SFA    FNT,T5      GET PROFILE FILE FST INFORMATION
          ADN    FSTG
          CRD    CM
          LDD    CM          EQUIPMENT NUMBER
          STD    T5
          LDD    CM+1
          RJM    SRA         SET RANDOM ADDRESS
          NJN    GPS6        IF TRACK/SECTOR NOT ON TRACK CHAIN
          STD    T1          SET *CKA* WORD COUNT
          LDD    RI          RETURN RANDOM ADDRESS
          STD    CN+3
          LDD    RI+1
          STD    CN+4
 GPS4     RJM    CKA         CHECK PARAMETER ADDRESS
          CWD    CN
 GPS5     LJM    CPMX        RETURN
 
 GPS6     LDK    SWET        SET ERROR FLAG
          STD    CM+2
          LDC    *           SET ADDRESS WHERE ERROR DETECTED
          STD    CM+1
          MONITOR  CHGM      CONDITIONAL HANG
          UJN    GPS5        RETURN
          TITLE  SUBROUTINES.
 CSU      SPACE  4,20
**        CSU - CHECK SECONDARY USER COMMAND.
*
*         ENTRY  (SM) = SECURITY MODE.
*                (CN - CN+4) = *CSPW*.
*                (UN - UN+4) = WORD 0 OF PARAMETER BLOCK.
*                (BA - BA+4) = WORD 2 OF PARAMETER BLOCK WITH STATUS
*                    FLAGS SET BY *GVP*.
*
*         EXIT   (A) = 0 IF SECONDARY USER COMMAND ALLOWED.
*                (A) .NE. 0 IF NOT SYSTEM ORIGIN JOB AND SYSTEM IS
*                  OPERATING IN SECURED MODE.
*                TO *CPMX* WITH ERROR CODE SET IN CALL BLOCK IF
*                  SECONDARY USER COMMAND DISALLOWED AND SYSTEM IS NOT
*                  OPERATING IN SECURED MODE.
*
*         USES   BA+4, CM - CM+4, CN - CN+4, T4 - T7.
*
*         CALLS  CKA, CFN, RUI, SFE.
*
*         MACROS NFA.
 
 
 CSU      SUBR
          LDD    CN
          SHN    3-2
          LPN    10
          NJN    CSU1        IF CHARGE REQUIRED SET
          LDD    OT          CHECK ORIGIN TYPE
          LMK    SYOT
          ZJN    CSUX        IF SYSTEM ORIGIN JOB
          LDD    SM
          NJN    CSUX        IF SYSTEM OPERATING IN SECURE MODE
          LDN    SSTL        CHECK IF SECONDARY USER COMMANDS ENABLED
          CRD    CM
          LDD    CM+1
          LPN    20
 CSU1     NJN    CSU2        IF SECONDARY USER COMMANDS DISABLED
          NFA    SSJN+AACS   READ USER ACCESS WORD
          CRD    T4
 
*         CHECK ALTERNATE FAMILY.
 
          LDD    T4+3
          SHN    21-11
          MJN    CSU3        IF VALIDATED FOR ALTERNATE FAMILY
          RJM    SFE         SET (FN - FN+3) IF FAMILY DEFAULTED
          LDD    CP          READ FAMILY EST POINTER
          ADN    PFCW
          CRD    CM
          SFA    EST,CM+3    GET MST ADDRESS
          ADK    EQDE
          CRD    CM
          LDD    CM+4        SET FAMILY ADDRESS
          SHN    3
          ADN    PFGL
          CRD    CN
          RJM    CFN         COMPARE FAMILIES
          ZJN    CSU3        IF ALTERNATE FAMILY NOT SPECIFIED
          LDN    30          SET ALTERNATE FAMILY NOT ALLOWED ERROR
 CSU2     UJN    CSU6        SET ERROR CODE
 
*         CHECK ALTERNATE USER NAME.
 
 CSU3     LDD    T4+2
          LPN    20          *CSAU* BIT
          LMN    20
 CSU4     ZJP    CSUX        IF VALIDATED FOR ALTERNATE USER NAME
          RJM    RUI         GET CURRENT USER NAME
          LMD    UN
          NJN    CSU5        IF NOT SAME USER NAME
          LDD    CM+1
          LMD    UN+1
          NJN    CSU5        IF NOT SAME USER NAME
          LDD    CM+2
          LMD    UN+2
          NJN    CSU5        IF NOT SAME USER NAME
          LDD    CM+3
          LMD    UN+3
          SCN    77
          ZJN    CSU4        IF SAME USER NAME
 CSU5     LDN    40          SET ALTERNATE USER NAME NOT ALLOWED ERROR
 
*         RETURN ERROR CODE AND EXIT.
 
 CSU6     RAD    BA+4        SET ERROR CODE
          RJM    CKA         WRITE ERROR STATUS
          ADN    2
          CWD    BA
          LJM    CPMX        EXIT
 GPV      SPACE  4,20
**        GPV - GET PARAMETERS FOR VALIDATE USER COMMAND FUNCTION.
*
*         ENTRY  (OT) = ORIGIN TYPE.
*
*         EXIT   (A) = 0 IF NOT SECONDARY USER COMMAND.
*                (CN - CN+4) = *CSPW*.
*                (UN - UN+4) = WORD 0 OF PARAMETER BLOCK.
*                (FN - FN+4) = WORD 2 OF PARAMETER BLOCK.
*                (BA - BA+4) = WORD 2 OF PARAMETER BLOCK WITH STATUS
*                    FLAGS SET.
*                (PIUE) RESET IF *NO ABORT* FLAG SET.
*                (VANA) RESET IF *SPECIAL USER NAMES OK* FLAG SET.
*                (VANC) = 1 IF PRIMARY USER COMMAND ALREADY PROCESSED.
*                TO *ERR* IF NO *SSJ=* PARAMETER BLOCK DEFINED.
*
*         USES   T1, BA - BA+4, CM - CM+4, CN - CN+4, FN - FN+4,
*                UN - UN+4.
*
*         CALLS  CKA.
*
*         MACROS ABORT, SFA.
 
 
 GPV      SUBR               ENTRY/EXIT
          LDD    CP
          ADK    SEPW
          CRD    CM
          LDD    CM+3
          LPN    77
          ADD    CM+4
          NJN    GPV1        IF *SSJ=* BLOCK DEFINED
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 GPV1     LDN    12          CHECK PARAMETER ADDRESS
          STD    T1
          RJM    CKA
          CRD    UN          READ USER NAME
          CRM    PIUB,ON     SET ERROR MESSAGE
          CRD    CM          READ OPTIONS
          ADN    1
          CRD    FN          READ FAMILY NAME
          CRD    BA
          LDD    CM+4        SAVE SPECIAL USER NAMES OK FOR SYOT FLAG
          LPN    10
          RAM    VANA
          LDD    CM+4        SAVE NO-ABORT OPTION
          LPN    4
          RAM    PIUE
          LDD    CP          READ EJT POINTER
          ADN    TFSW
          CRD    CM
          ADN    CSPW-TFSW   READ PRIMARY USER FLAG
          CRD    CN
          SFA    EJT,CM
          ADN    SCLE
          CRD    CM
          LDD    CM          SET SERVICE CLASS
          SHN    -6
          RAD    BA+3
          LDD    CN
          SHN    -1
          LPN    1
          STM    VANC        SAVE PRIMARY USER FLAG
          STD    BA+4
          LJM    GPVX        EXIT WITH SECONDARY USER COMMAND STATUS
 PIU      SPACE  4,20
**        PIU - PROCESS INCORRECT USER COMMAND.
*
*         ENTRY  (A) = 0 IF SECURITY COUNT EXHAUSTED.
*                (BA - BA+4) = STATUS WORD.
*                (UN - UN+4) = USER NAME AND USER INDEX.
*                (VANB) = FAMILY EST ORDINAL.
*
*         EXIT   TO *CPMX*.
*                USER INDEX CLEARED IN PARAMETER BLOCK IF NO ABORT
*                  OPTION.
*
*         USES   BA+4, CN+3, T1, T2, T6, FN - FN+4, UN+3 - UN+4.
*
*         CALLS  CKA, DFM, UFC.
*
*         MACROS MONITOR.
 
 
 PIU      BSS    0           ENTRY
          STD    T6          SAVE (A)
          NJN    PIU0.1      IF SECURITY COUNT NOT EXHAUSTED
          LDN    2           SET SECURITY COUNT EXHAUSTED
          RAD    BA+4
 PIU0.1   LDM    VANB        RESET FAMILY EST ORDINAL
          ZJN    PIU1        IF NOT SET
          STD    CN+3
          LDD    CP
          ADN    PFCW
          CRD    FN
          LDD    FN+3        SET NEW FAMILY EST ORDINAL FOR *UFC*
          STD    T2
          RJM    UFC         UPDATE FAMILY COUNT
 PIU1     LDD    T6
          ZJN    PIU4        IF USER SECURITY COUNT EXHAUSTED
          LDN    0           TERMINATE ACCOUNT FILE MESSAGE
          STM    PIUB+4
          LDM    PIUB+3
          SCN    77
          STM    PIUB+3
          LDC    PIUB-1      SET INDEX
          STD    T6
 PIU2     AOD    T6          FIND END OF MESSAGE
          LDI    T6
          ZJN    PIU3        IF END ON WORD BOUNDARY
          LPN    77
          NJN    PIU2        IF NOT END OF MESSAGE
          LDC    1R.&2R.
 PIU3     LMC    2R.         SET PERIOD
          RAI    T6
          LDC    ACFN+PIUA   WRITE MESSAGE TO ACCOUNT FILE
          RJM    DFM
          LDC    PIUD&PIUC   * INCORRECT USER COMMAND.*
 PIU4     LMC    PIUC        * USER SECURITY COUNT EXHAUSTED.*
          RJM    DFM
 PIUE     LDN    0
*         LDN    4           (IF JOB IS NOT TO BE ABORTED)
          NJN    PIU6        IF JOB IS NOT TO BE ABORTED
          LDN    SVET        SET ERROR FLAG
          STD    CM+1
          MONITOR  CEFM
 PIU5     LJM    CPMX        EXIT
 
 PIU6     LDN    0           CLEAR USER INDEX
          STD    UN+4
          LDD    UN+3
          SCN    77
          STD    UN+3
          LDN    12          RETURN ERROR STATUS TO CALLER
          STD    T1
          RJM    CKA
          CWD    UN
          ADN    2
          CWD    BA
          UJN    PIU5        TERMINATE PROGRAM
 
 
 PIUA     DATA   H*SIUN, *   ACCOUNT FILE MESSAGE
 PIUB     BSSZ   5
 
 PIUC     DATA   C* USER SECURITY COUNT EXHAUSTED.*
 PIUD     DATA   C* INCORRECT USER COMMAND.*
 PSV      SPACE  4,15
**        PSV - PROCESS SECURITY VALIDATIONS.
*
*         DETERMINE IF THE PRIMARY USER COMMAND CAN BE PROCESSED,
*         GIVEN THE USER-S VALIDATIONS AND THE APPLICABLE ACCESS
*         LEVEL LIMITS.  THIS SUBROUTINE IS ONLY NEEDED FOR *SYOT*
*         JOBS (SUCH AS *DIS* AND *PTFS*) WHICH HAVE NOT HAD
*         A *USER* COMMAND VALIDATED BY *0VJ*.
*
*         ENTRY  (T3) = FWA OF VALIDATION BLOCK.
*
*         EXIT   (A) = 0 IF NO ERROR.
*                *JSCW* UPDATED.
*                NEW ACCESS LEVEL LIMITS SET IN EJT.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  RUI.
*
*         MACROS MONITOR, SFA.
 
 
 PSV      SUBR               ENTRY/EXIT
          LDD    T3          SET VALIDATION BLOCK ADDRESS
          RAM    PSVA
          LDD    MA          SET UP *VSAM* PARAMETERS
          CWM    5*ASVW,ON
 PSVA     EQU    *-1         (FWA OF *ASVW* IN VALIDATION BLOCK)
          LDD    OT
          STD    CM+2
          LDD    CP          SET JOB ACCESS LEVEL LIMITS
          ADN    TFSW
          CRD    CN
          SFA    EJT,CN
          ADK    PRFE
          CRD    CN
          LDD    CN+2        SET UPPER ACCESS LEVEL LIMIT
          LPN    7
          STD    CM+3
          LDD    CN+2        SET LOWER ACCESS LEVEL LIMIT
          LPN    70
          SHN    -3
          STD    CM+4
          LDN    VJCS        VALIDATE JOB CREATION PARAMETERS
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          NJP    PSVX        IF JOB MAY NOT BE CREATED
 
*         UPDATE *JSCW* IN CONTROL POINT AREA.
 
          LDD    CP          GET CURRENT JOB ACCESS LEVEL
          ADK    JSCW
          CRD    CN
          LDD    CN+1
          SHN    -11
          SBD    CM+4
          MJN    PSV1        IF CURRENT LEVEL .LT. NEW LOWER LIMIT
          ADD    CM+4        KEEP CURRENT VALUE FOR JOB ACCESS LEVEL
          STD    CM+4
 PSV1     LDD    MA          SET UP *JSCW* WORD
          CRD    CN
          LDD    CM+4        RESET JOB ACCESS LEVEL
          SHN    11
          LMD    CN+1
          LPC    7000
          LMD    CN+1
          STD    CN+1
          LDD    CM+3        RESET UPPER ACCESS LEVEL LIMIT
          SHN    11
          LMD    CN+2
          LPC    7000
          LMD    CN+2
          STD    CN+2
          LDD    CP          RESET *JSCW*
          ADK    JSCW
          CWD    CN
 
*         SET NEW JOB ACCESS LEVEL LIMITS IN EJT ENTRY.
 
          LDN    ZERL
          CRD    CN
          LDD    CM+3        SET UPPER ACCESS LEVEL LIMIT
          STD    CN+4
          LDD    CM+4        SET LOWER ACCESS LEVEL LIMIT
          SHN    3
          RAD    CN+4
          LDC    24D*100     SET FIELD POSITION
          STD    CN+1
          LDN    6           SET LENGTH OF ACCESS LEVEL FIELD
          STD    CN
          LDD    CP          GET ADDRESS OF EJT ENTRY
          ADK    TFSW
          CRD    CM
          SFA    EJT,CM
          ADN    PRFE
          STD    CM+4        SET UP *UTEM* PARAMETERS
          SHN    -14
          STD    CM+3
          LDN    0
          STD    CM+2
          LDN    1
          STD    CM+1
          LDD    MA
          CWD    CN
          MONITOR  UTEM      UPDATE EJT ENTRY
          LDN    0           RETURN NORMAL STATUS
          LJM    PSVX        RETURN
 RPE      SPACE  4,15
**        RPE - RETURN PASSWORD EXPIRATION DATE.
*
*         ENTRY  (T3) = FWA OF ACCOUNT BLOCK RECORD.
*
*         EXIT   (CM - CM+4) = 42/0, 18/PASSWORD EXPIRATION DATE.
*
*         USES   T0, CM - CM+4.
 
 
 RPE      SUBR               ENTRY/EXIT
          LDN    ZERL        CLEAR REPLY WORD
          CRD    CM
          LDD    T3          SET ADDRESSES
          ADN    3
          ADC    APWI*5      INTERACTIVE PASSWORD
*         ADC    APSW*5      (BATCH PASSWORD)
 RPEA     EQU    *-1         (ADDRESS OF PASSWORD IN VALIDATION BLOCK)
          STD    T0
          LDI    T0          STORE PASSWORD EXPIRATION
          LPN    77
          STD    CM+3
          AOD    T0
          LDI    T0
          STD    CM+4
          UJN    RPEX        RETURN
 RUB      SPACE  4,30
**        RUB - RETURN USER BLOCK.
*
*         RETURN USER BLOCK BY EITHER READING THE SYSTEM SECTOR
*         OR CALLING *0AV*.
*
*         ENTRY  (UN - UN+3) = USER NAME.
*                (FN - FN+3) = FAMILY NAME.
*
*         EXIT   (A) = 0 IF INCORRECT USER NAME.
*                    .LT. 0, IF MASS STORAGE ERROR ENCOUNTERED.
*                (T1 - T2) = USER INDEX.
*                (T3) = FWA OF ACCOUNT RECORD BLOCK.
*                (T4) = 0 IF USER INDEX .LT. *AUIMX*.
*                (T5) = FAMILY EST ORDINAL.
*                (T6) = SECURITY COUNT.
*                (TNSS) = 0, IF SYSTEM SECTOR NOT READ.
*
*                THE JOB IS ROLLED OUT TO WAIT FOR THE DEVICE TO BECOME
*                ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
*                RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
*
*         USES   CM - CM+4, T1 - T7, UN+3 - UN+4.
*
*         CALLS  CJR, RUI, RSS, *0AV*.
*
*         MACROS ENDMS, EXECUTE, NFA, SETMS.
 
 
 RUB      SUBR               ENTRY/EXIT
          LDN    ZERL        CLEAR *TNSS*
          CRM    TNSS,ON
          LDM    VANC
          NJN    RUB1        IF SECONDARY USER COMMAND
          RJM    RUI         READ USER ID WORD
          NJN    RUB2        IF FIRST USER COMMAND VALIDATED BY *0VJ*
 RUB1     LJM    RUB5        CALL *0AV* TO READ VALIDATION FILE
 
*         USE VALIDATION BLOCK FROM JOB INPUT FILE SYSTEM SECTOR.
*         SET DIRECT CELLS TO MATCH *0AV* EXIT CONDITIONS.
 
 RUB2     NFA    FNTN+FSTL   READ INPUT FILE FST WORD
          CRD    T5
          SETMS  IO          READ JOB INPUT FILE SYSTEM SECTOR
          LDN    0
          RJM    RSS
          ZJN    RUB2.2      IF SUCCESSFUL READ
          PJN    RUB2.1      IF SYSTEM SECTOR ERROR OTHER THAN READ
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
 RUB2.1   LCN    0           INDICATE MASS STORAGE ERROR
          LJM    RUBX        RETURN
 
 RUB2.2   ENDMS
          LDC    VASS        SET FWA OF USER ACCOUNT BLOCK
          STD    T3
          LDM    AUIN*5+4,T3 USER INDEX
          STD    T2
          LDM    AUIN*5+3,T3
          LPN    77
          STD    T1
          LDM    AHSC*5+1,T3 SECURITY COUNT
          SHN    -6
          STD    T6
          LDI    T3
          ZJN    RUB5        IF NO ACCOUNT RECORD BLOCK
          LDD    T1
          SHN    14
          LMD    T2
          ADC    -AUIMX
          PJN    RUB3        IF UI .GE. AUIMX
          LDN    0
          UJN    RUB4        SET UI .LT. AUIMX
 
 RUB3     LDN    1
 RUB4     STD    T4
          UJN    RUB6        CONTINUE
 
*         READ USER BLOCK FROM VALIDATION FILE BY CALLING *0AV*.
 
 RUB5     LDN    0           SET NORMAL *0AV* CALL
          STD    UN+4
          LDD    UN+3
          SCN    77
          STD    UN+3
          EXECUTE  0AV,L0AV
          PJN    RUB6        IF NO MASS STORAGE ERROR ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          LCN    0           INDICATE MASS STORAGE ERROR
          UJN    RUB7        RETURN
 
 RUB6     LDD    T1          ENTER USER INDEX
          RAD    UN+3
          LPN    37
          SHN    14
          LMD    T2
          ZJN    RUB7        IF INCORRECT USER NAME
          STD    UN+4
 RUB7     LJM    RUBX        RETURN
 RUI      SPACE  4,10
**        RUI - READ USER IDENTIFICATION WORD.
*
*         EXIT   (A) = (RUIA) = FIRST BYTE OF CURRENT USER NAME.
*                (CM - CM+4) = CURRENT USER NAME FROM *SSJ=* BLOCK
*                              OR FROM CPA.
*
*         USES   CM - CM+4.
*
*         MACROS NFA.
 
 
 RUI1     LDD    CP          GET *UIDW* FROM CONTROL POINT AREA
          ADN    UIDW
 RUI2     CRD    CM          READ *UIDW*
          LDD    CM
          STM    RUIA
 
 RUI      SUBR               ENTRY/EXIT
          LDD    CP
          ADK    SEPW
          CRD    CM
          LDD    CM+3
          LPN    77
          ADD    CM+4
          ZJN    RUI1        IF NO *SSJ=* BLOCK
          NFA    SSJN+UIDS   GET *UIDW* FROM *SSJ=* BLOCK
          UJN    RUI2        READ *UIDW*
 
 RUIA     CON    0           FIRST BYTE OF CURRENT USER NAME
 VPW      SPACE  4,15
**        VPW - VALIDATE PASSWORD.
*
*         ENTRY  (T3) = FWA OF ACCOUNT BLOCK RECORD.
*                (FN - FN+4) = WORD 1 OF PARAMETER BLOCK.
*
*         EXIT   (A) = 0 IF LEGAL PASSWORD.
*                (CN+3 - CN+4) = PASSWORD EXPIRATION DATE.
*
*         USES   CM - CM+4, CN - CN+4, FN - FN+4.
*
*         CALLS  CFN.
*
*         MACROS MONITOR.
 
 
 VPW3     LDN    0           INDICATE LEGAL PASSWORD
 
 VPW      SUBR               ENTRY/EXIT
          LDK    ZERL        CLEAR PASSWORD EXPIRATION DATE
          CRD    CN
          LDD    FN+4
          LPN    1
          NJN    VPW3        IF PASSWORD NOT REQUIRED
          LDD    T3          SET ADDRESSES
          ADC    APWI*5      VALIDATE INTERACTIVE PASSWORD
*         ADC    APSW*5      (VALIDATE BATCH PASSWORD)
 VPWA     EQU    *-1         (ADDRESS OF PASSWORD IN VALIDATION BLOCK)
          STM    VPWD
          ADN    3
          STM    VPWB
          ADN    1
          STM    VPWC
 
*         PROCESS PASSWORD EXPIRATION DATE.
 
          LDM    *           CHECK PASSWORD EXPIRATION DATE
 VPWB     EQU    *-1         (FWA OF PASSWORD EXPIRATION DATE)
          LPN    77
          STD    CM+3
          SHN    14
          LMM    *
 VPWC     EQU    *-1         (FWA+1 OF PASSWORD EXPIRATION DATE)
          ZJN    VPW2        IF NONEXPIRING PASSWORD
          STD    CM+4
          LDN    VEDS        VALIDATE EXPIRATION DATE
          STD    CM+1
          MONITOR  VSAM
          LDD    CM+1
          ZJN    VPW2        IF PASSWORD NOT EXPIRED
 VPW1     LJM    VPWX        RETURN
 
 VPW2     LDN    REPS        ENCRYPT SUPPLIED PASSWORD
          STD    CM+1
          LDD    MA
          CWD    FN
          MONITOR  RDCM
          LDD    MA
          CRD    FN
          CWM    *,ON        COPY LEGAL PASSWORD
 VPWD     EQU    *-1         (FWA OF PASSWORD)
          SBN    1
          CRD    CN          READ LEGAL PASSWORD
          RJM    CFN         COMPARE PASSWORDS
          UJN    VPW1        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPSFE
*CALL     COMPSFN
*CALL     COMPSRA
*CALL     COMPSRU
          SPACE  4,10
**        BUFFERS.
 
 
 ALMT     EQU    *           *ALMW*
 ACLT     EQU    ALMT+5      *ACLW*
 AACT     EQU    ACLT+5      *AACW*
 
 BUFL     EQU    AACT+5      LWA+1 OF OVERLAY
          ERRNG  L0AV-5-BUFL OVERFLOW INTO *0AV*
          SPACE  4,10
          OVERFLOW  OVL,EPFW
          OVERLAY  (USER ACCOUNTING FUNCTIONS.)
 SLL      SPACE  4,15
***       FUNCTION 3.
*         SET TIME AND SRU LIMITS
*
*         ENTRY  (IR+3 - IR+4) = 6/FN,18/PARAM
*                            FN = 0 FOR TIME LIMIT
*                            FN = 1 FOR SRU JOB STEP LIMIT
*                            FN = 2 FOR SRU ACCOUNT BLOCK LIMIT
*                            PARAM = SECONDS FOR TIME, UNITS FOR SRU.
*                            IF PARAM IS ANY OF THE FOLLOWING:
*                              1. GREATER THAN THE MAXIMUM FOR WHICH
*                                 THE USER IS VALIDATED,
*                              2. BETWEEN 77770B AND 777777B (TIME
*                                 LIMIT),
*                              3. GREATER THAN OR EQUAL TO 655400B (SRU
*                                 LIMIT),
*                            THE TIME OR SRU LIMIT WILL BE SET TO THE
*                            MAXIMUM FOR WHICH THE USER IS VALIDATED
*                            (INFINITE IF UNLIMITED VALIDATION).
*
*         IF FN=1 AND PARAM IS GREATER THAN THE CURRENT ACCOUNT BLOCK
*         SRU LIMIT, BOTH THE JOB STEP AND ACCOUNT BLOCK SRU LIMITS ARE
*         SET TO PARAM.  IF FN=2 AND PARAM IS LESS THAN THE CURRENT JOB
*         STEP SRU LIMIT, BOTH THE ACCOUNT BLOCK AND JOB STEP SRU
*         LIMITS ARE SET TO PARAM.
 
 
 SLL      ENTRY
          LDD    IR+3
          SHN    -6
          STD    T1
          SBN    NOP
          MJN    SLL2        IF LEGAL SUB FUNCTION
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 SLL1     ABORT  ERNV        * XX NOT VALIDATED.*
 
 SLL2     LDD    T1
          ZJN    SLL3        IF TIME LIMIT REQUEST
          LDC    SHNI+74     *SHN    -3*
          STM    SLLA
          LDC    -5540B      *ADC    -65540*
          STM    SLLD+1
          AOM    SLLD
          LDC    2RSL&2RTL   SET *SL* RESOURCE TYPE
 SLL3     LMC    2RTL        SET RESOURCE TYPE
          STM    ERRA
          LDN    0
          STD    T2
          STD    CM+2
          LDD    IR+3        CHECK REQUESTED LIMIT
          LPN    77
          STD    CM+3
          SHN    14
          LMD    IR+4
          STD    CM+4
          ZJN    SLL1        IF ZERO LIMIT
 SLLA     PSN                PASS
*         SHN    -3          IF SRU LIMIT PROCESSING
          ADC    -77770
 SLLD     EQU    *-2
*         ADC    -65540      (SRU LIMIT PROCESSING)
          MJN    SLL5        IF NOT REQUEST FOR VALIDATED MAXIMUM
 SLL4     LCN    0
          STD    CM+4
          LPN    77
          STD    CM+3
          LDC    STDI+CM+4   SET UP TO SAVE VALIDATION LIMIT
          STM    STLA
          SBN    1
          STM    STLB
 
*         CHECK AGAINST VALIDATION LIMIT.
 
 SLL5     LDD    CP          READ VALIDATION PARAMETERS
          ADN    ALMW
          CRD    CN
          LDM    TOPN,T1     JUMP TO PROCESSOR
          STM    SLLB
          LJM    *
 SLLB     EQU    *-1
 
*         SET TIME LIMIT.
 
 STL      LDC    STL4        SET RETURN ADDRESS
          STM    SLLC
          LDD    CN+2
          RJM    TLI         CONVERT INDEX TO VALUE
 STL1     MJN    STL3        IF UNLIMITED
          SHN    3           MULTIPLY BY 10B
          STD    T2          SAVE BOTTOM HALF
          SHN    -14
          STD    T1          SAVE TOP HALF
          LDD    T2
 STLA     SBD    CM+4
*         STD    CM+4        (REQUEST FOR VALIDATED MAXIMUM)
          MJN    STL2        IF BORROW NEEDED
          AOD    T1
 STL2     SOD    T1
 STLB     SBD    CM+3
*         STD    CM+3        (REQUEST FOR VALIDATED MAXIMUM)
          PJN    STL3        IF NOT ABOVE USER MAXIMUM
          LDD    IR+3        RESTORE RESOURCE TYPE
          SHN    -6
          STD    T1
          LJM    SLL4        PROCESS AS REQUEST FOR VALIDATED MAXIMUM
 
 STL3     LJM    *           RETURN TO PROCESSOR
 SLLC     EQU    *-1
 
 STL4     LDN    RLTL        SET TIME LIMIT SUBFUNCTION
          STD    CM+1
          MONITOR RLMM
          LJM    CPMX        EXIT
 
*         SET JOB STEP LIMIT.
 
 SJS      LDC    SJS2
          STM    SLLC
 SJS1     LDD    CN+2        CHECK VALIDATION LIMIT
          RJM    SLI
          UJP    STL1        CHECK LIMIT WITHIN ALLOWED RANGE
 
 SJS2     LDD    CP          GET LIMIT WORD FROM CONTROL POINT
          ADN    STLW
          CRD    CN
          LDD    CN+1        GET ACCOUNT BLOCK LIMIT IN USABLE FORMAT
          SCN    77
          SHN    6
          LMD    CN
          SHN    6
          STD    CN
          SHN    -14
          SBD    CM+3
          MJN    SJS3        IF GREATER THAN ACCOUNT BLOCK LIMIT
          NJN    SJS4        IF LESS THAN ACCOUNT BLOCK LIMIT
          LDD    CN
          SBD    CM+4
          PJN    SJS4        IF NOT GREATER THAN ACCOUNT BLOCK LIMIT
 SJS3     RJM    SAL         SET ASL TO REQUESTED JSL FIRST
 SJS4     LDN    RLSL        SET SRU LIMIT SUBFUNCTION
          STD    CM+1
          MONITOR RLMM       SET SRU LIMIT
          LJM    CPMX
 
*         SET ACCOUNT BLOCK LIMIT.
 
 SAB      LDC    SAB1        SET RETURN ADDRESS
          STM    SLLC
          LJM    SJS1
 
 SAB1     LDD    CP          GET LIMIT WORD FROM CONTROL POINT
          ADN    STLW
          CRD    CN
          ADN    SRJW-STLW
          CRD    T1
          LDD    T1+2        COMPARE REQUEST TO CURRENT JOB STEP LIMIT
          SCN    77
          SHN    6
          LMD    T1+1
          SHN    6
          STD    T1+1
          SHN    -14
          STD    T1
          LDD    CM+3        REQUESTED ACCOUNT BLOCK - JOB STEP LIMIT
          SBD    T1
          MJN    SAB2        IF JOB STEP GREATER THAN REQUEST
          NJN    SAB3        IF REQUESTED GREATER THAN JOB STEP
          LDD    CM+4
          SBD    T1+1
          PJN    SAB3        IF REQUESTED GREATER THAN JOB STEP
 SAB2     LDD    MA          SAVE REQUESTED ACCOUNT BLOCK LIMIT
          CWD    CM
          CRD    BA
          LDN    RLSL        SET JSL TO REQUESTED ASL FIRST
          STD    CM+1
          MONITOR RLMM
          LDD    MA          RESTORE REQUESTED ACCOUNT BLOCK LIMIT
          CWD    BA
          CRD    CM
 SAB3     RJM    SAL         SET ACCOUNT BLOCK LIMIT
          LJM    CPMX        RETURN
 
 
 TOPN     BSS    0           TABLE OF SUB-FUNCTION CODE PROCESSORS
          LOC    0
          CON    STL         SET TIME LIMIT
          CON    SJS         SET JOB STEP LIMIT
          CON    SAB         SET ACCOUNT BLOCK LIMIT
          LOC    *O
 NOP      EQU    *-TOPN
 RLM      SPACE  4,10
***       FUNCTION 17.
*         RETRIEVE LIMIT TO (PARAMETER).
*
*         ENTRY  (IR+3 - IR+4) = 6/FN,18/PARAM
*                              FN = 0 FOR TIME LIMIT
*                              FN = 1 FOR SRU JOB STEP LIMIT
*                              FN = 2 FOR SRU ACCOUNT BLOCK LIMIT
*                              PARAM = SECONDS FOR TIME
*                                      UNITS  FOR SRU
 
 
 RLM      ENTRY
          LDN    ZERL
          CRD    CM
          LDD    IR+3        SET OPTION CODE
          SHN    -6
          NJN    RLM1        IF NOT TIME
          LDD    CP          RETURN TIME LIMIT VALUE
          ADN    CPJW
          UJN    RLM2
 
 RLM1     SHN    -1
          NJN    RLM4        IF NOT JOB STEP SRU
          LDD    CP          RETURN JOB STEP SRU LIMIT
          ADN    SRJW
 RLM2     CRD    CN
          LDD    CN+2
          SCN    77
          SHN    6
          LMD    CN+1
 RLM3     SHN    6
          STD    CM+4
          SHN    -14
          STD    CM+3
          LDD    IR+3        MAKE ADDRESS LEGAL FOR CKA ROUTINE
          LPN    37
          STD    IR+3
          RJM    CKA         CHECK RETURN ADDRESS
          CWD    CM
          LJM    CPMX        EXIT
 
 RLM4     LDD    CP          RETURN ACCOUNT BLOCK LIMIT
          ADN    STLW
          CRD    CN
          LDD    CN+1
          SCN    77
          SHN    6
          LMD    CN
          UJN    RLM3
 RAI      SPACE  4,15
***       FUNCTION 30.
*         PROVIDE ACCOUNTING INFORMATION.
*
*         EXIT   JOB ACCOUNTING INFORMATION RETURNED TO USER.
*
*         PARAMETER BLOCK FORMAT -
*
*T ADDR   18/ 0,42/ SRU ACCUMULATOR (MICRO UNITS * 10)
*T,       60/ CP ACCUMULATOR (QUARTER NANOUNITS)
*T,       20/ MS,20/ MT,20/ PF
*T,       20/ OD,20/ MP,20/ AA
*T,       31/ 0, 29/ AC
*         WHERE
*         AA = ACCUMULATED ADDER ACTIVITY.
*         MP = ACCUMULATED MAP ACTIVITY.
*         MS = ACCUMULATED MASS STORAGE ACTIVITY.
*         MT = ACCUMULATED MAGNETIC TAPE ACTIVITY.
*         OD = ACCUMULATED OPTICAL DISK ACTIVITY.
*         PF = ACCUMULATED PERMANENT FILE ACTIVITY.
*         AC = ACCUMULATED APPLICATION UNIT CHARGE ACTIVITY.
 
 
 RAI      ENTRY
          LDN    ACTWL       PICK NO OF ACCOUNTING WORDS
          STD    T1          NUMBER OF WORDS TO READ
          LDD    CP
          ADN    ACTW        ACCOUNTING INFORMATION
          CRM    STMT,T1
          LDD    CP          READ SECOND ACCOUNTING BLOCK
          ADK    AC1W
          CRM    STMT+ACTWL*5,ON
          LDN    0           CLEAR ALL BUT ACCUMULATORS
          STM    SRUW*5-ACTW*5+STMT  LIMIT FLAGS
          LDM    ADAW*5-ACTW*5+STMT+3
          LPC    377
          STM    ADAW*5-ACTW*5+STMT+3
          LDM    SRUW*5-ACTW*5+STMT+1  OVERFLOW FLAGS
          LPN    37
          STM    SRUW*5-ACTW*5+STMT+1
          LDN    2           GET MAP AND OPTICAL ACCUMULATORS
          STD    T5
 RAI1     LDM    MPAW*5-AC1W*5+STMT+ACTWL*5+2,T5
          SHN    21-3
          STM    ADAW*5-ACTW*5+STMT,T5
          SHN    13-21
          LPC    7400
          RAM    ADAW*5-ACTW*5+STMT+1,T5
          SOD    T5
          PJN    RAI1        IF NOT LAST MAP/OPTICAL BYTE
          LDM    MPAW*5-AC1W*5+STMT+ACTWL*5+1  MOVE FINAL 4 BITS
          SHN    13-3
          LPC    7400
          RAM    ADAW*5-ACTW*5+STMT
          LDD    CP          READ AUC ACCUMULATOR
          ADK    AUCW
          CRM    STMT+ACTWL*5,ON
          LDN    0           CLEAR ALL BUT ACCUMULATOR
          STM    AUCW*5-AC1W*5+STMT+ACTWL*5
          STM    AUCW*5-AC1W*5+STMT+ACTWL*5+1
          LDM    AUCW*5-AC1W*5+STMT+ACTWL*5+2
          LPN    5
          STM    AUCW*5-AC1W*5+STMT+ACTWL*5+2
          AOD    T1          SET NUMBER OF WORDS TO WRITE
          RJM    CKA
          CWM    STMT,T1     WRITE TO CENTRAL
          LJM    CPMX
 SCF      SPACE  4,40
***       FUNCTION 42.
*         BEGIN ACCOUNT BLOCK.
*
*         ENTRY  (IR+3 - IR+4)  =  6/A, 18/B
*                WHERE
*                A = CPM RECALL COUNT.
*                B = PARAMETER BLOCK ADDRESS.
*
*         PARAMETER BLOCK FORMAT -
*
*T STMT   12/ M1,12/ M2,12/ M3,12/ M4,12/ AD
*T,       6/ISV, 30/0, 6/A, 18/B
*T,       60/ CHARGE NUMBER
*T,       60/ PROJECT NUMBER
*T,       60/ PROJECT NUMBER
*T,       60/ ACCOUNT FILE MESSAGE
*T,       60/ ACCOUNT FILE MESSAGE
*T,       60/ ACCOUNT FILE MESSAGE
*T,       60/ ACCOUNT FILE MESSAGE
*T,       60/ ACCOUNT FILE MESSAGE
*         WHERE
*         M1, M2, M3, M4, AD ARE SRU MULTIPLIERS.
*         ISV = INDEX OF SRU VALIDATION LIMIT.
*         A = 0, IF PROJECT IS FIRST ENTRY IN LEVEL-3 BLOCK.
*           .NE. 0, IF PROJECT IS SECOND ENTRY IN LEVEL-3 BLOCK.
*         B = PROFILE FILE LEVEL-3 BLOCK RANDOM ADDRESS.
*
*         EXIT   ACCOUNT BLOCK BEGUN OR CHANGED.
*                ACCUMULATORS DISPLAYED IN USERS DAYFILE AND ACCOUNT
*                  FILE UNLESS FIRST CHARGE COMMAND.
*                CHARGE-PROJECT MESSAGE DISPLAYED IN ACCOUNT FILE.
*                CHARGE REQUIRED CLEARED.
*                ORIGINAL AND CURRENT SRU VALIDATION LIMIT RESET IF
*                  NECESSARY.
*                DAF USER COUNT OF OLD PROFILE FAMILY IS DECREMENTED.
*                DAF USER COUNT OF NEW PROFILE FAMILY IS INCREMENTED.
 
 
 BAB      ENTRY
          LDD    IR+3        RECALL COUNT
          STD    RC
          LPN    77
          STD    IR+3        CREATE VALID ADDRESS FIELD
          LDN    10D
          STD    T1
          RJM    CKA
          CRM    STMT,T1     GET SRU PARAMS AND CHARGE-PROJECT MESSAGE
 
*         SET VALIDATION PARAMETERS IN CONTROL POINT AREA AND NFL.
 
          NFA    SSJN+ALMS   GET SRU VALIDATION LIMIT
          CRD    CN
          LDD    CN
          SHN    -6
          NJN    BAB1        IF ORIGINAL SRU VALIDATION LIMIT SET
          LDD    CN+2        SET ORIGINAL SRU VALIDATION LIMIT
          LPN    77
          SHN    6
          RAD    CN
 BAB1     LDM    STMT+1*5    SET SRU VALIDATION LIMIT
          SHN    -6
          LMD    CN+2
          LPN    77
          LMD    CN+2
          STD    CN+2
          NFA    SSJN+ALMS
          CWD    CN
          ADK    SSJN-ALMS-CHGN  WRITE CHARGE AND PROJECT NUMBER
          CWM    STMT+2*5,TR
          LDD    CP          READ PROFILE PARAMETERS
          ADN    FPFW
          CRM    L0AU,ON
          ADN    CSPW-FPFW-1 CLEAR CHARGE REQUIRED
          CRD    BA
          LDD    BA
          SCN    4
          STD    BA
          LDD    CP
          ADN    CSPW
          CWD    BA
          LDM    L0AU+2      SAVE PROFILE FNT ORDINAL
          STM    SPPA
          LDM    L0AU        CHECK IF FIRST CHARGE VALIDATED
          SHN    21-13
          MJN    BAB2        IF NOT FIRST CHARGE NUMBER
 
*         BEGIN ACCOUNT BLOCK.
 
          LDD    MA          SET SRU PARAMETERS
          CWM    STMT,ON
          LDN    ABBF
          STD    CM+1        SET *ACTM* SUB-FUNCTION (ABBF)
          MONITOR ACTM       BEGIN ACCOUNT BLOCK
          LDC    2RAB
          STM    STMT+5*5    CHANGE MESSAGE FROM *ACCN* TO *ABCN*
          UJN    BAB3        SET PROFILE PARAMETERS
 
*         UPDATE PROJECT PROFILE FILE.
 
 BAB2     RJM    UPF         UPDATE PROJECT PROFILE FILE
          LDC    STMT        ADDRESS OF NEW MULTIPLIER INDICES
          RJM    IAM         ISSUE ACCOUNTING MESSAGES
          STD    T1
          RJM    CUF         CHECK FOR PROFILE FILE UPDATE FAILURE
 
*         SET PROFILE PARAMETERS AND DISPLAY CHARGE-PROJECT MESSAGE.
 
 BAB3     RJM    SPP         SET PROFILE PARAMETERS
          LDC    ACFN+STMT+5*5
          RJM    DFM         ISSUE MESSAGE TO ACCOUNT FILE
          LJM    CPMX        RETURN
 IAA      SPACE  4,25
***       FUNCTION 77.
*         INITIATE APPLICATION ACCOUNTING.
*
*         ENTRY  (IR+3 - IR+4)  = 24/ADDR
*                WHERE
*                ADDR = PARAMETER BLOCK ADDRESS.
*
*         PARAMETER BLOCK FORMAT -
*
*T,ADDR   24/SC, 36/0
*         WHERE
*         SC = 4-CHARACTER ALPHANUMERIC DISPLAY CODE SOFTWARE
*              CODE.
*
*         EXIT   ACCOUNT DAYFILE MESSAGE ISSUED.
*                APPLICATION ACCOUNTING IN PROCESS BIT SET IN CONTROL
*                POINT AREA WORD.
*
*         USES   BA - BA+4, CM - CM+4.
*
*         CALLS  CKA, DFM.
*
*         MACROS ABORT.
 
 
 IAA      ENTRY
          LDD    CP          READ APPLICATION ACCOUNTING CONTROL WORD
          ADN    FPFW
          CRD    BA
          LDD    BA          CHECK IF PROGRAM VALIDATED FOR FUNCTIONS
          SHN    21-11
          MJN    IAA1        IF APPLICATION ACCOUNTING IN PROCESS
          SHN    11-10
          MJN    IAA2        IF PROGRAM VALIDATED FOR FUNCTION
 IAA1     ABORT  ERAU        * INCORRECT APPLICATION ACCOUNTING CALL.*
 
 IAA2     RJM    CKA         CHECK ADDRESS
          CRD    CM          READ USER PARAMETER WORD
          LDD    CM+2        CHECK CONTENTS OF PARAMETER WORD
          ADD    CM+3
          ADD    CM+4
          NJN    IAA1        IF INCORRECT PARAMETER WORD
          LDD    CM
          STM    IAAA+3      SAVE FOR POSSIBLE MESSAGE
          SHN    -6
          ZJN    IAA1        IF INCORRECT CHARACTER
          SBN    1R9+1
          PJN    IAA1        IF INCORRECT CHARACTER
          LDD    CM
          LPN    77
          ZJN    IAA1        IF INCORRECT CHARACTER
          SBN    1R9+1
          PJN    IAA1        IF INCORRECT CHARACTER
          LDD    CM+1
          STM    IAAA+4      SAVE FOR POSSIBLE MESSAGE
          SHN    -6
 IAA3     ZJN    IAA1        IF INCORRECT CHARACTER
          SBN    1R9+1
 IAA4     PJN    IAA1        IF INCORRECT CHARACTER
          LDD    CM+1
          LPN    77
          ZJN    IAA3        IF INCORRECT CHARACTER
          SBN    1R9+1
          PJN    IAA4        IF INCORRECT CHARACTER
          LDC    ACFN+IAAA   ISSUE ACCOUNT FILE MESSAGE
          RJM    DFM
          LDD    BA          SET ACCOUNTING IN PROCESS
          ADC    1000
          STD    BA
          LDD    CP          REWRITE ACCOUNTING CONTROL WORD
          ADN    FPFW
          CWD    BA
          LJM    CPMX        EXIT
 
 
*         ACCOUNT FILE MESSAGE.
 
 IAAA     DATA   C*UBAU,     .*
 SJB      SPACE  4,20
***       FUNCTION 106.
*         SET JOB CHARACTERISTICS.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF 2 WORD PARAMETER BLOCK.
*T        42/ UJN,18/0
*T,       36/0,12/ OP,12/ DC
*         UJN    USER JOB NAME, 1 TO 7 ALPHANUMERIC OR ASTERISK (*)
*                CHARACTERS, LEFT JUSTIFIED WITH BINARY ZERO FILL.
*                IF UJN = 0, NO CHANGE OF USER JOB NAME.
*         OP     END OF JOB OPTIONS, SPECIFIED BY 2 DISPLAY
*                CODE CHARACTERS.
*                *SU* = SUSPEND JOB (VALID ONLY FOR TXOT JOBS).
*                *TJ* = TERMINATE JOB.
*                0 = NO CHANGE TO END OF JOB OPTION.
*         DC     DISPOSITION OF OUTPUT AT END OF JOB TIME, SPECIFIED
*                BY 2 DISPLAY CODE CHARACTERS.
*                *TO* = QUEUE OUTPUT TO TXOT QUEUE.
*                *NO* = DO NOT QUEUE OUTPUT FILES.
*                *DF* = QUEUE OUTPUT TO JOB DEFAULT QUEUE.
*                0 = NO CHANGE TO OUTPUT DISPOSITION OPTION.
*
*         EXIT   THE JOB IS ROLLED OUT TO WAIT FOR THE DEVICE TO BECOME
*                ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
*                RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
 
 
 SJB      ENTRY
          LDN    2           SET WORD COUNT
          STD    T1
          RJM    CKA         CHECK PARAMETER BLOCK ADDRESS
          CRD    FN
          ADN    1
          CRD    BA
          LDD    CP          GET END OF JOB OPTIONS
          ADK    EOJW
          CRD    CM
          LDD    BA+3        GET END OF JOB OPTION
          ZJN    SJB1        IF NO CHANGE TO END OF JOB OPTION
          LDD    CM
          LPC    777
          STD    CM
          LDD    BA+3
          LMC    2RTJ
          ZJN    SJB1        IF TERMINATE JOB OPTION SELECTED
          ERRNZ  TJJT        CODE DEPENDS ON VALUE
          LMC    2RSU&2RTJ
          NJN    SJB3        IF INCORRECT JOB OPTION CODE
          LDD    OT
          LMK    IAOT
          NJP    SJB8        IF NOT INTERACTIVE JOB
          LDC    SUJT*1000   SET SUSPEND JOB OPTION
          RAD    CM
 SJB1     LDD    BA+4
          ZJN    SJB5        IF NO CHANGE TO OUTPUT DISPOSITION OPTION
          LDN    TODOL
          STD    T1
 SJB2     SOD    T1
          PJN    SJB4        IF NOT END OF TABLE
 SJB3     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 SJB4     LDM    TODO,T1     CHECK FOR MATCH ON DISPOSITION OPTION
          LMD    BA+4
          NJN    SJB2        IF NO MATCH
          LDD    CM          SET NEW QUEUE FILE DISPOSITION
          SHN    0-6+22
          SCN    7
          ADD    T1
          SHN    6-0
          STD    CM
 SJB5     LDD    CP          WRITE END OF JOB OPTIONS
          ADK    EOJW
          CWD    CM
          LDD    FN
          ZJN    SJB7        IF NO USER JOB NAME CHANGE
          RJM    VFN         VERIFY USER JOB NAME
          ZJN    SJB3        IF INCORRECT USER JOB NAME
          RJM    RIS         READ INPUT FILE SYSTEM SECTOR
          STD    FN+4        WRITE USER JOB NAME TO INPUT SYSTEM SECTOR
          LDD    FN+3
          SCN    77
          STD    FN+3
          LDD    MA
          CWD    FN
          CRM    JNSS,ON
          SETMS  IO,RW       UPDATE INPUT FILE SYSTEM SECTOR
          RJM    WSS
          PJN    SJB6        IF NO MASS STORAGE ERRORS ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          UJN    SJB9        EXIT
 
 SJB6     ENDMS
 SJB7     UJN    SJB9        EXIT
 
 SJB8     LDC    =C* INCORRECT END OF JOB OPTION SPECIFIED.*
          RJM    DFM         ISSUE DAYFILE MESSAGE
 SJB9     LJM    CPMX        EXIT
 TODO     SPACE  4,10
**        TODO - TABLE OF OUTPUT DISPOSITION OPTIONS.
*
*         ONE WORD PER ENTRY, INDEXED BY OUTPUT DISPOSITION CODE.
 
 
 .TODOL   MAX    QOJT,NOJT,TTJT
 TODOL    EQU    .TODOL+1    LENGTH OF TABLE
 
 TODO     INDEX
          INDEX  QOJT,2RDF
          INDEX  NOJT,2RNO
          INDEX  TTJT,2RTO
          INDEX  TODOL
 CSV      SPACE  4,35
***       FUNCTION 124.
*         CHANGE SERVICE CLASS.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         PARAMETER BLOCK FORMAT.
*
*T ADDR   48/  0, 6/  ER, 6/  SC
*
*         SC = NEW SERVICE CLASS.
*         ER = ERROR STATUS RETURNED ON A SERVICE CLASS CHANGE.
*            = 0 IF NO ERROR.
*            = 1 IF *SC* IS NOT A DEFINED SERVICE CLASS.
*            = 2 IF SERVICE CLASS INCORRECT FOR THE USER.
*            = 3 IF SERVICE CLASS FULL.
*            = 4 IF MASS STORAGE ERROR ENCOUNTERED.
*
*         EXIT   SERVICE CLASS UPDATED IN EJT ENTRY OF JOB AND
*                IN THE INPUT FILE SYSTEM SECTOR.
*
*                IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
*                READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED OUT
*                TO WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.
*
*         USES   BA, T1, T3, CM - CM+4, CN - CN+4, FN - FN+4.
*
*         CALLS  CJR, CKA, CSC, RIS, VSP, WSS.
*
*         MACROS ENDMS, NFA, SETMS, SFA.
 
 
 CSV      ENTRY              ENTRY/EXIT
 CSV0     LDN    0           SET WORD COUNT
          STD    T1
          RJM    CKA         CHECK ADDRESS
          CRM    STMT,ON     GET PARAMETER WORD
          LDD    CP          CHECK IF SUBSYSTEM OR SSJ= JOB
          ADN    JCIW
          CRD    CM
          ADN    SEPW-JCIW
          CRD    CN
          LDD    CM+2
          NJN    CSV1        IF SUBSYSTEM
          LDD    CN
          LPN    4           SET IF SSJ= JOB
 CSV1     STD    T3
          NFA    SCVN        GET SERVICE CLASS VALIDATION MASK
          CRD    CN
          LDM    STMT+4
          LPN    77
          STD    T7
          RJM    VSP         VALIDATE SERVICE CLASS
 CSV1.1   STD    BA          RETURN ERROR STATUS
          SHN    6
          STD    T3
          LDD    OT
          LMN    IAOT
          ZJN    CSV1.2      IF INTERACTIVE JOB
          LDD    BA
          LMN    3
          NJN    CSV1.2      IF NOT SERVICE CLASS FULL ERROR
          SFA    JCB,T7
          ADK    JCTT
          CRD    FN
          LDC    SCRT/2      SET JOBS WAITING INDICATOR
          STD    FN+1
          SFA    JCB,T7
          ADK    JCTT
          CWD    FN
 CSV1.2   LDM    STMT+4
          LPN    77
          LMD    T3
          STM    STMT+4
          RJM    CKA         GET ADDRESS OF PARAMETER BLOCK
          CWM    STMT,ON     RETURN PARAMETER WORD
          LDD    BA
          ZJN    CSV2        IF NO ERROR
          LJM    CPMX        RETURN
 
 CSV2     SFA    JCB,T7      GET JCB ADDRESS
          STD    CM+4
          SHN    -14
          STD    CM+3
          LDN    2           SET NUMBER OF REQUESTS
          STD    CM+1
          LDD    CN          SET CURRENT JOB COUNT
          STM    CSVA+4
          ADN    1           INCREMENT COUNT
          STM    CSVB+4
          LDD    MA
          CWM    CSVA,CM+1
          MONITOR  UTEM
          LDD    CM+1
          NJP    CSV0        IF FUNCTION NOT COMPLETED
          LDN    1
          STD    T6
          LDM    STMT+4
          LPN    77
          RJM    CSC         CHANGE SERVICE CLASS
          RJM    RIS         READ INPUT FILE SYSTEM SECTOR
          LDD    CP          UPDATE INFORMATION IN SYSTEM SECTOR
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM
          ADK    JSNE
          CRD    CM
          ADK    SCLE-JSNE
          CRD    CN
          LDD    CM          SET JSN
          STM    IOSS
          LDD    CM+1
          STM    IOSS+1
          LDM    IOSS+SCLE*5 SET SERVICE CLASS
          LPN    17
          LMD    CN
          LPN    17
          LMD    CN
          STM    IOSS+SCLE*5
          SETMS  IO,RW
          RJM    WSS         WRITE INPUT FILE SYSTEM SECTOR
          PJN    CSV3        IF NO MASS STORAGE ERROR ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          LDN    4           INDICATE MASS STORAGE ERROR ENCOUNTERED
          LJM    CSV1.1      RETURN ERROR STATUS
 
 CSV3     ENDMS
          LJM    CPMX        RETURN
 
 
 CSVA     VFD    1/1,5/JCTT,6/12D,6/48D,42/0  VERIFY OLD JOB COUNT
 CSVB     VFD    6/JCTT,6/12D,6/48D,42/0      SET NEW JOB COUNT
 GCN      SPACE  4,15
***       FUNCTION 136.
*         GET CHARGE NUMBER INFORMATION.
*
*         ENTRY  (IR+3 - IR+4) =  PARAMETER BLOCK ADDRESS *ADDR*.
*
*         EXIT   CURRENT CHARGE AND PROJECT NUMBER INFORMATION
*                RETURNED TO CALLER.
*
*T ADDR+0 60/CHARGE NUMBER
*T,       60/PROJECT NUMBER
*T,       60/PROJECT NUMBER
*T,       1/V,59/0
*         WHERE
*         V = VALIDATED CHARGE FLAG.
*           = 0 IF CHARGE AND PROJECT NUMBER NOT VALIDATED.
*           = 1 IF CHARGE AND PROJECT NUMBER VALIDATED.
 
 
 GCN      ENTRY
          NFA    CHGN        READ CHARGE AND PROJECT NUMBER
          CRM    STMT,TR
          LDD    CP          READ CHARGE COMMAND PROCESSED FLAG
          ADN    FPFW
          CRD    CN
          LDN    ZERL        SET VALIDATED CHARGE FLAG
          CRD    CM
          LDD    CN
          LPC    4000
          STD    CM
          LDN    3           SET WORD COUNT
          STD    T1
          RJM    CKA         VALIDATE PARAMETER BLOCK ADDRESS
          CWM    STMT,TR     WRITE PARAMETER BLOCK
          CWD    CM
          LJM    CPMX        RETURN
          TITLE  SUBROUTINES.
 CUF      SPACE  4,15
**        CUF - CHECK FOR PROFILE FILE UPDATE FAILURE.
*
*         IF *CPM* COULD NOT MAKE A SUCCESSFUL *0AU* CALL, ANY CONTROL
*         POINT AREA ACCUMULATOR OVERFLOW FLAGS ARE CLEARED (IN
*         ADDITION, IF SRU ACCUMULATOR OVERFLOW, OVERFLOW VALUE
*         MESSAGE ISSUED), AND SRU ACCUMULATOR VALUE MESSAGE ISSUED.
*
*         ENTRY  (CUFA) = *LDN 0*, IF PROFILE FILE UPDATE FAILURE.
*                (T1) = ADDRESS OF *ACSR* ACCOUNT FILE MESSAGE.
*
*         CALLS  DFM.
 
 
 CUF      SUBR               ENTRY/EXIT
          LDN    1
 CUFA     EQU    *-1
*         LDN    0           (PROFILE FILE UPDATE FAILURE)
          NJN    CUFX        IF NO UPDATE FAILURE
          LDN    1RU-1RC     CHANGE MESSAGE PREFIX TO *AUSR*
          RAI    T1
          LDD    T1
          ADC    ACFN
          RJM    DFM         ISSUE MESSAGE TO ACCOUNT FILE
          UJN    CUFX        RETURN
 DAM      SPACE  4,10
**        DAM - DISPLAY ACCOUNT MESSAGES.
*
*         ENTRY  (A) = MESSAGE ADDRESS.
*                (T4) = NUMBER OF MESSAGES 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 QUANITY 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
 IAM      SPACE  4,15
**        IAM - ISSUE ACCOUNT FILE MESSAGES FOR END OF ACCOUNT BLOCK.
*
*         ENTRY  (A) = ADDRESS OF WORD IN PP CONTAINING NEW SRU
*                MULTIPLIERS IF MULTIPLIERS ARE TO BE CHANGED.
*T        12/ M1,12/ M2,12/ M3,12/ M4,12/ AD
*                (A) = 0 IF SRU MULTIPLIERS ARE NOT TO BE CHANGED.
*
*         EXIT   (A) = ADDRESS OF *ACSR* SRU MESSAGE DENOTING END OF
*                ACCOUNT BLOCK.
*
*         USES   TN, T3, T4, T5, CM - CM+4, CN - CN+4.
*
*         CALLS  DAM, PIR, RRR, SCM, SRR, STA.
*
*         MACROS MONITOR, NFA, SFA.
 
 
 IAM      SUBR               ENTRY/EXIT
          ZJN    IAM1        IF NO CHANGE TO SRU MULTIPLIERS
          STM    IAMA
          LDD    MA          MOVE SRU MULTIPLIERS TO MESSAGE BUFFER
          CWM    **,ON
 IAMA     EQU    *-1
          LDN    ABCF&ABCS   SET CHANGE ACCOUNT BLOCK SUBFUNCTION
 IAM1     LMN    ABCS        SET CLEAR SRU ACCUMULATORS SUBFUNCTION
          STD    CM+1
          LDN    AC1WL
          STD    T4
          LDD    CP
          ADK    AC1W
          CRM    IAMU,T4
          LDN    ACTWL
          STD    T4
          LDD    CP          SAVE CPA ACCUMULATORS FOR CONVERSION
          ADN    ACTW
          CRM    IAMC,T4
          MONITOR  ACTM      CHANGE ACCOUNT BLOCK/CLEAR ACCUMULATORS
 
*         CONVERT CPA ACCUMULATORS.
 
          LDD    MA          MOVE CPA ACCUMULATORS TO CPA
          CWM    IAMC,T4
          LDN    ABVF        SET CONVERT ACCUMULATORS SUBFUNCTION
          STD    CM+1
          MONITOR  ACTM
          LDN    ABNA-1      SET NUMBER OF CONVERTED ACCUMULATORS
          STD    T4
          LDN    ABNA-1+2
          STD    T5
 IAM2     LDC    IAME        SET MESSAGE ADDRESS
          RJM    SCM
          LDM    SCMB
          STD    T3
          LDI    T3
          NJN    IAM3        IF SRU ACCUMULATOR NOT ZERO
          LDD    MA
          CWM    IAMD,ON
          LDN    0
          STD    T4
          UJN    IAM2        STORE DISPLAY ZERO IN SRU MESSAGE
 
 IAM3     LDD    CP          GET JOB EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      GET FWA EJT ENTRY
          CRD    CM
          LDD    CM+4        CHECK JOB CONNECTION STATUS
          SHN    -7
          LPN    17
          LMN    OLCS
          ZJN    IAM4        IF ONLINE INTERACTIVE JOB
          NFA    RC2N        READ CHARACTER COUNTS FROM NFL
          CRD    CM
          UJN    IAM5        SET COUNTS
 
 IAM4     LDD    CP          GET TERMINAL NUMBER
          ADN    TTNW
          CRD    CM
          LDD    CM+1
          STD    TN
          RJM    PIR         PRESET WITH IAF R-REGISTER
          RJM    SRR         SET R-REGISTER TO IAF RA
          RJM    STA         SET TERMINAL TABLE ADDRESS
          ADN    VFST        READ CHARACTER COUNTS FROM TERMINAL TABLE
          CRD    CN
          ADN    VCHT-VFST
          CRD    CM
          RJM    RRR         RESTORE R-REGISTER
          LDD    CN+2
          STD    CM+2
 IAM5     LDD    CM+4        SET OUTPUT COUNT
          STM    IAMN+7
          LDD    CM+3        SET INPUT COUNT
          STM    IAMM+7
          ADD    CM+4        SET COMBINED COUNT
          STM    IAML+7
          SHN    -14
          ADD    CM+2
          STM    IAML+6
          LDD    MA          SET COUNTS FOR CONVERSION
          CWM    IAML+3,ON
          CWM    IAMM+3,ON
          CWM    IAMN+3,ON
          LDN    RCIS+3      SET F10.3 FORMAT AND REQUEST COUNT
          STD    CM+1
          LDN    0           CLEAR SRU FLAG
          STD    CM+2
          MONITOR  RDCM      CONVERT ACCUMULATORS
          LDD    MA
          CRM    IAML+3,ON   READ CONVERSIONS TO MESSAGES
          CRM    IAMM+3,ON
          CRM    IAMN+3,ON
          LDN    AC1WL
          STD    T4
          LDD    MA
          CWM    IAMU,T4
          LDN    ABOF
          STD    CM+1
          MONITOR  ACTM      CONVERT OTHER ACCUMULATORS
          LDN    ABNB-1
          STD    T4
          LDC    IAMO        SET MESSAGE ADDRESS
          RJM    SCM         STORE CONVERTED MESSAGES
 
*         ISSUE END OF ACCOUNT BLOCK MESSAGES TO USER
*         DAYFILE AND ACCOUNT FILE.
 
          LDN    ABNB-1
          STD    T4
          LDC    IAMO
          RJM    DAM         DISPLAY ACCOUNTING MESSAGES
          LDN    ABNA+3-1
          STD    T4
          LDC    IAME
          RJM    DAM         DISPLAY ACCOUNTING MESSAGES
          LDM    IAME+ABSR   RETURN ADDRESS OF SRU MESSAGE
          LJM    IAMX        RETURN
 
 
 IAMC     BSS    ACTWL*5     BUFFER FOR CPA ACCUMULATOR WORDS
 
 IAMD     DATA   C*     0.000*  DISPLAY ZERO
 
*         THE MESSAGE ADDRESSES IN THE FOLLOWING TABLE AND THE
*         ACCUMULATORS RETURNED BY *ACTM* SUBFUNCTION *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 TO INDICATE END OF ACCOUNT BLOCK.
 
 IAME     INDEX
          INDEX  ABSR,IAMF   SRUS
          ERRNZ  ABSR        SRUS MUST BE DISPLAYED LAST
          INDEX  ABCP,IAMG   CPU TIME
          INDEX  ABMS,IAMH   MASS STORAGE ACTIVITY
          INDEX  ABMT,IAMI   MAGNETIC TAPE ACTIVITY
          INDEX  ABPF,IAMJ   PERMANENT FILE ACTIVITY
          INDEX  ABAD,IAMK   SRU ADDER
          INDEX  ABNA+0,IAML TOTAL CHARACTERS
          INDEX  ABNA+1,IAMM CHARACTERS IN
          INDEX  ABNA+2,IAMN CHARACTERS OUT
          INDEX  ABNA+3
 
 IAMF     DATA   C*ACSR, 000000.000UNTS.*
 IAMG     DATA   C*UDCP, 000000.000SECS.*
 IAMH     DATA   C*UDMS, 000000.000KUNS.*
 IAMI     DATA   C*UDMT, 000000.000KUNS.*
 IAMJ     DATA   C*UDPF, 000000.000KUNS.*
 IAMK     DATA   C*UDAD, 000000.000KUNS.*
 IAML     DATA   6HUDCT, ,0,0,0,0,0,6HKCHS. ,0
 IAMM     DATA   6HUDCI, ,0,0,0,0,0,6HKCHS. ,0
 IAMN     DATA   6HUDCO, ,0,0,0,0,0,6HKCHS. ,0
 
 IAMO     INDEX
          INDEX  ABMP,IAMP   MAP
          INDEX  ABAC,IAMQ   AUC ACTIVITY
          INDEX  ABOD,IAMR   OPTICAL DISK ACTIVITY
          INDEX  ABNB
 
 IAMP     DATA   C*UDMP, 000000.000KUNS.*
 IAMQ     DATA   C*UDAC, 000000.000UNTS.*
 IAMR     DATA   C*UDOD, 000000.000KUNS.*
 
 IAMU     BSS    AC1WL*5     BUFFER FOR CPA ACCUMULATOR WORDS
 RIS      SPACE  4,20
**        RIS - READ INPUT FILE SYSTEM SECTOR.
*
*         EXIT   (A) = 0.
*                (BFMS) = INPUT FILE SYSTEM SECTOR.
*                (FA) = 0.
*
*                IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
*                READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED OUT
*                TO WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.
*
*         ERROR  TO *ERR* IF SYSTEM SECTOR ERROR OTHER THAN READ.
*
*         USES   T5 - T5+4.
*
*         CALLS  CJR, RSS.
*
*         MACROS ABORT, NFA, SETMS.
 
 
 RIS      SUBR               ENTRY/EXIT
          NFA    FNTN+FSTL   FETCH INPUT FILE FST
          CRD    T5
          SETMS  IO
          LDN    0           SET NO FILE NAME VERIFY
          RJM    RSS         READ SYSTEM SECTOR
          STD    FA
          ZJN    RISX        IF NO ERROR
          PJN    RIS1        IF SYSTEM SECTOR ERROR OTHER THAN READ
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
 RIS1     ABORT  ERSY        * CPM - SYSTEM ERROR.*
 SAL      SPACE  4,10
**        SAL - SET ACCOUNT BLOCK LIMIT.
*
*         ENTRY  (CM+3 - CM+4) = ACCOUNT BLOCK SRU LIMIT TO SET.
*
*         EXIT   *STLW* UPDATED.
*
*         USES   CN - CN+4.
 
 
 SAL      SUBR               ENTRY/EXIT
          LDD    CP          GET CURRENT ACCOUNT BLOCK SRU LIMIT
          ADN    STLW
          CRD    CN
          LDD    CN+1
          LPN    77
          STD    CN+1
          LDD    CM+3
          SHN    14
          LMD    CM+4
          SHN    14
          STD    CN
          SHN    -6
          SCN    77
          RAD    CN+1
          LDD    CP          STORE NEW LIMIT
          ADN    STLW
          CWD    CN
          UJN    SALX        RETURN
 SCM      SPACE  4,10
**        SCM - STORE CONVERSIONS IN MESSAGE.
*
*         ENTRY  (T4) = MESSAGE COUNT.
*                (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
 SPP      SPACE  4,10
**        SPP - SET PROFILE PARAMETERS.
*
*         CONTROL POINT AREA *FPFW* WORD IS UPDATED.
*
*         EXIT   TO *ERR1*, IF SYSTEM ERROR.
*
*         USES   T1 - T7, CM - CM+4, CN - CN+4, RI - RI+1.
*
*         CALLS  CRA, DFM, FAT, SLI, SRU.
*
*         MACROS ABORT, MONITOR, SFA.
 
 
 SPP      SUBR               ENTRY/EXIT
          LDD    MA          PROFILE FILE NAME
          CWM    SPPC,ON
          SBN    1
          CRD    CM
          LDD    CP          FAMILY NAME
          ADN    PFCW
          CRD    T1
          SFA    EST,T4
          ADK    EQDE
          CRD    CN
          LDD    CN+4
          SHN    3
          ADN    PFGL
          CRD    CN
          RJM    FAT         SEARCH FOR FAST-ATTACH FILE
          ZJN    SPP2        IF PROFILE FILE FOUND
 SPP1     ABORT  EREF+ERLN   *ERROR ON FILE - "PPFN".*
 
 SPP2     LDD    T1          SET SYSTEM FNT ORDINAL OF *PROFILE* FILE
          STD    CN+2
          SFA    FNT
          ADN    FSTG
          CRD    T5
          LDM    STMT+10     RANDOM ADDRESS
          LPN    77
          STD    RI
          SHN    14
          LMM    STMT+11
          STD    RI+1
          ZJN    SPP3        IF NO RANDOM ADDRESS
          RJM    CRA         CONVERT RANDOM ADDRESS
          MJN    SPP1        IF INCORRECT RANDOM ADDRESS
          LDD    T7          SET SECTOR
          STD    CN+4
          LDD    T6          TRACK
 SPP3     STD    CN+3
          LDM    STMT+10
          SCN    77
          ZJN    SPP4        IF FIRST ENTRY IN LEVEL-3 BLOCK
          LDN    1
 SPP4     ADN    2           SET NOT FIRST CHARGE BIT
          SHN    12
          STD    CN
          LDC    **          CHECK FOR PROFILE FILE SWITCH
 SPPA     EQU    *-1         (PROFILE FNT ORDINAL)
          ZJN    SPP5        IF NO OLD *CHARGE* COMMAND
          LMD    CN+2
          ZJN    SPP6        IF SAME FAMILY
          LMD    CN+2
          SFA    FNT
          ADN    FSTG
          CRD    CM
          LDD    CM          SET OLD FAMILY EST ORDINAL
          STM    SPPB
 SPP5     LDD    T5          INCREMENT DAF COUNT FOR NEW FAMILY
          STD    CM+1
          LDN    IUCS
          STD    CM+3
          MONITOR  SMDM
 SPP6     LDD    CP
          ADN    FPFW
          CWD    CN
          LDC    0
 SPPB     EQU    *-1
          ZJN    SPP7        IF NOT DECREMENTING OLD FAMILY DAF COUNT
          STD    CM+1
          LDN    DUCS        DECREMENT DAF COUNT FOR OLD FAMILY
          STD    CM+3
          MONITOR  SMDM
 SPP7     LDM    STMT+5      CONVERT VALIDATION INDEX
          SHN    -6
          RJM    SLI
          RJM    SRU         SET VALIDATION LIMITS
          LJM    SPPX
 
 SPPC     VFD    42/0L"PPFN" PROFILE FILE NAME
 UPF      SPACE  4,25
**        UPF - UPDATE PROJECT PROFILE FILE USING OVERLAY *0AU*.
*
*         ENTRY  (OVL0 - OVL0+4) = CONTROL POINT AREA *FPFW* WORD.
*                (RC, BITS 6-11) = RECALL COUNT.
*
*         EXIT   TO CALLING ROUTINE, IF ONE OF THE FOLLOWING-
*                         1) SUCCESSFUL *0AU* CALL.
*                         2) PROFILE FILE UPDATE FAILURE AND MAXIMUM
*                            RECALL COUNT REACHED.
*                            ALSO, (CUFA) = *LDN 0*.
*                         3) ERROR DETECTED BY *0AU*.
*                TO CPMX, IF PROFILE FILE INTERLOCKED IN ROLLABLE MODIFY
*                         MODE AND MAXIMUM RECALL COUNT NOT REACHED.
*                         RECALL COUNT IS INCREMENTED AND ANOTHER
*                         SYSTEM REQUEST ISSUED.
*                IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
*                READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED OUT
*                TO WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.
*
*
*         USES   CM - CM+4.
*
*         CALLS  CJR, DFM, *0AU*.
*
*         MACROS EXECUTE, MONITOR, SFA.
 
 
 UPF      SUBR               ENTRY/EXIT
          LDD    CP          GET JOB EJT ORDINAL
          ADN    TFSW
          CRD    CM
          SFA    EJT,CM      GET JSN
          ERRNZ  JSNE        CHECK IF WORD 0 OF EJT ENTRY
          CRM    AUPB,ON
          ADN    SCLE-JSNE-1 GET JOB SERVICE CLASS
          CRM    AUPB+4,ON
          LDD    CP          GET SRU ACCUMULATOR
          ADN    SRUW
          CRM    AUPB+5,ON
          LDC    AUPB
          STM    L0AU+1
          EXECUTE 0AU,L0AU+5
          PJN    UPF0        IF NO MASS STORAGE ERROR ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          LJM    UPF2        SET UPDATE FAILURE FLAG
 
 UPF0     SBN    2
          NJP    UPFX        IF NOT ROLLABLE MODIFY INTERLOCK
          LDD    RC          INCREMENT AND CHECK RECALL COUNT
          ADD    HN
          STD    IR+3
          SHN    -6
          LMN    MRCL+1
          ZJN    UPF1        IF MAXIMUM RECALL COUNT REACHED
          LDN    ZERL        ENTER DEFAULT TIMED RECALL
          CRD    CM
          LDN    PIRR        SET PF INTERLOCK REJECT REASON
          STD    CM
          LDD    MA          ENTER PP CALL INTO RECALL STACK
          CWD    IR
          ADN    1           STORE RECALL STACK REASON CODE
          CWD    CM
          MONITOR  RECM
          LJM    PPR         EXIT TO PP RESIDENT
 
 UPF1     STM    L0AU+3      CLEAR PROFILE FILE PRESENT
          EXECUTE 0AU,L0AU+5
          PJN    UPF1.1      IF NO MASS STORAGE ERROR ENCOUNTERED
          RJM    CJR         CHECK IF THE JOB IS ROLLABLE
          UJN    UPF2        SET UPDATE FAILURE FLAG
 
 UPF1.1   LDM    L0AU+4
          SHN    21-0
          PJN    UPF2        IF NOT SRU ACCUMULATOR OVERFLOW
          LDC    ACFN+UPFA   SRU OVERFLOW MESSAGE
          RJM    DFM
 UPF2     SOM    CUFA        SET UPDATE FAILURE FLAG
          LJM    UPFX        EXIT
 
 
 UPFA     DATA   C*AUSR, 219902.325UNTS.*
          SPACE  4,10
**        COMMON DECKS.
 
 
          QUAL
 AST$     SET    1           ASSEMBLE *SSCT/SSAT* UPDATE CODE
*CALL     COMPAST
          QUAL   *
*CALL     COMPCRA
*CALL     COMPCSC
*CALL     COMPFAT
          QUAL
*CALL COMPSTA
          QUAL   *
 QUAL$    EQU    1           SET TO NOT QUALIFY COMMON DECKS
 PIR$     EQU    1           SELECT ASSEMBLY OF *PIR* FOR IAF R-REG
*CALL     COMPSRR
*CALL     COMPSRU
 VFN$     EQU    1           ALLOW ASTERISK (*) IN FILE NAME
*CALL     COMPVFN
 CJL$     EQU    1           CHECK SERVICE CLASS AT JOB LIMIT
 CUV$     EQU    1           CHECK USER VALIDATED FOR SERVICE CLASS
*CALL     COMPVSP
*CALL     COMPWSS
          SPACE  4,10
          USE    LITERALS
          SPACE  4,10
**        BUFFER DEFINITIONS.
 
 
 STMT     EQU    *           COMMAND BUFFER
 AUPB     EQU    STMT+10D*5  *0AU* PARAMETER BLOCK
 L0AU     EQU    AUPB+2*5    LOAD ADDRESS FOR *0AU*
          ERRNG  EPFW-L0AU-ZAUL  CHECK LENGTH OF *0AU*
          SPACE  4,10
          OVERFLOW OVL
          OVERLAY (LOADER/MISCELLANEOUS FUNCTIONS.)
 SEE      SPACE  4,10
**        FUNCTION 4.
*         SET ERROR EXIT ADDRESS = PARAMETER.
*
*         ENTRY  (IR+3 - IR+4) = ERROR EXIT ADDRESS.
*
*         EXIT   (EECW) UPDATED TO NEW ERROR EXIT ADDRESS.
*                *OVERRIDE* REQUIRED FLAG CLEARED IN (SNSW).
 
 
 SEE      ENTRY
          RJM    CKA         CHECK ERROR EXIT ADDRESS WITHIN FL
          LDD    CP          READ (SNSW) AND (EECW)
          ADN    SNSW
          CRD    CN
          ADN    EECW-SNSW
          CRD    CM
          LDD    CM          CHECK EXTENDED RPV SET
          SHN    21-12
          PJN    SEE1        IF EXTENDED RPV NOT SET
          ABORT  ERIR        * CPM - INCORRECT REQUEST.*
 
 SEE1     LDN    0           CLEAR REPRIEVE OPTION
          STD    CM+1
          LDD    CM+3        SET ERROR EXIT ADDRESS
          LMD    IR+3
          SCN    77
          LMD    IR+3
          STD    CM+3
          LDD    IR+4
          STD    CM+4
          LDD    CN          CLEAR *OVERRIDE* REQUIRED BIT
          LPC    6777
          STD    CN
          LDD    CP
          ADN    SNSW
          CWD    CN
          ADN    EECW-SNSW
          CWD    CM
          LJM    CPMX        EXIT
 GLS      SPACE  4,15
***       FUNCTION 46.
*         GET GLOBAL LIBRARY SET.
*
*         GET THE LIST OF LIBRARY NAMES FROM THE GLOBAL
*         LIBRARY SET INDICATORS IN *LB1W* THRU *LB3W*.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T ADDR   6/ ,18/ LIST ,36/0
*         LIST   RETURN ADDRESS FOR LIBRARY NAMES.
*
*         EXIT   RETURNS GLOBAL LIBRARY SET NAMES, LEFT JUSTIFIED,
*                ZERO FILLED, STARTING AT *LIST* ADDRESS.
*                EXITS TO LSR.
 
 
 GLS      ENTRY
          RJM    CKA         READ PARAMETER WORD
          CRD    BA
          LDD    CP          READ GLOBAL LIBRARY SET
          ADC    LB1W
          CRM    TLBD,TR
          LDK    LBDP        READ LBD POINTER
          CRD    T0
          LDN    0
          STD    T1          CLEAR *TLBD* INDEX
          STD    T5          SET BYTE INDICATOR TO UPPER 6 BITS
          UJN    GLS2        ENTER LOOP
 
 GLS1     AOD    T5          ADVANCE *TLBD* INDEX
          SHN    -1
          STD    T1
 GLSA     LMN    TLBDL-3     CHECK FOR END OF *TLBD*
*         LMN    TLBDL-3-5   IF 1 USER LIBRARY
*         LMN    TLDBL-3-5-5 IF 2 USER LIBRARIES
          ZJN    GLS3        IF END OF LIBRARY INDICATORS
          LDM    GLSB        SET UP SHN INSTRUCTION
          LMN    71
          STM    GLSB
 GLS2     LDM    TLBD+3,T1   GET LIBRARY INDEX
 GLSB     SHN    -6
*         SHN    0           IF LIBRARY INDEX IN LOWER 6 BITS OF BYTE
          LPN    77
 GLS3     ZJN    LSR         IF END OF LIBRARY INDICATORS
          SBN    77
          ZJN    GLS5        IF LOCAL USER LIBRARY INDICATOR
          ADN    76          RESET INDICATOR MINUS 1
          SHN    1           READ LIBRARY FROM LBD
          ADD    T3
          SHN    6
          ADD    T2
          SHN    14
 GLS4     CRD    FN
          RJM    RLN         RETURN LIBRARY NAME
          UJN    GLS1        LOOP FOR NEXT INDICATOR
 
*         PROCESS LOCAL USER LIBRARY.
 
 GLS5     SOM    GLSC
          LCN    5           UPDATE END CHECK FOR *TLBD*
          RAM    GLSA
          LDD    CP          READ USER LIBRARY NAME
          ADC    LB3W+1
 GLSC     EQU    *-1
*         ADC    LB3W        IF FIRST USER LIBRARY
*         ADC    LB2W        IF SECOND USER LIBRARY
          UJN    GLS4        RETURN LIBRARY NAME
 LSR      SPACE  4,10
**        LSR - LIBRARY SET RETURN.
*
*         ENTRY  LIBRARY FUNCTION COMPLETED.
*
*         EXIT   PARAMETER WORD RETURNED.
 
 
 LSR      LDD    IR+3        RETURN PARAMETER WORD
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          CWD    BA
          LJM    CPMX        EXIT
 SLS      SPACE  4,35
***       FUNCTION 47.
*         SET GLOBAL LIBRARY SET.
*
*         SET THE GLOBAL LIBRARY SET INDICATORS FROM A LIST
*         OF LIBRARY NAMES.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T  ADDR  6/ 0,18/  LIST ,36/ 0
*         LIST   FWA OF LIBRARY NAMES.
*
*T LIST      42/LIBRARY NAME 1,18/
*T LIST+1    42/LIBRARY NAME 2,18/
*         . . .
*T LIST+N-1  42/LIBRARY NAME N,18/
*T LIST+N    60/0
*
*         EXIT   TO *LSR*.
*                (LIST) ADVANCED TO END OF TABLE + 1.
*
*LB1W     36/NOT CHANGED , 24/GLI
*LB2W     60/ULN
*LB3W     60/ULN
*                GLI = GLOBAL LIBRARY SET INDICATORS (6-BIT FIELDS) -
*                      00    END OF LIBRARY SET.
*                      01-76 ORDINAL OF SYSTEM LIBRARY.
*                      77    USER LIBRARY.  LOGICAL FILE NAME OF FIRST
*                            USER LIBRARY IN *LB3W*, LOGICAL FILE NAME
*                            OF SECOND USER LIBRARY IN *LB2W*.
*                ULN = EITHER LOGICAL FILE NAME OF SECOND (*LB2W*) OR
*                      FIRST (*LB3W*) USER LIBRARY, OR A COLLECTION OF
*                      6-BIT GLOBAL LIBRARY SET INDICATORS.
*
*         ERROR  (LIST) = ADDRESS OF TABLE ENTRY WHERE ERROR WAS
*                         FOUND.
 
 
 SLS      ENTRY
          RJM    CKA         READ PARAMETER WORD
          CRD    BA
          LDD    CP          READ FIRST LIBRARY CONTROL WORD
          ADC    LB1W
          CRM    TLBD,ON
          LDN    2           MAXIMUM NUMBER OF LOCAL USER LIBRARIES
          STD    T7
          LDN    3           NUMBER OF LIBRARY WORDS TO WRITE
          STD    T3
          LDN    0           CLEAR COUNTER NUMBER OF GLOBAL LIBRARIES
          STD    T6
          LDN    ZERL        CLEAR GLOBAL LIBRARIES
          CRM    TLBD+3,ON
          LDN    ZERL
          CRM    TLBD+3+5,ON
          LDN    ZERL
          CRM    TLBD+3+12,ON
          LDN    24D         MAXIMUM NUMBER OF GLOBAL LIBRARIES
          STD    T5
 SLS1     RJM    RLW         READ LIBRARY WORD
          NJN    SLS5        IF NAME FOUND
          LDD    CP          UPDATE GLOBAL LIBRARY SET
          ADC    LB1W
          CWM    TLBD,T3
          SOD    T3
          ZJN    SLS2        IF TWO USER LIBRARIES
          SOD    T3
          NJN    SLS3        IF NO USER LIBRARIES
          LDD    CP          STORE ONE USER LIBRARY NAME
          ADC    LB3W
          CWM    LB2T+5,ON
          UJN    SLS3        RETURN
 
 SLS2     LDN    2           STORE TWO USER LIBRARY NAMES
          STD    T5
          LDD    CP
          ADC    LB2W
          CWM    LB2T,T5
 SLS3     LJM    LSR         RETURN
 
*         ERROR EXIT, DECREMENT INDEX TO INDICATE BAD LIBRARY NAME.
 
 SLS4     SOD    BA+1
          PJN    SLS3        IF NO UNDERFLOW
          AOD    BA+1        CORRECT UNDERFLOW CONDITION
          SOD    BA
          UJN    SLS3        RETURN
 
 SLS5     SOD    T5
          MJN    SLS4        IF TOO MANY SYSTEM LIBRARIES
          RJM    LBD         SEARCH FOR MATCH IN LBD
          NJP    SLS7        IF MATCH FOUND
          SOD    T7
          MJN    SLS4        IF TOO MANY LOCAL USER LIBRARIES
          RJM    SAF         CHECK LOCAL FILE PRESENT
          NJN    SLS5.1      IF FILE FOUND
          STM    SLSD,T4     CLEAR ASSEMBLY AREA START
          LDD    T4
          ADC    SLSD        SET ASSEMBLY ADDRESS
          STD    T1
          LDN    FN          ADD FILE NAME
          RJM    ACS
          LDC    SLSE        ADD PERIOD
          RJM    ACS
          LDD    T8
          ADC    SLSC+CPON   ISSUE MESSAGE TO CALLER
          RJM    DFM
          LJM    SLS1        CHECK NEXT ENTRY
 
*         PROCESS LOCAL USER LIBRARY ENTRY.
 
 SLS5.1   LCN    10D         UPDATE MAXIMUM LIBRARIES ALLOWED
          RAD    T5
          MJP    SLS4        IF TOO MANY LIBRARIES
          LDN    4
          STD    T1
 SLS6     LDM    FN,T1
          STM    LB2T+5,T1   SAVE *LB3W* WORD
 SLSA     EQU    *-1
*         STM    LB2T,T1     (*LB2W*)
          SOD    T1
          PJN    SLS6        IF NOT 5 BYTES TRANSFERRED
          LCN    5
          RAM    SLSA
          LDN    77          USER LIBRARY INDICATOR
          STD    T4
          SOD    T3
 
*         PROCESS SYSTEM USER LIBRARY.
 
 SLS7     LDD    T6          SET UP INDEX IN *TLBD*
          SHN    -1
          STD    T1
          AOD    T6
          LDD    T4          ENTER GLOBAL LIBRARY SET INDICATOR
 SLSB     SHN    6
*         SHN    0           IF IN BITS 0-5 OF BYTE
          RAM    TLBD+3,T1
          LDM    SLSB        SET UP SHN INSTRUCTION
          LMN    6
          STM    SLSB
          LJM    SLS1        LOOP TO END OF LIBRARY SET
 
 
 SLSC     DATA   H* CPM - LIBRARY NOT FOUND = *
 SLSD     BSS    5           SPACE FOR NAME
 SLSE     DATA   C*.*
 SLSF     DATA   H* CPM - LIBRARY INACCESSIBLE = *
 SLSG     BSS    7           SPACE FOR NAME, PERIOD
 SPB      SPACE  4,10
***       FUNCTION 100.
*         SET/CLEAR PAUSE BIT.
*
*         ENTRY  (IR+4) = 0, IF TO SET BIT.
*                       = 1, IF TO CLEAR BIT.
*
*         USES   CM - CM+4.
*
*         CALLS  CUA.
*
*         MACROS ABORT.
 
 
 SPB      ENTRY
          LDD    EP          CHECK FOR *SSJ=* ENTRY POINT
          SHN    21-2
          MJN    SPB1        IF *SSJ=* PROGRAM
          RJM    CUA         CHECK FOR *SYOT* OR *CSOJ*/*DEBUG*
          ZJN    SPB1        IF ACCESS ALLOWED
          RJM    VPA         VERIFY PRIVILEGED ANALYST
          ZJN    SPB1        IF ACCESS ALLOWED
          ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
 
 SPB1     LDD    IR+4
          SBN    2
          MJN    SPB2        IF LEGAL SUBFUNCTION
          ABORT  ERIR        *CPM - INCORRECT REQUEST.*
 
 SPB2     LDD    CP          READ PAUSE WORD
          ADN    SNSW
          CRD    CM
          LDD    CM+3        SET/CLEAR PAUSE BIT
          SCN    1
          LMN    1
          LMD    IR+4
          STD    CM+3
          LDD    CP
          ADN    SNSW
          CWD    CM
          LJM    CPMX        EXIT
 SPS      SPACE  4,15
***       FUNCTION 101.
*         RETURN SYSTEM ORIGIN PRIVILEGES STATUS.
*
*         ENTRY  (IR+3 - IR+4) = STATUS RETURN ADDRESS.
*
*         EXIT   IF STATUS RETURN ADDRESS SPECIFIED -
*                (ADDR) = 48/0, 12/STATUS
*                WHERE STATUS = 0 IF USER HAS PRIVILEGES.
*                             .NE. 0 IF USER DOES NOT HAVE PRIVILEGES.
*
*                IF STATUS RETURN ADDRESS NOT SPECIFIED -
*                  TO *CPMX* IF USER HAS PRIVILEGES.
*                  ABORT, IF USER DOES NOT HAVE PRIVILEGES.
 
 
 SPS      ENTRY
          LDN    ZERL        CLEAR REPLY
          CRD    CN
          RJM    CUA         CHECK USER ACCESS
          STD    CN+4        SAVE STATUS
          LDD    IR+3
          LPN    37
          SHN    14
          LMD    IR+4
          ZJN    SPS2        IF NO ADDRESS SPECIFIED
          RJM    CKA         CHECK ADDRESS
          CWD    CN          RETURN STATUS
 SPS1     LJM    CPMX        EXIT
 
 SPS2     LDD    CN+4
          ZJN    SPS1        IF USER HAS PRIVILEGES
          ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
 GPG      SPACE  4,25
***       FUNCTION 127.
*         GET PAGESIZE INFORMATION.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF 2 WORD BLOCK.
*
*         EXIT   PARAMETER BLOCK RETURNED AS FOLLOWS.
*
*T,ADDR   28/RES,4/JPD,8/JPL,8/JPW,11/RES,1/C
*T        28/RES,4/SPD,8/SPL,8/SPW,12/RES
*
*         JPD    JOB PRINT DENSITY (6 OR 8)
*         JPL    JOB PAGE LENGTH
*         JPW    JOB PAGE WIDTH
*         C      COMPLETE BIT
*         SPD    SYSTEM PRINT DENSITY
*         SPL    SYSTEM PAGE LENGTH
*         SPW    SYSTEM PAGE WIDTH
*         RES    RESERVED FIELD
 
 
 GPG      ENTRY
          NFA    JPPN        GET JOB PAGE PARAMETERS
          CRD    T3
          LDD    T7
          SCN    1
          ADN    1           SET COMPLETION BIT
          STD    T7
          LDN    IPPL        GET SYSTEM PAGE PARAMETERS
          CRD    CM
          LDN    0
          STD    CM          CLEAR UNRELATED BYTES
          STD    CM+1
          LDN    2           NUMBER OF WORDS TO TRANSFER
          STD    T1
          RJM    CKA         COPY PAGE PARAMETERS
          CWM    T3,T1
          LJM    CPMX        RETURN
 SPG      SPACE  4,25
***       FUNCTION 130.
*         SET PAGESIZE INFORMATION.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF PARAMETER BLOCK.
*
*T,ADDR   28/RES,4/JPD,8/JPL,8/JPW,11/RES,1/C
*
*         JPD    JOB PRINT DENSITY (6 OR 8)
*         JPL    JOB PAGE LENGTH
*         JPW    JOB PAGE WIDTH
*         C      COMPLETE BIT
*         RES    RESERVED FIELD
*
*         EXIT   PAGE SIZE PARAMETERS SET IN NFL.
 
 SPG      ENTRY
          LDN    1           READ USER DEFINITIONS ONLY
          STD    T1
          RJM    CKA
          CRD    CM          READ PAGE SIZE PARAMETERS
          LDD    CM+4
          SCN    1
          ADN    1           SET COMPLETE BIT
          STD    CM+4
          RJM    CKA
          CWD    CM          SET COMPLETE BIT IN PARAMETER WORD
 
*         VALIDATE PARAMETERS.
 
          NFA    JPPN
          CRD    CN
          LDD    CN+2        CLEAR PAGE PARAMETERS
          LPC    -377
          STD    CN+2
          LDD    CM+2        CHECK PRINT DENSITY
          LPC    377
          RAD    CN+2
          SHN    -4
          LPN    17          CHECK REMAINDER OF BYTE FOR *PD* ONLY
          LMN    6
          ZJN    SPG2        IF *PD* IS 6 LPI
          LMN    6&10
          ZJN    SPG2        IF *PD* IS 8 LPI
 
 SPG1     ABORT  ERPV        * CPM - INCORRECT PAGE VALUES.*
 
 SPG2     LDD    CM+3        CHECK *PW*
          STD    CN+3
          LPC    377
          SBN    /BIO/PWLL
          MJN    SPG1        IF BELOW LOWER LIMIT OF *PW*
          LDD    CM+2
          LPN    17          UPPER PORTION OF *PS*
          SHN    14
          LMD    CM+3
          SHN    -10
          SBN    /BIO/PSLL
          MJN    SPG1        IF BELOW LOWER LIMIT OF *PS*
          NFA    JPPN        STORE JOB PAGE PARAMETERS
          CWD    CN
          LJM    CPMX        RETURN
 SOD      SPACE  4,10
***       FUNCTION 112.
*         SET OPERATOR DISPLAY DATA.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF BUFFER CONTAINING
*                                DISPLAY DATA.
*
*         EXIT   TO *CPMX* IF FUNCTION ALLOWED AND COMPLETED.
*                TO *RCL* IF *CPM* RECALLED.
*
*         ERROR  TO *ABORT* IF USER NOT VALIDATED FOR FUNCTION.
 
 
 SOD      ENTRY
          RJM    CUA         CHECK USER ACCESS
          ZJN    SOD1        IF SYSTEM ORIGIN PRIVILEGES
          LDD    CM
          ZJN    SOD1        IF *CMNT* ACCESS
          LDD    CP
          ADK    AACW
          CRD    CM
          LDD    CM+4
          SHN    21-4
          MJN    SOD1        IF *CSOJ* PRIVILEGES
          ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
 
 SOD1     LDC    LDSP        SET BUFFER ADDRESS
          CRD    CM+1
          LDD    CM+3
          SHN    14
          LMD    CM+4
          SBN    LODS
          STD    CM+4
          STM    SODA+1
          STM    SODB+1
          SHN    -14
          STD    CM+3
          RAM    SODA
          STM    SODB
          LDN    0
          STD    CM+2
          STD    CM+1
          LDD    CP          SET JSN
          ADN    TFSW
          CRD    FN
          SFA    EJT,FN
          ERRNZ  JSNE        IF NOT WORD 0 OF EJT ENTRY
          CRD    FN
          MONITOR  UTEM      INTERLOCK OPERATOR DISPLAY BUFFER
          LDD    CM+1
          ZJN    SOD2        IF BUFFER INTERLOCKED
          LJM    RCL         RECALL REQUEST
 
 SOD2     STD    FN+2        SET JSN IN BUFFER
          STD    FN+3
          LDN    1
          STD    FN+4
 SODA     LDC    *
          CWD    FN
          LDN    7           COPY MESSAGE TO BUFFER
          STD    T1
          RJM    CKA
          CRM    BFMS,T1
 SODB     LDC    **
          ADN    1
          CWM    BFMS,T1
          LDD    RA          SET *CFO* FLAG IN RA+0
          SHN    6
          CRD    CM
          LDD    CM+3
          SCN    4
          LMN    4
          STD    CM+3
          LDD    RA
          SHN    6
          CWD    CM
          LDN    1           SET OPERATOR DISPLAY FLAG
          STD    CM+1
          LDC    OPRL
          STD    CM+4
          LDN    0
          STD    CM+2
          STD    CM+3
          LDD    MA
          CWM    SODC,ON
          MONITOR  UTEM
          LJM    CPMX        EXIT
 
 
 SODC     VFD    6/0,6/1,6/59D,42/1  *UTEM* PARAMETER WORD
 SSC      SPACE  4,10
***       FUNCTION 113.
*         SET *SHELL* PROCESSING CONTROLS.
*
*         THIS FUNCTION SETS THE *SHELL* PROCESSING CONTROLS IN
*         THE USER-S NFL AND RETURNS THE PREVIOUS CONTROLS FROM
*         NFL TO THE USER-S PARAMETER WORD.
*
*T,ADDR   42/NAME,6/,1/X,3/,1/E,1/A,1/L,1/G,1/S,1/C,1/O,1/I
*
*                NAME = 1-7 CHARACTER NAME OF SHELL PROGRAM.
*                X    = CURRENTLY EXECUTING UNDER SHELL CONTROL.
*                       (IGNORED FOR SETTING NEW CONTROL INFORMATION)
*                E    = CLEAR CONTROLS ON SHELL LOAD ERROR.
*                A    = CLEAR CONTROLS IF SHELL PROGRAM ABORTS.
*                L    = ALLOW SHELL PROGRAM LOAD FROM LOCAL FILE.
*                G    = ALLOW SHELL PROGRAM LOAD FROM GLOBAL LIBRARY.
*                S    = ALLOW SHELL PROGRAM LOAD FROM SYSTEM LIBRARY.
*                C    = CALL SHELL IF NO MORE COMMANDS (INTERACTIVE).
*                O    = CALL SHELL FOR COMMANDS OUTSIDE PROCEDURES.
*                I    = CALL SHELL FOR COMMANDS INSIDE A PROCEDURE.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF *SHELL* CONTROL.
 
 
 SSC6     ABORT  ERSC        * CPM - MISSING *SHELL* LOAD OPTION.*
 
 SSC7     ABORT  ERSE        * EPILOGUE AND SHELL CONFLICT.*
 
 SSC8     ABORT  ERSF        * CPM - INCORRECT *SHELL* FILE.*
 
 SSC      ENTRY
          RJM    CKA
          CRD    FN
          LDD    FN
          ZJN    SSC3        IF CLEARING CONTROL
 SSC1     LDD    FN+4
          LPN    70
          ZJN    SSC6        IF LOAD OPTION NOT SPECIFIED
          LDD    CP          CHECK PROJECT EPILOGUE REQUIRED
          ADN    CSPW
          CRD    CN
          LDD    CN
          SHN    21-3
          PJN    SSC2        IF PROJECT EPILOGUE NOT REQUIRED
          LDD    FN+4
          SHN    21-6
          PJN    SSC7        IF NO ABORT SHELL REQUESTED
 SSC2     LDD    FN+4
          LPN    40
 SSC3     ZJN    SSC5        IF LOCAL FILE LOAD OPTION NOT SELECTED
          RJM    SAF
 SSC4     ZJN    SSC8        IF FILE NOT FOUND
          NFA    FA,R        CHECK FOR FILE ON MASS STORAGE
          ADN    FSTL
          CRD    CM
          LDD    CM
          SFA    EST
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    0-13
          ZJN    SSC4        IF FILE NOT ON MASS STORAGE
          LDD    FS+4
          SCN    NDST
          LMN    NDST
          STD    FS+4
          LDD    FS+3        SET WRITE LOCKOUT
          SCN    1
          LMN    1
          STD    FS+3
          NFA    FA,R        UPDATE THE FNT ENTRY
          CWD    FS
 SSC5     NFA    SHCN        COPY *SHELL* CONTROL TO NFL
          CRD    CN
          CWD    FN
          RJM    CKA         COPY OLD DATA TO USER
          CWD    CN
          LJM    CPMX        EXIT
 RSC      SPACE  4,20
***       FUNCTION 123.
*         RETURN SERVICE CLASS INFORMATION.
*
*         THIS FUNCTION RETURNS A LIST OF SERVICE CLASSES AND
*         ASSOCIATED PRIORITIES WHICH ARE VALID
*         FOR THE CALLER AND THE SPECIFIED ORIGIN TYPE.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         PARAMETER BLOCK FORMAT.
*
*T ADDR   24/ 0, 12/ OT, 12/ LEN, 11/ STAT, 1/C
*T,ADDR+1 12/ SC, 12/ 0, 12/ IN, 12/ EX, 12/ OUT
*T,       60/         .
*T,       60/         .
*T,       60/         .
*T,ADDR+N 12/ SC, 12/ 0, 12/ IN, 12/ EX, 12/ OUT
*
*         *ADDR* MUST BE SET UP BY THE CALLER.  *CPM* WILL UPDATE
*         *ADDR* AND ALSO RETURN *ADDR+1* TO *ADDR+N*.
*
*         *OT* = ORIGIN TYPE FOR WHICH A LIST OF VALID SERVICE
*                CLASSES IS TO BE RETURNED.  *OT* IS REQUIRED.
*         *LEN* = MAXIMUM NUMBER OF SERVICE CLASSES TO RETURN.
*                *CPM* WILL UPDATE THIS FIELD TO THE ACTUAL NUMBER
*                OF SERVICE CLASSES RETURNED.
*         *STAT* = ERROR STATUS.  THIS MUST BE ZERO ON THE
*                CALL.  VALUES RETURNED BY *CPM* ARE -
*                0 = NO ERROR.
*                1 = INCORRECT LENGTH.  (LENGTH = 0)
*                2 = INCORRECT ORIGIN TYPE.
*                3 = COMPLETE BIT SET.
*         *C* = COMPLETE BIT.  MUST BE ZERO ON CALL.  *CPM* WILL
*                SET TO ONE ON COMPLETION OF PROCESSING.
*         *SC* = TWO CHARACTER DISPLAY CODE SERVICE CLASS MNEMONIC.
*         *IN* = LOWER BOUND PRIORITY FOR INPUT FILES IN THIS
*                SERVICE CLASS.
*         *EX* = UPPER BOUND PRIORITY FOR EXECUTING JOBS IN THIS
*                SERVICE CLASS.
*         *OUT* = LOWER BOUND PRIOTITY FOR OUTPUT FILES IN THIS
*                SERVICE CLASS.
*
*         EXIT   INFORMATION RETURNED TO PARAMETER BLOCK.
*
*         USES   T3, T4, T5, T6, T7, BA - BA+4, CM - CM+4, CN - CN+4,
*                FN - FN+4.
*
*         CALLS  CKA.
*
*         MACROS NFA, SFA.
 
 
 RSC      ENTRY
          LDN    0           GET FIRST WORD OF PARAMETER BLOCK
          STD    T1
          RJM    CKA         CHECK ADDRESS
          CRD    CM
          LDD    CM+4
          SHN    21-0
          PJN    RSC3        IF COMPLETE BIT NOT SET
          LDN    3           SET ERROR STATUS
 RSC1     SHN    1
          ADN    1           SET COMPLETE BIT
          STD    CM+4
          RJM    CKA         UPDATE FIRST WORD OF BLOCK
          CWD    CM
          LJM    CPMX        RETURN
 
 RSC2     LDN    1           INCORRECT BUFFER LENGTH
          UJN    RSC1        SET ERROR STATUS
 
 RSC3     LDD    CM+3        CHECK LENGTH PARAMETER
          ZJN    RSC2        IF NO BUFFER SPACE ALLOCATED
          STD    T1
          STD    T2
          RJM    CKA         CHECK ADDRESS
          LDD    CM+2        CHECK ORIGIN TYPE
          STD    T3
          SBN    PLSC
          MJN    RSC5        IF VALID ORIGIN TYPE
 RSC4     LDN    2
          UJN    RSC1        SET ERROR STATUS
 
 RSC5     LDK    JBCP        GET *SCT* ENTRY
          CRD    CM
          LDD    CM
          SHN    14
          ADD    CM+1
          ADD    T3
          CRD    CN
          LDN    MXJC        SET MAXIMUM NUMBER OF CLASSES TO RETURN
          SBD    T2
          PJN    RSC6        IF LESS THAN MAXIMUM TO BE RETURNED
          LDN    MXJC        RESET NUMBER OF SERVICE CLASSES TO RETURN
          STD    T2
 RSC6     LDN    0
          STD    T3          INITIALIZE SERVICE CLASS INDEX
          STD    T6
          LDN    1
          STD    T4          INITIALIZE BUFFER INDEX
          LDN    2+1         SET BYTE INDEX FOR VALIDATION MASK
          STD    T5
          LCN    12D
 RSC7     ADN    12D         RESET SERVICE CLASS INDEX
          RAD    T6
          STD    T3
          SOD    T5
          MJP    RSC10       IF END OF MASK
          NFA    SCVN        GET VALIDATION MASK
          CRD    CM
          LDM    CN+2,T5     GET BITS FOR VALID SERVICE CLASSES
          STM    RSCA
          LDM    CM+2,T5
          LPC    0
 RSCA     EQU    *-1         (*SCT* VALIDATION BITS)
          STD    CN
 RSC8     LDD    CN
          ZJN    RSC7        IF END OF SERVICE CLASSES
          SHN    21
          STD    CN
          PJN    RSC9        IF SERVICE CLASS NOT ALLOWED
          SFA    JCB,T3      GET PRIORITIES
          ADK    INQT
          CRD    BA
          ADK    EXQT-INQT
          CRD    FN
          ADN    OTQT-EXQT
          CRD    UN
          LDN    ZERL
          CRD    CM
          LDM    TSCM,T3     SET SERVICE CLASS
          STD    CM
          LDD    UN+1        SET OUTPUT FILE PRIORITY
          STD    CM+4
          LDD    FN+2        SET EXECUTING JOB PRIORITY
          STD    CM+3
          LDD    BA+1        SET INPUT FILE PRIORITY
          STD    CM+2
          RJM    CKA         ENTER INTO BUFFER
          ADD    T4
          CWD    CM
          AOD    T4          INCREMENT BUFFER INDEX
          LDD    T2
          SBD    T4
          MJN    RSC10       IF BUFFER FULL
 RSC9     AOD    T3          INCREMENT SERVICE CLASS INDEX
          SBN    MXJC
          MJP    RSC8        IF MORE SERVICE CLASSES TO PROCESS
 
*         COMPLETE PROCESSING.
 
 RSC10    LDN    0           GET FIRST WORD OF BLOCK
          STD    T1
          RJM    CKA
          CRD    CM
          SOD    T4          SET NUMBER OF CLASSES RETURNED
          STD    CM+3
          LDN    1           SET COMPLETE BIT / CLEAR ERROR STATUS
          STD    CM+4
          RJM    CKA
          CWD    CM
          LJM    CPMX        RETURN
 TSCM     SPACE  4
**        TSCM - TABLE OF SERVICE CLASS MNEMONICS.
 
 
 TSCM     INDEX
          LIST   D
 .SCL     HERE
          LIST   *
          INDEX  MXSC
 ERRMSG   SPACE  4,20
***       FUNCTION 135.
*
*         ENABLE/DISABLE TERMINAL ERROR MESSAGES.
*
*         ENABLE OR DISABLE THE ECHOING OF *MS1W*/*MS2W*
*         ERROR MESSAGES TO THE TERMINAL BY *1RO*.  ERROR MESSAGE
*         ECHOING CAN ONLY BE DISABLED FOR THE DURATION OF A
*         *CCL* PROCEDURE.  ERROR MESSAGE PROCESSING REVERTS TO
*         NORMAL AFTER THE *CCL* PROCEDURE IS COMPLETED AND THE
*         USER RETURNS TO INTERACTIVE COMMAND MODE.
*
*         ENTRY  (IR+3 - IR+4) = ADDR.
*T  ADDR  59/0,1/F
*         F=0, IF TERMINAL ERROR MESSAGES TO BE ENABLED.
*         F=1, IF TERMINAL ERROR MESSAGES TO BE DISABLED.
*
*         EXIT   TERMINAL ERROR MESSAGES ENABLED/DISABLED.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  CKA.
 
 
 ERM      ENTRY
          RJM    CKA         GET ADDRESS OF VALUE
          CRD    CM
          LDD    CP          CLEAR OLD VALUE OF ERROR MESSAGE FLAG
          ADK    CSPW
          CRD    CN
          LDD    CN
          SCN    40
          STD    CN
          LDD    CM+4        SET NEW VALUE OF ERROR MESSAGE FLAG
          LPN    1
          SHN    5-0
          RAD    CN
          LDD    CP
          ADK    CSPW
          CWD    CN
          LJM    CPMX        RETURN
 ACP      SPACE 4,20
***       FUNCTION 140.
*
*         ASSIGN A CONCURRENT PP TO THE CONTROL POINT.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         PARAMETER BLOCK FORMAT.
*
*T ADDR   36/ 0, 12/ CCH, 11/ STAT, 1/C
*T,ADDR+1 60/ RA+1 CALL
*
*         CCH = CONCURRENT CHANNEL REQUIRED BY THE CPP.
*         STAT = STATUS REPLY,
*                0, IF CPP ASSIGNED.
*                1, IF CPP NOT ASSIGNED.
*         C = COMPLETION BIT.
*         RA+1 CALL = CPP *IR* REGISTER IMAGE.
*
*         USES   T1, CM - CM+4, CN - CN+4, FN - FN+4.
*
*         CALLS  CKA.
 
 
 ACP4     ABORT  ERCI        * CPM - HARDWARE DOES NOT SUPPORT CPP-S.*
 
 ACP      ENTRY
          LDK    CPPL        CHECK FOR CPP-S DEFINED
          CRD    CM
          LDD    CM+3
          LPN    77
          ZJN    ACP4        IF NO CPP-S DEFINED
          LDN    0           READ PARAMETER BLOCK
          STD    T1
          RJM    CKA
          CRM    CN,ON
          CRD    FN
          LDD    FN+1
          LPN    20
          ZJN    ACP1        IF RECALL BIT NOT SET
          LDD    FN+1        MOVE RECALL BIT
          SCN    60
          LMN    40
          STD    FN+1
          LDD    IR+1        CLEAR RECALL BIT FOR *CPM* CALL
          SCN    40
          STD    IR+1
 ACP1     LDD    MA          SET UP CPP CALL
          CWD    FN
          LDN    1           SELECT NO QUEUEING
          STD    CM+1
          LDD    CN+3
          SCN    40
          STD    CM+4
          LDN    4           COMPUTE CPP BARREL SELECT
          SBD    CM+4
          SHN    0-21
          ADN    2
          STD    CM+4
          MONITOR  CPRM      REQUEST A CONCURRENT PP
          LDD    CM+1
          NJN    ACP2        IF CPP ASSIGNED
          LDN    2
          RAD    CN+4
          UJN    ACP3        RETURN ERROR STATUS
 
 ACP2     LDD    IA          REWRITE INPUT REGISTER
          CWD    IR
 ACP3     AOD    CN+4        SET COMPLETE BIT
          RJM    CKA         RETURN RESPONSE
          CWD    CN
          LJM    CPMX        EXIT
 PAM      SPACE  4,20
***       FUNCTION 141.
*         RETURN PRIVILEGED ANALYST STATUS.
*
*         ENTRY  (IR+3 - IR+4) = STATUS RETURN ADDRESS.
*
*         EXIT   IF STATUS RETURN ADDRESS SPECIFIED -
*                   (ADDR) = 48/0, 12/STATUS
*                   STATUS = 0, IF USER HAS *CPAM* VALIDATION
*                               AND IF *PRIVILEGED ANALYST MODE*
*                               IS ENABLED.
*                   STATUS .NE. 0 OTHERWISE.
*
*                IF STATUS RETURN ADDRESS NOT SPECIFIED -
*                   USER JOB ABORTED, IF USER DOES NOT HAVE *CPAM*
*                   VALIDATION OR IF *PRIVILEGED ANALYST MODE*
*                   IS DISABLED.
 
 
 PAM      ENTRY
          LDN    ZERL        CLEAR REPLY
          CRD    CN
          RJM    VPA         VALIDATE PRIVILEGED ANALYST
          STD    CN+4        SAVE STATUS
          LDD    IR+3
          LPN    37
          SHN    14
          LMD    IR+4
          ZJN    PAM2        IF NO ADDRESS SPECIFIED
          RJM    CKA         CHECK ADDRESS
          CWD    CN          RETURN STATUS
 PAM1     LJM    CPMX        EXIT
 
 PAM2     LDD    CN+4
          ZJN    PAM1        IF PRIVILEGED ACCESS ALLOWED
          ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
 GSL      SPACE  4,20
***       FUNCTION 142.
*         GET SYSTEM LIBRARY STATUS.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*                   (ADDR) = 42/LIBRARY NAME, 18/0
*
*         EXIT    (ADDR) = 42/LIBRARY NAME, 17/, 1/STATUS
*                   STATUS = 1, IF *LIBRARY NAME* IS PRESENT IN
*                               SYSTEM LIBRARY DIRECTORY, AND
*                               LIBRARY ORDINAL IS IN RANGE.
*                   STATUS = 0, OTHERWISE.
 
 
 GSL      ENTRY
          RJM    CKA         CHECK ADDRESS
          CRD    FN          READ LIBRARY NAME
          RJM    LBD         SEARCH LIBRARY DIRECTORY
          ZJN    GSL1        IF NOT VALID LIBRARY
          LDN    1           SET *LIBRARY FOUND* STATUS
 GSL1     STD    FN+4        SET STATUS
          RJM    CKA         CHECK ADDRESS
          CWD    FN          RETURN STATUS
          LJM    CPMX        EXIT
 GSC      SPACE  4,10
***       FUNCTION 143.
*         GET *SHELL* PROCESSING CONTROLS.
*
*         THIS FUNCTION GETS THE *SHELL* PROCESSING CONTROLS FROM
*         THE USER-S NFL AND RETURNS THEM TO THE USER.  SEE FUNCTION
*         113 (*SSC*) FOR THE FORMAT OF *SHELL* PROCESSING CONTROLS.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF WORD TO RECEIVE
*                                *SHELL* PROCESSING CONTROLS.
 
 
 GSC      ENTRY
          NFA    SHCN        GET *SHELL* CONTROL FROM NFL
          CRD    CN
          RJM    CKA         COPY CONTROLS TO USER
          CWD    CN
          LJM    CPMX        EXIT
 SIC      SPACE  4,30
***       FUNCTION 144.
*         SET INTER-CONTROL POINT COMMUNCIATION CONTROLS.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
*         EXIT   INTER-CONTROL POINT COMMUNICATION CONTROLS UPDATED.
*
*         PARAMETER WORD FORMAT.
*
*T ADDR   1/T,11/ RES,6/ LEN0,18/ ADD0,6/ LEN1,12/ ADD1
*
*         T      *TDAM* FUNCTION WRITE CONTROL.
*                  0 = DISABLE *TDAM* WRITES TO SUBSYSTEM.
*                  1 = ENABLE *TDAM* WRITES TO SUBSYSTEM.
*         RES    RESERVED FOR CDC.
*         LEN0   LENGTH - 1 OF BUFFER 0.
*         ADD0   ADDRESS OF BUFER 0.
*         LEN1   LENGTH - 1 OF BUFFER 1.
*         ADD1   ADDRESS OF BUFER 1.
 
 
 SIC      ENTRY
          LDD    CP          CHECK IF CALLER IS A SUBSYSTEM
          ADK    JCIW
          CRD    CM
          LDC    LSSI
          SBD    CM+2
          MJN    SIC1        IF SUBSYSTEM
          ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 
 SIC1     RJM    CKA         READ PARAMETER WORD
          CRD    CM
          LDN    CM+1        SET BUFFER 0
          RJM    CBA         CHECK BUFFER ADDRESS
          LDN    CM+3        SET BUFFER 1
          RJM    CBA         CHECK BUFFER ADDRESS
          LDD    CM
          LPC    4000        SET *TDAM* WRITE CONTROL
          STD    CM
          NFA    ICAN        WRITE INTER-CP CONTROLS TO NFL
          CWD    CM
          LJM    CPMX        EXIT
 GTD      SPACE  4,55
***       FUNCTION 145.
*         GET TAPE DEFAULTS.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         EXIT   TAPE DEFAULT VALUES RETURNED TO PARAMETER BLOCK.
*
*         PARAMETER BLOCK ON EXIT.
*
*T ADDR   30/ RES,3/JCV,2/JD,1/R,3/JMD,3/JND,18/ RES
*T,       30/ RES,3/SCV,2/SD,1/R,3/SMD,3/SND,18/ RES
*
*         RES    RESERVED FOR CDC.
*         JCV    JOB DEFAULT CONVERSION MODE FOR 9 TRACK AND CARTRIDGE
*                  TAPE.
*                  2 = ASCII.
*                  3 = EBCDIC.
*         JD     JOB DEFAULT TAPE DEVICE TYPE.
*                  0 = MT.
*                  1 = CT.
*                  2 = NT.
*                  3 = AT.
*         JMD    JOB DEFAULT MT TAPE DENSITY.
*                  1 = 556 BPI.
*                  2 = 200 BPI.
*                  3 = 800 BPI.
*         RES    RESERVED FOR CDC.
*
*         RES    RESERVED FOR CDC.
*         JND    JOB DEFAULT NT TAPE DENSITY.
*                  3 = 800 BPI.
*                  4 = 1600 BPI.
*                  5 = 6250 CPI.
*         SCV    SYSTEM DEFAULT CONVERSION MODE FOR 9 TRACK AND
*                  CARTRIDGE TAPE.
*                  2 = ASCII.
*                  3 = EBCDIC.
*         SD     SYSTEM DEFAULT TAPE DEVICE TYPE.
*                  0 = 7 TRACK.
*                  1 = CARTRIDGE.
*                  2 = 9 TRACK.
*                  3 = ACS CARTRIDGE.
*         SMD    SYSTEM DEFAULT MT TAPE DENSITY.
*                  1 = 556 BPI.
*                  2 = 200 BPI.
*                  3 = 800 BPI.
*         SND    SYSTEM DEFAULT NT TAPE DENSITY.
*                  3 = 800 BPI.
*                  4 = 1600 BPI.
*                  5 = 6250 CPI.
*         RES    RESERVED FOR CDC.
 
 
 GTD      ENTRY
          NFA    TDFN        GET JOB TAPE DEFAULTS
          CRD    CM
          LDK    IPRL        GET SYSTEM TAPE DEFAULTS
          CRD    BA
          LDN    ZERL        CLEAR ASSEMBLY
          CRD    CN
          LDD    BA+3
          LPN    7
          SHN    3
          STD    CN+2        SET SYSTEM DEFAULT CONVERSION MODE
          LDD    BA+4
          LPN    60
          SHN    -3
          RAD    CN+2        SET SYSTEM DEFAULT DEVICE TYPE
          LDD    BA+4
          LPN    3
          SHN    11
          STD    CN+3        SET MT TAPE DEFAULT DENSITY
          LDD    BA+4
          LPC    700
          RAD    CN+3        SET NT TAPE DEFAULT DENSITY
          LDN    1           SET WORD COUNT
          STD    T1
          RJM    CKA         SET PARAMETER BLOCK ADDRESS
          CWD    CM          WRITE JOB TAPE DEFAULTS
          ADN    1           WRITE SYSTEM TAPE DEFAULTS
          CWD    CN
          LJM    CPMX        EXIT
 STD      SPACE  4,30
***       FUNCTION 146.
*         SET TAPE DEFAULTS FOR JOB.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         EXIT   JOB TAPE DEFAULTS SET.
*
*         PARAMETER BLOCK FORMAT.
*
*T ADDR   30/ RES,3/CVM,2/DT,1/R,3/MTD,3/NTD,18/ RES
*
*         RES    RESERVED FOR CDC.
*         CVM    CONVERSION MODE FOR 9 TRACK AND CARTRIDGE TAPE.
*                  2 = ASCII.
*                  3 = EBCDIC.
*         DT     TAPE DEVICE TYPE.
*                  0 = 7 TRACK.
*                  1 = CARTRIDGE.
*                  2 = 9 TRACK.
*                  3 = ACS CARTRIDGE.
*         MTD    MT TAPE DENSITY.
*                  1 = 556 BPI.
*                  2 = 200 BPI.
*                  3 = 800 BPI.
*         NTD    NT TAPE DENSITY.
*                  3 = 800 BPI.
*                  4 = 1600 BPI.
*                  5 = 6250 CPI.
*         RES    RESERVED FOR CDC.
 
 
 STD      ENTRY
          RJM    CKA         GET PARAMETERS
          CRD    CM
          LDN    ZERL        CLEAR ASSEMBLY
          CRD    CN
          LDD    CM+2
          LPN    76
          STD    CN+2        SET CONVERSION MODE AND DEVICE TYPE
          SHN    -3
          SBN    2
          MJN    STD1        IF INCORRECT CONVERSION MODE
          SBN    4-2
          PJN    STD1        IF INCORRECT CONVERSION MODE
          LDD    CM+3
          LPC    7700
          STD    CN+3        SET 7 AND 9 TRACK DENSITY
          SHN    -11
          ZJN    STD1        IF INCORRECT 7 TRACK DENSITY
          SBN    4
          PJN    STD1        IF INCORRECT 7 TRACK DENSITY
          LDD    CM+3
          SHN    -6
          LPN    7
          SBN    3
          MJN    STD1        IF INCORRECT 9 TRACK DENSITY
          SBN    6-3
          PJN    STD1        IF INCORRECT 9 TRACK DENSITY
          NFA    TDFN        UPDATE JOB TAPE DEFAULTS
          CWD    CN
          LJM    CPMX        EXIT
 
 STD1     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 GFN      SPACE  4,15
***       FUNCTION 147.
*         GET FAMILY ORDINAL AND FAMILY NAME.
*
*         ENTRY  (IR+3 - IR+4) = STATUS WORD ADDRESS.
*
*         EXIT   FAMILY ORDINAL AND FAMILY NAME RETURNED TO STATUS
*                  WORD.
*
*         STATUS WORD FORMAT.
*
*T ADDR   42/ FAMN,6/ 0,12/ FAMO
*
*         FAMN   FAMILY NAME (0 IF NO FAMILY).
*         FAMO   FAMILY ORDINAL (0 IF NO FAMILY).
 
 
 GFN      ENTRY
          LDN    ZERL        CLEAR FAMILY NAME AND ORDINAL
          CRD    FN
          LDD    CP
          ADK    PFCW        GET FAMILY EST ORDINAL
          CRD    CM
          LDD    CM+3
          ZJN    GFN1        IF NO FAMILY
          SFA    EST
          ADK    EQDE        GET MST ADDRESS
          CRD    CM
          LDD    CM+4
          SHN    3
          ADK    PFGL        GET FAMILY NAME
          CRD    FN
          RJM    GFO         GET FAMILY ORDINAL
 GFN1     LDN    0           SET WORD COUNT - 1
          STD    T1
          RJM    CKA         CHECK ADDRESS
          CWD    FN          RETURN FAMILY NAME AND FAMILY ORDINAL
          LJM    CPMX        EXIT
          TITLE  SUBROUTINES.
 CBA      SPACE  4,10
**        CBA - CHECK INTER-CONTROL POINT BUFFER ADDRESS.
*
*         ENTRY  (A) = ADDRESS OF BUFFER POINTERS.
*
*         EXIT   TO CALLER IF NO ERROR.
*                TO *ABT* IF BUFFER POINTER ERROR.
*
*         USES   T1, T2.
*
*         MACROS ABORT.
 
 
 CBA      SUBR               ENTRY/EXIT
          STD    T1          SET BUFFER POINTERS ADDRESS
          LDI    T1
          SHN    -6
          STD    T2          SET BUFFER LENGTH - 1
          LDI    T1          SET BUFFER ADDRESS
          LPN    77
          SHN    14
          LMM    1,T1
          ZJN    CBA1        IF NO BUFFER DEFINED
          MJN    CBA2        IF BUFFER ADDRESS ERROR
          ADD    T2
          SHN    -6
          SBD    FL
          MJN    CBAX        IF BUFFER WITHIN FL
          UJN    CBA2        ABORT
 
 CBA1     LDD    T2
          ZJN    CBAX        IF NO BUFFER LENGTH DEFINED
 CBA2     ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 LBD      SPACE  4,15
**        LBD - SEARCHES THE LIBRARY DIRECTORY FOR A SPECIAL ENTRY.
*
*         ENTRY  (FN - FN+4) = LIBRARY NAME LEFT JUSTIFIED.
*
*         EXIT   (A) = NONZERO - MATCH FOUND.
*                (T4) = INDEX + 1 IN LBD.
*                (T4) = 0 - IF NO MATCH.
*                (T4) AND (T8) = ERROR MESSAGE BIAS IF MATCH FOUND BUT
*                                ORDINAL OUT OF RANGE.
*
*         USES   T4, T8, CM - CM+4, CN - CN+4.
*
*         CALLS  CFN.
 
 
 LBD3     STD    T4          CLEAR ENTRY COUNT, ERROR MESSAGE BIAS
          STD    T8
 
 LBD      SUBR               ENTRY/EXIT
          LDN    1           INITIAL ENTRY COUNT IN *TLBD*
          STD    T4
          LDK    LBDP        READ LBD POINTER
          CRD    CM
          LDD    CM+2
          UJN    LBD2        ENTER LOOP
 
 LBD1     AOD    T4          INCREMENT ENTRY NUMBER
          LDN    2           ADVANCE LBD ADDRESS
          RAD    CM+2+1
          SHN    -14
          RAD    CM+2
 LBD2     SHN    14          READ LBD ENTRY
          ADD    CM+2+1
          CRD    CN
          LDD    CN          CHECK FOR MATCH
          ZJN    LBD3        IF END OF LBD
          RJM    CFN         COMPARE FILE NAMES
          NJN    LBD1        IF NO MATCH
          LDD    T4
          SBN    77
          MJN    LBDX        IF ORDINAL IN RANGE
          LDN    SLSG-SLSD   SET ERROR MESSAGE BIAS
          STD    T4
          LDN    SLSF-SLSC
          STD    T8
          LDN    0           SET NO MATCH
          UJN    LBDX        RETURN
 RLN      SPACE  4,10
**        RLN - RETURN LIBRARY NAME TO USER PROGRAM.
*
*         ENTRY  (BA - BA+1) = RETURN ADDRESS PARAMETER.
*                (FN - FN+4) = LIBRARY NAME.
*
*         EXIT   (BA - BA+1) ADVANCED.
*
*         MACROS ABORT.
 
 
 RLN1     LDD    BA          RETURN LIBRARY NAME
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    BA+1
          CWD    FN
          AOD    BA+1        INCREMENT RETURN ADDRESS
          SHN    -14
          RAD    BA
 
 RLN      SUBR               ENTRY/EXIT
          LDD    BA          VERIFY RETURN ADDRESS
          LPN    77
          SHN    14
          LMD    BA+1
          SHN    -6
          SBD    FL
          MJN    RLN1        IF .LT. FL
          ABORT  ERAE        * CPM - ARGUMENT ERROR.*
 RLW      SPACE  4,10
**        RLW - READ LIBRARY NAME FROM USER PROGRAM.
*
*         ENTRY  (BA - BA+1) = ADDRESS OF NEXT LIBRARY NAME.
*
*         EXIT   (A) = ZERO IF END OF LIBRARY LIST.
*                (BA - BA+1) ADVANCED IF NOT END OF LIST.
*                (FN - FN+4) = LIBRARY NAME.
*
*         MACROS ABORT.
 
 
 RLW1     LDD    BA          READ LIBRARY NAME
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    BA+1
          CRD    FN
          LDD    FN
          ZJN    RLWX        IF END OF LIBRARY LIST
          LDD    FN+3        CLEAR UNUSED FIELDS
          SCN    77
          STD    FN+3
          LDN    0
          STD    FN+4
          AOD    BA+1        INCREMENT RETURN ADDRESS
          SHN    -14
          RAD    BA
          LDD    FN
 
 RLW      SUBR               ENTRY/EXIT
          LDD    BA          VERIFY PARAMETER ADDRESS
          LPN    77
          SHN    14
          LMD    BA+1
          SHN    -6
          SBD    FL
          MJN    RLW1        IF .LT. FL
          ABORT  ERAE        * CPM - ARGUMENT ERROR.*
          SPACE  4,10
**        COMMON DECKS.
 
 
 SSJ$     EQU    1           SET *SSJ* CHECKING FOR *COMPCUA*
 QUAL$    EQU    1           SET TO NOT QUALIFY COMMON DECKS
*CALL     COMPACS
*CALL     COMPCUA
 FS       EQU    UN          DEFINE VALUE FOR *COMPSAF*
*CALL     COMPSAF
 GFO$     EQU    1           ASSEMBLE *GFO*
 DFF$     EQU    1           DO NOT ASSEMBLE FOT UPDATE CODE
*CALL     COMPUFT
*CALL     COMPVPA
          SPACE  4,10
**        BUFFER DEFINITIONS.
 
 
 TLBD     EQU    *           LOADER CONTROL/LIBRARY NAMES
 TLBDL    EQU    3*5
 LB2T     EQU    TLBD+TLBDL  *LB2W* (SECOND USER LIBRARY)
 LB3T     EQU    LB2T+5      *LB3W* (FIRST USER LIBRARY)
 
 BUFL     EQU    LB3T+5      LWA+1 OF BUFFERS
          ERRNG  7777-BUFL   BYTES LEFT IN OVERLAY
          SPACE  4,10
          OVERFLOW OVL
          OVERLAY (*L* DISPLAY FUNCTIONS.)
          SPACE  4,10
*         *DSDOUT*/*DSDINP* STATUS SYMBOLS.
*         (THESE SYMBOLS ARE PROCESSED BY *CPM* FUNCTIONS *TDC* AND
*         *TDU*.)
 
 NERR     EQU    0           NO ERROR
 NBUF     EQU    1           NO *L* DISPLAY BUFFER DEFINED IN CMR
 NINL     EQU    2           *L* DISPLAY NOT INTERLOCKED
 NDBF     EQU    3           DISPLAY BUFFER IN FL TOO LARGE
 NCMD     EQU    4           NO COMMAND ENTERED
 NCBF     EQU    5           COMMAND BUFFER IN FL TOO SMALL
          SPACE  4,10
**        DIRECT LOCATION ASSIGNMENTS.
 
*CM+5     EQU    CM+4+1      SCRATCH
 TDC      SPACE  4,30
***       FUNCTION 102.
*         TRANSFER DATA FROM UTILITY FL TO BUFFER IN CMR.
*
*         ENTRY  (IR+3 - IR+4) = FWA OF DISPLAY BUFFER IN FL OF
*                                UTILITY.
*
*         CALLS  CKA, CKR, DJI.
*
*         THE FORMAT OF THE DISPLAY BUFFER IN THE USER-S FL
*         IS AS FOLLOWS:
*
*T        12/N,1/S,1/F,1/A,45/0
*T,       60/DATA
*T,       60/DATA
*T,       60/0
*
*         CONTROL WORD OPTIONS ARE DEFINED AS FOLLOWS.
*
*         *N*    NUMBER OF WORDS IN THE BUFFER.  BUFFER
*                IS TERMINATED WHEN EITHER *N* WORDS ARE
*                TRANSFERRED OR THE ZERO TERMINATOR IS REACHED.
*         *S*    CHARACTER SIZE.
*                0 = SMALL CHARACTER SIZE.
*                1 = MEDIUM CHARACTER SIZE.
*         *F*    DATA FORMAT.
*                0 = PROGRAM FORMAT.
*                1 = CODED FORMAT.
*         *A*    LINE SPACING.
*                0 = SINGLE SPACING (10D OR 20D POSITIONS/LINE).
*                1 = WIDE SPACING (15D OR 30D POSITIONS/LINE).
 
 
 TDC      ENTRY              ENTRY
          RJM    CKR         CHECK ADDRESS
 LDSY     IFEQ   LDSY,0
          LDN    2*NBUF+1    SET BUFFER UNDEFINED STATUS
          STD    T5
 LDSY     ELSE
 
 TDC1     RJM    DJI         DETERMINE IF *L* DISPLAY INTERLOCKED
 
*         TRANSFER DATA FROM USER-S FL.
 
          LDN    2*NERR+1    SET COMPLETE STATUS
          STD    T5
          LDD    T1          STORE NUMBER OF WORDS TO TRANSFER
          STD    CM
          ZJN    TDC3        IF NO WORDS TO TRANSFER
          ADC    -LDSY-1
          MJN    TDC2        IF DISPLAY BUFFER .GE. WORDS TO TRANSFER
          LDC    LDSY
          STD    CM
          LDN    2*NDBF+1    SET BUFFER TOO LARGE STATUS
          STD    T5
 TDC2     RJM    CKA         READ BUFFER TO BE DISPLAYED
          ADN    1
          CRM    TDCB,CM
          LDD    CM          SAVE NUMBER OF BYTES TO TRANSFER
          SHN    2
          ADD    CM
 TDC3     STD    T7
          ADN    2*5         ADD TWO WORDS OF ZEROS
          STD    T0
 TDC4     LDN    0
          STM    TDCB,T7
          AOD    T7
          LMD    T0
          NJN    TDC4        IF BUFFER NOT ZERO FILLED
 
*         DETERMINE FWA DISPLAY BUFFER AND WRITE DATA TO CMR.
 
          LDN    2
          RAD    CM          ADJUST WORD COUNT FOR TERMINATOR
          LDD    CM+3        WRITE DATA TO CMR BUFFER
          SHN    14
          LMD    CM+4
          CRD    FN          SAVE *L* DISPLAY BUFFER CONTROL WORD
          ADN    LCOM+1
          CWM    TDCB,CM
 
*         DETERMINE TITLE AND WRITE IT TO CMR.
 
          RJM    CKA         GET FWA OF DISPLAY BUFFER
          CRD    BA
          LDN    2
          STD    T7
          LDD    RA          GET COMMAND NAME
          SHN    6
          ADK    PGNR
          CRM    TDCB,ON
          LDM    TDCB+3
          SCN    77
          STM    TDCB+3
          LDN    0
          STM    TDCB+4
          LDD    BA+2        CHECK FOR PROGRAM-SUPPLIED TITLE
          LPN    77
          SHN    14
          LMD    BA+3
          ZJN    TDC4.1      IF NO TITLE
          MJN    TDC4.1      IF TITLE ADDRESS IS OUT OF RANGE
          ADN    1
          SHN    -6
          SBD    FL
          PJN    TDC4.1      IF TITLE ADDRESS IS OUT OF RANGE
          LDD    BA+2        READ TITLE FROM PROGRAM
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    BA+3
          CRM    TDCB,T7
 TDC4.1   LDD    CM+3        WRITE TITLE TO CMR BUFFER
          SHN    14
          LMD    CM+4
          ADK    1+LCOM+LDSY+2
          CWM    TDCB,T7
 
*         UPDATE *L* DISPLAY CONTROL WORD BITS.
 
          LDD    BA+1        STORE CHARACTER SIZE AND FORMAT
          SHN    -12
          STM    TDCA+4
          LDD    BA+1        STORE LINE SPACING OPTION
          SHN    -11
          LPN    1
          STM    TDCAA+4
          LDN    4           STORE NUMBER OF OPTIONS TO PROCESS
          STD    CM+1
          LDN    0
          STD    CM+2
          LDD    FN+4        DETERMINE IF *L* DISPLAY DATA AVAILABLE
          SHN    21-3
          PJN    TDC5        IF *L* DISPLAY DATA NOT AVAILABLE
          SOD    CM+1        STORE NUMBER OF OPTIONS TO PROCESS
 TDC5     LDD    MA
          CWM    TDCA,CM+1
          MONITOR  UTEM      UPDATE CONTROL BITS
 LDSY     ENDIF
 
*         STORE STATUS IN USER-S FL.
 
          RJM    CKA
          CWD    T1
          LJM    CPMX        RETURN
          SPACE  4,10
*         *UTEM* BUFFER.
 
 TDCA     VFD    1/0,5/0,6/2,6/1,6/0  SET CHARACTER SIZE AND FORMAT
          CON    0,0,0
 TDCAA    VFD    1/0,5/0,6/1,6/6,6/0  SET WIDE LINE SPACING
          CON    0,0,0
          VFD    1/0,5/0,6/1,6/3,6/0  SET DATA AVAILABLE
          CON    0,0,1
          VFD    1/0,5/0,6/1,6/0,6/0  SET *L* DISPLAY REQUESTED
          CON    0,0,1
          SPACE  4,10
*         USE OF THIS BUFFER DESTROYS THE REMAINDER OF THE
*         OVERLAY INCLUDING SOME COMMONLY USED SUBROUTINES.
          SPACE  4,10
 TDCB     EQU    *           *L* DISPLAY DATA TRANSFER BUFFER
 
          ERRPL  TDCB+5*LDSY-7777-5-5  BUFFER OVERFLOW
 TDU      SPACE  4,25
***       FUNCTION 103.
*         TRANSFER DATA FROM CMR BUFFER TO USER-S FL.
*
*         ENTRY  (IR+3 - IR+4) = FWA OF DISPLAY BUFFER IN
*                FL OF UTILITY.  IF BIT 11 OF IR+3 IS SET,
*                THEN JSN WILL BE CLEARED.
*
*         CALLS  CKA, CKR, DJI.
*
*         THE FORMAT OF THE COMMAND BUFFER IN THE USER-S FL
*         IS AS FOLLOWS.
*
*T        12/N,48/0
*T,       60/0
*T,       60/0
*T,       60/0
*
*         CONTROL WORD OPTION IS DEFINED AS FOLLOWS.
*
*         *N*    NUMBER OF WORDS IN THE BUFFER.  BUFFER LENGTH
*                MUST BE AT LEAST HALF THE SIZE OF THE CMR COMMAND
*                BUFFER.
 
 
 TDU      ENTRY              ENTRY
          LDD    IR+3        STORE CLEAR INTERLOCK FLAG
          STD    T6
          LPN    77
          STD    IR+3
          RJM    CKR         CHECK IF ADDRESS IS WITHIN RANGE
          RJM    DJI         DETERMINE IF *L* DISPLAY INTERLOCKED
 LCOM     IFEQ   LCOM,0
          LDN    2*NBUF+1    SET BUFFER UNDEFINED STATUS
 LCOM     ELSE
          LDD    T6          CHECK CLEAR INTERLOCK FLAG
          SHN    21-6
          PJN    TDU2        IF NOT CLEARING INTERLOCK
 
*         CLEAR JSN FIELD, INPUT REQUESTED, AND COMMAND ENTERED BITS.
 
          LDN    0
          STD    CM+2
          LDN    2           STORE NUMBER OF OPTIONS TO PROCESS
          STD    CM+1
          LDD    MA
          CWM    TDUA,CM+1
          MONITOR  UTEM
          LDN    2*NERR+1    SET COMPLETE STATUS
          UJN    TDU4        RETURN STATUS
 
*         IF COMMAND NOT ENTERED SET PROGRAM REQUEST INPUT BIT.
 
 TDU2     LDD    BA+4        CHECK IF COMMAND HAS BEEN ENTERED
          SHN    21-5
          MJN    TDU3        IF COMMAND ENTERED
          LDN    0           SET COMMAND REQUESTED
          STD    CM+2
          LDN    2           STORE NUMBER OF OPTIONS TO PROCESS
          STD    CM+1
          LDD    MA
          CWM    TDUC,CM+1
          MONITOR  UTEM
          LDN    2*NCMD+1    SET NO COMMAND STATUS
          UJN    TDU4        RETURN STATUS
 
*         DETERMINE IF USER-S COMMAND BUFFER .GE. *LCOM*/2
 
 TDU3     LDD    T1
          SHN    1
          SBN    LCOM
          PJN    TDU5        IF USER-S COMMAND BUFFER .GE. *LCOM*/2
          LDN    2*NCBF+1    SET BUFFER TOO SMALL STATUS
 TDU4     LJM    TDU8        RETURN STATUS
 
*         TRANSFER COMMAND BUFFER TO *CPM* BUFFER.
 
 TDU5     LDN    LCOM        SET CMR COMMAND BUFFER LENGTH IN BYTES
          STD    BA
          LDK    LCOM*5
          STD    T6
          LDD    CM+3        READ UNPACKED DATA FROM CMR BUFFER
          SHN    14
          LMD    CM+4
          ADN    1
          CRM    CBUF,BA
          LDN    ZERL        WRITE ZERO TERMINATOR
          CRM    CBUF+LCOM*5,ON
 
*         PACK COMMAND BUFFER.
 
          LDC    CBUF        SET ORIGIN ADDRESS
          STD    BA
          STD    FN          SET DESTINATION ADDRESS
 TDU6     LDI    BA          PACK CHARACTERS
          SHN    6
          LMM    1,BA
          STI    FN
          ZJN    TDU7        IF END OF DATA
          LDN    2
          RAD    BA          INCREMENT ORIGIN ADDRESS
 TDU7     AOD    FN          INCREMENT DESTINATION ADDRESS
          SOD    T6
          NJN    TDU6        IF MORE DATA TO PACK
 
*         TRANSFER DATA TO USER-S COMMAND BUFFER.
 
          LDN    LCOM+1
          SHN    -1
          STD    BA
          RJM    CKA         WRITE COMMAND TO USER-S FL
          ADN    1
          CWM    CBUF,BA
 
*         CLEAR COMMAND AVAILABLE IN *L* DISPLAY BUFFER CONTROL WORD.
 
          LDN    0
          STD    CM+2
          LDN    1           STORE NUMBER OF OPTIONS TO PROCESS
          STD    CM+1
          LDD    MA
          CWM    TDUD,CM+1
          MONITOR  UTEM
 
*         SEND MESSAGE TO SYSTEM DAYFILE.
 
*         LDN    0
          STM    BUF+30B     ASSURE A ZERO BYTE TERMINATOR
          LDC    2RDS        PLACE HEADER ON MESSAGE
          STM    BUF
          LDC    2R,
          STM    BUF+1
          LDC    2RL.
          STM    BUF+2
          LDC    BUF+NMSN
          RJM    DFM         SEND MESSAGE TO SYSTEM DAYFILE
 
*         SET STATUS TO CALLER.
 
          LDN    2*NERR+1    SET COMPLETE STATUS
 LCOM     ENDIF
 TDU8     STD    T5
          RJM    CKA         GET ABSOLUTE ADDRESS
          CWD    T1
          LJM    CPMX        RETURN
          SPACE  4,10
*         *UTEM* BUFFER.
 
 TDUA     VFD    1/0,5/0,6/24D,6/36D,6/0  CLEAR JSN
          CON    0,0,0
 TDUB     VFD    1/0,5/0,6/2,6/4,6/0  INPUT REQUEST/COMMAND ENTERED
          CON    0,0,0
 TDUC     VFD    1/1,5/0,6/1,6/4,6/0  VERIFY INPUT NOT REQUESTED
          CON    0,0,0
          VFD    1/0,5/0,6/1,6/4,6/0  SET INPUT REQUESTED
          CON    0,0,1
 TDUD     VFD    1/0,5/0,6/1,6/5,6/0  SET COMMAND ENTERED
          CON    0,0,0
 CKR      SPACE  4,10
**        CKR - CHECK IF BUFFER IN USER-S FL WITHIN RANGE.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF DISPLAY BUFFER.
*
*         EXIT   (T1 - T5) = FIRST WORD OF USER-S BUFFER.
*
*         USES   T1 - T5.
*
*         CALLS  CKA.
 
 
 CKR      SUBR               ENTRY/EXIT
          LDN    0
          STD    T1
          RJM    CKA         CHECK ADDRESS
          CRD    T1
          RJM    CKA         CHECK ADDRESS
          UJN    CKRX        RETURN
 DJI      SPACE  4,20
**        DJI - DETERMINE IF CALLING JOB HAS *L* DISPLAY INTERLOCKED.
*
*         ENTRY  (IR+3 - IR+4) = ADDRESS OF DISPLAY BUFFER.
*                (T1 - T5) = FIRST WORD OF USER-S BUFFER.
*
*         EXIT   (BA - BA+4) = FIRST WORD OF CMR BUFFER.
*                (CM+1 - CM+5) = *LDSP* WORD FROM CMR.
*
*         ERROR  TO *ABORT* IF THE USER PROGRAM DOES NOT HAVE THE
*                JSN INTERLOCKED.
*                (T5) = ERROR STATUS IF ERROR.
*
*         USES   T5, BA - BA+4, CM+1 - CM+5, FN - FN+4.
*
*         CALLS  CKA.
*
*         MACROS ABORT, SFA.
 
 
 DJI      SUBR               ENTRY/EXIT
          LDC    LDSP        READ POINTER TO *L* DISPLAY BUFFER
          CRD    CM+1
          LDD    CM+3        READ *L* DISPLAY BUFFER CONTROL WORD
          SHN    14
          LMD    CM+4
          CRD    BA
          LDD    CP          READ JSN OF CALLING JOB
          ADN    TFSW
          CRD    FN
          SFA    EJT,FN      GET JSN
          ERRNZ  JSNE        CHECK IF WORD 0 OF EJT ENTRY
          CRD    FN
          LDD    FN          COMPARE JSN
          LMD    BA
          NJN    DJI1        IF NO MATCH
          LDD    FN+1
          LMD    BA+1
          ZJN    DJIX        IF JSN-S MATCH
 DJI1     LDN    2*NINL+1    SET NOT INTERLOCKED STATUS
          STD    T5
          RJM    CKA
          CWD    T1
          ABORT  ERIU        * CPM - USER ACCESS NOT VALID.*
          SPACE  4,10
 BUF      DATA   0,0,0       HEAD ON MESSAGE
 CBUF     EQU    *           INPUT ASSEMBLY BUFFER
 
          ERRPL  CBUF+5*LCOM-7777-5  BUFFER OVERFLOW
          SPACE  4,10
          OVERFLOW OVL
          TTL    CPM - CONTROL POINT MANAGER.
          SPACE  4,10
          END