Retro1.org codex

          IDENT  0ST,TSCX
          PERIPH J
          BASE   MIXED
          SST
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
*COMMENT  0ST - TERMINATE SCP CONNECTIONS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  0ST - TERMINATE SCP CONNECTIONS.
          SPACE  4,10
***       0ST - TERMINATE SCP CONNECTIONS.
*
*         A. J. KOMOR.       76/03/01.
*         J. L. LARSON.      81/09/11.
*         G. S. YODER.       91/06/25.
          SPACE  4,10
***              *0ST* IS A LOCATION FREE ROUTINE TO BE USED TO
*         TERMINATE CONNECTIONS BETWEEN SYSTEM CONTROL POINTS
*         (SCP-S) AND USER CONTROL POINTS (UCP-S).
*
*         *0ST* IS CALLED BY *1MA* TO PROCESS AN SCP *SF.EXIT* RA+1
*         REQUEST WHEN UCP CONNECTIONS ARE OUTSTANDING.
*
*         *0ST* IS CALLED BY *1AJ* TO INFORM SCP-S THAT A CONNECTED
*         UCP IS TERMINATING AND/OR TO DISCONNECT UCP-S CONNECTED
*         TO A TERMINATING SCP.
*
*         *0ST* ENTERS THE PP RECALL STACK FOR THE FOLLOWING
*         CONDITIONS -
*         1.  SCP ABORT INTERLOCK ALREADY SET (ANOTHER SCP IS
*         TERMINATING AT THE SAME TIME AS THIS SCP).
*         2.  TERMINATING UCP HAS OUTSTANDING CONNECTIONS TO SCP-S
*         WHEN JOB ADVANCING FOR OTHER THAN *OVERRIDE* ERROR.
*         THE UCP WILL NOT CONTINUE JOB ADVANCE UNTIL THE SCP-S
*         RESPOND BY CLEARING ALL OUTSTANDING CONNECTIONS.
          SPACE  4,10
***       OPERATOR MESSAGES (TO CONTROL POINT AREA).
*
*         * SCP TERMINATION PROCESSING.* = SCP END/ABORT PROCESSING.
*
*         * UCP TERMINATION PROCESSING.* = USER CP END/ABORT.
          SPACE  4,10
***       CALL.
*
*         ENTRY  (SC) = SCP CONNECTION ACTIVITY FLAGS.
*                       BIT 0 SET IF TERMINATING UCP HAS SCP
*                       CONNECTIONS.
*                       BIT 1 SET IF TERMINATING SCP HAS OUTSTANDING
*                       UCP CONNECTIONS.
*                       BIT 2 SET IF SCP ISSUED *SF.EXIT* RA+1
*                       REQUEST.
*                       BIT 3 SET IF SCP *SSIW* IDENTIFICATION WORD
*                       TO BE CLEARED.
*                (EF) = ERROR FLAG ON TERMINATING SCP/UCP.
*
*         EXIT   TO *PPR* IF ENTERED PP RECALL STACK.
*                (SC) = 0 IF SCP/UCP ABORT/END PROCESSING COMPLETE.
*
*         USES   DIRECT CELLS 0 - 14, 17 - 36, 60 - 64, 67 AND
*                MASS STORAGE SECTOR BUFFER *BFMS*.
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPMAC
 REL$     EQU    1           NO RELOCATION OF SYSTEXT *M* INSTRUCTIONS
*CALL     COMPREL
*CALL     COMSCPS
*CALL     COMSEJT
*CALL     COMSMSP
*CALL     COMSPIM
*CALL     COMSSCP
*CALL     COMSSSD
*CALL     COMSSSE
*CALL     COMSZOL
          SPACE  4,10
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 SI       EQU    17          SCP IDENTIFICATION
 CN       EQU    20 - 24     CM WORD BUFFER
 AB       EQU    25 - 31     CM WORD BUFFER
 FS       EQU    32 - 36     CM WORD BUFFER
 EF       EQU    46          ERROR FLAG
 CW       EQU    60 - 64     CM WORD BUFFER
 SC       EQU    67          SCP/UCP CONNECTION FLAGS
****
          TITLE  MAIN ROUTINES.
 TSC      SPACE  4,20
**        TSC - TERMINATE SCP CONNECTIONS.
*
*         TO PROCESS A TERMINATING UCP, THE WAIT RESPONSE AND LONG
*         TERM CONNECTION INDICATORS IN THE UCP *SSCW* WORD ARE
*         EXAMINED FOR EACH SCP.  IF THE TERMINATING UCP IS CONNECTED
*         TO AN SCP, A MESSAGE IS SENT TO THAT SCP INFORMING IT OF
*         THE UCP END/ABORT.
*         IF AN SCP IS TERMINATING, ALL UCP-S CONNECTED TO THIS SCP
*         WILL HAVE THE *SSET* (SCP ABORTED) ERROR FLAG SET.
*
*         EXIT   TO *ERS* TO ENTER RECALL STACK IF CONNECTIONS
*                REMAINING.
*
*         USES   SC, CM - CM+4.
*
*         CALLS  EUJ, SRS.
 
 
          ORG    5
 TSC      SUBR               ENTRY/EXIT
          LDD    SC
          LPN    10
          ZJN    TSC1        IF NOT ACTIVE SCP
          LDN    ZERL        CLEAR SCP IDENTIFICATION WORD
          CRD    CM
          LDD    RA
          SHN    6
          ADN    SSIW
          CWD    CM
 TSC1     LDD    SC
          LPN    1
          ZJN    TSC2        IF JOB IS NOT UCP WITH CONNECTIONS
          RJM    SRS         SEND UCP TERMINATION TO CONNECTED SCP-S
 TSC2     LDD    SC
          LPN    2
          ZJN    TSC3        IF JOB IS NOT SCP WITH CONNECTIONS
          RJM    EUJ         END UCPS CONNECTED TO THIS SCP
 TSC3     LDD    SC
          LPN    3
          NJN    ERS         IF OUTSTANDING CONNECTIONS REMAINING
          STD    SC          CLEAR SCP/UCP CONNECTION FLAG
          LDD    CP          CLEAR CONSOLE MESSAGE
          ADN    MS2W
          CWD    SC
          UJN    TSCX        RETURN
 ERS      SPACE  4,10
**        ERS - ENTER RECALL STACK.
*
*         EXIT   TO *PPR*.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 ERS      LDD    SC
          LPN    4
          NJN    ERS2        IF *SF.EXIT* PROCESSING
          LDD    EF          RESET ERROR FLAG
          ZJN    ERS1        IF NO ERROR FLAG
          STD    CM+1
          MONITOR  CEFM      RESET ERROR FLAG
*         LDN    0
 ERS1     STD    CM+1        SET *JACM* OPTIONS
          MONITOR  JACM      CLEAR JOB ADVANCE
 ERS2     LDN    ZERL        ENTER DEFAULT TIMED RECALL
          CRD    CM
          LDN    SUTR        SCP/UCP TERMINATION PENDING
          STD    CM
          LDD    MA          ENTER PP CALL INTO RECALL STACK
          CWD    IR
          ADN    1
          CWD    CM          STORE RECALL STACK REASON CODE
          MONITOR  RECM      ENTER RECALL STACK AND DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
          TITLE  SUBROUTINES.
 CCI      SPACE  4,15
**        CCI - CHECK CONNECTION INDICATORS WORD FOR TERMINATING SCP.
*
*         ENTRY  (A) = ADDRESS OF CONNECTION INDICATORS WORD TO CHECK.
*                (SI) = SUBSYSTEM ID OF TERMINATING SCP.
*                (CN+1) = ABORT JOB FLAG.
*
*         EXIT   (A) .NE. 0 IF CONNECTION TO TERMINATING SCP FOUND.
*                (A) = 0 IF CONNECTION TO TERMINATING SCP NOT FOUND.
*                (CN+1) .NE. 0 IF CONNECTION TO TERMINATING SCP FOUND.
*                (T2) = ADDRESS OF CONNECTION INDICATORS BYTE FOR
*                       TERMINATING SCP IF FOUND.
*                CONNECTION INDICATORS BYTE FOR TERMINATING SCP CLEARED
*                  IF FOUND.
*
*         USES   CN+1, T1, T2.
 
 
 CCI2     LDN    0           SET CONNECTION NOT FOUND
 
 CCI      SUBR               ENTRY/EXIT
          STD    T1          SET END OF SEARCH
          ADN    4+1
          STD    T2          SET FIRST BYTE TO CHECK + 1
 CCI1     SOD    T2
          SBD    T1
          MJN    CCI2        IF NO MORE CONNECTIONS TO CHECK
          LDI    T2
          SHN    -6
          ADC    LSSI
          LMD    SI
          NJN    CCI1        IF NO CONNECTION TO TERMINATING SCP
          STI    T2          CLEAR CONNECTION INDICATORS
          AOD    CN+1        SET ABORT JOB FLAG
          UJN    CCIX        RETURN
 CCJ      SPACE  4,15
**        CCJ - CHECK CONTROL POINT JOB SCP CONNECTIONS.
*
*         ENTRY  (CN+4) = EJT ORDINAL.
*                (CN+1) = ABORT JOB FLAG = 0.
*                (FS - FS+4) = EJT ENTRY *SCHE* WORD.
*
*         EXIT   (CN+1) .NE. 0 IF JOB SHOULD BE ABORTED.
*                CONNECTION INDICATORS FOR TERMINATING SCP CLEARED IF
*                  FOUND.
*
*         USES   CN, T5, T6, CM - CM+4, CW - CW+4.
*
*         CALLS  CCI, CRF, NUS.
*
*         MACROS MONITOR.
 
 
 CCJ      SUBR               ENTRY/EXIT
 
*         CHECK FOR ACTIVE CONNECTION TO TERMINATING SCP.
 
          LDD    FS+3        SET UCP CP ADDRESS
          LPN    37
          SHN    7
          STD    CN          SAVE UCP CP ADDRESS
          ADK    JCIW        GET SUBSYSTEM ID
          CRD    CM
          ADK    SSCW-JCIW
          CRD    CW          GET SCP CONNECTIONS
          LDN    CW          SET CONNECTIONS WORD ADDRESS
          RJM    CCI         CHECK CONNECTION INDICATORS
          ZJP    CCJ2        IF NO CONNECTION TO TERMINATING SCP
          LDN    12D         SET FIELD SIZE IN *UTEM* REQUEST
          STD    CW
          LDN    CW+4        SET FIELD POSITION IN *UTEM* REQUEST
          SBD    T2
          SHN    2+6
          STD    CW+1
          SHN    1
          RAD    CW+1
          LDN    0
          STD    CW+2
          STD    CW+3
          STD    CW+4
          LDD    CM+2
          ADC    -LSSI
          MJN    CCJ1        IF UCP IS NOT A SUBSYSTEM
          RJM    NUS         NOTIFY UCP SUBSYSTEM (MAY RECALL *0ST*)
 CCJ1     LDD    MA          SET *UTEM* REQUEST
          CWD    CW
          LDN    1           SET REQUEST COUNT
          STD    CM+1
          LDN    0
          STD    CM+3
          LDD    CN          SET *SSCW* ADDRESS
          ADK    SSCW
          STD    CM+4
          MONITOR  UTEM      CLEAR CONNECTION INDICATORS BYTE
 
*         CHECK DM* FILE FOR CONNECTION TO TERMINATING SCP.
 
 CCJ2     LDD    CN
          ADK    RFCW
          CRD    CM
          LDD    CM
          ZJN    CCJ3        IF NO DM* FILE PRESENT
          STD    T5          SET DM* FILE EST ORDINAL
          LDD    CM+1        SET DM* FILE FIRST TRACK
          STD    T6
          LDN    1           INDICATE DM* FILE
          RJM    CRF         CHECK ROLLOUT FILE
 CCJ3     LJM    CCJX        RETURN
 CIN      SPACE  4,15
**        CIN - CLEAR EJT INTERLOCK.
*
*         ENTRY  (CN+4) = UCP EJT ORDINAL.
*
*         EXIT   EJT INTERLOCK CLEARED.
*
*         USES   T1.
*
*         CALLS  SFI.
*
*         MACROS SFA.
 
 
 CIN      SUBR               ENTRY/EXIT
          LDN    CEIN        SET CLEAR EJT INTERLOCK OPTION
          STD    T1
          SFA    EJT,CN+4    SET EJT ENTRY ADDRESS
          RJM    SFI         CLEAR EJT INTERLOCK.
          UJN    CINX        RETURN
 CRF      SPACE  4,15
**        CRF - CHECK ROLLOUT FILE SCP CONNECTIONS.
*
*         ENTRY  (A) = 0 IF PROCESSING JOB ROLLOUT FILE.
*                (A) .NE. 0 IF PROCESSING DM* FILE.
*
*         EXIT   (A) = 0 IF VALID ROLLOUT FILE SYSTEM SECTOR READ.
*                (A) .NE. 0 IF ERROR ON SYSTEM SECTOR READ OR IF NOT
*                    VALID ROLLOUT FILE SYSTEM SECTOR.
*
*         USES   CW, T7.
*
*         CALLS  CCI, RSS, WDS.
*
*         MACROS ENDMS, SETMS.
 
 
*         EXIT WITH ERROR STATUS.
 
 CRF5     ENDMS
          LDN    1           SET ERROR STATUS
 
 CRF      SUBR               ENTRY/EXIT
          STD    CW          SAVE DM* FILE FLAG
          SETMS  IO,(NS,RW)
          LDN    0           SET NO FILE NAME VERIFY
          RJM    RSS         READ ROLLOUT FILE SYSTEM SECTOR
          NJN    CRFX        IF ERROR IN SYSTEM SECTOR
          STD    T7          SET SYSTEM SECTOR FOR WRITE
          LDM.   FNSS+4
          SHN    -6
          LMN    ROFT
          NJN    CRF5        IF NOT ROLLOUT FILE TYPE
          LDM.   FASS
          ZJN    CRF1        IF JOB ROLLOUT FILE
          LDD    CW
          NJN    CRF2        IF PROCESSING DM* FILE
          UJN    CRF5        PROCESS ROLLOUT FILE ERROR
 
 CRF1     LDD    CW
          NJN    CRF5        IF PROCESSING DM* FILE
 CRF2     LDC    COSS        SET CONNECTION INDICATORS ADDRESS
          RJM    CCI         CHECK CONNECTION INDICATORS
          ZJN    CRF3        IF NO CONNECTION FOUND
          LDC    BFMS
          RJM    WDS         WRITE UPDATED CONNECTION INDICATORS
          MJN    CRF4        IF WRITE ERROR
 CRF3     ENDMS
*         LDN    0           SET NO ERROR
 CRF4     LJM    CRFX        RETURN
 CRJ      SPACE  4,15
**        CRJ - CHECK ROLLED OUT JOB SCP CONNECTIONS.
*
*         ENTRY  (CN+4) = EJT ORDINAL.
*                (CN+1) = ABORT JOB FLAG = 0.
*                (FS - FS+4) = EJT ENTRY *SCHE* WORD.
*
*         EXIT   (CN+1) .NE. 0 IF JOB SHOULD BE ABORTED.
*                CONNECTION INDICATORS FOR TERMINATING SCP CLEARED IF
*                  FOUND.
*
*         USES   T5, T6.
*
*         CALLS  CRF.
 
 
 CRJ      SUBR               ENTRY/EXIT
          LDD    FS          SET ROLLOUT FILE EST ORDINAL
          STD    T5
          LDD    FS+1        SET ROLLOUT FILE FIRST TRACK
          STD    T6
          LDN    0           INDICATE JOB ROLLOUT FILE
          RJM    CRF         CHECK ROLLOUT FILE
          NJN    CRJX        IF ERROR IN ROLLOUT FILE
          LDM.   DFSS
          ZJN    CRJX        IF NO DM* FILE
          STD    T5          SET DM* FILE EST ORDINAL
          LDM.   DFSS+1      SET DM* FILE FIRST TRACK
          STD    T6
*         LDD    T6          INDICATE DM* FILE
          RJM    CRF         CHECK ROLLOUT FILE
          UJN    CRJX        RETURN
 DLY      SPACE  4,10
**        DLY - DELAY.
*
*         EXIT   (A) = 0 IF OPERATOR INTERVENTION.
*
*         USES   T0.
*
*         MACROS DELAY, PAUSE.
 
 
 DLY      SUBR               ENTRY/EXIT
          LDD    HN          DELAY 128 * 64 MICRO SECONDS
          STD    T0
 DLY1     SOD    T0
          MJN    DLYX        IF DELAY COMPLETE
          PAUSE
          DELAY
          LDD    CM+1        CHECK FOR OPERATOR OVERRIDE
          LMN    ORET
          NJN    DLY1        IF NOT OPERATOR INTERVENTION
          UJN    DLYX        RETURN
 EUJ      SPACE  4,15
**        EUJ - END ALL USER JOBS CONNECTED TO A TERMINATING SCP.
*
*         EXIT   ERROR FLAG *SSET* SET ON ALL CONNECTED UCPS.
*                CONNECTIONS TO TERMINATING SCP CLEARED FOR ALL
*                  CONNECTED UCPS.
*                TO *ERS* IF UNABLE TO SET SCP ABORT INTERLOCK.
*
*         USES   SC, SI, T1, AB - AB+4, CM - CM+4, CN - CN+4.
*
*         CALLS  CCJ, CIN, CRJ, SAI, SEF, SIN, WCM.
*
*         MACROS SFA.
 
 
 EUJ      SUBR               ENTRY/EXIT
 
*         SET SCP ABORT INTERLOCK.
 
          LDD    CP          READ JOB CONTROL WORD
          ADN    JCIW
          CRD    CM
          ADN    TFSW-JCIW   GET SCP EJT ORDINAL
          CRD    AB
          LDD    CM+2        SET SCP IDENTIFICATION
          STD    SI
          LDN    LIOS        INCREMENT LOW CORE FIELD BY ONE
          RJM    SAI         SET SCP ABORT INTERLOCK
          ZJN    EUJ1        IF INTERLOCK SUCCESSFULLY SET
          LJM    ERS         ENTER RECALL STACK
 
 EUJ1     LDC    =C* SCP TERMINATION PROCESSING.*
          RJM    WCM         WRITE CPA MESSAGE
 
*         SEARCH FOR JOBS CONNECTED TO TERMINATING SCP.
 
          LDN    EJTP        READ EJT POINTER
          CRD    CN
          LDN    0           INITIALIZE EJT SEARCH ORDINAL
          STD    CN+4
          LDD    AB          SAVE SCP EJT ORDINAL
          STD    CN+3
 EUJ2     AOD    CN+4        ADVANCE EJT ORDINAL
          LMD    CN+2
          ZJP    EUJ6        IF END OF EJT
          LDD    CN+4
          LMD    CN+3
          ZJN    EUJ2        IF EJT ENTRY OF TERMINATING SCP
          SFA    EJT,CN+4    READ EJT ENTRY
          CRD    AB
          LDD    AB
          ZJN    EUJ2        IF EJT ENTRY NOT OCCUPIED
          LDD    AB+4
          SHN    21-13
          PJN    EUJ2        IF NO POSSIBLE SCP CONNECTIONS
          RJM    SIN         SET EJT INTERLOCK AND READ ENTRY
          ZJN    EUJ2        IF *ORET* ERROR OR ENTRY NOT OCCUPIED
          LDN    0           INITIALIZE ABORT JOB FLAG
          STD    CN+1
          LDD    AB+4
          SHN    21-13
          PJN    EUJ5        IF NO POSSIBLE SCP CONNECTIONS
          SHN    -7          CHECK JOB STATUS
          LPN    37
          LMN    EXJS
          NJN    EUJ3        IF JOB NOT AT CONTROL POINT
          RJM    CCJ         CHECK CONTROL POINT JOB
          UJN    EUJ4        CHECK ABORT JOB FLAG
 
 EUJ3     RJM    CRJ         CHECK ROLLED OUT JOB
 EUJ4     LDD    CN+1
          ZJN    EUJ5        IF NOT TO ABORT JOB
          LDN    SSET        SET SCP ABORTED ERROR FLAG
          RJM    SEF
 EUJ5     RJM    CIN         CLEAR EJT INTERLOCK
          LJM    EUJ2        ADVANCE EJT ORDINAL
 
*         CLEAR SCP ABORT INTERLOCK.
 
 EUJ6     LDN    LDOS        DECREMENT LOW CORE FIELD BY ONE
          RJM    SAI         CLEAR SCP ABORT INTERLOCK
 
*         CLEAR OUTSTANDING CONNECTION COUNT.
 
          LDD    CP          GET OUTSTANDING CONNECTION COUNT
          ADK    SSOW
          STD    T1
          CRD    CM
          LDN    0           CLEAR OUTSTANDING CONNECTION COUNT
          STD    CM+4
          LDD    T1
          CWD    CM
          LCN    2           CLEAR SCP WITH CONNECTIONS FLAG
          RAD    SC
          LJM    EUJX        RETURN
 NUS      SPACE  4,15
**        NUS - NOTIFY UCP SUBSYSTEM OF SCP TERMINATION.
*
*         ENTRY  (CM+2) = SUBSYSTEM ID OF UCP JOB.
*                (SI) = SUBSYSTEM ID OF TERMINATING SCP.
*
*         EXIT   (CN+1) = 0 IF TERMINATION MESSAGE SET TO SUBSYSTEM (DO
*                           NOT ABORT JOB).
*                TO *ERS* IF SUBSYSTEM BUSY RESPONSE TO NOTIFICATION.
*
*         USES   CN+1, T2, T3, CM - CM+4.
*
*         CALLS  CIN, SAI, SDS.
 
 
 NUS1     STD    CN+1        CLEAR ABORT JOB FLAG
 
 NUS      SUBR               ENTRY/EXIT
 
*         BUILD AND SEND TERMINATION MESSAGE TO UCP SUBSYSTEM.
 
          LDD    CM+2        SAVE SUBSYSTEM ID
          STD    T3
          LDN    ZERL
          CRD    CM
          LDC    4*100       ERROR STATUS 4 (SCP ABORTED)
          STD    CM+3
          LDD    MA
          CWD    CM
          LDN    0
          STD    CM+3
          LDD    SI          SUBSYSTEM IDENTIFICATION OF ABORTED SCP
          STD    CM+4
          LDD    MA
          ADN    1
          CWD    CM
          LDN    3           SET RETRY ON MOVE
          STD    T2
          LDD    T3          SUBSYSTEM IDENTIFICATION OF UCP
          RJM    SDS         SEND DATA TO SUBSYSTEM
          ZJN    NUS1        IF NOTIFICATION COMPLETE
          LMN    2
          NJN    NUSX        IF SUBSYSTEN NOT ACTIVE SCP
 
*         RECALL *0ST* IF SUBSYSTEM BUSY REJECT.
 
          RJM    CIN         CLEAR EJT INTERLOCK
          LDN    LDOS        CLEAR SCP ABORT INTERLOCK
          RJM    SAI
          LJM    ERS         ENTER RECALL
 SAI      SPACE  4,10
**        SAI - SET/CLEAR SCP ABORT INTERLOCK.
*
*         ENTRY  (A) = LIOS, SET INTERLOCK.
*                    = LDOS, CLEAR INTERLOCK.
*
*         EXIT   (A) = 0, NO ERRORS.
*
*         USES   CM - CM+2.
 
 
 SAI      SUBR               ENTRY/EXIT
          STD    CM          INCREMENT/DECREMENT LOW CORE FIELD BY ONE
          LDC    INWL        SCP INTERLOCK WORD
          STD    CM+1
          LDN    0D*100+1    POSITION AND WIDTH OF FIELD
          STD    CM+2
          LDD    MA
          CWD    CM
          LDN    1           SET REQUEST COUNT
          STD    CM+1
          STD    CM+2        SPECIFY NO DROP OF PP
          MONITOR UADM       SET/CLEAR SCP ABORT INTERLOCK
          LDD    CM+1        STATUS
          UJN    SAIX        RETURN
 SDS      SPACE  4,20
**        SDS - SEND DATA TO SUBSYSTEM.
*
*         ENTRY  (A) = SUBSYSTEM IENTIFICATION OF SCP RECEIVING DATA.
*                (MB - MB+1) = 2 CM WORD MESSAGE TO BE SENT.
*                (T2) = 2 IF CONTINUE RETRY ON MOVE IN PROGRESS AND
*                       SCP NOT READY FOR DATA.
*                     = 3 IF CONTINUE RETRY ON MOVE IN PROGRESS.
*
*         EXIT   (A) = 0, IF DATA ACCEPTED.
*                    = 2, IF NOT READY FOR DATA.
*                    = 4, IF SCP INACTIVE.
*                (AB - AB+1) = RESTORED TO PRIOR VALUE.
*                (CN+2 - CN+4) = RESTORED TO PRIOR VALUE.
*
*         USES   T1, AB - AB+1, CM - CM+4, CN+2 - CN+4.
*
*         CALLS  DLY, SEF.
*
*         MACROS MONITOR.
 
 
 SDS4     LDD    CM+1        RETURN *TDAM* STATUS
 
 SDS      SUBR               ENTRY/EXIT
          STD    T1          SAVE APPROPRIATE SUBSYSTEM IDENTIFICATION
 SDS1     LDD    T1
          STD    CM+2
          LDN    0           CLEAR *RA* PARAMETER ON *TDAM* CALL
          STD    CM+4
          LDN    1           SET WRITE MODE
          STD    CM+1
          SHN    7-0
          STD    CM+3        SET TRANSFER LENGTH
          MONITOR TDAM
          LDD    CM+1        EXAMINE STATUS
          ZJN    SDSX        IF CALL ACCEPTED
          SBN    5
          ZJN    SDS3        IF INVALID SCP PARAMETERS
          ADD    T2
          PJN    SDS4        IF NOT MOVE OR NOT READY FOR DATA REJECT
          RJM    DLY         DELAY
          NJN    SDS1        IF NOT OPERATOR INTERVENTION
 SDS2     LDN    4           FORCIBLY BREAK CONNECTIONS
          UJN    SDSX        RETURN
 
 SDS3     LDD    MA          SAVE CONTENTS OF CN+2 - CN+4, AB - AB+1
          CWD    CN+2
          SBN    1           GET SCP INFORMATION FROM OUTPUT REGISTER
          CRD    CN+2
          LDN    ITET        SCP INVALID TRANSFER ADDRESS
          RJM    SEF         SET ERROR FLAG ON SCP
          LDD    MA          RESTORE CN+2 - CN+4, AB - AB+1
          CRD    CN+2
          UJN    SDS2        RETURN SUBSYSTEM INACTIVE STATUS
 SEF      SPACE  4,15
**        SEF - SET ERROR FLAG ON SPECIFIED JOB.
*
*         ENTRY  (A) = ERROR FLAG.
*                (CN+4) = EJT ORDINAL OF JOB TO SET ERROR FLAG ON.
*                (AB - AB+1) = JOB SEQUENCE NUMBER OF JOB TO SET
*                ERROR FLAG ON.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  DLY.
*
*         MACROS MONITOR.
 
 
 SEF      SUBR               ENTRY/EXIT
          ADC    4000        SET EJT ORDINAL SPECIFIED FLAG
          STD    T1
 SEF1     LDD    CN+4        SET JOB EJT ORDINAL
          STD    CM+2
          LDD    AB          SET JOB SEQUENCE NUMBER
          STD    CM+3
          LDD    AB+1
          STD    CM+4
          LDD    T1          ERROR FLAG AND EJT ORDINAL FLAG
          STD    CM+1
          MONITOR CEFM
          LDD    CM+1
          SBN    1
          NJN    SEFX        IF NOT JOB MOVING REJECT
          RJM    DLY         DELAY
          NJN    SEF1        IF NO OPERATOR INTERVENTION
          UJN    SEFX        RETURN
 SIN      SPACE  4,15
**        SIN - SET EJT ENTRY INTERLOCK.
*
*         ENTRY  (CN+4) = UCP EJT ORDINAL.
*
*         EXIT   (A) = 0 IF *ORET* ERROR SET OR EJT ENTRY NOT USED.
*                    .NE. 0 IF EJT INTERLOCK SUCCESSFULLY SET.
*                (AB - AB+4) = UCP EJT *JSNE* WORD.
*                (FS - FS+4) = UCP EJT *SCHE* WORD.
*
*         USES   T1, AB - AB+4, FS - FS+4.
*
*         CALLS  DLY, SFI.
*
*         MACROS SFA.
 
 
 SIN2     SFA    EJT,CN+4    READ EJT ENTRY
          CRD    AB
          ADN    SCHE-JSNE
          CRD    FS
 
 SIN      SUBR               ENTRY/EXIT
 SIN1     LDN    SFIN        SET EJT ENTRY INTERLOCK
          STD    T1
          SFA    EJT,CN+4    ABSOLUTE ADDRESS OF EJT ENTRY
          RJM    SFI
          ZJN    SIN2        IF INTERLOCK SUCCESSFULLY SET
          SBN    3
          ZJN    SINX        IF EJT ENTRY NOT IN USE
          RJM    DLY         DELAY
          NJN    SIN1        IF NOT OPERATOR INTERVENTION
          UJN    SINX        RETURN
 SRS      SPACE  4,10
**        SRS - SEND UCP TERMINATION RESPONSE TO CONNECTED SCPS.
*
*         EXIT   MESSAGE SENT TO INFORM CONNECTED SCP(S) OF
*                UCP END/ABORT.
*
*         USES   SC, T0, T2, CM - CM+4, CN - CN+4, CW - CW+4, T3 - T7.
*
*         CALLS  SDS, WCM.
*
*         MACROS SFA.
 
 
 SRS      SUBR               ENTRY/EXIT
          LDC    =C* UCP TERMINATION PROCESSING.*
          RJM    WCM         WRITE CPA MESSAGE
          LDD    CP          GET EJT ORDINAL OF UCP
          ADN    TFSW
          CRD    T3
          ADK    SEPW-TFSW   GET SPECIAL ENTRY POINTS
          CRD    CN
          ADK    SSCW-SEPW   READ SCP CONTROL WORD
          CRD    CW
          SFA    EJT,T3      ABSOLUTE ADDRESS OF UCP EJT ENTRY
          CRD    CM          GET UCP JOB SEQUENCE NUMBER
          LDN    0
          STD    CM+2
          LDD    CN          SET UCP *DMP=* STATUS
          LPN    20
          SHN    -4
          STD    CM+3
          LDD    T3          SET UCP EJT ORDINAL
          STD    CM+4
          LDN    ZERL        INITIALIZE UCP END/ABORT STATUS WORD
          CRD    T3
          LDD    EF
          ZJN    SRS2        IF NO ERROR FLAG SET
          LMN    ORET
          ZJN    SRS1        IF FORCED BREAK IN CONNECTIONS
          LCN    1
 SRS1     ADN    2
 SRS2     ADN    1           USER STATUS = END(1), ABORT(2), BROKEN(3)
          SHN    6
          STD    T3+3
          LDD    MA          WRITE USER STATUS
          CWD    T3
          ADN    1
          CWD    CM          JOB SEQUENCE NUMBER AND EJT ORDINAL
          LDN    4           INITIALIZE SCP BYTE POINTER
          STD    T4
 
*         CHECK WAIT RESPONSE AND LONG TERM CONNECTION INDICATORS.
 
 SRS3     LDM.   CW,T4
          ZJN    SRS5        IF UCP NOT CONNECTED TO THIS SCP
          SHN    -6
          ADC    LSSI
          STD    T3
          LDN    3           SET RETRY ON STORAGE MOVE
          STD    T2
          LDD    T3          GET SCP IDENTIFICATION
          RJM    SDS         SEND DATA TO SCP
          STD    T0          SAVE RESPONSE
          SBN    4
          PJN    SRS4        IF SCP INACTIVE
          LDD    EF
          LMN    ORET
          ZJN    SRS4        IF CONNECTIONS TO BE FORCIBLY BROKEN
          LDD    T0          CHECK RESPONSE
          ZJN    SRS5        IF DATA ACCEPTED BY SCP
          STD    T7          SET SCP BUSY FLAG
          UJN    SRS5        PROCESS NEXT SCP
 
 SRS4     LDN    0           CLEAR SCP CONNECTION
          STM.   CW,T4
 SRS5     SOD    T4
          PJP    SRS3        IF MORE SCP-S TO CHECK FOR
 
 SRS7     LDD    CP          UPDATE SCP CONTROL WORD
          ADC    SSCW
          CWD    CW
          LDD    T7
          ZJN    SRS8        IF ALL CONNECTED SCP-S NOTIFIED
          LJM    ERS         ENTER RECALL STACK
 
 SRS8     LDD    CW          CHECK FOR REMAINING SCP CONNECTIONS
          ADD    CW+1
          ADD    CW+2
          ADD    CW+3
          ADD    CW+4
          NJN    SRS9        IF CONNECTIONS REMAINING
          LCN    1           CLEAR UCP WITH CONNECTIONS FLAG
          RAD    SC
 SRS9     LJM    SRSX        RETURN
 WCM      SPACE  4,10
**        WCM - WRITE CPA MESSAGE.
*
*         ENTRY  (A) = RELATIVE ADDRESS OF MESSAGE.
 
 
 WCM      SUBR               ENTRY/EXIT
          ADD    LA          ADJUST MESSAGE ADDRESS BY LOAD ADDRESS
          STM    WCMA
          LDD    CP
          ADN    MS2W
          CWM.   **,TR       WRITE MESSAGE TO CPA
 WCMA     EQU    *-1
          UJN    WCMX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
 EJT$     EQU    1           DEFINE EXECUTING JOB TABLE PROCESSOR
*CALL     COMPGFP
*CALL     COMPRSS
 SFI$     EQU    1           SELECT IMMEDIATE RETURN FROM *SFI*
*CALL     COMPSFI
          SPACE  4,10
          USE
          RSTR
          OVERFLOW  5,ZSTL   CHECK LENGTH OF *0ST*
 
          END