CPM 
          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 
