0ST 
          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 
