Retro1.org codex

PROC ADDCAR; 
# TITLE ADDCAR - ADD CARTRIDGE TO SUB-FAMILY.                         #
 
      BEGIN  # ADDCAR #
 
#
**    ADDCAR - ADD CATRIDGE TO SUB-FAMILY.
*
*     *ADDCAR* UPDATES THE *SMMAP*, *FCT*, AND *AST* (IN THAT
*     ORDER) TO REFLECT THE ADDITION OF THE CARTRIDGE TO THE
*     SUB-FAMILY.
*
*     PROC ADDCAR
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC ADDCAR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC ANLZAST;                # ANALYZE THE *AST* #
        PROC CEXTSC;                 # EXTEND SUBCATALOG #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
        PROC MFLUSH;                 # FLUSH MAP TO FILE #
        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
                                       CALLER #
        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
                                     #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        PROC UASTPRM;                  # UPDATE *AST* AND *PRM* #
        END
 
#
****  PROC ADDCAR - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
 
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS FROM
                                       *ACQ$FCT* #
      ITEM FCTNUM     U;             # NUMBER OF ENTRIES TO ADD #
      ITEM FXS        U;             # INDEX TO AST$AUSF #
      ITEM FXL        U;             # INDEX TO AST$AULF #
      ITEM GRTO       U;             # TOTAL SPACE IN GROUP #
      ITEM GPX        U;             # BEST GROUP #
      ITEM GPS        U;             # BEST ORDINAL #
      ITEM I          U;             # COUNTER #
      ITEM LENCOUNT   I;             # LENGTH COUNT #
      ITEM POS        I;             # POSITION #
      ITEM POINT      U;             # HOLDS POINTER TO SET LINKAGE #
      ITEM START      U;             # BEGINNING LOOP COUNTER #
      ITEM STARTLN    U;             # STARTING LENGTH #
      ITEM SORL       U;             # SMALL OR LARGE FILE LOOP #
      ITEM TERMX      U;             # TERMINATION OF LOOP #
      ITEM WORD       I;             # LINK FIELD WORD #
      ITEM ORD        I;             # *AST* ORDINAL #
 
 
 
 
 
#
*     GET THE MAP ENTRY FOR THE REQUEST.
#
 
      LOANFCTQ(0);
      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
      P<SMUMAP> = LOC(MAPBUFR);
 
#
*     GET THE *AST* AND EXPAND THE CATALOG IF THE REQUIRED
*     *FCT* ENTRY DOES NOT PHYSICALLY EXIST.
#
 
      P<AST> = ASTBADR;
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
      IF (PRM$ENTRC[CPR$CSU[0]] + 15) LS CPR$FCT[0]
      THEN                           # EXPAND TO INCLUDE REQUIRED ENTRY
                                     #
        BEGIN
        FCTNUM = CPR$FCT[0] - PRM$ENTRC[CPR$CSU[0]] - 15;
        CEXTSC(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTNUM,0,ERRSTAT);
        IF ERRSTAT NQ CMASTAT"NOERR"
        THEN
          BEGIN
          GOTO ERRORTN;
          END
 
        END
 
      ORD = CPR$FCT[0];
 
#
*     GET THE *FCTQ* ENTRY.
#
 
 
      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     UPDATE THE MAP ENTRY WITH THE *CSN*.
#
 
      P<FCT> = FCTEADDR + FCTQHL;
      CM$CSND[0] = CPR$CSND[0];
      CM$CCOD[0] = CPR$CCOD[0];
      CM$FCTORD[0] = CPR$FCT[0];
      MPUTENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
#
*     UPDATE THE *FCT* WITH THE *CSN* OF THE CARTRIDGE, AND
*     THE *FAULF* AND THE *FAUSF*.
#
 
      FCT$CSND[0] = CPR$CSND[0];
      FCT$FAUSF[0] = 1;
      FCT$FAULF[0] = CPR$B[0] + 1;
      FCT$CCOD[0] = CPR$CCOD[0];
      FCT$ORD[0] = CPR$FCT[0];
      FCT$FLGS[0] = 0;
      FCT$OCL[0] = 0;
      FCT$OCL1[0] = 0;
      FCT$OCL2[0] = 0;
      FCT$FTST[0] = INFTST;
      FCT$SPAU[0] = INSPAU;
      FCT$PRUS[0] = INPRUS;
      FCT$AVOT[0] = INAVOT;
      FCT$CDP[0] = CPR$B[0] + 1;
      FCT$OCLF[0] = 0;
      FCT$STRD[0] = CPR$STRD[0];
      FCT$STWR[0] = CPR$STWR[0];
      FCT$SRDE[0] = CPR$SRDE[0];
      FCT$SWRE[0] = CPR$SWRE[0];
      FCT$HRDE[0] = CPR$HRDE[0];
      FCT$STDM[0] = CPR$STDM[0];
      FCT$CRLD[0] = CPR$CRLD[0];
      FCT$LDER[0] = CPR$LDER[0];
      FCT$Y[0] = CPR$Y[0];
      FCT$Z[0] = CPR$Z[0];
      IF CPR$B[0] EQ 0
      THEN             # SET FOR END CASE #
        BEGIN
        FCT$FAUSF[0] = 0;
        END
 
      IF CPR$B[0] EQ 1931
      THEN
        BEGIN
        FCT$FAULF[0] = 0;
        END
 
 
#
*     INITIALIZE CARTRIDGE LINK FIELD IN *FCT*.
#
 
      SLOWFOR SORL = 1 STEP 1 UNTIL 2
      DO                             # FOR LARGE AND SMALL FILES #
        BEGIN
        IF SORL EQ 1
        THEN                         # SET LINKAGE FOR LARGE FILES #
          BEGIN
          TERMX = CPR$B[0] + 1;
          POINT = 0;
          START = INAVOT;
          END
 
        IF SORL EQ 2
        THEN                         # SET LINKAGE FOR SMALL FILES #
          BEGIN
          TERMX = 1;
          POINT = 0;
          START = CPR$B[0];
          END
 
        LENCOUNT = 0;
        SLOWFOR I = START STEP -1 UNTIL TERMX
        DO                           # INITIALIZE FIELDS #
          BEGIN
          WORD = FCT$WD(I);
          POS = FCT$WP(I);
          FCT$CLFG(WORD,POS) = 0;
          FCT$LEN(WORD,POS) = LENCOUNT;
          IF (I - INAVVS + LENCOUNT) LQ 0
          THEN
            BEGIN
            FCT$LINK(WORD,POS) = 1;
            END
 
          ELSE
            BEGIN
            FCT$LINK(WORD,POS) = I - INAVVS + LENCOUNT;
            END
 
          IF (SORL EQ 1) AND ((I - INAVVS + LENCOUNT) LS TERMX)
          THEN                       # SHORT VOLUME FOR LARGE FILES #
            BEGIN
            FCT$LINK(WORD,POS) = TERMX;
            END
 
          IF LENCOUNT EQ INAVVS OR I EQ TERMX
          THEN
            BEGIN
            FCT$CAUF(WORD,POS) = 0;
            FCT$LINK(WORD,POS) = POINT;
            POINT = I;
            END
 
          ELSE
            BEGIN
            FCT$CAUF(WORD,POS) = 1;
            END
 
 
          LENCOUNT = LENCOUNT + 1;
          IF LENCOUNT GR INAVVS
          THEN                       # MAXIMUM VOLUME FOUND #
            BEGIN
            LENCOUNT = 0;
            END
 
          END
 
        END
 
 
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     UPDATE *AST* AND PREAMBLE.
#
 
      AST$1ST[ORD] = 0;
      AST$2ND[ORD] = 0;
      AST$AULF[ORD] = INAVOT - CPR$B[0];
      AST$AUSF[ORD] = CPR$B[0];
      AST$GR[ORD] = CPR$GR[0];
      AST$GRT[ORD] = CPR$GRT[0];
      AST$AAF[ORD] = TRUE;
      AST$NOCLF[ORD] = FALSE;
 
 
      AST$STAT[ORD] = ASTENSTAT"ASS$CART";
      ANLZAST(CPR$CSU[0],-1,-1,FXS,FXL,GPX,GPS);
      PRM$MXAUS[CPR$CSU[0]] = AST$AUSF[FXS];
      PRM$MXAUL[CPR$CSU[0]] = AST$AULF[FXL];
      PRM$MXAUGR[CPR$CSU[0]] = GPS;
 
      UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
 
#
*     PASS THE REQUEST STATUS TO THE *UCP* AND RETURN TO CALLER.
#
 
ERRORTN:
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      LOANFCTQ(-1);
      MFLUSH;
      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
      UCP$RES;
      RETURN;
 
      END  # ADDCAR #
 
    TERM
PROC ADDCSU;
# TITLE ADDCSU - ADD *SM* SUB-CATALOG.                                #
 
      BEGIN  # ADDCSU #
 
#
**    ADDCSU - ADD *SM* SUB-CATALOG.
*
*     *ADDCSU* ADDS A SUB-CATALOG TO THE CATALOG SO AS TO
*     ACCOMADATE AN ADDITIONAL *SM*.
*
*     PROC ADDCSU
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = SUB$CAT$EX      SUBCATALOG ALREADY EXISTS
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC ADDCSU - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CADDSC;                 # ADD SUBCATALOG #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC ADDCSU - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXLTC
*CALL COMXMSC
 
 
      ITEM FCTNUM     U;             # *FCT* ENTRY INCREMENT #
      ITEM I          U;             # COUNTER #
      ITEM K          U;             # COUNTER #
 
 
 
 
 
#
*     CREATE A SUB-CATALOG FOR THE *SM*.
#
 
      FCTNUM = NUMFCT;
      CADDSC(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTNUM,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     GET THE AVAILABLE STREAM TABLE (*AST*).
#
 
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
        LTC$RQR[LTCENTRY] = ERRSTAT;
        UCP$RES;
        RETURN;
        END
 
#
*      SET STATUS OF ENTRIES TO UNASSIGNED CUBE.
#
 
      P<AST> = ASTBADR;
      SLOWFOR I = 16 STEP 1 UNTIL (MAXORD + 15)
      DO                             # SET *AST* STATUS #
        BEGIN
        AST$STAT[I] = ASTENSTAT"UNASS$CUB";
        END
 
      AST$NAME[15] = "*AST* ";
      AST$SM[15] = CPR$CSU[0];
 
#
*     REWRITE *AST*.
#
 
      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
 
#
*     SEND RESPONSE TO *UCP* AND RETURN TO CALLER.
#
 
ERRORTN:
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
      UCP$RES;
      RETURN;
 
      END  # ADDCSU #
 
    TERM
PROC ADDCUBE;
# TITLE ADDCUBE - ASSIGN CUBE TO SUB-FAMILY.                          #
 
      BEGIN  # ADDCUBE #
 
#
**    ADDCUBE - ASSIGN CUBE TO SUB-FAMILY.
*
*     *ADDCUBE* UPDATES THE *SMMAP*, *FCT*, AND *AST*
*     TO REFLECT THE ASSIGNMENT OF THE CUBICLE TO THE SUB-FAMILY.
*
*     PROC ADDCUBE
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC ADDCUBE - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC CEXTSC;                 # EXTEND SUBCATALOG #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC MFLUSH;                 # FLUSH MAP TO FILE #
        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
                                       CALLER #
        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
                                     #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC ADDCUBE - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
 
      ITEM FCTNUM     U;             # *FCT* ENTRY INCREMENT #
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS RETURNED
                                       FROM *ACQ$FCT* #
      ITEM ORD        U;             # ORDINAL OF *AST*/*FCT* ENTRY #
      ITEM I          U;             # COUNTER #
      ITEM K          U;             # COUNTER #
 
 
 
 
 
#
*     GET ALLOCATION SUMMARY TABLE FOR THE FAMILY.
#
 
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
        LTC$RQR[LTCENTRY] = ERRSTAT;
        UCP$RES;
        RETURN;
        END
 
      FCTNUM = NUMFCT;
 
 
#
*     GET THE MAP ENTRY FOR THE *XY* COORDINATES OF THE REQUEST.
#
 
      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
#
*     UPDATE THE MAP AND *FCT* TO REFLECT A CUBE BEING ASSIGNED
*     TO A FAMILY.
#
 
      P<FCT> = FCTEADDR + FCTQHL;
      P<SMUMAP> = LOC(MAPBUFR);
      CM$FMLYNM[0] = CPR$FAM[0];
      CM$SUB[0] = CPR$SUB[0];
      CM$CODE[0] = CUBSTAT"SUBFAM";
      CM$CSND[0] = "        ";
      MPUTENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
 
 
 
#
*     RETURN THE RESPONSE TO THE UCP, REWRITE THE ALLOCATION
*     SUMMARY TABLE, AND RETURN TO THE CALLER.
#
 
ERRORTN:
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      MFLUSH;
      UCP$RES;
      RETURN;
 
      END  # ADDCUBE #
 
    TERM
PROC CONVER3((REQTYPE),(REQCODE),(MCSTAT),RSTATUS);
# TITLE CONVER3 - CONVERT MAP/CATALOG ERRORS TO *UCP* ERRORS.         #
 
      BEGIN  # CONVER3 #
 
#
**    CONVER3 - CONVERT MAP/CATALOG ERRORS TO *UCP* ERRORS.
*
*     PROC CONVER3((REQTYPE),(REQCODE),(MCSTAT),RSTATUS)
*
*     ENTRY     REQTYPE - REQUEST TYPE (TYPE 3).
*               REQCODE - REQUEST CODE (VALID TYPE 3 CODE).
*               MCSTAT  - MAP/CATALOG ERROR CODE.
*
*     EXIT      RSTATUS - *UCP* ERROR CODE.
*
*     MESSAGES  * EXEC ABNORMAL, CONVER3. *
#
 
      ITEM REQTYPE    U;             # REQUEST TYPE #
      ITEM REQCODE    U;             # REQUEST CODE #
      ITEM MCSTAT     U;             # MAP/CATALOG ERROR CODE #
      ITEM RSTATUS    U;             # *UCP* ERROR CODE RETURNED #
 
#
****  PROC CONVER3 - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        END
 
#
****  PROC CONVER3 - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMS
*CALL COMBCPR
*CALL,COMXMSC
 
      ARRAY ERRMAP [CMASTAT"NOERR":CMASTAT"STATLAST"] P(1);
        BEGIN
        ITEM ERR$RCV    U(00,00,60)   =  [  # RESPONSE CODE VALIDITY #
        O"37777000000000000000",     # NO ERROR #
        O"37775000000000000000",     # FILE INTERLOCKED #
        O"00000000000000000000",     # FILE ALREADY OPEN #
        O"37774000000000000000",     # FILE NOT OPEN #
        O"00000000000000000000",     # FILE NOT OPEN IN *MODIFY* MODE #
        O"00000000000000000000",     # FILE ALREADY INITIALIZED #
        O"04000000000000000000",     # SUBCATALOG ALREADY EXISTS #
        O"37674000000000000000",     # NO SUCH SUBCATALOG #
        O"37775000000000000000",     # *CIO* ERROR #
        O"33370000000000000000",     # ORDINAL OUT OF RANGE #
        O"00001000000000000000",     # MAP/CATALOG *ATTACH* ERROR #
        O"00000000000000000000",     # MAP/CATALOG *DEFINE* ERROR #
        O"24400000000000000000",     # TEMPORARY FILE *DEFINE* ERROR #
        O"24400000000000000000",     # TEMPORARY FILE *ATTACH* ERROR #
        O"24400000000000000000",     # TEMPORARY FILE *PURGE* ERROR #
        O"24400000000000000000",     # TEMPORARY FILE *RENAME* ERROR #
        O"00000000000000000000",     # *OCT* FULL #
        ];
        END
 
      SWITCH CONV$LIST:CMASTAT       # CONVERSION LIST #
                 CONV0:NOERR,        # NO ERROR #
                 CONV1:INTLK,        # FILE INTERLOCKED #
                 CONV2:NOTOPEN,      # FILE NOT OPENED #
                 CONV4:SCEXISTS,     # SUBCATALOG ALREADY EXISTS #
                 CONV5:NOSUBCAT,     # NO SUCH SUBCATALOG #
                 CONV6:CIOERR,       # *CIO* ERROR #
                 CONV8:ORDERR,       # ORDINAL OUT OF RANGE #
                 CONV6:ATTERR,       # MAP/CATALOG *ATTACH* ERROR #
                 CONV6:DEFERR,       # MAP/CATALOG *DEFINE* ERROR #
                 CONV6:TDEFERR,      # TEMPORARY FILE *DEFINE* ERROR #
                 CONV6:TATTERR,      # TEMPORARY FILE *ATTACH* ERROR #
                 CONV6:TPRGERR,      # TEMPORARY FILE *PURGE* ERROR #
                 CONV6:TRNMERR;      # TEMPORARY FILE *RENAME* ERROR #
                                               CONTROL EJECT;
 
#
*     TEST FOR AN INVALID ERROR CODE.
#
 
      IF REQTYPE NQ TYP"TYP3"        ##
        OR MCSTAT GQ CMASTAT"STATLAST"  ##
        OR REQCODE GQ REQTYP3"LSTREQTYP3"  ##
        OR B<REQCODE,1>ERR$RCV[MCSTAT] EQ 0
      THEN
        BEGIN
        FE$RTN[0] = "CONVER3.";
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END
 
#
*     SIMULATED CASE STATEMENT TO CONVERT THE MAP/CATALOG ERROR CODE
*     TO THE APPROPRIATE *UCP* ERROR CODE.
#
 
      GOTO CONV$LIST[MCSTAT];
 
CONV0:                               # NO ERROR #
      RSTATUS = RESPTYP3"OK3";
      RETURN;
 
CONV1:                               # CATALOG/MAP INTERLOCKED #
      RSTATUS = RESPTYP3"C$M$INTLCK";
      RETURN;
 
CONV2:                               # CATALOG/MAP NOT OPEN #
      RSTATUS = RESPTYP3"C$M$NOPEN";
      RETURN;
 
CONV4:                               # SUBCATALOG ALREADY EXISTS #
      RSTATUS = RESPTYP3"SUB$CAT$EX";
      RETURN;
 
CONV5:                               # NO SUCH SUBCATALOG #
      RSTATUS = RESPTYP3"NO$SUB$CAT";
      RETURN;
 
CONV6:                               # PERMANENT FILE PROBLEM #
      RSTATUS = RESPTYP3"PF$PROB";
      RETURN;
 
CONV8:                               # ORDINAL OUT OF RANGE #
      RSTATUS = RESPTYP3"ILLEG$ORD";
      RETURN;
 
#
*     END SIMULATED CASE STATEMENT TO CONVERT THE MAP/CATALOG
*     ERROR CODE TO THE APPROPRIATE *UCP* ERROR CODE.
#
 
      END  # CONVER3 #
 
    TERM
PROC GETPD;
# TITLE GETPD - RETURNS LAST *PRG$ORPH* DATE AND TIME.                #
 
      BEGIN  # GETPD #
 
#
**    GETPD - RETURNS LAST *PRG$ORPH* DATE AND TIME.
*     *GETPD* RETURNS THE DATE AND TIME AT WHICH THE LAST
*     *PRG$ORPH* REQUEST FROM *SSVAL* WAS PROCESSED.
*     THE DATE AND TIME IS RETURNED VIA THE *CSN* FIELD
*     OF THE RESPONSE WORD.
*
*     PROC GETPD
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = RESUB$REQ       RESUBMIT REQUEST
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
#
 
#
****  PROC GETPD - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CGETPD;                 # GET PURGE DATE #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC GETPD - XREF LIST END.
#
 
 
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMXLTC
 
      ITEM LASTPRG    U;             # LAST PURGE DATE AND TIME #
 
 
 
 
 
      CGETPD(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],LASTPRG,0,ERRSTAT);
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      LTC$DATE[LTCENTRY] = LASTPRG;
      UCP$RES;
      RETURN;
 
      END  # GETPD #
 
    TERM
PROC LOANFCTQ(ACTION);
 
# TITLE LOANFCTQ - ADD OR RECLAIM AN *FCTQ* ENTRY FOR *UCP* PROCS.    #
 
      BEGIN  # LOANFCTQ #
 
#
**    LOANFCTQ - ADD OR RECLAIM AN *FCTQ* ENTRY FOR *UCP* PROCESSING.
*
*     THIS PROCEDURE PROVIDES AN *FCTQ* ENTRY WHICH CAN BE USED
*     BY THE CALLING *UCP* REQUEST PROCESSOR IN THE EVENT THE NORMAL
*     *FCTQ* ENTRIES ARE IN USE BY *HLRQ* PROCESSING.  THE CALLING
*     PROCEDURES RULES ARE TO CALL *LOANFCTQ* PRIOR TO THE *ACQ$FCT*
*     CALL TO ENSURE AN AVAILABLE *FCTQ* ENTRY.  AFTER CALLING
*     *RLS$FCT*, *LOANFCTQ* IS AGAIN CALLED TO TAKE THE TEMPORARY
*     *FCTQ* ENTRY OUT OF THE *FCTQ* FREE SPACE CHAIN.
*
*     PROC LOANFCTQ(ACTION)
*
*     ENTRY     ACTION = 0, AN *FCTQ* ENTRY TO BE MADE AVAILABLE.
*                      = X, THE *FCTQ* ENTRY IS TO BE RECLAIMED.
*
*     EXIT      THE *FCTQ* FREE SPACE CHAIN IS PROPERLY ADJUSTED.
#
 
      ITEM ACTION     U;             # REQUESTED PROCESSING ACTION #
 
#
****  PROC LOANFCTQ - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO A CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM A CHAIN #
        PROC ZFILL;                  # ZERO FILL AN ARRAY #
        END
 
#
****  PROC LOANFCTQ - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
 
*CALL,COMBFAS
*CALL,COMBCHN
*CALL,COMBMCT
*CALL,COMXFCQ
 
      ARRAY LOANERFCTQ [0:0] S(FCTQHL);;  # *FCTQ* HEADER #
      ARRAY LOANERFCT [0:0] S(FCTENTL);;  # *FCT* ENTRY #
 
 
      IF ACTION EQ 0
      THEN
        BEGIN
        ZFILL(LOANERFCTQ[0],FCTQHL+FCTENTL);
        ADD$LNK(LOC(LOANERFCTQ[0]),LCHN"FCT$FRSPC",0);
        END
 
      ELSE
        BEGIN
        DEL$LNK(LOC(LOANERFCTQ[0]),LCHN"FCT$FRSPC",0);
        END
 
      RETURN;
      END  # LOANFCTQ #
 
    TERM
PROC MAPRCLM;
# TITLE MAPRCLM - RE-ATTACHES DESIGNATED MAP FILE.                    #
 
      BEGIN  # MAPRCLM #
 
#
**    MAPRCLM - RE-ATTACHES DESIGNATED MAP FILE.
*
*     *MAPRCLM* RE-ATTACHES THE DESIGNATED MAP FILE.
*
*     PROC MAPRCLM
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = PF$PROB         PERMANENT FILE PROBLEM
*
*     MESSAGES  * EXEC ABNORMAL, MAPRCLM.*
#
 
#
****  PROC MAPRCLM - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC MRCLMLK;                # RECLAIM MAP INTERLOCK. #
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST
                                       COMPLETE. #
        END
 
#
****  PROC MAPRCLM - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBPFP
*CALL COMXLTC
*CALL COMXMSC
 
 
 
 
 
      PFP$WRD0[0] = 0;               # SET FAMILY AND USER INDEX #
      PFP$FG1[0] = TRUE;
      PFP$FG4[0] = TRUE;
      PFP$FAM[0] = DEF$FAM;
      PFP$UI[0] = DEF$UI;
      SETPFP(PFP);
      IF PFP$STAT[0] NQ 0
      THEN                           # FAMILY NOT FOUND #
        BEGIN
        FE$RTN[0] = "MAPRCLM.";
        MESSAGE(FEMSG[0],UDFL1);     # ISSUE ERROR MESSAGE #
        ABORT;
        END
 
      MRCLMLK(CPR$CSU[0],ERRSTAT);
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      UCP$RES;
      RETURN;
 
      END  # MAPRCLM #
 
    TERM
PROC MAPRELS;
# TITLE MAPRELS - RETURNS THE DESIGNATED MAP FILE.                    #
 
      BEGIN  # MAPRELS #
 
#
**    MAPRELS - RETURNS THE DESIGNATED MAP FILE.
*
*     *MAPRELS* RETURNS THE DESIGNATED MAP FILE.
*
*     PROC MAPRELS
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
#
 
#
****  PROC MAPRELS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC MRELSLK;                # RETURN A MAP FILE #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC MAPRELS - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMXLTC
 
 
 
 
 
      LTC$RQR[LTCENTRY] = RESPTYP3"OK3";
      MRELSLK(CPR$CSU[0]);
      UCP$RES;
      RETURN;
 
      END  # MAPRELS #
 
    TERM
PROC NONQ$RP;
# TITLE NONQ$RP - PRELIMINARY PROCESSING OF TYPE 3 REQUEST.           #
 
      BEGIN  # NONQ$RP #
 
 
#
**    NONQ$RP - PRELIMINARY PROCESSING OF TYPE 3 REQUEST.
*
*     *NONQ$RP DOES PRELIMINARY PROCESSING OF TYPE 3 *UCP* REQUESTS
*     AND CALLS THE PROPER MODULE TO DO THE DETAILED PROCESSING OF
*     THE REQUESTS.
*
*     PROC NONQ$RP
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
#
 
#
****  PROC NONQ$RP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC KILL$UC;                # ABORT A *UCP* #
        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS #
        END
 
#
****  PROC NONQ$RP - XREF LIST END.
#
 
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBOVL
*CALL COMBUCR
*CALL COMXMSC
 
#
*     SWITCH LIST TO PROCESS THE TYPE 3 REQUESTS.
#
 
      SWITCH TYP3SW:REQTYP3
           ADDCUBEL:ADD$CUBE,
           ADDCARTL:ADD$CART,
            ADDCSUL:ADD$CSU,
            RMVCSUL:RMV$CSU,
           RMVCUBEL:RMV$CUBE,
           RMVCARTL:RMV$CART,
            UPDCATL:UPD$CAT,
            UPDMAPL:UPD$MAP,
          RELSETUPL:REL$SETUP,
          PURGFRAGL:PURG$FRAG,
           PURGFCTL:PURG$FCT,
         GTPRGDATEL:GT$PRGDATE,
           RELMPLKL:REL$MPLK,
           RECMPLKL:REC$MPLK;
 
 
 
 
 
#
*     REQUEST CODE HAS TO BE VALID.
#
 
      IF CPR$RQC[0] EQ REQTYP3"RES3"  ##
        OR CPR$RQC[0] GQ REQTYP3"LSTREQTYP3"
      THEN
        BEGIN
        KILL$UC(KILLCODE"INVRQC");
        RETURN;
        END
 
#
*     CALL THE APPROPRIATE PROCESSOR AND THEN RETURN TO THE CALLER.
#
 
      GOTO TYP3SW[CPR$RQC[0]];
 
ADDCUBEL:
      SSOVL(LADDCUBE,0);
      RETURN;
 
ADDCARTL:
      SSOVL(LADDCAR,0);
      RETURN;
 
 
ADDCSUL:
      SSOVL(LADDCSU,0);
      RETURN;
 
RMVCUBEL:
      SSOVL(LRMVCUBE,0);
      RETURN;
 
RMVCARTL:
      SSOVL(LRMVCAR,0);
      RETURN;
 
RMVCSUL:
      SSOVL(LRMVCSU,0);
      RETURN;
 
UPDCATL:
      SSOVL(LUPDCAT,0);
      RETURN;
 
UPDMAPL:
      SSOVL(LUPDMAP,0);
      RETURN;
 
PURGFRAGL:
      SSOVL(LRESETUP,0);
      RETURN;
 
RELSETUPL:
      SSOVL(LRESETUP,0);
      RETURN;
 
PURGFCTL:
      SSOVL(LPURGFCT,0);
      RETURN;
 
GTPRGDATEL:
      SSOVL(LGETPD,0);
      RETURN;
 
RELMPLKL:
      SSOVL(LMAPRELS,0);
      RETURN;
 
RECMPLKL:
      SSOVL(LMAPRCLM,0);
      RETURN;
 
      END  # NONQ$RP #
 
    TERM
PROC PURGFCT;
# TITLE PURGFCT - DELETE *FCT* ENTRY FROM USE.                        #
 
      BEGIN  # PURGFCT #
 
#
**    PURGFCT - DELETE *FCT* ENTRY FROM USE.
*
*     *PURGFCT* DELETES AN *FCT* ENTRY AND UPDATES THE *AST*
*     AND PREAMBLE.
*     *FCT* ENTRY.
*
*     PROC PURGFCT
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC PURGFCT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC ANLZAST;                # ANALYZE *AST* #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CNTFS;                  # COUNT FREE STREAMS #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        PROC UPDAST;                 # UPDATE THE *AST* #
        PROC ZFILL;                  # ZERO FILLS A BUFFER #
        END
 
#
****  PROC PURGFCT - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
      ITEM FROMCHAIN  U;             # CHAIN TO MOVE *FCT* ENTRY FROM #
      ITEM FXL        I;             # INDEX FOR LARGE *AU*S #
      ITEM FXS        I;             # INDEX FOR SMALL *AU*S #
      ITEM GPS        I;             # BEST GROUP #
      ITEM GPX        I;             # BEST ORDINAL #
      ITEM I          U;             # COUNTER #
                                               CONTROL EJECT;
 
#
*     GET THE *FCTQ* ENTRY FOR THE REQUEST.
#
 
      LOANFCTQ(0);
 
      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     GET THE ALLOCATION SUMMARY TABLE.
#
 
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
      P<FCT> = FCTEADDR + FCTQHL;
 
#
*     SET *AST* STATUS TO UNASSIGNED CUBE, AND UPDATE PREAMBLE.
#
 
      P<AST> = ASTBADR;
      ZFILL(AST[CPR$FCT[0]],2);
      AST$STAT[CPR$CSU[0]] = ASTENSTAT"UNASS$CUB";
 
      ANLZAST(CPR$CSU[0],-1,-1,FXS,FXL,GPX,GPS);
      PRM$MXAUS[CPR$CSU[0]] = AST$AUSF[FXS];
      PRM$MXAUL[CPR$CSU[0]] = AST$AULF[FXL];
      PRM$MXAUGR[CPR$CSU[0]] = GPS;
      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      ZFILL(FCT,FCTENTL);
 
ERRORTN:
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      LOANFCTQ(-1);
      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
      UCP$RES;
      RETURN;
 
      END  # PURGFCT #
 
    TERM
PROC PURGCHN;
# TITLE PURGCHN - PURGE FRAGMENTED AND ORPHAN CHAINS.                 #
 
      BEGIN  # PURGCHN #
 
#
**    PURGCHN - PURGE FRAGMENTED AND ORPHAN CHAINS.
*
*     *PURGCHN MAKES THE SPACE OCCUPIED BY A FILE FRAGMENT OR AN
*     ORPHAN FILE AVAILABLE FOR RE-USE. THIS PROCEDURE PROCESSES
*     BOTH PURGE FRAGMENT AND PURGE ORPHAN REQUESTS.
*
*     PROC PURGCHN
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
*                    = NFROZ$FRAG      NON FROZEN FRAGMENT.
*
*     MESSAGES  * EXEC ABNORMAL, PURGCHN. *
*
#
 
#
****  PROC PURGCHN - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CPUTPD;                 # PUT PURGE DATE #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC OCTSRCH;                # SEARCHES *OCT* FOR ENTRY #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC RLSVOL;                 # RELEASE VOLUME #
        PROC UASTPRM;                # UPDATE AST AND PREAMBLE #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        PROC UPDAST;                 # UPDATE THE *AST* #
        END
 
#
****  PROC PURGCHN - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
      ITEM FCTERR     B;             # SWITCH USED TO INDICATE MAIN
                                       LOOP WAS TERMINATED BECAUSE OF
                                       AN ERROR #
      ITEM FCTNBR     U;             # *FCT* TO FIND #
      ITEM FCTAU      U;             # *AU* TO BE RELEASED #
      ITEM FROZERR    B;             # NON-FROZEN-FRAGMENT ERROR FOUND
                                       WHICH DOES NOT REQUIRE
                                       CONVERSION #
      ITEM FRSTTIME   B;             # FIRST TIME SWITCH #
      ITEM GRX        ;              # GROUP #
      ITEM I          I;             # COUNTER #
      ITEM NEWFCT     U;             # USED TO HOLD THE
                                       OFF-CARTRIDGE-LINK *FCT* #
      ITEM NEWAU      U;             # NEXT *AU* TO RELEASE #
      ITEM ORD        I;             # *OCT* ORDINAL #
      ITEM PRGDONE    B;             # SWITCH TO CONTROL MAIN LOOP #
      ITEM RLSCNTL    B;             # SWITCH TO CONTROL FOLLOWING A
                                       STREAM PATH WITHIN AN *FCT* #
 
 
 
 
 
#
*     GET THE ALLOCATION SUMMARY TABLE.
#
 
      LOANFCTQ(0);
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     GET THE MAXIMUM *FCT* ORDINAL.
#
 
      OCTSRCH(CPR$FAM[0],CPR$SUB[0],ORD,0,ERRSTAT);
 
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
      P<PREAMBLE> = OCT$PRMA[ORD];
 
      IF PRM$SCW1[CPR$CSU[0]] EQ 0
      THEN
        BEGIN
        ERRSTAT = CMASTAT"NOSUBCAT";
        GOTO ERRORTN;
        END
 
#
*     ESTABLISH THE NECESSARY BEGINNING CONTROLS FOR THE MAIN LOOP.
#
 
      FRSTTIME = TRUE;
      PRGDONE = FALSE;
      FCTNBR = CPR$FCT[0];
      GRX = FCTNBR/MAXGRT;
      FCTAU = CPR$AU[0];
      P<AST> = ASTBADR;
      FCTERR = FALSE;
      FROZERR = FALSE;
 
#
*     GET THE *FCT* ENTRY.  FOLLOW THE AU PATH WITHIN THE *FCT*
*     RELEASING AU-S.  THE AU PATH WILL TERMINATE WHEN
*     EITHER A NON-BUSY AU OR THE LAST AU (AS DEFINED
*     BY CHAIN CONTROL) IS FOUND.  WHENEVER THE AU PATH CROSSES
*     *FCT*-S (DETERMINED BY THE OFF-CARTRIDGE-LINK CONTROL), THE
*     AVAILABLE AU TABLE IS UPDATED TO REFLECT THE CURRENT
*     CONDITION OF THE *FCT* AND THE MAIN LOOP IS REPEATED.
*     IF A AU PATH DOES NOT CROSS *FCT* BOUNDARIES,
*     THE MAIN LOOP WILL ONLY BE EXECUTED ONCE.
#
 
      REPEAT WHILE NOT PRGDONE
      DO
        BEGIN  # MAIN LOOP #
 
#
*     GET THE *FCT* ENTRY.
#
 
        ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
          FCTNBR,FCTEADDR,0,ERRSTAT);
        IF ERRSTAT NQ CMASTAT"NOERR"
        THEN
          BEGIN
          FCTERR = TRUE;
          PRGDONE = TRUE;
          TEST DUMMY;
          END
 
        P<FCT> = FCTEADDR + FCTQHL;
 
#
*     FRAGMENTED AU-S MUST HAVE THE FIRST AU FROZEN.
#
 
        IF FRSTTIME AND CPR$RQC[0] EQ REQTYP3"PURG$FRAG"
        THEN
          BEGIN
          FRSTTIME = FALSE;
            IF FCT$FRCF(FCT$WD(CPR$AU[0]),FCT$WP(CPR$AU[0])) EQ OFF
          THEN
            BEGIN
            ERRSTAT = RESPTYP3"NFROZ$FRAG";
            FCTERR = TRUE;
            PRGDONE = TRUE;
            FROZERR = TRUE;
            TEST DUMMY;
            END
 
          END
 
#
*     SEARCH THE VOLUME CHAIN RELEASING VOLUMES.
#
 
 
        RLSCNTL = FALSE;
 
        SLOWFOR I = 0 WHILE NOT RLSCNTL
        DO
          BEGIN  # RELEASE LOOP #
 
#
*     A NONBUSY AU ENDS THE AU PATH SEARCH.
#
 
          IF FCT$FBF(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ OFF
          THEN
            BEGIN
            RLSCNTL = TRUE;
            PRGDONE = TRUE;
            TEST I;
            END
 
          RLSCNTL =                  ##
            FCT$LINK(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 0  ##
            OR FCT$CC(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ CHAINCON"LAST"##
            OR FCT$CC(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ CHAINCON"ONLY";
 
 
#
*     DETERMINE WHETHER THE AU PATH CROSSES *FCT* BOUNDARIES.
*     IF IT DOES, PICK UP THE NEW *FCT* TO USE.
#
 
          IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) NQ 0
          THEN
            BEGIN  # OFF-CARTRIDGE LINK #
            RLSCNTL = TRUE;
            IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 1
            THEN
              BEGIN
              B<0,1>FCT$OCLF[0] = 0;
              NEWFCT = GRX * 16 + FCT$OCL[0];
              END
 
            ELSE
              BEGIN
              IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 2
              THEN
                BEGIN
                B<1,1>FCT$OCLF[0] = 0;
                NEWFCT = GRX * 16 + FCT$OCL1[0];
                END
 
              ELSE
                BEGIN
                B<2,1>FCT$OCLF[0] = 0;
                NEWFCT = GRX * 16 + FCT$OCL2[0];
                END
 
              END
 
            IF NEWFCT GR (PRM$ENTRC[CPR$CSU[0]] + 15) OR NEWFCT LS 16
              THEN                   # *FCT* OUT OF RANGE #
              BEGIN
              RLSCNTL = TRUE;
              PRGDONE = TRUE;
              GOTO EXIT$RLS;
              END
 
            END  # OFF-CARTRIDGE LINK #
 
 
          IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 0  ##
            AND RLSCNTL
          THEN
            BEGIN
            PRGDONE = TRUE;
            END
 
 
 
          NEWAU = FCT$LINK(FCT$WD(FCTAU),FCT$WP(FCTAU));
 
EXIT$RLS:                            # CLEAR AU DETAIL #
          RLSVOL(0,FCTEADDR,FCTAU,   ##
            FCT$LEN(FCT$WD(FCTAU),FCT$WP(FCTAU))+1);
          FCTAU = NEWAU;
          END  # RELEASE LOOP #
 
 
#
*     UPDATE *AST* AND PREAMBLE FOR TO MATCH *FCT*.
#
 
        UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
 
 
#
*     UPDATE THE *FCT* ENTRY.
#
 
        RLS$FCT(FCTEADDR,0,ERRSTAT);
        FCTNBR = NEWFCT;
        END  # MAIN LOOP #
 
#
*     IF ANY ERRORS IN MAIN LOOP, PROCESSING DOES NOT CONTINUE.
#
 
      IF FCTERR
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     UPDATE THE DATE AND TIME ON THE PURGE ORPHAN REQUEST.
#
 
      IF CPR$RQC[0] NQ REQTYP3"PURG$FRAG"
      THEN
        BEGIN
        CPUTPD(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],0,ERRSTAT);
        END
 
ERRORTN:
      IF NOT FROZERR
      THEN
        BEGIN
        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
        END
 
      LTC$RQR[LTCENTRY] = ERRSTAT;
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      LOANFCTQ(-1);
      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
      IF CPR$RQC[0] EQ REQTYP3"PURG$FRAG"
      THEN                             # SSDEBUG CALL ENDS HERE #
        BEGIN
        UCP$RES;
        END
 
      RETURN;
 
 
      END
 
    TERM
PROC RESETUP;
#TITLE RESETUP - CATALOG RELEASE PROCESSING AND SETUP.                #
 
      BEGIN # RESETUP #
 
#
**    RESETUP - CATALOG RELEASE PROCESSING AND SETUP.
*
*     * RESETUP PROCESSES THE UCP REQUEST WHICH RELEASES *SFMCAT*
*     SPACE FOR A LIST OF FILES ON FILE *RELCOM* WHICH IS SENT
*     BY *SSVAL*.
*
*     PROC RESETUP
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
*               *CPR*. THE *LTCT* ENTRY FOR THE REQUESTING UCP IS
*               POINTED TO BY *LTCENTRY*. THIS REQUEST INDICATES
*               THAT A LIST OF FILES TO BE RELEASED IS AVAILABLE ON
*               FILE *RELCOM*.
*
*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST. THE CHAINS IN THE LIST HAVE BEEN
*               PUT ON THE FREE SPACE CHAIN.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
*
*     MESSAGES  * EXEC ABNORMAL, RESETUP. *
*
#
 
#
****  PROC RESETUP LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC BZFILL;                 # ZERO BLANK FILL #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CPUTPD;                 # PUT PURGE DATE #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC PFD;                    # PERMANENT FILE ACCESS #
        PROC PURGCHN;                # PUT CHAIN ON FREE SPACE #
        PROC READ;                   # READ *CIO* BUFFER #
        PROC READW;                  # READ TO WORKING BUFFER #
        PROC RETERN;                 # RETURN LOCAL FILE #
        PROC SETPFP;                 # SET PF PARAMETERS #
        PROC UASTPRM;                # UPDATE AST AND PREAMBLE #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST
                                       COMPLETE #
        PROC ZSETFET;                # SET UP FILE *FET* #
        END
 
#
****  PROC PURGCHN - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCPR
*CALL COMBMCT
*CALL COMBPFP
*CALL COMBPFS
*CALL COMSPFM
*CALL COMTVLD
*CALL COMTVLF
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM I          I;             # COUNTER #
      ITEM STATW      I;             # ERROR STATUS #
      ITEM SAVEPT     I;             # SAVE POINTER #
 
      ARRAY CPRARRAY [0:0] S(CPRLEN);;
 
 
#
*     PROCESS SSDEBUG CALL, *PURGE FRAGMENT*.
#
 
      IF CPR$RQC[0] EQ REQTYP3"PURG$FRAG"
      THEN                           # DELINK FRAGMENT #
        BEGIN
        PURGCHN;
        RETURN;
        END
 
#
*     SWITCH TO SPECIFIED FAMILY.
#
 
      PFP$WRD0[0] = 0;
      PFP$FAM[0]  = CPR$FAM[0];
      PFP$UI[0]   = DEF$UI;
      PFP$FG1[0]  = TRUE;
      PFP$FG4     = TRUE;
      SETPFP(PFP);
 
      IF PFP$STAT NQ 0
      THEN                           # PROCESS ERROR #
        BEGIN
        FE$RTN[0] = "RESETUP.";
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END
 
 
#
*     ATTACH *RELCOM* FILE GENERATED BY SSVAL.
#
 
      RELNAME = RELLFN;
      BZFILL(RELNAME,TYPFILL"ZFILL",7);
      PFD("ATTACH",RELNAME,0,"M","W","RC",STATW,0);
      IF STATW NQ OK
      THEN                           # ATTACH ERROR #
        BEGIN
        FE$MSG[0] = " FILE PROBLEM, ";
        FE$RTN[0] = "RESETUP.";
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END
 
#
*     READ *RELCOM* FILE.
#
 
      RELFADR = LOC(RELCFILE);
      RELBADR = LOC(RELCBUF);
      ZSETFET(RELFADR,RELLFN,RELBADR,LFIXBUF);
      READ(RELCFILE,RCL);
      SAVEPT = P<CPR>;
      P<CPR> = LOC(CPRARRAY);
 
 
#
*     PROCESS EACH ENTRY.
#
 
 
      SLOWFOR I = 0 STEP 1 WHILE STATW EQ OK
      DO
        BEGIN  # MAIN LOOP #
        READW(RELCFILE,CPRARRAY,CPRLEN,STATW);
        IF STATW NQ OK
        THEN
          BEGIN
          TEST I;
          END
 
#
*      DELINK FILE CHAIN.
#
 
        PURGCHN;
 
        IF LTC$RQR[LTCENTRY] NQ OK
        THEN                            # ERROR IN PURGCHN #
          BEGIN
          STATW = O"777";
          TEST I;
          END
 
#
*     WRITE TEMP FILE FOR DEBUGGING PURPOSES.
#
 
 
        END                             # MAIN LOOP #
 
      RETERN(RELCFILE,RCL);
      P<CPR> = SAVEPT;
      CPR$RQR[0] = LTC$RQR[LTCENTRY];
      LTC$DATE[LTCENTRY] = I - 1;          # FILE RELEASE COUNT #
      UCP$RES;
      RETURN;
      END                               # RESETUP #
 
    TERM
PROC RMVCAR;
# TITLE RMVCAR - REMOVE CARTRIDGE FROM SUB-FAMILY.                    #
 
      BEGIN  # RMVCAR #
 
#
**    RMVCAR - REMOVE CARTRIDGE FROM SUB-FAMILY.
*
*     *RMVCAR* UPDATES THE *AST*, *FCT*, AND *SMMAP*
*     TO REFLECT THAT THE GIVEN CARTRIDGE IS NO LONGER ASSIGNED TO
*     THE SUB-FAMILY.
*
*     PROC RMVCAR
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = MSC$NEMPTY      CARTRIDGE NOT EMPTY
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC RMVCAR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC ANLZAST;                # ANALYZE THE *AST* #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CNTFS;                  # COUNT FREE STREAMS #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
        PROC MFLUSH;                 # FLUSH MAP TO FILE #
        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
                                       CALLER #
        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
                                     #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        PROC UPDAST;                 # UPDATE THE *AST* #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        END
 
#
****  PROC RMVCAR - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM ERRCONV    B;             # ERROR CODE CONVERSION FLAG #
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS FROM
                                       *ACQ$FCT* #
      ITEM FXL        U;             # BEST ORDINAL FOR ALLOCATION #
      ITEM FXS        U;             # BEST ORDINAL FOR ALLOCATION #
      ITEM GPS        U;             # BEST GROUP ORDINAL #
      ITEM GPX        U;             # BEST GROUP #
      ITEM I          U;             # COUNTER #
      ITEM ORD        I;             # *AST* ORDINAL #
      ITEM SAVEY      U;             # SAVED Y COORDINATE #
      ITEM SAVEZ      U;             # SAVED Z COORDINATE #
 
 
 
 
 
#
*     GET THE MAP ENTRY FOR THE REQUEST.
#
 
      LOANFCTQ(0);
      ERRCONV = TRUE;
      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     GET THE *FCTQ* ENTRY FOR THE REQUEST.
#
 
 
      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
#
*     GET THE ALLOCATION SUMMARY TABLE.
#
 
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
      P<FCT> = FCTEADDR + FCTQHL;
      P<AST> = ASTBADR;
 
#
*     VERIFY THAT THE CARTRIDGE IS FREE AND UPDATE *AST*.
#
 
      ORD = CPR$FCT[0];
      IF (AST$AULF[ORD] + AST$AUSF[ORD] + AST$FLAWS[ORD]) NQ INAVOT
        THEN                         # CARTRIDGE IS NOT FREE #
        BEGIN
        ERRSTAT = RESPTYP3"MSC$NEMPTY";
        ERRCONV = FALSE;             # BYPASS CODE CONVERSION #
        GOTO ERRORTN;
        END
 
#
*     UPDATE PREAMBLE.
#
 
 
      AST$1ST[ORD] = 0;
      AST$2ND[ORD] = 0;
      AST$STAT[ORD] = ASTENSTAT"UNASS$CART";
 
      ANLZAST(CPR$CSU[0],-1,-1,FXS,FXL,GPX,GPS);
      PRM$MXAUS[CPR$CSU[0]] = AST$AUSF[FXS];
      PRM$MXAUL[CPR$CSU[0]] = AST$AULF[FXL];
      PRM$MXAUGR[CPR$CSU[0]] = GPS;
 
 
      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     REMOVE THE CARTRIDGE FROM THE *FCT* AND MAP (*CSN* = 0).
#
 
      ZFILL(FCT,FCTENTL);
      FCT$CSND[0] = "      ";
      P<SMUMAP> = LOC(MAPBUFR);
      CM$CSND[0] = "      ";
      CM$CCOD[0] = 0;
      CM$FLAG1[0] = FALSE;           # CLEAR ERROR FLAG IN MAP ENTRY #
      CM$FCTORD[0] = 0;
 
      MPUTENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
 
ERRORTN:
      IF ERRCONV
      THEN                           # CONVERT ERROR CODE #
        BEGIN
        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
        END
 
      LTC$RQR[LTCENTRY] = ERRSTAT;
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      LOANFCTQ(-1);
      MFLUSH;
      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
      UCP$RES;
      RETURN;
 
      END  # RMVCAR #
 
    TERM
PROC RMVCSU;
# TITLE RMVCSU - REMOVES *SM* FROM SUB-FAMILY CATALOG.                #
 
      BEGIN  # RMVCSU #
 
#
**    RMVCSU - REMOVES *SM* FROM SUB-FAMILY CATALOG.
*
*     *RMVCSU* REMOVES A *SM* FROM THE
*     CATALOG FOR A SUB-FAMILY.
*
*     PROC RMVCSU
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = PF$PROB         PERMANENT FILE PROBLEM
#
 
#
****  PROC RMVCSU - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRMVSC;                 # REMOVE SUBCATALOG #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC RMVCSU - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMXLTC
 
 
 
 
 
      CRMVSC(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],0,ERRSTAT);
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      UCP$RES;
      RETURN;
 
      END  # RMVCSU #
 
    TERM
PROC RMVCUBE;
# TITLE RMVCUBE - REMOVE CUBICLE FROM FAMILY.                         #
 
      BEGIN  # RMVCUBE #
 
#
**    RMVCUBE - REMOVE CUBICLE FROM FAMILY.
*
*     *RMVCUBE* UPDATES THE *AST*, *FCT* AND *SMMAP* (IN THAT
*     ORDER) TO REFLECT THAT THE GIVEN CUBICLE IS NO LONGER
*     ASSIGNED TO THE SUB-FAMILY.
*
*     PROC RMVCUBE
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC RMVCUBE - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC MFLUSH;                 # FLUSH MAP TO FILE #
        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
                                       CALLER #
        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
                                     #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        PROC UPDAST;                 # UPDATE THE *AST* #
        END
 
#
****  PROC RMVCUBE - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMXFCQ
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
      ITEM I          U;             # COUNTER #
      ITEM ORD        I;             # *AST* ORDINAL #
 
 
 
 
 
#
*     GET THE MAP ENTRY FOR THE REQUEST.
#
 
      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
#
*     GET THE ALLOCATION SUMMARY TABLE.
#
 
      P<AST> = ASTBADR;
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     UPDATE *AST* AND PREAMBLE.
#
 
      ORD = CPR$FCT[0];
      AST$STAT[ORD] = ASTENSTAT"UNASS$CUB";
      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
      P<FCT> = FCTEADDR + FCTQHL;
 
#
*     REMOVE *FCT* ORDINAL AND FAMILY NAME FROM THE MAP ENTRY
*     AND INDICATE THAT THE CUBE IS UNASSIGNED.
#
 
      P<SMUMAP> = LOC(MAPBUFR);
      CM$CODE[0] = CUBSTAT"UNASGN";
      CM$FCTORD[0] = 0;
      CM$FMLYNM[0] = "       ";
      CM$SUB[0] = 0;
      CM$FLAG1[0] = FALSE;           # CLEAR ERROR FLAG IN MAP ENTRY #
      MPUTENT(CPR$CSU,SMORD,LOC(MAPBUFR),ERRSTAT);
 
#
*     CONVERT THE REQUEST STATUS AND RETURN IT TO THE *UCP*.
#
 
 
ERRORTN:
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      MFLUSH;
      UCP$RES;
      RETURN;
 
      END  # RMVCUBE #
 
    TERM
PROC UPDCAT;
# TITLE UPDCAT - UPDATE FIELDS IN THE *SFM* CATALOG.                  #
 
      BEGIN  # UPDCAT #
 
#
**    UPDCAT - UPDATE FIELDS IN THE *SFM* CATALOG.
*
*     *UPDCAT* UPDATES FIELDS IN AN *SFM* CATALOG.
*
*     PROC UPDCAT
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
*
*     NOTE      IN ALL BOOLEAN CASES A VALUE OF ZERO IN THE UPDATE
*               FIELD IS ASSUMED TO BE FALSE AND A NON-ZERO VALUE
*               TO BE TRUE.
#
 
#
****  PROC UPDCAT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
                                     #
        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC CPUTPD;                 # PUT PURGE DATE #
        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
        PROC KILL$UC;                # ABORT A *UCP* #
        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        PROC UASTPRM;                  # UPDATE *AST* AND *PRM* #
        END
 
#
****  PROC UPDCAT - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMBMCT
*CALL COMBUCR
*CALL COMXFCQ
*CALL COMXLTC
 
      SWITCH   UPDUCF:UCF            # FIELDS TO BE UPDATED #
             UPDFRCAR:FREEFL,        # FREE CARTRIDGE FLAG #
             UPDINHIB:INHIB,         # INHIBIT ALLOCATION #
              UPDLOST:LOST,          # LOST CARTRIDGE #
              UPDEWPE:EWPE,          # EXCESSIVE WRITE PARITY ERRORS #
              UPDCMAP:CMAP,          # *SMMAP* ERROR FLAG #
              UPDFROZ:FROZ,          # FROZEN CHAIN FLAG #
              UPDCONF:CONF,          # CONFLICT FLAG #
               UPDSOF:SOF;           # START OF FRAGMENT FLAG #
 
      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
      ITEM POS        I;             # WORD POSITION #
      ITEM WORD       I;             # POSITION WITHIN WORD #
                                               CONTROL EJECT;
 
#
*     VALIDATE THE CATALOG FIELD NAME PARAMETER AND ABORT THE *UCP*
*     IF NOT VALID.
#
 
      IF CPR$FLD[0] EQ UCF"UNUSED" OR CPR$FLD[0] GQ UCF"LSTSOF"
      THEN
        BEGIN
        KILL$UC(KILLCODE"INVRQC");
        RETURN;
        END
 
      LOANFCTQ(0);
 
#
*     GET THE ALLOCATION SUMMARY TABLE.
#
 
      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
#
*     GET THE *FCTQ* ENTRY FOR THE REQUEST.
#
 
      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
      IF ERRSTAT NQ CMASTAT"NOERR"
      THEN
        BEGIN
        GOTO ERRORTN;
        END
 
 
      P<FCT> = FCTEADDR + FCTQHL;
 
 
#
*     UPDATE THE SPECIFIED CATALOG FIELD.
#
 
      GOTO UPDUCF[CPR$FLD[0]];
 
 
UPDFRCAR:
      IF CPR$VAL[0] EQ 0
      THEN                           # SET FREE FLAG TO FALSE #
        BEGIN
        FCT$FCF[0] = FALSE;
        END
 
      ELSE
        BEGIN
        FCT$FCF[0] = TRUE;
        END
 
      IF NOT FCT$FCF[0]
      THEN               # DO NOT CLEAR INHIBIT FLAG #
        BEGIN
        UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
        GOTO ERRORTN;
        END
 
 
UPDINHIB:
      IF (NOT FCT$IAF[0] AND (CPR$VAL[0] EQ ON))  ##
        OR (FCT$IAF[0] AND (CPR$VAL[0] EQ OFF))
      THEN                           # FLAG UPDATE REQUIRED #
        BEGIN  # UPDATE INHIBIT FLAG #
        FCT$IAF[0] = NOT FCT$IAF[0];
        END  # UPDATE INHIBIT FLAG #
 
      UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
      GOTO ERRORTN;
 
UPDLOST:
      IF (NOT FCT$LCF[0] AND (CPR$VAL[0] EQ ON))  ##
        OR (FCT$LCF[0] AND (CPR$VAL[0] EQ OFF))
      THEN                           # FLAG UPDATE REQUIRED #
        BEGIN  # UPDATE LOST FLAG #
        FCT$LCF[0] = NOT FCT$LCF[0];
      UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
        END  # UPDATE LOST FLAG #
 
      GOTO ERRORTN;
 
UPDEWPE:
      IF (NOT FCT$EEF[0] AND (CPR$VAL[0] EQ ON))  ##
        OR (FCT$EEF[0] AND (CPR$VAL[0] EQ OFF))
      THEN                           # FLAG UPDATE REQUIRED #
        BEGIN  # UPDATE WRITE PARITY ERROR FLAG #
        FCT$EEF[0] = NOT FCT$EEF[0];
      UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
        END  # UPDATE WRITE PARITY ERROR FLAG #
 
      GOTO ERRORTN;
 
UPDCMAP:
      FCT$SEF[0] = CPR$VAL[0] NQ OFF;
      AST$AAF[CPR$FCT[0]] = FALSE;
      GOTO ERRORTN;
 
UPDFROZ:
      WORD = FCT$WD(CPR$AU[0]);
      POS = FCT$WP(CPR$AU[0]);
      FCT$FRCF(WORD,POS) = CPR$VAL[0];
 
      GOTO ERRORTN;
 
UPDCONF:
      FCT$AUCF(FCT$WD(CPR$AU[0]),FCT$WP(CPR$AU[0])) = CPR$VAL[0];
 
      GOTO ERRORTN;
 
UPDSOF:
      IF CPR$VAL EQ 0
      THEN
        BEGIN
        FCT$SFF(FCT$WD(CPR$AU[0]),FCT$WP(CPR$AU[0])) = OFF;
        END
 
      ELSE
        BEGIN
        FCT$SFF(FCT$WD(CPR$AU[0]),FCT$WP(CPR$AU[0])) = ON;
        CPUTPD(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],0,ERRSTAT);
        END
 
 
 
ERRORTN:
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      RLS$FCT(FCTEADDR,0,ERRSTAT);
      LOANFCTQ(-1);
      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
      UCP$RES;
      RETURN;
 
      END  # UPDCAT #
 
    TERM
PROC UPDMAP;
# TITLE UPDMAP - UPDATE MAP ENTRY.                                    #
 
      BEGIN  # UPDMAP #
 
#
**    UPDMAP - UPDATE MAP ENTRY.
*
*     *UPDMAP* UPDATES THE *SMMAP* ENTRY WITH DATA FROM THE
*     *UCP* REQUEST BLOCK.
*
*     PROC UPDMAP
*
*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED 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 TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
*               OF THE REQUEST.
*
*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
*                    = OK3             OK
*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
*                    = PF$PROB         PERMANENT FILE PROBLEM
*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
#
 
#
****  PROC UPDMAP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
                                       *UCP* ERRORS #
        PROC MFLUSH;                 # FLUSH MAP TO FILE #
        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
                                     #
        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
                                     #
        END
 
#
****  PROC UPDMAP - XREF LIST END.
#
 
 
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBMAP
*CALL COMXLTC
*CALL COMXMSC
 
 
 
 
 
#
*     UPDATE THE MAP ENTRY WITH *UCP* DATA.
#
 
      MPUTENT(CPR$CSU[0],SMORD,LOC(CPR$MAPENT[0]),ERRSTAT);
 
#
*     SEND RESPONSE TO *UCP* AND RETURN TO CALLER.
#
 
      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
      LTC$RQR[LTCENTRY] = ERRSTAT;
      MFLUSH;
      UCP$RES;
      RETURN;
      END  # UPDMAP #
 
    TERM