SX3UCP
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
