Retro1.org codex

          IDENT  1RM,RDM 
          PERIPH
          BASE   M
          SST
          TITLE  1RM - REDEFINE MASS STORAGE.
*COMMENT  1RM - REDEFINE MASS STORAGE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 RDM      SPACE  4,10
*****     1RM - REDEFINE MASS STORAGE.
*
*         A. J. BEEKMAN.     77/04/25.
*         W. E. GOEBEL.      80/02/25.
*
*         *1RM* PROVIDES FUNCTIONS USED IN THE REDEFINITION OR REPAIR
*         OF 844 AND 885 TYPE MASS STORAGE DEVICES.
          SPACE  4,10
***       *1RM* USES PARAMETERS PASSED TO IT FROM THE CPU ROUTINE
*         *CONFIG* (CONFIGURATION MONITOR) TO PERFORM OPERATIONS
*         WHICH CONTROL THE ON-LINE RECONFIGURATION OR REPAIR OF
*         844 AND 885 TYPE MASS STORAGE DEVICES.
          SPACE  4,10
***       *1RM* PROCESSES THE FUNCTIONS AS DEFINED IN *COMS1RM*.
*         ALL *1RM* FUNCTIONS REQUIRE THAT THE CALLING JOB HAS MASS
*         STORAGE SUBSYSTEM ID.
*
*         THE CALL TO *1RM* IS IN THE FOLLOWING FORM -
*
*T IR     24/ *1RMP*,18/ KDMA,18/ ADDR
*
*         ADDR = ADDRESS OF CALL BLOCK.
*         KDMA = K-DISPLAY MESSAGE LINE ADDRESS.
*
*                THE CALL BLOCK FORMAT IS DOCUMENTED IN *COMS1RM*.
          SPACE  4,10
***       K-DISPLAY COMMANDS.
*
*         THE FOLLOWING COMMANDS ARE ENTERED IN RESPONSE TO AN
*         ERROR CONDITION DETECTED BY *1RM*.
*
*         ABORT. THIS COMMAND IS ENTERED TO DISCONTINUE PROCESSING
*                OF THE CURRENT COMMAND IN PROGRESS.
*
*         IGNORE.  THE ERROR CONDITION DETECTED BY *1RM* IS TO
*                BE IGNORED.  THIS COMMAND SHOULD BE USED WITH
*                DISCRETION.  IT SHOULD BE USED ONLY WHEN THE
*                ERROR BEING POSTED IS WELL UNDERSTOOD AND
*                CAN LEGITIMATELY BE IGNORED.
*
*         NEXT.  THIS COMMAND IS ENTERED IN RESPONSE TO AN
*                885 SERVO TIMING CHECK WHEN THE TIMING DATA
*                IS IN THE REQUIRED RANGE.  ENTRY OF THIS
*                COMMAND WILL CAUSE PROCESSING TO CONTINUE
*                WITH EITHER THE NEXT UNIT OR THE NEXT STEP
*                OF PROCESSING.
*
*         RECHECK.  THIS COMMAND IS ENTERED TO RETRY A PROCESS
*                WHICH PREVIOUSLY GAVE AN ERROR.  IF THE ERROR
*                PERSISTS THE MESSAGE WILL BE POSTED AGAIN
*                WITH ANOTHER OPPORTUNITY FOR OPERATOR ACTION.
          SPACE  4,10
***       K-DISPLAY OPERATOR MESSAGES.
*
*
*         THE FOLLOWING COMMANDS ARE POSTED ON THE K-DISPLAY BY
*         *1RM*.  WHEN *1RM* DETECTS A CONDITION WHICH MAY BE
*         RESPONDED TO BY THE OPERATOR, A MESSAGE IS POSTED AND
*         THE LEGAL COMMANDS ARE POSTED ON THE K-DISPLAY.  THE
*         FOLLOWING LIST OF ERROR MESSAGES LISTS THOSE LEGAL
*         COMMANDS AND INDICATES IF AN OPERATOR RESPONSE IS
*         REQUIRED OR OPTIONAL.
*
*
*         UNIT XX, CHYY WRITE/READ VERIFY ERROR.
*                PART OF THE VALIDATION PROCEDURE WHEN RETURNING
*                AN EQUIPMENT FOR SYSTEM USE (CLEAR COMMAND) IS
*                TO WRITE A SECTOR OF DATA TO THE DEVICE, READ IT
*                BACK AND VERIFY THE DATA.  WHEN THIS VERIFICATION
*                FAILS THE ABOVE MESSAGE APPEARS.
*         COMMANDS - REQUIRED.
*                ABORT, IGNORE, RECHECK.
*
*
*         ERROR IN PERFORMING SERVO CHECK ON UNIT XX.
*                THE SERVO ADJUSTMENT PROCEDURE HAS ENCOUNTERED
*                A DISK ERROR CONDITION.
*         COMMANDS - REQUIRED.
*                ABORT, IGNORE, RECHECK.
*
*
*         UNIT XX SERVO TIMING= XXX.  ACCEPTABLE RANGE IS 325 TO 345.
*                WHEN RECONFIGURING AN 885 HDA A SERVO ADJUSTMENT
*                PROCEDURE IS EXECUTED.  THIS PROCEDURE MEASURES
*                SERVO TIMING CHARACTERISTICS WHICH MUST BE IN THE
*                SPECIFIED RANGE.  A DRIVE ADJUSTMENT MUST BE MADE
*                BY A CE UNTIL THE TIMING IS IN THE SPECIFIED
*                RANGE.
*         COMMANDS - REQUIRED.
*                ABORT, RECHECK.
*                NEXT.  ONLY IF TIMING IS IN RANGE.
*                IGNORE.  ONLY IF TIMING IS NOT IN RANGE.
*
*
*         ERROR ON LINK DEVICE.
*                WHEN A DEVICE IS SHARED BETWEEN MAINFRAMES THE
*                LINK DEVICE IS READ TO SYNCHRONIZE PROCESSING
*                BETWEEN MACHINES.  WHEN AN ERROR OCCURS IN
*                READING THE LINK DEVICE THIS ERROR MESSAGE
*                IS ISSUED.
*         COMMANDS - REQUIRED.
*                ABORT, IGNORE.
*
*
*         SPIN DOWN UNIT XX.
*                THIS IS A DIRECTIVE TO THE OPERATOR OR CE TO
*                SPIN DOWN THE SPECIFIED UNIT IN PREPARATION
*                FOR MOVING THE PACK OR HDA.
*         COMMAND - OPTIONAL.
*                ABORT, IGNORE.
*
*
*         MOVE PACK FROM UNIT XX TO UNIT YY AND SPIN UP.
*                THIS DIRECTIVE IS ISSUED TO THE OPERATOR FOR
*                EACH UNIT TO BE MOVED DURING A RECONFIGURATION.
*                UNIT XX HAS PREVIOUSLY BEEN DIRECTED TO BE
*                SPUN DOWN AND ITS PACK OR HDA IS NOW TO BE
*                MOVED TO UNIT YY.
*         COMMANDS - OPTIONAL.
*                ABORT, IGNORE.
*
*
*         UNIT XX, CHYY LABEL READ ERROR.
*                IN VERIFYING THAT THE CORRECT LABEL IS PRESENT
*                ON UNIT XX A DISK ERROR OCCURRED WHICH PREVENTED
*                THE LABEL FROM BEING READ SUCCESSFULLY.
*                THE CHANNEL IS SPECIFIED IN THE MESSAGE AND
*                MAY BE HELPFUL IF THE VERIFY ERROR OCCURS
*                ONLY FROM A SINGLE CHANNEL IN A DUAL ACCESS
*                CONFIGURATION.
*         COMMANDS - REQUIRED.
*                ABORT, IGNORE, RECHECK.
*
*
*         UNIT XX, CHYY LABEL VERIFICATION ERROR.
*                THE LABEL SECTOR WAS READ BUT THE DATA IN THE
*                LABEL SECTOR IS NOT CORRECT.
*         COMMANDS - REQUIRED.
*                ABORT, IGNORE, RECHECK.
*
*
*         WAITING FOR MACHINE ID=XX.
*                A SHARED DEVICE IS BEING PROCESSED AND IT HAS
*                BEEN DETECTED THAT MACHINE IDXX IS NOT AT THE
*                SAME STAGE OF PROCESSING AS THIS MACHINE.
*         COMMANDS - REQUIRED.
*                ABORT, IGNORE.
*
*
*         COMMAND ABORTED.
*                INFORMATIVE MESSAGE STATING THAT THE ATTEMPTED
*                COMMAND WAS ABORTED AND ALL VALUES FOR THE CURRENT
*                EQUIPMENT BEING PROCESSED HAVE BEEN RESET TO THEIR
*                ORIGINAL VALUE.
*         COMMANDS - NONE.
*
*
*         UNIT XX SERVO TIMING IN PROGRESS.
*                INFORMATIVE MESSAGE STATING THAT ADJUSTMENTS ARE
*                BEING MADE ON THE SERVO TIMING.
*         COMMANDS - NONE.
*
*
*         EQXXX, REDEFINITION COMPLETE.
*                NORMAL COMPLETION MESSAGE.
*
*
*         EQXXX, SYSTEM USAGE OF DEVICE SUSPENDED.
*                INFORMATIVE MESSAGE STATING THAT DEVICE USAGE HAS
*                BEEN SUSPENDED AS REQUESTED.
*         COMMANDS - NONE.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         * 1RM INCORRECT REQUEST.* = INCORRECT FUNCTION CODE OR STATUS
*         WORD ADDRESS OUT OF RANGE.
*
*         * 1RM USER ACCESS NOT VALID.* = CALLING JOB NOT MASS STORAGE
*         SUBSYSTEM QUEUE PRIORITY.
          SPACE  4,10
**        ROUTINES USED.
*
*         0SI - SERVO TIMING.
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMPMAC
*CALL     COMSCPS
          QUAL   DSL
*CALL     COMSDSL
          QUAL   *
*CALL     COMSEVT
*CALL     COMSLSD
*CALL     COMSMMF
*CALL     COMSMSP
*CALL     COMSMST
*CALL     COMSPIM
*CALL     COMSPRD
*CALL     COMSSSD
*CALL     COMSZOL
          LIST   X
*CALL     COMS1RM
          LIST   *
          TITLE  MACROS.
 COMMAND  SPACE  4,10
**        COMMAND - SPECIFY LEGAL K-DISPLAY COMMANDS.
*
*         THE *TPAR* WORD INDICATES TO *CONFIG* WHICH K-DISPLAY
*         COMMANDS ARE LEGAL FOR *1RM* PROCESSING.  THIS
*         MACRO IS USED TO SET THE *TPAR* WORD TO THE LEGAL
*         COMMANDS.  WHEN *CONFIG* DETECTS A LEGAL COMMAND IT IS
*         PASSED TO *1RM* VIA WORD *TCOM* IN THE CALL BLOCK.
*         *1RM* CHECKS FOR COMMANDS WITH THE AID OF THE *IFCOM*
*         MACRO.
*
*         COMMAND  C
*                C = A LIST OF LEGAL COMMAND KEYWORDS.
 
 
 COMMAND  MACRO  C
          MACREF COMMAND
 .2       SET    0
          IRP    C
 .1       DECMIC ._C-1
 .2       SET    .2+1BS".1"
          IRP
          IFGT   .2,77
          LDC    .2
          ELSE   1
          LDN    .2
          RJM    SLC
          ENDM
 LDBUF    SPACE  4,10
**        LDBUF - LOAD ADDRESS OF CALL BUFFER WORD.
*
*         LDBUF  ADD
*                ADD = CALL BUFFER WORD INDEX.
 
 
 LDBUF    MACRO  A
          MACREF LDBUF
          RJM    LDB
          IFNE   A,0,1
          ADN    A
          ENDM
 IFCOM    SPACE  4,10
**        IFCOM - CHECK IF COMMAND ENTERED.
*
*         THIS MACRO CHECKS FOR A COMMAND PREVIOUSLY SPECIFIED
*         WITH THE COMMAND MACRO TO SEE IF IT HAS BEEN ENTERED
*         VIA THE K-DISPLAY.
*
*         IFCOM  C,TAG
*                C = COMMAND LIST TO BE CHECKED.
*                TAG = ADDRESS TO JUMP TO IF COMMAND ENTERED.
 
 
 IFCOM    MACRO  C,TAG
          MACREF IFCOM
 .2       SET    0
          IRP    C
 .1       DECMIC ._C-1
 .2       SET    .2+1BS".1"
          IRP
          IFGT   .2,77
          LDC    .2
          ELSE   1
          LDN    .2
          RJM    CLC
          IF     DEF,TAG
          IFLT   *-TAG,40
          NJN    TAG         IF TAG WITHIN RANGE
          ELSE   2
          ZJN    *+3         IF TAG OUT OF RANGE, REVERSE TEST LOGIC
          LJM    TAG         LONG JUMP TO TAG
          ENDM
 MESG     SPACE  4,10
**        MESG - SEND MESSAGE TO K-DISPLAY.
*
*         MESG   ADD
*                ADD = ADDRESS OF K-DISPLAY MESSAGE.
 
 
 MESG     MACRO  A
          MACREF MESG
          IFC    NE,=A=*=,1
          LDC    A
          RJM    KMS
          ENDM
          SPACE  4,10
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 BEGIN    BSSN   20
 CN       BSSN   5           CM WORD BUFFER
 CH       BSSN   1           CHANNEL CURRENTLY IN USE
 DI       BSSN   1           DAT INDEX
 EQ       BSSN   1           EST ORDINAL FOR RECONFIGURATION
 FN       BSSN   1           FUNCTION IN PROGRESS
 GL       BSSN   1           DEVICE UNAVAILABLE FLAG
 LU       BSSN   1           LOGICAL UNIT NUMBER OF CURRENT UNIT
 LT       BSSN   1           LABEL TRACK FROM MST
 MF       BSSN   1           MMF STATUS
 MM       BSSN   1           MACHINE MASK FOR THIS MACHINE
 MS       BSSN   1           MST ADDRESS/10B
 NC       BSSN   1           FIRST OF SECOND CHANNEL FLAG
 NU       BSSN   1           NUMBER OF UNITS FOR EQUIPMENT
 PU       BSSN   1           PHYSICAL UNIT NUMBER OF CURRENT UNIT
 RM       BSSN   1           *RD* DEVICE MST ADDRESS/10B
 RU       BSSN   1           UNITS FOR RECONFIGURATION OR REPAIR
 SC       BSSN   1           SUSPENDED DEVICE COUNT
 SL       BSSN   1           SINGLE UNIT SECTOR LIMIT FOR EQUIPMENT
 MX       BSSN   0           MAXIMUM DIRECT CELL
 END      BSSN
          ERRPL  MX-50       DIRECT CELL OVERFLOW
 
 
****
          TITLE  RDM - MAIN PROGRAM.
**        RDM - MAIN PROGRAM.
 
 
          ORG    PPFW
 RDM      RJM    PRS         PRESET
 RDM1     DELAY
          PAUSE
          LDBUF  RFNB        CHECK FOR FUNCTION REQUEST
          CRD    CN
          LDD    CM+1
          ZJN    RDM2        IF NO ERROR FLAG
          LDN    0
          LJM    RDM4        DROP PP
 
 RDM2     LDD    CN+4
          SHN    21
          PJN    RDM1        IF NO FUNCTION PRESENT
          STD    FN
          RJM    SEQ         SET EQUIPMENT PARAMETERS
          LDM    TFCN,FN
          STM    RDMA
          RJM    *           PROCESS REQUEST
 RDMA     EQU    *-1
 
*         RETURN FROM FUNCTION PROCESSOR.
*         IF A DEVICE SUSPEND REQUEST IS OUTSTANDING *1RM* MUST
*         REMAIN ASSIGNED UNTIL IT IS CLEARED.  IF *1RM* WERE
*         TO DROP OUT A DEADLOCK COULD BE CREATED BECAUSE OF
*         PP RESOURCES BEING TIED UP WAITING FOR THE SUSPENDED
*         DEVICE.
*
*         (A) = 0 IF COMMAND WAS NOT ABORTED.
*         (A) .NE. 0 IF *ABORT* WAS ENTERED.
 
          ZJN    RDM3        IF COMMAND NOT ABORTED
          MESG   RDMB        *COMMAND ABORTED*
 RDM3     RJM    RRD         RESET *RD* DEVICE
          LDBUF  RFNB        READ FUNCTION WORD
          CRD    CN
          LDD    SC          CHECK FOR SUSPENDED DEVICES
          ZJN    RDM4        IF NO DEVICE SUSPENDED - DROP PP
          LDD    CN+4
          SCN    1
 RDM4     STD    CN+4
          LDBUF  RFNB
          CWD    CN
          LDD    CN+4
          ZJN    RDM5        IF DROP OF PP
          LJM    RDM1        CHECK FOR NEXT FUNCTION
 
 RDM5     RJM    CSP         CLEAR EQUIPMENT ASSIGNMENT
          LDK    ZERL        RESTART JOBS WAITING ON DEVICE
          CRD    CM
          LDD    EQ          EST ORDINAL
          STD    CM+3
*         LDN    0           *WISE* SUBFUNCTION
*         STD    CM+4
          ERRNZ  WISE        ADJUST CODE IF VALUE CHANGES
          MONITOR  EATM
          MONITOR  DPPM
          LJM    PPR         EXIT
 
 RDMB     DATA   C*COMMAND ABORTED.*
          SPACE  4,10
**        TFCN - TABLE OF FUNCTION CODE PROCESSORS.
*
*         ENTRY = 1 WORD INDEXED BY FUNCTION CODE.
*
*T        12/ ADDR
*                ADDR = ADDRESS OF FUNCTION PROCESSOR.
 
 
 TFCN     INDEX              TABLE OF FUNCTION CODE PROCESSORS
          INDEX  RUMF,UMT    UPDATE MST-S FROM EXTENDED MEMORY
          INDEX  RCLF,CLR    CLEAR IDLE AND SUSPEND REQUESTS
          INDEX  RCDF,CDI    CLEAR DAT INTERLOCK
          INDEX  RDDF,RDD    REDEFINE DEVICE
          INDEX  RSPF,SPD    SUSPEND DEVICE ACTIVITY
          INDEX  RMXF
 CDI      TITLE  CLEAR *DATI* INTERLOCK.
**        CDI - CLEAR *DATI* INTERLOCK.  (FUNCTION RCDF).
*
*         ENTRY  (MF) = MULTI-MAINFRAME LINK DEVICE.
*
*         USES   CN - CN+4.
*
*         CALLS  IFR.
 
 
 CDI      SUBR               ENTRY/EXIT
          LDD    MF          CHECK FOR MULTI-MAINFRAME
          ZJN    CDIX        IF NOT MMF
          LDC    MMFL        READ *DATI* INTERLOCK INDICATION
          CRD    CN
          LDD    CN+2
          ZJN    CDIX        IF INTERLOCK NOT SET
          LCN    DATI
          RJM    IFR         CLEAR *DATI* FLAG REGISTER INTERLOCK
          LDN    0           CLEAR INTERLOCK INDICATOR
          STD    CN+2
          LDC    MMFL
          CWD    CN
          LDN    0
          UJN    CDIX        RETURN
          TITLE  CLR - CLEAR IDLE AND SUSPEND REQUEST.
**        CLR - CLEAR IDLE AND SUSPEND REQUEST.  (FUNCTION RCLF).
*
*         CLEAR THE IDLE AND SUSPEND REQUESTED BIT FOR THE SPECIFIED
*         EQUIPMENT.
*
*         ENTRY  (EQ) = EST ORDINAL.
*
*         EXIT   (A) .NE. 0 IF THE OPERATION WAS ABORTED OR AN ERROR
*                           FLAG IS SET AT THE CONTROL POINT.
*
*         USES   LU, NC, T5, T7, CM - CM+4, CN - CN+4.
*
*         CALLS  CAS, CDI, CDP, CSP, MSV, PUE, SCF, SDI, SNC, VLB, WAM.
*
*         MACROS CMSTF, LDBUF, MONITOR, SFA.
 
 
 CLR      SUBR               ENTRY
          LDD    GL
          ZJN    CLR1        IF DEVICE AVAILABLE
          LJM    CLR6        CLEAR SUSPEND AND IDLE STATUS
 
 CLR1     LDN    MSTL        SET MST WORD COUNT
          STD    T7
          LDBUF  ESTD        READ EST ENTRY
          CRD    CN
          ADN    MSTD-ESTD   READ MST
          CRM    BFMS,T7
          RJM    SCF         SET COMMON FIELDS IN *RD* DEVICE
          NJN    CLRX        IF ERROR FLAG SET AT CP
 
*         VERIFY FUNCTIONAL AND LOGICAL INTEGRITY OF EQUIPMENT.
 
 CLR2     LDN    1           SET FIRST CHANNEL
          STD    NC
 CLR3     RJM    SNC         SET *NC* CHANNEL
          NJN    CLR5        IF CHANNEL NOT AVAILABLE
          RJM    VLB         VERIFY LABEL SECTOR
          NJN    CLR7        IF *ABORT*
 CLR4     RJM    MSV         MASS STORAGE VERIFICATION
          ZJN    CLR5        IF VERIFY GOOD
          LDC    CLRA        * UNIT XX, CHYY WRITE/READ VERIFY ERROR.*
          RJM    PUE         PROCESS UNIT ERROR
          MJN    CLR4        IF *RECHECK*
          NJN    CLR7        IF *ABORT*
 CLR5     SOD    NC
          PJN    CLR3        IF MORE CHANNELS TO PROCESS
 
*         ADVANCE TO NEXT UNIT.
 
          AOD    LU
          LDD    SL
          RAD    T7
          SBM    SLM
          MJN    CLR2        IF MORE UNITS TO PROCESS
 
*         CLEAR SUSPEND AND IDLE STATUS.
 
 CLR6     RJM    SDI         SET DAT INTERLOCK
 CLR7     NJN    CLR9        IF *ABORT*
          RJM    CSP         CLEAR SUSPEND STATUS
          RJM    CAS         CHECK ALL SUSPENDS CLEARED
          NJN    CLR8        IF SUSPEND SET FOR OTHER MACHINES
          LDD    EQ
          STD    T5
          CMSTF  GRDR        CLEAR REDEFINITION REQUESTED
 CLR8     RJM    CDI         CLEAR DAT INTERLOCK
          LDC    ZJNI+WAM4-WAMB   USE CORRECT CONDITIONAL JUMP
          RJM    WAM         ENSURE SYNCHRONIZATION OF PROCESSING
          NJN    CLR9        IF *ABORT*
          RJM    CDP         COMPLETE DEVICE PROCESSING
          LDN    0
 CLR9     LJM    CLRX        RETURN
 
 CLRA     DATA   C* UNIT XX, CHYY WRITE/READ VERIFY ERROR.*
 RDD      TITLE  REDEFINE UNITS FUNCTION PROCESSOR.
**        RDD - REDEFINE UNITS.  (FUNCTION RDDF).
*
*         REDEFINE AN EQUIPMENT BY CHANGING THE UNITS AND OPTIONALLY
*         THE CHANNELS.  THE CHANGE MAY INVOLVE PHYSICALLY MOVING
*         PACKS OR HDAS IN WHICH CASE THE PROCESS IS GUIDED BY
*         MESSAGES WHICH APPEAR ON THE *K* DISPLAY AND AT THE USER-S
*         CONTROL POINT.
*
*         ENTRY  (FG) = FLAGS.
*                       1 = SPIN DOWN UNITS BEING CHANGED.
*                       2 = VERIFY LABELS ON NEW CONFIGURATION.
*
*         EXIT   (A) .NE. 0 IF OPERATION ABORTED.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  CLR, GCI, SCH, SDU, SPD, SUU, ULD.
*
*         MACROS LDBUF.
 
 
 RDD      SUBR               ENTRY/EXIT
          LDD    RU
          ZJN    RDD1        IF NO CHANGE OF UNITS
          RJM    SPD         SUSPEND DEVICE USAGE
          NJN    RDDX        IF REDEFINITION ABORTED
          LDD    GL
          NJN    RDD1        IF DEVICE UNAVAILABLE
          RJM    SDU         SPIN DOWN CHANGED UNITS
          NJN    RDDX        IF *ABORT* OR ERROR FLAG SET
          RJM    SUU         SPIN UP UNITS
          NJN    RDDX        IF *ABORT* OR ERROR FLAG SET
 
*         SET NEW CONFIGURATION IN MST.
 
 RDD1     LDBUF  ESTD        SET NEW CHANNELS
          CRD    CN
          LDD    CN+1        SET NEW CHANNELS IN EST
          RJM    GCI
          ZJN    RDD2        IF FULL-TRACK CHANNEL
          LDD    CN+1        SET HALF-TRACK FLAG
          LPC    7377
          LMC    400
          STD    CN+1
 RDD2     LDD    CN+2        PROCESS SECOND CHANNEL
          ZJN    RDD5        IF NO SECOND CHANNEL
          RJM    GCI
          ZJN    RDD5        IF FULL-TRACK CHANNEL
          LDD    CN+2        SET HALF-TRACK FLAG
          LPC    7377
          LMC    400
          STD    CN+2
 RDD5     LDD    EQ          SET CHANNELS IN EST
          RJM    SCH
          LDBUF  MSTD+DDLL   SET NEW UNIT LIST
          CRD    CN
          LDD    CN
          LPC    3777
          STD    CN
          LDD    MS
          SHN    3
          ADN    DDLL
          CWD    CN
          RJM    ULD         UPDATE LINKED DEVICES MST-S
          RJM    CLR         CLEAR SUSPEND AND IDLE AFTER VALIDATION
          LJM    RDDX        RETURN
 SPD      TITLE  SUSPEND PROCESSING ON DEVICE.
**        SPD - SUSPEND PROCESSING ON DEVICE.  (FUNCTION RSPF).
*
*         THIS FUNCTION SUSPENDS PROCESSING ON A DEVICE SO THAT
*         REPAIR OPERATIONS CAN BE EFFECTED.  ALSO A DEVICE MAY
*         BE SUSPENDED SO THAT A UNIT IN ITS CONFIGURATION MAY
*         BE ADDED TO ANOTHER EQUIPMENT.
*
*         EXIT   (A) .NE. 0 IF THE OPERATION WAS ABORTED OR AN ERROR
*                           FLAG IS SET AT THE CONTROL POINT.
*                (SC) UPDATED TO INDICATE NEW SUSPEND COUNT.
*
*         USES   CM - CM+4.
*
*         CALLS  CDI, SDI, SSP, WAM.
*
*         MACROS MONITOR, SFA.
 
 
 SPD      SUBR               ENTRY/EXIT
 
*         THE *DATI* INTERLOCK IS HELD WHILE SETTING THE SUSPEND
*         STATUS ON A DEVICE.  SUSPEND STATUS REQUIRES THAT IDLE
*         BE SET ON THE DEVICE.  THE *DATI* INTERLOCK CONTROLS THE
*         CLEARING OF SUSPEND.  WHEN THE LAST MACHINE CLEARS IT-S
*         SUSPEND STATUS IT ALSO CLEARS DEVICE IDLE.  THUS WHEN
*         CHECKING TO ENSURE IDLE IS SET SO THAT SUSPEND MAY THEN BE
*         SET, THE *DATI* INTERLOCK IS HELD TO ENSURE THAT ANOTHER
*         MACHINE IS NOT CLEARING IDLE AT THE SAME TIME.
 
          RJM    SDI         SET *DATI* INTERLOCK
          NJN    SPDX        IF SUSPEND ABORTED
 
*         CHECK THAT THE DEVICE IDLE STATUS HAS NOT BEEN CLEARED
*         BY ANOTHER MACHINE.
 
          LDD    EQ          OBTAIN UP-TO-DATE MST IN CM
          STD    CM+1
          LDN    UTRS
          STD    CM+3
          MONITOR  STBM
          SFA    EST,EQ      READ *ACGL* WORD OF MST
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          SHN    3
          ADN    ACGL
          CRD    CM
          LDD    CM+4        CHECK REDEFINITION REQUESTED BIT
          SHN    21-GRDR
          PJN    SPD1        IF IDLE NOT SET
          RJM    SSP         SET SUSPEND STATUS
 SPD1     RJM    CDI         CLEAR *DATI* INTERLOCK
 
*         IN ORDER TO ENSURE ALL MACHINES ARE SYNCHRONIZED IN
*         THEIR PROCESSING OF A DEVICE THE FOLLOWING CODE WAITS
*         FOR ANY OTHER MACHINES SHARING THE DEVICE TO SUSPEND
*         ACTIVITY.
 
          LDC    NJNI+WAM4-WAMB  USE CORRECT CONDITIONAL JUMP
          RJM    WAM         WAIT FOR ALL MACHINES
          NJN    SPD2        IF *ABORT*
*         LDN    0           INDICATE NO ABORT
 SPD2     LJM    SPDX        RETURN
          TITLE  UMT - UPDATE SHARED DEVICE MST FROM EXTENDED MEMORY.
**        UMT - UPDATE SHARED DEVICE MST FROM ECS.  (FUNCTION RUMF).
*
*         ENTRY  NO CALL BLOCK PARAMETERS NEEDED.
*
*         EXIT   MST-S FOR ALL SHARED DEVICES UPDATED FROM ECS.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         MACROS MONITOR, SFA.
 
 
 UMT      SUBR               ENTRY/EXIT
          LDD    MF
          ZJN    UMTX        IF NOT MULTI-MAINFRAME
          LDN    ESTP        INITIALIZE EST SEARCH
          CRD    CN
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    CN
 UMT1     AOD    CN          ADVANCE EST ORDINAL
          LMD    CN+3
          ZJN    UMTX        IF END OF EQUIPMENTS
          SFA    EST,CN      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM
          SHN    21-13
          PJN    UMT1        IF NOT MASS STORAGE
          SHN    21-11-21+13
          PJN    UMT1        IF NOT SHARED DEVICE
          LDD    CN          UPDATE MST FROM EXTENDED MEMORY
          STD    CM+1
          LDN    UTRS
          STD    CM+3
          MONITOR  STBM
          UJN    UMT1        NEXT EQUIPMENT
 CAS      TITLE  SUBROUTINES.
 CAS      SPACE  4,10
**        CAS - CHECK ALL SUSPENDS CLEARED.
*
*         ENTRY  (EQ) = EST ORDINAL.
*                (DI) = DAT INDEX.
*
*         EXIT   (A) = 0 IF SUSPEND CLEARED FOR ALL OTHER MACHINES.
*
*         USES   T1 - T3.
*
*         CALLS  RDE.
*
*         MACROS SFA.
 
 
 CAS      SUBR               ENTRY/EXIT
          LDD    MF
          ZJN    CASX        IF NOT MMF
          SFA    EST,EQ      TEST FOR SHARED DEVICE
          ADK    EQDE
          CRD    CM
          LDD    CM
          LPC    1000
          ZJN    CASX        IF DEVICE NOT SHARED
          RJM    RDE         READ DAT ENTRY FOR DEVICE
          NJN    CASX        IF *ABORT*
          LDC    BFMS+2+DALL*5
          STD    T1
          LDN    1           PRESET SEARCH MASK
          STD    T2
          LDN    MXMF
          STD    T3
 CAS1     LDM    TDAT+5+4
          LMD    T2
          SBM    TDAT+5+4
          PJN    CAS2        IF NOT SHARING WITH THIS MACHINE
          LDI    T1
          SHN    0-10
          LMN    3
          ZJN    CAS4        IF DEVICE IS DOWN
 CAS2     LDD    T2          ADVANCE MACHINE MASK AND INDEX
          RAD    T2
          LDN    LLLL*5
          RAD    T1
          SOD    T3
          NJN    CAS1        IF MORE MACHINES
 CAS3     LJM    CASX        RETURN
 
 CAS4     LDN    1           SET REPLY STATUS
          UJN    CAS3        RETURN
 CDP      SPACE  4,10
**        CDP - COMPLETE DEVICE PROCESSING.
*
*         ENTRY  (EQ) = EST ORDINAL.
*
*         CALLS  C2D.
*
*         MACROS MESG.
 
 
 CDP      SUBR               ENTRY/EXIT
          LDD    EQ          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3
          RJM    C2D
          STM    CDPA+1
          LDD    EQ          CONVERT LOWER DIGIT OF EST ORDINAL
          LPN    7
          SHN    6
          ADC    2R0,
          STM    CDPA+2
          MESG   CDPA
          UJN    CDPX        RETURN
 
 CDPA     DATA   C*EQXXX, REDEFINITION COMPLETE.*
 CLC      SPACE  4,10
**        CLC - CHECK FOR LEGAL COMMAND.
*
*         ENTRY  (A) = COMMAND MASK TO CHECK.
*
*         EXIT   (A) .NE. 0 IF COMMAND ENTERED.
*                LEGAL COMMANDS CLEARED WHEN (A) .NE. 0.
*
*         USES   CM - CM+4.
*
*         MACROS COMMAND, LDBUF, PAUSE.
 
 
 .1       DECMIC .ABORT-1    SET BIT NUMBER MICRO FOR *ABORT*
 CLC1     LDN    1BS".1"     ERROR FLAG TREATED AS *ABORT* COMMAND
 CLC2     BSS    0
 CLCA     LPC    *
          ZJN    CLCX        IF NO LEGAL COMMAND FOUND
          COMMAND            CLEAR LEGAL COMMANDS
          LDN    1           RETURN STATUS
 
 CLC      SUBR               ENTRY/EXIT
          STM    CLCA+1      SET LEGAL COMMAND MASK
          SHN    -14
          LMC    LPCI
          STM    CLCA
          PAUSE              CHECK ERROR FLAG
          LDD    CM+1
          SBN    ODET
          PJN    CLC1        IF ERROR FLAG SET
          LDBUF  TCOM        READ LEGAL COMMANDS
          CRD    CM
          LDD    CM+3
          SHN    14
          LMD    CM+4
          LJM    CLC2        RETURN
 CNR      SPACE  4,10
**        CNR - CHECK NOT READY STATUS ON DEVICE.
*
*         ENTRY  (T6) = TRACK TO READ.
*                (T5) = EST ORDINAL.
*
*         EXIT   (A) = 0 IF UNIT HAS NOT READY STATUS.
*                    .GT. 0 IF UNIT HAS READY STATUS.
*                    .LT. 0 IF MASS STORAGE READ ERROR.
*
*         CALLS  RDS.
*
*         MACROS ENDMS, SETMS.
 
 
 CNR1     ENDMS
          LDN    1           SET READY STATUS
 
 CNR      SUBR               ENTRY/EXIT
          SETMS  IO,(AD,DF,NR)
          LDC    BFMS        READ SECTOR
          RJM    RDS
          PJN    CNR1        IF NO MASS STORAGE ERROR
          LPN    77          CHECK NOT READY STATUS
          LMN    NRDE
          ZJN    CNRX        IF NOT READY
          LCN    1           SET READ ERROR
          UJN    CNRX        RETURN
 CSP      SPACE  4,10
**        CSP - CLEAR SUSPEND STATUS.
*
*         ENTRY  (MS) = MST ADDRESS/10B.
*                (SC) = SUSPEND COUNT.
*
*         USES   SC, T5, CM - CM+7.
*
*         MACROS CMSTF, MONITOR.
 
 
 CSP      SUBR               ENTRY/EXIT
          LDM    SCFA
          LPN    77
          ZJN    CSP1        IF EQUIPMENT NOT ASSIGNED
          SOM    SCFA        CLEAR ASSIGNMENT FLAG
          LDD    CP          GET EJT ORDINAL
          ADK    TERW
          CRD    CM+3
          LDD    EQ
          LMC    4000        INDICATE EJT ORDINAL PASSED
          STD    CM+1
          MONITOR  DEQM
 CSP1     LDD    SC
          ZJN    CSPX        IF EQUIPMENTS NOT SUSPENDED
          LDD    EQ          SET DEVICE STATE = ON
          STD    T5
          STD    CM+1
          LDN    **
 CSPA     EQU    *-1
          ZJN    CSP2        IF DEVICE STATE UNCHANGED
          LDK    ONES
          STD    CM+2
          MONITOR  SEQM
          SOD    SC          UPDATE SUSPEND COUNT
 CSP2     CMSTF  LFPR        FORCE UPDATE OF LOCAL MST TO ECS
          UJP    CSPX        RETURN
 C3D      SPACE  4,10
**        C3D - CONVERT THREE DIGITS OF DECIMAL DISPLAY CODE.
*
*         ENTRY  (A) = NUMBER TO CONVERT.
*
*         EXIT   (A) = THREE DISPLAY CODE DIGITS.
*                (A) = 999 IN DISPLAY CODE IF .GT. THREE DIGITS.
*
*         USES   CM - CM+4.
 
 
 C3D3     LDC    3R999
 
 C3D      SUBR               ENTRY/EXIT
          STD    CM+3
          ADC    -999D
          PJN    C3D3        IF .GE. 999
          LDN    2           PRESET DIVISION
          STD    CM+4
          LDN    0
          STD    CM
          STD    CM+1
          STD    CM+2
 C3D1     LDD    CM+3
          SBM    C3DA,CM+4
          MJN    C3D2        IF NEXT DECIMAL PLACE
          STD    CM+3
          AOM    CM,CM+4
          UJN    C3D1        CONTINUE DIVISION
 
 C3D2     SOD    CM+4
          PJN    C3D1        IF NOT COMPLETE
          LDD    CM+2        ASSEMBLE DIGITS
          SHN    6
          ADD    CM+1
          SHN    6
          ADD    CM
          ADC    3R000
          UJN    C3DX        RETURN
 
 C3DA     CON    1,10D,100D  DIVISION TABLE
 DOS      SPACE  4,20
**        DOS - DELAY APPROXIMATELY ONE SECOND.
*
*         THE PURPOSE OF THIS ROUTINE IS TO AVOID CHECKING THE DEVICE
*         TOO OFTEN.  THE TIME INTERVAL IS NOT REALLY IMPORTANT.
*
*         USES   T1, T2.
*
*         MACROS DELAY, PAUSE.
 
 
 DOS      SUBR               ENTRY/EXIT
          LDN    40D         SET DELAY INCREMENT PARAMETERS
          STD    T2
 DOS1     LDC    100D
          STD    T1
 DOS2     DELAY
          PAUSE  NE
          SOD    T1
          NJN    DOS2        IF NOT END OF INNER INCREMENT
          SOD    T2
          NJN    DOS1        IF NOT END OF DELAY
          UJN    DOSX        RETURN
 GCI      SPACE  4,10
**        GCI - GET CHANNEL CONTROLWARE TABLE INDEX.
*
*         ENTRY  (A) = CHANNEL(S).
*
*         EXIT   (A) = 0, IF FULL-TRACK CONTROLLER CHANNEL.
*                    .NE. 0, OTHERWISE.
*                (T2) = CHANNEL BEING PROCESSED.
*
*         USES   T0, T1, T2, CM - CM+4.
 
 
 GCI      SUBR               ENTRY/EXIT
          LPN    37          SAVE CHANNEL NUMBER
          STD    T1
          STD    T2
          LCN    0
          STD    T0
 GCI1     AOD    T0          INCREMENT CM WORD OFFSET
          LCN    5           DIVIDE BY 5
          RAD    T1
          PJN    GCI1        IF INCORRECT CM WORD OFFSET
          LDC    **          FWA OF CHANNEL CONTROLWARE TABLE
 GCIA     EQU    *-2
          ADD    T0          ADD CORRECT CM WORD OFFSET
          CRD    CM
          LDM    CM+5,T1
          LPN    77
          LMN    /DSL/FTCW
          ZJN    GCIX        IF FULL TRACK CONTROLWARE CHANNEL
          LMN    /DSL/FMCW&/DSL/FTCW
          UJN    GCIX        RETURN
 KMS      SPACE  4,10
**        KMS - SEND MESSAGE TO K-DISPLAY.
*
*         ENTRY  (A) = MESSAGE ADDRESS.
*
*         USES   T1 - T2.
*
*         MACROS DELAY, PAUSE.
 
 
 KMS      SUBR               ENTRY/EXIT
          STD    T1
          LDN    0
          STD    T2
 KMS1     LDI    T1          MOVE MESSAGE TO BUFFER
          ZJN    KMS2        IF END OF MESSAGE
          STM    KMSA,T2
          AOD    T1
          AOD    T2
          LMN    60D/2
          NJN    KMS1        IF NOT END OF LINE
 KMS2     LDC    2R          BLANK FILL MESSAGE
          STM    KMSA,T2
          AOD    T2
          SBN    60D/2
          MJN    KMS2        IF NOT END OF LINE
          LDN    6
          STD    T1
          LDD    IR+3        WRITE MESSAGE TO K-DISPLAY
          SCN    77
          SHN    6
          ADD    IR+2
          ADD    RA
          SHN    6
          CWM    KMSA,T1
 KMS3     DELAY              PAUSE FOR MESSAGE TO BE SEEN
          PAUSE  NE
          SOD    T2
          PJN    KMS3        IF MORE DELAY
          LJM    KMSX        RETURN
 
 KMSA     BSS    60D/2+1
 LDB      SPACE  4,10
**        LDB - LOAD CALL BLOCK BUFFER ADDRESS.
*
*         EXIT   (A) = ABSOLUTE ADDRESS OF CALL BLOCK.
 
 
 LDB      SUBR               ENTRY/EXIT
          LDD    IR+3        GET CALL BLOCK ADDRESS FROM *IR*
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          UJN    LDBX        RETURN
 PSA      SPACE  4,10
**        PSA - PROCESS SERVO ADJUSTMENT.
*
*         ENTRY  (T5) = 0.
*                (T6) = LABEL TRACK.
*                (T7) = CURRENT SECTOR.
*
*         EXIT   (A) .NE. 0 IF *ABORT*.
*
*         USES   CN - CN+1, T6 - T7.
*
*         CALLS  C3D, SPU, WFC.
*
*         MACROS COMMAND, EXECUTE, MESG, SETMS.
 
 
 PSA9     LDN    0           RETURN STATUS
 
 PSA      SUBR               ENTRY/EXIT
          SETMS  STATUS
          LDD    CM+3
          LPC    3777
          LMC    2RDM
          ZJN    PSA1        IF 885
          LMN    2RDQ&2RDM
          NJN    PSA9        IF NOT 885
 PSA1     LDD    T7          SAVE LOGICAL SECTOR NUMBER
          STD    CN
          LDD    RM          SET UNIT IN MESSAGES
          RJM    SPU
          STM    PSAB+24
          STM    PSAC+3
          STM    PSAD+3
 PSA2     MESG   PSAD        * UNIT XX SERVO TIMING IN PROGRESS.*
          LDN    0           SET *0SI* FUNCTION
          STM    OVLA
          EXECUTE  0SI,OVLA+1
          STM    PSAA        SET PROCESSOR ADDRESS
          LDN    0           SET TRACK TO ZERO
          STD    T6
          LDD    CN          RESTORE SECTOR NUMBER
          STD    T7
          RJM    *           PERFORM SERVO CHECK
 PSAA     EQU    *-1
          MJN    PSA4        IF SERVO CHECK UNSUCCESSFUL
          STD    CN+1        SAVE TIME
          NJN    PSA3        IF NOT OUT OF RANGE
          LDC    999D        SET OUT OF RANGE
 PSA3     RJM    C3D         CONVERT THREE DIGITS TO DECIMAL DISPLAY
          STM    PSAC+14
          SHN    -14
          LMC    2L
          STM    PSAC+13
          LDD    CN+1
          ADC    -325D
          MJN    PSA5        IF OUT OF RANGE
          SBN    346D-325D
          PJN    PSA5        IF OUT OF RANGE
          COMMAND  (ABORT,NEXT,RECHECK)  ENABLE COMMANDS
          UJN    PSA6        SET MESSAGE
 
 PSA4     COMMAND  (ABORT,IGNORE,RECHECK)  ENABLE COMMANDS
          MESG   PSAB        SET ERROR MESSAGE
          UJN    PSA7        WAIT FOR COMMAND
 
 PSA5     COMMAND  (ABORT,IGNORE,RECHECK)  ENABLE COMMANDS
 PSA6     MESG   PSAC        SET TIMING DATA MESSAGE
 PSA7     LDD    LT          RESET TO LABEL TRACK
          STD    T6
          RJM    WFC         WAIT FOR COMMAND
          PJN    PSA8        IF NOT *RECHECK*
          LJM    PSA2        RECHECK SERVO TIMING
 
 PSA8     LJM    PSAX        RETURN WITH STATUS
 
 PSAB     DATA   C* ERROR IN PERFORMING SERVO CHECK ON UNITXX.*
 PSAC     DATA   C* UNIT XX SERVO TIMING= XXX.  ACCEPTABLE RANGE IS 325
,TO 345.*
 PSAD     DATA   C* UNIT XX SERVO TIMING IN PROGRESS.*
 PUE      SPACE  4,10
**        PUE - PROCESS UNIT ERROR.
*
*         ENTRY  (A) = ERROR MESSAGE ADDRESS.
*                (CH) = CHANNEL.
*
*         EXIT   (A) .LT. 0 IF *RECHECK* COMMAND ENTERED.
*                (A) = 0 IF *IGNORE* OR *NEXT* COMMAND ENTERED.
*                (A) .GT. 0 IF *ABORT* COMMAND ENTERED.
*
*         USES   T1.
*
*         CALLS  C2D, SPU, WFC.
*
*         MACROS COMMAND, MESG.
 
 
 PUE      SUBR               ENTRY/EXIT
          STD    T1
          LDD    RM          SET UNIT AND CHANNEL IN MESSAGE
          RJM    SPU
          STM    3,T1
          LDD    CH
          RJM    C2D
          STM    6,T1
          COMMAND  (ABORT,IGNORE,RECHECK)
          LDD    T1
          MESG   *
          RJM    WFC         WAIT FOR COMMAND
          LJM    PUEX        RETURN
 RDE      SPACE  4,20
**        RDE - READ DAT ENTRY FROM EXTENDED MEMORY.
*
*         ENTRY  (MF) = LINK EQUIPMENT.
*                (DI) = DAT INDEX.
*
*         EXIT   (A) .NE. 0 IF *ABORT*.
*                (TDAT) = DAT ENTRY.
*                (BFMS) = DAT TRACK FOR THIS EQUIPMENT.
*
*         USES   T3, CM - CM+4, T5 - T7.
*
*         CALLS  RDS.
*
*         MACROS COMMAND, ENDMS, IFCOM, MESG, SETMS.
 
 
 RDE      SUBR               ENTRY/EXIT
          LDD    MF          SET LINK EQUIPMENT
          STD    T5
          SETMS  IO,(NR,DF)
 
*         SET POINTERS TO READ DAT.
 
          LDD    CM+4        GET DAT POINTER
          SHN    3
          ADN    ALGL
          CRD    CM
          LDD    CM+4        SET DAT TRACK
          STD    T6
          LDD    DI          SET DAT SECTOR
          SHN    21-4
          STD    T7
          SHN    -14         SET DAT SECTOR INDEX
          STD    T3
          SHN    2           SET INDEX * 5
          RAD    T3
 
*         READ DAT.
 
          LDC    BFMS        READ SECTOR
          RJM    RDS
          PJN    RDE2        IF NO ERROR
          MESG   RDEA        ERROR ON LINK DEVICE
          COMMAND  (ABORT,IGNORE)  SET LEGAL COMMANDS
 RDE1     IFCOM  IGNORE,RDE2 IF *IGNORE*
          IFCOM  ABORT,RDEX  IF *ABORT*
          UJN    RDE1        RECHECK COMMAND ENTRY
 
 RDE2     LDN    0           INITIALIZE BUFFER INDEX
          STD    CM
 RDE3     LDM    BFMS+2,T3
          STM    TDAT,CM
          AOD    T3          ADVANCE POINTERS
          AOD    CM
          LMN    5*2
          NJN    RDE3        IF TWO WORDS NOT MOVED
          LDM    TDAT+4      SET DAT TRACK FOR THIS EQUIPMENT
          STD    T6
          LDN    0
          STD    T7
          LDC    BFMS        READ DAT TRACK
          RJM    RDS
          PJN    RDE5        IF NO ERROR
          MESG   RDEA        ERROR ON LINK DEVICE
          COMMAND  (ABORT,IGNORE)  SET LEGAL COMMANDS
 RDE4     IFCOM  IGNORE,RDE5  IF *IGNORE*
          IFCOM  ABORT,RDEX  IF *ABORT*
          UJN    RDE4        RECHECK COMMAND ENTRY
 
 RDE5     ENDMS
          LJM    RDEX        RETURN
 
 RDEA     DATA   C*ERROR ON LINK DEVICE.*
 RRD      SPACE  4,10
**        RRD - RESET *RD* DEVICE FIELDS.
*
*         ENTRY  (RM) = MST ADDRESS/10B OF *RD* DEVICE.
*                (EQ) = ORIGINAL EST ORDINAL.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  SCH.
*
*         MACROS MONITOR.
 
 
 RRD      SUBR               ENTRY/EXIT
          LDM    SCFB
          ZJN    RRDX        IF *RD* DOES NOT NEED TO BE RESET
 
*         RESET EST/MST FIELDS.
 
          LDN    ZERL        CLEAR CHANNELS
          CRD    CM
          LDD    RM          CLEAR MST WORDS
          SHN    3
          ADN    MDGL
          CWD    CM
          ADN    DILL-MDGL
          CWD    CM
          ADN    DDLL-DILL
          CWD    CM
          LDN    ZERL        CLEAR CHANNELS
          CRD    CN
          LDN    0
          RJM    SCH
          LDC    2RRD        RESET *RD* EQUIPMENT TYPE
          STD    CM+3
          LDN    SMNS        SET MNEMONIC
          STD    CM+2
          MONITOR  SEQM
*         LDN    0
          STM    SCFB        CLEAR *RD* ALTERED FLAG
          LJM    RRDX        RETURN
 SCF      SPACE  4,20
**        SCF - SET COMMON *RD* DEVICE FIELDS.
*
*         ENTRY  (CN - CN+4) = EST ENTRY.
*                (BFMS) = MST ENTRY.
*                (EQ) = ORIGINAL EST ORDINAL.
*
*         EXIT   (A) .NE. 0 IF AN ERROR FLAG IS SET IN THE CPA.
*                (T5) = 0.
*                (T6) = LABEL TRACK.
*                (T7) = 0.
*                (LU) = 0.
*
*         USES   T5, T7 - CM+3.
*
*         CALLS  SCH.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 SCF      SUBR               ENTRY/EXIT
 SCFA     LDN    0
*         LDN    1           (ON SECOND CALL)
          NJP    SCF2        IF DEVICE ALREADY ASSIGNED
          LDD    CP
          ADK    TERW
          CRD    T7
          LDD    EQ          SET ORIGINAL EST ORDINAL
          STD    T5
 SCF1     DELAY
          PAUSE
          LDD    CM+1
          NJN    SCFX        IF ERROR FLAG IS SET
          LDD    T5          SET EST ORDINAL
          LMC    4000
          STD    CM+1
          LDK    RVES
          STD    CM+2
          LDD    T7          SPECIFY EJT ORDINAL
          STD    CM+3
          MONITOR  REQM
          LDD    CM+1
          ZJN    SCF1        IF EQUIPMENT NOT ASSIGNED
          AOM    SCFA        INDICATE ASSIGNED EQUIPMENT
 SCF2     LDN    0           CLEAR DEVICE ACTIVITY/SET STATE = ON
          STM    BFMS+DALL*5
          STM    BFMS+DALL*5+1
          LDD    RM          SET PARAMETERS IN *RD* DEVICE
          SHN    3
          ADN    MDGL
          CWM    BFMS+MDGL*5,ON
          ADN    DILL-MDGL-1
          CWM    BFMS+DILL*5,ON
          ADN    DDLL-DILL-1
          CWM    BFMS+DDLL*5,ON
          LDN    0           SET CHANNELS
          RJM    SCH
          LDN    0
          STD    CM+1
          LDD    CN+3        SET EQUIPMENT TYPE IN EQUIPMENT 0
          STD    CM+3
          LDN    SMNS        SET MNEMONIC
          STD    CM+2
          MONITOR  SEQM
          SFA    EST,EQ
          ADN    EQAE
          CRD    CM
          LDD    CM+2        SET INSTRUCTION PLUG FOR DRIVER
          STM    SCFC+4
          LDN    1
          STD    CM+1
          LDD    MA
          CWM    SCFC,ON
          LDN    0           SET ADDRESS FOR *RD* DEVICE
          SFA    EST
          STD    CM+4
          SHN    -14
          STD    CM+3
          MONITOR  UTEM
*         LDN    0           PRESET VALIDATION LOOP
          STD    LU
          STD    T5
          STD    T7
          LDD    LT
          STD    T6
          AOM    SCFB        FLAG *RD* ALTERED
          SETMS  IO,(AD,DF,NR)
          LDM    MSD         CHECK STATUS
          LPC    100
          LJM    SCFX        RETURN
 
 SCFB     CON    0           *RD* DEVICE ALTERED FLAG
 SCFC     VFD    6/EQAE,6/12D,6/24D,42/0
 SCH      SPACE  4,10
**        SCH - SET CHANNEL(S) IN EST.
*
*         ENTRY  (A) = EQUIPMENT.
*                (CN+1 - CN+2) = CHANNEL(S).
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 SCH      SUBR               ENTRY/EXIT
          STD    CM+1        ENTER CALL PARAMETERS
          LDD    CN+1
          STD    CM+2
          LDD    CN+2
          STD    CM+4
          LDN    SCHS        SET CHANNEL(S) IN EST
          STD    CM+3
          MONITOR  SCSM      SET CHANNELS
          UJN    SCHX        RETURN
 SDI      SPACE  4,10
**        SDI - SET *DATI* INTERLOCK.
*
*         ENTRY  (MF) = MMF LINK DEVICE.
*
*         EXIT   (A) .NE. 0 IF ABORT COMMAND ENTERED.
*
*         USES   CN - CN+4.
*
*         CALLS  IFR.
*
*         MACROS COMMAND, IFCOM.
 
 
 SDI2     COMMAND            RESET LEGAL COMMANDS
          LDC    4000        SET DAT INTERLOCK INDICATION
          STD    CN+2
          LDC    MMFL        WRITE INTERLOCK INDICATOR
          CWD    CN
 SDI3     LDN    0           RETURN STATUS
 
 SDI      SUBR               ENTRY/EXIT
          LDD    MF
          ZJN    SDIX        IF NOT MULTI-MAINFRAME
          LDC    MMFL        CHECK *DATI* INTERLOCK HELD
          CRD    CN
          LDD    CN+2
          NJN    SDI3        IF INTERLOCK PREVIOUSLY SET
          COMMAND  ABORT     ENABLE *ABORT* COMMAND
 
 SDI1     LDN    DATI        ATTEMPT TO SET INTERLOCK
          RJM    IFR
          LDD    CM+1
          ZJN    SDI2        IF INTERLOCK SET
          IFCOM  ABORT,SDIX  IF ABORT COMMAND ENTERED
          UJN    SDI1        RECHECK INTERLOCK
 SDU      SPACE  4,10
**        SDU - SPIN DOWN UNITS.
*
*         THIS ROUTINE MONITORS THE SPINNING DOWN OF UNITS TO BE
*         RECONFIGURED OR RECABLED.
*
*         ENTRY  (RU) = UNITS TO BE RECONFIGURED OR RECABLED.
*
*         EXIT   (A) .NE. 0 IF *ABORT* ENTERED OR A CONTROL POINT
*                           ERROR FLAG IS SET.
*
*         USES   LU, T7, CN - CN+4.
*
*         CALLS  CNR, DOS, SCF, SPU.
*
*         MACROS COMMAND, IFCOM, MESG, SFA.
 
 
 SDU4     LDN    0
 
 SDU      SUBR               ENTRY/EXIT
          LDN    MSTL        SET *RD* DEVICE
          STD    T7
          SFA    EST,EQ      SET OLD DEVICE PARAMETERS
          ADK    EQDE
          CRD    CN
          LDD    MS
          SHN    3
          CRM    BFMS,T7
          RJM    SCF         SET COMMON *RD* DEVICE FIELDS
          NJN    SDUX        IF ERROR FLAG SET
          UJN    SDU2        ENTER LOOP
 
*         FIND UNITS TO PROCESS AND WAIT FOR *NOT READY*.
 
 SDU1     COMMAND            CLEAR COMMAND LIST
          AOD    LU          ADVANCE UNIT
          LDD    SL
          RAD    T7
          SBM    SLM
          PJN    SDU4        IF NO MORE UNITS
 SDU2     LDD    RU          CHECK IF PROCESSING THIS UNIT
          LMM    TMSK,LU
          SBD    RU
          PJN    SDU1        IF NOT THIS UNIT
          LDD    RM
          RJM    SPU         SET PHYSICAL UNIT NUMBER
          STM    SDUA+10
          MESG   SDUA        * SPIN DOWN UNIT XX.*
 SDU3     RJM    CNR         CHECK NOT READY
          ZJN    SDU1        IF NOT READY
          COMMAND  (ABORT,IGNORE)
          IFCOM  IGNORE,SDU1 IF *IGNORE*
          IFCOM  ABORT,SDUX  IF *ABORT*
          RJM    DOS         DELAY
          UJN    SDU3        RETRY
 
 SDUA     DATA   C* SPIN DOWN UNIT XX.*
 SEQ      SPACE  4,10
**        SEQ - SET EQUIPMENT PARAMETERS.
*
*         EXIT   (DI) = DAT INDEX FOR EQUIPMENT.
*                (EQ) = EST ORDINAL FROM CALL BLOCK.
*                (GL) = DEVICE UNAVAILABLE FLAG.
*                (LT) = LABEL TRACK FOR EQUIPMENT.
*                (MS) = MST ADDRESS FOR EQUIPMENT.
*                (NU) = NUMBER OF UNITS IN EQUIPMENT.
*                (RU) = UNITS FOR RECONFIGURATION OR REPAIR.
*                (SL) = SINGLE UNIT SECTOR LIMIT.
*
*         USES   DI, EQ, GL, LT, MS, NU, RU, SL, CM - CM+4, T5 - T7.
*
*         MACROS LDBUF, MONITOR, SFA.
 
 
 SEQ      SUBR               ENTRY/EXIT
          LDBUF  CUEQ        GET CURRENT EST ORDINAL
          CRD    CM
          ADN    URCD-CUEQ   GET RECONFIGURATION AND REPAIR UNITS
          CRD    CM-1
          ADN    ESTD-URCD   GET EST ENTRY
          CRD    CM-2
          ADN    MSTD-ESTD+ALGL  GET LABEL TRACK
          CRD    CM-3
          LDD    CM+4        SET EST ORDINAL
          STD    EQ
          LDD    CM-1+4      SET UNITS
          STD    RU
          LDD    CM-2+4      SET MST ADDRESS
          STD    MS
          LDD    CM-3+1      SET LABEL TRACK
          STD    LT
          LDBUF  MSTD+MDGL   READ DAT INDEX
          CRD    CM-2
          ADN    DDLL-MDGL   READ NUMBER OF UNITS
          CRD    CM
          LDD    CM-2        SET DAT INDEX
          LPC    377
          STD    DI
          LDD    CM-2+1      SET SINGLE UNIT SECTOR LIMIT
          LPC    3777
          STD    SL
          LDD    CM          SET NUMBER OF UNITS
          LPN    7
          ADN    1
          STD    NU
          LDD    CM
          SHN    21-12
          PJN    SEQ1        IF NOT NULL EQUIPMENT
          SOD    NU
 SEQ1     SFA    EST,EQ      SET DEVICE UNAVAILABLE FLAG
          ADK    EQDE
          CRD    CM
          LDD    CM
          LPC    100
          STD    GL
 SEQ2     LJM    SEQX        RETURN
 SLC      SPACE  4,10
**        SLC - SET LEGAL COMMAND.
*
*         ENTRY  (A) = BIT MASK OF LEGAL COMMANDS.
*
*         MACROS LDBUF.
 
 
 SLC1     LDN    ZERL        CLEAR LEGAL COMMANDS
          CRM    SLCA,ON
          LDBUF  TCOM        CLEAR COMMANDS ENTERED
          CWM    SLCA,ON
          SBN    1+TCOM-TPAR
          CWM    SLCA,ON
 
 SLC      SUBR               ENTRY/EXIT
          ZJN    SLC1        IF CLEARING COMMANDS
          STM    SLCA+4      CLEAR LEGAL COMMANDS
          SHN    -14
          STM    SLCA+3
          LDBUF  TPAR        SET LEGAL COMMANDS
          CWM    SLCA,ON
          UJN    SLCX        RETURN
 
 SLCA     BSSZ   5           LEGAL COMMANDS
 SNC      SPACE  4,10
**        SNC - SET CHANNEL SPECIFIED BY *NC*.
*
*         ENTRY  (NC) = CHANNEL FLAG, 0 = FIRST CHANNEL.
*
*         EXIT   (A) = 0 IF CHANNEL SET IN *RD* DEVICE.
*                (A) .NE. 0 IF CHANNEL DOWN OR NOT PRESENT.
*
*         USES   CH, CM - CM+4, CN - CN+4.
*
*         CALLS  SCH.
*
*         MACROS LDBUF.
 
 
 SNC2     LDN    1           SET CHANNEL NOT PRESENT
 
 SNC      SUBR               ENTRY/EXIT
          LDD    NC
          ZJN    SNC1        IF FIRST CHANNEL
          LDD    CN+2
          ZJN    SNC2        IF NO SECOND CHANNEL
          STD    CN+1
          LDN    0
 SNC1     STD    CN+2
          LPN    77
          STD    CH
          SHN    21-12
          MJN    SNCX        IF DOWN CHANNEL
          LDN    0
          RJM    SCH         SET CHANNEL IN EST
          LDBUF  ESTD        RESTORE EST
          CRD    CN
          LDN    0
          UJN    SNCX        RETURN
 SPU      SPACE  4,10
**        SPU - SET PHYSICAL UNIT.
*
*         ENTRY  (LU) = LOGICAL UNIT NUMBER.
*                (A) = MST ADDRESS CONTAINING UNIT.
*
*         EXIT   (PU) = UNIT NUMBER.
*                (A) = DISPLAY CODE UNIT NUMBER.
*
*         USES   PU, T0, CM - CM+4.
*
*         CALLS  C2D.
 
 
 SPU      SUBR               ENTRY/EXIT
          SHN    3           READ *DDLL* MST WORD
          ADN    DDLL
          CRD    CM
          LDN    CM*2+11     SET BYTE POINTER = CM+4 - LU/2
          SBD    LU
          SHN    21
          STD    T0
          LMD    T0
          LMI    T0
          MJN    SPU1        IF FIRST UNIT IN BYTE
          SHN    -6
 SPU1     LPN    77
          STD    PU
          RJM    C2D         CONVERT TO DISPLAY CODE
          UJN    SPUX        RETURN
 SSP      SPACE  4,20
**        SSP - SET SUSPEND STATUS ON DEVICE.
*
*         ENTRY  (EQ) = EST ORDINAL.
*                (MS) = MST ADDRESS.
*                (SC) = CURRENT COUNT OF SUSPENDED DEVICES.
*
*         EXIT   (A) .NE. 0 IF A CONTROL POINT ERROR FLAG IS SET.
*                (SC) = UPDATED SUSPEND COUNT.
*
*         USES   CM+1, CM+2, SC, T5.
*
*         CALLS  C2D.
*
*         MACROS CMSTF, MESG, MONITOR.
 
 
 SSP      SUBR               ENTRY/EXIT
 
*         SET DOWN STATUS.
 
          LDD    EQ
          STD    T5
          STD    CM+1
          LDK    DWES
          STD    CM+2
          MONITOR  SEQM
          AOD    SC          UPDATE SUSPEND COUNT
          AOM    CSPA        SET DEVICE STATE CHANGE FLAG
          LDD    EQ          SET EQUIPMENT
          STD    T5
          SHN    -3          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          RJM    C2D
          STM    SSPA+1
          LDD    EQ          CONVERT LOWER DIGIT OF EST ORDINAL
          LPN    7
          SHN    6
          ADC    2R0,
          STM    SSPA+2
          CMSTF  LFPR        FORCE UPDATE OF LOCAL MST TO ECS
          MESG   SSPA
          LDN    0
          LJM    SSPX        RETURN
 
 SSPA     DATA   C*EQXXX, SYSTEM USAGE OF DEVICE SUSPENDED.*
 SUU      SPACE  4,10
**        SUU - SPIN UP UNITS.
*
*         ENTRY  (RU) = UNITS TO BE RECONFIGURED OR RECABLED.
*
*         EXIT   (A) .NE. 0 IF *ABORT* ENTERED OR CP ERROR FLAG IS SET.
*
*         USES   LU, T7, CN - CN+4.
*
*         CALLS  CNR, DOS, PSA, SCF, SPU.
*
*         MACROS COMMAND, IFCOM, LDBUF, MESG.
 
 
 SUU      SUBR               ENTRY/EXIT
          LDN    MSTL        SET *RD* DEVICE
          STD    T7
          LDBUF  ESTD        SET NEW DEVICE PARAMETERS
          CRD    CN
          ADN    MSTD-ESTD
          CRM    BFMS,T7
          RJM    SCF         SET COMMON *RD* DEVICE FIELDS
          NJN    SUUX        IF CONTROL POINT ERROR FLAG SET
 
 
          UJN    SUU2        ENTER LOOP
 
 SUU1     COMMAND            CLEAR COMMAND LIST
          AOD    LU          ADVANCE UNIT
          LDD    SL
          RAD    T7
          SBM    SLM
          ZJN    SUUX        IF END OF UNITS
 SUU2     LDD    RU
          LMM    TMSK,LU
          SBD    RU
          PJN    SUU1        IF NOT CHANGING THIS UNIT
          LDD    MS
          RJM    SPU         GET OLD UNIT NUMBER
          STM    SUUA+12
          LDD    RM
          RJM    SPU         GET NEW UNIT NUMBER
          STM    SUUA+20
          COMMAND  (ABORT,IGNORE)  SET LEGAL COMMANDS
          MESG   SUUA        *MOVE PACK FROM UNIT XX TO UNIT YY ...*
 SUU3     RJM    CNR         CHECK IF UNIT READY
          NJN    SUU4        IF READY CHECK SERVO TIMING
          RJM    DOS         DELAY
          IFCOM  IGNORE,SUU1 IF IGNORE OF NOT READY
          IFCOM  ABORT,SUUX  IF *ABORT*
          UJN    SUU3        RECHECK UNIT
 
 SUU4     RJM    PSA         PROCESS SERVO ADJUSTMENT
          NJN    SUU5        IF *ABORT*
          LJM    SUU1        PROCESS NEXT UNIT
 
 SUU5     LJM    SUUX        RETURN
 
 SUUA     DATA   C*MOVE PACK FROM UNIT XX  TO UNIT YY AND SPIN UP.*
 ULD      SPACE  4,20
**        ULD - UPDATE LINKED DEVICE MST-S.
*
*         ENTRY  (NU) = NUMBER OF UNITS FOR EQUIPMENT.
*                (MS) = MST ADDRESS/10B OF EQUIPMENT TO RECONFIGURE.
*
*         USES   T7, CM - CM+4, CN - CN+4, T1 - T3.
*
*         MACROS SFA.
 
 
 ULD      SUBR               ENTRY/EXIT
 
*         CHECK IF UNIT IS IN FIRST EQUIPMENT OF LINKED DEVICE.
 
          LDD    MS          GET ORIGINAL NUMBER OF UNITS - 1
          SHN    3
          ADN    DDLL
          CRD    CM
          LDD    CM
          SHN    -3
          LPN    7
          ADN    1
          STD    T1          SAVE POSITION IN UNIT LIST
          SBD    NU
          PJN    ULDX        IF UNITS IN FIRST EQUIPMENT IN CHAIN
 
*         BUILD TABLE OF UNITS IN *TDAT*.
 
          LDN    0           INITIALIZE LOOP
          STD    T2
          LDN    4
          STD    T3
 ULD1     LDM    CM,T3       SET UNITS
          SHN    14
          STM    TDAT+1,T2
          SHN    -14
          STM    TDAT,T2
          LDN    2           ADVANCE TABLE POINTER
          RAD    T2
          SOD    T3
          NJN    ULD1        IF MORE UNITS IN *DDLL*
 
*         GET NEXT EQUIPMENT IN CHAIN.
 
 ULD2     LDD    MS
          SHN    3
          ADN    STLL
          CRD    CN
          LDD    CN+4
          SHN    -3
          SFA    EST
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          STD    T7          SAVE MST ADDRESS
          SHN    3
          ADN    DDLL
          CRD    CM
          LDD    CM
          SHN    21-12
          MJN    ULD2        IF NULL EQUIPMENT
          LDD    CM          SET NUMBER OF UNITS - 1 FOR THIS EQUIPMENT
          SHN    -3
          LPN    7
          STD    T2
 
*         RESET UNIT LIST FROM TABLE OF UNITS.
 
          LDN    CM+4        PRESET LOOP
          STD    T3
 ULD3     LDI    T3          REPLACE LOWER UNIT
          SCN    77
          LMM    TDAT,T1
          STI    T3
          AOD    T1          ADVANCE TABLE POINTER
          SBD    NU
          PJN    ULD4        IF END OF UNITS
          SOD    T2
          MJN    ULD4        IF END OF EQUIPMENT
          LDI    T3          REPLACE UPPER UNIT
          SHN    14
          SCN    77
          LMM    TDAT,T1
          SHN    6
          STI    T3
          SOD    T3
          AOD    T1          ADVANCE TABLE POINTER
          SBD    NU
          PJN    ULD4        IF END OF UNITS
          SOD    T2
          PJN    ULD3        IF MORE UNITS IN THIS EQUIPMENT
 ULD4     LDD    T7          REWRITE UNIT LIST
          SHN    3
          ADN    DDLL
          CWD    CM
          LDD    T1
          SBD    NU
          PJN    ULD5        IF END OF UNITS
          LJM    ULD2        GET NEXT EQUIPMENT IN CHAIN
 
 ULD5     LJM    ULDX        RETURN
 VLB      SPACE  4,20
**        VLB - VERIFY LABEL.
*
*         ENTRY  (T5) = 0, *RD* PSEUDO EQUIPMENT.
*                (T6) = LABEL TRACK.
*                (T7) = LU * SINGLE UNIT SECTOR LIMIT.
*                (LU) = LOGICAL UNIT NUMBER, 0 - 7.
*                (PU) = PHYSICAL UNIT NUMBER, 0 - 77.
*                (CH) = CHANNEL(S) TO CHECK.
*
*         EXIT   (A) .NE. 0 IF ABORT ENTERED.
*
*         USES   CM - CM+4.
*
*         CALLS  PUE, RDS.
*
*         MACROS ENDMS, SETMS.
 
 
 VLB5     LDC    VLBB        * UNIT XX LABEL VERIFY ERROR.*
          RJM    PUE         PROCESS UNIT ERROR
          MJN    VLB1        IF *RECHECK*
*         UJN    VLBX        RETURN *ABORT* OR *IGNORE* STATUS
 
 VLB      SUBR               ENTRY/EXIT
 VLB1     SETMS  IO,(AD,DF,NR)
          LDC    BFMS        READ LABEL SECTOR
          RJM    RDS
          PJN    VLB2        IF NO READ ERROR
          LDC    VLBA        * UNIT XX LABEL READ ERROR.*
          RJM    PUE         PROCESS UNIT ERROR
          MJN    VLB1        IF *RECHECK*
          NJN    VLBX        IF *ABORT*
*         UJN    VLB2        IGNORE READ ERROR
 
 VLB2     ENDMS
 
*         VERIFY CONTROL BYTES, TRACK AND EQUIPMENT TYPE.
 
          LDM    BFMS        CHECK CONTROL BYTES
          LMC    3777
 VLB3     NJN    VLB5        IF NOT PROPER CONTROL BYTE
          LDM    BFMS+1
          LMN    77
          NJN    VLB3        IF NOT PROPER WORD COUNT
          LDM    FTSS
          LMD    LT
          NJN    VLB3        IF NOT PROPER TRACK
          LDD    MS          READ FAMILY AND DEVICE NUMBER
          SHN    3
          ADN    PFGL
          CRD    CM
          LDM    E4SS        CHECK EQUIPMENT TYPE
          LMD    CN+3
          LPC    3777
 VLB4     NJN    VLB3        IF NOT CORRECT EQUIPMENT TYPE
 
*         VERIFY FAMILY, DEVICE NUMBER AND RELATIVE UNIT.
 
          LDD    CM+4        SET RELATIVE UNIT
          SCN    70
          STD    CM+4
          LDD    LU
          SHN    3
          RAD    CM+4
          LDM    N4SS+5*PFGL COMPARE FAMILY AND DEVICE NUMBER
          LMD    CM
          NJN    VLB4        IF NO MATCH
          LDM    N4SS+5*PFGL+1
          LMD    CM+1
          NJN    VLB4        IF NO MATCH
          LDM    N4SS+5*PFGL+2
          LMD    CM+2
          NJN    VLB4        IF NO MATCH
          LDM    N4SS+5*PFGL+3
          LMD    CM+3
          NJN    VLB4        IF NO MATCH
          LDM    N4SS+5*PFGL+4  COMPARE RELATIVE UNIT AND TOTAL UNITS
          LMD    CM+4
          LPN    77
          NJN    VLB4        IF NO MATCH
          LJM    VLBX        RETURN
 
 VLBA     DATA   C* UNIT XX, CHYY LABEL READ ERROR.*
 VLBB     DATA   C* UNIT XX, CHYY LABEL VERIFICATION ERROR.*
 WAM      SPACE  4,10
**        WAM - WAIT FOR ALL MACHINES TO SYNCHRONIZE PROCESSING.
*
*         ENTRY  (A) = CONDITIONAL JUMP INSTRUCTION FOR *WAMB*.
*                (MF) = MULTI-MAINFRAME FLAG.
*                (MM) = MACHINE MASK OF THIS MACHINE.
*
*         EXIT   (A) .NE. 0 IF COMMAND ABORTED.
*
*         USES   CN - CN+2.
*
*         CALLS  RDE.
*
*         MACROS COMMAND, IFCOM, MESG, SFA.
 
 
 WAM5     COMMAND            CLEAR COMMAND LIST
          LDN    1           RETURN ABORT STATUS
 
 WAM      SUBR               ENTRY/EXIT
          STM    WAMB        CHANGE CONDITIONAL JUMP INSTRUCTION
          ERRNG  37+WAMB-WAM4  IF OUT OF RANGE
          LDD    MF
          ZJN    WAMX        IF NOT MULTI-MAINFRAME
          SFA    EST,EQ      TEST FOR SHARED DEVICE
          ADK    EQDE
          CRD    CM
          LDD    CM
          LPC    1000
          ZJN    WAMX        IF DEVICE NOT SHARED
 
*         CHECK FOR DOWN STATUS SET/CLEAR ON ALL ACTIVE MACHINES
*         SHARING THIS DEVICE.
 
          LDN    1           INITIALIZE MACHINE SEARCH LOOP
          STD    CN          MACHINE INDEX
          STD    CN+1        MACHINE MASK
          LDN    0
          STD    CN+2        MST LOCAL AREA INDEX
 WAM1     RJM    RDE         READ DAT ENTRY
          NJN    WAM5        IF *ABORT*
 WAM2     LDM    TDAT+5+4    CHECK ACCESS BIT
          LMD    CN+1
          SBM    TDAT+5+4
          PJN    WAM3        IF NO ACCESS SET FOR MACHINE
          LDD    MM
          LMD    CN+1
          ZJN    WAM3        IF THIS MACHINE
          LDM    BFMS+2+DALL*5,CN+2
          SHN    0-10
          LMN    3
          NJN    WAM4        IF DEVICE NOT DOWN
*         ZJN    WAM4        IF DEVICE STILL DOWN
 WAMB     EQU    *-1
 WAM3     LDD    CN+1        ADVANCE MACHINE
          RAD    CN+1
          LDN    LLLL*5
          RAD    CN+2
          AOD    CN
          LMN    MXMF+1
          NJN    WAM2        IF NOT END OF MACHINES
          COMMAND            CLEAR LEGAL COMMAND TABLE
          LDN    0
          LJM    WAMX        RETURN
 
 WAM4     COMMAND  (ABORT,IGNORE)  ENABLE COMMAND PROCESSING
          LDM    BFMS+2+STLL*5+2,CN+2  SET MACHINE ID
          STM    WAMA+14
          MESG   WAMA        SET MESSAGE IN K-DISPLAY
          IFCOM  IGNORE,WAM3 IF *IGNORE* COMMAND ENTERED
          IFCOM  ABORT,WAM5  IF *ABORT* COMMAND ENTERED
          LJM    WAM1        RECHECK THIS MACHINE INDEX
 
 WAMA     DATA   C* WAITING FOR MACHINE ID=XX.*
 WFC      SPACE  4,10
**        WFC - WAIT FOR COMMAND TO BE ENTERED.
*
*         EXIT   (A) .LT. 0 IF *RECHECK* COMMAND ENTERED.
*                (A) = 0 IF *IGNORE* OR *NEXT* COMMAND ENTERED.
*                (A) .GT. 0 IF *ABORT* COMMAND ENTERED.
*                COMMAND LIST CLEARED.
*
*         USES   T1.
*
*         MACROS COMMAND, IFCOM.
 
 
 WFC2     COMMAND            CLEAR COMMAND LIST
          SOD    T1          RETURN COMMAND CODE
 
 WFC      SUBR               ENTRY/EXIT
 WFC1     LDN    0           PRESET COMMAND CODE
          STD    T1
          IFCOM  RECHECK,WFC2  IF *RECHECK*
          AOD    T1
          IFCOM  (IGNORE,NEXT),WFC2  IF *IGNORE* OR *NEXT*
          AOD    T1
          IFCOM  ABORT,WFC2  IF *ABORT*
          UJN    WFC1        RECHECK COMMAND ENTRY
          TITLE  COMMON DECKS.
**        COMMON DECKS.
 
 
*CALL     COMPC2D
*CALL     COMPIFR
*CALL     COMPTGB
*CALL     COMPTLB
*CALL     COMPMSV
          SPACE  4
          USE    LITERALS
 TABLES   SPACE  4,10
 TMSK     BSS    0           TABLE OF MASK BITS INDEXED BY ORDINAL
          CON    1
          CON    2
          CON    4
          CON    10
          CON    20
          CON    40
          CON    100
          CON    200
          CON    400
          CON    1000
          CON    2000
          CON    4000
 
 TDAT     EQU    *           TWO CM WORD BUFFER FOR DAT ENTRY
 OVLA     EQU    TDAT+5*2    OVERLAY AREA
 L.1RM    EQU    OVLA+1+ZPXL END OF *1RM* PLUS *0PI*
          ERRPL  L.1RM-BFMS  *OPI* EXTENDS INTO BFMS
 PRS      TITLE  PRESET.
**        PRS - PRESET.
*
*         EXIT   (SC) = 0, SUSPENDED DEVICE COUNT.
*                (EQ) = *RD* EQUIPMENT EST ORDINAL.
*                (RM) = *RD* DEVICE MST ADDRESS.
*                (MF) = MULTI-MAINFRAME LINK DEVICE NUMBER.
*                (TUNL) = DDLL MST WORD FOR NEW DEFINITION.
*
*         USES   EQ, MF, MM, RM, SC, CM - CM+4.
*
*         CALLS  DFM.
*
*         MACROS MONITOR, SFA.
 
 
 PRS      SUBR               ENTRY/EXIT
 
*         CHECK STATUS WORD ADDRESS.
 
          LDD    IR+3        CHECK ADDRESS
          LPN    77
          SHN    14
          MJN    PRS1        IF OUT OF RANGE
          ADD    IR+4
          ADN    CBMX
          SHN    -6
          SBD    FL
          PJN    PRS1        IF .GT. FL - 1
          LDD    IR+3        SET ADDRESS - 2
          LPN    77
          SHN    14
          ADD    IR+4
          SBN    2
          PJN    PRS2        IF .GT. RA + 1
 PRS1     LDC    =C* 1RM INCORRECT REQUEST.*
          LJM    PRS3        ISSUE ERROR MESSAGE AND ABORT
 
*         CHECK FOR LEGAL ACCESS.
 
 PRS2     LDD    CP          GET QUEUE PRIORITY
          ADN    JCIW
          CRD    CM
          LDC    MSSI
          LMD    CM+2
          ZJN    PRS4        IF LEGAL ACCESS
          LDC    =C* 1RM USER ACCESS NOT VALID.*
 PRS3     RJM    DFM         ISSUE MESSAGE
          MONITOR  ABTM
          LJM    PPR         EXIT
 
*         GET MASS STORAGE EQUIPMENT EST POINTERS.
*         SET MULTI-MAINFRAME STATUS.
 
 PRS4     LDC    MMFL        GET EST ORDINAL OF LINK DEVICE
          CRD    CM
          LDD    CM+1        SET MMF STATUS
          LPC    777
          STD    MF
          LDD    CM+3        SET MACHINE MASK
          STD    MM
          LDN    RDEQ        READ *RD* EST ENTRY
          STD    EQ
          SFA    EST
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          STD    RM
          LDN    0           CLEAR SUSPENDED DEVICE COUNT
          STD    SC
          LDK    CHTP        READ FWA OF CHANNEL TABLES
          CRD    CM
          LDD    CM+2        PRESET FWA OF CONTROLWARE TABLE
          SHN    14
          LMD    CM+3
          ADN    CTALL*2
          STM    GCIA+1
          SHN    -14
          RAM    GCIA
          LJM    PRSX        RETURN
          SPACE  4
          END