Retro1.org codex

PROC ALT$RP; 
# TITLE ALT$RP - SSALTER REQUEST PROCESSOR.                           #
 
      BEGIN  # ALT$RP #
 
#
**    ALT$RP - SSALTER REQUEST PROCESSOR.
*
*     *ALT$RP* PROCESSES THE *SSALTER* TYPE 5 REQUESTS.
*
*     PROC ALT$RP
*
*     ENTRY      P<CPR> = ADDRESS OF TYPE 5 *UCP* REQUEST BLOCK.
*
*     EXIT       THE *UNIT DEVICE TABLE* TRANSMITTED, OR THE *UNIT
*                DEVICE TABLE* FIELD CHANGED.
#
 
#
****  PROC ALT$RP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* #
        PROC MESSAGE;                # ABORT A *UCP* #
        PROC KILL$UC;                # ABORT A UCP #
        PROC LLRQENQ;                # *LLRQ* ENGUEUER #
        PROC UCP$RES;                # ISSUE RESPONSE TO *UCP* #
        PROC UCP$WRI;                # PASS DATA TO *UCP* #
        END
 
#
****  PROC ALT$RP - XREF LIST END.
#
 
      DEF LISTCON  #0#;              # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMBUCR
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM BYNR       U;             # OFF/SET BIT ADDRESS #
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
      ITEM PMMR       U;             # STATUS BIT #
      ITEM RETCODE    U;             # RETURN CODE #
      ITEM STAT       U;             # STATUS OF *UDT* BIT #
      ITEM UDTQ       U;             # UDT ADDRESS #
 
      BASED
      ARRAY  UDTBIT  [0:0]  P(1);      # ALTER *UDT* AREA #
        BEGIN
        ITEM UDT$BIT    U(00,00,60);
        END
 
 
      IF CPR$RQC[0] LQ REQTYP5"RES5"  ##
        OR CPR$RQC[0] GQ REQTYP5"LSTREQTYP5"
      THEN
        BEGIN  # IF REQUEST CODE IS INCORRECT #
        KILL$UC(KILLCODE"INVRQC");   # ABORT THE UCP #
        RETURN;
        END
 
#
*     RETURN THE UNIT DEVICE TABLE TO THE UCP.
#
 
      IF CPR$RQC[0] EQ REQTYP5"SSA$PUDT"     ##
      THEN
        BEGIN  # TRANFERS THE UDT TO THE UCP #
        UDTQ = UDTCADR + CPR$ADDR3[0];
        UCP$WRI(CPR$ADDR2[0],CPR$ADDR4[0],UDTQ,RETCODE);
        IF RETCODE EQ SFRCUCPGON
        THEN
          BEGIN
          RETURN;
          END
 
        IF RETCODE EQ SFRCBDUCPA
        THEN
          BEGIN
          KILL$UC(KILLCODE"INVADDR");
          RETURN;
          END
 
        IF RETCODE NQ 0
        THEN
          BEGIN
          FE$RTN[0] = "ALT$RP.";
          MESSAGE(FEMSG[0],UDFL1);
          ABORT;
          END
 
        ELSE
          BEGIN
 
          IF INITIALIZE
          THEN
            BEGIN     # BEFORE INITIALIZATION #
            LTC$RQR[LTCENTRY] = RESPTYP5"SSA$OK";
            END
          ELSE
            BEGIN    # AFTER INITIALIZATION #
            LTC$RQR[LTCENTRY] = RESPTYP5"OK5";
            END
 
          UCP$RES;
          RETURN;
          END
 
        END  # RETURN OF UDT #
 
#
*     CHANGE A PATH NOD.
#
 
      UDTQ = CPR$UDTQ[0]+UDTCADR;    # UDT RELATIVE ADDRESS #
      BYNR = CPR$BYNR[0];            # OFF SET BIT ADDRESS #
 
      P<UDTBIT> = UDTQ;
      IF CPR$PMMR[0]
      THEN
        BEGIN
        PMMR = 1;
        END
 
      ELSE
        BEGIN
        PMMR = 0;
        END
 
      STAT = B<BYNR,1> UDT$BIT[0];    # CHECK FOR BIT ALREADY SET #
      IF STAT EQ PMMR
      THEN
        BEGIN
        LTC$RQR[LTCENTRY] = RESPTYP5"SSA$UIRC";
        UCP$RES;
        RETURN;
        END
 
      ELSE
        BEGIN
        B<BYNR,1> UDT$BIT[0] = PMMR;    # SET OPTION BIT #
        B<BYNR+1,1> UDT$BIT[0] = 1;     # SET *ACK* FLAG #
        END
 
#
*     CHECK FOR INITIALIZATION.
#
 
      IF INITIALIZE
      THEN
        BEGIN
        LTC$RQR[LTCENTRY] = RESPTYP5"SSA$OK";
        UCP$RES;
        RETURN;
        END
 
#
*     SET UP A *LLRQ* ENTRY.
#
 
 
        LLRQENQ(LLRADR);
        P<LLRQ> = LLRADR;
        LLR$LTCT[0] = LTCENTRY;
        LLR$UCPRA[0] = UCP$ADDR[0];
        LLR$WORD4[0] = CPR3[0];
        LLR$WORD5[0] = CPR2[0];
        LLR$PRCNME[0] = REQTYP4"INITHW";
        LLR$CU[0] = CPR$CUORD[0];
        LLR$UDTQ[0] = UDTQ;
        LLR$BYNR[0] = BYNR;
        LLR$PMMR[0] = PMMR;
 
        LTC$LLRQA[LTCENTRY] = LLRADR;
        RETURN;
 
      END  # ALT$PR #
 
    TERM
PROC CONNECT;
# TITLE CONNECT - ESTABLISH LONG TERM CONNECTION.                     #
 
      BEGIN  # CONNECT #
 
#
**    CONNECT - ESTABLISH LONG TERM CONNECTION.
*
*     *CONNECT* PROCESSES *UCP* CONNECT REQUESTS.
*
*     PROC CONNECT
*
*     ENTRY     THE CONNECT REQUEST TO BE PROCESSED IS IN ARRAY
*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.
*
*     EXIT      THE LONG TERM CONNECTION HAS BEEN ESTABLISHED, THE
*               *LTCT* ENTRY FOR THE CONNECTING *UCP* HAS BEEN BUILT,
*               AND A RESPONSE HAS BEEN SENT BACK TO THE *UCP*.
*
*     MESSAGES  * EXEC ABNORMAL, CONNECT.*
#
 
#
****  PROC CONNECT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC KILL$UC;                # ABORT A *UCP* #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC CONNECT - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
 
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBUCR
*CALL COMXCTF
*CALL COMXLTC
*CALL COMXMSC
 
 
      ITEM J          U;             # COUNTER #
      ITEM ORD$MRFT   U;             # *MRFT* ORDINAL #
      ITEM UCPSWAPPED B;             # UCP WAS SWAPPED OUT #
 
 
 
 
#
*     ABORT *UCP* IF *DRYUP* FLAG IS SET.
#
 
      IF DRYUP
      THEN
        BEGIN
        KILL$UC(KILLCODE"CLOSED");
        RETURN;
        END
 
#
*     REQUESTOR ID HAS TO BE IN RANGE.
#
 
      IF CPR$RQI[0] EQ  REQNAME"RQIFIRST" OR  ##
        CPR$RQI[0] GQ  REQNAME"RQILAST"
      THEN
        BEGIN
        KILL$UC(KILLCODE"NOTAUTH");
        RETURN;
        END
 
#
*     SYSTEM LONG TERM CONNECTION HAS TO BE CLEARED.
#
 
      IF LTCENTRY NQ 0
      THEN
        BEGIN
        KILL$UC(KILLCODE"MULCON");
        RETURN;
        END
 
#
*     1. MULTIPLE COPIES OF *SSMOVE* CAN BE RUN AT A TIME, HOWEVER,
*        ONLY ONE COPY OF *SSMOVE* THAT IS IN THE PROCESS OF
*        DESTAGING FILES CAN BE CONNECTED AT A TIME. *MULTIPLE RUN*
*
*     2. MULTIPLE COPIES OF *SSLABEL*, *SSDEBUG* OR *SSVAL* CAN NOT
*        BE CONNECTED. *MULTIPLE RUN*
*
*     3. *SSLABEL*, *SSDEBUG* OR *SSVAL* CAN NOT BE CONNECTED WHILE
*        ANOTHER COPY OF THESE UTILITIES ARE CONNECTED.
*        *UTILITY CONFLICT*
*
*     4. *SSVAL* CAN NOT BE CONNECTED WHILE *SSMOVE* IS IN THE
*        PROCESS OF DESTAGING FILES. *SSMOVE* CAN NOT BE CONNECTED
*        WHEN *SSVAL* IS CONNECTED. *UTILITY CONFLICT*
#
 
      IF CPR$RQI[0] EQ REQNAME"RQIMOVE"
      THEN
        BEGIN  # *SSMOVE* REQUEST #
        IF DSC$FAM NQ 0
        THEN
          BEGIN  # MULTIPLE RUN #
          KILL$UC(KILLCODE"MULRUN");
          RETURN;
          END  # MULTIPLE RUN #
 
        IF CONIND[REQNAME"RQIVALD"]
        THEN
          BEGIN  # UTILITY CONFLICT #
          KILL$UC(KILLCODE"UTLCONF");
          RETURN;
          END  # UTILITY CONFLICT #
 
        END  # *SSMOVE* REQUEST #
 
      ELSE
        BEGIN  # NOT *SSMOVE* REQUEST #
        IF CONIND[CPR$RQI[0]]
        THEN
          BEGIN  # MULTIPLE RUN #
          KILL$UC(KILLCODE"MULRUN");
          RETURN;
          END  # MULTIPLE RUN #
 
        ELSE
          BEGIN  # NOT MULTIPLE RUN #
          IF (CPR$RQI[0] EQ REQNAME"RQILABL")    ##
            OR (CPR$RQI[0] EQ REQNAME"RQIDBUG")  ##
            OR (CPR$RQI[0] EQ REQNAME"RQIVALD")
          THEN
            BEGIN  # *SSLABEL*, *SSDEBUG* OR *SSVAL* REQUEST #
            IF ((CONIND[REQNAME"RQILABL"])       ##
              OR (CONIND[REQNAME"RQIDBUG"])      ##
              OR (CONIND[REQNAME"RQIVALD"]))     ##
              OR ((CPR$RQI[0] EQ REQNAME"RQIVALD") AND (DSC$FAM NQ 0))
            THEN
              BEGIN  # UTILITY CONFLICT #
              KILL$UC(KILLCODE"UTLCONF");
              RETURN;
              END  # UTILITY CONFLICT #
 
            END  # *SSLABEL*, *SSDEBUG* OR *SSVAL* REQUEST #
 
          END  # NOT MULTIPLE RUN #
 
        END  # NOT *SSMOVE* REQUEST #
 
#
*     FIND AN EMPTY LONG TERM CONNECT TABLE ENTRY AND
*     ASSIGN THE *UCP* TO THE ENTRY.  SET THE SYSTEM LONG
*     TERM CONNECT BIT.
#
 
      FASTFOR LTCENTRY = 1 STEP 1 UNTIL LTCTCNT
      DO
        BEGIN  # SEARCH *LTCT* FOR AN EMPTY SLOT #
        IF LTC$SFJBSN[LTCENTRY] EQ 0
        THEN
          BEGIN  # SET UP LONG TERM CONNECTION #
          UCPSWAPPED = TRUE;
          REPEAT WHILE UCPSWAPPED
          DO
            BEGIN  # REPEAT WHILE SWAPPED #
            SFFC[0] = SFSLTC;
            SFCALL(SFBLKPTR,RCL);
            IF SFRC[0] EQ SFRCSWPOUT
            THEN
              BEGIN
              SFFC[0] = SFSWPI;
              SFCALL(SFBLKPTR,RCL);
              END
 
            ELSE
              BEGIN
              UCPSWAPPED = FALSE;
              END
 
            END  # REPEAT WHILE SWAPPED #
 
          IF SFRC[0] NQ 0
          THEN
            BEGIN  # PROCESS UNEXPECTED RESPONSE #
            IF SFRC[0] EQ SFRCUCPGON
            THEN
              BEGIN
              RETURN;
              END
 
            ELSE
              BEGIN
              FE$RTN[0] = "CONNECT.";
              MESSAGE(FEMSG[0],UDFL1);
              ABORT;
              END
 
            END  # PROCESS UNEXPECTED RESPONSE #
 
          LTC$WORD1[LTCENTRY] = UCP$WORD1[0];
          LTC$WORD2[LTCENTRY] = 0;
          LTC$RQI[LTCENTRY] = CPR$RQI[0];
          LTC$UCPA[LTCENTRY] = UCP$ADDR[0];
          LTC$WORD3[LTCENTRY] = CPR3[0];
          CONIND[CPR$RQI[0]] = TRUE;
          LTC$RQR[LTCENTRY] = RESPTYP1"OK1";
          UCP$RES;
          RETURN;
          END  # SET UP LONG TERM CONNECTION #
 
        END  # SEARCH *LTCT* FOR AN EMPTY SLOT #
 
#
*     ABORT IF THERE ARE NO LONG TERM CONNECT TABLE ENTRIES
*     AVAILABLE.
#
 
      FE$RTN[0] = "CONNECT.";
      MESSAGE(FEMSG[0],UDFL1);
      ABORT;
      END  # CONNECT #
 
    TERM
PROC KILL$UC((MCODE));
# TITLE KILL$UC - ABORT A *UCP*.                                      #
      BEGIN  # KILL$UC #
 
#
**    KILL$UC - ABORT A *UCP*.
*
*     *KILL$UC* ABORTS A *UCP*.
*
*     PROC KILL$UC((MCODE))
*
*     ENTRY     MCODE = MESSAGE CODE ORDINAL.
*               THE JOB SEQUEUNCE NUMBER FROM THE OFFENDING *UCP* IS
*               IN ARRAY *UCPR*. THE BASE POINTER FOR *UCPR* IS
*               ALREADY SET.
*
*     EXIT      A DAYFILE MESSAGE HAS BEEN ISSUED TO EXPLAIN WHY THE
*               *UCP* IS BEING ABORTED, AND AN *SF.REGR* HAS BEEN
*               ISSUED TO ABORT THE OFFENDING *UCP*.
*
*     MESSAGES  * EXEC ABNORMAL, KILL$UC.*
*               * XXXX ABORTED - NOT CONNECTED.*
*               * XXXX ABORTED - ALREADY CONNECTED.*
*               * XXXX ABORTED - MULTIPLE REQUESTS.*
*               * XXXX ABORTED - MULTIPLE RUN.*
*               * XXXX ABORTED - INCORRECT REQUEST TYPE.*
*               * XXXX ABORTED - INCORRECT REQUEST CODE.*
*               * XXXX ABORTED - UTILITY CONFLICT.*
*               * XXXX ABORTED - CARTRIDGE ACTIVE.*
*               * XXXX ABORTED - SSEXEC IS CLOSED.*
*               * XXXX ABORTED - INCORRECT ADDRESS.*
*                   XXXX = JOB SEQUENCE NUMBER.
*
#
 
      ITEM MCODE      U;             # MESSAGE-CODE ORDINAL #
 
#
****  PROC KILL$UC - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC MESSAGE;                # INTERFACE TO *MESSAGE* MACRO #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        END
 
#
****  PROC KILL$UC - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBUCR
*CALL COMXLTC
*CALL COMXMSC
 
#
*     ABORT MESSAGE DEFINITION.
#
 
      ARRAY DISPMESS [0:0] S(5);
        BEGIN
        ITEM MESSJBSN   C(00,00,04);  # JOB NAME #
        ITEM MESSFLR    C(00,24,03) = ["   "];
        ITEM MESSABT    C(00,42,10) = ["ABORTED - "];
        ITEM MESSREASON C(01,42,21);
        ITEM MESSTERMTR C(03,48,12) = [0];
        END
 
#
*     REASON WHY *UCP* IS BEING ABORTED.
#
 
      ARRAY ABTREASON [KILLCODE"NOTAUTH":KILLCODE"LASTCODE"] S(3);
        BEGIN
        ITEM REASONMESS C(00,00,21) = ["NOT AUTHORIZED.",
        "NOT CONNECTED.",
        "ALREADY CONNECTED.",
        "MULTIPLE REQUESTS.",
        "MULTIPLE RUN.",
        "INVALID REQUEST TYPE.",
        "INVALID REQUEST CODE.",
        "UTILITY CONFLICT.",
        "CARTRIDGE ACTIVE.",
        "SSEXEC IS CLOSED.",
        "INVALID ADDRESS.",
        "LAST ENTRY."];
        END
 
 
 
 
 
#
*     REASON CODE HAS TO BE WITHIN RANGE.
#
 
      IF MCODE LS KILLCODE"NOTAUTH" OR MCODE GQ KILLCODE"LASTCODE"
        THEN
        BEGIN
        FE$RTN[0] = "KILLUCP.";
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END
 
      MESSJBSN[0] = UCP$JBSN[0];
      MESSREASON[0] = REASONMESS[MCODE];
      MESSAGE(DISPMESS,3);
 
#
*     ABORT THE *UCP* VIA A *SFCALL* REQUEST.
#
 
REPEATREGR:
      SFFP[0] = 0;
      SFUCPA[0] = 2;
      SFSCPA[0] = LOC(DISPMESS);
      SFFC[0] = SFREGR;
      SFJBSN[0] = UCP$JBSN[0];
      SFFSTA[0] = UCP$FSTA[0];
      SFCALL(SFBLKPTR,RCL);
 
#
*     SWAPIN *UCP* IF OUT.
#
 
      IF SFRC[0] EQ SFRCSWPOUT
      THEN
        BEGIN
        SFFC[0] = SFSWPI;
        SFCALL(SFBLKPTR,RCL);
        GOTO REPEATREGR;
        END
 
#
*     ABORT IF *SFERROR* NOT *UCP* ABORTED OR UNDEFINED.
#
 
      IF SFRC[0] NQ 0
      THEN
        BEGIN
        IF SFRC[0] NQ SFRCUCPGON
        THEN
          BEGIN
          FE$RTN[0] = "KILLUCP.";
          MESSAGE(FEMSG[0],UDFL1);
          ABORT;
          END
 
        END
 
      RETURN;
      END  # KILL$UC #
 
    TERM
PROC LINK$RP;
# TITLE LINK$RP - PRELIMINARY LINKAGE PROCESSING.                     #
      BEGIN  # LINK$RP #
 
 
#
**    LINK$RP - PRELIMINARY LINKAGE PROCESSING.
*
*     *LINK$RP* DOES PRELIMINARY PROCESSING OF *UCP* LINKAGE
*     REQUESTS AND THEN CALLS THE APPROPRIATE MODULE TO DO
*     THE DETAILED PROCESSING OF THE REQUEST.
*
*     PROC LINK$RP
*
*     ENTRY     THE TYPE 1 UCP REQUEST TO BE PROCESSED IS IN ARRAY
*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.
*
*     EXIT      THE TYPE 1 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
#
 
#
****  PROC LINK$RP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CONNECT;                # ESTABLISH LONG TERM CONNECTION #
        PROC KILL$UC;                # ABORT A *UCP* #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC UCP$DON;                # TERMINATE *UCP* REQUEST PROPERLY
                                     #
        END
 
#
****  PROC LINK$RP - XREF LIST END.
#
 
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBUCR
*CALL COMXMSC
 
#
*     LIST FOR PROCESSING LINKAGE REQUESTS.
#
 
      SWITCH TYP1SW:REQTYP1
              PRCON:CONNECT,
             PRDISC:DISCONNECT;
 
 
 
 
 
#
*     REQUEST CODE HAS TO BE A VALID LINKAGE REQUEST CODE.
#
 
      IF CPR$RQC[0] EQ REQTYP1"RES1"  ##
        OR CPR$RQC[0] GQ REQTYP1"LSTREQTYP1"
      THEN
        BEGIN
        KILL$UC(KILLCODE"INVRQC");
        RETURN;
        END
 
 
#
*     PROCESS THE APPROPRIATE LINKAGE REQUEST AND THEN RETURN TO
*     THE CALLER.
#
 
      GOTO TYP1SW[CPR$RQC[0]];
 
 
PRCON:
      CONNECT;
      RETURN;
 
 
PRDISC:
      UCP$DON;
      RETURN;
 
 
      END  # LINK$RP #
 
    TERM
PROC QUE$RP;
# TITLE QUE$RP - QUEUABLE REQUEST PROCESSOR.                          #
 
      BEGIN  # QUE$RP #
 
#
**    QUE$RP - QUEUABLE REQUEST PROCESSOR.
*
*     *QUE$RP* DOES PRELIMINARY PROCESSING OF TYPE 4 *UCP* REQUESTS.
*     A LOW LEVEL REQUEST QUEUE ENTRY IS SET UP. FOR AN UNLOAD
*     CARTRIDGE REQUEST, THE UTILITY CARTRIDGE TABLE IS CLEARED.
*
*     PROC QUE$RP
*
*     ENTRY      POINTERS TO THE UCP REQUEST BEING PROCESSED AND
*                THE *LTCT* ENTRY CORRESPONDING TO THE REQUEST HAVE
*                BEEN SET.
*
*     EXIT       IF AN INCORRECT REQUEST CODE OR A UTILITY CONFLICT IS
*                DISCOVERED, THE UCP WILL BE ABORTED AND CONTROL WILL
*                RETURN TO THE CALLER.
*
*     NOTES      *QUE$RP* MUST NOT BE CALLED IF THE *LLRQ* IS FULL.
#
 
#
****  PROC QUE$RP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC KILL$UC;                # ABORT A UCP #
        PROC LLRQENQ;                # *LLRQ* ENQUEUER #
        END
 
#
****  PROC QUE$RP - XREF LIST END.
#
 
      DEF LISTCON    #0#;
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMXLTC
*CALL COMXMSC
*CALL COMBUCR
 
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
 
      SWITCH REQCODE:REQTYP4
                REQ1:LOAD$CART,
                REQ2:UNLD$CART,
                REQ3:CP$RAW$AU,
                REQ4:WRT$LAB,
              REQEND:LSTREQTYP4;
 
                                               CONTROL EJECT;
 
      IF CPR$RQC[0] LQ REQTYP4"RES4"  ##
        OR CPR$RQC[0] GQ REQTYP4"LSTREQTYP4"
      THEN                           # IF REQUEST CODE IS INCORRECT #
        BEGIN
        KILL$UC(KILLCODE"INVRQC");   # ABORT THE UCP #
        RETURN;
        END
 
      IF CPR$RQC[0] EQ REQTYP4"LOAD$CART"
      THEN                           # IF LOAD CARTRDIGE REQUEST #
        BEGIN  # LOAD CARTRDIGE REQUEST #
        IF LTC$CART[LTCENTRY]
        THEN                         # IF *UTCT* NOT EMPTY #
          BEGIN
          KILL$UC(KILLCODE"MULCART");  # CARTRIDGE ALREADY ACTIVE #
          RETURN;
          END
        ELSE
          BEGIN     # SET UP *LLRQ* ENTRY #
          LLRQENQ(LLRADR);
          P<LLRQ> = LLRADR;
          LLR$LTCT[0] = LTCENTRY;
          LLR$UCPRA[0] = UCP$ADDR[0];
          LLR$WORD4[0] = CPR3[0];
          LLR$WORD5[0] = CPR2[0];
          LTC$LLRQA[LTCENTRY] = LLRADR;
          END
 
        END  # LOAD CARTRIDGE REQUEST #
 
      IF CPR$RQC[0] EQ REQTYP4"UNLD$CART"
      THEN                           # IF UNLOAD CARTRIDGE REQUEST #
        BEGIN
        LTC$CART[0] = FALSE;
        END
 
      IF CPR$RQC[0] NQ REQTYP4"LOAD$CART"
      THEN
        BEGIN        # NO BUILD OF *LLRQ* #
        P<LLRQ> = LTC$LLRQA[LTCENTRY];
        LLR$DR[0] = 0;          # CLEAR OLD RESPONSE CODE #
        LLR$PRCST[0] = 0;
        LLR$RQC[0] = CPR$RQC[0];   # NEW REQUEST CODE #
        LLR$WORD4[0] = CPR3[0];
        LLR$YZ[0] = CPR$YZ[0];
        LLR$ADDR2[0] = CPR$ADDR2[0];
        END
 
#
*     SIMULATED CASE COMMAND FOR SETTING PROCESS NAME.
#
 
CORCOD:
      GOTO REQCODE[CPR$RQC[0]];
 
REQ1:                                # LOAD CARTRIDGE #
      LLR$PRCNME[0] = REQTYP4"LOAD$CART";
      RETURN;
 
REQ2:                                # UNLOAD CARTRIDGE #
      LLR$PRCNME[0] = REQTYP4"UNLD$CART";
      GOTO REQEND;
 
REQ3:                                # COPY RAW STREAM #
      LLR$PRCNME[0] = REQTYP4"CP$RAW$AU";
      GOTO REQEND;
 
REQ4:                                # WRITE LABEL #
      LLR$PRCNME[0] = REQTYP4"WRT$LAB";
      GOTO REQEND;
 
REQEND:
 
#
*     END SIMULATED CASE COMMAND FOR SETTING PROCESS NAME.
#
 
      ADD$LNK(LTC$LLRQA[LTCENTRY],LCHN"LL$READY",0);
      RETURN;
 
      END  # QUE$RP #
 
    TERM
PROC TYP2$RP;
# TITLE TYP2$RP - TYPE 2 REQUEST PROCESSOR.                           #
 
      BEGIN  # TYP2$RP #
 
#
**    TYP2$RP - TYPE 2 REQUEST PROCESSOR.
*
*     *TYP2$RP* DOES PRELIMINARY PROCESSING OF TYPE 2 *UCP* REQUESTS.
*     THE APPROPRIATE MODULE IS CALLED TO DO DETAILED PROCESSING OF
*     THE REQUEST.
*
*     PROC TYP2$RP
*
*     ENTRY      THE POINTER TO THE *UCP* REQUEST BEING PROCESSED
*                HAS BEEN SET (BASED ARRAY *CPR*).
*
*     EXIT       IF AN INCORRECT REQUEST CODE WAS DETECTED, THE *UCP*
*                HAS BEEN ABORTED, ELSE *ACTVMF* HAS BEEN CALLED.
#
 
#
*     PROC TYP2$RP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC DSSETUP;        # SETUP DESTAGE PROCESSING #
        PROC KILL$UC;                # ABORT A *UCP* #
        PROC SFCALL;         # INTERFACE TO *SFCALL* MACRO #
      PROC UCP$RES;        # ISSUE RESPONSE TO A *UCP* #
        END
 
#
*     PROC TYP2$RP - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBUCR
*CALL,COMXLTC
*CALL,COMXMSC
 
      ITEM STAT      U;  # STATUS #
                                               CONTROL EJECT;
      IF CPR$RQC[0] LQ REQTYP2"RES2"  ##
        OR CPR$RQC[0] GQ REQTYP2"LSTREQTYP2"
      THEN                           # IF INCORRECT REQUEST CODE #
        BEGIN
        KILL$UC(KILLCODE"INVRQC");   # ABORT THE *UCP* #
        RETURN;
        END
 
#
*     CALL *DSSETUP* TO INITIATE DESTAGE PROCESSING.
*     IF PROBLEMS WITH THIS INITIATION OR IF THE NO-WAIT OPTION IS
*     SELECTED, ISSUE AN IMMEDIATE REPLY TO *SSMOVE*.  OTHERWISE,
*     SAVE THE LONG-TERM CONNECT TABLE ORDINAL SO A REPLY CAN
*     BE RETURNED UPON COMPLETION OF DESTAGING.
#
 
      DSSETUP(CPR$FAM[0],STAT);
 
      IF STAT NQ 0
      THEN
        BEGIN STAT = RESPTYP2"MRFERR"; END
      ELSE BEGIN STAT = RESPTYP2"OK2";
        IF NOT CPR$NW[0]
        THEN   # CAUSE *SSMOVE* TO BE ROLLED UNTIL DESTAGING
                        IS COMPLETE #
        BEGIN
        LTC$SFUCPA[LTCENTRY] = 0;
        LTC$SFSCPA[LTCENTRY] = 0;
        LTC$SFFC[LTCENTRY] = SFSWPO;
        SFCALL(LOC(LTC$WORD0[LTCENTRY]),NRCL);
        DSC$LTCT = LTCENTRY;
        RETURN;
        END
 
      END
 
#
*     REPLY IMMEDIATELY.
#
 
      LTC$RQR[LTCENTRY] = STAT;
      UCP$RES;
      RETURN;
      END  # TYP2$RP #
 
    TERM
PROC UCP$DON;
# TITLE UCP$DON - TERMINATE *UCP* REQUEST PROPERLY.                   #
 
      BEGIN  # UCP$DON #
 
#
**    UCP$DON - TERMINATE *UCP* REQUEST PROPERLY.
*
*     *UCP$DON* CLEANS UP THE LONG TERM CONNECT TABLE
*     ENTRY AND ANY OUTSTANDING REQUESTS WHEN A *UCP*
*     TERMINATES WHILE STILL HAVING A LONG TERM
*     CONNECTION WITH *SSEXEC*.
*
*     PROC UCP$DON
*
*     ENTRY     THE DISCONNECT REQUEST OR TERMINATION NOTICE IS IN
*               ARRAY *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY
*               SET.  THE *LTCT* ENTRY FOR THE REQUESTING *UCP* IS
*               POINTED TO BY *LTCENTRY*.
*
*     EXIT      THE REQUEST/NOTICE HAS BEEN PROCESSED.
*
*     MESSAGES  * EXEC ABNORMAL, UCP$DON.*
*
*     NOTE      IT IS ASSUMED THAT THE *LTCENTRY* FOR THE *UCP*
*               IS SET ON ENTRY.  THE REQUEST AREA FOR THE UCP,
*               AS DEFINED IN *COMBCPR*, IS USED AS A COUNTER
*               TO CLEAR THE TEST POINTS IF THE CONDITIONS ARE
*               PROPER.
#
 
#
****  PROC UCP$DON - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORTS PROCESSING #
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC LLRQENQ;                # LOW LEVEL REQUEST QUEUE ENQUEUER
                                     #
        PROC MESSAGE;                # ISSUES DAYFILE MESSAGE #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST
                                       COMPLETION #
        END
 
#
****  PROC UCP$DON - XREF LIST END.
#
 
      DEF OVERRIDE   #3#;            # N.OVERRIDE ON UCP #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMBMAT
*CALL COMBUCR
*CALL COMXCTF
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM I          U;             # COUNTER #
      ITEM LLRQE      U;             # ADDRESS OF THE *LLRQ* FROM
                                       *LLRQENQ* #
      ITEM MATCH      B;             # LOOP CONTROL FLAG #
      ITEM RESTRT     B=FALSE;       # RESTART ALL PROCESSES AT A STEP
                                       POINT #
      ITEM UCPSWAPPED   B;           # UCP WAS SWAPPED OUT #
 
 
 
 
 
#
*     IF THE *UCP* HAS AN *LLRQ* ENTRY, FLAG THE *LLRQ* THAT
*
*     THE *UCP* HAS ABORTED.  IF AN CARTRIDGE IS LOADED, CLEAN-UP
*     WILL UNLOAD THE CARTRIDGE.
#
 
 
      IF LTC$LLRQA[LTCENTRY] NQ 0
      THEN
        BEGIN     # SET ABORT FLAG #
        P<LLRQ> = LTC$LLRQA[LTCENTRY];
        LLR$UCPABT[0] = TRUE;
        IF LTC$CART[LTCENTRY]                      ##
          AND LLR$RS[0] EQ PROCST"COMPLETE"          ##
          AND LTC$RQI[LTCENTRY] NQ REQNAME"RQIDBUG"
        THEN
          BEGIN     # SET UNLOAD OF CARTRIDGE #
          LLR$RQC[0] = REQTYP4"UNLD$CART";
          LLR$DR[0] = 0;     # CLEAR OLD FIELDS #
          LLR$PRCST[0] = 0;
          LLR$PRCNME[0] = REQTYP4"UNLD$CART";
          ADD$LNK(LTC$LLRQA[LTCENTRY],LCHN"LL$READY",0);
          END       # END OF UNLOAD CARTRIDGE #
        END      # END OF *LLRQ* CLEAN UP #
 
#
*     CLOSE OUT THE CONNECTION.
#
 
      LTC$SFSCPA[LTCENTRY] = 0;
 
      IF UCP$STAT[0] NQ 0
      THEN
        BEGIN  # PROCESS THE *UCP* TERMINATION NOTICE #
        LTC$SFUCPA[LTCENTRY] = -1;
        UCPSWAPPED = TRUE;
        REPEAT WHILE UCPSWAPPED
        DO
          BEGIN  # PROCESS SWAPPED *UCP* #
          LTC$SFFC[LTCENTRY] = SFENDT;
          SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
          IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
          THEN
            BEGIN
            LTC$SFFC[LTCENTRY] = SFSWPI;
            SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
            END
 
          ELSE
            BEGIN
            UCPSWAPPED = FALSE;
            END
 
          END  # PROCESS SWAPPED *UCP* #
 
        END  # PROCESS THE *UCP* TERMINATION NOTICE #
 
      ELSE
        BEGIN  # PROCESS THE DISCONNECT REQUEST #
 
#
*       CLEAR THE LONG TERM CONNECT.
#
 
        LTC$SFUCPA[LTCENTRY] = LTC$UCPA[LTCENTRY];
        UCPSWAPPED = TRUE;
        REPEAT WHILE UCPSWAPPED
        DO
          BEGIN  # WAIT FOR CONNECTION TO CLEAR #
          LTC$SFFC[LTCENTRY] = SFCLTC;
          SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
          IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
          THEN
            BEGIN
            LTC$SFFC[LTCENTRY] = SFSWPI;
            SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
            END
 
          ELSE
            BEGIN
            UCPSWAPPED = FALSE;
            END
 
          END  # WAIT FOR CONNECTION TO CLEAR #
 
        IF LTC$SFRC[LTCENTRY] NQ 0
        THEN
          BEGIN
          GOTO SFERR;
          END
 
#
*       RETURN THE OK1 RESPONSE.
#
 
        LTC$RQR[LTCENTRY] = RESPTYP1"OK1";
        UCPSWAPPED = TRUE;
        REPEAT WHILE UCPSWAPPED
        DO
          BEGIN  # WAIT FOR RESPONSE TO BE PROCESSED #
          LTC$SFFC[LTCENTRY] = SFWRIT;
          LTC$SFSCPA[LTCENTRY] = LOC(LTC$RQR[LTCENTRY]);
          LTC$SFUCPA[LTCENTRY] = LTC$UCPA[LTCENTRY] + 2;
          LTC$SFFP[LTCENTRY] = 1;
          SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
          IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
          THEN
            BEGIN
            LTC$SFFC[LTCENTRY] = SFSWPI;
            LTC$SFSCPA[LTCENTRY] = 0;
            LTC$SFFP[LTCENTRY] = 0;
            LTC$SFUCPA[LTCENTRY] = LTC$UCPA[LTCENTRY];
            SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
            END
 
          ELSE
            BEGIN
            UCPSWAPPED = FALSE;
            END
 
          END  # WAIT FOR RESPONSE TO BE PROCESSED #
 
        IF LTC$SFRC[LTCENTRY] NQ 0
        THEN
          BEGIN
          GOTO SFERR;
          END
 
#
*       ACKNOWLEDGE REQUEST COMPLETION.
#
 
        UCPSWAPPED = TRUE;
        LTC$SFUCPA[LTCENTRY] = LTC$UCPA[LTCENTRY];
        LTC$SFSCPA[LTCENTRY] = 0;
        LTC$SFFP[LTCENTRY] = 0;
        REPEAT WHILE UCPSWAPPED
        DO
          BEGIN  # WAIT UNTIL *ENDT* IS PROCESSED #
          LTC$SFFC[LTCENTRY] = SFENDT;
          SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
          IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
          THEN
            BEGIN
            LTC$SFFC[LTCENTRY] = SFSWPI;
            SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
            END
 
          ELSE
            BEGIN
            UCPSWAPPED = FALSE;
            END
 
          END  # WAIT UNTIL *ENDT* IS PROCESSED #
 
        END  # PROCESS THE DISCONNECT REQUEST #
 
SFERR:
      IF LTC$SFRC[LTCENTRY] EQ 0 OR LTC$SFRC[LTCENTRY] EQ SFRCUCPGON
        OR (LTC$SFRC[LTCENTRY] EQ SFRCUCPNET AND UCP$STAT[0] EQ
        OVERRIDE)
      THEN
        BEGIN  # CLEAR THE *LTCT* ENTRY #
        CONIND[LTC$RQI[LTCENTRY]] = FALSE;
        LTC$WORD0[LTCENTRY] = 0;
        LTC$WORD1[LTCENTRY] = 0;
        LTC$WORD2[LTCENTRY] = 0;
        LTC$WORD3[LTCENTRY] = 0;
        RETURN;
        END  # CLEAR THE *LTCT* ENTRY #
 
      ELSE
        BEGIN  # UNEXPECTED *SFCALL* RESPONSE #
        FE$RTN[0] = "UCP$DON.";
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END  # UNEXPECTED *SFCALL* RESPONSE #
 
      END  # UCP$DON #
 
    TERM
PROC UCP$RES;
# TITLE UCP$RES - NOTIFY *UCP* OF REQUEST COMPLETE.                   #
 
      BEGIN  # UCP$RES #
 
#
**    UCP$RES - NOTIFY *UCP* OF REQUEST COMPLETE.
*
*     *UCP$RES* RETURNS THE REQUEST RESPONSE WORD TO THE *UCP*
*     AND THEN NOTIFIES THE *UCP* (AND O/S) THAT THE PROCESSING
*     OF THE REQUEST HAS BEEN COMPLETED.
*
*     PROC UCP$RES
*
*     ENTRY     THE *LTCT* ENTRY POINTED TO BY *LTCENTRY* CONTAINS
*               ALL THE INFORMATION NEEDED.
*
*     EXIT      IF THE *UCP* WAS SWAPPED OUT, AN *SF.SWPI* REQUEST
*               HAS BEEN ISSUED AND THE SWAPPED-UCP FLAG IN THE *LTCT*
*               ENTRY HAS BEEN SET.  OTHERWISE, THE RESPONSE WORD HAS
*               BEEN WRITTEN BACK TO THE *UCP* AND THE *UCP* HAS BEEN
*               NOTIFIED THAT PROCESSING OF ITS LAST REQUEST HAS BEEN
*               COMPLETED.
*
*     MESSAGES  * EXEC ABNORMAL, UCP$RES.*
*
#
 
#
****  PROC UCP$RES - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORTS PROCESSING #
        PROC MESSAGE;                # ISSUES DAYFILE MESSAGE #
        PROC RTIME;                  # GETS TIME SINCE DEADSTART #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        END
 
#
****  PROC UCP$RES - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBUCR
*CALL COMXCTF
*CALL COMXIPR
*CALL COMXLTC
*CALL COMXMSC
 
 
 
 
 
#
*     RETURN REQUEST RESPONSE WORD TO THE *UCP*.
#
 
      LTC$SFUCPA[LTCENTRY] = LTC$UCPA[LTCENTRY] + 2;
      LTC$SFSCPA[LTCENTRY] = LOC(LTC$RQR[LTCENTRY]);
      LTC$SFFP[LTCENTRY] = 1;
      LTC$SFFC[LTCENTRY] = SFWRIT;
      SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
      IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
      THEN
        BEGIN  # SWAPPED *UCP* #
        LTC$UCPSW[LTCENTRY] = TRUE;
        GLBUCPSW = TRUE;
        LTC$SFUCPA[LTCENTRY] = 0;
        LTC$SFSCPA[LTCENTRY] = 0;
        LTC$SFFC[LTCENTRY] = SFSWPI;
        SFCALL(LOC(LTC$WORD0[LTCENTRY]),NRCL);
 
        IF UCP$EXPIR EQ 0
        THEN
          BEGIN
          RTIME(RTIMESTAT[0]);
          UCP$EXPIR = RTIMSECS[0] + UCP$INTV;
          END
 
        RETURN;
        END  # SWAPPED *UCP* #
 
      ELSE
        BEGIN
        IF LTC$SFRC[LTCENTRY] NQ 0 AND LTC$SFRC[LTCENTRY] NQ
          SFRCUCPGON
        THEN                         # UNEXPECTED RESPONSE #
          BEGIN
          FE$RTN[0] = "UCP$RES.";
          MESSAGE(FEMSG[0],UDFL1);
          ABORT;
          END
 
        END
 
#
*     NOTIFY THE *UCP* THAT THE REQUEST IS COMPLETE.
#
 
      LTC$SFUCPA[LTCENTRY] = LTC$UCPA[LTCENTRY];
      LTC$SFSCPA[LTCENTRY] = 0;
      LTC$SFFP[LTCENTRY] = 0;
      LTC$SFFC[LTCENTRY] = SFENDT;
      SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
      IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
      THEN
        BEGIN  # *UCP* SWAPPED #
        LTC$UCPSW[LTCENTRY] = TRUE;
        GLBUCPSW = TRUE;
        LTC$SFUCPA[LTCENTRY] = 0;
        LTC$SFSCPA[LTCENTRY] = 0;
        LTC$SFFC[LTCENTRY] = SFSWPI;
        SFCALL(LOC(LTC$WORD0[LTCENTRY]),NRCL);
 
        IF UCP$EXPIR EQ 0
        THEN
          BEGIN
          RTIME(RTIMESTAT[0]);
          UCP$EXPIR = RTIMSECS[0] + UCP$INTV;
          END
 
        RETURN;
        END  # *UCP* SWAPPED #
 
      ELSE
        BEGIN
        IF LTC$SFRC[LTCENTRY] NQ 0 AND LTC$SFRC[LTCENTRY] NQ
          SFRCUCPGON
        THEN                         # UNEXPECTED RESPONSE #
          BEGIN
          FE$RTN[0] = "UCP$RES.";
          MESSAGE(FEMSG[0],UDFL1);
          ABORT;
          END
 
        END
 
#
*     CLEAR THE REQUEST FROM THE LONG TERM CONNECT TABLE.
#
 
      LTC$UCPSW[LTCENTRY] = FALSE;
      LTC$UCPA[LTCENTRY] = 0;
      LTC$WORD3[LTCENTRY] = 0;
      RETURN;
 
      END  # UCP$RES #
 
    TERM
PROC UCP$RP;
# TITLE UCP$RP - PRELIMINARY PROCESSING OF *UCP* REQUESTS.            #
 
      BEGIN  # UCP$RP #
 
#
**    UCP$RP - PRELIMINARY PROCESSING OF *UCP* REQUESTS.
*
*     *UCP$RP* DOES PRELIMINARY PROCESSING OF *UCP* REQUESTS AND CALLS
*     THE APPROPRIATE MODULES TO DO FURTHER PROCESSING OF THE REQUESTS.
*
*     PROC UCP$RP
*
*     ENTRY     A NEW *UCP* REQUEST HAS BEEN RECEIVED AND IF
*               IT IS A TYPE 4 OR 5 REQUEST, AT LEAST ONE *LLRQ*
*               ENTRY IS AVAILABLE ON THE *LLRQ* FREE SPACE CHAIN.
*
*     EXIT      TYPE 4 OR 5 REQUESTS HAVE BEEN ENQUEUED IN THE
*               *LLRQ* FOR FUTURE PROCESSING. ALL OTHER REQUESTS HAVE
*               BEEN PROCESSED TO COMPLETION.
*
*     NOTES     BEFORE SUBORDINATE ROUTINES ARE CALLED, THE BASE
*               POINTERS FOR *CPR* AND *UCPR* ARE SET AND *LTCENTRY*
*               IS SET TO POINT TO THE *LTCT* ENTRY FOR THE *UCP*.
#
 
#
****  PROC UCP$RP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ALT$RP;                 # PRELIMINARY PROCESSING OF
                                       *SSALTER* REQUESTS #
        PROC KILL$UC;                # ABORT A *UCP* #
        PROC LINK$RP;                # PRELIMINARY LINKAGE PROCESSING #
        PROC NONQ$RP;                # PRELIMINARY PROCESSING OF TYPE 3
                                       REQUEST #
        PROC QUE$RP;                 # QUEUABLE REQUEST PROCESSOR #
        PROC SFCALL;                 # ISSUES *SFCALL* REQUEST #
        PROC TYP2$RP;                # TYPE 2 REQUEST PROCESSOR #
        PROC UCP$DON;                # TERMINATE *UCP* REQUEST PROPERLY
                                     #
        END
 
#
****  PROC UCP$RP - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMBUCR
*CALL COMXCTF
*CALL,COMXJCA
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM I          U;             # LOOP COUNTER #
      ITEM J          U;             # LOOP COUNTER #
      ITEM TESTEXIT   B;             # *FOR* LOOP CONTROL SWITCH #
      ITEM UCPSWAPPED B;             # UCP WAS SWAPPED OUT #
#
*     STATUS SWITCH LIST TO PROCESS TYPE OF REQUEST.
#
 
      SWITCH TYPSW:TYP
             TYPE1:TYP1,
             TYPE2:TYP2,
             TYPE3:TYP3,
             TYPE4:TYP4,
             TYPE5:TYP5;
 
 
 
 
 
      P<LTCT> = LTCTPTR;
 
#
*     THE FOLLOWING *FOR* LOOP IS THE MAIN CONTROL LOOP OF *UCP$RP*.
*     THIS LOOP MAINTAINS CONTROL IN THIS PROCEDURE UNTIL THERE ARE
*     NO MORE *UCP* REQUESTS TO BE STARTED.
#
 
      SLOWFOR I=0 WHILE RA$SSCINLK[0]  ##
        AND CHN$BOC[LCHN"LL$FRSPC"] NQ 0
      DO
        BEGIN  # PROCESS *UCP* REQUEST #
        P<UCPR> = RA$SSCAP[0];
        P<CPR> = RA$SSCAP[0] + 2;
 
#
*     SWITCH TO ALTERNATE *UCP* REQUEST RECEIVING AREA.
#
 
        RA$SSCAP[0] = LOC(UCPPARM[UCPPARMSW]);
        IF UCPPARMSW EQ 0
        THEN
          BEGIN
          UCPPARMSW = 1;
          END
 
        ELSE
          BEGIN
          UCPPARMSW = 0;
          END
 
        RA$SSCINLK[0] = FALSE;
        TESTEXIT = FALSE;
        SFJBSN[0] = UCP$JBSN[0];
        SFFSTA[0] = UCP$FSTA[0];
 
        LTCENTRY = 0;
        FASTFOR J = 1 STEP 1 WHILE J LQ LTCTCNT AND NOT TESTEXIT
        DO
          BEGIN  # *LTCT* SEARCH #
          IF UCP$JBSN[0] EQ LTC$SFJBSN[J]  ##
            AND UCP$FSTA[0] EQ LTC$SFFSTA[J]
          THEN
            BEGIN  # *UCP* HAS AN ENTRY IN THE *LTCT* #
            TESTEXIT = TRUE;
            LTCENTRY = J;
            END  # *UCP* HAS AN ENTRY IN THE *LTCT* #
 
          ELSE
            BEGIN
            TEST J;
            END
 
          END  # *LTCT* SEARCH #
 
        IF UCP$STAT NQ 0
        THEN
          BEGIN  # PROCESS TERMINATION NOTICE FROM O/S #
          IF TESTEXIT
          THEN
            BEGIN  # TERMINATING *UCP* WAS CONNECTED #
            UCP$DON;
            END  # TERMINATING *UCP* WAS CONNECTED #
 
          ELSE
            BEGIN  # TERMINATING UCP NOT CONNECTED #
            SFUCPA[0] = -1;
            UCPSWAPPED = TRUE;
            REPEAT WHILE UCPSWAPPED
            DO
              BEGIN  # WAIT UNTIL *ENDT* IS PROCESSED #
              SFFC[0] = SFENDT;
              SFCALL(SFBLKPTR,RCL);
              IF SFRC[0] EQ SFRCSWPOUT
              THEN
                BEGIN
                SFFC[0] = SFSWPI;
                SFCALL(SFBLKPTR,RCL);
                END
 
              ELSE
                BEGIN
                UCPSWAPPED = FALSE;
                END
 
              END  # WAIT UNTIL *ENDT* IS PROCESSED #
 
            END  # TERMINATING *UCP* NOT CONNECTED #
 
          TEST I;
          END  # PROCESS TERMINATION NOTICE FROM O/S #
 
        ELSE
          BEGIN  # PROCESS REQUEST FROM *UCP* #
          IF NOT TESTEXIT
          THEN
            BEGIN  # NOT IN *LTCT* SO REQUIRE A CONNECT #
            IF CPR$RQT[0] EQ TYP"TYP1"  ##
              AND CPR$RQC[0] EQ REQTYP1"CONNECT"
            THEN
              BEGIN
              LINK$RP;
              END
 
            ELSE
              BEGIN
              KILL$UC(KILLCODE"NOTCON");
              END
 
            TEST I;
            END  # NOT IN *LTCT* SO REQUIRE A CONNECT #
 
          IF LTC$UCPA[LTCENTRY] NQ 0
          THEN
            BEGIN  # PREVIOUS REQUEST NOT PROCESSED YET #
            KILL$UC(KILLCODE"MULREQ");
            TEST I;
            END  # PREVIOUS REQUEST NOT PROCESSED YET #
 
          IF CPR$RQT[0] EQ TYP"TYP0" OR CPR$RQT[0] GQ TYP"TYPLST"
          THEN
            BEGIN  # TYPE CODE OUT OF RANGE #
            KILL$UC(KILLCODE"INVRQT");
            TEST I;
            END  # TYPE CODE OUT OF RANGE #
 
#
*      SET THE LONG TERM CONNECT TABLE ENTRY TO REFLECT THE CURRENT
*      REQUEST.
#
 
          LTC$WORD3[LTCENTRY] = CPR3[0];
          LTC$UCPA[LTCENTRY] = UCP$ADDR[0];
 
#
*     CALL THE APPROPRIATE REQUEST PROCESSOR.
#
 
          GOTO TYPSW[CPR$RQT[0]];
 
TYPE1:
          LINK$RP;
          TEST I;
 
TYPE2:
          TYP2$RP;
          TEST I;
 
TYPE3:
          NONQ$RP;
          TEST I;
 
TYPE4:
          QUE$RP;
          TEST I;
 
TYPE5:
          ALT$RP;
          TEST I;
 
          END  # PROCESS REQUEST FROM *UCP* #
 
        END  # PROCESS *UCP* REQUEST #
 
#
*     RETURN TO THE CALLER WHEN THERE IS NO REQUEST TO
*     PROCESS OR NO REQUEST CAN BE PROCESSED.
#
 
      RETURN;
      END  # UCP$RP #
 
    TERM
PROC UCP$WRI((LLRQADDR2),(WORDCOUNT),(SCPADDR),RSTATUS);
# TITLE UCP$WRI - PASS DATA TO *UCP*.                                 #
 
      BEGIN  # UCP$WRI #
 
#
**    UCP$WRI - PASS DATA TO *UCP*.
*
*     *UCP$WRI* ISSUES AN *SF.WRIT* TO TRANSFER INFORMATION BACK
*     TO THE *UCP*.
*
*     PROC UCP$WRI((LLRQADDR2),(WORDCOUNT),(SCPADDR),RSTATUS)
*
*     ENTRY      LLRQADDR2 = DESTINATION OF DATA IN *UCP*.
*                WORDCOUNT = NUMBER OF WORDS TO BE TRANSFERRED
*                            TO *UCP*.
*                SCPADDR   = SOURCE OF DATA IN THE *SCP*.
*
*     EXIT       RSTATUS   = *SFCALL* ERROR RETURNED TO THE CALLER.
*
*     NOTE       *LTCENTRY* CONTAINS THE ORDINAL OF THE *UCP* LONG
*                TERM CONNECT TABLE ENTRY.
*
#
 
      ITEM LLRQADDR2  U;             # DESTINATION OF DATA IN *UCP* #
      ITEM WORDCOUNT  U;             # NUMBER OF WORDS TO BE
                                       TRANSFERRED #
      ITEM SCPADDR    U;             # SOURCE OF DATA IN *SCP* #
      ITEM RSTATUS    U;             # *SFCALL* ERROR RETURNED TO
                                       CALLER #
 
#
****  PROC UCP$WRI - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        END
 
#
****  PROC UCP$WRI - XREF LIST END.
#
 
 
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBUCR
*CALL COMXLTC
*CALL COMXMSC
 
 
 
 
 
#
*     SET UP AN *SFCALL* REQUEST FOR AN *SF.WRIT* AND ISSUE IT.
#
 
      LTC$SFUCPA[LTCENTRY] = LLRQADDR2;
      LTC$SFSCPA[LTCENTRY] = SCPADDR;
      LTC$SFFP[LTCENTRY] = WORDCOUNT;
      LTC$SFFC[LTCENTRY] = SFWRIT;
      SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
      RSTATUS = LTC$SFRC[LTCENTRY];
      RETURN;
      END  # UCP$WRI #
 
    TERM