1DS 
          IDENT  1DS,IDS
          PERIPH
          BASE   MIXED
          SST 
*COMMENT  1DS - DSD REQUEST PROCESSOR.
 EQV$     EQU    1           DO NOT VERIFY EQUIPMENT IN *COMPRSS* 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  1DS - DSD REQUEST PROCESSOR. 
          SPACE  4,10 
***       1DS - DSD REQUEST PROCESSOR.
*         G. R. MANSFIELD.  70/10/24. 
*         R. E. DENNIS.  74/10/15.
*         C. B. LOSCHEIDER.  78/09/11.
          SPACE  4,10 
***              *1DS* PROCESSES FUNCTIONS FOR *DSD* WHICH ARE NOT
*         POSSIBLE FOR *DSD* TO PROCESS.  *1DS* IS CALLED BY
*         *1SJ* TO INITIATE THE JOB *CMS*.  *1DS* IS CALLED 
*         BY *6DI* TO INITIATE THE *LBC* JOB. 
          SPACE  4,10 
***       PROGRAMMING CONSIDERATIONS. 
* 
**        FOR A DETAILED EXPLAINATION OF THE *DSD*/*1DS*
*         INTERFACE, SEE COMMON DECK *COMS1DS*. 
          SPACE  4,15 
***       CALL. 
* 
*T        18/1DS, 6/SC, 1/C, 1/L, 3/LOG, 6/REQ, 12/P1, 12/P2
* 
*         SC     SYSTEM CONTROL POINT.
*         C      CONTROL POINT CHANGE REQUIRED (CP NUMBER IN P2). 
*         L      LOCKED BUFFER. 
*         LOG    LOGGING CONTROL BITS.
*         REQ    FUNCTION CODE. 
*         P1     PARAMETER 1. 
*         P2     PARAMETER 2. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
* 
*         *DEADSTART SEQUENCING FAILED.*
*                THE DEADSTART SEQUENCING JOB COULD NOT BE INITIATED
*                AFTER SEVERAL RETRIES BECAUSE OF AN I/O ERROR
*                ENCOUNTERED ON A MASS STORAGE DEVICE.
          SPACE  4,15 
***       ACCOUNT DAYFILE MESSAGES. 
* 
* 
*         *ABLQ, C1, JSN, YYMMDD, HHMMSS, DC.*
*         *ABLQ, C2, XXXXXX.XXXKUNS.* 
*                QUEUED FILE WITH JOB SEQUENCE NAME JSN AND 
*                DISPOSITION CODE DC HAS BEEN ROUTED TO THE 
*                QUEUE ON DATE YYMMDD AT TIME HHMMSS. 
*                THE FILE HAS A DISPOSITION CODE OF DC AND IS 
*                XXXXXX.XXX THOUSAND PRU-S IN LENGTH. 
* 
*         *ACDT, DATE YY/MM/DD.*
*                WHERE YY=YEAR, MM=MONTH, DD=DAY OF THE NEW 
*                DATE ENTERED BY THE OPERATOR.
* 
*         *ACDT, TIME HH.MM.SS.*
*                WHERE HH=HOURS, MM=MINUTES, SS=SECONDS OF THE
*                NEW TIME ENTERED BY THE OPERATOR.
* 
*         *MSEQ, NNN, LEVEL1, LEVEL2.*
*                WHERE NNN=EST ORDINAL, LEVEL1=LOWER ACCESS LEVEL,
*                LEVEL2=UPPER ACCESS LEVEL ENTERED BY THE OPERATOR
*                VIA THE *SECUREQ* COMMAND. 
* 
*         *MSOT, OT, LEVEL1, LEVEL2.* 
*                WHERE OT=ORIGIN TYPE (IN DISPLAY CODE),
*                LEVEL1=LOWER ACCESS LEVEL, LEVEL2=UPPER ACCESS LEVEL 
*                ENTERED BY THE OPERATOR VIA THE *SECURES* COMMAND. 
* 
*         *MSSA, USERNAME.* 
*                WHERE USERNAME=VALID USER NAME (I.E., A USER WITH
*                SECURITY ADMINISTRATOR PRIVILEGES) ENTERED BY THE
*                OPERATOR VIA THE *SECURITY-UNLOCK* COMMAND.
* 
*         *MSSI, USERNAME.* 
*                WHERE USERNAME=INCORRECT USER NAME (I.E., A USER WHO 
*                DOES NOT HAVE SECURITY ADMINISTRATOR PRIVILEGES) 
*                ENTERED BY THE OPERATOR VIA THE
*                *SECURITY-UNLOCK* COMMAND. 
          SPACE  4,20 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 PP       EQU    LA          POT POINTER
 S1       EQU    16          SCRATCH CELL 
 S2       EQU    17          SCRATCH CELL 
 PA       EQU    S1 - S2     POT ADDRESS (2 LOCATIONS)
 FS       EQU    20 - 24     FST ENTRY (5 LOCATIONS)
 MS       EQU    FS+5        MST POINTER
 QA       EQU    26          FNT ORDINAL
 CA       EQU    27          COMMAND ADDRESS
 CN       EQU    30 - 34     CM WORD BUFFER (5 LOCATIONS) 
 JF       EQU    35          JOB FIELD LENGTH 
 TN       EQU    36          TABLE NUMBER 
 FG       EQU    37          CPU FLAGS
 AB       EQU    40 - 44     CM WORD BUFFER (5 LOCATIONS) 
 NC       EQU    45          SYSTEM CP NUMBER 
 JS       EQU    57          JOB SERVICE CLASS
 FN       EQU    60 - 64     CM WORD BUFFER (5 LOCATIONS) 
 SR       EQU    FN          SCRATCH (5 LOCATIONS)
 FV       EQU    65          CONSTANT FIVE
 JC       EQU    66          JOB COUNTER
 BA       EQU    67          SECTOR BUFFER ADDRESS
****
          SPACE  4,10 
*         ASSEMBLY CONSTANTS. 
  
  
 CPMR     EQU    10D         CONTROL POINT MOVE RETRY COUNT 
 DFFL     EQU    60000       DEFAULT FIELD LENGTH 
 DFTL     EQU    777777      DEFAULT JOB STEP TIME LIMIT
          SPACE  4,10 
*CALL     COMPMAC 
*CALL     COMSACC 
          QUAL   BIO
*CALL     COMSBIO 
          QUAL   *
*CALL     COMSCPS 
*CALL     COMSDFS 
          QUAL   DSL
*CALL     COMSDSL 
          QUAL   *
*CALL     COMSDSP 
*CALL     COMSEJT 
          QUAL   EVENT
*CALL     COMSEVT 
          QUAL   *
*CALL     COMSHIO 
*CALL     COMSJIO 
          QUAL   LSD
*CALL     COMSLSD 
          QUAL   *
*CALL     COMSMLS 
          QUAL   MMF
*CALL     COMSMMF 
          QUAL   *
          QUAL   MTX
*CALL     COMSMTX 
          QUAL   *
*CALL     COMSMSP 
*CALL     COMSMST 
*CALL     COMSPFM 
          QUAL   REM
*CALL     COMSREM 
          QUAL   *
          QUAL   RSX
*CALL     COMSRSX 
          QUAL   *
*CALL     COMSSCD 
*CALL     COMSSSD 
*CALL     COMSSSE 
*CALL     COMSPIM 
*CALL     COMSPRD 
*CALL     COMSTCM 
*CALL     COMSWEI 
*CALL     COMSZOL 
          QUAL   1DS
          LIST   X
*CALL     COMS1DS 
          LIST   *
          QUAL   *
*CALL     COMS1MV 
          TITLE  MACRO DEFINITIONS. 
 BIODF    SPACE  4,20 
**        BIODF - DEFINE *BIO* DEVICE/FUNCTIONS.
* 
*         BIODF  FUNC,(DV,DV,...DV) 
* 
*         ENTRY  *FUNC* = *BIO* REQUEST FUNCTION. 
*                *DV* = DEVICE TYPE.
* 
*         THIS MACRO WORKS LIKE THE *INDEX* MACRO DEFINED IN *COMPMAC*. 
*         IT IS USED TO GENERATE A TABLE OF ALLOWABLE DEVICES FOR 
*         REQUESTS TO *BIO*.  ENTRIES IN THE TABLE ARE PLACED 
*         BETWEEN THE FIRST *BIODF* AND LAST *BIODF* SHOWN BELOW. 
* 
*TAG      BIODF 
*         . 
*         . 
*         BIODF  MAXFUNC
* 
*         MACROS .1.
  
  
          PURGMAC  BIODF
  
          MACRO  BIODF,A,B,C
          MACREF BIODF
          IFC    NE,$A$$
 A        BSS    0
 .3       SET    A
          ELSE   8
          ORG    .3+/BIO/_B 
          IFC    NE,$C$$,5
          QUAL   BIO
          LOC    B
          .1     (C)
          CON    .1 
          QUAL   *
          BSS    0
 BIODF    ENDM
 CHKERR   SPACE  4,10 
**        CHKERR - CHECK ERROR FLAG.
* 
*         RETURNS BYTE ONE OF *STSW*. 
  
  
          PURGMAC  CHKERR 
  
 CHKERR   MACRO 
          MACREF CHKERR 
          LDD    CP 
          ADK    STSW 
          CRD    CM 
          LDD    CM+1 
          ENDM
 FCN      SPACE  4,10 
**        FCN - DEFINE FUNCTION PROCESSOR.
* 
*         FCN    CODE,NAME
* 
*         ENTRY  *CODE* = FUNCTION CODE.
*                *NAME* = FUNCTION PROCESSING ROUTINE NAME. 
  
  
 FCN      MACRO  C,N
          INDEX  C*2,N-N/10000B*10000B
          CON    N/10000B 
          ENDM
 OVERLAY  SPACE  4,10 
**        OVERLAY - DEFINE THE SECONDARY OVERLAY(S).
* 
*         OVERLAY (TEXT)
*         ENTRY  *TEXT* = TEXT OF SUBTITLE. 
  
  
 .N       SET    0
 OVLB     MICRO  1,, 2D      OVERLAY NAME 
  
  
          PURGMAC OVERLAY 
  
 OVERLAY  MACRO  TEXT 
          MACREF OVERLAY
          QUAL
 .N       SET    .N+1 
 .M       MICRO  .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 
 .O       MICRO  1,3, "OVLB"".M"
          QUAL   ".O" 
          TTL    1DS/".O" - TEXT
          TITLE 
          IDENT  ".O",OVLA   TEXT 
*COMMENT  1DS - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          ORG    OVLA 
          LJM    *           ENTRY/EXIT 
          UJN    *-2         OVERLAY EXIT ADDRESS 
          ENDM
 SUBSYST  SPACE  4,10 
**        SUBSYST - GENERATE SUBSYSTEM TABLE. 
* 
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT 
* 
*         ENTRY  *NAME* = 3 CHARACTER SUBSYSTEM NAME. 
*                *ID* = SUBSYSTEM ID. 
*                *PP* = NAME OF PP, IF PP INITIATED SUBSYSTEM.
*                *AUTO* = *AUTO* IF *AUTO* ENABLED SUBSYSTEM. 
  
          PURGMAC  SUBSYST
  
 SUBSYST  MACRO  NM,ID,PT,PP,AU,DF,DC,CP,PR,AB
 .SUB     RMT 
 IAS.NM   EQU    *           TAG FOR TABLE ENTRY
          VFD    18/3L_NM    NAME 
 .A       IFC    EQ,$PP$$ 
          VFD    1/0         PPU FLAG 
 .A       ELSE
          VFD    1/1         PPU FLAG 
 .A       ENDIF 
 .B       IFC    EQ,$AU$AUTO$ 
          VFD    1/1         AUTO FLAG
 .B       ELSE
          VFD    1/0         AUTO FLAG
 .B       ENDIF 
 .1       SET    MXSI-ID
 .2       SET    .1/12D 
 .3       SET    4-.2 
 .4       DECMIC .1-12D*.2
 .5       SET    1S".4" 
          VFD    4/.3        *SSSL* BYTE
          VFD    12/ID     SSID 
          VFD    12/.5       *SSSL* MASK
 .C       IFC    EQ,$NM$CMS$
          VFD    12/NOQF*100+7
 .C       ELSE
          VFD    12/0 
 .C       ENDIF 
 IASBE    EQU    *-IAS.NM 
 .SUB     RMT 
 SUBSYST  ENDM
 ENTRY    SPACE  4,10 
**        ENTRY - DEFINE OVERLAY ENTRY POINT. 
* 
* NAME    ENTRY 
*         NAME = NAME OF ENTRY ADDRESS. 
  
  
          PURGMAC ENTRY 
  
          MACRO  ENTRY,NAME 
          MACREF ENTRY
          QUAL
 NAME_X   LJM    *           EXIT ADDRESS 
 NAME     EQU    *-1+.N*10000B
 .NAME    EQU    NAME-.N*10000B  ENTRY ADDRESS WITHIN OVERLAY 
          QUAL   *
          ENDM
          TITLE  MAIN PROGRAM.
**        IDS - MAIN PROGRAM. 
  
  
          ORG    PPFW 
 IDS      RJM    /PRESET/PRS PRESET PROGRAM 
          LDM    /PRESET/TRQP+1,CM  CHECK OVERLAY LOAD
          ZJN    IDS1        IF OVERLAY NOT NEEDED
          LMC    2L"OVLB"    LOAD OVERLAY 
          RJM    EXR
 IDS1     RJM    *           PROCESS FUNCTION 
 IDSA     EQU    *-1
 IDS2     RJM    LKC         LOG COMMAND
          LDC    0
 IDSB     EQU    *-1
          ZJN    IDS3        IF NO JOBS ENTERED 
          LDC    INWL        CHECK CHECKPOINT IN PROGRESS FLAG
          CRD    CN 
          LDD    CN+4 
          LPN    20 
          NJN    IDS3        IF CHECKPOINT IN PROGRESS
          LDN    1
          STD    CM+2 
          MONITOR  RSJM      REQUEST SCHEDULER
          LDN    ** 
 IDSE     EQU    *-1
          NJN    IDS4        IF PP NOT TO BE DROPPED
 IDS3     MONITOR  DPPM      DROP PP
 IDS4     LJM    PPR         EXIT TO PP RESIDENT
  
  
 IDSC     CON    0           ORIGINAL (IR+2)
 IDSD     CON    0           *DSD* REPLY STATUS 
          TITLE  RESIDENT SUBROUTINES.
 CSS      SPACE  4,10 
**        CSS - CHECK SUBSYSTEM STATUS. 
* 
*         ENTRY  (A) = SUBSYSTEM ID.
*                (CP) = SUBSYSTEM CPA ADDRESS.
* 
*         EXIT   (A) = 0, IF SUBSYSTEM ACTIVE.
*                TO *IDS2* IF SUBSYSTEM NOT ACTIVE. 
* 
*         USES   T7, CM - CM+4. 
  
  
 CSS      SUBR               ENTRY/EXIT 
          STD    T7 
          LDD    CP 
          ADN    JCIW 
          CRD    CM 
          LDD    CM+2 
          LMD    T7 
          ZJN    CSSX        IF CORRECT SUBSYSTEM 
          LJM    IDS2        DROP PP
 FAS      SPACE  4,10 
**        FAS - FORMAT AND SEND ACCOUNT FILE MESSAGE. 
* 
*         FORMAT AND SEND *DSD* MESSAGE TO ACCOUNT DAYFILE
*         AND/OR ERROR LOG AND/OR SYSTEM DAYFILE. 
* 
*         ENTRY  (IDSC) = LOGGING CONTROL BITS. 
*                (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/ .
*                (BUF+2 - BUF+61) = DSD KEYBOARD DATA.
* 
*         CALLS  DFM, RPK.
  
  
 FAS      SUBR               ENTRY/EXIT 
          LDC    /OVERLAY/BUF+2  READ AND PACK KEYBOARD BUFFER
          RJM    RPK
          LDN    ZERL        CLEAR LAST WORD
          CRM    /OVERLAY/BUF+31,ON 
          LDC    2RDS        PLACE HEADER ON MESSAGE
          STM    /OVERLAY/BUF 
          LDC    2R,
          STM    /OVERLAY/BUF+1 
          LDM    IDSC 
          SHN    21-6 
          PJN    FAS1        IF ERROR LOG NOT SELECTED
          LDC    /OVERLAY/BUF+ERLN  SEND TO ERROR LOG 
          RJM    DFM
 FAS1     LDM    IDSC 
          SHN    21-7 
          PJN    FAS2        IF SYSTEM DAYFILE NOT SELECTED 
          LDC    /OVERLAY/BUF+MDON
          RJM    DFM
 FAS2     LDM    IDSC 
          SHN    21-10
          PJN    FAS3        IF ACCOUNT FILE NOT SELECTED 
          LDN    ZERL        CLEAR LAST WORD
          CRM    /OVERLAY/BUFB+31,ON
          LDC    /OVERLAY/BUFB+ACFN 
          RJM    DFM
 FAS3     LJM    FASX        EXIT 
 LKC      SPACE  4,10 
**        LKC - LOG KEYBOARD COMMAND. 
* 
*         ENTRY  (IDSC) = ORIGINAL IR+2.
* 
*         EXIT   (IR+4) = 0.
* 
*         USES   IR+4, CM - CM+4. 
* 
*         CALLS  FAS. 
  
  
 LKC      SUBR               ENTRY/EXIT 
          LDM    IDSC        SET LOGGING PARAMETER
          LPC    700
          ZJN    LKC1        IF NO LOGGING REQUIRED 
          LDN    0
          STD    IR+4 
          RJM    FAS         PROCESS LOGGING
 LKC1     LDM    IDSC 
          LPC    1700 
          ZJN    LKCX        IF INTERLOCK NOT SET 
          LMM    IDSC 
          STM    IDSC 
          LDM    IDSD        *DSD* REPLY
          STD    T7 
          LDN    ZERL        CLEAR INTERLOCK
          CRD    CM 
          ADN    /1DS/DSDL+1-ZERL 
          CWD    T7 
          SBN    1
          CWD    CM 
          UJN    LKCX        RETURN 
 RPK      SPACE  4,10 
**        RPK - READ AND PACK KEYBOARD BUFFER.
* 
*         ENTRY  (A) = DESTINATION ADDRESS. 
*                (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/ .
* 
*         USES   S1, S2, T0.
  
  
 RPK      SUBR               ENTRY/EXIT 
          STD    S1          SAVE ADDRESS 
          LDN    /1DS/KBCML 
          STD    S2 
          LDC    /1DS/DSDL
          CRM    BFMS+100D,S2 
          LDN    ZERL 
          CRM    BFMS+100D+/1DS/KBCML*5,ON
          LDD    IR+4        SET KEYBOARD ADDRESS 
          SHN    -6 
          ADC    BFMS+100D
          STD    S2 
          LDN    /1DS/KBCML*5/2 
          STD    T0 
 RPK1     LDI    S2          PACK NEXT TWO CHARACTERS 
          SHN    6
          LMM    1,S2 
          STI    S1 
          ZJN    RPK2        IF END OF MESSAGE
          LDN    2
          RAD    S2 
 RPK2     AOD    S1 
          SOD    T0 
          PJN    RPK1        IF MORE DATA TO PACK 
          LDD    S1          READ ONE CM WORD OF ZERO 
          STM    RPKA 
          LDN    ZERL 
          CRM    *,ON 
 RPKA     EQU    *-1
          LJM    RPKX        EXIT 
 SCP      SPACE  4,10 
**        SCP - SET CP/PCP AREA ADDRESS.
* 
*         ENTRY  (A) = CP/PCP NUMBER. 
*                (NC) = SYSTEM CP NUMBER. 
* 
*         EXIT   (A) = CPA/PCPA ADDRESS.
  
  
 SCP1     ADD    NC          SET REAL CP AREA ADDRESS 
          SHN    7
  
 SCP      SUBR               ENTRY/EXIT 
          SBD    NC 
          MJN    SCP1        IF REAL CP 
          ZJN    SCP1        IF SYSTEM CP 
          SBN    1           SET PCP AREA ORDINAL 
          SHN    7
          ADC    0           ADD BASE PCPA ADDRESS
 SCPA     EQU    *-1
          UJN    SCPX        RETURN 
 SRD      SPACE  4,10 
**        SRD - SAVE REPLY TO *DSD*.
* 
*         ENTRY  (A) = 0 IF POSITIVE REPLY TO *DSD*.
* 
*         EXIT   (IDSD) = *DSD* REPLY.
*                (IDSC) LOGGING BITS (6-8) CLEARED IF ERROR RESPONSE. 
  
  
 SRD      SUBR               ENTRY/EXIT 
          STM    IDSD        SAVE REPLY 
          ZJN    SRDX        IF NO ERROR
          LDM    IDSC 
          LPC    -700        CLEAR LOGGING
          STM    IDSC 
          UJN    SRDX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
          QUAL   ACS
 QUAL$    EQU    0           DO NOT FURTHER QUALIFY *ACS* 
 T2       EQU    LA 
*CALL     COMPACS 
          QUAL   *
 ACS      EQU    /ACS/ACS 
*CALL     COMPCLD 
*CALL     COMPC2D 
*CALL     COMPCTI 
 RND$     EQU    1           SELECT ROUNDING FOR *COMPDV5*
*CALL     COMPDV5 
 EJT$     EQU    1           EJT SEARCH 
 FNT$     EQU    1           FNT SEARCH 
 IFP$     EQU    1           *COMPGFP* REMOTE ASSEMBLY
 JCB$     EQU    1           JCB SEARCH 
 QFT$     EQU    1           QFT SEARCH 
*CALL     COMPGFP 
 SFI$     EQU    1           SELECT CALLER DELAY PROCESSING 
*CALL     COMPSFI            TABLE INTERLOCK
*CALL     COMPSTI 
*CALL     COMPTGB 
*CALL     COMPTLB 
 WCS$     EQU    1           CONSECUTIVE SECTORS AFTER SYSTEM SECTOR
*CALL     COMPWSS 
          SPACE  4,10 
 OVLA     EQU    *+5         ORIGIN OF OVERLAY AREA 
          TITLE  OVERLAYABLE SUBROUTINES. 
          QUAL   OVERLAY
 CCF      SPACE  4,15 
**        CCF - CLEAR CHECKPOINT FLAGS. 
* 
*         THIS ROUTINE CLEARS THE *VALID CHECKPOINT 
*         FILE* FLAG IN THE SECTOR OF LOCAL AREAS FOR 
*         EACH CHECKPOINT DEVICE.  THIS PREVENTS
*         LEVEL 1 AND 2 RECOVERY DEADSTART FROM 
*         AN OBSOLETE CHECKPOINT FILE.
* 
*         USES   T6, AB - AB+4, CM - CM+4, CN - CN+4, 
*                FN - FN+4, FS - FS+4.
* 
*         CALLS  CSB, LKC.
* 
*         MACROS SFA. 
  
  
 CCF      SUBR               ENTRY/EXIT 
          RJM    LKC         LOG KEYBOARD COMMAND 
 CCF1     LDN    JSCL        READ SCHEDULER CONTROL WORD
          CRD    AB 
          LDD    AB 
          SHN    21-13
          PJN    CCF2        IF SCHEDULER ACTIVE
          DELAY 
          UJN    CCF1        WAIT UNTIL SCHEDULER ACTIVE
  
 CCF2     LDK    ESTP        GET LAST MASS STORAGE EST ORDNAL+1 
          CRD    AB 
          ADK    MMFL-ESTP
          CRD    FN 
          LDN    NOPE-1      INITIALIZE EST ORDINAL 
          STD    S1 
 CCF3     AOD    S1          ADVANCE EST ORDINAL
          STD    T5 
          LMD    AB+3 
          ZJN    CCFX        IF END OF MASS STORAGE DEVICES 
          SFA    EST,S1      READ EST ENTRY 
          ADK    EQDE 
          CRD    FS 
          LDD    FS 
          SHN    21-13
          PJN    CCF3        IF NOT MASS STORAGE DEVICE 
          SHN    13-2 
          PJN    CCF3        IF NOT CHECKPOINT DEVICE 
          LDD    FS+4 
          SHN    3
          ADK    ACGL 
          CRD    CN 
          ADK    ALGL-ACGL
          CRD    CM 
          LDD    CM+1        SET LABEL TRACK FOR *CSB*
          STD    T6 
          RJM    CSB         CLEAR SLA BIT
          UJN    CCF3        PROCESS NEXT DEVICE
 CCI      SPACE  4,15 
**        CCI - COMPLETE COMMAND IMAGE. 
* 
*         ENTRY  (A) = ADDRESS OF COMMAND COMPLETION IN *C* FORMAT. 
*                (CA) = FWA OF COMMAND BUFFER.
* 
*         EXIT   (T1) = BUFFER ADDRESS FOR NEXT COMMAND.
* 
*         ERROR  TO *IDS2* IF FULL SECTOR.
* 
*         USES   T1.
* 
*         CALLS  ACS, DV5.
  
  
 CCI2     ADD    HN          SET ADDRESS FOR NEXT COMMAND 
          STD    T1 
          SHN    2
          ADD    CA 
          RAD    T1 
  
 CCI      SUBR               ENTRY/EXIT 
          RJM    ACS         ASSEMBLE CHARACTER STRING
          LDI    T1 
          ZJN    CCI1        IF ASSEMBLY ON BYTE BOUNDARY 
          AOD    T1 
 CCI1     AOD    T1          CALCULATE CM WORD COUNT
          SBD    CA 
          RJM    DV5
          STM    -1,CA       SET WORD COUNT IN LINKAGE
          SBD    HN 
          MJN    CCI2        IF NOT FULL SECTOR 
          LJM    IDS2        DROP PP
 CSB      SPACE  4,15 
**        CSB - CLEAR SLA BIT.
* 
*         ENTRY  (T5) = CHECKPOINT DEVICE EST ORDINAL.
*                (T6) = LABEL TRACK.
*                (CN - CN+4) = *ACGL* WORD OF MST.
*                (FN - FN+4) = *MMFL*.
* 
*         USES   T1, T2, T7.
* 
*         CALLS  CTI, RDS, STI, WDS.
* 
*         MACROS ENDMS, SETMS.
  
  
 CSB3     ENDMS 
 CSB4     LDD    T6          CLEAR TRACK INTERLOCK
          RJM    CTI
  
 CSB      SUBR               ENTRY/EXIT 
          LDD    CN+4 
          LPC    MGLAP
          ZJN    CSBX        IF NO SECTOR OF LOCAL AREAS
          RJM    STI         SET LABEL TRACK INTERLOCK
          NJN    CSBX        IF ERROR 
          LDN    /MMF/LMLT   SET LOCAL AREA SECTOR
          STD    T7 
          SETMS  IO,RW
          LDC    BFMS 
          RJM    RDS
          MJN    CSB4        IF ERROR 
          LDM    BFMS 
          ZJN    CSB3        IF UNFORMATTED SECTOR
          LCN    2*5-1       INITIALIZE ENTRY OFFSET
          STD    T2 
          LCN    2-1         INITIALIZE WORD COUNT
          STD    T1 
 CSB1     LDN    2*5         ADVANCE ENTRY OFFSET 
          RAD    T2 
          LDN    2           INCREMENT WORD COUNT 
          RAD    T1 
          LDD    T1 
          SBM    BFMS+1 
          PJN    CSB2        IF NO ENTRY FOR THIS MF
          LDM    BFMS+2,T2
          LMD    FN 
          NJN    CSB1        IF ENTRY NOT FOR THIS MF 
          LDM    BFMS+2+1,T2  CLEAR *VALID CHECKPOINT FILE* FLAG
          LPC    3777 
          STM    BFMS+2+1,T2
          LDC    BFMS+WLSF   REWRITE SECTOR 
          RJM    WDS
 CSB2     LJM    CSB3        CLEAR TRACK INTERLOCK
 EJB      SPACE  4,25 
**        EJB - ENTER JOB.
* 
*         ENTRY  (BUFA - BUFA+4) = UJN, ZERO-FILLED.
*                (BA) = FWA OF COMMAND SECTOR.
*                (JS) = JOB SERVICE CLASS.
*                (FN - FN+4) = SUBSYSTEM NAME, SPACE-FILLED.
*                (EJBC) = FILE TYPE AND STATUS, IF FILE TYPE .NE. 
*                         *INQF*. 
*                (EJBE) = SUBSYSTEM ID. 
*                (EJBF - EJBG) = PROCEDURE FILE NAME. 
* 
*         EXIT   (A) = 0  IF JOB ENTERED. 
*                (A) .LT. 0 FOR - QFT FULL / TRACK LIMIT / DISK ERROR.
*                (QA) = QFT ORDINAL.
*                     = 0, IF NO QFT ENTRY WAS ASSIGNED.
*                (FN - FN+4) = FIRST WORD OF QFT ENTRY. 
* 
*         USES   QA, CM - CM+4, FN - FN+4, T1 - T7. 
* 
*         CALLS  CTE, RFI, WDS, WEI, WSS, *0QM*.
* 
*         MACROS ENDMS, EXECUTE, MONITOR, SETMS, SFA. 
* 
*         NOTE THAT THE CONTENTS OF *BUF* STARTING AT *BUFA* WILL BE
*         OVERLAYED BY THE EOI BUFFER AND *0QM* ON EXIT.
  
  
 EJB      SUBR               ENTRY/EXIT 
          LDC    501
          STD    T7 
 EJB1     LDN    0           CLEAR SYSTEM SECTOR BUFFER 
          STM    BFMS,T7
          SOD    T7 
          NJN    EJB1        IF NOT START OF BUFFER 
          STD    QA          INITIALIZE QFT ORDINAL 
          LDN    PDTL        ENTER CREATION DATE
          CRM    CDSS,ON
          ADN    RTCL-PDTL-1 SET ENTRY TIME 
          CRM    IOSS+5*ENTQ+3,ON 
  
*         SET JOB ACCESS LEVEL LIMITS AND ACCESS LEVEL VALIDATION 
*         BITS TO ALL LEVELS VALID FOR THE SYSTEM.  FOR THE 
*         DEADSTART SEQUENCING JOB, SET ALL LEVELS AND VALIDATIONS, 
*         REGARDLESS OF SYSTEM LIMITS.  A NULL CATEGORY SET WILL BE 
*         SET FOR ALL JOBS. 
  
          LDN    ZERL        SET UP *VSAM* FUNCTION 
          CRD    CM 
          ERRNZ  SYOT        CODE DEPENDS ON VALUE
          CRM    IOSS+5*ENTQ+5,ON 
          LDN    7           REQUEST ALL VALID ACCESS LEVELS
          STD    CM+3 
          LDN    VJCS        VALIDATE JOB CREATION PARAMETERS 
          STD    CM+1 
          LDD    MA          SET ALL LEVELS AND VALIDATIONS 
          CWM    EJBL,ON
          SBN    1
          CRM    VASS+5*ASVW,ON 
          MONITOR  VSAM      REQUEST VALID LEVELS AND CATEGORIES
          LDM    EJBE 
          LMC    DSSI 
          ZJN    EJB1.0      IF DEADSTART SEQUENCING JOB
          LDD    MA          SET ONLY VALID LEVELS
          CRM    VASS+5*ASVW,ON 
          LDN    0           CLEAR VALIDATION BITS
          STM    VASS+5*ASVW
  
*         SET JOB ACCESS LEVEL LIMITS INTO QFT. 
  
 EJB1.0   LDD    CM+4        LOWER ACCESS LEVEL LIMIT 
          SHN    3
          LMD    CM+2        INITIAL JOB ACCESS LEVEL 
          SHN    3
          LMD    CM+3        UPPER ACCESS LEVEL LIMIT 
          STM    IOSS+5*INSQ+3
  
*         ASSIGN MASS STORAGE FOR FILE. 
  
          LDN    ZERL 
          CRD    CM 
          LDM    IOSS+5*INSQ+3  GET LOWER ACCESS LEVEL LIMIT
          SHN    -6 
          ADN    40          SET ACCESS LEVEL SELECTION BIT 
          SHN    6
          STD    CM+3 
 EJBF     LDN    TNDS        SELECT TEMPORARY - NONSHARED DEVICE
*         LDN    TSDS        (SELECT SYSTEM DEVICE) 
          STD    CM+2 
          MONITOR  RTCM      REQUEST TRACK CHAIN
          LDD    CM+4 
          STM    IOSS+5*ENTQ+1
          NJN    EJB1.1      IF TRACK ASSIGNED
          LDD    CP          ISSUE B-DISPLAY MESSAGE
          ADK    MS2W 
          CWM    EJBN,TR
          LJM    EJB2.1      SET QUEUED STATUS
  
 EJB1.1   STD    T6 
          LDD    CM+1        SAVE EQUIPMENT 
          STD    T5 
          STM    IOSS+5*ENTQ
          LDC    7777        SET UI=377777
*         LDC    0           (SET BY *ICJ*) 
 EJBA     EQU    *-1
          STD    FN+3 
          LDC    100+37      SET FAMILY ORDINAL=1 
*         LDC    0           (SET BY *ICJ*) 
 EJBB     EQU    *-1
          STD    FN+2 
          LDC    INQF*100+7  SET FILE TYPE AND STATUS 
 EJBC     EQU    *-1
          STD    FN+4 
          LDD    MA 
          CWD    FN 
          CRD    CM+3 
          LDD    JS 
          LMN    SYSC 
          ZJN    EJB2        IF SYSTEM JOB
          LMN    SYSC&DSSC
          ZJN    EJB2        IF DEADSTART SEQUENCING JOB
          LMN    DSSC&SSSC
          ZJN    EJB2        IF SUBSYSTEM 
          LDC    -4000
 EJB2     ADC    4000        SET SYSTEM JOB FLAG
 EJBD     ADC    PQFT        REQUEST QFT ENTRY
*         ADC    10000B+PQFT (DISABLE JSN ACQUISITION)
          RJM    CTE
          NJN    EJB3        IF ENTRY CREATED 
 EJB2.0   LDD    T6          SET TRACK
          STD    CM+2 
          LDD    T5          SET EQUIPMENT
          STD    CM+1 
          MONITOR  DTKM      DROP ALL TRACKS
 EJB2.1   LCN    0           SET JOB NOT QUEUED STATUS
          LJM    EJBX        RETURN 
  
 EJB3     CRD    FN          FIRST WORD OF QFT ENTRY
          CRM    IOSS,ON
          LDM    IOSS+JSNQ*5+4  CLEAN UP STATUS FIELD 
          SCN    17 
          STM    IOSS+JSNQ*5+4
          LDD    CM+1        SAVE QFT ORDINAL 
          STD    QA 
          STM    GQSS 
          LDD    FN          SET JSN
          STM    OJSS 
          LDD    FN+1 
          STM    OJSS+1 
          LDD    JS          SET SERVICE CLASS/JOB ORIGIN TYPE
          SHN    6
          LMK    SYOT 
          STM    IOSS+SCLQ*5
          LCN    0           INDICATE NO JOB COMMAND FL 
          STM    JCSS 
          STM    JESS 
  
*         SET SYSTEM SECTOR FIELDS FOR *SYSTEMX* JOB. 
  
          LDD    MA          SET UN, UI, AND UNLIMITED VALIDATIONS
          CWM    EJBJ,ON
          CWM    EJBM,ON
          SBN    2
          CRM    VASS+ACCN*5,ON 
          CRM    VASS+AHMT*5,ON 
          SBN    1
          CRM    VASS+AHDS*5,ON 
          SBN    1
          CRM    VASS+AAWC*5,ON 
          LDN    IPRL        SET DEFAULT KEYPUNCH MODE
          CRD    CM 
          LDD    CM+2 
          SHN    -13
          STM    JFSS 
          LDC    DFTL        SET DEFAULT TIME LIMIT 
          STM    JTSS+1 
          SHN    -14
          STM    JTSS 
          LDC    0           SET SUBSYSTEM ID 
 EJBE     EQU    *-1         (SUBSYSTEM ID) 
          STM    SISS 
          LDN    3           SET FLAGS
          STM    FGSS 
          LDC    MMFL        SET MACHINE ID 
          CRD    CM 
          LDD    CM 
          STM    RMSS 
          STM    CMSS 
          LDM    EJBA        CHECK IF UI WAS SPECIFIED
          ZJN    EJB5        IF NO UI SPECIFIED 
  
*         SET INFORMATION IN SYSTEM SECTOR TO MATCH QFT 
*         FAMILY ORDINAL AND UI INFORMATION.
  
          LDD    MA          SET CREATION USER NAME 
          CWM    EJBJ,ON
          SBN    1
          CRM    OASS,ON
          SBN    1
          CRM    ACSS,ON
          LDK    FOTP        SET CREATION FAMILY
          CRD    CM 
          LDD    CM 
          SHN    14 
          LMD    CM+1 
          ADN    1
          CRD    CM 
          LDD    CM+3 
          SCN    77 
          STD    CM+3 
          LDN    0
          STD    CM+4 
          LDD    MA          MOVE FAMILY NAME TO SYSTEM SECTOR
          CWD    CM 
          CRM    FOSS,ON
          SBN    1
          CRM    FMSS,ON
 EJB5     LDN    0           SET CREATION JSN 
          SFA    QFT
          CRM    CJSS,ON
          LDD    MA 
          CWM    BUFA,ON
          CWM    EJBH,ON     SET FNT
          LDD    MA 
          CRM    JNSS,ON
          CRM    FNSS,ON
          LDC    2RIN        SET DISPOSITION CODE 
          STM    DCSS 
          LDD    BA 
          ZJN    EJB9        IF NO COMMAND SECTOR 
          AOM    FLSS+1 
          LDC    JNSS        REMOVE *.* FROM UJN
          STD    T1 
          ADN    3
          STD    T2 
 EJB6     LDI    T1 
          LPN    77 
          LMN    1R.
          ZJN    EJB7        IF *.* FOUND 
          LDM    1,T1 
          SHN    -6 
          LMN    1R.
          ZJN    EJB8        IF *.* FOUND 
          AOD    T1 
          LMD    T2 
          NJN    EJB6        IF NOT END OF UJN
 EJB7     LDI    T1 
          SCN    77          REMOVE *.* 
          STI    T1 
          LDN    0
 EJB8     STM    1,T1 
 EJB9     AOM    FLSS+1      SET FILE LENGTH
          LDC    FLSS        GET ADDRESS OF SYSTEM SECTOR FILE LENGTH 
          RJM    RFI         SET FILE SIZE INDEX IN QFT ENTRY 
  
*         WRITE FILE. 
  
          SETMS  IO 
          RJM    WSS         WRITE SYSTEM SECTOR
 EJB9.1   MJP    EJB2.0      IF DISK ERROR
          LDD    BA 
          ZJN    EJB10       IF NO COMMANDS 
          LMC    WCSF 
          RJM    WDS         WRITE COMMAND SECTOR 
 EJB9.2   MJN    EJB9.1      IF DISK ERROR
          AOD    T7          ADVANCE SECTOR 
 EJB10    LDN    QFTE*5-5-1  SAVE QFT ENTRY 
          STD    T2 
 EJB10.1  LDM    IOSS+5,T2
          STM    EJBK,T2
          SOD    T2 
          PJN    EJB10.1     IF MORE TO MOVE
          LDD    MA          SET FNT/FST INFORMATION IN EOI SECTOR
          CWM    FNSS,TR
          SBN    3
          CRM    BUFA+FNEI,TR 
          LDC    501-DTEI-5  CLEAR END OF EOI BUFFER
          STD    T2 
 EJB11    LDN    0
          STM    BUFA+DTEI+5,T2 
          SOD    T2 
          PJN    EJB11       IF MORE TO CLEAR 
          LDC    BUFA        SET EOI BUFFER ADDRESS 
          RJM    WEI         WRITE EOI
          MJN    EJB9.2      IF DISK ERROR
          ENDMS 
          LDD    T5          SET EQUIPMENT
          STD    CM+1 
          LDD    T7          SET LAST SECTOR
          STD    CM+3 
          LDD    T6          SET TRACK
          LPC    3777 
          STD    CM+2 
          MONITOR  DTKM      DROP TRACKS
  
*         QUEUE FILE. 
  
          LDC    2RAB        SET *ABLQ* ACCOUNT FILE MESSAGE
          STM    OVL0-2 
          LDC    2RLQ 
          STM    OVL0-1 
          EXECUTE  0QM,OVL0  ISSUE MESSAGE TO ACCOUNT FILE
          LCN    7           CLEAR ENTRY INTERLOCK
          RAD    FN+4 
          LDN    QFTE-1 
          STD    T2 
          SFA    QFT,QA      SET QFT ADDRESS
          ADN    1           WRITE QFT DATA 
          CWM    EJBK,T2
          SBN    QFTE-JSNQ   WRITE INTERLOCK WORD 
          CWD    FN 
          AOM    IDSB        ADVANCE JOB ENTRY COUNT
          LDK    INQF*100+7  SET DEFAULT FILE TYPE AND STATUS 
          STM    EJBC 
  
*         REINITIALIZE *EJB*. 
  
          LDN    0           CLEAR PARAMETERS 
          STM    EJBE 
          LJM    EJBX        RETURN 
  
  
 EJBH     VFD    42/0LINPUT,6/0,6/INFT,6/0
 EJBK     BSS    QFTE*5-5    BUFFER FOR QFT ENTRY 
 EJBJ     VFD    42/0,18/SYUI 
 EJBL     VFD    12/7777,12/377,36/0
 EJBM     VFD    60/-0
 EJBN     DATA   C* NO INPUT FILE SPACE AVAILABLE.* 
 GAC      SPACE  4,10 
**        GAC - GENERATE ASSIGN COMMAND.
* 
*         ENTRY  (A) = ADDRESS OF STRING *XXX,LOAD)*. 
*                (IR+3) = EST ORDINAL.
* 
*         USES   T3.
* 
*         CALLS  ACS, C2D, CCI. 
  
  
 GAC      SUBR               ENTRY/EXIT 
          STD    T3          SAVE ADDRESS OF FILE NAME
          LDC    =C*ASSIGN(*
          RJM    ACS
          LDD    IR+3        CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3 
          RJM    C2D
          STI    T3 
          LDD    IR+3        CONVERT LOWER DIGIT OF EST ORDINAL 
          LPN    7
          SHN    6
          ADC    2R0, 
          STM    1,T3 
          LDD    T3          COMPLETE COMMAND IMAGE 
          RJM    CCI
          UJN    GACX        RETURN 
 GJC      SPACE  4,10 
**        GJC - GENERATE JOB COMMAND. 
* 
*         ENTRY  (A) = ADDRESS OF LEFT JUSTIFIED NAME.
* 
*         EXIT   (BUFA - BUFA+4) = JOB COMMAND. 
* 
*         USES   T1, T3.
* 
*         CALLS  ACS, CCI.
  
  
 GJC      SUBR               ENTRY/EXIT 
          STD    T3          SAVE JOB COMMAND ADDRESS 
          LDD    CA 
          ADC    477
          STD    T1 
 GJC1     LDN    0           CLEAR COMMAND BUFFER 
          STI    T1 
          SOD    T1 
          LMD    CA 
          NJN    GJC1        IF NOT END OF BUFFER 
          STI    T1 
          LDD    T3          COPY JOB COMMAND TO BUFFER 
          RJM    ACS
          LDC    =C*.*       COMPLETE JOB COMMAND 
          RJM    CCI
          UJN    GJCX        RETURN 
 ISJ      SPACE  4,10 
**        ISJ - INITIATE SUBSYSTEM JOB. 
* 
*         ENTRY  (A) = SUBSYSTEM ID.
*                (TN) = ADDRESS OF SUBSYSTEM TABLE ENTRY. 
* 
*         EXIT   (A) = 0, IF SUBSYSTEM INITIATED. 
* 
*         USES   BA, JS, FN - FN+4. 
* 
*         CALLS  AST, EJB.
  
  
 ISJ      SUBR               ENTRY/EXIT 
          STM    EJBE        SET SUBSYSTEM ID 
          LMC    DSSI 
          ZJN    ISJ0        IF DEADSTART SEQUENCING JOB
          LMC    FEAF*10000&DSSI  FETCH *SSAT* ENTRY
          RJM    AST
          NJN    ISJX        IF SUBSYSTEM ACTIVE
 ISJ0     STD    BA 
          LDN    ZERL        ZERO FILL BUFFER 
          CRM    BUFA,ON
          LDI    TN          SET JSN AND UJN = SUBSYSTEM NAME 
          STD    FN 
          STM    BUFA 
          LDM    1,TN 
          SCN    77 
          STM    BUFA+1 
          LMN    1R          SPACE-FILL JSN 
          STD    FN+1 
          LDC    ADCI+1      DISABLE JSN ACQUISITION
          STM    EJBD 
 ISJA     LDN    SSSC        SET SERVICE CLASS
*         LDN    DSSC        (DEADSTART SEQUENCING JOB) 
          STD    JS 
          LDM    4,TN        SET FILE TYPE AND STATUS 
          ZJN    ISJ1        IF NOT SPECIFIED 
          STM    EJBC 
 ISJ1     LDM    1,TN 
          SHN    21-5 
          MJP    ISJ2        IF PP-INITIATED SUBSYSTEM
  
*         FOR NON-PP-INITIATED SUBSYSTEMS, GENERATE A JOB INPUT FILE
*         WITH THE FOLLOWING FORMAT - 
*                SUBPROC. 
*                GET,SUBPROC/NA.
*                SUBPROC. 
  
          LDC    BUF         INDICATE COMMAND RECORD PRESENT
          STD    BA 
          LDN    ZERL        BUILD SUBSYSTEM PROCEDURE FILE NAME
          CRD    AB 
          LDI    TN          SUBSYSTEM NAME 
          STD    AB 
          LDM    1,TN 
          SCN    77 
          SHN    6
          LMC    **          (FIRST BYTE OF PROCEDURE NAME SUFFIX)
 ISJB     EQU    *-1
          SHN    -6+22
          STD    AB+1 
          LPC    770000 
          LMC    **          (SECOND BYTE OF PROCEDURE NAME SUFFIX) 
 ISJC     EQU    *-1
          SHN    -6+22
          STD    AB+2 
          SHN    -6 
          SCN    77 
          STD    AB+3 
          LDN    AB          GENERATE JOB COMMAND 
          RJM    GJC
          LDC    =C*GET,*    GENERATE *GET,SUBPROC/NA.* 
          RJM    ACS
          LDN    AB 
          RJM    ACS
          LDC    =C*/NA.* 
          RJM    CCI
          LDN    AB          GENERATE NAME CALL TO PROCEDURE
          RJM    ACS
          LDC    =C*.*
          RJM    CCI
          LDN    0           CLEAR SUFFIX FOR NEXT CALL 
          STM    ISJB 
          STM    ISJC 
 ISJ2     RJM    EJB         ENTER JOB
          LJM    ISJX        RETURN 
 SJF      SPACE  4,10 
**        SJF - SET JOB FIELD LENGTH. 
* 
*         ENTRY  (AB - AB+4) = ENTRY POINT NAME.
* 
*         EXIT   (JF) = FIELD LENGTH. 
* 
*         USES   JF, CM - CM+4. 
* 
*         CALLS  CLD. 
  
  
 SJF1     LDC    DFFL/100    SET DEFAULT FIELD LENGTH 
 SJF2     STD    JF 
  
 SJF      SUBR               ENTRY/EXIT 
          RJM    CLD         SEARCH FOR PROGRAM 
          CRD    CM 
          LDD    CM          CHECK FOR MFL=/RFL= ENTRY POINT
          ZJN    SJF1        IF NO FILE LENGTH SPECIFIED
          STD    JF 
          SHN    6
          PJN    SJFX        IF NOT MFL= ENTRY POINT
          SHN    2
          SHN    -8D
          UJN    SJF2        SET FIELD LENGTH 
 SSC      SPACE  4,10 
**        SSC - SET SERVICE CLASS.
* 
*         ENTRY  (AB - AB+1) = COMMAND. 
* 
*         EXIT   (JS) = *MASC* IF MAINTENANCE JOB.
*                     = *SYSC* IF NOT MAINTENANCE JOB.
* 
*         USES   JC, TN.
  
  
 SSC2     LMD    AB          FIND COMMAND 
          NJN    SSC3        IF NO MATCH
          LDM    1,JC 
          LMD    AB+1 
          ZJN    SSC5        IF MAINTENANCE JOB 
 SSC3     LDN    2           ADVANCE TABLE ADDRESS
          RAD    JC 
 SSC4     LDI    JC 
          NJN    SSC2        IF NOT END OF TABLE
          AOD    TN          ADVANCE LIST ADDRESS 
          LMN    ITJAL
          NJN    SSC1        IF NOT END OF TABLES 
          LDN    SYSC&MASC
 SSC5     LMN    MASC        SET SERVICE CLASS
          STD    JS 
  
 SSC      SUBR               ENTRY/EXIT 
          LDN    0
          STD    TN 
 SSC1     LDM    ITJA,TN     SET TABLE ADDRESS
          STD    JC 
          UJN    SSC4        ENTER LOOP 
          TITLE  REQUEST PROCESSORS.
 ICJ      SPACE  4,10 
***       FUNCTION ICJF - INITIATE COMMAND JOB. 
* 
*         ENTRY  (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/. 
*                (IJCA) = FIELD LENGTH SPECIFIED BY CALLER (*IJCF*
*                         FUNCTION ONLY.  ZERO, OTHERWISE.) 
  
  
 ICJ      ENTRY              ENTRY/EXIT 
          LDC    BFMS        GET COMMAND
          RJM    RPK
          LDC    /1DS/DSDL+/1DS/KBCML  GET SPECIAL PARAMETER
          CRD    AB 
          LDN    0
          STM    BFMS+/1DS/KBCML/2*5
          RJM    SJF         SET JOB FIELD LENGTH 
          LDM    IJCA 
          ZJN    ICJ1        IF NO FIELD LENGTH SPECIFIED 
          STD    JF 
 ICJ1     LDD    JF          CONVERT INITIAL RFL
          SHN    -6 
          RJM    C2D
          STM    ICJH+2 
          LDD    JF 
          RJM    C2D
          STM    ICJH+3 
          LDN    AB          GENERATE JOB COMMAND 
          RJM    GJC
          LDC    ICJF 
          RJM    CCI         CREATE COMMAND IMAGE 
          LDC    TSJN 
          STD    T3 
          UJN    ICJ3        CHECK SPECIAL JOB NAME 
  
 ICJ2     LDI    T3          ADVANCE TO NEXT ENTRY
          ADN    1
          RAD    T3 
          STM    ICJA 
 ICJ3     LDI    T3          SET ENTRY LENGTH 
          ZJN    ICJ5        IF END OF TABLE
          STD    T2 
 ICJ4     LDM    TSJN,T2     COMPARE JOB NAMES
 ICJA     EQU    *-1
          LMM    AB-1,T2
          NJN    ICJ2        IF NO COMPARE
          SOD    T2 
          NJN    ICJ4        IF NOT END OF NAME 
          STM    EJBA 
          STM    EJBB 
          LCN    ICJGL
 ICJ5     ADN    ICJGL+1     ADJUST POINTER FOR NEXT COMMAND
          RAD    LA 
 ICJ6     LDD    LA          CREATE COMMAND IMAGE 
          RJM    CCI
          AOD    LA          ADVANCE COMMAND POINTER
          LDI    LA 
          NJN    ICJ6        IF NOT END OF COMMAND STREAM 
          LDC    BFMS        COPY COMMAND (OR JOB COMMAND)
*         LDC    BUFA        (INITIATE JOB CALL)
 ICJB     EQU    *-1
          RJM    CCI
          RJM    SSC         SET SERVICE CLASS
          LDC    UJSI        SET *SISS* FIELD 
*         LDC    IRSI        (SET INHIBIT ROLLOUT ID) 
 ICJC     EQU    *-1
          STM    EJBE 
          LDC    INQF*100+7  GENERATE OUTPUT
*         LDC    NOQF*100+7  (DO NOT GENERATE OUTPUT) 
 ICJD     EQU    *-1
          STM    EJBC 
          RJM    EJB         ENTER JOB
          LJM    ICJX        RETURN 
  
  
 ICJF     DATA   Z*MODE(0)* 
*         DATA   Z*MODE(1)*  (CYBER 176)
 ICJG     DATA   Z*SUI(0)*
 ICJGL    EQU    *-ICJG 
          DATA   Z*RETURN(INPUT)* 
          DATA   Z*NORERUN.*
 ICJH     DATA   Z*RFL(XXXX00)* 
          CON    0           END OF COMMANDS
 TSJN     SPACE  4,10 
**        TSJN - TABLE OF SPECIAL JOB NAMES.
* 
*         JOBS LISTED IN THIS TABLE WILL HAVE A *SUI(0)*
*         COMMAND INCLUDED IN THEIR JOB STREAM. 
* 
*         12/ L, 12*L/ NAME 
*                L = LENGTH OF JOB NAME IN PP WORDS.
*                NAME = JOB NAME TO COMPARE.
  
  
 TSJN     BSS    0
          VFD    12/2,24/0LDDF
          VFD    12/2,24/0LDIS
          VFD    12/2,24/0LO26
          VFD    12/0        END OF TABLE 
 ISC      SPACE  4,10 
***       FUNCTION ISCF - INITIATE SYSTEM COMMAND JOB.
* 
*         ENTRY  (IR+4) = 6/ KEYBOARD BUFFER OFFSET, 6/.
* 
*         NOTE   FLAGS SET IN ROUTINE *ICJ* TO SET
*                *SISS* FIELD IN THE SYSTEM SECTOR AND
*                TO NOT DISPOSE OUTPUT AT END OF JOB TIME.
  
  
 ISC      ENTRY              ENTRY/EXIT 
          LDN    IRSI        SET INHIBIT ROLLOUT IN *SISS*
          STM    ICJC 
          LDC    NOQF*100+7  SET NO OUTPUT
          STM    ICJD 
          RJM    ICJ         INITIATE COMMAND JOB 
          UJN    ISCX        RETURN 
 ITJ      SPACE  4,10 
***       FUNCTION ITJF.
* 
*         INITIATE JOBS FROM TABLE. 
*         INITIATE ALL ENABLED SUB-SYSTEMS. 
  
  
*         CALCULATE NEXT TABLE NUMBER FROM CPU TYPE.
  
 ITJ8     LDD    FG          CALCULATE NEXT TABLE NUMBER
          SHN    0-4
          LPN    1           ZERO IF INSTRUCTION STACK PRESENT
          STD    T1 
          LDD    FG 
          SHN    1-6
          LPN    2           ZERO IF CYBER 170 MAINFRAME
          RAD    T1 
          LDN    4
          SBD    T1 
          UJN    ITJ11       CONTINUE PROCESSING
  
*         CHECK FOR 6700 OR CYBER 74-2X MAINFRAME TYPE. 
  
 ITJ9     LDD    FG          CHECK DUAL CPU BIT 
          LPN    2
          NJN    ITJ13       IF NOT DUAL CPU
          LDN    1           SET TABLE 1
          UJN    ITJ1        PROCESS TABLE 1 JOBS 
  
*         CHECK FOR CMU.
  
 ITJ10    LDD    FG          CHECK CMU BIT
          SHN    21-3 
          MJN    ITJ13       IF NO CMU
          LDN    5           SET TABLE 5
 ITJ11    UJN    ITJ1        PROCESS TABLE
  
*         CHECK IF ALL TABLES PROCESSED.
  
 ITJ12    LDD    TN          CHECK CURRENT TABLE NUMBER 
          ZJN    ITJ8        IF TABLE 0 
          LMN    2
          ZJN    ITJ9        IF TABLE 2 
          LMN    5&2
          NJN    ITJ10       IF NOT TABLE 5 
 ITJ13    RJM    IAS         INITIATE ALL ENABLED SUBSYSTEMS
  
 ITJ      ENTRY              ENTRY/EXIT 
          LDD    FG 
          SHN    -6 
          LPN    71 
          ZJN    ITJ0        IF CYBER 170-865/875 
          LMN    70 
          ZJN    ITJ0.1      IF CYBER 176 
          SHN    -5 
          ZJN    ITJ1        IF NOT CYBER 170-815/825/835/855 
          LDN    0           SPIN UP ISMD DEVICES 
          RJM    SUD
          LDN    7&10        SET TABLE FOR CYBER 170-815/825/835/855
 ITJ0     LMN    10&6        SET TABLE FOR CYBER 170-865/875
 ITJ0.1   LMN    6           SET TABLE FOR CYBER 176
 ITJ1     STD    TN          SET TABLE NUMBER 
          LDM    ITJA,TN     SET JOB TABLE ADDRESS
          STD    JC 
          LDN    0           CLEAR SECOND PASS FLAG 
          STM    ITJD 
 ITJ2     LDN    ZERL 
          CRD    AB 
          LDI    JC          SET JOB NAME 
          NJN    ITJ2.2      IF NOT END OF TABLE
          LDC    *
 ITJC     EQU    *-1
 ITJ2.1   NJP    ITJ12       IF NOT A DUAL CPU MACHINE
          LDC    ** 
 ITJD     EQU    *-1
          NJN    ITJ2.1      IF END OF SECOND PASS
          AOM    ITJD        FLAG SECOND PASS 
          LDM    ITJA,TN     RESET TABLE POINTER
          STD    JC 
          LDI    JC 
 ITJ2.2   STD    AB 
          LDM    1,JC 
          STD    AB+1 
          RJM    SJF         SET JOB FIELD LENGTH 
          LDN    AB          GENERATE JOB COMMAND 
          RJM    GJC
          LDC    ICJF 
          RJM    CCI         CREATE COMMAND IMAGE 
  
*         ISSUE USECPU COMMAND IF ON 6700 OR CYBER 74-2X. 
  
          LDD    FG          CHECK DUAL AND STACK CPU BITS
          LPC    4122 
          LMC    4100        PREVENT SELECTION FOR CYBER 170 AND 8X5
          NJN    ITJ2.4      IF NOT DUAL AND STACK CPU ON 6000 OR C70 
          LDD    TN          CHECK TABLE NUMBER 
          ZJN    ITJ5        IF TABLE 0 
          LMN    1
          ZJN    ITJ3        IF TABLE 1 
 ITJ2.3   LDC    =C*USECPU(1)*  CPU0
          UJN    ITJ4        CREATE COMMAND IMAGE 
  
 ITJ2.4   LDD    FG 
          LPN    2
          STM    ITJC 
          NJN    ITJ5        IF NOT A DUAL CPU MACHINE
          LDM    ITJD 
          NJN    ITJ3        IF PASS 2
          UJN    ITJ2.3      CREATE COMMAND IMAGE 
  
 ITJ3     LDC    =C*USECPU(2)* CPU1 
 ITJ4     RJM    CCI         CREATE COMMAND IMAGE 
 ITJ5     LDD    TN 
          LMN    6
          NJN    ITJ6        IF NOT CYBER 176 STACK 
          LDC    TSBJA
          LMD    JC 
          NJN    ITJ6        IF NOT JOB *LCM* 
          LDC    =C*RFL,EC=10.* 
          RJM    CCI         CREATE COMMAND IMAGE 
 ITJ6     LDD    CA 
          RJM    CCI         CREATE COMMAND IMAGE 
          LDC    =C*EXIT.*
          RJM    CCI         CREATE COMMAND IMAGE 
          LDC    =C*DMP.* 
          RJM    CCI         CREATE COMMAND IMAGE 
          LDD    JF          CONVERT FIELD LENGTH 
          SHN    -6 
          RJM    C2D
          STM    ITJB+2 
          LDD    JF 
          RJM    C2D
          STM    ITJB+3 
          LDC    ITJB 
          RJM    CCI         CREATE COMMAND IMAGE 
          LDC    =C*IFE(EF.EQ.ODE,NOLIST)*
          RJM    CCI         CREATE COMMAND IMAGE 
          LDC    =C*RETURN(OUTPUT)* 
          RJM    CCI         CREATE COMMAND IMAGE 
          LDC    =C*ENDIF(NOLIST)*
          RJM    CCI         CREATE COMMAND IMAGE 
          LDN    MASC        SET SERVICE CLASS
          STD    JS 
          RJM    EJB         ENTER JOB
          PJN    ITJ7        IF JOB QUEUED
          LJM    ITJ13       ENABLE JOB SCHEDULING
  
 ITJ7     LDN    2           ADVANCE JOB COUNTER
          RAD    JC 
          LJM    ITJ2        LOOP 
  
  
 ITJA     BSS    0
          LOC    0
          CON    TCMJ        COMMON MAINTENANCE JOBS
          CON    TNSJ        CYBER 70 NO STACK MAINTENANCE JOBS 
          CON    TSSJ        CYBER 70 WITH STACK MAINTENANCE JOBS 
          CON    TNOJ        CYBER 170 NO STACK MAINTENANCE JOBS
          CON    TSOJ        CYBER 170 WITH STACK MAINTENANCE JOBS
          CON    TMUJ        MAINFRAMES WITH CMU MAINTENANCE JOBS 
          CON    TSBJ        CYBER 176 MAINTENANCE JOBS 
          CON    TSAJ        CYBER 170-815/825/835/855 MAINTENANCE JOBS 
          CON    TSCJ        CYBER 170-865/875 MAINTENANCE JOBS 
 ITJAL    BSS    0           LENGTH OF LIST 
          LOC    *O 
  
 ITJB     DATA   C*DMP(XXXX00)* 
 TCMJ     SPACE  4,10 
**        JOB TABLE 0.
*         COMMON MAINTENANCE JOBS.
*         JOBS RUN ON ALL MAINFRAME TYPES.
  
  
 TCMJ     BSS    0
          VFD    24/0LALX 
          VFD    24/0LCU1 
          VFD    24/0LFST 
          DATA   0
 TNSJ     SPACE  4,10 
**        JOB TABLE 1.
* 
*         NO STACK CYBER 70 MAINTENANCE JOBS. 
*         JOBS RUN ON MAINFRAME TYPES 6400, 6500, CYBER 72, CYBER 
*         73, CPU1 OF 6700 AND CPU1 OF CYBER 74-2X. 
* 
*         NOTE   JOB TABLE 1 STARTS IN THE
*                MIDDLE OF JOB TABLE 2. 
 TSSJ     SPACE  4,10 
**        JOB TABLE 2.
* 
*         WITH STACK CYBER 70 MAINTENANCE JOBS. 
*         JOBS RUN ON MAINFRAME TYPES 6600, CYBER 74-1X, CPU0 OF
*         6700 AND CPU0 OF CYBER 74-2X. 
  
  
 TSSJ     BSS    0
          VFD    24/0LFM2 
          VFD    24/0LIWS 
 TNSJ     BSS    0           START OF JOB TABLE 1 
          VFD    24/0LCT3 
          VFD    24/0LMRG 
          VFD    24/0LMY1 
          VFD    24/0LRAN 
          DATA   0
 TNOJ     SPACE  4,10 
**        JOB TABLE 3.
* 
*         NO STACK CYBER 170 MAINTENANCE JOBS.
*         JOBS RUN ON MAINFRAME TYPES CYBER 172, 173 AND 174. 
  
  
 TNOJ     BSS    0
          VFD    24/0LCSU 
          VFD    24/0LCT3 
          VFD    24/0LMRG 
          VFD    24/0LRAN 
          DATA   0
 TSOJ     SPACE  4,10 
**        JOB TABLE 4.
* 
*         WITH STACK CYBER 170 MAINTENANCE JOBS.
*         JOBS RUN ON MAINFRAME TYPE CYBER 175. 
  
  
 TSOJ     BSS    0
          VFD    24/0LCSU 
          VFD    24/0LCT7 
          VFD    24/0LRAN 
          DATA   0
 TMUJ     SPACE  4,10 
**        JOB TABLE 5.
* 
*         JOBS RUN ON MAINFRAMES WITH CMU.
  
  
 TMUJ     BSS    0
          VFD    24/0LCMU 
          DATA   0
 TSBJ     SPACE  4,10 
**        JOB TABLE 6.
* 
*         CYBER 176 MAINTENANCE JOBS. 
  
  
 TSBJ     BSS    0
          VFD    24/0LRAN 
          VFD    24/0LFST 
          VFD    24/0LCTB 
 TSBJA    VFD    24/0LLCM 
          VFD    24/0LMEM 
          DATA   0
 TSAJ     SPACE  4,10 
**        JOB TABLE 7.
* 
* 
*         CYBER 170 - 815/825/835/855 MAINTENANCE JOBS. 
  
  
 TSAJ     VFD    24/0LALX 
          VFD    24/0LCSU 
          VFD    24/0LCT8 
          VFD    24/0LCU8 
          VFD    24/0LFS8 
          VFD    24/0LMRG 
          VFD    24/0LRA8 
          DATA   0
 TSCJ     SPACE  4,10 
**        JOB TABLE 8.
* 
*         CYBER 170 - 865/875 MAINTENANCE JOBS. 
  
  
 TSCJ     VFD    24/0LALX 
          VFD    24/0LCSU 
          VFD    24/0LCT6 
          VFD    24/0LCU8 
          VFD    24/0LFS8 
          VFD    24/0LRA8 
          DATA   0
 IJC      SPACE  4,10 
***       FUNCTION IJCF - INITIATE JOB CALL.
* 
*         ENTRY  (IR+3) = FIELD LENGTH, IF SPECIFIED BY CALLER. 
*                       = 0, OTHERWISE. 
*                (IR+4) = 6/ KEYBOARD BUFFER OFFSET, 6/.
  
  
 IJC      ENTRY              ENTRY/EXIT 
          LDC    BUFA        SET JOB COMMAND ADDRESS
          STM    ICJB 
          LDD    IR+3        SAVE FIELD LENGTH
          STM    IJCA 
          RJM    ICJ
          UJN    IJCX        RETURN 
  
 IJCA     CON    0           FIELD LENGTH SPECIFIED BY CALLER 
 ILJ      SPACE  4,10 
***       FUNCTION ILJF - INITIATE *LBC* JOB. 
* 
*         CALLED BY *6DI* AND *1DS* FUNCTIONS *UPCF* AND *OCMF* TO
*         INITIATE SYSTEM JOB TO RELOAD CONTROLWARE.
* 
*         ENTRY  (IR+4) = 1/,2/F,9/EQ.
*                         F    0 IF NO RECALL OF CALLER REQUIRED. 
*                              1 IF *UPCF* *1DS* FUNCTION TO BE 
*                                RECALLED.
*                              2 IF *OCMF* *1DS* FUNCTION TO BE 
*                                RECALLED.
*                         EQ   INDICATES CONTROL MODULE RELOAD IF VALUE 
*                              IS EITHER 1 OR A CONTROL MODULE EST
*                              ORDINAL. 
  
  
 ILJ      ENTRY              ENTRY/EXIT 
          LDC    =Z*LBC*
          RJM    GJC         GENERATE JOB COMMAND 
          LDD    IR+4 
          SHN    0-11 
          LPN    3
          STD    MS 
          SHN    14 
          NJN    ILJ2        IF NOT *6DI* CALL
          LDD    IR+4 
          LPC    777
          STD    CM 
          SBN    1
          MJN    ILJ1        IF NOT CONTROL MODULE
          ZJN    ILJ2        IF CONTROL MODULE
          SFA    EST,CM 
          ADK    EQDE 
          CRD    CM 
          LDD    CM+3 
          LMC    2RCM 
          ZJN    ILJ2        IF CONTROL MODULE
 ILJ1     LDC    ILJA&ILJB
 ILJ2     LMC    ILJB 
          STD    LA 
 ILJ3     LDD    LA          COMPLETE COMMAND IMAGE 
          RJM    CCI
          AOD    LA          ADVANCE COMMAND POINTER
          LDI    LA 
          NJN    ILJ3        IF NOT END OF COMMAND STREAM 
          LDN    SYSC        SET SYSTEM SERVICE CLASS 
          STD    JS 
          LCN    TNDS-TSDS   SELECT SYSTEM DEVICE FOR JOB FILE
          RAM    EJBF 
          RJM    EJB         ENTER JOB
          LDD    MS 
          ZJN    ILJ4        IF NO *1DS* CALL REQUIRED
          LDM    IDSC        SET FUNCTION CODE
          SCN    77          PRESERVE BUFFER LOCK/LOGGING CONTROL BITS
          LMM    ILJC-1,MS
          STD    IR+2 
          LDN    0           DISABLE LOGGING/INTERLOCK CLEARING 
          STM    IDSC 
          LDD    IR+4 
          LPC    -3000
          STD    IR+4 
          LDD    IA          REWRITE PP INPUT REGISTER
          CWD    IR 
          AOM    IDSE        SET *NO DROP* FLAG 
          EXECUTE  1DS,=
 ILJ4     LJM    ILJX        RECALL *1DS* FUNCTION
  
  
 ILJA     DATA   Z*LOADBC,D=DUMP.*
  
*         THE FOLLOWING COMMANDS SHOULD BE ACTIVATED IF THE NEED EVER 
*         ARISES AGAIN TO DUMP THE MEMORY OF A FAILING CONTROLLER.
*         THE DUMP CAPABILITY WAS ADDED TO DETERMINE WHY 7155 
*         CONTROLLERS WERE FAILING.  SINCE THE CAUSE OF THIS PROBLEM
*         IS NOW UNDERSTOOD, THERE IS NO LONGER A NEED TO DUMP
*         CONTROLLERS DURING THE RELOAD PROCESS.
  
*         DATA   Z*DSDI,DMB,Z.+BCDUMP/V.* 
*         DATA   Z*ATTACH,LBCDUMP/M=W,NA.*
*         DATA   Z*IF,.NOT.FILE(LBCDUMP,PM).DEFINE,LBCDUMP.*
*         DATA   Z*SKIPEI,LBCDUMP.* 
*         DATA   Z*REWIND,DUMP.*
*         DATA   Z*COPY,DUMP,LBCDUMP.*
  
          CON    0           END OF STATEMENTS
  
  
 ILJB     DATA   Z*LOADBC.* 
          CON    0           END OF STATEMENTS
  
  
 ILJC     CON    /1DS/UPCF
          CON    /1DS/OCMF
 DSP      SPACE  4,10 
***       FUNCTION DSPF - INITIATE *L* DISPLAY JOB. 
* 
*         ENTRY  (IR+4) = 6/ KEYBOARD BUFFER OFFSET, 6/.
  
  
 DSP      ENTRY              ENTRY/EXIT 
          LDC    LDSP        GET *L* DISPLAY CONTROL WORD 
          CRD    CM+1 
          LDN    0
          STD    CM+2 
          LDN    2           SET WORD COUNT OF OPTIONS TO PROCESS 
          STD    CM+1 
          LDD    MA 
          CWM    DSPA,CM+1
          MONITOR  UTEM      INTERLOCK JSN FIELD IF .EQ. 0
          LDD    CM+1 
          NJP    DSP2        IF VERIFICATION FALIED, RETURN ERROR 
          LDC    NOQF*100+7  DO NOT GENERATE OUTPUT 
          STM    ICJD 
          RJM    ICJ         INITIATE COMMAND JOB 
          SHN    -21         SAVE REPLY 
          STD    T1 
          ZJN    DSP1        IF *L* DISPLAY JOB SUBMITTED 
          LDN    0           CLEAR JSN
          STD    FN 
          STD    FN+1 
 DSP1     LDC    LDSP        *L* DISPLAY POINTER
          CRD    CM+1 
          LDN    0
          STD    CM+2 
          LDN    2
          STD    CM+1        STORE WORD COUNT OF OPTIONS
          LDD    FN          SET JSN
          STM    DSPB+1*5+3 
          LDD    FN+1 
          STM    DSPB+1*5+4  STORE *JSN*
          LDD    MA 
          CWM    DSPB,CM+1
          MONITOR  UTEM      STORE *JSN* IN FWA *L* BUFFER ZERO FILLED
          LDD    T1          SET DSD RESPONSE 
 DSP2     RJM    SRD
          LJM    DSPX        EXIT 
  
  
*         *UTEM* MONITOR FUNCTION BUFFER. 
  
 DSPA     VFD    1/1,5/0,6/24D,6/36D,42/0   VERIFY *JSN* .EQ. 0 
          VFD    1/0,5/0,6/24D,6/36D,42/-1  INTERLOCK JSN FIELD 
  
 DSPB     VFD    1/0,5/0,6/36D,6/0,6/0   CLEAR CONTROL WORD STATUS BITS 
          CON    0,0,0
          VFD    1/0,5/0,6/24D,6/36D,6/0  STORE *JSN* 
          CON    0,0,0
 DSS      SPACE  4,10 
***       FUNCTION DSSF - INITIATE DEADSTART SEQUENCING JOB.
* 
*         ENTRY  (IR+3 - IR+4) = 18/*CMS*, 6/0. 
  
  
 DSS      ENTRY              ENTRY/EXIT 
          LDN    DSSC-SSSC   CHANGE SERVICE CLASS 
          RAM    ISJA 
          LDK    DSSI        CHANGE SUBSYSTEM ID
          STM    IAS.CMS+2
 DSS1     RJM    ISS         INITIATE SUBSYSTEM 
          PJN    DSSX        IF JOB QUEUED SUCCESSFULLY 
          LDK    ZERL 
          CRD    CM 
          LDD    QA          SET QFT ORDINAL
          ZJN    DSS2        IF NO ENTRY WAS ASSIGNED 
          STD    CM+1 
          LDN    PQFT 
          STD    CM+2 
          MONITOR  MTRM      RETURN QFT ENTRY 
 DSS2     SOM    DSSA 
          NJN    DSS1        IF RETRY COUNT NOT EXCEEDED
          LDK    NCPL        GET SYSTEM CONTROL POINT 
          CRD    CM 
          AOD    CM+1        ISSUE MESSAGE TO SYSTEM CONTROL POINT
          SHN    7
          ADN    MS2W 
          CWM    DSSB,TR
          LJM    DSSX        RETURN 
  
  
 DSSA     CON    5           SUBSYSTEM INITIATION RETRY COUNT 
 DSSB     DATA   C*DEADSTART SEQUENCING FAILED.*
 LOD      SPACE  4,10 
***       FUNCTION LODF - LOAD JOB. 
* 
*         ENTRY  (IR+3) = EST ORDINAL.
*                (IR+4) = ID. 
  
  
 LOD      ENTRY              ENTRY/EXIT 
          LDC    =C*LOAD* 
          RJM    GJC         GENERATE JOB COMMAND 
          LDD    IR+3 
          ZJN    LOD1        IF NO EST ORDINAL SPECIFIED
          LDC    =C*XXX,LOAD)*
          RJM    GAC
 LOD1     LDD    IR+4 
          ZJN    LOD2        IF NO ID 
          RJM    C2D         ENTER ID 
          SHN    6
          LMN    1R.
          STM    LODA+3 
          SHN    -14
          SBN    1R.
          RAM    LODA+2 
 LOD2     LDC    LODA 
          RJM    CCI
          LDN    SYSC        SET SERVICE CLASS
          STD    JS 
          RJM    EJB         ENTER JOB
          LJM    LODX        RETURN 
  
  
 LODA     VFD    60/6LLDI,,.
 IRM      SPACE  4,10 
**        IRM - INITIATE REMOTE MAINTENANCE FACILITY. 
* 
*         EXIT   RDF INITIATED. 
* 
*         USES   TN, T6, AB - AB+4, CM - CM+4, CN - CN+4. 
* 
*         CALLS  AST, ISJ.
* 
*         MACROS DELAY, MONITOR, PAUSE. 
  
  
 IRM3     LDD    MA          MAKE *IAF*REQUEST* 
          CWM    IRMB,ON
 IRM4     LDK    ZERL 
          CRD    CM 
          MONITOR  TSEM 
          LDD    CM+1 
          ZJN    IRMX        IF *IAF* INACCESSIBLE OR ERROR 
          LMC    7777 
          NJN    IRMX        IF REQUEST COMPLETE
          PAUSE  ST 
          LDC    3600        *TSEM* QUEUE FULL - DELAY AND RETRY
          STD    T6 
 IRM5     DELAY 
          SOD    T6 
          ZJN    IRM4        IF TIME TO REISSUE REQUEST 
          UJN    IRM5        CONTINUE TO DELAY
  
 IRM      SUBR               ENTRY/EXIT 
          LDD    TN          SAVE CURRENT ID
          STM    IRMC 
          LDM    IRMD 
          NJN    IRMX        IF AUTO SELECTED *IAF* 
          LDC    IAS.IAF     GET ADDRESS OF *IAF* SUBSYSTEM ENTRY 
          STD    TN 
          LDM    2,TN        CHECK SUBSYSTEM ACTIVE 
          LMC    FEAF*10000  FETCH *SSAT* ENTRY 
          RJM    AST
          NJP    IRM3        IF ACTIVE
          LDK    SSSL        CHECK IF *IAF* IS ENABLED
          CRD    CN 
          LDM    3,TN 
          STM    IRMA 
          LDM    1,TN 
          LPN    17 
          ADN    CN 
          STD    T6 
          LDI    T6          CHECK SUBSYSTEM
          LPC    0
 IRMA     EQU    *-1
          ZJN    IRM1        IF *IAF* ENABLED 
          LDC    IAS.RDF     CHECK IF *RDF* IS ACTIVE 
          STD    TN 
          LDM    2,TN 
          LMC    FEAF*10000 
          RJM    AST
          NJN    IRM2        IF *RDF* ACTIVE
 IRM1     LDM    2,TN 
          RJM    ISJ         INITIATE *RDF* OR *IAF*
 IRM2     LDM    IRMC        RESTORE CURRENT ID 
          STD    TN 
          LJM    IRMX        RETURN 
  
  
*         BUFFER FOR *TSEM* MONITOR CALL TO LOAD *RDF* DRIVER.
  
 IRMB     CON    /REM/VITP
          CON    0
          CON    0
          CON    0
          CON    0
 IRMC     CON    0           CURRENT ID 
 IRMD     CON    0           IAF AUTO FLAG
  
 ISS      SPACE  4,10 
***       FUNCTION ISSF - INITIATE SPECIFIED SUB-SYSTEM.
* 
*         ENTRY  (IR+3 - IR+4) = 18/NAME, 6/0, IF NOT *DSD* CALL. 
*                (IR+3) = 0, IF *DSD* CALL. 
*                (KBCML) = 18/NAME, 6/0, 24/PFC, 12/0, IF *DSD* CALL. 
*                          NAME = 3-CHARACTER SUBSYSTEM NAME. 
*                          PFC = PROCEDURE FILE NAME. 
* 
*         EXIT   (A) = 0, IF SUBSYSTEM INITIATED. 
  
  
 ISS      ENTRY              ENTRY/EXIT 
          LDD    IR+3 
          NJN    ISS1        IF NOT *DSD* CALL
          LDC    /1DS/DSDL+/1DS/KBCML  GET SPECIAL PARAMETER WORD 
          CRD    AB 
          LDD    AB+2        SET PROCEDURE FILE NAME
          STM    ISJB 
          LDD    AB+3 
          STM    ISJC 
          UJN    ISS2        GET SUBSYSTEM ID 
  
 ISS1     STD    AB          SET SUBSYSTEM NAME 
          LDD    IR+4 
          STD    AB+1 
 ISS2     LDC    IASB        FIND SUBSYSTEM ID
          STD    TN 
 ISS3     LDI    TN 
          LMD    AB 
          NJN    ISS4        IF NO MATCH
          LDM    1,TN 
          SCN    77 
          LMD    AB+1 
          ZJN    ISS5        IF MATCH 
 ISS4     LDN    IASBE       GET NEXT TABLE ENTRY 
          RAD    TN 
          LMC    IASBL
          NJN    ISS3        IF NOT END OF TABLE
          LDN    1           SET ERROR STATUS 
          LJM    ISSX        RETURN 
  
 ISS5     LDD    TN 
          LMC    IAS.RDF
          NJN    ISS6        IF NOT *RDF* 
          RJM    IRM         INITIATE *RDF* 
          UJN    ISS7        RETURN 
  
 ISS6     LDM    2,TN 
          RJM    ISJ
 ISS7     LJM    ISSX        RETURN 
 IAS      SPACE  4,10 
***       FUNCTION IASD - INITIATE ALL ENABLED SUB-SYSTEMS. 
  
  
 IAS5     RJM    CCF         CLEAR CHECKPOINT FLAGS 
          LDN    1
          STD    CM+1        SET NUMBER OF OPTIONS
          STD    CM+2        DO NOT DROP PPU
          LDD    MA 
          CWM    IASD,ON
          MONITOR  UADM      ENABLE JOB SCHEDULING
  
 IAS      ENTRY              ENTRY/EXIT 
          LDN    0           SPIN UP ISMD DEVICES 
          RJM    SUD
          LDD    IR+2 
          LMN    /1DS/SCHF
          ZJN    IAS5        IF ENABLE SCHEDULING CALL
          LDC    IASB-IASBE  SET LIST ADDRESS 
          STD    TN 
          LDK    SSSL        GET SUBSYSTEM STATUS WORD
          CRD    CN 
 IAS1     LDN    IASBE       ADVANCE LIST ADDRESS 
          RAD    TN 
          LMC    IASBL
          ZJN    IAS5        IF END OF LIST 
          LDM    1,TN 
          SHN    21-4 
          PJN    IAS1        IF NOT *AUTO* INITIATED SUBSYSTEM
          LDD    TN 
          LMC    IAS.IAF
          NJN    IAS2        IF NOT *IAF* 
          AOM    IRMD        SET *IAF* AUTO FLAG
 IAS2     LDD    TN 
          LMC    IAS.RDF
          NJN    IAS3        IF NOT *RDF* 
          RJM    IRM         INITIATE *RDF* 
          UJN    IAS1        NEXT SUBSYSTEM 
  
 IAS3     LDM    3,TN        SET MASK 
          STM    IASA 
          LDM    1,TN        SET BYTE ADDRESS 
          LPN    17 
          ADN    CN 
          STD    T6 
          LDI    T6          CHECK SUBSYSTEM
          LPC    0
 IASA     EQU    *-1
          NJN    IAS4        IF DISABLED
          LDM    2,TN        INITIATE SUBSYSTEM 
          RJM    ISJ
 IAS4     LJM    IAS1        CHECK NEXT SUBSYSTEM 
          SPACE  4,15 
**        TABLE OF SUBSYSTEMS.
* 
*         ENTRY FORMAT. 
* 
*T        18/ NAME, 1/P, 1/A, 4/ BYTE, 12/ SSID, 12/ MASK, 12/ TYPE 
* 
*         NAME = 3-CHARACTER SUBSYSTEM NAME.
*         BYTE = BYTE POSITION IN *SSTL*. 
*         P    = SET IF PP-INITIATED SUBSYSTEM. 
*         A    = SET IF *AUTO* INITIATED SUBSYSTEM. 
*         SSID = SUBSYSTEM ID.
*         MASK   BIT MASK FOR SUBSYSTEM ENABLE/DISABLE BIT. 
*         TYPE   FILE TYPE AND STATUS, IF FILE TYPE .NE. *INQF*.
  
  
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO 
*CALL     COMSSSD 
  
 IASB     BSS    0
          LIST   G
 .SUB     HERE
          LIST   *
  
 IASBL    BSS    0           END OF SUBSYSTEMS
  
  
 IASD     CON    LDOS        DECREMENT BY ONE 
          CON    INWL        WORD ADDRESS 
          CON    13D*100+1   BIT ADDRESS AND FIELD WIDTH
          CON    0,0
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 QUAL$    EQU    1           DO NOT QUALIFY COMMON DECKS
*CALL     COMPAST 
*CALL     COMPCTE 
*CALL     COMPRFI 
*CALL     COMPSUD 
 WEI$     EQU    1           DEFINE ALTERNATE EOI BUFFER
*CALL     COMPWEI 
          SPACE  4,10 
          USE    OVERLAY     FORCE /LITERALS*/
 MSG      SPACE  4,10 
***       FUNCTION MSGF - SEND DAYFILE MESSAGE. 
* 
*         ENTRY  (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/. 
  
  
 MSG      ENTRY              ENTRY/EXIT 
          LDC    BUF         GET MESSAGE
          RJM    RPK
          LDN    0           CLEAR LAST BYTE
          STM    BUF+31 
          LDC    BUF         SEND MESSAGE TO DAYFILE
          RJM    DFM
          UJN    MSGX        RETURN 
 DIS      SPACE  4,10 
***       FUNCTION DISF - CALL DIS TO JOB.
  
  
 DIS      ENTRY              ENTRY/EXIT 
          RJM    LKC         LOG COMMAND
          LDC    2RDI        BUILD INPUT REGISTER 
          STD    IR 
          LDD    CP 
          SHN    -7 
          LMC    2L S 
          STD    IR+1 
          LDN    0
          STD    IR+2 
          STD    IR+3 
          LDC    4000        SET DIRECT CALL
          STD    IR+4 
          LDD    MA          ENTER *DIS* IN RECALL STACK
          CWD    IR 
          LDN    ZERL 
          CRD    CM 
          MONITOR  RECM 
          LJM    PPR         EXIT TO PP RESIDENT
 ECB      SPACE  4,10 
***       FUNCTION ECBF - ENTER CENTRAL MEMORY BUFFER.
* 
*         ENTRY  (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/. 
  
  
 ECB      ENTRY              ENTRY/EXIT 
          LDC    BUF         READ AND PACK MESSAGE
          RJM    RPK
          LDD    CP          READ DISPLAY CONTROL WORD
          ADC    DBAW 
          CRD    CM 
          LDD    CM          CHECK ADDRESS
          LPN    37 
          SHN    14 
          LMD    CM+1 
          ADN    5
          SHN    -6 
          SBD    FL 
          PJN    ECBX        IF .GE. FL - 5 
          LDD    CM          STORE MESSAGE
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    CM+1 
          CWM    BUF,FV 
          UJN    ECBX        RETURN 
 BUF      SPACE  4,10 
 BUFB     DATA   6HACDT,
 BUF      DATA   2,0         COMMAND SECTOR BUFFER
 BUFA     BSS    0
 OVL0     EQU    BUFA+2      LOAD ADDRESS FOR *0SD*, *0QM*
          ERRNG  BFMS-BUF-510 CHECK FOR BUFFER OVERFLOW 
          ERRNG  BFMS-OVL0-2-ZQML  *0QM* OVERFLOW 
          ERRNG  BFMS-OVL0-2-ZSDL  *0SD* OVERFLOW 
          TITLE  OVERLAYABLE REQUEST PROCESSORS.
          SPACE  4,10 
*         THE FOLLOWING ROUTINES CANNOT USE BUFFER *BUF*. 
  
  
          QUAL   OVLNB
 ECP      SPACE  4,10 
***       FUNCTION ECPF - ENTER CPU PRIORITY. 
* 
*         ENTRY  (IR+3) = EJT ORDINAL.
*                (IR+4) = CPU PRIORITY IF .NE. 0. 
*                (IR+4) = 0 IF SET PRIORITY TO SERVICE CLASS VALUE. 
*                (KBCML) = 36/, 24/ JSN.
  
  
 ECP      ENTRY              ENTRY/EXIT 
          LDC    /1DS/DSDL+/1DS/KBCML 
          CRD    FN          READ PARAMETER WORD
          LDD    FN+3        SET JSN IN *UTEM* PARAMETER BLOCK
          STM    ECPA+3 
          LDD    FN+4 
          STM    ECPA+4 
          LDD    MA 
          CWM    ECPA,ON
          LDN    60          SET RETRY COUNT
          STD    T4 
  
*         INTERLOCK EJT.
  
 ECP1     LDN    VFIN        SET INTERLOCK FLAG + WORD COUNT
          STD    T1 
          LDN    0           CLEAR UNUSED BYTE
          STD    CM+2 
          SFA    EJT,IR+3 
          RJM    SFI         SET INTERLOCK
          ZJN    ECP4        IF ENTRY INTERLOCKED 
          SBN    2
          PJN    ECP3        IF VERIFICATION FAILED OR ENTRY NOT IN USE 
          LDD    HN          DELAY
          STD    T0 
 ECP2     DELAY 
          SOD    T0 
          PJN    ECP2        IF MORE DELAY
          SOD    T4 
          PJN    ECP1        IF NOT TIMED OUT 
 ECP3     LDN    1           SET *EJT ENTRY BUSY* 
          RJM    SRD         RETURN STATUS TO *DSD* 
          LJM    ECPX        EXIT 
  
*         DETERMINE JOB STATE.
  
 ECP4     SFA    EJT,IR+3 
          ADK    JSNE        FETCH JOB STATUS FROM EJT
          CRD    FN 
          ADK    SCHE-JSNE   GET ROLLOUT INFORMATION
          CRD    T5 
          LDD    FN+4        EXTRACT JOB STATUS 
          LPN    76 
          LMN    EXJS*2 
          NJP    ECP8        IF NOT EXECUTING JOB STATE 
  
*         PROCESS JOB AT CONTROL POINT. 
  
          LDD    T5+3        SET CONTROL POINT NUMBER 
          STD    T6 
          LDD    NC          SET SYSTEM CP ADDRESS
          STD    T7 
          RJM    CCP         CHANGE CONTROL POINT 
          NJN    ECP5        IF UNABLE TO MOVE TO DESIRED CP
          LDD    CP          CHECK CURRENT PRIORITY 
          ADN    CWQW 
          CRD    T1 
          LDD    T1 
          SHN    -3 
          ADC    -200-LSCS
          PJN    ECP6        IF NOT .LT. SYSTEM PRIORITIES
          LDD    IR+4 
          LPC    177
          STD    CM+4        SET CPU PRIORITY IN REQUEST
          LDN    CPRS 
          STD    CM+1        CHANGE CPU PRIORITY
          MONITOR  SJCM 
 ECP5     SOD    FN+4 
          SFA    EJT,IR+3    CLEAR EJT INTERLOCK
          ADK    JSNE 
          CWD    FN 
          UJP    ECPX        RETURN 
  
 ECP6     LDN    3           SET *INCORRECT ENTRY*
 ECP7     RJM    SRD         SET ERROR RESPONSE FOR *DSD* 
          UJN    ECP5        CLEAR EJT INTERLOCK
  
*         PROCESS JOB AT PSEUDO-CONTROL POINT.
  
 ECP8     LMN    PCJS*2&EXJS*2
          NJP    ECP10       IF JOB NOT AT PSEUDO CP
          LDD    T6 
          RJM    SCP         SET PSEUDO CP AREA ADDRESS 
          CRM    BFMS+2,HN   READ FIRST SECTOR OF CP AREA 
          RJM    SPR         SET PRIORITY 
          PJN    ECP6        IF PRIORITY CHANGE NOT ALLOWED 
          LDD    T6          RESET PCP AREA ADDRESS 
          RJM    SCP
          ADN    CWQW        UPDATE CPU SCHEDULING INFORMATION
          CWM    BFMS+2+5*CWQW,ON 
          CWM    BFMS+2+5*CSAW,ON  CLEAR CPU SLICE ACCUMULATORS 
          ERRNZ  CSAW-CWQW-1
          UJP    ECP5        CLEAR EJT INTERLOCK
  
 ECP9     LDN    2           SET *CANNOT ACCESS ROLLOUT DEVICE.*
          UJP    ECP7        SET ERROR STATUS 
  
*         PROCESS ROLLED-OUT JOB. 
  
 ECP10    LMN    PRJS*2&PCJS*2
          ZJN    ECP9        IF PRE-INITIAL JOB STATE 
          LMN    PWJS*2&PRJS*2
          ZJN    ECP9        IF PRE-INITIAL WAIT JOB STATE
          SETMS  IO,(NS,RW) 
          LDN    FSMS        SET FIRST SECTOR OF CP AREA
          STD    T7 
          LDC    BFMS        READ ROLLOUT FILE
          RJM    RDS
          MJN    ECP9        IF DISK ERROR
          RJM    SPR         SET PRIORITY 
          MJN    ECP11       IF PRIORITY CHANGE ALLOWED 
          ENDMS 
          LJM    ECP6        SET *INCORRECT ENTRY*
  
 ECP11    LDC    BFMS+WLSF   UPDATE ROLLOUT FILE
          RJM    WDS
          ENDMS 
          UJP    ECP5        CLEAR EJT INTERLOCK
  
  
 ECPA     VFD    1/1,5/JSNE,6/24D  VERIFY THAT JSN-S MATCH
          VFD    6/36D,6/0
          VFD    36/0 
 SPR      SPACE  4,10 
**        SPR - SET CPU PRIORITY OF ROLLED OUT JOB. 
* 
*         ENTRY  FIRST SECTOR OF CONTROL POINT AREA IN *BFMS*.
* 
*         EXIT   (A) .LT. 0 IF NO ERROR.
  
  
 SPR      SUBR               ENTRY/EXIT 
          LDM    BFMS+2+5*CWQW+0
          ERRPL  CWQW-100    *CWQW* MUST BE IN FIRST SECTOR OF CPA
          SHN    -3 
          ADC    -200-LSCS
          PJN    SPRX        IF JOB AT SYSTEM PRIORITY
  
*         IF SETTING THE PRIORITY TO THE SERVICE CLASS VALUE, THE 
*         SERVICE CLASS FLAG IN *CWQW* IS CLEARED SO THAT THE *JACM*
*         FUNCTION WILL RESET THE PRIORITY ON ROLLIN. 
  
          LDM    BFMS+2+5*CWQW+1
          LPC    2777        CLEAR SLICE AND SERVICE CLASS FLAGS
          LMC    4000        SET INCOMPLETE EXTENDED CPU SLICE
          STM    BFMS+2+5*CWQW+1
          LDD    IR+4        SET NEW PRIORITY 
          ZJN    SPR1        IF SET PRIORITY TO SERVICE CLASS VALUE 
          SHN    3
          ADC    2000 
          STM    BFMS+2+5*CWQW+0
          LDD    TH          SET PRIORITY NOT FROM SERVICE CLASS FLAG 
          RAM    BFMS+2+5*CWQW+1
 SPR1     LDN    ZERL        CLEAR CPU SLICE ACCUMULATORS 
          CRM    BFMS+2+5*CSAW,ON 
          ERRPL  CSAW-100    *CSAW* MUST BE IN FIRST SECTOR OF CPA
          LCN    1           SET NO ERROR 
          UJN    SPRX        RETURN 
          SPACE  4,10 
*         THE FOLLOWING ROUTINES CANNOT USE BUFFERS *BUF* OR *BFMS*.
  
  
          ERRNG  BFMS-*      OVERFLOW INTO BUFFER 
 AEJ      SPACE  4,10 
***       FUNCTION AEJF - ASSIGN EQUIPMENT TO JOB.
* 
*         ENTRY  (IR+3) = EQUIPMENT.
  
  
 AEJ      ENTRY              ENTRY/EXIT 
          LDD    CP          SET OPERATOR ASSIGNED EQUIPMENT
          ADN    OAEW 
          CRD    CM 
          LDD    IR+3 
          STD    CM+4 
          LDD    CP 
          ADN    OAEW 
          CWD    CM 
          UJN    AEJX        RETURN 
 CKP      SPACE  4,10 
***       FUNCTION CKPF - CALL CHECKPOINT TO JOB. 
  
  
 CKP      ENTRY              ENTRY/EXIT 
          LDN    0
          STD    CM+1 
          MONITOR  DCPM      GET RID OF CP ACTIVITY 
          LDD    CM+1        SAVE STATUS
          STD    T1 
 CKP1     PAUSE 
          LDD    CM+1 
          NJN    CKPX        IF ERROR 
          LDD    CM+2 
          LPN    1
          NJN    CKP3        IF ROLLOUT REQUESTED 
          LDD    CM          CHECK PP ACTIVITY
          LPN    36          IGNORE THIS PP 
          ZJN    CKP2        IF NO PP ACTIVITY
          LDN    77 
          SBN    1
          NJN    *-1         IF DELAY NOT FINISHED
          UJN    CKP1        LOOP 
  
 CKP2     LDD    CM+4 
          SHN    -4 
          NJN    CKP3        IF PP RECALL REQUESTS
          LDD    CP 
          ADN    JCIW 
          CRD    CN 
          ADK    TFSW-JCIW
          CRD    AB 
          ADK    SPCW-TFSW
          CRD    CM 
          LDD    CN+3 
          LPC    600
          NJN    CKP3        IF USER FILE PRIVACY 
          LDD    CM 
 CKP3     NJN    CKP4        IF *SPCW* BUSY 
          SFA    EJT,AB      CHECK FOR SCP CONNECTION 
          ADK    JSNE 
          CRD    AB 
          LDD    AB+4 
          SHN    21-13
          MJN    CKP4        IF JOB IS CONNECTED TO A SCP 
          LDN    ZERL 
          CRD    CN 
          CRD    CM 
          LDC    2RCK        BUILD *SPCW* CALL
          STD    CN 
          LDC    2L P+20
          STD    CN+1 
          LDD    CP          STORE SPECIAL REQUEST
          ADC    SPCW 
          CWD    CN 
          MONITOR  ROCM      SET ROLLOUT FLAG 
 CKP4     LDD    T1 
          ZJN    CKP6        IF NO ORIGINAL STATUS
          LDD    RA          CHECK SYSTEM REQUEST 
          SHN    6
          ADN    1
          CRD    CM 
          LDD    CM 
          NJN    CKP5        IF  CALL 
          LDN    ZERL        CLEAR SYSTEM REQUEST 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    1
          CWD    CM 
 CKP5     LDD    CP          INDICATE CPU STATUS AT ROLLOUT 
          ADN    STSW 
          CRD    CM 
          LDN    2
          RAD    CM+2 
          LDD    CP 
          ADN    STSW 
          CWD    CM 
 CKP6     LJM    CKPX        RETURN 
 CLR      SPACE  4,10 
***       FUNCTION CLRF - SET/CLEAR PAUSE BIT.
* 
*         ENTRY  (IR+3) = 0 IF CLEARING PAUSE BIT.
*                       = 1 IF SETTING PAUSE BIT. 
*                (IR+4) = 6/ KEYBOARD BUFFER OFFSET, 6/.
* 
*         EXIT   TO *ISC* IF JOB NOT AT CP. 
  
  
 CLR4     LDM    CLR         SET RETURN ADDRESS 
          STM    ISC
          LJM    ISC+1       INITIATE JOB CALL AND EXIT 
  
 CLR      ENTRY              ENTRY/EXIT 
          LDC    /1DS/DSDL+/1DS/KBCML  FETCH PARAMETER WORD 
          CRD    FN 
          LDN    ERLN/10000  SET DEFAULT DAYFILE
          STD    T4 
          LDD    FN+1 
          LPN    77 
          NJN    CLR1        IF NOT JSN FOR SUBSYSTEM 
          LDN    1R 
          RAD    FN+1 
 CLR1     LDD    FN+2 
          NJN    CLRX        IF INCORRECT JSN 
          RJM    SSJ         SEARCH FOR SPECIFIED JOB 
          NJN    CLR4        IF JOB NOT FOUND 
 CLR2     LDD    CP 
          ADN    SNSW 
          CRD    CM 
          ADN    MS2W-SNSW
          CRD    CN 
          LDN    0           CLEAR MESSAGE
          STD    CN 
          LDD    CM+3        SET/CLEAR PAUSE BIT IN CPA 
          SCN    3
          LMD    IR+3 
          STD    CM+3 
          LDD    CP 
          ADN    SNSW 
          CWD    CM 
          ADN    MS2W-SNSW
          CWD    CN 
          LDD    FL 
          ZJN    CLR3        IF NO FIELD LENGTH 
          LDD    RA 
          SHN    6
          CRD    FS 
          LDD    FS+3        SET/CLEAR PAUSE FLAGS IN (RA)
          SCN    3
          LMD    IR+3 
          STD    FS+3 
          LDD    RA          STORE (RA) 
          SHN    6
          CWD    FS 
 CLR3     LDD    T4          ISSUE DAYFILE MESSAGE
          SHN    14 
          ADM    CLRA,IR+3
          RJM    DFM
          LJM    CLRX        RETURN 
  
  
 CLRA     CON    MSGA 
          CON    MSGB 
          TITLE  OVERLAYABLE SUBROUTINES. 
 CCP      SPACE  4,15 
**        CCP - CHANGE CONTROL POINT. 
* 
*         ENTRY  (T6) = CONTROL POINT NUMBER. 
*                (T7) = SYSTEM CONTROL POINT NUMBER.
* 
*         EXIT   (A) = 0 IF CHANGE MADE.
* 
*         USES   CM+1, T5.
* 
*         CALLS  CSJ. 
* 
*         MACROS DELAY, MONITOR.
  
  
 CCP2     DELAY 
          SOD    T5 
          PJN    CCP1        IF RETRY COUNT NOT EXHAUSTED 
  
 CCP      SUBR               ENTRY/EXIT 
          LDN    10-1        SET RETRY COUNT
          STD    T5 
 CCP1     LDD    T6          CHANGE TO REQUESTED CP 
          ADD    TH          SET REJECT ON STORAGE MOVE 
          ERRNZ  RCMS-1000
          STD    CM+1 
          MONITOR  CCAM 
          LDD    CM+1 
          NJN    CCP2        IF CHANGE REJECTED 
          RJM    CSJ         RECHECK JSN
          ZJN    CCPX        IF JOB STILL AT CP 
          LDD    T7 
          STD    CM+1 
          MONITOR  CCAM      MOVE BACK TO SYSTEM CP 
          LDN    1
          UJN    CCPX        RETURN 
 CSJ      SPACE  4,10 
**        CSJ - CHECK CP FOR SPECIFIED JOB. 
* 
*         ENTRY  (T6) = CP NUMBER.
*                (FN - FN+1) = JSN OF SPECIFIED JOB.
* 
*         EXIT   (A) = 0 IF JOB EXECUTING AT CP.
* 
*         USES   AB - AB+4, CM - CM+4.
* 
*         MACROS SFA. 
  
  
 CSJ      SUBR               ENTRY/EXIT 
          LDD    T6          FETCH EJT ORDINAL
          SHN    7
          ADN    TFSW 
          CRD    CM 
          LDD    CM 
          ZJN    CSJ1        IF CP INACTIVE 
          SFA    EJT
          ADK    JSNE        READ EJT ENTRY 
          CRD    AB 
          LDD    AB+1        COMPARE JSN
          LMD    FN+1 
          NJN    CSJX        IF NO MATCH
          LDD    AB 
 CSJ1     LMD    FN 
          NJN    CSJX        IF NO MATCH
          LDD    AB+4 
          LPN    76 
          LMN    EXJS*2 
          UJN    CSJX        RETURN 
 SSJ      SPACE  4,10 
**        SEJ - SEARCH CP-S FOR SPECIFIED JOB.
* 
*         ENTRY  (FN - FN+1) = JSN OF SPECIFIED JOB.
* 
*         EXIT   (A) = 0 IF SPECIFIED JOB ACTIVE AT CP. 
*                (T4) = MESSAGE OFFSET + DAYFILE OPTION.
* 
*         USES   T6, T7.
* 
*         CALLS  CCP, CSJ.
  
  
 SSJ2     LDD    FN 
          LMC    2RSY 
          NJN    SSJX        IF NOT SYSTEM JSN
          LDD    FN+1 
          LMC    2RS
  
 SSJ      SUBR               ENTRY/EXIT 
          LDN    0
          STD    T6 
          LDD    CP          SET SYSTEM CP NUMBER 
          SHN    -7 
          STD    T7 
 SSJ1     AOD    T6          ADVANCE CP 
          LMD    T7 
          ZJN    SSJ2        IF ALL CP-S CHECKED
          RJM    CSJ         CHECK FOR SPECIFIED JOB
          NJN    SSJ1        IF JOB NOT ACTIVE AT THIS CP 
          LDC    2S6         CHANGE DAYFILE/MESSAGE OFFSET
          STD    T4 
          RJM    CCP         CHANGE TO CP 
          UJN    SSJX        RETURN 
          SPACE  4,10 
**        OVERLAID MESSAGES.
  
  
 MSGA     DATA   C*DS, GO.* 
 MSGB     DATA   C*DS, PAUSE.*
          TITLE  PRESET.
          QUAL   PRESET 
 PRS      SPACE  4,10 
**        PRS - PRESET. 
* 
*         EXIT   (IDSA) = FUNCTION PROCESSOR ADDRESS. 
*                (IDSC) = ORIGINAL (IR+2).
*                (BA) = BUFFER ADDRESS. 
*                (CA) = COMMAND ADDRESS.
*                (FG) = CPU FLAGS.
*                (JF) = DEFAULT FIELD LENGTH. 
*                (CP) = CONTROL POINT ADDRESS.
*                (QA) = 0.
*                (IR+2) = REQ.
* 
*         CALLS  IFP. 
* 
*         MACROS DELAY, MONITOR, SFA. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDN    0           PRESET DIRECT CELLS
          STD    QA 
          LDC    /OVERLAY/BUF  SET SECTOR BUFFER ADDRESS
          STD    BA 
          ADN    2           SET COMMAND ADDRESS
          STD    CA 
          LDN    CPMR        SET RETRY COUNT
          STD    S1 
          LDC    DFFL/100    SET DEFAULT FIELD LENGTH 
          STD    JF 
          LDN    5           SET CONSTANT FIVE
          STD    FV 
          LDN    NCPL        GET NUMBER OF CP-S 
          CRD    CM 
          ADK    MABL-NCPL   FETCH HARDWARE OPTIONS 
          CRD    CN 
          ADK    PCPP-MABL   GET FWA OF PCP AREA
          CRD    FS 
          AOD    CM+1        SET SYSTEM CP NUMBER 
          STD    NC 
          LDD    FS+3 
          RAM    SCPA-1 
          LDD    FS+4        SET PCP AREA BASE ADDRESS
          STM    SCPA 
          LDD    IR+2        SAVE PARAMETERS
          STM    IDSC 
          LPN    77          GET FUNCTION CODE
          STD    IR+2 
          SBN    /1DS/MAXF
          PJN    PRS3        IF INCORRECT FUNCTION
          RJM    IFP         INITIALIZE *SFA* MACRO 
          LDD    CN+1 
          STD    FG 
          SHN    -11
          LMN    7
          NJN    PRS1        IF NOT A CYBER 176 
          AOM    /OVERLAY/ICJF+2
 PRS1     LDM    IDSC 
          SHN    21-12
          MJN    PRS2        IF CP CHANGE REQUIRED
          LJM    PRS7        PROCESS FUNCTION 
  
 PRS2     LDD    IR+4        SET CP NUMBER
          LPN    37 
          STD    TN 
          NJN    PRS4        IF ASSIGNED
 PRS3     LJM    IDS2        DROP PP
  
 PRS4     ADD    TH          SET REJECT ON STORAGE MOVE 
          ERRNZ  RCMS-1000
          STD    CM+1 
          LPN    77 
          SHN    7
          ADN    TFSW        READ EJTO AND JSN
          CRD    CN 
          LDD    CN 
          ZJN    PRS3        IF NO EJTO 
          SFA    EJT         READ EJT ENTRY 
          CRD    CN 
          LDD    CN+4        CHECK JOB STATUS 
          LPN    76 
          LMN    EXJS*2 
          NJN    PRS5        IF JOB NOT AT CONTROL POINT
          MONITOR  CCAM      MOVE TO USER-S CP
          LDD    CM+1 
          ZJN    PRS6        IF MOVE SUCCESSFUL 
          DELAY  4*10        DELAY FOR 4 MILLISECONDS 
          SOD    S1 
          ZJN    PRS5        IF RETRY COMPLETE
          LDD    TN          RESET CONTROL POINT NUMBER 
          UJN    PRS4        RETRY CONTROL POINT MOVE 
  
 PRS5     LJM    IDS2        DROP PP
  
 PRS6     LDD    IR+1 
          SCN    77 
          LMD    TN 
          STD    IR+1 
          LDD    CP          READ JSN FROM EJT ENTRY
          ADN    TFSW 
          CRD    CM 
          SFA    EJT,CM 
          CRD    CM 
          LDD    CN          CHECK FOR SAME JOB 
          LMD    CM 
          NJN    PRS5        IF DIFFERENT JOB 
          LDD    CN+1 
          LMD    CM+1 
          NJN    PRS5        IF DIFFERENT JOB 
 PRS7     LDD    IR+2        GET FUNCTION CODE
          SHN    1
          STD    CM 
          LDM    TRQP,CM     SET/GET PROCESSOR ADDRESS
          ZJN    PRS5        IF FUNCTION NOT DEFINED
          STM    IDSA 
          LJM    PRSX        EXIT 
 TRQP     SPACE  4,10 
**        TRQP - TABLE OF REQUEST PROCESSORS. 
*         ENTRY = 2 WORDS.
*         INDEXED BY REQUEST NUMBER * 2.
* 
*T,       12/  ADDR, 12/  OVLN
*         ADDR   ADDRESS OF REQUEST PROCESSOR.
*         OVLN   OVERLAY NUMBER.
  
  
 TRQP     INDEX 
  
*         FUNCTION *FASF* MUST REMAIN FIRST.
  
          FCN    /1DS/FASF,0
  
  
          FCN    /1DS/AEJF,AEJ
          FCN    /1DS/CLRF,CLR
          FCN    /1DS/CKPF,CKP
          FCN    /1DS/DCMF,DCM
          FCN    /1DS/DIAF,DIA
          FCN    /1DS/DISF,DIS
          FCN    /1DS/DSPF,DSP
          FCN    /1DS/DSSF,DSS
          FCN    /1DS/DWNF,DWN
          FCN    /1DS/UPCF,DWN
          FCN    /1DS/EBRF,EBR
          FCN    /1DS/ECBF,ECB
          FCN    /1DS/ECPF,ECP
          FCN    /1DS/EUFF,EUF
          FCN    /1DS/IASF,IAS
          FCN    /1DS/ICJF,ICJ
          FCN    /1DS/IDLF,IDD
          FCN    /1DS/IJCF,IJC
          FCN    /1DS/ILJF,ILJ
          FCN    /1DS/ISCF,ISC
          FCN    /1DS/ISSF,ISS
          FCN    /1DS/ITJF,ITJ
          FCN    /1DS/KIJF,KIJ
          FCN    /1DS/LODF,LOD
          FCN    /1DS/MSGF,MSG
          FCN    /1DS/OCMF,OCM
          FCN    /1DS/RSTF,RST
          FCN    /1DS/SAMF,SAM
          FCN    /1DS/SCAF,SCA
          FCN    /1DS/SCDF,SCD
          FCN    /1DS/SCHF,IAS
          FCN    /1DS/SPNF,SPD
          FCN    /1DS/SERF,SER
          FCN    /1DS/TPSF,TPS
          FCN    /1DS/VMSF,VMS
          FCN    /1DS/VSAF,VSA
          FCN    /1DS/WARF,WAR
  
          INDEX  /1DS/MAXF*2
          SPACE  4,10 
 IFP      HERE               REMOTE CODE FOR *SFA* MACRO
          SPACE  4,10 
  
          OVERFLOW  PPFW,EPFW 
          EJECT 
          OVERLAY  (MASS STORAGE FUNCTIONS.)
 2DA      SPACE  4,10 
**        COMMON DECK EQUIVALENCES. 
  
  
 CKSS     EQU    /LSD/CKSS
 DISS     EQU    /LSD/DISS
 DKSS     EQU    /LSD/DKSS
 MNEC     EQU    /LSD/MNEC
 N4SS     EQU    /LSD/N4SS
 STVE     EQU    /LSD/STVE
  
 MISD     EQU    /MMF/MISD
 MXMF     EQU    /MMF/MXMF
 CIO      SPACE  4,10 
**        CIO - CHECK INITIALIZE OPTIONS. 
* 
*         ENTRY  (MS) = MST POINTER.
* 
*         EXIT   (IR+3) = INITIALIZE FLAG BIT NUMBER. 
* 
*         USES   CM - CM+4. 
  
  
 CIO      SUBR               ENTRY/EXIT 
          LDN    LIAL 
 CIOA     LMN    0
          NJN    CIOX        IF NOT *AL* OPTION 
          LDD    MS 
          SHN    3
          ADN    MDGL        FETCH CURRENT RECORDING MODE FROM MST
          CRD    CM 
          LDD    CM+1 
          SHN    -13         FORM *HT* OR *FT* OPTION 
          ADN    LIFD 
          ERRNZ  LIFD+1-LIHD CODE DEPENDS ON VALUE
          STD    IR+3 
          UJN    CIOX        RETURN 
 CSD      SPACE  4,15 
**        CSD - CHECK SHARED DEVICE.
* 
*         ENTRY  (MS-4 - MS) = EST ENTRY OF DEVICE. 
* 
*         EXIT   (A) = 0 IF NOT SHARED DEVICE, OR IF INITIALIZE NOT 
*                SET ON SHARED DEVICE FOR ANY MAINFRAME.
*                (A) .NE. 0 OTHERWISE, OR IF *EXTENDED MEMORY* ERROR. 
* 
*         USES   T3, CM - CM+4, CN - CN+4.
* 
*         CALLS  DFM. 
* 
*         MACROS MONITOR. 
  
  
 CSD6     LDN    0
  
 CSD      SUBR               ENTRY/EXIT 
          LDD    MS-4 
          SHN    21-11
          PJN    CSD6        IF NOT SHARED
          SHN    21-4-21+11 
          MJN    CSD6        IF INDEPENDENT SHARED DEVICE 
          LDK    MMFL        SET MACHINE ID OF THIS MACHINE 
          CRD    CM 
          LDD    CM 
          STM    CSDA 
          LDD    MS          READ MST 
          SHN    3
          ADN    SDGL 
          CRD    CN 
          LDN    MXMF 
          STD    T3 
 CSD1     LDD    CN+1        SET EXTENDED MEMORY ADDRESS
          ADN    STLL 
          STD    CM+4 
          SHN    -14
          ADD    CN 
          LMC    RECS*1000   SET UP MONITOR REQUEST 
          STD    CM+3 
          LDD    MA          SET CM ADDRESS FOR READ
          STD    CM+2 
          LDN    1-1         SET WORD COUNT 
*         SHN    6
          STD    CM+1 
          MONITOR  ECSM 
          LDD    CM+1        CHECK RETURN STATUS
          SHN    21-13
          PJN    CSD4        IF NO ERROR
          LDD    CM+3 
          SHN    14 
          LMD    CM+4 
          ZJN    CSD4        IF NO RETRY ERROR
          LDC    =C*EXTENDED MEMORY ERROR.* 
 CSD2     RJM    DFM
          LDN    77 
 CSD3     LJM    CSDX        EXIT 
  
 CSD4     LDD    MA 
          CRD    CM 
          LDD    CM+2        CHECK MACHINE ID 
          LMC    *
 CSDA     EQU    *-1
          ZJN    CSD5        IF THIS MACHINE
          LDD    CM          CHECK INITIALIZE BITS
          SCN    77 
*         LPC    MLFPR+MLIAL+MLIHD+MLIFD+MLIPF+MLIQF
          ERRNZ  MLFPR+MLIAL+MLIHD+MLIFD+MLIPF+MLIQF-7700 
          ZJN    CSD5        IF NO INITIALIZE BIT SET 
          LDC    =C*INITIALIZE PENDING ON THIS DEVICE.* 
          UJN    CSD2        SEND ERROR MESSAGE TO DAYFILE
  
 CSD5     LDN    LLLL        ADVANCE TO NEXT MAINFRAME
          RAD    CN+1 
          SHN    -14
          RAD    CN 
          SOD    T3 
          ZJN    CSD3        IF ALL MAINFRAMES
          LJM    CSD1        PROCESS NEXT MAINFRAME 
 CSM      SPACE  4,15 
**        CSM - CHECK SHARED RMS. 
* 
*         ENTRY  (T5) = EST ORDINAL.
*                (MS) = MST POINTER.
*                (IR+4) BIT 2**12 = PRESET FOR SHARED RMS, IF SET.
* 
*         EXIT   (A) = 0, IF NOT INDEPENDENT SHARED DEVICE. 
*                (A) .GT. 0, IF INDEPENDENT SHARED DEVICE.
*                (A) = NEGATIVE, IF INCORRECT CALL. 
* 
*         USES   T6, T7, CM - CM+4. 
* 
*         CALLS  CDC, RDS, SMI, WDS.
* 
*         MACROS ENDMS, SETMS, SFA, SMSTF.
  
  
 CSM7     LDD    IR+4 
          SHN    21-12
          MJN    CSMX        IF INCORRECT PRESET
          LDN    0
  
 CSM      SUBR               ENTRY/EXIT 
          SFA    EST,T5 
          ADK    EQDE 
          CRD    CM 
          LDD    CM 
          SHN    21-4 
          PJN    CSM7        IF NOT ISD 
          SHN    5+21-10
          PJN    CSM4        IF NON-REMOVABLE DEVICE
 CSM1     LDD    IR+4 
          SHN    21-12
          PJN    CSM2        IF MOUNT ON ISD WITHOUT PRESET 
          SMSTF  GPRS        SET ISD PRESET BIT FOR DEVICE
 CSM2     LDN    1
 CSM3     UJN    CSMX        RETURN 
  
 CSM4     SHN    10-3 
          PJN    CSM1        IF DEVICE NOT PREVIOUSLY RECOVERED 
          SETMS  IO,(DE,NR) 
          LDD    MS          FETCH LABEL TRACK FROM MST 
          SHN    3
          ADN    ALGL 
          CRD    CM 
          LDD    CM+1 
          ZJN    CSM1        IF LABEL TRACK UNDEFINED 
          STD    T6 
          LDN    0
          STD    T7 
          LDC    BFMS        READ LABEL SECTOR
          RJM    RDS
          PJN    CSM6        IF NO READ ERROR 
          ENDMS 
          LCN    1
 CSM5     UJN    CSM3        RETURN 
  
 CSM6     RJM    SMI         SET MACHINE INDEX
          STD    CM 
          SHN    2
          RAD    CM 
          LDM    DISS-5+3,CM
          SCN    2           CLEAR UNLOAD STATUS
          STM    DISS-5+3,CM
          RJM    CDC         COMPUTE LABEL CHECKSUM 
          STM    CKSS 
          LDC    BFMS+WLSF   REWRITE LABEL SECTOR 
          RJM    WDS
          ENDMS 
          LDN    GLGL-ALGL
          STD    T7 
          LDD    MS          UPDATE GLOBAL MST
          SHN    3
          ADN    ALGL 
          CWM    N4SS+5*ALGL,T7 
          UJN    CSM5        RETURN 
 C0S      SPACE  4,10 
**        C0S - CALL *0SD*. 
* 
*         ENTRY  (A) = 0 IF SPIN UP ALL UNITS.
*                    = 20B IF SPIN DOWN ALL UNITS.
* 
*         EXIT   (A) = *0SD* PROCESSOR ENTRY ADDRESS. 
  
  
 C0S      SUBR               ENTRY/EXIT 
          STM    L0SD-2 
          EXECUTE  0SD,L0SD 
          UJN    C0SX        RETURN 
 SFA      SPACE  4,15 
**        SFA - SEARCH FOR FAST ATTACH FILE.
* 
*         ENTRY  (T5) = EST ORDINAL.
*                            SEARCHES THE FNT FOR ANY FILE OF TYPE
*                            *FAFT* ASSIGNED TO THIS EQUIPMENT. 
* 
*         EXIT   (A) = 0 IF NO FILE FOUND.
*                (A) = 1 IF *FAFT* TYPE FILE FOUND ON EQUIPMENT.
* 
*         USES   QA, FN - FN+4, FS - FS+4.
* 
*         MACROS SFA. 
  
  
 SFA      SUBR               ENTRY/EXIT 
          LDN    0
          STD    QA 
          LDN    FNTP        READ FNT POINTER 
          CRD    FN 
 SFA1     AOD    QA          ADVANCE FNT ORDINAL
          LMD    FN+2 
          ZJN    SFAX        IF END OF FNT
          SFA    FNT,QA      READ FNT ENTRY 
          CRD    FS 
          LDD    FS+4        CHECK FILE TYPE
          SHN    -6 
          LMN    FAFT 
          NJN    SFA1        IF NOT FAST ATTACH 
          SFA    FNT,QA      READ FST ENTRY 
          ADN    FSTG 
          CRD    FS 
          LDD    FS          CHECK EQUIPMENT ASSIGNMENT 
          LMD    T5 
          NJN    SFA1        IF NOT SAME EQUIPMENT
          LDN    1
          UJN    SFAX        EXIT WITH FAST ATTACH FOUND
 SFD      SPACE  4,10 
**        SFD - SEARCH FOR DAYFILES.
* 
*         ENTRY  (IR+4) = EST ORDINAL.
* 
*         EXIT   (A) = 0, IF SYSTEM DAYFILES ON DEVICE. 
* 
*         USES   CM - CM+4, T1 - T5.
  
  
 SFD      SUBR               ENTRY/EXIT 
          LDK    DFPP 
          CRD    T1 
          LDN    3*3+2       SET DAYFILE EST OFFSET 
          STD    T3 
 SFD1     LDD    T1 
          SHN    14 
          LMD    T2 
          ADD    T3 
          CRD    CM 
          LDD    CM 
          LMD    IR+4 
          ZJN    SFDX        IF DAYFILE ON EQUIPMENT
          LCN    3
          RAD    T3 
          PJN    SFD1        IF MORE DAYFILES TO CHECK
          UJN    SFDX        RETURN 
 SUL      SPACE  4,10 
**        SUL - SCAN UNIT LIST. 
* 
*         ENTRY  (T3) = CONTROL MODULE NUMBER * 10B.
*                (AB+4) = ISMD DEVICE MST ADDRESS/10. 
* 
*         EXIT   (A) = 0 IF THE ISMD CONTAINS A UNIT ON THE *CM*. 
* 
*         USES   T4, T5, FN - FN+4. 
  
  
 SUL      SUBR               ENTRY/EXIT 
          LDD    AB+4        READ MST WORD *DDLL* 
          SHN    3
          ADN    DDLL 
          CRD    FN 
          LDD    FN 
          SHN    21-12
          MJN    SULX        IF NULL EQUIPMENT
          LDD    FN          GET NUMBER OF UNITS - 1
          LPN    7
          STD    T4 
          LDN    FN+4        INITIALIZE UNIT LIST ADDRESS 
          STD    T5 
 SUL1     LDI    T5 
          LMD    T3          COMPARE WITH CONTROL MODULE NUMBER 
          LPN    70 
          ZJN    SULX        IF NUMBER MATCHES
          SOD    T4 
          MJN    SULX        IF END OF UNITS
          LDI    T5 
          SHN    3-11 
          LMD    T3          COMPARE WITH CONTROL MODULE NUMBER 
          LPN    70 
          ZJN    SULX        IF NUMBER MATCHES
          SOD    T4 
          MJN    SULX        IF END OF UNITS
          SOD    T5 
          UJN    SUL1        CHECK NEXT UNIT
 UDD      SPACE  4,10 
**        UDD - UP *DD* DRIVE.
* 
*         ENTRY  (AB - AB+4) = EST ENTRY. 
* 
*         EXIT   (A) .NE. 0 IF DRIVE SPUN UP. 
*                (A) = 0 IF CONTROL MODULE DOWN.
* 
*         USES   T1, T3, CN - CN+4. 
* 
*         CALLS  COS, SUL.
  
  
 UDD2     RJM    C0S         SPIN UP *DD* DRIVE 
          STM    UDDA 
          RJM    *
 UDDA     EQU    *-1
          LDN    1
  
 UDD      SUBR               ENTRY/EXIT 
          LDN    ESTP 
          CRD    CN 
          LDD    CN+2        SET LAST EST ORDINAL + 1 
          STD    T1 
 UDD1     SOD    T1 
          ZJN    UDD2        IF END OF EST
          SFA    EST
          CRD    CN 
          LDD    CN+3 
          LMC    2RCM 
          NJN    UDD1        IF NOT *CM*
          LDD    CN 
          LPN    3           CHECK DEVICE STATE 
          LMN    3
          NJN    UDD1        IF NOT DOWN
          LDD    CN+4 
          SHN    3-11        SAVE EQUIPMENT NUMBER
          STD    T3 
          RJM    SUL         SCAN UNIT LIST 
          NJN    UDD1        IF NO UNIT ON THIS *CM*
          UJP    UDDX        RETURN 
          TITLE  FUNCTION PROCESSORS. 
 DCM      SPACE  4,10 
***       FUNCTION DCMF - DOWN CONTROL MODULE.
* 
*         ENTRY  (IR+4) = CONTROL MODULE EQUIPMENT NUMBER.
* 
*         NOTE   IF ANY ISMD DEVICE WHICH IS NOT DOWN HAS A UNIT ON 
*                THE SPECIFIED CONTROL MODULE, A NEGATIVE REPLY IS
*                RETURNED TO *DSD* AND THE CONTROL MODULE IS NOT
*                DOWNED.
  
  
 DCM3     LDN    DWES        *SEQM* SUBFUNCTION 
          STD    CM+2 
          LDD    IR+4        EST ORDINAL
          STD    CM+1 
          MONITOR  SEQM      SET EQUIPMENT DOWN 
  
 DCM      ENTRY              ENTRY/EXIT 
          LDN    ESTP        GET LAST MASS STORAGE ORDINAL + 1
          CRD    CN 
          SFA    EST,IR+4    GET *CM* EST ENTRY 
          CRD    CM 
          LDD    CM+4        SAVE EQUIPMENT NUMBER
          SHN    3-11 
          STD    T3 
 DCM1     SOD    CN+3 
          ZJN    DCM3        IF END OF EST
          SFA    EST
          ADK    EQDE        FETCH EST ENTRY
          CRD    AB 
          LDD    AB+3        CHECK DEVICE TYPE
          LMC    2RDD 
          ZJN    DCM2        IF ISD (TYPE *DD*) 
          LMN    1RG&1RD
          NJN    DCM1        IF NOT TYPE *DG* 
 DCM2     LDD    AB 
          LPN    3           CHECK DEVICE STATE 
          LMN    3
          ZJN    DCM1        IF DEVICE DOWN 
          RJM    SUL         SCAN UNIT LIST 
          NJN    DCM1        IF NO UNIT ON THIS *CM*
          LDN    1           INDICATE *CM* NOT DOWNED 
          RJM    SRD         SAVE REPONSE TO *DSD*
          LJM    DCMX        RETURN 
 OCM      SPACE  4,10 
***       FUNCTION OCMF - ON CONTROL MODULE.
* 
*         ENTRY  (IR+4) = CONTROL MODULE EST ORDINAL. 
  
  
*         CHECK FOR FIRMWARE RELOAD COMPLETION. 
  
 OCM1     LMN    1&3
          NJN    OCM2        IF CONTROL MODULE NOT IDLE 
          LDD    FN+2 
          SHN    0-12 
          ZJN    OCM2        IF FIRMWARE RELOAD COMPLETE
          LDK    ZERL        SET 1 SECOND TIMED RECALL PARAMETERS 
          CRD    CM 
          LDM    IDSC        RESTORE ORIGINAL CONTENTS
          STD    IR+2 
          LDD    MA          SET PP INPUT REGISTER IMAGE
          CWD    IR 
          MONITOR  RECM      ENTER RECALL AND DROP PP 
          LJM    PPR         EXIT TO PP RESIDENT
  
*         SET CONTROL MODULE STATUS = ON. 
  
 OCM2     LDN    ONES        *SEQM* SUBFUNCTION 
          STD    CM+2 
          MONITOR  SEQM 
  
 OCM      ENTRY              ENTRY
          LDD    IR+4 
          STD    CM+1 
          SFA    EST         READ CONTROL MODULE EST ENTRY
          ADK    EQDE 
          CRD    CN 
          ADK    EQAE-EQDE
          CRD    FN 
          STD    CM+4        SAVE ADDRESS OF *EQAE* WORD
          SHN    -14
          STD    CM+3 
          LDD    CN 
          LPN    3
          LMN    3
          NJP    OCM1        IF CONTROL MODULE NOT DOWN 
  
*         IDLE CONTROL MODULE FOR FIRMWARE LOAD.
  
          LDN    IDES        SET *SEQM* SUBFUNCTION 
          STD    CM+2 
          MONITOR  SEQM 
  
*         SET CONTROLWARE LOAD FLAG IN EST ENTRY. 
  
          LDN    1           SET REQUEST COUNT
          STD    CM+1 
          LDD    MA          PLACE *UTEM* PARAMETERS IN MB
          CWM    OCMA,ON
          MONITOR  UTEM 
  
*         USE THIS PP TO INITIATE CONTROLWARE LOAD. 
  
          LDM    IDSC        SET FUNCTION CODE
          SCN    77          PRESERVE BUFFER LOCK/LOGGING CONTROL BITS
          LMN    /1DS/ILJF
          STD    IR+2 
          LDC    2000        SET *OCMF* CALL FLAG 
          RAD    IR+4 
          LDD    IA          REWRITE PP INPUT REGISTER
          CWD    IR 
          EXECUTE  1DS,=
          LJM    PPR         EXIT TO PP RESIDENT
  
  
 OCMA     VFD    1/0,5/0,6/1,6/43,42/1  *UTEM* REQUEST
 RST      SPACE  4,10 
***       FUNCTION RSTF - RESTORE PARITY PROTECTION FOR DAS DEVICE. 
* 
*         ENTRY  (IR+4) = DEVICE EST ORDINAL. 
  
  
 RST      ENTRY              ENTRY/EXIT 
          LDD    IR+4 
          STD    T5 
          SFA    EST         GET EST ENTRY
          ADK    EQDE 
          CRD    CM 
  
*         CHECK DEVICE TYPE.
  
          LDN    TRSTL       CHECK DEVICE TYPE
          STD    T1 
 RST1     SOD    T1 
          MJN    RSTX        IF DEVICE DOES NOT SUPPORT RESTORE 
          LDD    CM+3 
          LMM    TRST,T1
          NJN    RST1        IF DEVICE TYPE DOES NOT MATCH
  
*         CALCULATE *PUT* ENTRY ADDRESS.
  
          LDD    CM+4        GET *PUT* ORDINAL
          SHN    3
          ADN    DILL 
          CRD    CM 
          LDD    CM+2 
          SHN    PUTLS
          STM    RSTA+1 
          SHN    -14
          RAM    RSTA 
          LDC    BIOL        GET POINTER TO BUFFERED I/O TABLES 
          CRD    CM 
          LDD    CM+1        FETCH *PUT* TABLE POINTER WORD 
          SHN    14 
          LMD    CM+2 
          ADN    PUTP 
          CRD    CM 
          LDD    CM+3        FWA OF FIRST *PUT* ENTRY 
          LPN    77 
          SHN    14 
          ADD    CM+4 
 RSTA     ADC    0           (*PUT* ORDINAL SHIFTED BY *PUTLS*) 
  
*         SET *RSPF* SPECIAL REQUEST FLAG IN *PUT*. 
  
          STD    CM+4        SET ADDRESS OF *PUT* ENTRY 
          SHN    -14
          STD    CM+3 
          LDN    1           SET NUMBER OF REQUESTS 
          STD    CM+1 
          LDD    MA          STORE *UTEM* REQUEST IN MESSAGE BUFFER 
          CWM    RSTB,ON
          MONITOR  UTEM      SET FLAG FOR BUFFERED DEVICE DRIVER
          UJP    RSTX        RETURN 
  
  
 RSTB     VFD    1/0,5/PILL,6/1,6/RSPF,42/1  *UTEM* REQUEST 
  
          PURGMAC  TBLM 
  
 TBLM     MACRO  TY 
 TBLM     IFEQ   BF_TY,7,1
          CON    2R_TY
 TBLM     ENDIF 
 TBLM     ENDM
  
 TRST     BSS    0           DEVICES ALLOWED FOR RESTORE
          LIST   G
          TBL    "MSEQ" 
          LIST   *
 TRSTL    EQU    *-TRST      LENGTH OF TABLE
  
          PURGMAC  TBLM 
 SCA      SPACE  4,10 
***       FUNCTION SCAF - SET/CLEAR BIT IN MST WORD ACGL. 
* 
*         ENTRY  (IR+3) = BIT NUMBER. 
*                (IR+4) = EST ORDINAL.
*                BIT 2**11 OF (IR+3) SET IF BIT TO BE CLEARED.
  
  
 SCA      ENTRY              ENTRY/EXIT 
          LDD    IR+4        SET EST ORDINAL
          STD    T5 
          LDD    IR+3        CHECK REQUEST
          LPC    4000 
          ZJN    SCA1        IF BIT TO BE SET 
          LMC    -0 
 SCA1     LMD    IR+3        SET/CLEAR GLOBAL BIT 
          RJM    TGB
          UJN    SCAX        RETURN 
 SCD      SPACE  4,10 
***       FUNCTION SCDF - SET/CLEAR FLAGS FOR RMS DEVICES.
* 
*         ENTRY  (IR+3) = *ONES* TO SET DEVICE *ON*.
*                         *IDES* TO SET DEVICE *IDLE*.
*                         *OFES* TO SET DEVICE *OFF*. 
*                         *DWES* TO SET DEVICE *DOWN*.
*                (IR+4) = EST ORDINAL.
  
  
 SCD14    LDN    1           RETURN NEGATIVE RESPONSE 
          RJM    SRD
  
 SCD      ENTRY 
          LDD    IR+4        SAVE EST ORDINAL 
          STM    L0SD-1 
          STM    SCDA+2 
          SFA    EST         FETCH EST ENTRY
          ADK    EQDE 
          CRD    AB 
          LDD    IR+3 
          LMN    DWES 
          NJN    SCD2        IF NOT SETTING DEVICE DOWN 
          RJM    SFD         SEARCH FOR DAYFILES ON DEVICE
 SCD1     ZJN    SCD14       IF DAYFILES PRESENT
          UJN    SCD5        CONTINUE DOWN PROCESSING 
  
 SCD2     LDN    TSCDL       CHECK DEVICE TYPE FOR NON-*LDAM* DEVICE
          STD    T1 
 SCD3     SOD    T1 
          MJN    SCD4        IF DRIVE SHOULD NOT BE SPUN UP 
          LDD    AB+3 
          LMM    TSCD,T1
          NJN    SCD3        IF DEVICE TYPE DOES NOT MATCH
          RJM    UDD         SPIN UP DRIVE
          ZJN    SCD1        IF SPIN-UP ERROR 
 SCD4     LDD    AB 
          SHN    21-6 
          MJN    SCD9        IF DEVICE UNAVAILABLE
 SCD5     LDD    IR+3 
          SBN    OFES 
          PJN    SCD8        IF SETTING DEVICE *OFF* OR *DOWN*
          ADN    OFES-ONES
          ZJN    SCD6        IF SETTING DEVICE *ON* 
          LDN    ONFC&IDFC
 SCD6     LMN    ONFC 
 SCD7     SHN    6
          STM    SCDA+3 
          RJM    LKC         LOG KEYBOARD COMMAND 
          LDD    IR+1 
          LPN    77 
          RAM    SCDA+1 
          LDD    IA          CALL *1MV* TO PROCESS REQUEST
          CWM    SCDA,ON
          EXECUTE  1MV,=
          LJM    PPR         EXIT TO PPR TO LOAD *1MV*
  
 SCD8     ZJN    SCD10       IF *OFF* REQUESTED 
          LDK    OFES        SET DEVICE *OFF* TO ELIMINATE ACTIVITY 
          STD    CM+2 
          LDD    IR+4 
          STD    CM+1 
          MONITOR  SEQM 
 SCD9     UJN    SCD11       SET DEVICE *DOWN*
  
 SCD10    LDD    AB 
          LPN    3
          LMN    3
          NJN    SCD11       IF NOT CURRENTLY DOWN
          LDN    OFFC 
          UJN    SCD7        CALL *1MV* TO GO FROM DOWN TO OFF
  
 SCD11    LDD    IR+3        *SEQM* SUBFUNCTION 
          STD    CM+2 
          LDD    IR+4        EST ORDINAL
          STD    CM+1 
          MONITOR  SEQM      CHANGE EQUIPMENT STATE 
          LDD    CM+1 
          NJN    SCD12       IF DEVICE STATE WAS CHANGED
          LDD    AB          RESTORE ORIGINAL DEVICE STATE
          LPN    3
          STD    CM+2 
          ERRNZ  ONES        CODE DEPENDS ON VALUE
          ERRNZ  IDES-1      CODE DEPENDS ON VALUE
          ERRNZ  OFES-2      CODE DEPENDS ON VALUE
          LDD    IR+4        EST ORDINAL
          STD    CM+1 
          MONITOR  SEQM 
          LJM    SCD14       RETURN 
  
 SCD12    LDD    IR+3 
          LMK    ONES 
          NJN    SCD13       IF NOT TURNING DEVICE ON 
          LPN    2
          ERRNZ  ONES        CODE DEPENDS ON VALUE
          ERRNZ  IDES-1      CODE DEPENDS ON VALUE
          NJN    SCD10       IF NOT ATTEMPTING TO *ON* OR *IDLE* DEVICE 
          LDD    AB 
          SHN    -3          CHECK EQUIPMENT STATUS 
          LPN    41 
          NJN    SCD13       IF NOT INACTIVE NON-REMOVABLE DEVICE 
          LDC    4000+LUNL
          STD    IR+3 
          RJM    .TPS        PROCESS MOUNT REQUEST
 SCD13    LDN    ZERL 
          CRD    CM 
          ADN    PFNL+1-ZERL CLEAR *CMS* TIMEOUT
          CWD    CM 
          LJM    SCDX        RETURN 
  
  
 SCDA     VFD    18/3R1MV,42/0
  
 TSCD     BSS    0           DEVICES TO SPIN UP ON *ON* 
          CON    2RDD        834
          CON    2RDG        836
          CON    2RDF        887 (4KB SECTOR) 
          CON    2RDH        887 (16KB SECTOR)
  
 TSCDL    EQU    *-TSCD      LENGTH OF TABLE
 SPD      SPACE  4,10 
***       FUNCTION SPNF - SPIN MASS STORAGE DRIVE.
* 
*         ENTRY  (IR+3) = 0 IF SPIN UP. 
*                       .GT. 0 IF SPIN DOWN.
*                (IR+4) = DEVICE EST ORDINAL. 
  
  
 SPD      ENTRY              ENTRY/EXIT 
          LDD    IR+3 
          ZJN    SPD1        IF SPIN UP 
          LDN    20 
 SPD1     RJM    C0S         CALL *0SD* 
          STM    SPDA        SAVE *0SD* PROCESSOR ENTRY ADDRESS 
          LDD    IR+4        SET EST ORDINAL
          STM    L0SD-1 
          RJM    *           SPIN UP/DOWN MASS STORAGE DEVICE 
 SPDA     EQU    *-1         (*0SD* PROCESSOR ENTRY ADDRESS)
          UJN    SPDX        RETURN 
 TPS      SPACE  4,20 
***       FUNCTION TPSF - TOGGLE PF STATUS. 
* 
*         PROCESS COMMAND FOR *DSD* - 
*                *INITIALIZE*, *MOUNT*, OR *UNLOAD*.
* 
*         ENTRY  (IR+3) = 1/M, 11/TYPE. 
*                         M = 1, IF *MOUNT* REQUEST.
*                           = 0, IF *UNLOAD* REQUEST. 
*                         TYPE = LUNL, IF *MOUNT* OR *UNLOAD*.
*                (IR+4) = 1/, 1/S, 10/EQ. 
*                         S = 1, IF SHARED RMS IS PRESET. 
*                         EQ = EST ORDINAL, IF NOT *INITIALIZE*.
*                       = UNUSED, IF *INITIALIZE*.
*                (PARAMETER WORD) = 12/EQ1,12/EQ2,12/EQ3,12/EQ4,12/EQ5. 
*                                   (USED ONLY FOR *INITIALIZE*.) 
*                                   THE FIRST EQUIPMENT THAT EQUALS 
*                                   ZERO ENDS THE LIST OF EQUIPMENTS. 
  
  
*         PROCESS *MOUNT* OR *UNLOAD* OF ONE EQUIPMENT. 
  
 TPS14    LDD    IR+4        GET EST ENTRY
          LPC    777
          STD    T5 
          STM    L0SD-1 
          SFA    EST
          ADK    EQDE 
          CRD    MS-4 
* 
*         CHECK IF OPTICAL DISK DRIVE.
* 
          LDD    MS-1 
          LMC    2ROD        OPTICAL DISK 
          NJN    TPS14.1     IF NOT OPTICAL DISK
          RJM    DOD         DISMOUNT OPTICAL DISK
          LJM    TPSX        RETURN TO CALLER 
  
 TPS14.1  LDD    IR+3 
          SHN    0-13 
          ZJP    TPS20       IF UNLOAD REQUEST
          LDD    MS-4 
          SHN    21-3 
          PJN    TPS15       IF DEVICE INACTIVE 
          SHN    4+21-10
          PJN    TPS16       IF NON-REMOVABLE DEVICE
 TPS15    LDD    MS 
          SHN    3
          ADN    STLL 
          CRD    CM 
          LDD    CM          CHECK LOCAL STATUS 
          LPN    MLDUL
          ZJN    TPS19       IF DEVICE NOT UNLOADED 
          SMSTF  LPTU        PROHIBIT TRT UPDATE BY *1RU* 
 TPS16    RJM    CSM
          MJN    TPS17       IF BAD CALL
          NJN    TPS18       IF INDEPENDENT SHARED DEVICE MOUNT 
          RJM    CSD         CHECK EXTENDED MEMORY MMF SHARED DEVICE
 TPS17    NJN    TPS21       IF DEVICE CANNOT BE RECOVERED
 TPS18    CMSTF  LDUL        CLEAR DEVICE UNLOADED STATUS 
          CMSTF  GUNL        CLEAR GLOBAL UNLOAD
          RJM    C0S         CALL 0SD 
          STM    TPSB 
          RJM    **          SPIN UP ISMD DEVICE
 TPSB     EQU    *-1         (*0SD* PROCESSOR ENTRY ADDRESS)
 TPS19    LCN    0
 TPS20    LMN    LUNL        SET/CLEAR UNLOAD REQUESTED 
          RJM    TLB
 TPS21    LDK    ZERL 
          CRD    CM 
          ADN    PFNL+1-ZERL CLEAR *CMS* TIMEOUT
          CWD    CM 
  
 TPS      ENTRY              ENTRY/EXIT 
          LDD    IR+3        CHECK REQUEST
          LPN    77 
          LMN    LUNL 
          NJN    TPS1        IF NOT MOUNT/UNLOAD
          LJM    TPS14       PROCESS MOUNT/UNLOAD 
  
*         PROCESS *INITIALIZE* OF MULTIPLE EQUIPMENTS.
  
 TPS1     LDC    /1DS/DSDL+/1DS/KBCML  READ SPECIAL PARAMETER WORD
          CRM    TPSA,ON
          LDD    IR+3        SET REQUESTED INITIALIZE OPTION
          RAM    CIOA 
          LDC    TPSA 
          STD    T4 
          UJN    TPS3        ENTER LOOP 
  
 TPS2     AOD    T4 
          ADC    -TPSA-4-1
          ZJN    TPSX        IF END OF PARAMETER WORD 
 TPS3     LDI    T4          GET NEXT EQUIPMENT 
          ZJN    TPSX        IF NO MORE EQUIPMENTS
          STD    T5 
          SFA    EST         GET EST ENTRY
          ADK    EQDE 
          CRD    MS-4 
          LDD    MS          READ *STLL*
          SHN    3
          ADN    STLL 
          CRD    AB 
          RJM    CIO         CHECK INITIALIZE OPTIONS 
          LDD    AB 
          LPC    MLFPR+MLIAL+MLIHD+MLIFD
          ZJN    TPS7        IF FULL INITIALIZE NOT SET 
          LDD    IR+3 
          SBN    LIFD 
          MJN    TPS2        IF REQUEST FOR PARTIAL INITIALIZE
          ADN    LIFD 
          RJM    TLB         SET INITIALIZE REQUEST 
          LDN    LIAL 
          STD    T2 
          LDD    CM+1        CHECK REPLY
          LPN    1
          ZJN    TPS4        IF INITIALIZE FLAG NOT ALREADY SET 
          LJM    TPS9        CLEAR INITIALIZE FLAG
  
 TPS4     LDD    IR+3        CHECK FULL INITIALIZE FLAG 
          LMD    T2 
          ZJN    TPS5        IF FLAG JUST SET 
          LCN    0           CLEAR OTHER FULL INITIALIZE FLAGS
          LMD    T2 
          RJM    TLB
 TPS5     SOD    T2          DECREMENT FLAG NUMBER
          LMN    LIFD-1 
          NJN    TPS4        IF NOT END OF FULL INITIALIZE FLAG 
 TPS6     LJM    TPS2        LOOP 
  
 TPS7     LDD    IR+3 
          SBN    LIQF 
          MJN    TPS8        IF PRESERVED FILES NOT BEING INITIALIZED 
          RJM    CSD         CHECK SHARED DEVICE
          NJN    TPS6        IF NOT CLEAR FOR INITIALIZE
          LDD    IR+3 
          SBN    LIPF 
          MJN    TPS8        IF PERMANENT FILES NOT INVOLVED
          RJM    SFA
          ZJN    TPS8        IF NO FAST ATTACH FILES ON DEVICE
          LDC    =C*FAST ATTACH FILES ON DEVICE.* 
          RJM    DFM
          LJM    TPSX        RETURN 
  
 TPS8     LDD    IR+3        SET INITIALIZE REQUEST 
          RJM    TLB
          LDD    CM+1        CHECK REPLY
          LPN    1
          ZJN    TPS10       IF INITIALIZE FLAG NOT ALREADY SET 
 TPS9     LCN    0           CLEAR INITIALIZE FLAG
          LMD    IR+3 
          RJM    TLB
 TPS10    LDD    IR+3        CHECK REQUEST
          SBN    LIFD 
          MJN    TPS12       IF NOT FULL INITIALIZE REQUEST 
          LDD    AB 
          LPC    MLIPF+MLIQF
          ZJN    TPS11       IF PARTIAL INITIALIZE NOT SET
          CMSTF  LIPF 
          CMSTF  LIQF 
 TPS11    LDD    AB+1 
          LPC    MLIDF+MLIAF+MLIEF+MLIMF
          ZJN    TPS12       IF NO DAYFILE INITIALIZATION SET 
          CMSTF  LIDF 
          CMSTF  LIAF 
          CMSTF  LIEF 
          CMSTF  LIMF 
 TPS12    LDD    MS          REREAD INITIALIZE STATUS FROM MST
          SHN    3
          ADN    STLL 
          CRD    AB 
          LDD    AB+1 
          SCN    77 
          SHN    6
          LMD    AB 
          SCN    MLIRP+MLUNL+MLCKP+MLDUL+MRASD+MLPTU
          ZJN    TPS13       IF NO INITIALIZE FLAGS SET 
          LCN    0
 TPS13    LMC    -LIRP       SET/CLEAR INITIALIZE PENDING 
          RJM    TLB
          LJM    TPS2        LOOP 
  
  
 TPSA     VFD    60/0        EQUIPMENT LIST 
 VMS      SPACE  4,10 
***       VMSF - VERIFY MASS STORAGE FUNCTION.
* 
*         ENTRY  (IR+4) = EST ORDINAL.
  
  
 VMS      ENTRY              ENTRY/EXIT 
          LDD    IR+4        SET EST ORDINAL
          STD    T5 
          SFA    EST
          ADK    EQDE 
          CRD    CM 
          LDD    CM+4        GET MST PARAMETERS 
          SHN    3
          ADN    SDGL 
          CRD    CM 
          ADN    STLL-SDGL
          CRD    AB 
          LDD    AB+1        EXTRACT CURRENT ERROR STATUS 
          LPN    77 
          STD    T7 
          LDD    CM+4 
          LPN    1
          ZJN    VMS1        IF DEVICE NOT INTERLOCKED
          LDD    T7          CHECK CURRENT ERROR STATUS 
          LMN    STVE 
          SHN    14 
          NJN    VMS1        IF NOT INTERLOCKED WITH VALIDATION ERROR 
          SMSTF  LPTU        PROHIBIT TRT UPDATE BY *1RU* 
          LDN    VEQS&VEIS
 VMS1     LMK    VEIS        SET UP MONITOR CALL
          STD    CM+3 
          LDD    T5 
          STD    CM+1 
          MONITOR  VMSM       REQUEST MASS STORAGE VALIDATION 
          LDD    CM+1 
          NJN    VMS3        IF VALIDATION NOT SUCCESSFUL 
          CMSTF  LPTU        ALLOW TRT UPDATES BY *1RU* 
          LDD    T7          CHECK PREVIOUS ERROR STATUS
          LMN    STVE 
          NJN    VMS2        IF NOT VALIDATION ERROR
          RJM    SES         CLEAR MST ERROR STATUS 
          LDN    NCPL 
          CRD    CN 
          AOD    CN+1        CLEAR MESSAGE AT SYSTEM CONTROL POINT
          SHN    7
          ADN    MS2W 
          CWD    CM 
          CMSTF  GDEI        CLEAR ERROR IDLE FLAG
          SMSTF  LCKP        SET CHECKPOINT REQUEST 
 VMS2     LJM    VMSX        RETURN 
  
 VMS3     STD    IR+2        SET ERROR CODES
          LDD    T7          CHECK PREVIOUS ERROR STATUS
          SBN    MNEC 
          PJN    VMS4        IF PREVIOUS ERROR NOT TO BE CHANGED
          LDD    TH 
          RAD    T5 
          LDN    STVE   SET ERROR STATUS IN MST 
          RJM    SES
 VMS4     LDD    T5          SET EST ORDINAL FOR *5ME*
          STD    IR+3 
          EXECUTE 5ME 
          UJN    VMS2        RETURN 
 DOD      SPACE  4,10 
**        DOD - DISMOUNT OPTICAL DRIVE. 
* 
*         ENTRY  (T5) = EST ORDINAL.
* 
*         USES   CM+1.
* 
*         CALLS  (1OS). 
* 
*         MACROS DELAY, MONITOR.
  
  
 DOD2     LDD    CP          CLEAR WAIT MESSAGE 
          ADK    MS2W 
          CWD    CM 
  
 DOD      SUBR               ENTRY/EXIT 
          LDM    IDSC        PASS RELEVANT CALL DATA ON TO *1OS*
          STM    DODA+2 
          LDD    IR+3 
          STM    DODA+3 
          LDD    IR+4 
          STM    DODA+4 
 DOD1     LDD    MA          PLACE REQUEST IN MESSAGE BUFFER
          CWM    DODA,ON
          LDN    0
          STD    CM+1 
          MONITOR  RPPM      CALL *1OS* 
          LDD    CM+1 
          NJP    DOD2        IF PP ASSIGNED OR IN REQUEST QUEUE 
          LDD    CP          ISSUE WAIT MESSAGE 
          ADK    MS2W 
          CWM    DODB,TR
          DELAY  100D        DELAY BETWEEN *1OS* CALLS
          UJN    DOD1        RETRY *1OS* CALL 
  
  
 DODA     VFD    18/3R1OS,6/0,12/0,12/0,12/0
 DODB     DATA   C*WAITING FOR PP.* 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 QUAL$    EQU    0           DON-T QUALIFY COMMON DECKS 
*CALL     COMPCLC 
*CALL     COMPSES 
*CALL     COMPSMI 
  
  
 L0SD     EQU    *+2         *0SD* LOAD ADDRESS 
  
          ERRNG  BFMS-L0SD-ZSDL  *0SD* OVERFLOW 
  
          OVERFLOW  OVLA,/OVERLAY/BUFB
          OVERLAY  (IAF/MAGNET FUNCTIONS.)
 DIA      SPACE  4,10 
***       FUNCTION DIAF - SEND MESSAGE TO *IAF* USER. 
* 
*         ENTRY  (CP) = *IAF* CONTROL POINT ADDRESS.
*                (IR+3) = USER TERMINAL NUMBER. 
*                       = 7777 IF DIALING ALL TERMINALS.
*                (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/. 
  
  
 DIA      ENTRY              ENTRY/EXIT 
          LDC    IFSI        FIND *IAF* 
          RJM    CSS
          CHKERR             CHECK ERROR FLAG 
          NJN    DIAX        IF ERROR FLAG
          LDN    1           INITIALIZE TERMINAL COUNT
          STD    SR+4 
          LDN    40          INITIALIZE NO POT CHAIN RETRY COUNT
          STD    AB 
          LDD    IR+3        GET TERMINAL NUMBER
          LMC    7777        CHECK FOR DIAL ALL REQUEST 
          NJP    DIA2        IF DIALING A SPECIFIC JSN
          LDK    /REM/VPST   INITIALIZE TERMINAL NUMBER 
          STD    IR+3 
          LDD    RA 
          SHN    6
          ADK    /REM/VTTP
          CRD    CN          GET FWA OF TERMINAL TABLE
          ADK    /REM/VMNL-/REM/VTTP
          CRD    SR          GET MAX NUMBER OF TERMINALS
          LDN    2           SET WORD COUNT FOR CM READ 
          STD    CN 
          LDK    /REM/VPST*/REM/VTTL
 DIA1     RAD    CN+2 
          SHN    -14
          RAD    CN+1 
          SHN    6           CALCULATE ADDRESS FOR THIS ENTRY 
          ADD    RA 
          SHN    6
          ADD    CN+2 
          ADK    /REM/VFST
          CRD    T1          READ JSN 
          ADK    /REM/VDCT-/REM/VFST  GET OUTPUT POT POINTERS 
          ERRNZ  /REM/VSTT-/REM/VDCT-1  CODE REQUIRES CONTIGUOUS WORDS
          CRM    T3,CN
          LDD    T1 
          ZJN    DIA3        IF ENTRY NOT IN USE
          STM    DIAA+7      PLACE JSN IN FAILURE MESSAGE 
          LDD    T3+4 
          ADD    T3+5+4 
          ZJN    DIA2        IF OUTPUT NOT ALREADY QUEUED 
          LDD    T2 
          STM    DIAA+10
          LDC    DIAA 
          RJM    DFM         SEND FAILURE MESSAGE TO DAYFILE
          UJN    DIA3        CHECK FOR ERROR
  
 DIA2     LDN    3           ONE HEADER AND TWO LINKAGE WORDS 
          RJM    SBT         FILL POTS WITH MESSAGE 
          ZJN    DIA7        IF NO POT CHAIN AVAILABLE
          LDN    40          RESET NO POT CHAIN RETRY COUNT 
          STD    AB 
          LDD    IR+3 
          STM    WARA+4      ADD TERMINAL NUMBER TO REQUEST 
          RJM    ITR         ISSUE *TSEM* REQUEST 
 DIA3     CHKERR             CHECK ERROR FLAG 
          NJN    DIA6        IF ERROR FLAG SET
          AOD    IR+3        INCREMENT TERMINAL NUMBER
          SOD    SR+4        DECREMENT TERMINAL COUNT 
          ZJN    DIA6        IF ALL TERMINALS DIALED
          LDN    /REM/VTTL   ADVANCE TERMINAL TABLE POINTER 
 DIA4     UJP    DIA1        READ TERMINAL TABLE ENTRY
  
 DIA5     LDC    DIAB        *DIAL - NO POT CHAIN.* 
          RJM    DFM         SEND FAILURE MESSAGE 
 DIA6     LJM    DIAX        RETURN 
  
 DIA7     SOD    AB          DECREMENT NO POT CHAIN RETRY COUNT 
          MJN    DIA5        IF THROUGH RETRYING
          LDC    1400        DELAY 100 MILLISECONDS AND RETRY 
          STD    T0 
 DIA8     DELAY 
          CHKERR             CHECK ERROR FLAG 
          NJN    DIA6        IF ERROR FLAG SET
          SOD    T0 
          NJN    DIA8        IF NOT THROUGH DELAYING
          UJN    DIA4        RETRY DIAL 
  
  
 DIAA     DATA   C*OUTPUT BUSY - JSNX.* 
 DIAB     DATA   C*DIAL - NO POT CHAIN.*
 KIJ      SPACE  4,10 
***       FUNCTION KIJF - KILL INTERACTIVE JOB. 
* 
*         ENTRY  (IR+3 - IR+4) = JSN. 
  
  
 KIJ      ENTRY              ENTRY/EXIT 
          LDD    MA          COPY JSN INTO (AB - AB+1)
          CWD    IR+3 
          CRD    AB 
          LDN    /REM/VCPT   MOVE TO *IAF* CP 
          STD    CM+1 
          MONITOR  CCAM 
          LDD    CM+1 
          NJP    IDS2        IF UNABLE TO CHANGE CONTROL POINTS 
          LDC    IFSI        CHECK IF IAF PRESENT 
          RJM    CSS
*         LDN    0
          STD    AB+3        INITIALIZE TERMINAL NUMBER 
          LDD    RA          SET *IAF* RA 
          STD    T7 
          RJM    GTN         GET TERMINAL NUMBER
          MJN    KIJX        IF NOT FOUND 
          LDD    AB+3        SET TERMINAL NUMBER
          STM    WARA+4 
          LDC    /REM/VTLF
          STM    WARA 
          LDN    2           SET UNCONDITIONAL LOGOFF 
          STM    WARA+2 
          RJM    ITR         ISSUE *TSEM* REQUEST 
          LJM    KIJX        RETURN 
 WAR      SPACE  4,10 
***       FUNCTION WARF - SEND *IAF* WARNING MESSAGE. 
* 
*         ENTRY  (CP) = *IAF* CONTROL POINT ADDRESS.
*                (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/. 
  
  
 WAR      ENTRY              ENTRY/EXIT 
          LDC    IFSI        FIND *IAF* 
          RJM    CSS
          LDD    IR+4 
          SHN    -6 
          NJN    WAR1        IF NOT CLEAR PREVIOUS MESSAGE
          LDC    2R"NL"      SET NEW LINE TO CLEAR BUFFER 
          STM    BFMS+5*6+2 
          UJN    WAR2        CLEAR OLD MESSAGE
  
 WAR1     LDN    TIML        SET TIME 
          CRM    BFMS+5*3,ON
          LDD    MA          SET WARNING
          CWM    =C* WARNING*,ON
          SBN    1
          CRM    BFMS+5*4,ON
          LDN    ZERL 
          CRM    BFMS+5*5,ON
          CHKERR
          NJN    WAR4        IF ERROR FLAG
          LDN    6           FOUR HEADER AND TWO LINKAGE WORDS
          RJM    SBT         FILL POTS WITH MESSAGE 
          ZJN    WAR4        IF POT CHAIN NOT AVAILABLE 
 WAR2     LDC    BFMS+5*6+2-1  FIND NEW LINE
          STD    T1 
 WAR3     AOD    T1 
          LDI    T1 
          LMC    2R"NL" 
          NJN    WAR3        IF NOT FOUND 
          STI    T1          SET MESSAGE TERMINATOR 
          RJM    ITR         ISSUE *TSEM* REQUEST 
          ZJN    WAR4        IF IAF NOT AVAILABLE 
          LDD    CP          COPY MESSAGE TO B DISPLAY
          ADN    MS1W 
          CWM    BFMS+5*6+2,FV
 WAR4     LJM    WARX        EXIT 
  
  
 WARA     CON    /REM/VMSG
          CON    0
          CON    0           LAST POT FILLED
          CON    0           FIRST POT FILLED 
          CON    0           TERMINAL NUMBER (DIAL) 
 EUF      SPACE  4,10 
***       FUNCTION EUFF - ENTER MAGNET UDT ENTRY. 
* 
*         ENTRY  (IR+3) = OFFSET INTO KEYBOARD BUFFER.
  
  
 EUF      ENTRY              ENTRY/EXIT 
  
*         CHECK MAGNET STATUS AND FIND UDT ENTRY. 
  
          LDC    MTSI 
          RJM    CSS         CHECK MAGNET STATUS
          LDK    /1DS/DSDL+/1DS/KBCML  GET REQUEST
          CRD    AB 
          LDD    RA 
          SHN    6
          ADC    /MTX/UBUF   GET UDT POINTERS 
          CRD    T1 
          LDD    T1+3        SET UDT ADDRESS
          LPN    77 
          RAM    UADA 
          LDD    T1+4 
          STM    UADA+1 
 EUF1     RJM    UAD         SET UDT ADDRESS
          CRD    T1 
          ADK    /MTX/UST1   GET EST ORDINAL
          CRD    CM 
          ADK    /MTX/UVRI-/MTX/UST1  GET EJT ORDINAL 
          CRD    CN 
          LDD    T1 
          SHN    -13
          LMN    1
          ZJN    EUF3        IF END OF UDT
          LDD    AB+1 
          LMD    CM+2 
          ZJN    EUF2        IF UDT ENTRY FOUND 
          AOM    IMRA        ADVANCE UDT ORDINAL
          LMK    /MTX/MUNIT 
          ZJN    EUF3        IF BEYOND MAXIMUM UDT
          LDK    /MTX/UNITL  ADVANCE UDT ADDRESS
          RAM    UADA+1 
          SHN    -14
          RAM    UADA 
          UJN    EUF1        CHECK NEXT UNIT
  
*         DETERMINE IF REQUEST ALLOWED ON UNIT. 
  
 EUF2     LDD    CM 
          SHN    -1 
          LPN    1           ACS UNIT FLAG
          RAM    EUFA 
          LDM    TMRF,AB     SET TABLE ADDRESS FOR REQUEST
 EUFA     LPN    1
*         LPN    2           (ACS UNIT) 
 EUF3     ZJN    EUF5        IF REQUEST NOT ALLOWED ON UNIT 
          LDM    TMRF,AB
          SHN    21-2 
          PJN    EUF3.1      IF UNASSIGNED UNIT NOT REQUIRED
          LDD    CN 
          NJN    EUF5        IF UNIT ASSIGNED TO JOB
          UJN    EUF4        SET PROCESSOR ADDRESS
  
 EUF3.1   LDD    CN 
          ZJN    EUF5        IF UNIT NOT ASSIGNED 
          LDD    CN+4 
          SHN    21-0 
          PJN    EUF5        IF NO PREVIEW DISPLAY MESSAGE
 EUF4     LDM    TMRP,AB     SET PROCESSOR ADDRESS
          STD    T1 
          RJM    0,T1        CALL PROCESSOR 
          NJN    EUF6        IF ERROR 
          RJM    IMR         ISSUE MAGNET REQUEST 
          UJN    EUF7        RETURN 
  
 EUF5     LDN    1           SET INCORRECT EQUIPMENT ERROR
 EUF6     RJM    SRD         SET RETURN STATUS
 EUF7     LJM    EUFX        RETURN 
 TMRF     SPACE  4,15 
**        TMRF - TABLE OF MAGNET REQUEST FLAGS. 
* 
*         ENTRY FORMAT -
* 
*T        9/0,1/U,1/A,1/N 
* 
*         U      UNASSIGNED UNIT REQUIRED.
*         A      REQUEST ALLOWED ON ACS UNITS.
*         N      REQUEST ALLOWED ON NON-ACS UNITS.
  
  
 TMRF     INDEX 
          INDEX  /MTX/XEV,5  ENTER VSN
          INDEX  /MTX/XUU,7  UNLOAD UNIT
          INDEX  /MTX/XSV,5  ENTER SCRATCH VSN
          INDEX  /MTX/XRT,3  SET *RETRY* FLAG 
          INDEX  /MTX/XUG,3  UNIT GO
          INDEX  /MTX/XUS,3  UNIT STOP
          INDEX  /MTX/XTR,3  SET *TERMINATE* FLAG 
          INDEX  /MTX/XMU,6  ACS UNIT MOUNT 
          INDEX  /MTX/XNV,3  SPECIFY NEXT VSN 
          INDEX  /MTX/XRMX
 TMRP     SPACE  4,15 
**        TMRP - TABLE OF MAGNET REQUEST PROCESSORS.
  
  
 TMRP     INDEX 
          INDEX  /MTX/XEV,CVR  ENTER VSN
          INDEX  /MTX/XUU,CLC  UNLOAD UNIT
          INDEX  /MTX/XSV,CLC  ENTER SCRATCH VSN
          INDEX  /MTX/XRT,CLE  SET *RETRY* FLAG 
          INDEX  /MTX/XUG,CUG  UNIT GO
          INDEX  /MTX/XUS,CUG  UNIT STOP
          INDEX  /MTX/XTR,CLE  SET *TERMINATE* FLAG 
          INDEX  /MTX/XMU,CAM  ACS UNIT MOUNT 
          INDEX  /MTX/XNV,CNV  SPECIFY NEXT VSN 
          INDEX  /MTX/XRMX
          TITLE  IAF FUNCTION SUBROUTINES.
 ITR      SPACE  4,10 
**        ITR - ISSUE *TSEM* REQUEST. 
* 
*         ENTRY  (WARA - WARA+4) = FORMATTED *TSEM* REQUEST.
* 
*         EXIT   (A) .EQ. 0, IF IAF UNAVAILABLE.
*                    .NE. 0, IF REQUEST SENT. 
* 
*         USES   T2, CM - CM+4. 
* 
*         MACROS DELAY, MONITOR, CHKERR.
  
  
 ITR3     LDN    0
  
 ITR      SUBR               ENTRY/EXIT 
 ITR1     LDD    MA          ISSUE *TSEM* REQUEST 
          CWM    WARA,ON
          LDK    ZERL 
          CRD    CM 
          MONITOR  TSEM 
          LDD    CM+1 
          ZJN    ITRX        IF IAF UNAVAILABLE 
          LMC    7777 
          NJN    ITRX        IF REQUEST COMPLETE
          LDC    7313        REISSUE REQUEST AFTER ONE HALF SECOND
          STD    T2 
 ITR2     DELAY 
          CHKERR
          NJN    ITR3        IF ERROR FLAG
          SOD    T2 
          ZJN    ITR1        IF TIME TO REISSUE REQUEST 
          UJN    ITR2        CONTINUE TO DELAY
 SBT      SPACE  4,15 
**        SBT - SET BUFFER AND TRANSFER DATA TO POTS. 
* 
*         ENTRY  (A) = NUMBER OF WORDS IN HEADER, INCLUDING THE FIRST 
*                      TWO WORDS USED FOR QUEUE LINKAGE BY IAF. 
* 
*         EXIT   (A) = 0, IF POTS NOT AVAILABLE.
*                (WARA+2 - WARA+3) = SET UP FOR *TSEM* REQUEST. 
* 
*         USES   T1, T2, T3.
* 
*         CALLS  RPK, SPA, UPP. 
* 
*         MACROS MONITOR. 
  
  
 SBT      SUBR               ENTRY/EXIT 
          STD    T3          COMPUTE ADDRESS OF FIRST WORD AFTER HEADER 
          SHN    2
          ADC    BFMS 
          RAD    T3 
          LDK    ZERL        PUT AN EOL IN THE FIRST WORD OF MESSAGE
          CRM    BFMS+5*2,ON
          LDK    2R"EM"      SET EXTENDED MODE AS FIRST BYTE OF HEADER
          STI    T3 
          LDK    2R"NL"      SET NEW LINE AS SECOND BYTE
          STM    1,T3 
          LDD    T3 
          ADN    2
          RJM    RPK         PACK MESSAGE AFTER HEADER
          LDN    0           ENSURE MESSAGE TERMINATOR AFTER FIVE WORDS 
          STM    1+5*5,T3 
 SBT1     AOD    T3          NEXT BYTE
          LDI    T3 
          NJN    SBT1        IF NOT END OF MESSAGE
          LDM    -1,T3       CHECK PREVIOUS BYTE
          LPN    77 
          NJN    SBT2        IF NOT ZERO CHARACTER IN LAST BYTE 
          LDN    1R          INSERT BLANK 
          RAM    -1,T3
 SBT2     LDC    2R"NL"      ISSUE NEW LINE 
          STI    T3 
          AOD    T3 
          LDK    2R"EB"      SET STOP BYTE
          STI    T3 
          AOD    T3 
          STM    SBTA 
          LDN    ZERL 
          CRM    *,ON        INSURE END OF LINE 
 SBTA     EQU    *-1
          LDN    5           ADVANCE BEYOND EOL 
          RAD    T3 
          LDN    0           SET CM WORD COUNT
          STD    T2 
          LDC    -BFMS
          RAD    T3 
 SBT3     AOD    T2 
          LCN    5
          RAD    T3 
          PJN    SBT3        IF NOT START OF MESSAGE
          LDN    /REM/VCPC
          STD    T3 
          LDK    ZERL        CALCULATE HOW MANY POTS ARE NEEDED 
          CRD    CM 
          LDD    T2 
          ADK    /REM/VCPC-1  ROUND UP TO THE NEAREST POT 
          SHN    -3 
          STD    CM+1 
          MONITOR  TGPM 
          LDC    BFMS        INITIALIZE BUFFER ADDRESS
          STM    SBTB 
          LDD    CM+1 
          ZJN    SBT5        IF IAF UNAVAILABLE 
          LMC    7777 
          ZJN    SBT5        IF POT QUEUE IN IAF CURRENTLY EMPTY
          LMC    7777 
          STD    PP 
          STM    WARA+3 
 SBT4     STM    WARA+2 
          RJM    SPA         SET POT ADDRESS
          CWM    *,T3 
 SBTB     EQU    *-1
          LCN    /REM/VCPC
          RAD    T2 
          SBN    1
          MJN    SBT5        IF TRANSFER COMPLETE 
          LDN    /REM/VCPC*5
          RAM    SBTB 
          RJM    UPP         UPDATE TO NEXT POT 
          NJN    SBT4        IF MORE POTS IN CHAIN
          LDN    1
 SBT5     LJM    SBTX        EXIT 
          TITLE  MAGNET FUNCTION SUBROUTINES. 
 CAM      SPACE  4,15 
**        CAM - CHECK ACS MOUNT REQUEST.
* 
*         EXIT   (A) = 0 IF MOUNT CAN BE PROCESSED. 
*                (A) = 1 IF UNIT STATUS PROHIBITS MOUNT.
*                (A) = 2 IF VSN ACTIVITY PROHIBITS MOUNT. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  FAV, UAD.
* 
*         MACROS SFA. 
  
  
 CAM2     LDN    1           SET EQUIPMENT ERROR
  
 CAM      SUBR               ENTRY/EXIT 
          SFA    EST,AB+1    GET EQUIPMENT STATUS 
          ADK    EQDE 
          CRD    CM 
          LDD    CM 
          LPN    3
          LMN    DWES 
          ZJN    CAM2        IF UNIT DOWN 
          LDD    CM+1 
          SHN    -11
          LMN    4
          ZJN    CAM1        IF UNIT ACCESSIBLE ON PRIMARY CHANNEL
          LDD    CM+2 
          SHN    -11
          LMN    4
          NJN    CAM2        IF NO ACCESS ON SECONDARY CHANNEL
 CAM1     RJM    UAD         SET UDT ADDRESS
          ADK    /MTX/UMST   GET MOUNT STATUS 
          CRD    CM 
          LDD    CM+4 
          LPN    7
          NJN    CAMX        IF NOT DISMOUNTED OR CONTROL PATH ERROR
          RJM    FAV         FIND ACS VSN 
          UJN    CAMX        RETURN WITH STATUS 
 CLE      SPACE  4,10 
**        CLE - CHECK LOAD POINT ERROR. 
* 
*         EXIT   (A) = 0 IF LOAD POINT ERROR OPERATOR PROMPT PRESENT. 
*                (A) = 1 IF NO LOAD POINT ERROR OPERATOR PROMPT.
* 
*         CALLS  GMC. 
  
  
 CLE      SUBR               ENTRY/EXIT 
          RJM    GMC         GET MESSAGE CODE 
          LMN    /RSX/TCF 
          ZJN    CLEX        IF LOAD POINT ERROR
          LMN    /RSX/BFR&/RSX/TCF
          ZJN    CLEX        IF LOAD POINT ERROR
          LMN    /RSX/BFW&/RSX/BFR
          ZJN    CLEX        IF LOAD POINT ERROR
          LDN    1           SET EQUIPMENT ERROR
          UJN    CLEX        RETURN 
 CLC      SPACE  4,10 
**        CLC - CHECK INITIAL LABEL CHECK COMPLETE. 
* 
*         EXIT   (A) = 0 IF INITIAL LABEL CHECK COMPLETE. 
*                (A) = 1 IF INITIAL LABEL CHECK NOT COMPLETE. 
*                (CM - CM+4) = *UVSN*.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  UAD. 
  
  
 CLC1     LDN    1           SET EQUIPMENT ERROR
  
 CLC      SUBR               ENTRY/EXIT 
          RJM    UAD         SET UDT ADDRESS
          ADK    /MTX/UVSN   GET LABEL CHECK STATUS 
          CRD    CM 
          LDD    CM 
          ADD    CM+1 
          ADD    CM+2 
          ZJN    CLC1        IF LABELS NOT CHECKED
          LDD    CM+3 
          SHN    -13         CHECK FOR LABEL CHECK IN PROGRESS
          UJN    CLCX        RETURN WITH STATUS 
 CNV      SPACE  4,10 
**        CNV - CHECK *NEXTVSN* COMMAND REQUEST.
* 
*         EXIT   (A) = 0 IF NO ERROR. 
*                (A) = 1 IF ERROR.
* 
*         CALLS  GMC. 
  
  
 CNV      SUBR               ENTRY/EXIT 
          RJM    GMC         GET MESSAGE CODE 
          LMN    /RSX/NTV 
          ZJN    CNVX        IF NEXT VSN PROMPT 
          LDN    1           SET EUIPMENT ERROR 
          UJN    CNVX        RETURN 
 CUG      SPACE  4,10 
**        CUG - CHECK FOR TMS UNIT GO PROMPT. 
* 
*         EXIT   (A) = 0 IF UNIT GO PROMPT. 
*                (A) = 1 IF NO UNIT GO PROMPT.
* 
*         CALLS  GMC. 
  
  
 CUG      SUBR               ENTRY EXIT 
          RJM    GMC         GET MESSAGE CODE 
          LMN    /RSX/NLG 
          ZJN    CUGX        IF UNIT GO PROMPT
          LMN    /RSX/CAG&/RSX/NLG
          ZJN    CUGX        IF UNIT GO PROMPT
          LMN    /RSX/WVG&/RSX/CAG
          ZJN    CUGX        IF UNIT GO PROMPT
          LDN    1           SET EQUIPMENT ERROR
          UJN    CUGX        RETURN 
 CVR      SPACE  4,10 
**        CVR - CHECK ENTER VSN REQUEST.
* 
*         EXIT   (A) = 0 IF NO ERROR. 
*                (A) = 1 IF ERROR.
* 
*         CALLS  CLC. 
  
  
 CVR      SUBR               ENTRY/EXIT 
          RJM    CLC         CHECK LABEL CHECK COMPLETE 
          NJN    CVRX        IF LABELS NOT CHECKED
          LDD    AB+2 
          ADD    AB+3 
          ADD    AB+4 
          ZJN    CVRX        IF CLEARING VSN
          LDD    CM+3 
          LPN    4
          LMN    4
          ZJN    CVRX        IF UNLABELED TAPE
          LDN    1           SET EQUIPMENT ERROR
          UJN    CVRX        RETURN 
 CVS      SPACE  4,10 
**        CVS - COMPARE VSN-S.
* 
*         ENTRY  (AB+2 - AB+4) = REQUESTED VSN. 
*                (CM - CM+2) = VSN TO COMPARE.
* 
*         EXIT   (A) = 0 IF VSN-S MATCH.
*                (A) .NE. 0 IF VSN-S DO NOT MATCH.
  
  
 CVS      SUBR               ENTRY/EXIT 
          LDD    CM 
          LMD    AB+2 
          NJN    CVSX        IF NO MATCH
          LDD    CM+1 
          LMD    AB+3 
          NJN    CVSX        IF NO MATCH
          LDD    CM+2 
          LMD    AB+4 
          UJN    CVSX        RETURN WITH STATUS 
 FAV      SPACE  4,10 
**        FAV - FIND ACS VSN. 
* 
*         EXIT   (A) = 0 IF VSN NOT FOUND IN UDT OR VSN ERROR TABLE.
*                (A) = 2 IF VSN FOUND IN UDT OR VSN ERROR TABLE.
* 
*         USES   CM - CM+4, CN - CN+4, T1 - T1+4. 
* 
*         CALLS  CVS. 
  
  
 FAV      SUBR               ENTRY/EXIT 
  
*         CHECK UDT.
  
          LDD    RA 
          SHN    6
          ADK    /MTX/UBUF   GET UDT POINTERS 
          CRD    T1 
          LDN    0           INITIALIZE UDT ORDINAL 
          STD    T1 
 FAV1     LDD    T4 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    T5 
          CRD    CN 
          ADK    /MTX/UMST
          CRD    CM 
          LDD    CN 
          SHN    21-13
          MJN    FAV2        IF END OF UDT
          RJM    CVS         COMPARE VSN-S
          ZJN    FAV4        IF VSN FOUND 
          LDK    /MTX/UNITL  ADVANCE UDT ADDRESS
          RAD    T5 
          SHN    -14
          RAD    T4 
          AOD    T1 
          LMN    /MTX/MUNIT 
          ZJN    FAV4        IF BEYOND MAXIMUM UDT
          UJN    FAV1        CHECK NEXT UNIT
  
*         CHECK VSN ERROR TABLE.
  
 FAV2     LDN    0           INITIALIZE ERROR TABLE INDEX 
          STD    T1 
 FAV3     LDD    RA          SET ERROR TABLE ADDRESS
          SHN    6
          ADK    /MTX/VET 
          ADD    T1 
          CRD    CM          GET ERROR TABLE ENTRY
          LDD    CM 
          ZJN    FAV5        IF END OF ENTRIES
          RJM    CVS         COMPARE VSN-S
          ZJN    FAV4        IF VSN FOUND 
          AOD    T1          ADVANCE ENTRY INDEX
          LMK    /MTX/VETL
          NJN    FAV3        IF NOT BEYOND MAXIMUM ENTRY
  
*         RETURN STATUS.
  
 FAV4     LDN    2           SET VSN ERROR
 FAV5     LJM    FAVX        RETURN 
 GMC      SPACE  4,10 
**        GMC - GET PREVIEW DISPLAY MESSAGE CODE. 
* 
*         EXIT   (A) = PREVIEW DISPLAY MESSAGE CODE.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  UAD. 
  
  
 GMC      SUBR               ENTRY/EXIT 
          RJM    UAD         SET UDT ADDRESS
          ADK    /MTX/UISN   GET PREVIEW DISPLAY MESSAGE CODE 
          CRD    CM 
          LDD    CM+3 
          LPN    77          SET MESSAGE CODE 
          UJN    GMCX        RETURN 
 IMR      SPACE  4,10 
**        IMR - ISSUE MAGNET EXTERNAL REQUEST.
* 
*         USES   AB+1, T1, CM+1 - CM+4. 
* 
*         MACROS DELAY, MONITOR, PAUSE. 
  
  
 IMR      SUBR               ENTRY/EXIT 
          LDC    0           SET UDT ORDINAL
 IMRA     EQU    *-1         (UDT ORDINAL)
          STD    AB+1 
          LDD    MA          SET REQUEST
          CWD    AB 
          LDC    250D        SET 1 SECOND RETRY LIMIT 
          STD    T1 
 IMR1     LDN    1           SET WRITE FLAG 
          STD    CM+1 
          LCN    7777-MTSI   SET SUBSYSTEM ID 
          STD    CM+2 
          LDD    HN          SET WORD COUNT 
          STD    CM+3 
          LDN    /MTX/XREQ   SET WRITE ADDRESS
          STD    CM+4 
          MONITOR  TDAM 
          LDD    CM+1 
          ZJN    IMRX        IF TRANSFER COMPLETE 
          SBN    4
          ZJN    IMRX        IF *MAGNET* NOT ACTIVE 
          SOD    T1 
          ZJN    IMRX        IF MAXIMUM RETRIES 
          PAUSE  ST 
          DELAY  40          DELAY 4 MILLISECONDS 
          UJN    IMR1        RETRY FUNCTION 
 UAD      SPACE  4,10 
**        UAD - SET UDT ADDRESS.
* 
*         EXIT   (A) = ABSOLUTE UDT ADDRESS.
  
  
 UAD      SUBR               ENTRY/EXIT 
          LDD    RA 
          SHN    6
 UADA     ADC    0           SET UDT ADDRESS
          UJN    UADX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPSPA 
*CALL     COMPUPP 
*CALL     COMPGTN 
  
  
          OVERFLOW  OVLA,/OVERLAY/BUFB
          OVERLAY  (MULTILEVEL SECURITY FUNCTIONS.) 
 SAM      SPACE  4,10 
***       FUNCTION SAMF - SEND ACCOUNT FILE MESSAGE.
* 
*         ENTRY  (IR+3) = 2/T, 4/, 3/LA, 3/UA.
*                         T = 0, IF *MSOT* MESSAGE. 
*                           = 1, IF *MSLK* MESSAGE. 
*                           = 2, IF *MSEQ* MESSAGE. 
*                           = 3, IF *MSUL* MESSAGE. 
*                         LA = NEW LOWER ACCESS LEVEL LIMIT.
*                         UA = NEW UPPER ACCESS LEVEL LIMIT.
*                (IR+4) = 12/ORD. 
*                         ORD = EST ORDINAL, IF *MSEQ* MESSAGE. 
*                             = ORIGIN TYPE ORDINAL, IF *MSOT* MESSAGE. 
  
  
 SAM      ENTRY              ENTRY/EXIT 
          LDD    IR+3 
          SHN    21-12
          PJN    SAM2        IF NOT *MSLK* OR *MSUL* MESSAGE
          LPN    1
          ZJN    SAM1        IF *MSLK*
          LDC    2RUL&2RLK
 SAM1     LMC    2RLK 
          STM    SAMA+1      CHANGE ACCOUNT FILE MESSAGE
          LDC    2R.         APPEND PERIOD
          STM    SAMA+2 
          LJM    SAM6        ISSUE MESSAGE
  
 SAM2     LPN    1
          ZJN    SAM3        IF *MSOT* MESSAGE
          LDD    IR+4        CONVERT EST ORDINAL TO DISPLAY CODE
          SHN    -3 
          RJM    C2D
          STM    SAMA+3 
          LDD    IR+4 
          LPN    7
          ADN    1R0
          SHN    6
          STM    SAMC        TEMPORARILY SAVE DISPLAY-CODED ORDINAL 
          LDC    SAMB        FWA OF MESSAGE BUFFER
          STD    T1 
          LDC    SAMC        ADDRESS OF EST ORDINAL 
          RJM    ACS
          UJN    SAM4        APPEND COMMA 
  
 SAM3     LDC    2ROT        CHANGE ACCOUNT FILE MESSAGE
          STM    SAMA+1 
          LDM    TJOT,IR+4   SAVE ORIGIN TYPE 
          STM    SAMA+3 
          LDC    SAMB        FWA OF MESSAGE BUFFER
          STD    T1 
 SAM4     LDC    =C*, * 
          RJM    ACS         APPEND COMMA 
          LDD    IR+3        DETERMINE MNEMONIC OF LOWER ACCESS LEVEL 
          SHN    -3 
          LPN    7
          SHN    2
          ADC    TALV        APPEND NEW LOWER ACCESS LEVEL LIMIT
          RJM    ACS
          LDC    =C*, *      APPEND COMMA 
          RJM    ACS
          LDD    IR+3        DETERMINE MNEMONIC OF UPPER ACCESS LEVEL 
          LPN    7
          SHN    2
          ADC    TALV        APPEND NEW UPPER ACCESS LEVEL LIMIT
          RJM    ACS
          LDC    =C*. *      TERMINATE MESSAGE WITH A PERIOD
          RJM    ACS
 SAM6     LDC    ACFN+SAMA   ISSUE ACCOUNT FILE MESSAGE 
          RJM    DFM
          LJM    SAMX        RETURN 
  
 SAMA     DATA   C*MSEQ, *
 SAMB     BSSZ   13 
 SAMC     BSS    1           TEMPORARY STORAGE LOCATION 
 TJOT     SPACE  4,10 
*         TJOT - TABLE OF JOB ORIGIN TYPES. 
  
 TJOT     DATA   H+"NMOT"+
 VSA      SPACE  4,10 
***       FUNCTION VSAF - VALIDATE SECURITY-UNLOCK ACCESS.
* 
*         ENTRY  (IR+4) = BUFFER OFFSET.
  
  
 VSA      ENTRY              ENTRY/EXIT 
          LDN    /1DS/KBCML  READ KEYBOARD BUFFER 
          STD    BA 
          LDC    /1DS/DSDL
          CRM    VSAA,BA
          LDD    IR+4        SET POINTER TO BUFFER
          ADC    VSAA 
          STD    BA 
          RJM    ASN         EXTRACT USERNAME 
          LDC    VSAB+3      SET POINTER TO ACCOUNT FILE MESSAGE
          STD    T1 
          LDN    AB          APPEND USERNAME TO ACCOUNT FILE MESSAGE
          RJM    ACS
          LDC    =C*. *      TERMINATE MESSAGE WITH A PERIOD
          RJM    ACS
          AOD    BA          SKIP SEPARATOR 
          LDN    ZERL        FORCE SYSTEM DEFAULT FAMILY
          CRD    CN 
          LDC    1R0*100
          STD    CN 
          EXECUTE  0AV,L0AV  GET USER VALIDATION INFORMATION
          LDD    T1          CHECK FOR USER INDEX 
          ADD    T2 
          ZJN    VSA2        IF USER NOT VALID
          RJM    ASN         EXTRACT PASSWORD 
          LDD    MA          SET PARAMETER FOR *RDCM* CALL
          CWD    AB 
          LDN    REPS        ENCRYPT SUPPLIED PASSWORD
          STD    CM+1 
          MONITOR  RDCM 
          LDD    MA 
          CRD    AB 
          LDD    AB          COMPARE ENCRYPTED PASSWORDS
          LMM    APSW*5,T3
          NJN    VSA2        IF NO MATCH
          LDD    AB+1 
          LMM    APSW*5+1,T3
          NJN    VSA2        IF NO MATCH
          LDD    AB+2 
          LMM    APSW*5+2,T3
          NJN    VSA2        IF NO MATCH
          LDD    AB+3 
          LMM    APSW*5+3,T3
          SCN    77 
          ZJN    VSA3        IF MATCH 
 VSA2     LDC    2RSI        CONVERT ACCOUNT FILE MESSAGE 
          STM    VSAB+1 
          LDN    1           ERROR CONDITION
          RJM    SRD         SAVE RESPONSE TO *DSD* 
 VSA2.1   LDC    ACFN+VSAB   ISSUE ACCOUNT FILE MESSAGE 
          RJM    DFM
          LJM    VSAX        RETURN ERROR 
  
*         CHECK FOR SECURITY ADMINISTRATOR PRIVILEGES.
  
 VSA3     LDM    ASVW*5,T3
          SHN    21-13
          PJN    VSA2        IF NOT SECURITY ADMINISTRATOR
          LDN    SSTL        SET SECURITY UNLOCK
          CRD    AB 
          LDD    AB 
          LPC    6377 
          LMC    1400 
          STD    AB 
          LDN    SSTL 
          CWD    AB 
          UJN    VSA2.1      ISSUE ACCOUNT FILE MESSAGE 
  
 VSAA     BSSZ   /1DS/KBCML*5   KEYBOARD BUFFER 
 VSAB     DATA   C*MSSA, *
 VSAC     BSSZ   5
          SPACE  4,10 
**        ASN - ASSEMBLE NAME.
* 
*         ENTRY  (BA) = CHARACTER ADDRESS.
* 
*         EXIT   (AB - AB+4) = ASSEMBLED NAME LEFT JUSTIFIED WITH 
*                ZERO FILL. 
*                (CA)   ADVANCED TO SEPARATOR CHARACTER.
* 
*         USES   T1, BA, AB - AB+4. 
  
  
 ASN      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR ASSEMBLY BUFFER
          CRD    AB 
          LDN    AB          SET BYTE ADDRESS 
          STD    T1 
 ASN1     LDI    BA          CHECK CHARACTER
          ZJN    ASNX        IF END OF STRING 
          SBN    1R9+1
          PJN    ASNX        IF SEPARATOR 
          ADN    1R9+1       STORE UPPER
          SHN    6
          STI    T1 
          AOD    BA          ADVANCE CHARACTER
          LDI    BA          CHECK CHARACTER
          ZJN    ASNX        IF END OF STRING 
          SBN    1R9+1
          PJN    ASNX        IF SEPARATOR 
          ADN    1R9+1       STORE LOWER
          RAI    T1 
          AOD    BA          ADVANCE CHARACTER
          AOD    T1          ADVANCE BYTE 
          LMN    AB+5 
          NJN    ASN1        IF NOT 5 BYTES 
          UJN    ASNX        RETURN 
          SPACE  4,10 
*         COMMON DECKS. 
  
  
          QUAL
 VAL$     EQU    1           DEFINE ACCESS LEVEL TABLE
*CALL     COMPVLC 
          QUAL   *
  
  
          USE    LITERALS 
  
 L0AV     EQU    *+5         LOAD ADDRESS FOR *0AV* 
          ERRNG  BFMS-L0AV-ZAVL  *0AV* OVERFLOW 
  
  
          OVERFLOW  OVLA,/OVERLAY/BUFB
  
          ERRNG  L0AV-*      CODE OVERFLOWS INTO *0AV*
          OVERLAY  (*SERVICE* COMMAND PROCESSOR.) 
 SER      SPACE  4,10 
***       FUNCTION SERF - PROCESS *SERVICE* COMMAND.
* 
*         ENTRY  (IR+4) = OFFSET IN KEYBOARD BUFFER TO START OF 
*                         COMMAND PARAMETERS. 
*                (IR+3) = SERVICE CLASS.
  
  
 SER      ENTRY              ENTRY/EXIT 
          LDN    CSAT-SVJT
          STD    SR+2        SET LENGTH OF SERVICE CONTROL BLOCK
          SFA    JCB,IR+3    GET JOB CONTROL BLOCK
          ADN    SVJT 
          CRM    SERF,SR+2
          SBD    SR+2        SAVE FWA OF WORDS READ 
          STD    T7 
          SHN    -14
          STD    T6 
          LDN    /1DS/KBCML  GET CONTENTS OF KEYBOARD BUFFER
          STD    T1 
          LDC    /1DS/DSDL
          CRM    CBUF,T1
          LDD    IR+4        GET ADDRESS OF COMMAND 
          ADK    CBUF+2      SKIP SERVICE CLASS 
          STD    CA 
  
*         PROCESS NEXT PARAMETER. 
  
 SER1     AOD    CA          SKIP SEPARATOR 
          LDC    TSVP        SEARCH PARAMETER TABLE 
          RJM    SPT
          MJN    SER2        IF NOT FOUND 
          STD    SR+1 
          SBN    TSVPE-TSVP 
          NJN    SER3        IF NOT *DT* PARAMETER
  
*         PROCESS *DT* PARAMETER. 
  
          LDC    TNSC        SEARCH FOR VALID SERVICE CLASS 
          RJM    SPT
          MJN    SER2        IF NOT FOUND 
          STD    AB+4 
          LMN    SSSC 
          ZJN    SER2        IF SUBSYSTEM SERVICE CLASS 
          LMN    DSSC&SSSC
          NJN    SER5        IF NOT DEADSTART SERVICE CLASS 
 SER2     LDN    1
          LJM    SER18       RETURN ERROR STATUS TO *DSD* 
  
 SER3     RJM    ASD         ASSEMBLE DIGITS
  
 SER5     LDM    SERE,SR+1   SET PROCESSOR ADDRESS
          STD    T5 
          LJM    0,T5        EXIT TO PROCESSOR
  
*         PROCESS *PR* PARAMETER. 
  
 SER6     LDD    AB+4 
          SBN    2
          MJN    SER2        IF PRIORITY .LT. 2 
          SBN    100-2
          PJN    SER2        IF PRIORITY .GE. 100B
          AOM    SERG        SET TO ISSUE *SCTM* FUNCTION 
          LJM    SER14       VALIDATE ASSEMBLY
  
*         PROCESS INDEX ENTRY.
  
 SER7     LDD    SR+1        SET FIELD POSITION 
          SBN    TSVPD-TSVP 
          STD    T2          MULTIPLY BY 3
          SHN    1
          ADD    T2          SET SHIFT INSTRUCTION
          LMD    TH 
          ERRNZ  SHNI-1000   CODE DEPENDS ON VALUE
          STM    SERA 
          STM    SERB 
          LCN    7           SET MASK FIELD 
 SERA     SHN    ** 
*         SHN    11          (DS) 
*         SHN    6           (FC) 
*         SHN    3           (CS) 
*         SHN    0           (FS) 
          STM    SERC 
          LDD    AB+4        SET NEW INDEX VALUE
          SBN    10 
          PJN    SER9        IF INVALID INDEX 
          ADN    10 
 SERB     SHN    ** 
*         SHN    11          (DS) 
*         SHN    6           (FC) 
*         SHN    3           (CS) 
*         SHN    0           (FS) 
          STD    CM 
          LDN    TSVPD-TSVP  SET SERVICE BLOCK INDEX
          STD    SR+1 
          LDM    SERF,SR+1   INSERT INDEX VALUE IN EXISTING BYTE
          LPC    ** 
 SERC     EQU    *-1
*         LPC    0777        (DS) 
*         LPC    7077        (FC) 
*         LPC    7707        (CS) 
*         LPC    7770        (FS) 
          LMD    CM 
          STD    AB+4 
          UJN    SER14       CHECK VALUE RANGE
  
*         PROCESS *RS* PARAMETER. 
  
 SER8     LDM    SERF+CSJT*5-SVJT*5+4  EXISTING *US* VALUE
          SBD    AB+4        SPECIFIED *RS* VALUE 
          UJN    SER8.2      ENSURE *RS* .LE. *US*
  
*         PROCESS *US* PARAMETER. 
  
 SER8.1   LDD    AB+4        SPECIFIED *US* VALUE 
          SBM    SERF+CSJT*5-SVJT*5+3  EXISTING *RS* VALUE
 SER8.2   MJN    SER9        IF *RS* .GT. *US*
          LDD    AB+4 
          ZJN    SER9        IF NOT VALID PARAMETER 
  
*         PROCESS *IT* AND *SE* PARAMETERS. 
  
 SER8.3   AOM    SERG        FORCE *SCTM*/*CCSS* MONITOR FUNCTION 
          UJN    SER14       CHECK VALUE RANGE
  
*         RETURN ERROR STATUS.
  
 SER9     LDN    1
          LJM    SER18       RETURN ERROR STATUS TO *DSD* 
  
 SER10    LDD    AB+3        ALLOW *AM* UP TO 77777 
          STM    SERF-1,SR+1
          SCN    7
          UJN    SER15       CHECK VALUE RANGE
  
 SER13    AOM    SERD        FLAG *NJ* PARAMETER
  
*         CHECK VALUE RANGE.
  
 SER14    LDD    AB+3        CHECK ASSEMBLY 
 SER15    ADD    AB+2 
          ADD    AB+1 
          ADD    AB 
          NJN    SER9        IF VALUE TOO LARGE 
  
*         STORE VALUE.
  
 SER16    LDD    AB+4        SET VALUE IN SERVICE CONTROL BLOCK 
          STM    SERF,SR+1
          LDI    CA          CHECK SEPARATOR
          LMN    1R,
          ZJP    SER1        IF NOT END OF PARAMETERS 
          LMN    1R.&1R,
          NJN    SER9        IF INCORRECT TERMINATION 
          LDD    T6 
          SHN    14 
          LMD    T7          STORE SERVICE CONTROL BLOCK
          CWM    SERF,SR+2
 SERD     LDN    0
          ZJN    SER17       IF NO *NJ* PARAMETER 
          LDN    ZERL 
          CRD    CM 
          LDN    /EVENT/SCFE ISSUE JOB LIMIT CHANGED EVENT
          STD    CM+4 
          MONITOR  EATM 
 SER17    LDN    0
 SERG     EQU    *-1
          ZJN    SER18       IF NO *SCTM* UPDATE REQUIRED 
          LDN    ZERL 
          CRD    CM 
          LDN    CCSS        CONVERT CPU SCHEDULING PARAMETERS
          STD    CM+1 
          LDD    IR+3        SET SERVICE CLASS
          STD    CM+4 
          MONITOR  SCTM      SET SYSTEM CONTROL PARAMETERS
*         LDN    0           RETURN NO ERROR TO *DSD* 
 SER18    RJM    SRD
          LJM    SERX        RETURN 
  
  
 SERE     BSS    0           SERVICE COMMAND PROCESSORS 
          CON    SER9        UNUSED 
          CON    SER14       *CT* PARAMETER 
          CON    SER14       *CM* PARAMETER 
          CON    SER13       *NJ* PARAMETER 
          CON    SER14       *TD* PARAMETER 
  
          CON    SER14       *CP* PARAMETER 
          CON    SER14       *TP* PARAMETER 
          CON    SER14       *FL* PARAMETER 
          CON    SER9        UNUSED 
          CON    SER10       *AM* PARAMETER 
  
          CON    SER9        UNUSED 
          CON    SER9        UNUSED 
          CON    SER14       *EC* PARAMETER 
          CON    SER9        UNUSED 
          CON    SER14       *EM* PARAMETER 
  
          CON    SER7        *FS* PARAMETER 
          CON    SER7        *CS* PARAMETER 
          CON    SER7        *FC* PARAMETER 
          CON    SER7        *DS* PARAMETER 
          CON    SER16       *DT* PARAMETER 
  
          CON    SER6        *PR* PARAMETER 
          CON    SER8.3      *IT* PARAMETER 
          CON    SER8.3      *SE* PARAMETER 
          CON    SER8        *RS* PARAMETER 
          CON    SER8.1      *US* PARAMETER 
  
 SERF     VFD    60/0        *SVJT* 
          VFD    60/0        *MCMT* 
          VFD    60/0        *MECT* 
          VFD    60/0        *PFCT* 
          VFD    60/0        *CSJT* 
 TNSC     SPACE  4,10 
**        TNSC - TABLE OF SERVICE CLASSES.
  
 TNSC     DATA   H+"NMSC"+
          CON    0           END OF TABLE 
 TSVP     SPACE  4,10 
**        TSVP - TABLE OF SERVICE PARAMETERS. 
* 
*T        12/ NAME
* 
*         NAME = TWO-CHARACTER MNEMONIC.
* 
*         THE TABLE IS INDEXED BY BYTE NUMBER, RELATIVE TO
*         JOB CONTROL BLOCK WORD *SVJT*.  HOWEVER, THE
*         TABLE ENTRIES FOR WORD *PFCT* ARE IN ORDER
*         BY 3-BIT FIELD.  SEE COMMENTS ON THE *PFCT* 
*         TABLE ENTRIES.
  
  
 TSVP     BSS    0
  
*         *SVJT*. 
  
          CON    6060 
          CON    2RCT        CONTROL POINT TIME SLICE 
          CON    2RCM        CENTRAL MEMORY TIME SLICE
          CON    2RNJ        NUMBER OF JOBS 
          CON    2RTD        TIME OUT DELAY (SUSPENDED JOBS)
  
*         *MCMT*. 
  
          CON    2RCP        CONTROL POINT SLICE PRIORITY 
          CON    2RTP        BASE PRIORITY FOR INTERACTIVE JOBS 
          CON    2RFL        MAXIMUM FIELD LENGTH PER JOB 
          CON    6060 
          CON    2RAM        MAXIMUM MEMORY AVAILABLE FOR ALL JOBS
  
*         *MECT*. 
  
          CON    6060 
          CON    6060 
          CON    2REC        MAXIMUM EXTENDED MEMORY PER JOB
          CON    6060 
          CON    2REM        MAXIMUM EXTENDED MEMORY FOR ALL JOBS 
  
*         *PFCT*. 
  
 TSVPD    CON    2RFS        INDIVIDUAL INDIRECT ACCESS FILE SIZE 
          CON    2RCS        CUMULATIVE INDIRECT ACCESS FILE SIZE 
          CON    2RFC        NUMBER OF FILES IN CATALOG 
          CON    2RDS        INDIVIDUAL DIRECT ACCESS FILE SIZE 
 TSVPE    CON    2RDT        SERVICE CLASS TO ASSIGN ON A DETACH
  
*         *CSJT*. 
  
          CON    2RPR        CPU PRIORITY 
          CON    2RIT        SYSTEM I/O CPU THRESHOLD (MILLISECONDS)
          CON    2RSE        CPU SLICE EXTENSION (MILLISECONDS) 
          CON    2RRS        CPU RECALL SLICE (MILLISECONDS)
          CON    2RUS        UNEXTENDED CPU SLICE (MILLISECONDS)
  
          CON    0
 ASD      SPACE  4,15 
**        ASD - ASSEMBLE DIGITS.
* 
*         ENTRY  (CA) = ADDRESS OF NEXT CHARACTER.
* 
*         EXIT   (A) = NON OCTAL DIGIT IN STRING. 
*                (CA) UPDATED.
*                (AB - AB+4) = DIGITS ASSEMBLED, RIGHT-JUSTIFIED. 
* 
*         USES   T1, T2, T3, AB - AB+4. 
  
  
 ASD      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR ASSEMBLY 
          CRD    AB 
 ASD1     LDI    CA          CHECK CHARACTER
          SBN    1R0
          MJN    ASD2        IF ALPHA 
          SBN    10 
          MJN    ASD3        IF OCTAL DIGIT 
          SBN    1R -1R8
          ZJN    ASD5        IF * * 
 ASD2     LDI    CA          GET CHARACTER
          UJN    ASDX        RETURN 
  
 ASD3     ADN    10          SET NEW DIGIT
          STD    T2 
          LDN    AB+4        SET BYTE ADDRESS 
          STD    T3 
 ASD4     LDI    T3          BYTE * 10
          SHN    3
          ADD    T2          ADD NEW DIGIT
          STI    T3 
          SHN    -14         NEW DIGIT = OVERFLOW 
          STD    T2 
          SOD    T3          DECREMENT BYTE ADDRESS 
          LMN    AB-1 
          NJN    ASD4        IF NOT 5 BYTES 
 ASD5     AOD    CA          ADVANCE CHARACTER
          UJN    ASD1        LOOP 
 SPT      SPACE  4,10 
**        SPT - SEARCH PARAMETER TABLE. 
* 
*         ENTRY  (A) = FWA OF PARAMETER TABLE.
*                (CA) = CHARACTER ADDRESS.
* 
*         EXIT   (A) = INDEX OF ENTRY FOUND.
*                (A) .LT. 0, IF NOT FOUND.
*                (T5) = ADDRESS OF TABLE ENTRY FOUND. 
*                (CA) = CHARACTER ADDRESS ADVANCED. 
* 
*         USES   T1, T3, T5.
  
  
 SPT2     LDN    2           ADVANCE CHARACTER ADDRESS
          RAD    CA 
          LDD    T5          SET INDEX OF ENTRY 
          SBD    T3 
  
 SPT      SUBR               ENTRY/EXIT 
          STD    T3 
          STD    T5 
          LDI    CA          ASSEMBLE PARAMETER NAME
          SHN    6
          LMM    1,CA 
          STD    T1 
          LDI    T5 
 SPT1     LMD    T1 
          ZJN    SPT2        IF MATCH FOUND 
          AOD    T5 
          LDI    T5 
          NJN    SPT1        IF NOT END OF TABLE
          LCN    0           FLAG ENTRY NOT FOUND 
          UJP    SPTX        RETURN 
          SPACE  4,10 
*         BUFFERS.
  
 CBUF     BSS    /1DS/KBCML*5  KEYBOARD BUFFER
          SPACE  4,10 
          OVERFLOW  OVLA,/OVERLAY/BUFB
          OVERLAY  (*BIO* FUNCTIONS.) 
 EBR      SPACE  4,10 
***       FUNCTION EBRF - ENTER *BIO* BUFFER POINT REQUEST. 
* 
*         ENTRY  (CP) = *BIO* CONTROL POINT ADDRESS.
*                (IR+4) = 6/KEYBOARD BUFFER OFFSET, 6/. 
*                (PARAMETER) = 12/,12/PR,6/,6/PA,12/EST ORD,12/FUNC.
*                              PR = PRIORITY. 
*                              PA = PARAMETER.
*                              FUNC = *BIO* REQUEST FUNCTION. 
*                IF REQUEST FUNCTION = *REPM* (*REPEAT* COMMAND)
*                (PARAMETER) = 12/J1,12/PR,6/,6/PA,12/J2,12/FUNC. 
*                              J1 = FIRST TWO CHARACTERS OF JSN.
*                              J2 = LAST TWO CHARACTERS OF JSN. 
  
  
 EBR      ENTRY              ENTRY/EXIT 
          LDC    BISI        CHECK IF *BIO* IS ACTIVE 
          RJM    CSS
          LDN    TAEQL/5     READ AVAILABLE EQUIPMENT TABLE 
          STD    T1 
          LDD    RA 
          SHN    6
          ADK    /BIO/TEQR
          CRM    TAEQ,T1
          LDC    /1DS/DSDL+/1DS/KBCML  READ SPECIAL PARAMETER WORD
          CRD    AB 
          LDD    AB+4 
          LMN    /BIO/REPM
          NJN    EBR0        IF NOT *REPEAT*
          LCN    2
          RAM    EBRB 
          LDC    NJNI+EBR2-EBRC 
          ERRNG  EBRC-EBR2+37  INCORRECT JUMP INSTRUCTION 
          STM    EBRC 
 EBR0     LDC    /BIO/BFCW   SET ADDRESS OF FIRST BUFFER POINT
          STD    T7 
          STD    T1 
          SBN    /BIO/BFCWL  SET END OF BUFFER POINTS 
          STD    T6 
 EBR1     NFA    T7,R        READ BUFFER POINT WORD 
          CRD    CM 
          LDD    CM 
          ZJN    EBR2        IF BUFFER POINT INACTIVE 
 EBRB     LDD    CM+3        CHECK EST ORDINAL
*         LDD    CM+1        (*REPEAT*) 
          LMD    AB+3 
 EBRC     UJN    EBR1.1      CHECK EST
*         NJN    EBR2        (IF *REPEAT* AND JSN DOES NOT MATCH) 
          LDD    CM 
          LMD    AB 
 EBR1.1   ZJN    EBR5        IF SPECIFIED EQUIPMENT FOUND 
 EBR2     LCN    2           ADVANCE BUFFER POINT ADDRESS 
          RAD    T7 
          LMD    T6 
          NJN    EBR1        IF NOT END OF BUFFER POINTS
 EBR3     LDN    1           SET ERROR
 EBR4     RJM    SRD
          UJP    EBRX        RETURN 
  
 EBR5     LDD    CM+4 
          LPN    77 
          ZJN    EBR6        IF LAST COMMAND PROCESSED
          LDN    2           SET *BIO BUSY* 
          UJN    EBR4        SAVE RESPONSE TO *DSD* 
  
 EBR6     LDD    T1          SET EQUIPMENT INDEX
          SBD    T7 
          SHN    -1 
          STD    T1 
          LDM    TAEQ+1,T1   SET DEVICE TYPE
          LPN    7
          LMC    -0 
          RAM    EBRA 
          LDM    TBDF,AB+4   CHECK IF COMMAND ALLOWED FOR DEVICE
 EBRA     SHN    21-0 
*         SHN    21-XX
          PJN    EBR3        IF COMMAND NOT ALLOWED FOR THIS DEVICE 
          LDD    AB+2        MERGE PARAMETER AND REQUEST
          SHN    6
          LMD    AB+4 
          STD    CM+4 
          LDD    AB+1        SET PRIORITY VALUE 
          STD    CM+2 
          NFA    T7,R        STORE BUFFER POINT REQUEST 
          CWD    CM 
          LDN    0           SET NO ERROR 
          UJP    EBR4        SAVE REPSONSE TO *DSD* 
 TBDF     SPACE  4,10 
**        TBDF - TABLE OF *BIO* DEVICE FUNCTIONS. 
* 
*         INDEXED BY *BIO* REQUEST FUNCTION.
  
  
 TBDF     BIODF 
          BIODF  ENDM,(LPDT,NPDT,CPDT,CRDT)  END
          BIODF  REPM,(LPDT,NPDT,CPDT)       REPEAT 
          BIODF  SUPM,(LPDT)                 SUPPRESS 
          BIODF  RRNM,(LPDT,NPDT,CPDT)       REPRINT/REPUNCH
          BIODF  HLDM,(LPDT,NPDT)            STOP (HOLD)
          BIODF  CNTM,(LPDT,NPDT)            CONTINUE 
          BIODF  BKPO,(LPDT)                 BACKSPACE PRUS 
          BIODF  BKRO,(LPDT)                 BACKSPACE RECORDS
          BIODF  BKFO,(LPDT)                 BACKSPACE FILES
          BIODF  SKPO,(LPDT)                 SKIP PRUS
          BIODF  SKRO,(LPDT)                 SKIP RECORDS 
          BIODF  SKFO,(LPDT)                 SKIP FILES 
          BIODF  FPRE 
 TAEQ     SPACE  4,10 
**        TAEQ - TABLE OF AVAILABLE EQUIPMENTS. 
  
  
 TAEQ     BSS    0
 TAEQL    EQU    /BIO/CTIR*5-/BIO/TEQR*5
          SPACE  4,10 
          OVERFLOW  OVLA,/OVERLAY/BUFB-TAEQL
          OVERLAY  (IDLEDOWN PROCESSING.) 
 IDD      SPACE  4,10 
***       FUNCTION IDLF - IDLEDOWN SUBSYSTEMS.
* 
*         ENTRY  (IR+4) = EJT ORDINAL.
  
  
 IDD      ENTRY              ENTRY/EXIT 
 IDD1     SFA    EJT,IR+4    INTERLOCK EJT ENTRY
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          LDN    41 
          STD    CM+1 
          LDD    MA 
          CWM    IDDA,ON
          MONITOR  UTEM 
          LDD    CM+1 
          ZJN    IDD2        IF INTERLOCK SET 
          LMN    3
          ZJN    IDDX        IF EJT NOT IN USE
          DELAY 
          UJN    IDD1        LOOP ON INTERLOCK
  
 IDD2     SFA    EJT,IR+4 
          ADK    JSNE 
          CRD    CM 
          ADK    SCHE-JSNE
          CRD    CN 
          LDD    CM+4 
          LMK    EXJS*2 
          LPN    76 
          ZJN    IDD4        IF JOB AT CONTROL POINT
          LDD    CM          SET JSN
          STD    CM+3 
          LDD    CM+1 
          STD    CM+4 
          LDD    IR+4        SET ERROR FLAG IN EJT
          STD    CM+2 
          LDK    IDET+4000
          STD    CM+1 
          MONITOR  CEFM 
 IDD3     SFA    EJT,IR+4    CLEAR THE EJT INTERLOCK
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          LDN    40 
          STD    CM+1 
          MONITOR  UTEM 
          LJM    IDDX        RETURN 
  
 IDD4     LDD    CN+3        MOVE TO JOB-S CONTROL POINT
          STD    CM+1 
          MONITOR  CCAM 
          LDD    CM+1 
          ZJN    IDD5        IF CHANGE MADE 
          DELAY 
          UJN    IDD4        RETRY CP CHANGE
  
 IDD5     RJM    IDL         SET IDLEDOWN CONTROL FLAGS 
          LJM    IDD3        CLEAR THE EJT INTERLOCK
  
 IDDA     VFD    6/40,6/1,6/6,42/0  VERIFY JOB ADVANCE NOT SET
 IDL      SPACE  4,15 
**        IDL - IDLEDOWN SUBSYSTEM. 
* 
*         IF JOB IS A SPECIAL SUBSYSTEM (*BATCHIO*, *MAGNET*, *MSS*,
*         *MAS*, *RHF*) THE SUBSYSTEM IDLEDOWN FLAG (BIT 2**15 OF RA+0
*         AND BIT 2**15 OF CONTROL POINT AREA WORD *SNSW*) WILL BE SET. 
*         IF THE JOB IS NOT A SPECIAL SUBSYSTEM, IT WILL BE 
*         ABORTED WITH THE *IDET* ERROR FLAG. 
* 
*         ENTRY  EJT INTERLOCK SET. 
* 
*         USES   T1, CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 IDL2     LDN    IDET        SET *IDET* ERROR FLAG
          STD    CM+1 
          MONITOR  CEFM 
  
 IDL      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADN    JCIW 
          CRD    CM 
          LDC    IDLA-1      SET TABLE ADDRESS
          STD    T1 
 IDL1     AOD    T1          CHECK NEXT TABLE ENTRY 
          LDI    T1 
          ZJN    IDL2        IF END OF TABLE
          LMD    CM+2 
          NJN    IDL1        IF NOT A MATCH 
          LDD    RA          READ RA+0
          SHN    6
          CRD    CM 
          LDD    CM+3        SET IDLEDOWN FLAG IN (RA)
          SCN    10 
          LMN    10 
          STD    CM+3 
          LDD    RA          REWRITE RA+0 
          SHN    6
          CWD    CM 
          LDD    CP          READ CPA WORD *SNSW* 
          ADK    SNSW 
          CRD    CM 
          LDD    CM+3        SET IDLEDOWN FLAG IN CPA 
          SCN    10 
          LMN    10 
          STD    CM+3 
          LDD    CP          REWRITE CPA WORD *SNSW*
          ADK    SNSW 
          CWD    CM 
          ADK    CSSW-SNSW   READ CPA WORD *CSSW* 
          CRD    CM 
          LDD    CM          CLEAR *SKIP-TO-EXIT* FLAG
          LPC    5777 
          STD    CM 
          LDD    CP          WRITE CPA WORD *CSSW*
          ADK    CSSW 
          CWD    CM 
          LJM    IDLX        RETURN 
  
  
 IDLA     BSS    0           TABLE OF SPECIAL SUBSYSTEMS
          CON    BISI        *BATCHIO*
          CON    MTSI        *MAGNET* 
          CON    MFSI        *MSS*
          CON    ASSI        *MAS*
          CON    RFSI        *RHF*
          CON    0           END OF TABLE 
  
          OVERFLOW  OVLA,/OVERLAY/BUFB
          OVERLAY  (UP/DOWN CHANNEL.) 
          SPACE  4,10 
**        DIRECT CELL ASSIGNMENTS.
  
 CB       EQU    PP          CONTROLWARE TABLE BYTE ADDRESS 
 TA       EQU    PA          CONTROLWARE TABLE WORD ADDRESS 
 CH       EQU    60          CHANNEL NUMBER 
 MX       EQU    61          MUX CHANNEL FLAG (100 IF MUX CHANNEL)
 CS       EQU    62          CHANNEL RESERVATION STATUS 
 MI       EQU    63          NON-ZERO IF ERROR LOG MESSAGE ISSUED 
 S1       EQU    64          SCRATCH
 TI       EQU    65          DEVICE TABLE INDEX 
 FT       EQU    66          FUNCTION TYPE
 UPC      SPACE  4,15 
***       FUNCTION UPCF - UP CHANNEL. 
* 
*         ENTRY  (IR+3) = 5/MT, 1/M, 1/C, 5/CH. 
*                (IR+4) = 1/S, 2/0, 9/EQ. 
* 
*                WHERE  M  = 1, IF MUX CHANNEL. 
*                       C  = 1, IF CONCURRENT CHANNEL.
*                       CH = CHANNEL NUMBER.
*                       S  = 1, IF CALLED BY DRIVER OR *1MV*. 
*                       EQ = EST ORDINAL (0 IF FUNCTION TO BE PERFORMED 
*                            ON ALL EQUIPMENTS THAT THE CHANNEL 
*                            ACCESSES). 
  
  
*UPC      ENTRY              ENTRY/EXIT 
* 
*         THIS FUNCTION USES THE *DWNF* PROCESSOR.
 DWN      SPACE  4,15 
***       FUNCTION DWNF - DOWN CHANNEL. 
* 
*         ENTRY  (IR+3) = 5/0, 1/M, 1/C, 5/CH.
*                (IR+4) = 3/0, 9/EQ.
* 
*                WHERE  M  = 1, IF MUX CHANNEL. 
*                       C  = 1, IF CONCURRENT CHANNEL.
*                       CH = CHANNEL NUMBER.
*                       EQ = EST ORDINAL (0 IF FUNCTION TO BE PERFORMED 
*                            ON ALL EQUIPMENTS THAT THE CHANNEL 
*                            ACCESSES). 
  
  
 DWN6     RJM    DCH         RELEASE CHANNEL, IF RESERVED 
 DWN7     LDD    MI 
          ZJN    DWN8        IF NO ERROR LOG MESSAGES ISSUED
          LDK    ZERL        ISSUE *CHANNEL DOWNED BY SYSTEM* EVENT 
          CRD    CM 
          LDN    /EVENT/CDSE
          STD    CM+4 
          MONITOR  EATM 
 DWN8     LDD    IR+2 
          ZJN    DWNX        IF *DOWN* REQUEST
          RJM    CRC         CLEAR CONTROLWARE RELOAD COUNT 
  
 DWN      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          LDD    IR+4 
          LPC    777
          NJN    DWN1        IF EST ORDINAL SPECIFIED 
          LDK    ESTP        INITIALIZE CELLS FOR EST SCAN
          CRD    T5 
          LDK    NOPE-1 
          STD    T5 
          UJN    DWN2        ENTER EST SCAN LOOP
  
 DWN1     SBN    1
          STD    T5 
          ADN    2           SET SCAN TERMINATION CONDITION 
          STD    T5+2 
 DWN2     AOD    T5          INCREMENT EST ORDINAL
          STM    CMVA+2      STORE EST ORDINAL IN *1MV* CALL
          LMD    T5+2 
          ZJP    DWN6        IF END OF EST SCAN 
          SFA    EST,T5      READ EST ENTRY 
          ADK    EQDE 
          CRD    CN 
          RJM    DDP         DETERMINE IF DEVICE SHOULD BE PROCESSED
          MJN    DWN2        IF DEVICE NOT TO BE PROCESSED
 DWN3     RJM    RCH         REQUEST CHANNEL, IF NECESSARY
          MJP    DWN7        IF CHANNEL CANNOT BE OBTAINED
          RJM    RCS         REQUEST CHANNEL STATUS CHANGE ON DEVICE
          PJN    DWN5        IF CHANNEL STATUS HAS BEEN CHANGED 
          RJM    DCH         DROP CHANNEL 
          LDD    IR+2 
          NJN    DWN2        IF *UP* REQUEST
          RJM    DEQ         DOWN EQUIPMENT 
          PJN    DWN3        IF EQUIPMENT WAS DOWNED
 DWN4     UJP    DWN2        PROCESS NEXT EST ENTRY 
  
 DWN5     RJM    CDS         CHECK DRIVER STATUS
          RJM    CMV         CALL *1MV*, IF NECESSARY 
          UJN    DWN4        PROCESS NEXT EST ENTRY 
 CDS      SPACE  4,20 
**        CDS - CHECK BUFFERED I/O DRIVER STATUS. 
* 
*         IF CHANNEL UP FUNCTION
*           AND BUFFERED I/O DRIVER IS NOT UP 
*         THEN
*           CLEAR DRIVER DROPPED FLAG IN CHANNEL CONTROLWARE TABLE. 
*           ISSUE *RPPM* FUNCTION TO START APPROPRIATE DRIVER.
* 
*         ENTRY  (CH) = CHANNEL NUMBER. 
*                (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (MX) = MUX CHANNEL FLAG. 
*                (CB) = CONTROLWARE TABLE BYTE ADDRESS. 
*                (TA - TA+1) = CONTROLWARE TABLE WORD ADDRESS.
* 
*         USES   CM - CM+4, FS - FS+4.
* 
*         MACROS DELAY, MONITOR.
  
  
 CDS5     LDD    CP          ISSUE WAIT MESSAGE 
          ADK    MS2W 
          CWM    CMVB,TR
          DELAY  10D*8D 
 CDS6     LDD    MA 
          CWD    FS          STORE INPUT REGISTER FOR PP REQUEST
          LDN    1
          STD    CM+1        SELECT NO QUEUEING OF PP REQUEST 
          LDD    FS+4 
          LPN    40 
          NJN    CDS7        IF CONCURRENT CHANNEL
          MONITOR  RPPM 
          UJN    CDS8        CHECK MONITOR RESPONSE 
  
 CDS7     SBD    FS+4        ISOLATE CHANNEL
          ADN    4
          SHN    0-21 
          ADN    2           DETERMINE BARREL SUBFUNCTION 
          STD    CM+4 
          MONITOR  CPRM      REQUEST CONCURRENT PP
 CDS8     LDD    CM+1 
          ZJP    CDS5        IF PP NOT ASSIGNED 
          LDD    CP          CLEAR WAIT MESSAGE 
          ADK    MS2W 
          CWD    CM 
  
 CDS      SUBR               ENTRY/EXIT 
          LDD    FT 
          ZJN    CDSX        IF *DOWN* REQUEST
          LDD    MX 
          NJN    CDSX        IF MUX CHANNEL 
          RJM    RCE         READ CONTROLWARE TABLE 
          SHN    21-11
 CDS1     PJN    CDSX        IF DRIVER IS UP
 CDS1.1   DELAY 
          LDD    TA 
          SHN    14 
          LMD    TA+1 
          SBK    CTALL*2
          CRD    CM 
          LDI    CB 
          SHN    21-5 
          MJN    CDS1.1      IF *MTR* HASN-T YET UPDATED CHANNEL TABLE
          LDN    2           SET NUMBER OF REQUESTS 
          STD    CM+1 
          LDD    TA+1 
          STD    CM+4 
          LDD    TA 
          STD    CM+3 
          LDD    MA          SET *UTEM* REQUEST IN MESSAGE BUFFER 
          CWM    CDSD,CM+1
          MONITOR  UTEM 
          LDD    CM+1 
          NJN    CDS1        IF BUFFER DRIVER FLAG NOT CLEARED
          LDC    BIOL        READ BUFFERED I/O TABLES POINTER 
          CRD    CM 
          LDD    CM+1        CHECK BUFFERED I/O PRESENT 
          SHN    14 
          ADD    CM+2 
 CDS2     ZJP    CDSX        IF NO BUFFERED DEVICES PRESENT 
          ADN    CCTP 
          CRD    CM          CHANNEL TABLE POINTER WORD 
          LDN    CUN1 
          UJN    CDS4        SCAN CHANNEL CONTROL TABLE 
  
 CDS3     SOD    CM 
          ZJN    CDS2        IF NO MORE CHANNELS
          LDN    CCTL 
 CDS4     RAD    CM+4        ADVANCE CCT POINTER
          SHN    -14
          RAD    CM+3 
          SHN    14          READ PP DRIVER INPUT REGISTER
          ADD    CM+4 
          CRD    FS 
          LDD    FS 
          ZJN    CDS3        IF 819 ENTRY 
          LDD    FS+4 
          LMD    CH 
          NJN    CDS3        IF NOT SELECTED CHANNEL
          LJM    CDS6        LOAD DRIVER
  
  
 CDSD     VFD    1/1,5/,6/1,6/,42/1  VERIFY BUFFERED I/O DRIVER FLAG
 CDSE     VFD    1/0,5/,6/1,6/,42/0  UPDATE BUFFERED I/O DRIVER FLAG
 CMV      SPACE  4,10 
**        CMV - CALL *1MV* IF *UP* REQUEST FOR MASS STORAGE CHANNEL.
* 
*         ENTRY  (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (CN - CN+4) = WORD *EQDE* OF EST ENTRY.
* 
*         USES   CM+1.
* 
*         MACROS DELAY, MONITOR, SMSTF. 
  
  
 CMV2     LDD    CP          CLEAR WAIT MESSAGE 
          ADK    MS2W 
          CWD    CM 
          SMSTF  L1MV        SET *1MV* ACTIVE 
  
 CMV      SUBR               ENTRY/EXIT 
          LDD    CN 
          SHN    21-13
          PJN    CMVX        IF NOT MASS STORAGE
          LDD    FT 
          ZJN    CMVX        IF *DOWN* REQUEST
 CMV1     DELAY  100D*8D     DELAY BETWEEN *1MV* CALLS
          LDD    MA          PLACE REQUEST IN MESSAGE BUFFER
          CWM    CMVA,ON
          LDN    0
          STD    CM+1 
          MONITOR  RPPM      CALL *1MV* 
          LDD    CM+1 
          NJP    CMV2        IF PP ASSIGNED OR IN REQUEST QUEUE 
          LDD    CP          ISSUE WAIT MESSAGE 
          ADK    MS2W 
          CWM    CMVB,TR
          UJN    CMV1        RETRY *1MV* CALL 
  
  
 CMVA     VFD    18/3R1MV,6/0,12/0,6/UCFC,6/0,12/0
 CMVB     DATA   C*WAITING FOR PP.* 
 CRC      SPACE  4,10 
**        CRC - CLEAR RELOAD COUNT IN CONTROLWARE TABLE.
* 
* 
*         USES   CM+1 - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 CRC      SUBR               ENTRY/EXIT 
          LDN    1           NUMBER OF PARAMETER WORDS
          STD    CM+1 
          LDD    TA+1 
          STD    CM+4 
          LDD    TA 
          STD    CM+3 
          LDD    MA          STORE *UTEM* PARAMETERS
          CWM    CRCB,ON
          MONITOR  UTEM 
          UJN    CRCX        RETURN 
  
  
 CRCB     VFD    1/0,5/0,6/3,6/,42/0  *UTEM* REQUEST
 DCH      SPACE  4,15 
**        DCH - DROP CHANNEL. 
* 
*         THIS SUBROUTINE DROPS THE CHANNEL IF IT IS PRESENTLY ASSIGNED 
*         TO THIS PP. 
* 
*         ENTRY  (CH) = CHANNEL NUMBER. 
*                (CS) = 1 IF CHANNEL ASSIGNED.
* 
*         EXIT   (CS) = 0.
* 
*         USES   CM+1, CS.
* 
*         MACROS MONITOR. 
  
  
 DCH      SUBR               ENTRY/EXIT 
          LDD    CS 
          ZJN    DCHX        IF CHANNEL NOT ASSIGNED
          LDD    CH          DROP THE CHANNEL 
          STD    CM+1 
          MONITOR  DCHM 
*         LDN    0           CLEAR CHANNEL STATUS 
          STD    CS 
          UJN    DCHX        RETURN 
 DDP      SPACE  4,30 
**        DDP - DETERMINE IF DEVICE SHOULD BE PROCESSED.
* 
*         THIS SUBROUTINE DETERMINES IF A DEVICE IS ACCESSED BY A 
*         PARTICULAR CHANNEL AND IF THE STATE OF THE CHANNEL ON THE 
*         DEVICE IS SUCH THAT THE DEVICE SHOULD BE PROCESSED.  ONLY 
*         MASS STORAGE, TAPE, *NIP*, AND OPTICAL DISK DEVICE TYPES
*         WILL BE CONSIDERED FOR PROCESSING.
* 
*         ENTRY  (CH) = CHANNEL NUMBER. 
*                (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (MX) = 100 IF MUX CHANNEL. 
*                (CN - CN+4) = *EQDE* WORD OF EST ENTRY.
* 
*         EXIT   (A) .GE. 0 IF THE DEVICE SHOULD BE PROCESSED.
*                    .LT. 0 IF AT LEAST ONE OF THE FOLLOWING CONDITIONS 
*                              IS TRUE -
*                               A. THE DEVICE IS OF A TYPE NOT SUITABLE 
*                                  FOR PROCESSING.
*                               B. THE CHANNEL DOES NOT ACCESS THE
*                                  DEVICE.
*                               C. THE CONCURRENCY OF THE CHANNEL DOES
*                                  NOT MATCH THAT OF THE CHANNELS 
*                                  ACCESSING THE DEVICE.
*                               D. THE CHANNEL IS A MUX CHANNEL BUT THE 
*                                  DEVICE TYPE IS *LDAM*. 
*                               E. THE *UP*/*DOWN* STATUS OF THE
*                                  CHANNEL ON THE DEVICE MISMATCHES THE 
*                                  *1DS* FUNCTION TYPE. 
*                (TI) = TABLE INDEX IF TAPE, *NIP* OR OPTICAL DISK. 
* 
*         USES   TI, T1.
  
  
 DDP      SUBR               ENTRY/EXIT 
          LDD    CN          VALIDATE DEVICE TYPE 
          SHN    21-13
          MJN    DDP2        IF MASS STORAGE
          LDN    TDVTL       SET DEVICE TYPE TABLE LENGTH 
          STD    TI 
 DDP1     SOD    TI          DECREMENT TABLE INDEX
          MJN    DDPX        IF DEVICE TYPE NOT FOUND 
          LDM    TDVT,TI
          LMD    CN+3 
          NJN    DDP1        IF NOT DEVICE TYPE MATCH 
 DDP2     LDN    1
          STD    T1 
 DDP3     LDM    CN+1,T1
          LMD    CH 
          LPN    77 
          NJN    DDP4        IF WRONG CHANNEL 
          LDM    CN+1,T1
          SHN    0-11 
          SBN    4
          MJN    DDP4        IF CHANNEL NOT PRESENT OR DISABLED 
          LMN    1
          ZJN    DDP6        IF CHANNEL STATE = *IDLE*
          LMD    FT 
          LPN    1
          NJN    DDP6        IF RIGHT CHANNEL STATE 
 DDP4     SOD    T1 
          PJN    DDP3        IF CHANNEL 1 NOT YET CHECKED 
 DDP5     UJP    DDPX        RETURN 
  
 DDP6     LDD    MX 
          ZJN    DDP5        IF MUX CHANNEL NOT SPECIFIED 
          LDD    CN 
          SHN    21-13
          PJN    DDP5        IF NOT MASS STORAGE DEVICE 
          SHN    13-7 
          UJN    DDP5        RETURN WITH (A) .LT. 0 IF *LDAM* DEVICE
  
  
 TDVT     BSS    0           TABLE OF DEVICE TYPES TO BE PROCESSED
          CON    2ROD 
          CON    2RLX 
          CON    2RLY 
          CON    2RCT 
          CON    2RMT 
          CON    2RNT 
          CON    2RAT 
 TDVTL    EQU    *-TDVT      TABLE LENGTH 
 DEQ      SPACE  4,20 
**        DEQ - DOWN EQUIPMENT. 
* 
*         THIS SUBROUTINE REQUESTS *MTR* TO DOWN A MASS STORAGE 
*         DEVICE.  IT ALSO ISSUES BML AND ERRLOG MESSAGES TO
*         RECORD THE EVENT. 
* 
*         ENTRY  (T5) = EST ORDINAL.
* 
*         EXIT   (A) .GE. 0 IF EQUIPMENT WAS DOWNED.
*                    .LT. 0 IF EQUIPMENT CANNOT BE DOWNED.
* 
*         USES   CM+1, CM+2.
* 
*         CALLS  IMS. 
* 
*         MACROS MONITOR. 
  
 DEQ1     LCN    0           SET REJECT STATUS
  
 DEQ      SUBR               ENTRY/EXIT 
          LDD    T5          STORE EST ORDINAL IN REQUEST 
          STD    CM+1 
          LDK    DWES        STORE SUBFUNCTION IN REQUEST 
          STD    CM+2 
          MONITOR  SEQM 
          LDD    CM+1 
          ZJN    DEQ1        IF FUNCTION REJECTED 
          LDN    MSI1        MESSAGE INDEX
          RJM    IMS         ISSUE MESSAGES (IF CALLED BY DRIVER) 
          UJN    DEQX        RETURN 
 IBM      SPACE  4,15 
**        IBM - ISSUE BML MESSAGE.
* 
*         ENTRY  (CH) = CHANNEL NUMBER, INCLUDING CONCURRENCY FLAG. 
*                (S1) = MESSAGE INDEX.
*                (T5) = EST ORDINAL.
*                (CN - CN+4) = *EQDE* WORD OF EST ENTRY.
* 
*         EXIT   (A) = 0. 
* 
*         USES   T1, T2, CM - CM+4, FS - FS+4.
* 
*         CALLS  DFM. 
  
  
 IBM      SUBR               ENTRY/EXIT 
          LDC    TMID-2      SET TABLE ADDRESS
          STD    T1 
          LDD    CN+3        SAVE DEVICE TYPE 
          STD    T2 
          LMC    2RDP 
          NJN    IBM1        IF NOT *DP* DEVICE TYPE
          LDC    TEMID-2     SET TABLE ADDRESS
          STD    T1 
          LDD    CN+4 
          SHN    3
          ADK    DILL 
          CRD    CM 
          LDD    CM+3 
          LPC    707
          STD    T2 
 IBM1     LDN    2           CHECK NEXT TABLE ENTRY 
          RAD    T1 
          LDI    T1 
          ZJN    IBM2        IF DEVICE TYPE NOT FOUND IN TABLE
          LMD    T2 
          NJN    IBM1        IF NOT A MATCH 
          LDM    1,T1        MESSAGE ID 
 IBM2     STM    BMLID
          LDM    IBMA,S1     SYMPTOM CODE 
          STM    BMLSC
          LDD    CH          CHANNEL NUMBER 
          STM    BMLPP
          LDK    PPCP        READ PP COMMUNICATIONS AREA POINTER
          CRD    CM 
          ADK    MMFL-PPCP
          CRD    FS 
          LDD    FS          MAINFRAME ID 
          STM    BMLMF
          LDD    IA          COMPUTE PP NUMBER
          SBD    CM+4 
          SHN    6-3
          RAM    BMLPP
          LDD    CN+4        READ EQUIPMENT AND UNIT NUMBERS
          SHN    3
          ADK    DDLL 
          CRD    CM 
          LDD    CM          GET EQUIPMENT (CONTROLLER) NUMBER
          LPC    700
          LMD    CM+4        MERGE WITH UNIT NUMBER 
          SCN    77 
          LMD    CM+4 
          STM    BMLUN
          LDD    T5          STORE EST ORDINAL
          STM    BMLEO
          LDM    IBMA,S1     SYMPTOM CODE 
          STM    BMLSC
          LDK    BMLL        SET MESSAGE LENGTH 
          STD    CM+1 
          LDC    BML+BMLN    ISSUE MESSAGE
          RJM    DFM
*         LDN    0
          LJM    IBMX        RETURN 
  
  
*         MESSAGE INDICES.
  
 BEGIN    BSSN   0
 MSI0     BSSN   1
 MSI1     BSSN   1
 MSIX     BSSN   1           MAXIMUM INDEX + 1
 END      BSSN
  
  
*         TABLE OF SYMPTOM CODES. 
  
 IBMA     INDEX 
          INDEX  MSI0,/COMSDFS/HS0015 
          INDEX  MSI1,/COMSDFS/HS0034 
          INDEX  MSIX 
 TMID     SPACE  4,10 
*         TABLE OF MESSAGE ID-S.
  
 TMID     BSS    0
          CON    2RDI,/COMSDFS/RM0002   (DI)  844-2X, HALF TRACK
          CON    2RDJ,/COMSDFS/RM0003   (DJ)  844-4X, HALF TRACK
          CON    2RDK,/COMSDFS/RM0004   (DK)  844-2X, FULL TRACK
          CON    2RDL,/COMSDFS/RM0005   (DL)  844-4X, FULL TRACK
          CON    2RDM,/COMSDFS/RM0007   (DM)  885-1X, HALF TRACK
          CON    2RDQ,/COMSDFS/RM0017   (DQ)  885-1X, FULL TRACK
          CON    2RDR,/COMSDFS/RM0015   (DR)  CDSS II 
          CON    2RDX,/COMSDFS/RM0010   (DX)  3330-1
          CON    2RDY,/COMSDFS/RM0011   (DY)  3330-11 
          CON    2RDZ,/COMSDFS/RM0012   (DZ)  3350
          CON    2RDA,/COMSDFS/RM0013   (DA)  33502 
          CON    2RDB,/COMSDFS/RM0014   (DB)  885-42
          CON    2RDD,/COMSDFS/RM0110   (DD)  834 
          CON    2RDF,/COMSDFS/RM0120   (DF)  887 (4KB SECTOR)
          CON    2RDG,/COMSDFS/RM0111   (DG)  836 
          CON    2RDH,/COMSDFS/RM0121   (DH)  887 (16KB SECTOR) 
          CON    2RDC,/COMSDFS/RM0115   (DC)  895 
          CON    2RDN,/COMSDFS/RM0124   (DN)  9853 (XMD/CM3)
          CON    2REA,/COMSDFS/RM0130   (EA)  5832 (1X SSD) 
          CON    2REB,/COMSDFS/RM0131   (EB)  5832 (2X SSD) 
          CON    2REC,/COMSDFS/RM0132   (EC)  5833 (1X SABRE) 
          CON    2RED,/COMSDFS/RM0133   (ED)  5833 (1XP SABRE)
          CON    2REE,/COMSDFS/RM0134   (EE)  5833 (2X SABRE) 
          CON    2REF,/COMSDFS/RM0137   (EF)  5833 (2XP SABRE)
          CON    2REG,/COMSDFS/RM0142   (EG)  5838 (1X ELITE) 
          CON    2REH,/COMSDFS/RM0143   (EH)  5838 (1XP ELITE)
          CON    2REI,/COMSDFS/RM0144   (EI)  5838 (2X ELITE) 
          CON    2REJ,/COMSDFS/RM0147   (EJ)  5838 (2XP ELITE)
          CON    2REK,/COMSDFS/RM0145   (EK)  5838 (3XP ELITE)
          CON    2REL,/COMSDFS/RM0146   (EL)  5838 (4X ELITE) 
          CON    2REM,/COMSDFS/RM0135   (EM)  5833 (3XP SABRE)
          CON    2REN,/COMSDFS/RM0136   (EN)  5833 (4X SABRE) 
          CON    2REO,/COMSDFS/RM0162   (EO)  47444 (1X 3.5IN)
          CON    2REP,/COMSDFS/RM0163   (EP)  47444 (1XP 3.5IN) 
          CON    2RES,/COMSDFS/RM0164   (ES)  47444 (2X 3.5IN)
          CON    2REU,/COMSDFS/RM0167   (EU)  47444 (2XP 3.5IN) 
          CON    2REV,/COMSDFS/RM0165   (EV)  47444 (3XP 3.5IN) 
          CON    2REW,/COMSDFS/RM0166   (EW)  47444 (4X 3.5IN)
          CON    0
 TEMID    SPACE  4,10 
*         TABLE OF MESSAGE ID-S FOR EXTENDED MEMORY DEVICES.
  
  
 TEMID    BSS    0
          CON    102,/COMSDFS/RM0070    (DP)  ECS I  - DC135 DDP
          CON    202,/COMSDFS/RM0072    (DP)  ECS II - DC135 DDP
          CON    101,/COMSDFS/RM0074    (DP)  ECS I  - DC145 DDP
          CON    201,/COMSDFS/RM0075    (DP)  ECS II - DC145 DDP
          CON    300,/COMSDFS/RM0076    (DP)  LCME   - COUPLER
          CON    501,/COMSDFS/RM0210    (DP)  ESM    - LOW SPEED PORT 
          CON    601,/COMSDFS/RM0172    (DP)  STORNET 
          CON    0           END OF TABLE 
 BML      SPACE  4,10 
*         BINARY MAINTENANCE LOG MESSAGE. 
  
 BML      BSS    0
  
 BMLID    VFD    12/         MESSAGE ID 
  
 BMLSC    VFD    12/         SYMPTOM CODE 
  
 BMLPP    VFD    6/          PP NUMBER
          VFD    6/          CHANNEL NUMBER 
  
 BMLUN    VFD    6/0         EQUIPMENT NUMBER 
          VFD    6/          UNIT NUMBER
  
          VFD    12/0        RESERVED 
  
 BMLEO    VFD    12/         EST ORDINAL
  
          VFD    24/0        RESERVED 
 BMLMF    VFD    12/         MAINFRAME ID 
  
          VFD    12/0        RESERVED 
  
 BMLL     EQU    *-BML       MESSAGE LENGTH 
 IFL      SPACE  4,15 
**        IFL - INITIATE FIRMWARE LOAD. 
* 
*         ENTRY  (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (MX) = MUX CHANNEL FLAG. 
*                (CN - CN+4) = *EQDE* EST WORD. 
* 
*         USES   IR+2, IR+4, CM - CM+4. 
* 
*         CALLS  RCE. 
* 
*         MACROS EXECUTE, MONITOR.
  
  
*         CHECK FOR FIRMWARE LOAD COMPLETE. 
  
 IFL1     RJM    RCE         READ CONTROLWARE TABLE ENTRY 
          SHN    21-13
          PJN    IFLX        IF LOAD IS COMPLETE
  
*         ENTER PP RECALL QUEUE.
  
          LDK    ZERL        SET 1 SECOND TIMED RECALL PARAMETERS 
          CRD    CM 
          LDM    IDSC        RESTORE ORIGINAL CONTENTS
          STD    IR+2 
          LDD    MA          SET PP INPUT REGISTER IMAGE
          CWD    IR 
          MONITOR  RECM      ENTER RECALL AND DROP PP 
          LJM    PPR         EXIT TO PP RESIDENT
  
 IFL      SUBR               ENTRY
          LDD    CN 
          SHN    21-13
          PJN    IFLX        IF NOT MASS STORAGE
          LDD    MX 
          NJN    IFLX        IF MUX CHANNEL 
          LDD    FT 
          ZJN    IFLX        IF *DOWN* REQUEST
          RJM    RCE         READ CONTROLWARE TABLE 
          LPN    37 
          ZJN    IFLX        IF NO CONTROLWARE
          LDN    ** 
 IFLA     EQU    *-1
          ZJP    IFL1        IF FIRMWARE RELOAD ALREADY STARTED 
  
*         SET RELOAD REQUEST FLAG IN CONTROLWARE TABLE. 
  
          LDD    TA+1 
          STD    CM+4 
          LDD    TA 
          STD    CM+3 
          LDN    1           SET REQUEST COUNT
          STD    CM+1 
          LDD    MA          PLACE PARAMETERS IN MESSAGE BUFFER 
          CWM    IFLE,ON
          MONITOR  UTEM 
  
*         USE THIS PP TO INITIATE CONTROLWARE RELOAD. 
  
          LDM    IDSC        SET FUNCTION CODE
          SCN    77          PRESERVE BUFFER LOCK/LOGGING CONTROL BITS
          LMN    /1DS/ILJF
          STD    IR+2 
          LDD    TH          SET *UPCF* CALL FLAG 
          RAD    IR+4 
          LDD    IA          REWRITE PP INPUT REGISTER
          CWD    IR 
          EXECUTE  1DS,=
          LJM    PPR         EXIT TO PP RESIDENT
  
  
 IFLE     VFD    1/0,5/,6/1,6/13,42/1  *UTEM* REQUEST 
 IMS      SPACE  4,15 
**        IMS - ISSUE MESSAGES TO THE ERRLOG AND BML. 
* 
*         ENTRY  (A) = MESSAGE INDEX. 
*                (CH) = CHANNEL NUMBER. 
*                (IR+4) = DRIVER CALL FLAG. 
*                (MI) = INCREMENTED IF MESSAGES WERE ISSUED.
*                (T5) = EST ORDINAL.
* 
*         EXIT   (A) .GE. 0.
* 
*         USES   S1, T1.
* 
*         CALLS  C2D, DFM, IBM. 
  
  
*         *MSI0* PROCESSOR. 
  
 IMS1     LDD    CH          CONVERT CHANNEL NUMBER TO DISPLAY CODE 
          RJM    C2D
          STM    MSG0+1 
  
*         *MSI1* PROCESSOR. 
  
 IMS2     LDD    T5          CONVERT EST ORDINAL TO DISPLAY CODE
          SHN    -3 
          RJM    C2D
          STM    MSG1+1 
          LDD    T5 
          LPN    7
          SHN    6
          ADC    2R0
          STM    MSG1+2 
          LDM    IMSB,S1     ISSUE ERRLOG MESSAGE 
          LMK    ERLN 
          RJM    DFM
          RJM    IBM         ISSUE BML MESSAGE
*         LDN    0
  
 IMS      SUBR               ENTRY/EXIT 
          STD    S1          SAVE MESSAGE INDEX 
          LDD    IR+4 
          SHN    21-13
          PJN    IMSX        IF NOT CALLED BY DRIVER
          AOD    MI          SET *MESSAGE ISSUED* FLAG
          LDM    IMSA,S1     GET PROCESSOR ADDRESS
          STD    T1 
          LJM    0,T1        ENTER PROCESSOR
  
  
*         MESSAGE INDICES.
  
 BEGIN    BSSN   0
 MSI0     BSSN   1
 MSI1     BSSN   1
 MSIX     BSSN   1           MAXIMUM INDEX + 1
 END      BSSN
  
  
*         TABLE OF PROCESSOR ADDRESSES. 
  
 IMSA     INDEX 
          INDEX  MSI0,IMS1
          INDEX  MSI1,IMS2
          INDEX  MSIX 
  
  
*         TABLE OF MESSAGE ADDRESSES. 
  
 IMSB     INDEX 
          INDEX  MSI0,MSG0
          INDEX  MSI1,MSG1
          INDEX  MSIX 
  
  
 MSG0     DATA   6HCHXX,
 MSG1     DATA   C*EQXXX DOWNED BY SYSTEM.* 
 RCE      SPACE  4,10 
**        RCE - READ CONTROLWARE TABLE ENTRY. 
* 
*         ENTRY  (CB) = CONTROLWARE TABLE BYTE ADDRESS. 
*                (TA - TA+1) = CONTROLWARE TABLE WORD ADDRESS.
* 
*         EXIT   (A) = CONTROLWARE TABLE ENTRY. 
* 
*         USES   CM - CM+4. 
  
  
 RCE      SUBR               ENTRY/EXIT 
          LDD    TA 
          SHN    14 
          LMD    TA+1 
          CRD    CM 
          LDI    CB 
          UJN    RCEX        RETURN 
 RCH      SPACE  4,30 
**        RCH - REQUEST CHANNEL ASSIGNMENT. 
* 
*         THIS SUBROUTINE DETERMINES IF CHANNEL ASSIGNMENT TO THIS PP 
*         IS NECESSARY BEFORE PROCEDING WITH THE *UP*/*DOWN* FUNCTION.
*         IF THE CHANNEL MUST BE ASSIGNED, THE *CCHM* MONITOR FUNCTION
*         WILL BE REPEATEDLY ISSUED UNTIL EITHER THE ASSIGNMENT OCCURS
*         OR CHANNEL ASSIGNMENT BECOMES IMPOSSIBLE DUE TO ASSIGNMENT OF 
*         THE CHANNEL TO A JOB. 
* 
*         ENTRY  (CH) = CHANNEL NUMBER (AND CONCURRENCY FLAG).
*                (CS) = CHANNEL STATUS. 
*                (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (MX) = 100 IF MUX CHANNEL. 
*                (CN - CN+4) = WORD *EQDE* OF EST ENTRY.
* 
*         EXIT   (A) .GE. 0 IF ONE OF THE FOLLOWING IS TRUE - 
*                            A. CHANNEL ASSIGNMENT IS NOT REQUIRED FOR
*                               PROCESSING THIS FUNCTION. 
*                            B. CHANNEL ASSIGNMENT IS NOT REQUIRED FOR
*                               PROCESSING THIS DEVICE TYPE.
*                            C. THE CHANNEL WAS ALREADY ASSIGNED. 
*                            D. THE CHANNEL IS A MUX CHANNEL. 
*                            E. CHANNEL ASSIGNMENT WAS OBTAINED.
*                    .LT. 0 IF THE CHANNEL IS PRESENTLY ASSIGNED TO A 
*                            JOB. 
*                (CS) = 1 IF CHANNEL ASSIGNED, ELSE 0.
* 
*         USES   CM+1, CS.
* 
*         MACROS MONITOR, PAUSE.
  
  
 RCH      SUBR               ENTRY/EXIT 
          LDD    CN 
          SHN    0-13 
          ADD    CS 
          ADD    FT 
          ADD    MX 
          NJN    RCHX        IF CHANNEL NOT TO BE ASSIGNED
 RCH1     LDD    CH          REQUEST CHANNEL ASSIGNMENT 
          STD    CM+1 
          MONITOR  CCHM 
          LDD    CM+1 
          SHN    21-5 
          MJN    RCHX        IF DOWN CHANNEL ASSIGNED TO JOB
          LDD    CM+2        SET CHANNEL STATUS 
          STD    CS 
          NJN    RCHX        IF CHANNEL ASSIGNED
          PAUSE  ST 
          UJN    RCH1        RETRY
 RCS      SPACE  4,30 
**        RCS - REQUEST CHANNEL STATUS CHANGE.
* 
*         THIS SUBROUTINE REQUESTS, VIA THE *SEQM* MONITOR FUNCTION,
*         THAT THE CHANNEL STATE BE CHANGED TO *UP* OR *DOWN* ON THE
*         CURRENT DEVICE ACCORDING TO THE *1DS* FUNCTION BEING
*         PROCESSED.
* 
*         ENTRY  (CH) = CHANNEL NUMBER. 
*                (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (MX) = 100 IF MUX CHANNEL. 
*                (TI) = DEVICE TABLE INDEX. 
*                (T5) = EST ORDINAL.
*                (CN - CN+4) = WORD *EQDE* OF EST ENTRY.
* 
*         EXIT   (A) .GE. 0 IF CHANNEL STATUS HAS BEEN CHANGED. 
*                    .LT. 0 IF THE *SEQM* REQUEST WAS REJECTED.  THIS 
*                            CAN OCCUR IN THE FOLLOWING CASES - 
*                            A. THE REQUEST IS TO *UP* THE CHANNEL AND
*                               IT IS PRESENTLY ASSIGNED TO A 
*                               DIAGNOSTIC JOB. 
*                            B. THE REQUEST IS TO *DOWN* THE CHANNEL
*                               AND THE CHANNEL PROVIDES THE ONLY 
*                               NON-DOWN ACCESS PATH TO THE SPECIFIED 
*                               DEVICE AND THAT DEVICE IS NOT DOWN. 
* 
*         USES   T1, CM+1 - CM+4. 
* 
*         CALLS  IFL, IMS.
* 
*         MACROS MONITOR. 
  
  
 RCS6     LDD    T1 
          SHN    -1 
          STD    T1 
          NJN    RCS1        IF MORE RETRIES REQUIRED 
          LCN    0           SET REJECT STATUS
  
 RCS      SUBR               ENTRY/EXIT 
          LDN    10          SET RETRY CONTROL
          STD    T1 
 RCS1     LDD    T5          STORE EST ORDINAL IN REQUEST 
          STD    CM+1 
          ERRNZ  UPCS-DNCS-1 CODE DEPENDS ON VALUE
          LDD    FT          SET *SEQM* SUBFUNCTION 
          ADK    DNCS 
          STD    CM+2 
          LDD    CH          STORE CHANNEL IN REQUEST 
          STD    CM+3 
          LDD    MX          STORE MUX FLAG IN REQUEST
          STD    CM+4 
          MONITOR  SEQM      REQUEST CHANNEL STATUS CHANGE
          LDD    CM+1 
          ZJN    RCS6        IF REQUEST WAS REJECTED
          RJM    IFL         INITIATE FIRMWARE RELOAD IF NEEDED 
          LDD    CN 
          SHN    0-13 
          NJN    RCS4        IF MASS STORAGE DEVICE 
          LDD    FT 
          ZJN    RCS3        IF *DOWN* REQUEST
          LDD    T5          EST ORDINAL
          STD    CM+1 
          LDD    CH          CHANNEL NUMBER 
          STD    CM+2 
          LDK    SUCS        *SCSM* SUBFUNCTION 
          STD    CM+3 
          MONITOR  SCSM      SET CHANNEL STATE = *UP* 
 RCS3     LDD    FT 
          ZJN    RCS4.1      IF *DOWN* REQUEST
          LDD    T5          SET CONTROLWARE LOAD REQUIRED
          STD    CM+1 
          LDN    SB0S        SET SUBFUNCTION
          STD    CM+2 
          LCN    20          SET MASK 
          STD    CM+3 
          LDN    20          SET VALUE
          STD    CM+4 
          MONITOR  SEQM 
 RCS4     LDK    MSI0        MESSAGE INDEX
          RJM    IMS         ISSUE MESSAGES, IF NECESSARY 
 RCS4.1   LJM    RCSX        RETURN 
 PRS      SPACE  4,10 
**        PRS - PRESET. 
* 
*         EXIT   (CB) = CONTROLWARE TABLE BYTE ADDRESS. 
*                (CH) = CHANNEL NUMBER (INCLUDING CONCURRENCY FLAG).
*                (CS) = 0.
*                (FG) = CME FLAG. 
*                (FT) = FUNCTION TYPE (1 IF *UP*, 0 IF *DOWN*). 
*                (MI) = 0.
*                (MX) = MUX FLAG (100 IF MUX CHANNEL, ELSE 0).
*                (TA - TA+1) = CONTROLWARE TABLE WORD ADDRESS.
* 
*         USES   CH, CS, FT, MI, MX, T1 - T3, CM - CM+4.
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDN    0
          STD    CS 
          STD    MI 
          STD    T1 
          LDD    IR+3        SET CHANNEL NUMBER 
          LPN    77 
          STD    CH 
          STD    T2 
          STM    CMVA+4 
          LDD    IR+2        SET FUNCTION TYPE
          ERRNZ  /1DS/UPCF-/1DS/DWNF-1  CODE DEPENDS ON VALUE 
          SBN    /1DS/DWNF
          STD    FT 
          LDD    IR+3        SET/CLEAR MUX FLAG 
          LPC    100
          STD    MX 
          LDN    60D
          STD    T3 
 PRS1     AOD    T1          ADVANCE CM WORD INDEX
          LCN    5
          RAD    T2 
          PJN    PRS1        IF NOT AT PROPER WORD
          ADN    5+CM        SET CONTROLWARE TABLE BYTE ADDRESS 
          STD    CB 
          SBN    CM 
          LPN    7
          STD    T2 
 PRS2     LCN    12D         DECREMENT POSITION 
          RAD    T3 
          SOD    T2          DECREMENT BYTE NUMBER
          PJN    PRS2        IF NOT TO PROPER POSITION
          LDD    T3          BIT POSITION 
          ADN    13          ADD OFFSET OF BIT WITHIN BYTE
          SHN    6
          STM    IFLE+1 
          SBK    200
          RAM    CDSD+1 
          STM    CDSE+1 
          SBK    300
          RAM    CRCB+1 
          LDK    CHTP        READ CHANNEL STATUS TABLE
          CRD    CM 
          LDD    CM+2 
          SHN    14 
          LMD    CM+3 
          ADD    T1 
          SBN    1
          CRD    CM 
          ADN    CTALL*2     CONTROLWARE TABLE ADDRESS
          STD    TA+1 
          SHN    -14
          STD    TA 
          LDI    CB          SAVE GLOBAL DOWN STATUS
          LPN    40 
          RAM    IFLA 
          LJM    PRSX        RETURN 
  
  
          OVERFLOW  OVLA,/OVERLAY/BUFB
          TTL    1DS - DSD REQUEST PROCESSOR. 
          SPACE  4,10 
          END 
