1 Modification

Seq #  *Modification Id* Act 
----------------------------+
00001  M01S00001.sx3ucp  +++|PROC ADDCAR;
00002  M01S00002.sx3ucp  +++|# TITLE ADDCAR - ADD CARTRIDGE TO SUB-FAMILY.                         #
00003  M01S00003.sx3ucp  +++|
00004  M01S00004.sx3ucp  +++|      BEGIN  # ADDCAR #
00005  M01S00005.sx3ucp  +++|
00006  M01S00006.sx3ucp  +++|#
00007  M01S00007.sx3ucp  +++|**    ADDCAR - ADD CATRIDGE TO SUB-FAMILY.
00008  M01S00008.sx3ucp  +++|*
00009  M01S00009.sx3ucp  +++|*     *ADDCAR* UPDATES THE *SMMAP*, *FCT*, AND *AST* (IN THAT
00010  M01S00010.sx3ucp  +++|*     ORDER) TO REFLECT THE ADDITION OF THE CARTRIDGE TO THE
00011  M01S00011.sx3ucp  +++|*     SUB-FAMILY.
00012  M01S00012.sx3ucp  +++|*
00013  M01S00013.sx3ucp  +++|*     PROC ADDCAR
00014  M01S00014.sx3ucp  +++|*
00015  M01S00015.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
00016  M01S00016.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
00017  M01S00017.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
00018  M01S00018.sx3ucp  +++|*               *LTCENTRY*.
00019  M01S00019.sx3ucp  +++|*
00020  M01S00020.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
00021  M01S00021.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
00022  M01S00022.sx3ucp  +++|*               OF THE REQUEST.
00023  M01S00023.sx3ucp  +++|*
00024  M01S00024.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
00025  M01S00025.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
00026  M01S00026.sx3ucp  +++|*                    = OK3             OK
00027  M01S00027.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
00028  M01S00028.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
00029  M01S00029.sx3ucp  +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
00030  M01S00030.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
00031  M01S00031.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
00032  M01S00032.sx3ucp  +++|#
00033  M01S00033.sx3ucp  +++|
00034  M01S00034.sx3ucp  +++|#
00035  M01S00035.sx3ucp  +++|****  PROC ADDCAR - XREF LIST BEGIN.
00036  M01S00036.sx3ucp  +++|#
00037  M01S00037.sx3ucp  +++|
00038  M01S00038.sx3ucp  +++|      XREF
00039  M01S00039.sx3ucp  +++|        BEGIN
00040  M01S00040.sx3ucp  +++|        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
00041  M01S00041.sx3ucp  +++|                                     #
00042  M01S00042.sx3ucp  +++|        PROC ANLZAST;                # ANALYZE THE *AST* #
00043  M01S00043.sx3ucp  +++|        PROC CEXTSC;                 # EXTEND SUBCATALOG #
00044  M01S00044.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
00045  M01S00045.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
00046  M01S00046.sx3ucp  +++|                                       *UCP* ERRORS #
00047  M01S00047.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
00048  M01S00048.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
00049  M01S00049.sx3ucp  +++|        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
00050  M01S00050.sx3ucp  +++|        PROC MFLUSH;                 # FLUSH MAP TO FILE #
00051  M01S00051.sx3ucp  +++|        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
00052  M01S00052.sx3ucp  +++|                                       CALLER #
00053  M01S00053.sx3ucp  +++|        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
00054  M01S00054.sx3ucp  +++|                                     #
00055  M01S00055.sx3ucp  +++|        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
00056  M01S00056.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
00057  M01S00057.sx3ucp  +++|                                     #
00058  M01S00058.sx3ucp  +++|        PROC UASTPRM;                  # UPDATE *AST* AND *PRM* #
00059  M01S00059.sx3ucp  +++|        END
00060  M01S00060.sx3ucp  +++|
00061  M01S00061.sx3ucp  +++|#
00062  M01S00062.sx3ucp  +++|****  PROC ADDCAR - XREF LIST END.
00063  M01S00063.sx3ucp  +++|#
00064  M01S00064.sx3ucp  +++|
00065  M01S00065.sx3ucp  +++|      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
00066  M01S00066.sx3ucp  +++|*CALL COMBFAS
00067  M01S00067.sx3ucp  +++|*CALL COMBCMD
00068  M01S00068.sx3ucp  +++|*CALL COMBCMS
00069  M01S00069.sx3ucp  +++|*CALL COMBCPR
00070  M01S00070.sx3ucp  +++|*CALL COMBMAP
00071  M01S00071.sx3ucp  +++|*CALL COMBMCT
00072  M01S00072.sx3ucp  +++|*CALL COMXFCQ
00073  M01S00073.sx3ucp  +++|*CALL COMXLTC
00074  M01S00074.sx3ucp  +++|*CALL COMXMSC
00075  M01S00075.sx3ucp  +++|
00076  M01S00076.sx3ucp  +++|
00077  M01S00077.sx3ucp  +++|      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS FROM
00078  M01S00078.sx3ucp  +++|                                       *ACQ$FCT* #
00079  M01S00079.sx3ucp  +++|      ITEM FCTNUM     U;             # NUMBER OF ENTRIES TO ADD #
00080  M01S00080.sx3ucp  +++|      ITEM FXS        U;             # INDEX TO AST$AUSF #
00081  M01S00081.sx3ucp  +++|      ITEM FXL        U;             # INDEX TO AST$AULF #
00082  M01S00082.sx3ucp  +++|      ITEM GRTO       U;             # TOTAL SPACE IN GROUP #
00083  M01S00083.sx3ucp  +++|      ITEM GPX        U;             # BEST GROUP #
00084  M01S00084.sx3ucp  +++|      ITEM GPS        U;             # BEST ORDINAL #
00085  M01S00085.sx3ucp  +++|      ITEM I          U;             # COUNTER #
00086  M01S00086.sx3ucp  +++|      ITEM LENCOUNT   I;             # LENGTH COUNT #
00087  M01S00087.sx3ucp  +++|      ITEM POS        I;             # POSITION #
00088  M01S00088.sx3ucp  +++|      ITEM POINT      U;             # HOLDS POINTER TO SET LINKAGE #
00089  M01S00089.sx3ucp  +++|      ITEM START      U;             # BEGINNING LOOP COUNTER #
00090  M01S00090.sx3ucp  +++|      ITEM STARTLN    U;             # STARTING LENGTH #
00091  M01S00091.sx3ucp  +++|      ITEM SORL       U;             # SMALL OR LARGE FILE LOOP #
00092  M01S00092.sx3ucp  +++|      ITEM TERMX      U;             # TERMINATION OF LOOP #
00093  M01S00093.sx3ucp  +++|      ITEM WORD       I;             # LINK FIELD WORD #
00094  M01S00094.sx3ucp  +++|      ITEM ORD        I;             # *AST* ORDINAL #
00095  M01S00095.sx3ucp  +++|
00096  M01S00096.sx3ucp  +++|
00097  M01S00097.sx3ucp  +++|
00098  M01S00098.sx3ucp  +++|
00099  M01S00099.sx3ucp  +++|
00100  M01S00100.sx3ucp  +++|#
00101  M01S00101.sx3ucp  +++|*     GET THE MAP ENTRY FOR THE REQUEST.
00102  M01S00102.sx3ucp  +++|#
00103  M01S00103.sx3ucp  +++|
00104  M01S00104.sx3ucp  +++|      LOANFCTQ(0);
00105  M01S00105.sx3ucp  +++|      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
00106  M01S00106.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00107  M01S00107.sx3ucp  +++|      THEN
00108  M01S00108.sx3ucp  +++|        BEGIN
00109  M01S00109.sx3ucp  +++|        GOTO ERRORTN;
00110  M01S00110.sx3ucp  +++|        END
00111  M01S00111.sx3ucp  +++|
00112  M01S00112.sx3ucp  +++|      P<SMUMAP> = LOC(MAPBUFR);
00113  M01S00113.sx3ucp  +++|
00114  M01S00114.sx3ucp  +++|#
00115  M01S00115.sx3ucp  +++|*     GET THE *AST* AND EXPAND THE CATALOG IF THE REQUIRED
00116  M01S00116.sx3ucp  +++|*     *FCT* ENTRY DOES NOT PHYSICALLY EXIST.
00117  M01S00117.sx3ucp  +++|#
00118  M01S00118.sx3ucp  +++|
00119  M01S00119.sx3ucp  +++|      P<AST> = ASTBADR;
00120  M01S00120.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
00121  M01S00121.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00122  M01S00122.sx3ucp  +++|      THEN
00123  M01S00123.sx3ucp  +++|        BEGIN
00124  M01S00124.sx3ucp  +++|        GOTO ERRORTN;
00125  M01S00125.sx3ucp  +++|        END
00126  M01S00126.sx3ucp  +++|
00127  M01S00127.sx3ucp  +++|      IF (PRM$ENTRC[CPR$CSU[0]] + 15) LS CPR$FCT[0]
00128  M01S00128.sx3ucp  +++|      THEN                           # EXPAND TO INCLUDE REQUIRED ENTRY
00129  M01S00129.sx3ucp  +++|                                     #
00130  M01S00130.sx3ucp  +++|        BEGIN
00131  M01S00131.sx3ucp  +++|        FCTNUM = CPR$FCT[0] - PRM$ENTRC[CPR$CSU[0]] - 15;
00132  M01S00132.sx3ucp  +++|        CEXTSC(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTNUM,0,ERRSTAT);
00133  M01S00133.sx3ucp  +++|        IF ERRSTAT NQ CMASTAT"NOERR"
00134  M01S00134.sx3ucp  +++|        THEN
00135  M01S00135.sx3ucp  +++|          BEGIN
00136  M01S00136.sx3ucp  +++|          GOTO ERRORTN;
00137  M01S00137.sx3ucp  +++|          END
00138  M01S00138.sx3ucp  +++|
00139  M01S00139.sx3ucp  +++|        END
00140  M01S00140.sx3ucp  +++|
00141  M01S00141.sx3ucp  +++|      ORD = CPR$FCT[0];
00142  M01S00142.sx3ucp  +++|
00143  M01S00143.sx3ucp  +++|#
00144  M01S00144.sx3ucp  +++|*     GET THE *FCTQ* ENTRY.
00145  M01S00145.sx3ucp  +++|#
00146  M01S00146.sx3ucp  +++|
00147  M01S00147.sx3ucp  +++|
00148  M01S00148.sx3ucp  +++|      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
00149  M01S00149.sx3ucp  +++|        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
00150  M01S00150.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00151  M01S00151.sx3ucp  +++|      THEN
00152  M01S00152.sx3ucp  +++|        BEGIN
00153  M01S00153.sx3ucp  +++|        GOTO ERRORTN;
00154  M01S00154.sx3ucp  +++|        END
00155  M01S00155.sx3ucp  +++|
00156  M01S00156.sx3ucp  +++|#
00157  M01S00157.sx3ucp  +++|*     UPDATE THE MAP ENTRY WITH THE *CSN*.
00158  M01S00158.sx3ucp  +++|#
00159  M01S00159.sx3ucp  +++|
00160  M01S00160.sx3ucp  +++|      P<FCT> = FCTEADDR + FCTQHL;
00161  M01S00161.sx3ucp  +++|      CM$CSND[0] = CPR$CSND[0];
00162  M01S00162.sx3ucp  +++|      CM$CCOD[0] = CPR$CCOD[0];
00163  M01S00163.sx3ucp  +++|      CM$FCTORD[0] = CPR$FCT[0];
00164  M01S00164.sx3ucp  +++|      MPUTENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
00165  M01S00165.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00166  M01S00166.sx3ucp  +++|      THEN
00167  M01S00167.sx3ucp  +++|        BEGIN
00168  M01S00168.sx3ucp  +++|        GOTO ERRORTN;
00169  M01S00169.sx3ucp  +++|        END
00170  M01S00170.sx3ucp  +++|
00171  M01S00171.sx3ucp  +++|
00172  M01S00172.sx3ucp  +++|#
00173  M01S00173.sx3ucp  +++|*     UPDATE THE *FCT* WITH THE *CSN* OF THE CARTRIDGE, AND
00174  M01S00174.sx3ucp  +++|*     THE *FAULF* AND THE *FAUSF*.
00175  M01S00175.sx3ucp  +++|#
00176  M01S00176.sx3ucp  +++|
00177  M01S00177.sx3ucp  +++|      FCT$CSND[0] = CPR$CSND[0];
00178  M01S00178.sx3ucp  +++|      FCT$FAUSF[0] = 1;
00179  M01S00179.sx3ucp  +++|      FCT$FAULF[0] = CPR$B[0] + 1;
00180  M01S00180.sx3ucp  +++|      FCT$CCOD[0] = CPR$CCOD[0];
00181  M01S00181.sx3ucp  +++|      FCT$ORD[0] = CPR$FCT[0];
00182  M01S00182.sx3ucp  +++|      FCT$FLGS[0] = 0;
00183  M01S00183.sx3ucp  +++|      FCT$OCL[0] = 0;
00184  M01S00184.sx3ucp  +++|      FCT$OCL1[0] = 0;
00185  M01S00185.sx3ucp  +++|      FCT$OCL2[0] = 0;
00186  M01S00186.sx3ucp  +++|      FCT$FTST[0] = INFTST;
00187  M01S00187.sx3ucp  +++|      FCT$SPAU[0] = INSPAU;
00188  M01S00188.sx3ucp  +++|      FCT$PRUS[0] = INPRUS;
00189  M01S00189.sx3ucp  +++|      FCT$AVOT[0] = INAVOT;
00190  M01S00190.sx3ucp  +++|      FCT$CDP[0] = CPR$B[0] + 1;
00191  M01S00191.sx3ucp  +++|      FCT$OCLF[0] = 0;
00192  M01S00192.sx3ucp  +++|      FCT$STRD[0] = CPR$STRD[0];
00193  M01S00193.sx3ucp  +++|      FCT$STWR[0] = CPR$STWR[0];
00194  M01S00194.sx3ucp  +++|      FCT$SRDE[0] = CPR$SRDE[0];
00195  M01S00195.sx3ucp  +++|      FCT$SWRE[0] = CPR$SWRE[0];
00196  M01S00196.sx3ucp  +++|      FCT$HRDE[0] = CPR$HRDE[0];
00197  M01S00197.sx3ucp  +++|      FCT$STDM[0] = CPR$STDM[0];
00198  M01S00198.sx3ucp  +++|      FCT$CRLD[0] = CPR$CRLD[0];
00199  M01S00199.sx3ucp  +++|      FCT$LDER[0] = CPR$LDER[0];
00200  M01S00200.sx3ucp  +++|      FCT$Y[0] = CPR$Y[0];
00201  M01S00201.sx3ucp  +++|      FCT$Z[0] = CPR$Z[0];
00202  M01S00202.sx3ucp  +++|      IF CPR$B[0] EQ 0
00203  M01S00203.sx3ucp  +++|      THEN             # SET FOR END CASE #
00204  M01S00204.sx3ucp  +++|        BEGIN
00205  M01S00205.sx3ucp  +++|        FCT$FAUSF[0] = 0;
00206  M01S00206.sx3ucp  +++|        END
00207  M01S00207.sx3ucp  +++|
00208  M01S00208.sx3ucp  +++|      IF CPR$B[0] EQ 1931
00209  M01S00209.sx3ucp  +++|      THEN
00210  M01S00210.sx3ucp  +++|        BEGIN
00211  M01S00211.sx3ucp  +++|        FCT$FAULF[0] = 0;
00212  M01S00212.sx3ucp  +++|        END
00213  M01S00213.sx3ucp  +++|
00214  M01S00214.sx3ucp  +++|
00215  M01S00215.sx3ucp  +++|#
00216  M01S00216.sx3ucp  +++|*     INITIALIZE CARTRIDGE LINK FIELD IN *FCT*.
00217  M01S00217.sx3ucp  +++|#
00218  M01S00218.sx3ucp  +++|
00219  M01S00219.sx3ucp  +++|      SLOWFOR SORL = 1 STEP 1 UNTIL 2
00220  M01S00220.sx3ucp  +++|      DO                             # FOR LARGE AND SMALL FILES #
00221  M01S00221.sx3ucp  +++|        BEGIN
00222  M01S00222.sx3ucp  +++|        IF SORL EQ 1
00223  M01S00223.sx3ucp  +++|        THEN                         # SET LINKAGE FOR LARGE FILES #
00224  M01S00224.sx3ucp  +++|          BEGIN
00225  M01S00225.sx3ucp  +++|          TERMX = CPR$B[0] + 1;
00226  M01S00226.sx3ucp  +++|          POINT = 0;
00227  M01S00227.sx3ucp  +++|          START = INAVOT;
00228  M01S00228.sx3ucp  +++|          END
00229  M01S00229.sx3ucp  +++|
00230  M01S00230.sx3ucp  +++|        IF SORL EQ 2
00231  M01S00231.sx3ucp  +++|        THEN                         # SET LINKAGE FOR SMALL FILES #
00232  M01S00232.sx3ucp  +++|          BEGIN
00233  M01S00233.sx3ucp  +++|          TERMX = 1;
00234  M01S00234.sx3ucp  +++|          POINT = 0;
00235  M01S00235.sx3ucp  +++|          START = CPR$B[0];
00236  M01S00236.sx3ucp  +++|          END
00237  M01S00237.sx3ucp  +++|
00238  M01S00238.sx3ucp  +++|        LENCOUNT = 0;
00239  M01S00239.sx3ucp  +++|        SLOWFOR I = START STEP -1 UNTIL TERMX
00240  M01S00240.sx3ucp  +++|        DO                           # INITIALIZE FIELDS #
00241  M01S00241.sx3ucp  +++|          BEGIN
00242  M01S00242.sx3ucp  +++|          WORD = FCT$WD(I);
00243  M01S00243.sx3ucp  +++|          POS = FCT$WP(I);
00244  M01S00244.sx3ucp  +++|          FCT$CLFG(WORD,POS) = 0;
00245  M01S00245.sx3ucp  +++|          FCT$LEN(WORD,POS) = LENCOUNT;
00246  M01S00246.sx3ucp  +++|          IF (I - INAVVS + LENCOUNT) LQ 0
00247  M01S00247.sx3ucp  +++|          THEN
00248  M01S00248.sx3ucp  +++|            BEGIN
00249  M01S00249.sx3ucp  +++|            FCT$LINK(WORD,POS) = 1;
00250  M01S00250.sx3ucp  +++|            END
00251  M01S00251.sx3ucp  +++|
00252  M01S00252.sx3ucp  +++|          ELSE
00253  M01S00253.sx3ucp  +++|            BEGIN
00254  M01S00254.sx3ucp  +++|            FCT$LINK(WORD,POS) = I - INAVVS + LENCOUNT;
00255  M01S00255.sx3ucp  +++|            END
00256  M01S00256.sx3ucp  +++|
00257  M01S00257.sx3ucp  +++|          IF (SORL EQ 1) AND ((I - INAVVS + LENCOUNT) LS TERMX)
00258  M01S00258.sx3ucp  +++|          THEN                       # SHORT VOLUME FOR LARGE FILES #
00259  M01S00259.sx3ucp  +++|            BEGIN
00260  M01S00260.sx3ucp  +++|            FCT$LINK(WORD,POS) = TERMX;
00261  M01S00261.sx3ucp  +++|            END
00262  M01S00262.sx3ucp  +++|
00263  M01S00263.sx3ucp  +++|          IF LENCOUNT EQ INAVVS OR I EQ TERMX
00264  M01S00264.sx3ucp  +++|          THEN
00265  M01S00265.sx3ucp  +++|            BEGIN
00266  M01S00266.sx3ucp  +++|            FCT$CAUF(WORD,POS) = 0;
00267  M01S00267.sx3ucp  +++|            FCT$LINK(WORD,POS) = POINT;
00268  M01S00268.sx3ucp  +++|            POINT = I;
00269  M01S00269.sx3ucp  +++|            END
00270  M01S00270.sx3ucp  +++|
00271  M01S00271.sx3ucp  +++|          ELSE
00272  M01S00272.sx3ucp  +++|            BEGIN
00273  M01S00273.sx3ucp  +++|            FCT$CAUF(WORD,POS) = 1;
00274  M01S00274.sx3ucp  +++|            END
00275  M01S00275.sx3ucp  +++|
00276  M01S00276.sx3ucp  +++|
00277  M01S00277.sx3ucp  +++|          LENCOUNT = LENCOUNT + 1;
00278  M01S00278.sx3ucp  +++|          IF LENCOUNT GR INAVVS
00279  M01S00279.sx3ucp  +++|          THEN                       # MAXIMUM VOLUME FOUND #
00280  M01S00280.sx3ucp  +++|            BEGIN
00281  M01S00281.sx3ucp  +++|            LENCOUNT = 0;
00282  M01S00282.sx3ucp  +++|            END
00283  M01S00283.sx3ucp  +++|
00284  M01S00284.sx3ucp  +++|          END
00285  M01S00285.sx3ucp  +++|
00286  M01S00286.sx3ucp  +++|        END
00287  M01S00287.sx3ucp  +++|
00288  M01S00288.sx3ucp  +++|
00289  M01S00289.sx3ucp  +++|      RLS$FCT(FCTEADDR,0,ERRSTAT);
00290  M01S00290.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00291  M01S00291.sx3ucp  +++|      THEN
00292  M01S00292.sx3ucp  +++|        BEGIN
00293  M01S00293.sx3ucp  +++|        GOTO ERRORTN;
00294  M01S00294.sx3ucp  +++|        END
00295  M01S00295.sx3ucp  +++|
00296  M01S00296.sx3ucp  +++|#
00297  M01S00297.sx3ucp  +++|*     UPDATE *AST* AND PREAMBLE.
00298  M01S00298.sx3ucp  +++|#
00299  M01S00299.sx3ucp  +++|
00300  M01S00300.sx3ucp  +++|      AST$1ST[ORD] = 0;
00301  M01S00301.sx3ucp  +++|      AST$2ND[ORD] = 0;
00302  M01S00302.sx3ucp  +++|      AST$AULF[ORD] = INAVOT - CPR$B[0];
00303  M01S00303.sx3ucp  +++|      AST$AUSF[ORD] = CPR$B[0];
00304  M01S00304.sx3ucp  +++|      AST$GR[ORD] = CPR$GR[0];
00305  M01S00305.sx3ucp  +++|      AST$GRT[ORD] = CPR$GRT[0];
00306  M01S00306.sx3ucp  +++|      AST$AAF[ORD] = TRUE;
00307  M01S00307.sx3ucp  +++|      AST$NOCLF[ORD] = FALSE;
00308  M01S00308.sx3ucp  +++|
00309  M01S00309.sx3ucp  +++|
00310  M01S00310.sx3ucp  +++|      AST$STAT[ORD] = ASTENSTAT"ASS$CART";
00311  M01S00311.sx3ucp  +++|      ANLZAST(CPR$CSU[0],-1,-1,FXS,FXL,GPX,GPS);
00312  M01S00312.sx3ucp  +++|      PRM$MXAUS[CPR$CSU[0]] = AST$AUSF[FXS];
00313  M01S00313.sx3ucp  +++|      PRM$MXAUL[CPR$CSU[0]] = AST$AULF[FXL];
00314  M01S00314.sx3ucp  +++|      PRM$MXAUGR[CPR$CSU[0]] = GPS;
00315  M01S00315.sx3ucp  +++|
00316  M01S00316.sx3ucp  +++|      UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
00317  M01S00317.sx3ucp  +++|      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
00318  M01S00318.sx3ucp  +++|
00319  M01S00319.sx3ucp  +++|#
00320  M01S00320.sx3ucp  +++|*     PASS THE REQUEST STATUS TO THE *UCP* AND RETURN TO CALLER.
00321  M01S00321.sx3ucp  +++|#
00322  M01S00322.sx3ucp  +++|
00323  M01S00323.sx3ucp  +++|ERRORTN:
00324  M01S00324.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00325  M01S00325.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
00326  M01S00326.sx3ucp  +++|      RLS$FCT(FCTEADDR,0,ERRSTAT);
00327  M01S00327.sx3ucp  +++|      LOANFCTQ(-1);
00328  M01S00328.sx3ucp  +++|      MFLUSH;
00329  M01S00329.sx3ucp  +++|      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
00330  M01S00330.sx3ucp  +++|      UCP$RES;
00331  M01S00331.sx3ucp  +++|      RETURN;
00332  M01S00332.sx3ucp  +++|
00333  M01S00333.sx3ucp  +++|      END  # ADDCAR #
00334  M01S00334.sx3ucp  +++|
00335  M01S00335.sx3ucp  +++|    TERM
00336  M01S00336.sx3ucp  +++|PROC ADDCSU;
00337  M01S00337.sx3ucp  +++|# TITLE ADDCSU - ADD *SM* SUB-CATALOG.                                #
00338  M01S00338.sx3ucp  +++|
00339  M01S00339.sx3ucp  +++|      BEGIN  # ADDCSU #
00340  M01S00340.sx3ucp  +++|
00341  M01S00341.sx3ucp  +++|#
00342  M01S00342.sx3ucp  +++|**    ADDCSU - ADD *SM* SUB-CATALOG.
00343  M01S00343.sx3ucp  +++|*
00344  M01S00344.sx3ucp  +++|*     *ADDCSU* ADDS A SUB-CATALOG TO THE CATALOG SO AS TO
00345  M01S00345.sx3ucp  +++|*     ACCOMADATE AN ADDITIONAL *SM*.
00346  M01S00346.sx3ucp  +++|*
00347  M01S00347.sx3ucp  +++|*     PROC ADDCSU
00348  M01S00348.sx3ucp  +++|*
00349  M01S00349.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
00350  M01S00350.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
00351  M01S00351.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
00352  M01S00352.sx3ucp  +++|*               *LTCENTRY*.
00353  M01S00353.sx3ucp  +++|*
00354  M01S00354.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
00355  M01S00355.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
00356  M01S00356.sx3ucp  +++|*               OF THE REQUEST.
00357  M01S00357.sx3ucp  +++|*
00358  M01S00358.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
00359  M01S00359.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
00360  M01S00360.sx3ucp  +++|*                    = OK3             OK
00361  M01S00361.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
00362  M01S00362.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
00363  M01S00363.sx3ucp  +++|*                    = SUB$CAT$EX      SUBCATALOG ALREADY EXISTS
00364  M01S00364.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
00365  M01S00365.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
00366  M01S00366.sx3ucp  +++|#
00367  M01S00367.sx3ucp  +++|
00368  M01S00368.sx3ucp  +++|#
00369  M01S00369.sx3ucp  +++|****  PROC ADDCSU - XREF LIST BEGIN.
00370  M01S00370.sx3ucp  +++|#
00371  M01S00371.sx3ucp  +++|
00372  M01S00372.sx3ucp  +++|      XREF
00373  M01S00373.sx3ucp  +++|        BEGIN
00374  M01S00374.sx3ucp  +++|        PROC CADDSC;                 # ADD SUBCATALOG #
00375  M01S00375.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
00376  M01S00376.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
00377  M01S00377.sx3ucp  +++|                                       *UCP* ERRORS #
00378  M01S00378.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
00379  M01S00379.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
00380  M01S00380.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
00381  M01S00381.sx3ucp  +++|                                     #
00382  M01S00382.sx3ucp  +++|        END
00383  M01S00383.sx3ucp  +++|
00384  M01S00384.sx3ucp  +++|#
00385  M01S00385.sx3ucp  +++|****  PROC ADDCSU - XREF LIST END.
00386  M01S00386.sx3ucp  +++|#
00387  M01S00387.sx3ucp  +++|
00388  M01S00388.sx3ucp  +++|      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
00389  M01S00389.sx3ucp  +++|*CALL COMBFAS
00390  M01S00390.sx3ucp  +++|*CALL COMBCMD
00391  M01S00391.sx3ucp  +++|*CALL COMBCMS
00392  M01S00392.sx3ucp  +++|*CALL COMBCPR
00393  M01S00393.sx3ucp  +++|*CALL COMBMAP
00394  M01S00394.sx3ucp  +++|*CALL COMBMCT
00395  M01S00395.sx3ucp  +++|*CALL COMXLTC
00396  M01S00396.sx3ucp  +++|*CALL COMXMSC
00397  M01S00397.sx3ucp  +++|
00398  M01S00398.sx3ucp  +++|
00399  M01S00399.sx3ucp  +++|      ITEM FCTNUM     U;             # *FCT* ENTRY INCREMENT #
00400  M01S00400.sx3ucp  +++|      ITEM I          U;             # COUNTER #
00401  M01S00401.sx3ucp  +++|      ITEM K          U;             # COUNTER #
00402  M01S00402.sx3ucp  +++|
00403  M01S00403.sx3ucp  +++|
00404  M01S00404.sx3ucp  +++|
00405  M01S00405.sx3ucp  +++|
00406  M01S00406.sx3ucp  +++|
00407  M01S00407.sx3ucp  +++|#
00408  M01S00408.sx3ucp  +++|*     CREATE A SUB-CATALOG FOR THE *SM*.
00409  M01S00409.sx3ucp  +++|#
00410  M01S00410.sx3ucp  +++|
00411  M01S00411.sx3ucp  +++|      FCTNUM = NUMFCT;
00412  M01S00412.sx3ucp  +++|      CADDSC(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTNUM,0,ERRSTAT);
00413  M01S00413.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00414  M01S00414.sx3ucp  +++|      THEN
00415  M01S00415.sx3ucp  +++|        BEGIN
00416  M01S00416.sx3ucp  +++|        GOTO ERRORTN;
00417  M01S00417.sx3ucp  +++|        END
00418  M01S00418.sx3ucp  +++|
00419  M01S00419.sx3ucp  +++|#
00420  M01S00420.sx3ucp  +++|*     GET THE AVAILABLE STREAM TABLE (*AST*).
00421  M01S00421.sx3ucp  +++|#
00422  M01S00422.sx3ucp  +++|
00423  M01S00423.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
00424  M01S00424.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00425  M01S00425.sx3ucp  +++|      THEN
00426  M01S00426.sx3ucp  +++|        BEGIN
00427  M01S00427.sx3ucp  +++|        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00428  M01S00428.sx3ucp  +++|        LTC$RQR[LTCENTRY] = ERRSTAT;
00429  M01S00429.sx3ucp  +++|        UCP$RES;
00430  M01S00430.sx3ucp  +++|        RETURN;
00431  M01S00431.sx3ucp  +++|        END
00432  M01S00432.sx3ucp  +++|
00433  M01S00433.sx3ucp  +++|#
00434  M01S00434.sx3ucp  +++|*      SET STATUS OF ENTRIES TO UNASSIGNED CUBE.
00435  M01S00435.sx3ucp  +++|#
00436  M01S00436.sx3ucp  +++|
00437  M01S00437.sx3ucp  +++|      P<AST> = ASTBADR;
00438  M01S00438.sx3ucp  +++|      SLOWFOR I = 16 STEP 1 UNTIL (MAXORD + 15)
00439  M01S00439.sx3ucp  +++|      DO                             # SET *AST* STATUS #
00440  M01S00440.sx3ucp  +++|        BEGIN
00441  M01S00441.sx3ucp  +++|        AST$STAT[I] = ASTENSTAT"UNASS$CUB";
00442  M01S00442.sx3ucp  +++|        END
00443  M01S00443.sx3ucp  +++|
00444  M01S00444.sx3ucp  +++|      AST$NAME[15] = "*AST* ";
00445  M01S00445.sx3ucp  +++|      AST$SM[15] = CPR$CSU[0];
00446  M01S00446.sx3ucp  +++|
00447  M01S00447.sx3ucp  +++|#
00448  M01S00448.sx3ucp  +++|*     REWRITE *AST*.
00449  M01S00449.sx3ucp  +++|#
00450  M01S00450.sx3ucp  +++|
00451  M01S00451.sx3ucp  +++|      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
00452  M01S00452.sx3ucp  +++|
00453  M01S00453.sx3ucp  +++|#
00454  M01S00454.sx3ucp  +++|*     SEND RESPONSE TO *UCP* AND RETURN TO CALLER.
00455  M01S00455.sx3ucp  +++|#
00456  M01S00456.sx3ucp  +++|
00457  M01S00457.sx3ucp  +++|ERRORTN:
00458  M01S00458.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00459  M01S00459.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
00460  M01S00460.sx3ucp  +++|      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
00461  M01S00461.sx3ucp  +++|      UCP$RES;
00462  M01S00462.sx3ucp  +++|      RETURN;
00463  M01S00463.sx3ucp  +++|
00464  M01S00464.sx3ucp  +++|      END  # ADDCSU #
00465  M01S00465.sx3ucp  +++|
00466  M01S00466.sx3ucp  +++|    TERM
00467  M01S00467.sx3ucp  +++|PROC ADDCUBE;
00468  M01S00468.sx3ucp  +++|# TITLE ADDCUBE - ASSIGN CUBE TO SUB-FAMILY.                          #
00469  M01S00469.sx3ucp  +++|
00470  M01S00470.sx3ucp  +++|      BEGIN  # ADDCUBE #
00471  M01S00471.sx3ucp  +++|
00472  M01S00472.sx3ucp  +++|#
00473  M01S00473.sx3ucp  +++|**    ADDCUBE - ASSIGN CUBE TO SUB-FAMILY.
00474  M01S00474.sx3ucp  +++|*
00475  M01S00475.sx3ucp  +++|*     *ADDCUBE* UPDATES THE *SMMAP*, *FCT*, AND *AST*
00476  M01S00476.sx3ucp  +++|*     TO REFLECT THE ASSIGNMENT OF THE CUBICLE TO THE SUB-FAMILY.
00477  M01S00477.sx3ucp  +++|*
00478  M01S00478.sx3ucp  +++|*     PROC ADDCUBE
00479  M01S00479.sx3ucp  +++|*
00480  M01S00480.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
00481  M01S00481.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
00482  M01S00482.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
00483  M01S00483.sx3ucp  +++|*               *LTCENTRY*.
00484  M01S00484.sx3ucp  +++|*
00485  M01S00485.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
00486  M01S00486.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
00487  M01S00487.sx3ucp  +++|*               OF THE REQUEST.
00488  M01S00488.sx3ucp  +++|*
00489  M01S00489.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
00490  M01S00490.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
00491  M01S00491.sx3ucp  +++|*                    = OK3             OK
00492  M01S00492.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
00493  M01S00493.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
00494  M01S00494.sx3ucp  +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
00495  M01S00495.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
00496  M01S00496.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
00497  M01S00497.sx3ucp  +++|#
00498  M01S00498.sx3ucp  +++|
00499  M01S00499.sx3ucp  +++|#
00500  M01S00500.sx3ucp  +++|****  PROC ADDCUBE - XREF LIST BEGIN.
00501  M01S00501.sx3ucp  +++|#
00502  M01S00502.sx3ucp  +++|
00503  M01S00503.sx3ucp  +++|      XREF
00504  M01S00504.sx3ucp  +++|        BEGIN
00505  M01S00505.sx3ucp  +++|        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
00506  M01S00506.sx3ucp  +++|                                     #
00507  M01S00507.sx3ucp  +++|        PROC CEXTSC;                 # EXTEND SUBCATALOG #
00508  M01S00508.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
00509  M01S00509.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
00510  M01S00510.sx3ucp  +++|                                       *UCP* ERRORS #
00511  M01S00511.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
00512  M01S00512.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
00513  M01S00513.sx3ucp  +++|        PROC MFLUSH;                 # FLUSH MAP TO FILE #
00514  M01S00514.sx3ucp  +++|        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
00515  M01S00515.sx3ucp  +++|                                       CALLER #
00516  M01S00516.sx3ucp  +++|        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
00517  M01S00517.sx3ucp  +++|                                     #
00518  M01S00518.sx3ucp  +++|        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
00519  M01S00519.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
00520  M01S00520.sx3ucp  +++|                                     #
00521  M01S00521.sx3ucp  +++|        END
00522  M01S00522.sx3ucp  +++|
00523  M01S00523.sx3ucp  +++|#
00524  M01S00524.sx3ucp  +++|****  PROC ADDCUBE - XREF LIST END.
00525  M01S00525.sx3ucp  +++|#
00526  M01S00526.sx3ucp  +++|
00527  M01S00527.sx3ucp  +++|      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
00528  M01S00528.sx3ucp  +++|*CALL COMBFAS
00529  M01S00529.sx3ucp  +++|*CALL COMBCMD
00530  M01S00530.sx3ucp  +++|*CALL COMBCMS
00531  M01S00531.sx3ucp  +++|*CALL COMBCPR
00532  M01S00532.sx3ucp  +++|*CALL COMBMAP
00533  M01S00533.sx3ucp  +++|*CALL COMBMCT
00534  M01S00534.sx3ucp  +++|*CALL COMXFCQ
00535  M01S00535.sx3ucp  +++|*CALL COMXLTC
00536  M01S00536.sx3ucp  +++|*CALL COMXMSC
00537  M01S00537.sx3ucp  +++|
00538  M01S00538.sx3ucp  +++|
00539  M01S00539.sx3ucp  +++|      ITEM FCTNUM     U;             # *FCT* ENTRY INCREMENT #
00540  M01S00540.sx3ucp  +++|      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS RETURNED
00541  M01S00541.sx3ucp  +++|                                       FROM *ACQ$FCT* #
00542  M01S00542.sx3ucp  +++|      ITEM ORD        U;             # ORDINAL OF *AST*/*FCT* ENTRY #
00543  M01S00543.sx3ucp  +++|      ITEM I          U;             # COUNTER #
00544  M01S00544.sx3ucp  +++|      ITEM K          U;             # COUNTER #
00545  M01S00545.sx3ucp  +++|
00546  M01S00546.sx3ucp  +++|
00547  M01S00547.sx3ucp  +++|
00548  M01S00548.sx3ucp  +++|
00549  M01S00549.sx3ucp  +++|
00550  M01S00550.sx3ucp  +++|#
00551  M01S00551.sx3ucp  +++|*     GET ALLOCATION SUMMARY TABLE FOR THE FAMILY.
00552  M01S00552.sx3ucp  +++|#
00553  M01S00553.sx3ucp  +++|
00554  M01S00554.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
00555  M01S00555.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00556  M01S00556.sx3ucp  +++|      THEN
00557  M01S00557.sx3ucp  +++|        BEGIN
00558  M01S00558.sx3ucp  +++|        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00559  M01S00559.sx3ucp  +++|        LTC$RQR[LTCENTRY] = ERRSTAT;
00560  M01S00560.sx3ucp  +++|        UCP$RES;
00561  M01S00561.sx3ucp  +++|        RETURN;
00562  M01S00562.sx3ucp  +++|        END
00563  M01S00563.sx3ucp  +++|
00564  M01S00564.sx3ucp  +++|      FCTNUM = NUMFCT;
00565  M01S00565.sx3ucp  +++|
00566  M01S00566.sx3ucp  +++|
00567  M01S00567.sx3ucp  +++|#
00568  M01S00568.sx3ucp  +++|*     GET THE MAP ENTRY FOR THE *XY* COORDINATES OF THE REQUEST.
00569  M01S00569.sx3ucp  +++|#
00570  M01S00570.sx3ucp  +++|
00571  M01S00571.sx3ucp  +++|      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
00572  M01S00572.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00573  M01S00573.sx3ucp  +++|      THEN
00574  M01S00574.sx3ucp  +++|        BEGIN
00575  M01S00575.sx3ucp  +++|        GOTO ERRORTN;
00576  M01S00576.sx3ucp  +++|        END
00577  M01S00577.sx3ucp  +++|
00578  M01S00578.sx3ucp  +++|
00579  M01S00579.sx3ucp  +++|#
00580  M01S00580.sx3ucp  +++|*     UPDATE THE MAP AND *FCT* TO REFLECT A CUBE BEING ASSIGNED
00581  M01S00581.sx3ucp  +++|*     TO A FAMILY.
00582  M01S00582.sx3ucp  +++|#
00583  M01S00583.sx3ucp  +++|
00584  M01S00584.sx3ucp  +++|      P<FCT> = FCTEADDR + FCTQHL;
00585  M01S00585.sx3ucp  +++|      P<SMUMAP> = LOC(MAPBUFR);
00586  M01S00586.sx3ucp  +++|      CM$FMLYNM[0] = CPR$FAM[0];
00587  M01S00587.sx3ucp  +++|      CM$SUB[0] = CPR$SUB[0];
00588  M01S00588.sx3ucp  +++|      CM$CODE[0] = CUBSTAT"SUBFAM";
00589  M01S00589.sx3ucp  +++|      CM$CSND[0] = "        ";
00590  M01S00590.sx3ucp  +++|      MPUTENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
00591  M01S00591.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
00592  M01S00592.sx3ucp  +++|      THEN
00593  M01S00593.sx3ucp  +++|        BEGIN
00594  M01S00594.sx3ucp  +++|        GOTO ERRORTN;
00595  M01S00595.sx3ucp  +++|        END
00596  M01S00596.sx3ucp  +++|
00597  M01S00597.sx3ucp  +++|
00598  M01S00598.sx3ucp  +++|
00599  M01S00599.sx3ucp  +++|
00600  M01S00600.sx3ucp  +++|
00601  M01S00601.sx3ucp  +++|#
00602  M01S00602.sx3ucp  +++|*     RETURN THE RESPONSE TO THE UCP, REWRITE THE ALLOCATION
00603  M01S00603.sx3ucp  +++|*     SUMMARY TABLE, AND RETURN TO THE CALLER.
00604  M01S00604.sx3ucp  +++|#
00605  M01S00605.sx3ucp  +++|
00606  M01S00606.sx3ucp  +++|ERRORTN:
00607  M01S00607.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00608  M01S00608.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
00609  M01S00609.sx3ucp  +++|      RLS$FCT(FCTEADDR,0,ERRSTAT);
00610  M01S00610.sx3ucp  +++|      MFLUSH;
00611  M01S00611.sx3ucp  +++|      UCP$RES;
00612  M01S00612.sx3ucp  +++|      RETURN;
00613  M01S00613.sx3ucp  +++|
00614  M01S00614.sx3ucp  +++|      END  # ADDCUBE #
00615  M01S00615.sx3ucp  +++|
00616  M01S00616.sx3ucp  +++|    TERM
00617  M01S00617.sx3ucp  +++|PROC CONVER3((REQTYPE),(REQCODE),(MCSTAT),RSTATUS);
00618  M01S00618.sx3ucp  +++|# TITLE CONVER3 - CONVERT MAP/CATALOG ERRORS TO *UCP* ERRORS.         #
00619  M01S00619.sx3ucp  +++|
00620  M01S00620.sx3ucp  +++|      BEGIN  # CONVER3 #
00621  M01S00621.sx3ucp  +++|
00622  M01S00622.sx3ucp  +++|#
00623  M01S00623.sx3ucp  +++|**    CONVER3 - CONVERT MAP/CATALOG ERRORS TO *UCP* ERRORS.
00624  M01S00624.sx3ucp  +++|*
00625  M01S00625.sx3ucp  +++|*     PROC CONVER3((REQTYPE),(REQCODE),(MCSTAT),RSTATUS)
00626  M01S00626.sx3ucp  +++|*
00627  M01S00627.sx3ucp  +++|*     ENTRY     REQTYPE - REQUEST TYPE (TYPE 3).
00628  M01S00628.sx3ucp  +++|*               REQCODE - REQUEST CODE (VALID TYPE 3 CODE).
00629  M01S00629.sx3ucp  +++|*               MCSTAT  - MAP/CATALOG ERROR CODE.
00630  M01S00630.sx3ucp  +++|*
00631  M01S00631.sx3ucp  +++|*     EXIT      RSTATUS - *UCP* ERROR CODE.
00632  M01S00632.sx3ucp  +++|*
00633  M01S00633.sx3ucp  +++|*     MESSAGES  * EXEC ABNORMAL, CONVER3. *
00634  M01S00634.sx3ucp  +++|#
00635  M01S00635.sx3ucp  +++|
00636  M01S00636.sx3ucp  +++|      ITEM REQTYPE    U;             # REQUEST TYPE #
00637  M01S00637.sx3ucp  +++|      ITEM REQCODE    U;             # REQUEST CODE #
00638  M01S00638.sx3ucp  +++|      ITEM MCSTAT     U;             # MAP/CATALOG ERROR CODE #
00639  M01S00639.sx3ucp  +++|      ITEM RSTATUS    U;             # *UCP* ERROR CODE RETURNED #
00640  M01S00640.sx3ucp  +++|
00641  M01S00641.sx3ucp  +++|#
00642  M01S00642.sx3ucp  +++|****  PROC CONVER3 - XREF LIST BEGIN.
00643  M01S00643.sx3ucp  +++|#
00644  M01S00644.sx3ucp  +++|
00645  M01S00645.sx3ucp  +++|      XREF
00646  M01S00646.sx3ucp  +++|        BEGIN
00647  M01S00647.sx3ucp  +++|        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
00648  M01S00648.sx3ucp  +++|        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
00649  M01S00649.sx3ucp  +++|        END
00650  M01S00650.sx3ucp  +++|
00651  M01S00651.sx3ucp  +++|#
00652  M01S00652.sx3ucp  +++|****  PROC CONVER3 - XREF LIST END.
00653  M01S00653.sx3ucp  +++|#
00654  M01S00654.sx3ucp  +++|
00655  M01S00655.sx3ucp  +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
00656  M01S00656.sx3ucp  +++|*CALL COMBFAS
00657  M01S00657.sx3ucp  +++|*CALL COMBCMS
00658  M01S00658.sx3ucp  +++|*CALL COMBCPR
00659  M01S00659.sx3ucp  +++|*CALL,COMXMSC
00660  M01S00660.sx3ucp  +++|
00661  M01S00661.sx3ucp  +++|      ARRAY ERRMAP [CMASTAT"NOERR":CMASTAT"STATLAST"] P(1);
00662  M01S00662.sx3ucp  +++|        BEGIN
00663  M01S00663.sx3ucp  +++|        ITEM ERR$RCV    U(00,00,60)   =  [  # RESPONSE CODE VALIDITY #
00664  M01S00664.sx3ucp  +++|        O"37777000000000000000",     # NO ERROR #
00665  M01S00665.sx3ucp  +++|        O"37775000000000000000",     # FILE INTERLOCKED #
00666  M01S00666.sx3ucp  +++|        O"00000000000000000000",     # FILE ALREADY OPEN #
00667  M01S00667.sx3ucp  +++|        O"37774000000000000000",     # FILE NOT OPEN #
00668  M01S00668.sx3ucp  +++|        O"00000000000000000000",     # FILE NOT OPEN IN *MODIFY* MODE #
00669  M01S00669.sx3ucp  +++|        O"00000000000000000000",     # FILE ALREADY INITIALIZED #
00670  M01S00670.sx3ucp  +++|        O"04000000000000000000",     # SUBCATALOG ALREADY EXISTS #
00671  M01S00671.sx3ucp  +++|        O"37674000000000000000",     # NO SUCH SUBCATALOG #
00672  M01S00672.sx3ucp  +++|        O"37775000000000000000",     # *CIO* ERROR #
00673  M01S00673.sx3ucp  +++|        O"33370000000000000000",     # ORDINAL OUT OF RANGE #
00674  M01S00674.sx3ucp  +++|        O"00001000000000000000",     # MAP/CATALOG *ATTACH* ERROR #
00675  M01S00675.sx3ucp  +++|        O"00000000000000000000",     # MAP/CATALOG *DEFINE* ERROR #
00676  M01S00676.sx3ucp  +++|        O"24400000000000000000",     # TEMPORARY FILE *DEFINE* ERROR #
00677  M01S00677.sx3ucp  +++|        O"24400000000000000000",     # TEMPORARY FILE *ATTACH* ERROR #
00678  M01S00678.sx3ucp  +++|        O"24400000000000000000",     # TEMPORARY FILE *PURGE* ERROR #
00679  M01S00679.sx3ucp  +++|        O"24400000000000000000",     # TEMPORARY FILE *RENAME* ERROR #
00680  M01S00680.sx3ucp  +++|        O"00000000000000000000",     # *OCT* FULL #
00681  M01S00681.sx3ucp  +++|        ];
00682  M01S00682.sx3ucp  +++|        END
00683  M01S00683.sx3ucp  +++|
00684  M01S00684.sx3ucp  +++|      SWITCH CONV$LIST:CMASTAT       # CONVERSION LIST #
00685  M01S00685.sx3ucp  +++|                 CONV0:NOERR,        # NO ERROR #
00686  M01S00686.sx3ucp  +++|                 CONV1:INTLK,        # FILE INTERLOCKED #
00687  M01S00687.sx3ucp  +++|                 CONV2:NOTOPEN,      # FILE NOT OPENED #
00688  M01S00688.sx3ucp  +++|                 CONV4:SCEXISTS,     # SUBCATALOG ALREADY EXISTS #
00689  M01S00689.sx3ucp  +++|                 CONV5:NOSUBCAT,     # NO SUCH SUBCATALOG #
00690  M01S00690.sx3ucp  +++|                 CONV6:CIOERR,       # *CIO* ERROR #
00691  M01S00691.sx3ucp  +++|                 CONV8:ORDERR,       # ORDINAL OUT OF RANGE #
00692  M01S00692.sx3ucp  +++|                 CONV6:ATTERR,       # MAP/CATALOG *ATTACH* ERROR #
00693  M01S00693.sx3ucp  +++|                 CONV6:DEFERR,       # MAP/CATALOG *DEFINE* ERROR #
00694  M01S00694.sx3ucp  +++|                 CONV6:TDEFERR,      # TEMPORARY FILE *DEFINE* ERROR #
00695  M01S00695.sx3ucp  +++|                 CONV6:TATTERR,      # TEMPORARY FILE *ATTACH* ERROR #
00696  M01S00696.sx3ucp  +++|                 CONV6:TPRGERR,      # TEMPORARY FILE *PURGE* ERROR #
00697  M01S00697.sx3ucp  +++|                 CONV6:TRNMERR;      # TEMPORARY FILE *RENAME* ERROR #
00698  M01S00698.sx3ucp  +++|                                               CONTROL EJECT;
00699  M01S00699.sx3ucp  +++|
00700  M01S00700.sx3ucp  +++|#
00701  M01S00701.sx3ucp  +++|*     TEST FOR AN INVALID ERROR CODE.
00702  M01S00702.sx3ucp  +++|#
00703  M01S00703.sx3ucp  +++|
00704  M01S00704.sx3ucp  +++|      IF REQTYPE NQ TYP"TYP3"        ##
00705  M01S00705.sx3ucp  +++|        OR MCSTAT GQ CMASTAT"STATLAST"  ##
00706  M01S00706.sx3ucp  +++|        OR REQCODE GQ REQTYP3"LSTREQTYP3"  ##
00707  M01S00707.sx3ucp  +++|        OR B<REQCODE,1>ERR$RCV[MCSTAT] EQ 0
00708  M01S00708.sx3ucp  +++|      THEN
00709  M01S00709.sx3ucp  +++|        BEGIN
00710  M01S00710.sx3ucp  +++|        FE$RTN[0] = "CONVER3.";
00711  M01S00711.sx3ucp  +++|        MESSAGE(FEMSG[0],UDFL1);
00712  M01S00712.sx3ucp  +++|        ABORT;
00713  M01S00713.sx3ucp  +++|        END
00714  M01S00714.sx3ucp  +++|
00715  M01S00715.sx3ucp  +++|#
00716  M01S00716.sx3ucp  +++|*     SIMULATED CASE STATEMENT TO CONVERT THE MAP/CATALOG ERROR CODE
00717  M01S00717.sx3ucp  +++|*     TO THE APPROPRIATE *UCP* ERROR CODE.
00718  M01S00718.sx3ucp  +++|#
00719  M01S00719.sx3ucp  +++|
00720  M01S00720.sx3ucp  +++|      GOTO CONV$LIST[MCSTAT];
00721  M01S00721.sx3ucp  +++|
00722  M01S00722.sx3ucp  +++|CONV0:                               # NO ERROR #
00723  M01S00723.sx3ucp  +++|      RSTATUS = RESPTYP3"OK3";
00724  M01S00724.sx3ucp  +++|      RETURN;
00725  M01S00725.sx3ucp  +++|
00726  M01S00726.sx3ucp  +++|CONV1:                               # CATALOG/MAP INTERLOCKED #
00727  M01S00727.sx3ucp  +++|      RSTATUS = RESPTYP3"C$M$INTLCK";
00728  M01S00728.sx3ucp  +++|      RETURN;
00729  M01S00729.sx3ucp  +++|
00730  M01S00730.sx3ucp  +++|CONV2:                               # CATALOG/MAP NOT OPEN #
00731  M01S00731.sx3ucp  +++|      RSTATUS = RESPTYP3"C$M$NOPEN";
00732  M01S00732.sx3ucp  +++|      RETURN;
00733  M01S00733.sx3ucp  +++|
00734  M01S00734.sx3ucp  +++|CONV4:                               # SUBCATALOG ALREADY EXISTS #
00735  M01S00735.sx3ucp  +++|      RSTATUS = RESPTYP3"SUB$CAT$EX";
00736  M01S00736.sx3ucp  +++|      RETURN;
00737  M01S00737.sx3ucp  +++|
00738  M01S00738.sx3ucp  +++|CONV5:                               # NO SUCH SUBCATALOG #
00739  M01S00739.sx3ucp  +++|      RSTATUS = RESPTYP3"NO$SUB$CAT";
00740  M01S00740.sx3ucp  +++|      RETURN;
00741  M01S00741.sx3ucp  +++|
00742  M01S00742.sx3ucp  +++|CONV6:                               # PERMANENT FILE PROBLEM #
00743  M01S00743.sx3ucp  +++|      RSTATUS = RESPTYP3"PF$PROB";
00744  M01S00744.sx3ucp  +++|      RETURN;
00745  M01S00745.sx3ucp  +++|
00746  M01S00746.sx3ucp  +++|CONV8:                               # ORDINAL OUT OF RANGE #
00747  M01S00747.sx3ucp  +++|      RSTATUS = RESPTYP3"ILLEG$ORD";
00748  M01S00748.sx3ucp  +++|      RETURN;
00749  M01S00749.sx3ucp  +++|
00750  M01S00750.sx3ucp  +++|#
00751  M01S00751.sx3ucp  +++|*     END SIMULATED CASE STATEMENT TO CONVERT THE MAP/CATALOG
00752  M01S00752.sx3ucp  +++|*     ERROR CODE TO THE APPROPRIATE *UCP* ERROR CODE.
00753  M01S00753.sx3ucp  +++|#
00754  M01S00754.sx3ucp  +++|
00755  M01S00755.sx3ucp  +++|      END  # CONVER3 #
00756  M01S00756.sx3ucp  +++|
00757  M01S00757.sx3ucp  +++|    TERM
00758  M01S00758.sx3ucp  +++|PROC GETPD;
00759  M01S00759.sx3ucp  +++|# TITLE GETPD - RETURNS LAST *PRG$ORPH* DATE AND TIME.                #
00760  M01S00760.sx3ucp  +++|
00761  M01S00761.sx3ucp  +++|      BEGIN  # GETPD #
00762  M01S00762.sx3ucp  +++|
00763  M01S00763.sx3ucp  +++|#
00764  M01S00764.sx3ucp  +++|**    GETPD - RETURNS LAST *PRG$ORPH* DATE AND TIME.
00765  M01S00765.sx3ucp  +++|*     *GETPD* RETURNS THE DATE AND TIME AT WHICH THE LAST
00766  M01S00766.sx3ucp  +++|*     *PRG$ORPH* REQUEST FROM *SSVAL* WAS PROCESSED.
00767  M01S00767.sx3ucp  +++|*     THE DATE AND TIME IS RETURNED VIA THE *CSN* FIELD
00768  M01S00768.sx3ucp  +++|*     OF THE RESPONSE WORD.
00769  M01S00769.sx3ucp  +++|*
00770  M01S00770.sx3ucp  +++|*     PROC GETPD
00771  M01S00771.sx3ucp  +++|*
00772  M01S00772.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
00773  M01S00773.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
00774  M01S00774.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
00775  M01S00775.sx3ucp  +++|*               *LTCENTRY*.
00776  M01S00776.sx3ucp  +++|*
00777  M01S00777.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
00778  M01S00778.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
00779  M01S00779.sx3ucp  +++|*               OF THE REQUEST.
00780  M01S00780.sx3ucp  +++|*
00781  M01S00781.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
00782  M01S00782.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
00783  M01S00783.sx3ucp  +++|*                    = OK3             OK
00784  M01S00784.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
00785  M01S00785.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
00786  M01S00786.sx3ucp  +++|*                    = RESUB$REQ       RESUBMIT REQUEST
00787  M01S00787.sx3ucp  +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
00788  M01S00788.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
00789  M01S00789.sx3ucp  +++|#
00790  M01S00790.sx3ucp  +++|
00791  M01S00791.sx3ucp  +++|#
00792  M01S00792.sx3ucp  +++|****  PROC GETPD - XREF LIST BEGIN.
00793  M01S00793.sx3ucp  +++|#
00794  M01S00794.sx3ucp  +++|
00795  M01S00795.sx3ucp  +++|      XREF
00796  M01S00796.sx3ucp  +++|        BEGIN
00797  M01S00797.sx3ucp  +++|        PROC CGETPD;                 # GET PURGE DATE #
00798  M01S00798.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
00799  M01S00799.sx3ucp  +++|                                       *UCP* ERRORS #
00800  M01S00800.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
00801  M01S00801.sx3ucp  +++|                                     #
00802  M01S00802.sx3ucp  +++|        END
00803  M01S00803.sx3ucp  +++|
00804  M01S00804.sx3ucp  +++|#
00805  M01S00805.sx3ucp  +++|****  PROC GETPD - XREF LIST END.
00806  M01S00806.sx3ucp  +++|#
00807  M01S00807.sx3ucp  +++|
00808  M01S00808.sx3ucp  +++|
00809  M01S00809.sx3ucp  +++|
00810  M01S00810.sx3ucp  +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
00811  M01S00811.sx3ucp  +++|*CALL COMBFAS
00812  M01S00812.sx3ucp  +++|*CALL COMBCPR
00813  M01S00813.sx3ucp  +++|*CALL COMBMAP
00814  M01S00814.sx3ucp  +++|*CALL COMXLTC
00815  M01S00815.sx3ucp  +++|
00816  M01S00816.sx3ucp  +++|      ITEM LASTPRG    U;             # LAST PURGE DATE AND TIME #
00817  M01S00817.sx3ucp  +++|
00818  M01S00818.sx3ucp  +++|
00819  M01S00819.sx3ucp  +++|
00820  M01S00820.sx3ucp  +++|
00821  M01S00821.sx3ucp  +++|
00822  M01S00822.sx3ucp  +++|      CGETPD(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],LASTPRG,0,ERRSTAT);
00823  M01S00823.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00824  M01S00824.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
00825  M01S00825.sx3ucp  +++|      LTC$DATE[LTCENTRY] = LASTPRG;
00826  M01S00826.sx3ucp  +++|      UCP$RES;
00827  M01S00827.sx3ucp  +++|      RETURN;
00828  M01S00828.sx3ucp  +++|
00829  M01S00829.sx3ucp  +++|      END  # GETPD #
00830  M01S00830.sx3ucp  +++|
00831  M01S00831.sx3ucp  +++|    TERM
00832  M01S00832.sx3ucp  +++|PROC LOANFCTQ(ACTION);
00833  M01S00833.sx3ucp  +++|
00834  M01S00834.sx3ucp  +++|# TITLE LOANFCTQ - ADD OR RECLAIM AN *FCTQ* ENTRY FOR *UCP* PROCS.    #
00835  M01S00835.sx3ucp  +++|
00836  M01S00836.sx3ucp  +++|      BEGIN  # LOANFCTQ #
00837  M01S00837.sx3ucp  +++|
00838  M01S00838.sx3ucp  +++|#
00839  M01S00839.sx3ucp  +++|**    LOANFCTQ - ADD OR RECLAIM AN *FCTQ* ENTRY FOR *UCP* PROCESSING.
00840  M01S00840.sx3ucp  +++|*
00841  M01S00841.sx3ucp  +++|*     THIS PROCEDURE PROVIDES AN *FCTQ* ENTRY WHICH CAN BE USED
00842  M01S00842.sx3ucp  +++|*     BY THE CALLING *UCP* REQUEST PROCESSOR IN THE EVENT THE NORMAL
00843  M01S00843.sx3ucp  +++|*     *FCTQ* ENTRIES ARE IN USE BY *HLRQ* PROCESSING.  THE CALLING
00844  M01S00844.sx3ucp  +++|*     PROCEDURES RULES ARE TO CALL *LOANFCTQ* PRIOR TO THE *ACQ$FCT*
00845  M01S00845.sx3ucp  +++|*     CALL TO ENSURE AN AVAILABLE *FCTQ* ENTRY.  AFTER CALLING
00846  M01S00846.sx3ucp  +++|*     *RLS$FCT*, *LOANFCTQ* IS AGAIN CALLED TO TAKE THE TEMPORARY
00847  M01S00847.sx3ucp  +++|*     *FCTQ* ENTRY OUT OF THE *FCTQ* FREE SPACE CHAIN.
00848  M01S00848.sx3ucp  +++|*
00849  M01S00849.sx3ucp  +++|*     PROC LOANFCTQ(ACTION)
00850  M01S00850.sx3ucp  +++|*
00851  M01S00851.sx3ucp  +++|*     ENTRY     ACTION = 0, AN *FCTQ* ENTRY TO BE MADE AVAILABLE.
00852  M01S00852.sx3ucp  +++|*                      = X, THE *FCTQ* ENTRY IS TO BE RECLAIMED.
00853  M01S00853.sx3ucp  +++|*
00854  M01S00854.sx3ucp  +++|*     EXIT      THE *FCTQ* FREE SPACE CHAIN IS PROPERLY ADJUSTED.
00855  M01S00855.sx3ucp  +++|#
00856  M01S00856.sx3ucp  +++|
00857  M01S00857.sx3ucp  +++|      ITEM ACTION     U;             # REQUESTED PROCESSING ACTION #
00858  M01S00858.sx3ucp  +++|
00859  M01S00859.sx3ucp  +++|#
00860  M01S00860.sx3ucp  +++|****  PROC LOANFCTQ - XREF LIST BEGIN.
00861  M01S00861.sx3ucp  +++|#
00862  M01S00862.sx3ucp  +++|
00863  M01S00863.sx3ucp  +++|      XREF
00864  M01S00864.sx3ucp  +++|        BEGIN
00865  M01S00865.sx3ucp  +++|        PROC ADD$LNK;                # ADD ENTRY TO A CHAIN #
00866  M01S00866.sx3ucp  +++|        PROC DEL$LNK;                # DELETE ENTRY FROM A CHAIN #
00867  M01S00867.sx3ucp  +++|        PROC ZFILL;                  # ZERO FILL AN ARRAY #
00868  M01S00868.sx3ucp  +++|        END
00869  M01S00869.sx3ucp  +++|
00870  M01S00870.sx3ucp  +++|#
00871  M01S00871.sx3ucp  +++|****  PROC LOANFCTQ - XREF LIST END.
00872  M01S00872.sx3ucp  +++|#
00873  M01S00873.sx3ucp  +++|
00874  M01S00874.sx3ucp  +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
00875  M01S00875.sx3ucp  +++|
00876  M01S00876.sx3ucp  +++|*CALL,COMBFAS
00877  M01S00877.sx3ucp  +++|*CALL,COMBCHN
00878  M01S00878.sx3ucp  +++|*CALL,COMBMCT
00879  M01S00879.sx3ucp  +++|*CALL,COMXFCQ
00880  M01S00880.sx3ucp  +++|
00881  M01S00881.sx3ucp  +++|      ARRAY LOANERFCTQ [0:0] S(FCTQHL);;  # *FCTQ* HEADER #
00882  M01S00882.sx3ucp  +++|      ARRAY LOANERFCT [0:0] S(FCTENTL);;  # *FCT* ENTRY #
00883  M01S00883.sx3ucp  +++|
00884  M01S00884.sx3ucp  +++|
00885  M01S00885.sx3ucp  +++|      IF ACTION EQ 0
00886  M01S00886.sx3ucp  +++|      THEN
00887  M01S00887.sx3ucp  +++|        BEGIN
00888  M01S00888.sx3ucp  +++|        ZFILL(LOANERFCTQ[0],FCTQHL+FCTENTL);
00889  M01S00889.sx3ucp  +++|        ADD$LNK(LOC(LOANERFCTQ[0]),LCHN"FCT$FRSPC",0);
00890  M01S00890.sx3ucp  +++|        END
00891  M01S00891.sx3ucp  +++|
00892  M01S00892.sx3ucp  +++|      ELSE
00893  M01S00893.sx3ucp  +++|        BEGIN
00894  M01S00894.sx3ucp  +++|        DEL$LNK(LOC(LOANERFCTQ[0]),LCHN"FCT$FRSPC",0);
00895  M01S00895.sx3ucp  +++|        END
00896  M01S00896.sx3ucp  +++|
00897  M01S00897.sx3ucp  +++|      RETURN;
00898  M01S00898.sx3ucp  +++|      END  # LOANFCTQ #
00899  M01S00899.sx3ucp  +++|
00900  M01S00900.sx3ucp  +++|    TERM
00901  M01S00901.sx3ucp  +++|PROC MAPRCLM;
00902  M01S00902.sx3ucp  +++|# TITLE MAPRCLM - RE-ATTACHES DESIGNATED MAP FILE.                    #
00903  M01S00903.sx3ucp  +++|
00904  M01S00904.sx3ucp  +++|      BEGIN  # MAPRCLM #
00905  M01S00905.sx3ucp  +++|
00906  M01S00906.sx3ucp  +++|#
00907  M01S00907.sx3ucp  +++|**    MAPRCLM - RE-ATTACHES DESIGNATED MAP FILE.
00908  M01S00908.sx3ucp  +++|*
00909  M01S00909.sx3ucp  +++|*     *MAPRCLM* RE-ATTACHES THE DESIGNATED MAP FILE.
00910  M01S00910.sx3ucp  +++|*
00911  M01S00911.sx3ucp  +++|*     PROC MAPRCLM
00912  M01S00912.sx3ucp  +++|*
00913  M01S00913.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
00914  M01S00914.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
00915  M01S00915.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
00916  M01S00916.sx3ucp  +++|*               *LTCENTRY*.
00917  M01S00917.sx3ucp  +++|*
00918  M01S00918.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
00919  M01S00919.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
00920  M01S00920.sx3ucp  +++|*               OF THE REQUEST.
00921  M01S00921.sx3ucp  +++|*
00922  M01S00922.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
00923  M01S00923.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
00924  M01S00924.sx3ucp  +++|*                    = OK3             OK
00925  M01S00925.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
00926  M01S00926.sx3ucp  +++|*
00927  M01S00927.sx3ucp  +++|*     MESSAGES  * EXEC ABNORMAL, MAPRCLM.*
00928  M01S00928.sx3ucp  +++|#
00929  M01S00929.sx3ucp  +++|
00930  M01S00930.sx3ucp  +++|#
00931  M01S00931.sx3ucp  +++|****  PROC MAPRCLM - XREF LIST BEGIN.
00932  M01S00932.sx3ucp  +++|#
00933  M01S00933.sx3ucp  +++|
00934  M01S00934.sx3ucp  +++|      XREF
00935  M01S00935.sx3ucp  +++|        BEGIN
00936  M01S00936.sx3ucp  +++|        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
00937  M01S00937.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
00938  M01S00938.sx3ucp  +++|                                       *UCP* ERRORS #
00939  M01S00939.sx3ucp  +++|        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
00940  M01S00940.sx3ucp  +++|        PROC MRCLMLK;                # RECLAIM MAP INTERLOCK. #
00941  M01S00941.sx3ucp  +++|        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
00942  M01S00942.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST
00943  M01S00943.sx3ucp  +++|                                       COMPLETE. #
00944  M01S00944.sx3ucp  +++|        END
00945  M01S00945.sx3ucp  +++|
00946  M01S00946.sx3ucp  +++|#
00947  M01S00947.sx3ucp  +++|****  PROC MAPRCLM - XREF LIST END.
00948  M01S00948.sx3ucp  +++|#
00949  M01S00949.sx3ucp  +++|
00950  M01S00950.sx3ucp  +++|      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
00951  M01S00951.sx3ucp  +++|*CALL COMBFAS
00952  M01S00952.sx3ucp  +++|*CALL COMBCPR
00953  M01S00953.sx3ucp  +++|*CALL COMBMAP
00954  M01S00954.sx3ucp  +++|*CALL COMBPFP
00955  M01S00955.sx3ucp  +++|*CALL COMXLTC
00956  M01S00956.sx3ucp  +++|*CALL COMXMSC
00957  M01S00957.sx3ucp  +++|
00958  M01S00958.sx3ucp  +++|
00959  M01S00959.sx3ucp  +++|
00960  M01S00960.sx3ucp  +++|
00961  M01S00961.sx3ucp  +++|
00962  M01S00962.sx3ucp  +++|      PFP$WRD0[0] = 0;               # SET FAMILY AND USER INDEX #
00963  M01S00963.sx3ucp  +++|      PFP$FG1[0] = TRUE;
00964  M01S00964.sx3ucp  +++|      PFP$FG4[0] = TRUE;
00965  M01S00965.sx3ucp  +++|      PFP$FAM[0] = DEF$FAM;
00966  M01S00966.sx3ucp  +++|      PFP$UI[0] = DEF$UI;
00967  M01S00967.sx3ucp  +++|      SETPFP(PFP);
00968  M01S00968.sx3ucp  +++|      IF PFP$STAT[0] NQ 0
00969  M01S00969.sx3ucp  +++|      THEN                           # FAMILY NOT FOUND #
00970  M01S00970.sx3ucp  +++|        BEGIN
00971  M01S00971.sx3ucp  +++|        FE$RTN[0] = "MAPRCLM.";
00972  M01S00972.sx3ucp  +++|        MESSAGE(FEMSG[0],UDFL1);     # ISSUE ERROR MESSAGE #
00973  M01S00973.sx3ucp  +++|        ABORT;
00974  M01S00974.sx3ucp  +++|        END
00975  M01S00975.sx3ucp  +++|
00976  M01S00976.sx3ucp  +++|      MRCLMLK(CPR$CSU[0],ERRSTAT);
00977  M01S00977.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
00978  M01S00978.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
00979  M01S00979.sx3ucp  +++|      UCP$RES;
00980  M01S00980.sx3ucp  +++|      RETURN;
00981  M01S00981.sx3ucp  +++|
00982  M01S00982.sx3ucp  +++|      END  # MAPRCLM #
00983  M01S00983.sx3ucp  +++|
00984  M01S00984.sx3ucp  +++|    TERM
00985  M01S00985.sx3ucp  +++|PROC MAPRELS;
00986  M01S00986.sx3ucp  +++|# TITLE MAPRELS - RETURNS THE DESIGNATED MAP FILE.                    #
00987  M01S00987.sx3ucp  +++|
00988  M01S00988.sx3ucp  +++|      BEGIN  # MAPRELS #
00989  M01S00989.sx3ucp  +++|
00990  M01S00990.sx3ucp  +++|#
00991  M01S00991.sx3ucp  +++|**    MAPRELS - RETURNS THE DESIGNATED MAP FILE.
00992  M01S00992.sx3ucp  +++|*
00993  M01S00993.sx3ucp  +++|*     *MAPRELS* RETURNS THE DESIGNATED MAP FILE.
00994  M01S00994.sx3ucp  +++|*
00995  M01S00995.sx3ucp  +++|*     PROC MAPRELS
00996  M01S00996.sx3ucp  +++|*
00997  M01S00997.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
00998  M01S00998.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
00999  M01S00999.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
01000  M01S01000.sx3ucp  +++|*               *LTCENTRY*.
01001  M01S01001.sx3ucp  +++|*
01002  M01S01002.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
01003  M01S01003.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
01004  M01S01004.sx3ucp  +++|*               OF THE REQUEST.
01005  M01S01005.sx3ucp  +++|*
01006  M01S01006.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
01007  M01S01007.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
01008  M01S01008.sx3ucp  +++|*                    = OK3             OK
01009  M01S01009.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
01010  M01S01010.sx3ucp  +++|#
01011  M01S01011.sx3ucp  +++|
01012  M01S01012.sx3ucp  +++|#
01013  M01S01013.sx3ucp  +++|****  PROC MAPRELS - XREF LIST BEGIN.
01014  M01S01014.sx3ucp  +++|#
01015  M01S01015.sx3ucp  +++|
01016  M01S01016.sx3ucp  +++|      XREF
01017  M01S01017.sx3ucp  +++|        BEGIN
01018  M01S01018.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
01019  M01S01019.sx3ucp  +++|                                       *UCP* ERRORS #
01020  M01S01020.sx3ucp  +++|        PROC MRELSLK;                # RETURN A MAP FILE #
01021  M01S01021.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
01022  M01S01022.sx3ucp  +++|                                     #
01023  M01S01023.sx3ucp  +++|        END
01024  M01S01024.sx3ucp  +++|
01025  M01S01025.sx3ucp  +++|#
01026  M01S01026.sx3ucp  +++|****  PROC MAPRELS - XREF LIST END.
01027  M01S01027.sx3ucp  +++|#
01028  M01S01028.sx3ucp  +++|
01029  M01S01029.sx3ucp  +++|      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
01030  M01S01030.sx3ucp  +++|*CALL COMBFAS
01031  M01S01031.sx3ucp  +++|*CALL COMBCPR
01032  M01S01032.sx3ucp  +++|*CALL COMXLTC
01033  M01S01033.sx3ucp  +++|
01034  M01S01034.sx3ucp  +++|
01035  M01S01035.sx3ucp  +++|
01036  M01S01036.sx3ucp  +++|
01037  M01S01037.sx3ucp  +++|
01038  M01S01038.sx3ucp  +++|      LTC$RQR[LTCENTRY] = RESPTYP3"OK3";
01039  M01S01039.sx3ucp  +++|      MRELSLK(CPR$CSU[0]);
01040  M01S01040.sx3ucp  +++|      UCP$RES;
01041  M01S01041.sx3ucp  +++|      RETURN;
01042  M01S01042.sx3ucp  +++|
01043  M01S01043.sx3ucp  +++|      END  # MAPRELS #
01044  M01S01044.sx3ucp  +++|
01045  M01S01045.sx3ucp  +++|    TERM
01046  M01S01046.sx3ucp  +++|PROC NONQ$RP;
01047  M01S01047.sx3ucp  +++|# TITLE NONQ$RP - PRELIMINARY PROCESSING OF TYPE 3 REQUEST.           #
01048  M01S01048.sx3ucp  +++|
01049  M01S01049.sx3ucp  +++|      BEGIN  # NONQ$RP #
01050  M01S01050.sx3ucp  +++|
01051  M01S01051.sx3ucp  +++|
01052  M01S01052.sx3ucp  +++|#
01053  M01S01053.sx3ucp  +++|**    NONQ$RP - PRELIMINARY PROCESSING OF TYPE 3 REQUEST.
01054  M01S01054.sx3ucp  +++|*
01055  M01S01055.sx3ucp  +++|*     *NONQ$RP DOES PRELIMINARY PROCESSING OF TYPE 3 *UCP* REQUESTS
01056  M01S01056.sx3ucp  +++|*     AND CALLS THE PROPER MODULE TO DO THE DETAILED PROCESSING OF
01057  M01S01057.sx3ucp  +++|*     THE REQUESTS.
01058  M01S01058.sx3ucp  +++|*
01059  M01S01059.sx3ucp  +++|*     PROC NONQ$RP
01060  M01S01060.sx3ucp  +++|*
01061  M01S01061.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
01062  M01S01062.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
01063  M01S01063.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
01064  M01S01064.sx3ucp  +++|*               *LTCENTRY*.
01065  M01S01065.sx3ucp  +++|*
01066  M01S01066.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
01067  M01S01067.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
01068  M01S01068.sx3ucp  +++|*               OF THE REQUEST.
01069  M01S01069.sx3ucp  +++|#
01070  M01S01070.sx3ucp  +++|
01071  M01S01071.sx3ucp  +++|#
01072  M01S01072.sx3ucp  +++|****  PROC NONQ$RP - XREF LIST BEGIN.
01073  M01S01073.sx3ucp  +++|#
01074  M01S01074.sx3ucp  +++|
01075  M01S01075.sx3ucp  +++|      XREF
01076  M01S01076.sx3ucp  +++|        BEGIN
01077  M01S01077.sx3ucp  +++|        PROC KILL$UC;                # ABORT A *UCP* #
01078  M01S01078.sx3ucp  +++|        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS #
01079  M01S01079.sx3ucp  +++|        END
01080  M01S01080.sx3ucp  +++|
01081  M01S01081.sx3ucp  +++|#
01082  M01S01082.sx3ucp  +++|****  PROC NONQ$RP - XREF LIST END.
01083  M01S01083.sx3ucp  +++|#
01084  M01S01084.sx3ucp  +++|
01085  M01S01085.sx3ucp  +++|
01086  M01S01086.sx3ucp  +++|      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
01087  M01S01087.sx3ucp  +++|*CALL COMBFAS
01088  M01S01088.sx3ucp  +++|*CALL COMBCPR
01089  M01S01089.sx3ucp  +++|*CALL COMBOVL
01090  M01S01090.sx3ucp  +++|*CALL COMBUCR
01091  M01S01091.sx3ucp  +++|*CALL COMXMSC
01092  M01S01092.sx3ucp  +++|
01093  M01S01093.sx3ucp  +++|#
01094  M01S01094.sx3ucp  +++|*     SWITCH LIST TO PROCESS THE TYPE 3 REQUESTS.
01095  M01S01095.sx3ucp  +++|#
01096  M01S01096.sx3ucp  +++|
01097  M01S01097.sx3ucp  +++|      SWITCH TYP3SW:REQTYP3
01098  M01S01098.sx3ucp  +++|           ADDCUBEL:ADD$CUBE,
01099  M01S01099.sx3ucp  +++|           ADDCARTL:ADD$CART,
01100  M01S01100.sx3ucp  +++|            ADDCSUL:ADD$CSU,
01101  M01S01101.sx3ucp  +++|            RMVCSUL:RMV$CSU,
01102  M01S01102.sx3ucp  +++|           RMVCUBEL:RMV$CUBE,
01103  M01S01103.sx3ucp  +++|           RMVCARTL:RMV$CART,
01104  M01S01104.sx3ucp  +++|            UPDCATL:UPD$CAT,
01105  M01S01105.sx3ucp  +++|            UPDMAPL:UPD$MAP,

Seq #  *Modification Id* Act 
----------------------------+
01106  M02S01106.sx3ucp1 ---|          PURGORPHL:PURG$ORPH,
01107  M01S00001.sx3ucp1 +++|          RELSETUPL:REL$SETUP,
01108  M01S01107.sx3ucp  +++|          PURGFRAGL:PURG$FRAG,
01109  M01S01108.sx3ucp  +++|           PURGFCTL:PURG$FCT,
01110  M01S01109.sx3ucp  +++|         GTPRGDATEL:GT$PRGDATE,
01111  M01S01110.sx3ucp  +++|           RELMPLKL:REL$MPLK,
01112  M01S01111.sx3ucp  +++|           RECMPLKL:REC$MPLK;
01113  M01S01112.sx3ucp  +++|
01114  M01S01113.sx3ucp  +++|
01115  M01S01114.sx3ucp  +++|
01116  M01S01115.sx3ucp  +++|
01117  M01S01116.sx3ucp  +++|
01118  M01S01117.sx3ucp  +++|#
01119  M01S01118.sx3ucp  +++|*     REQUEST CODE HAS TO BE VALID.
01120  M01S01119.sx3ucp  +++|#
01121  M01S01120.sx3ucp  +++|
01122  M01S01121.sx3ucp  +++|      IF CPR$RQC[0] EQ REQTYP3"RES3"  ##
01123  M01S01122.sx3ucp  +++|        OR CPR$RQC[0] GQ REQTYP3"LSTREQTYP3"
01124  M01S01123.sx3ucp  +++|      THEN
01125  M01S01124.sx3ucp  +++|        BEGIN
01126  M01S01125.sx3ucp  +++|        KILL$UC(KILLCODE"INVRQC");
01127  M01S01126.sx3ucp  +++|        RETURN;
01128  M01S01127.sx3ucp  +++|        END
01129  M01S01128.sx3ucp  +++|
01130  M01S01129.sx3ucp  +++|#
01131  M01S01130.sx3ucp  +++|*     CALL THE APPROPRIATE PROCESSOR AND THEN RETURN TO THE CALLER.
01132  M01S01131.sx3ucp  +++|#
01133  M01S01132.sx3ucp  +++|
01134  M01S01133.sx3ucp  +++|      GOTO TYP3SW[CPR$RQC[0]];
01135  M01S01134.sx3ucp  +++|
01136  M01S01135.sx3ucp  +++|ADDCUBEL:
01137  M01S01136.sx3ucp  +++|      SSOVL(LADDCUBE,0);
01138  M01S01137.sx3ucp  +++|      RETURN;
01139  M01S01138.sx3ucp  +++|
01140  M01S01139.sx3ucp  +++|ADDCARTL:
01141  M01S01140.sx3ucp  +++|      SSOVL(LADDCAR,0);
01142  M01S01141.sx3ucp  +++|      RETURN;
01143  M01S01142.sx3ucp  +++|
01144  M01S01143.sx3ucp  +++|
01145  M01S01144.sx3ucp  +++|ADDCSUL:
01146  M01S01145.sx3ucp  +++|      SSOVL(LADDCSU,0);
01147  M01S01146.sx3ucp  +++|      RETURN;
01148  M01S01147.sx3ucp  +++|
01149  M01S01148.sx3ucp  +++|RMVCUBEL:
01150  M01S01149.sx3ucp  +++|      SSOVL(LRMVCUBE,0);
01151  M01S01150.sx3ucp  +++|      RETURN;
01152  M01S01151.sx3ucp  +++|
01153  M01S01152.sx3ucp  +++|RMVCARTL:
01154  M01S01153.sx3ucp  +++|      SSOVL(LRMVCAR,0);
01155  M01S01154.sx3ucp  +++|      RETURN;
01156  M01S01155.sx3ucp  +++|
01157  M01S01156.sx3ucp  +++|RMVCSUL:
01158  M01S01157.sx3ucp  +++|      SSOVL(LRMVCSU,0);
01159  M01S01158.sx3ucp  +++|      RETURN;
01160  M01S01159.sx3ucp  +++|
01161  M01S01160.sx3ucp  +++|UPDCATL:
01162  M01S01161.sx3ucp  +++|      SSOVL(LUPDCAT,0);
01163  M01S01162.sx3ucp  +++|      RETURN;
01164  M01S01163.sx3ucp  +++|
01165  M01S01164.sx3ucp  +++|UPDMAPL:
01166  M01S01165.sx3ucp  +++|      SSOVL(LUPDMAP,0);
01167  M01S01166.sx3ucp  +++|      RETURN;
01168  M01S01167.sx3ucp  +++|
01169  M01S01168.sx3ucp  +++|PURGFRAGL:

Seq #  *Modification Id* Act 
----------------------------+
01170  M02S01169.sx3ucp1 ---|      SSOVL(LPURGCHN,0);
01171  M01S00002.sx3ucp1 +++|      SSOVL(LRESETUP,0);
01172  M01S01170.sx3ucp  +++|      RETURN;
01173  M01S01171.sx3ucp  +++|

Seq #  *Modification Id* Act 
----------------------------+
01174  M02S01172.sx3ucp1 ---|PURGORPHL:

Seq #  *Modification Id* Act 
----------------------------+
01175  M02S01173.sx3ucp1 ---|      SSOVL(LPURGCHN,0);
01176  M01S00003.sx3ucp1 +++|RELSETUPL:
01177  M01S00004.sx3ucp1 +++|      SSOVL(LRESETUP,0);
01178  M01S01174.sx3ucp  +++|      RETURN;
01179  M01S01175.sx3ucp  +++|
01180  M01S01176.sx3ucp  +++|PURGFCTL:
01181  M01S01177.sx3ucp  +++|      SSOVL(LPURGFCT,0);
01182  M01S01178.sx3ucp  +++|      RETURN;
01183  M01S01179.sx3ucp  +++|
01184  M01S01180.sx3ucp  +++|GTPRGDATEL:
01185  M01S01181.sx3ucp  +++|      SSOVL(LGETPD,0);
01186  M01S01182.sx3ucp  +++|      RETURN;
01187  M01S01183.sx3ucp  +++|
01188  M01S01184.sx3ucp  +++|RELMPLKL:
01189  M01S01185.sx3ucp  +++|      SSOVL(LMAPRELS,0);
01190  M01S01186.sx3ucp  +++|      RETURN;
01191  M01S01187.sx3ucp  +++|
01192  M01S01188.sx3ucp  +++|RECMPLKL:
01193  M01S01189.sx3ucp  +++|      SSOVL(LMAPRCLM,0);
01194  M01S01190.sx3ucp  +++|      RETURN;
01195  M01S01191.sx3ucp  +++|
01196  M01S01192.sx3ucp  +++|      END  # NONQ$RP #
01197  M01S01193.sx3ucp  +++|
01198  M01S01194.sx3ucp  +++|    TERM
01199  M01S01195.sx3ucp  +++|PROC PURGFCT;
01200  M01S01196.sx3ucp  +++|# TITLE PURGFCT - DELETE *FCT* ENTRY FROM USE.                        #
01201  M01S01197.sx3ucp  +++|
01202  M01S01198.sx3ucp  +++|      BEGIN  # PURGFCT #
01203  M01S01199.sx3ucp  +++|
01204  M01S01200.sx3ucp  +++|#
01205  M01S01201.sx3ucp  +++|**    PURGFCT - DELETE *FCT* ENTRY FROM USE.
01206  M01S01202.sx3ucp  +++|*
01207  M01S01203.sx3ucp  +++|*     *PURGFCT* DELETES AN *FCT* ENTRY AND UPDATES THE *AST*
01208  M01S01204.sx3ucp  +++|*     AND PREAMBLE.
01209  M01S01205.sx3ucp  +++|*     *FCT* ENTRY.
01210  M01S01206.sx3ucp  +++|*
01211  M01S01207.sx3ucp  +++|*     PROC PURGFCT
01212  M01S01208.sx3ucp  +++|*
01213  M01S01209.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
01214  M01S01210.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
01215  M01S01211.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
01216  M01S01212.sx3ucp  +++|*               *LTCENTRY*.
01217  M01S01213.sx3ucp  +++|*
01218  M01S01214.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
01219  M01S01215.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
01220  M01S01216.sx3ucp  +++|*               OF THE REQUEST.
01221  M01S01217.sx3ucp  +++|*
01222  M01S01218.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
01223  M01S01219.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
01224  M01S01220.sx3ucp  +++|*                    = OK3             OK
01225  M01S01221.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
01226  M01S01222.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
01227  M01S01223.sx3ucp  +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
01228  M01S01224.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
01229  M01S01225.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
01230  M01S01226.sx3ucp  +++|#
01231  M01S01227.sx3ucp  +++|
01232  M01S01228.sx3ucp  +++|#
01233  M01S01229.sx3ucp  +++|****  PROC PURGFCT - XREF LIST BEGIN.
01234  M01S01230.sx3ucp  +++|#
01235  M01S01231.sx3ucp  +++|
01236  M01S01232.sx3ucp  +++|      XREF
01237  M01S01233.sx3ucp  +++|        BEGIN
01238  M01S01234.sx3ucp  +++|        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
01239  M01S01235.sx3ucp  +++|                                     #
01240  M01S01236.sx3ucp  +++|        PROC ANLZAST;                # ANALYZE *AST* #
01241  M01S01237.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
01242  M01S01238.sx3ucp  +++|        PROC CNTFS;                  # COUNT FREE STREAMS #
01243  M01S01239.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
01244  M01S01240.sx3ucp  +++|                                       *UCP* ERRORS #
01245  M01S01241.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
01246  M01S01242.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
01247  M01S01243.sx3ucp  +++|        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
01248  M01S01244.sx3ucp  +++|        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
01249  M01S01245.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
01250  M01S01246.sx3ucp  +++|                                     #
01251  M01S01247.sx3ucp  +++|        PROC UPDAST;                 # UPDATE THE *AST* #
01252  M01S01248.sx3ucp  +++|        PROC ZFILL;                  # ZERO FILLS A BUFFER #
01253  M01S01249.sx3ucp  +++|        END
01254  M01S01250.sx3ucp  +++|
01255  M01S01251.sx3ucp  +++|#
01256  M01S01252.sx3ucp  +++|****  PROC PURGFCT - XREF LIST END.
01257  M01S01253.sx3ucp  +++|#
01258  M01S01254.sx3ucp  +++|
01259  M01S01255.sx3ucp  +++|      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
01260  M01S01256.sx3ucp  +++|*CALL COMBFAS
01261  M01S01257.sx3ucp  +++|*CALL COMBCHN
01262  M01S01258.sx3ucp  +++|*CALL COMBCMD
01263  M01S01259.sx3ucp  +++|*CALL COMBCMS
01264  M01S01260.sx3ucp  +++|*CALL COMBCPR
01265  M01S01261.sx3ucp  +++|*CALL COMBMAP
01266  M01S01262.sx3ucp  +++|*CALL COMBMCT
01267  M01S01263.sx3ucp  +++|*CALL COMXFCQ
01268  M01S01264.sx3ucp  +++|*CALL COMXLTC
01269  M01S01265.sx3ucp  +++|*CALL COMXMSC
01270  M01S01266.sx3ucp  +++|
01271  M01S01267.sx3ucp  +++|      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
01272  M01S01268.sx3ucp  +++|      ITEM FROMCHAIN  U;             # CHAIN TO MOVE *FCT* ENTRY FROM #
01273  M01S01269.sx3ucp  +++|      ITEM FXL        I;             # INDEX FOR LARGE *AU*S #
01274  M01S01270.sx3ucp  +++|      ITEM FXS        I;             # INDEX FOR SMALL *AU*S #
01275  M01S01271.sx3ucp  +++|      ITEM GPS        I;             # BEST GROUP #
01276  M01S01272.sx3ucp  +++|      ITEM GPX        I;             # BEST ORDINAL #
01277  M01S01273.sx3ucp  +++|      ITEM I          U;             # COUNTER #
01278  M01S01274.sx3ucp  +++|                                               CONTROL EJECT;
01279  M01S01275.sx3ucp  +++|
01280  M01S01276.sx3ucp  +++|#
01281  M01S01277.sx3ucp  +++|*     GET THE *FCTQ* ENTRY FOR THE REQUEST.
01282  M01S01278.sx3ucp  +++|#
01283  M01S01279.sx3ucp  +++|
01284  M01S01280.sx3ucp  +++|      LOANFCTQ(0);
01285  M01S01281.sx3ucp  +++|
01286  M01S01282.sx3ucp  +++|      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
01287  M01S01283.sx3ucp  +++|        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
01288  M01S01284.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
01289  M01S01285.sx3ucp  +++|      THEN
01290  M01S01286.sx3ucp  +++|        BEGIN
01291  M01S01287.sx3ucp  +++|        GOTO ERRORTN;
01292  M01S01288.sx3ucp  +++|        END
01293  M01S01289.sx3ucp  +++|
01294  M01S01290.sx3ucp  +++|#
01295  M01S01291.sx3ucp  +++|*     GET THE ALLOCATION SUMMARY TABLE.
01296  M01S01292.sx3ucp  +++|#
01297  M01S01293.sx3ucp  +++|
01298  M01S01294.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
01299  M01S01295.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
01300  M01S01296.sx3ucp  +++|      THEN
01301  M01S01297.sx3ucp  +++|        BEGIN
01302  M01S01298.sx3ucp  +++|        GOTO ERRORTN;
01303  M01S01299.sx3ucp  +++|        END
01304  M01S01300.sx3ucp  +++|
01305  M01S01301.sx3ucp  +++|
01306  M01S01302.sx3ucp  +++|      P<FCT> = FCTEADDR + FCTQHL;
01307  M01S01303.sx3ucp  +++|
01308  M01S01304.sx3ucp  +++|#
01309  M01S01305.sx3ucp  +++|*     SET *AST* STATUS TO UNASSIGNED CUBE, AND UPDATE PREAMBLE.
01310  M01S01306.sx3ucp  +++|#
01311  M01S01307.sx3ucp  +++|
01312  M01S01308.sx3ucp  +++|      P<AST> = ASTBADR;
01313  M01S01309.sx3ucp  +++|      ZFILL(AST[CPR$FCT[0]],2);
01314  M01S01310.sx3ucp  +++|      AST$STAT[CPR$CSU[0]] = ASTENSTAT"UNASS$CUB";
01315  M01S01311.sx3ucp  +++|
01316  M01S01312.sx3ucp  +++|      ANLZAST(CPR$CSU[0],-1,-1,FXS,FXL,GPX,GPS);
01317  M01S01313.sx3ucp  +++|      PRM$MXAUS[CPR$CSU[0]] = AST$AUSF[FXS];
01318  M01S01314.sx3ucp  +++|      PRM$MXAUL[CPR$CSU[0]] = AST$AULF[FXL];
01319  M01S01315.sx3ucp  +++|      PRM$MXAUGR[CPR$CSU[0]] = GPS;
01320  M01S01316.sx3ucp  +++|      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
01321  M01S01317.sx3ucp  +++|      ZFILL(FCT,FCTENTL);
01322  M01S01318.sx3ucp  +++|
01323  M01S01319.sx3ucp  +++|ERRORTN:
01324  M01S01320.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
01325  M01S01321.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
01326  M01S01322.sx3ucp  +++|      RLS$FCT(FCTEADDR,0,ERRSTAT);
01327  M01S01323.sx3ucp  +++|      LOANFCTQ(-1);
01328  M01S01324.sx3ucp  +++|      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
01329  M01S01325.sx3ucp  +++|      UCP$RES;
01330  M01S01326.sx3ucp  +++|      RETURN;
01331  M01S01327.sx3ucp  +++|
01332  M01S01328.sx3ucp  +++|      END  # PURGFCT #
01333  M01S01329.sx3ucp  +++|
01334  M01S01330.sx3ucp  +++|    TERM
01335  M01S01331.sx3ucp  +++|PROC PURGCHN;
01336  M01S01332.sx3ucp  +++|# TITLE PURGCHN - PURGE FRAGMENTED AND ORPHAN CHAINS.                 #
01337  M01S01333.sx3ucp  +++|
01338  M01S01334.sx3ucp  +++|      BEGIN  # PURGCHN #
01339  M01S01335.sx3ucp  +++|
01340  M01S01336.sx3ucp  +++|#
01341  M01S01337.sx3ucp  +++|**    PURGCHN - PURGE FRAGMENTED AND ORPHAN CHAINS.
01342  M01S01338.sx3ucp  +++|*
01343  M01S01339.sx3ucp  +++|*     *PURGCHN MAKES THE SPACE OCCUPIED BY A FILE FRAGMENT OR AN
01344  M01S01340.sx3ucp  +++|*     ORPHAN FILE AVAILABLE FOR RE-USE. THIS PROCEDURE PROCESSES
01345  M01S01341.sx3ucp  +++|*     BOTH PURGE FRAGMENT AND PURGE ORPHAN REQUESTS.
01346  M01S01342.sx3ucp  +++|*
01347  M01S01343.sx3ucp  +++|*     PROC PURGCHN
01348  M01S01344.sx3ucp  +++|*
01349  M01S01345.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
01350  M01S01346.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
01351  M01S01347.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
01352  M01S01348.sx3ucp  +++|*               *LTCENTRY*.
01353  M01S01349.sx3ucp  +++|*
01354  M01S01350.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
01355  M01S01351.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
01356  M01S01352.sx3ucp  +++|*               OF THE REQUEST.
01357  M01S01353.sx3ucp  +++|*
01358  M01S01354.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
01359  M01S01355.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
01360  M01S01356.sx3ucp  +++|*                    = OK3             OK
01361  M01S01357.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
01362  M01S01358.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
01363  M01S01359.sx3ucp  +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
01364  M01S01360.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
01365  M01S01361.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
01366  M01S01362.sx3ucp  +++|*                    = NFROZ$FRAG      NON FROZEN FRAGMENT.
01367  M01S01363.sx3ucp  +++|*
01368  M01S01364.sx3ucp  +++|*     MESSAGES  * EXEC ABNORMAL, PURGCHN. *
01369  M01S01365.sx3ucp  +++|*
01370  M01S01366.sx3ucp  +++|#
01371  M01S01367.sx3ucp  +++|
01372  M01S01368.sx3ucp  +++|#
01373  M01S01369.sx3ucp  +++|****  PROC PURGCHN - XREF LIST BEGIN.
01374  M01S01370.sx3ucp  +++|#
01375  M01S01371.sx3ucp  +++|
01376  M01S01372.sx3ucp  +++|      XREF
01377  M01S01373.sx3ucp  +++|        BEGIN
01378  M01S01374.sx3ucp  +++|        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
01379  M01S01375.sx3ucp  +++|        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
01380  M01S01376.sx3ucp  +++|                                     #
01381  M01S01377.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
01382  M01S01378.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
01383  M01S01379.sx3ucp  +++|                                       *UCP* ERRORS #
01384  M01S01380.sx3ucp  +++|        PROC CPUTPD;                 # PUT PURGE DATE #
01385  M01S01381.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
01386  M01S01382.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
01387  M01S01383.sx3ucp  +++|        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
01388  M01S01384.sx3ucp  +++|        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
01389  M01S01385.sx3ucp  +++|        PROC OCTSRCH;                # SEARCHES *OCT* FOR ENTRY #
01390  M01S01386.sx3ucp  +++|        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
01391  M01S01387.sx3ucp  +++|        PROC RLSVOL;                 # RELEASE VOLUME #
01392  M01S01388.sx3ucp  +++|        PROC UASTPRM;                # UPDATE AST AND PREAMBLE #
01393  M01S01389.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
01394  M01S01390.sx3ucp  +++|                                     #
01395  M01S01391.sx3ucp  +++|        PROC UPDAST;                 # UPDATE THE *AST* #
01396  M01S01392.sx3ucp  +++|        END
01397  M01S01393.sx3ucp  +++|
01398  M01S01394.sx3ucp  +++|#
01399  M01S01395.sx3ucp  +++|****  PROC PURGCHN - XREF LIST END.
01400  M01S01396.sx3ucp  +++|#
01401  M01S01397.sx3ucp  +++|
01402  M01S01398.sx3ucp  +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
01403  M01S01399.sx3ucp  +++|*CALL COMBFAS
01404  M01S01400.sx3ucp  +++|*CALL COMBCMD
01405  M01S01401.sx3ucp  +++|*CALL COMBCMS
01406  M01S01402.sx3ucp  +++|*CALL COMBCPR
01407  M01S01403.sx3ucp  +++|*CALL COMBMAP
01408  M01S01404.sx3ucp  +++|*CALL COMBMCT
01409  M01S01405.sx3ucp  +++|*CALL COMXFCQ
01410  M01S01406.sx3ucp  +++|*CALL COMXLTC
01411  M01S01407.sx3ucp  +++|*CALL COMXMSC
01412  M01S01408.sx3ucp  +++|
01413  M01S01409.sx3ucp  +++|      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
01414  M01S01410.sx3ucp  +++|      ITEM FCTERR     B;             # SWITCH USED TO INDICATE MAIN
01415  M01S01411.sx3ucp  +++|                                       LOOP WAS TERMINATED BECAUSE OF
01416  M01S01412.sx3ucp  +++|                                       AN ERROR #
01417  M01S01413.sx3ucp  +++|      ITEM FCTNBR     U;             # *FCT* TO FIND #
01418  M01S01414.sx3ucp  +++|      ITEM FCTAU      U;             # *AU* TO BE RELEASED #
01419  M01S01415.sx3ucp  +++|      ITEM FROZERR    B;             # NON-FROZEN-FRAGMENT ERROR FOUND
01420  M01S01416.sx3ucp  +++|                                       WHICH DOES NOT REQUIRE
01421  M01S01417.sx3ucp  +++|                                       CONVERSION #
01422  M01S01418.sx3ucp  +++|      ITEM FRSTTIME   B;             # FIRST TIME SWITCH #
01423  M01S01419.sx3ucp  +++|      ITEM GRX        ;              # GROUP #
01424  M01S01420.sx3ucp  +++|      ITEM I          I;             # COUNTER #
01425  M01S01421.sx3ucp  +++|      ITEM NEWFCT     U;             # USED TO HOLD THE
01426  M01S01422.sx3ucp  +++|                                       OFF-CARTRIDGE-LINK *FCT* #
01427  M01S01423.sx3ucp  +++|      ITEM NEWAU      U;             # NEXT *AU* TO RELEASE #
01428  M01S01424.sx3ucp  +++|      ITEM ORD        I;             # *OCT* ORDINAL #
01429  M01S01425.sx3ucp  +++|      ITEM PRGDONE    B;             # SWITCH TO CONTROL MAIN LOOP #
01430  M01S01426.sx3ucp  +++|      ITEM RLSCNTL    B;             # SWITCH TO CONTROL FOLLOWING A
01431  M01S01427.sx3ucp  +++|                                       STREAM PATH WITHIN AN *FCT* #
01432  M01S01428.sx3ucp  +++|
01433  M01S01429.sx3ucp  +++|
01434  M01S01430.sx3ucp  +++|
01435  M01S01431.sx3ucp  +++|
01436  M01S01432.sx3ucp  +++|
01437  M01S01433.sx3ucp  +++|#
01438  M01S01434.sx3ucp  +++|*     GET THE ALLOCATION SUMMARY TABLE.
01439  M01S01435.sx3ucp  +++|#
01440  M01S01436.sx3ucp  +++|
01441  M01S01437.sx3ucp  +++|      LOANFCTQ(0);
01442  M01S01438.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
01443  M01S01439.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
01444  M01S01440.sx3ucp  +++|      THEN
01445  M01S01441.sx3ucp  +++|        BEGIN
01446  M01S01442.sx3ucp  +++|        GOTO ERRORTN;
01447  M01S01443.sx3ucp  +++|        END
01448  M01S01444.sx3ucp  +++|
01449  M01S01445.sx3ucp  +++|#
01450  M01S01446.sx3ucp  +++|*     GET THE MAXIMUM *FCT* ORDINAL.
01451  M01S01447.sx3ucp  +++|#
01452  M01S01448.sx3ucp  +++|
01453  M01S01449.sx3ucp  +++|      OCTSRCH(CPR$FAM[0],CPR$SUB[0],ORD,0,ERRSTAT);
01454  M01S01450.sx3ucp  +++|
01455  M01S01451.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
01456  M01S01452.sx3ucp  +++|      THEN
01457  M01S01453.sx3ucp  +++|        BEGIN
01458  M01S01454.sx3ucp  +++|        GOTO ERRORTN;
01459  M01S01455.sx3ucp  +++|        END
01460  M01S01456.sx3ucp  +++|
01461  M01S01457.sx3ucp  +++|      P<PREAMBLE> = OCT$PRMA[ORD];
01462  M01S01458.sx3ucp  +++|
01463  M01S01459.sx3ucp  +++|      IF PRM$SCW1[CPR$CSU[0]] EQ 0
01464  M01S01460.sx3ucp  +++|      THEN
01465  M01S01461.sx3ucp  +++|        BEGIN
01466  M01S01462.sx3ucp  +++|        ERRSTAT = CMASTAT"NOSUBCAT";
01467  M01S01463.sx3ucp  +++|        GOTO ERRORTN;
01468  M01S01464.sx3ucp  +++|        END
01469  M01S01465.sx3ucp  +++|
01470  M01S01466.sx3ucp  +++|#
01471  M01S01467.sx3ucp  +++|*     ESTABLISH THE NECESSARY BEGINNING CONTROLS FOR THE MAIN LOOP.
01472  M01S01468.sx3ucp  +++|#
01473  M01S01469.sx3ucp  +++|
01474  M01S01470.sx3ucp  +++|      FRSTTIME = TRUE;
01475  M01S01471.sx3ucp  +++|      PRGDONE = FALSE;
01476  M01S01472.sx3ucp  +++|      FCTNBR = CPR$FCT[0];
01477  M01S01473.sx3ucp  +++|      GRX = FCTNBR/MAXGRT;
01478  M01S01474.sx3ucp  +++|      FCTAU = CPR$AU[0];
01479  M01S01475.sx3ucp  +++|      P<AST> = ASTBADR;
01480  M01S01476.sx3ucp  +++|      FCTERR = FALSE;
01481  M01S01477.sx3ucp  +++|      FROZERR = FALSE;
01482  M01S01478.sx3ucp  +++|
01483  M01S01479.sx3ucp  +++|#
01484  M01S01480.sx3ucp  +++|*     GET THE *FCT* ENTRY.  FOLLOW THE AU PATH WITHIN THE *FCT*
01485  M01S01481.sx3ucp  +++|*     RELEASING AU-S.  THE AU PATH WILL TERMINATE WHEN
01486  M01S01482.sx3ucp  +++|*     EITHER A NON-BUSY AU OR THE LAST AU (AS DEFINED
01487  M01S01483.sx3ucp  +++|*     BY CHAIN CONTROL) IS FOUND.  WHENEVER THE AU PATH CROSSES
01488  M01S01484.sx3ucp  +++|*     *FCT*-S (DETERMINED BY THE OFF-CARTRIDGE-LINK CONTROL), THE
01489  M01S01485.sx3ucp  +++|*     AVAILABLE AU TABLE IS UPDATED TO REFLECT THE CURRENT
01490  M01S01486.sx3ucp  +++|*     CONDITION OF THE *FCT* AND THE MAIN LOOP IS REPEATED.
01491  M01S01487.sx3ucp  +++|*     IF A AU PATH DOES NOT CROSS *FCT* BOUNDARIES,
01492  M01S01488.sx3ucp  +++|*     THE MAIN LOOP WILL ONLY BE EXECUTED ONCE.
01493  M01S01489.sx3ucp  +++|#
01494  M01S01490.sx3ucp  +++|
01495  M01S01491.sx3ucp  +++|      REPEAT WHILE NOT PRGDONE
01496  M01S01492.sx3ucp  +++|      DO
01497  M01S01493.sx3ucp  +++|        BEGIN  # MAIN LOOP #
01498  M01S01494.sx3ucp  +++|
01499  M01S01495.sx3ucp  +++|#
01500  M01S01496.sx3ucp  +++|*     GET THE *FCT* ENTRY.
01501  M01S01497.sx3ucp  +++|#
01502  M01S01498.sx3ucp  +++|
01503  M01S01499.sx3ucp  +++|        ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
01504  M01S01500.sx3ucp  +++|          FCTNBR,FCTEADDR,0,ERRSTAT);
01505  M01S01501.sx3ucp  +++|        IF ERRSTAT NQ CMASTAT"NOERR"
01506  M01S01502.sx3ucp  +++|        THEN
01507  M01S01503.sx3ucp  +++|          BEGIN
01508  M01S01504.sx3ucp  +++|          FCTERR = TRUE;
01509  M01S01505.sx3ucp  +++|          PRGDONE = TRUE;
01510  M01S01506.sx3ucp  +++|          TEST DUMMY;
01511  M01S01507.sx3ucp  +++|          END
01512  M01S01508.sx3ucp  +++|
01513  M01S01509.sx3ucp  +++|        P<FCT> = FCTEADDR + FCTQHL;
01514  M01S01510.sx3ucp  +++|
01515  M01S01511.sx3ucp  +++|#
01516  M01S01512.sx3ucp  +++|*     FRAGMENTED AU-S MUST HAVE THE FIRST AU FROZEN.
01517  M01S01513.sx3ucp  +++|#
01518  M01S01514.sx3ucp  +++|
01519  M01S01515.sx3ucp  +++|        IF FRSTTIME AND CPR$RQC[0] EQ REQTYP3"PURG$FRAG"
01520  M01S01516.sx3ucp  +++|        THEN
01521  M01S01517.sx3ucp  +++|          BEGIN
01522  M01S01518.sx3ucp  +++|          FRSTTIME = FALSE;
01523  M01S01519.sx3ucp  +++|            IF FCT$FRCF(FCT$WD(CPR$AU[0]),FCT$WP(CPR$AU[0])) EQ OFF
01524  M01S01520.sx3ucp  +++|          THEN
01525  M01S01521.sx3ucp  +++|            BEGIN
01526  M01S01522.sx3ucp  +++|            ERRSTAT = RESPTYP3"NFROZ$FRAG";
01527  M01S01523.sx3ucp  +++|            FCTERR = TRUE;
01528  M01S01524.sx3ucp  +++|            PRGDONE = TRUE;
01529  M01S01525.sx3ucp  +++|            FROZERR = TRUE;
01530  M01S01526.sx3ucp  +++|            TEST DUMMY;
01531  M01S01527.sx3ucp  +++|            END
01532  M01S01528.sx3ucp  +++|
01533  M01S01529.sx3ucp  +++|          END
01534  M01S01530.sx3ucp  +++|
01535  M01S01531.sx3ucp  +++|#
01536  M01S01532.sx3ucp  +++|*     SEARCH THE VOLUME CHAIN RELEASING VOLUMES.
01537  M01S01533.sx3ucp  +++|#
01538  M01S01534.sx3ucp  +++|
01539  M01S01535.sx3ucp  +++|
01540  M01S01536.sx3ucp  +++|        RLSCNTL = FALSE;
01541  M01S01537.sx3ucp  +++|
01542  M01S01538.sx3ucp  +++|        SLOWFOR I = 0 WHILE NOT RLSCNTL
01543  M01S01539.sx3ucp  +++|        DO
01544  M01S01540.sx3ucp  +++|          BEGIN  # RELEASE LOOP #
01545  M01S01541.sx3ucp  +++|
01546  M01S01542.sx3ucp  +++|#
01547  M01S01543.sx3ucp  +++|*     A NONBUSY AU ENDS THE AU PATH SEARCH.
01548  M01S01544.sx3ucp  +++|#
01549  M01S01545.sx3ucp  +++|
01550  M01S01546.sx3ucp  +++|          IF FCT$FBF(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ OFF
01551  M01S01547.sx3ucp  +++|          THEN
01552  M01S01548.sx3ucp  +++|            BEGIN
01553  M01S01549.sx3ucp  +++|            RLSCNTL = TRUE;
01554  M01S01550.sx3ucp  +++|            PRGDONE = TRUE;
01555  M01S01551.sx3ucp  +++|            TEST I;
01556  M01S01552.sx3ucp  +++|            END
01557  M01S01553.sx3ucp  +++|
01558  M01S01554.sx3ucp  +++|          RLSCNTL =                  ##
01559  M01S01555.sx3ucp  +++|            FCT$LINK(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 0  ##
01560  M01S01556.sx3ucp  +++|            OR FCT$CC(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ CHAINCON"LAST"##
01561  M01S01557.sx3ucp  +++|            OR FCT$CC(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ CHAINCON"ONLY";
01562  M01S01558.sx3ucp  +++|
01563  M01S01559.sx3ucp  +++|
01564  M01S01560.sx3ucp  +++|#
01565  M01S01561.sx3ucp  +++|*     DETERMINE WHETHER THE AU PATH CROSSES *FCT* BOUNDARIES.
01566  M01S01562.sx3ucp  +++|*     IF IT DOES, PICK UP THE NEW *FCT* TO USE.
01567  M01S01563.sx3ucp  +++|#
01568  M01S01564.sx3ucp  +++|
01569  M01S01565.sx3ucp  +++|          IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) NQ 0
01570  M01S01566.sx3ucp  +++|          THEN
01571  M01S01567.sx3ucp  +++|            BEGIN  # OFF-CARTRIDGE LINK #
01572  M01S01568.sx3ucp  +++|            RLSCNTL = TRUE;
01573  M01S01569.sx3ucp  +++|            IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 1
01574  M01S01570.sx3ucp  +++|            THEN
01575  M01S01571.sx3ucp  +++|              BEGIN
01576  M01S01572.sx3ucp  +++|              B<0,1>FCT$OCLF[0] = 0;
01577  M01S01573.sx3ucp  +++|              NEWFCT = GRX * 16 + FCT$OCL[0];
01578  M01S01574.sx3ucp  +++|              END
01579  M01S01575.sx3ucp  +++|
01580  M01S01576.sx3ucp  +++|            ELSE
01581  M01S01577.sx3ucp  +++|              BEGIN
01582  M01S01578.sx3ucp  +++|              IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 2
01583  M01S01579.sx3ucp  +++|              THEN
01584  M01S01580.sx3ucp  +++|                BEGIN
01585  M01S01581.sx3ucp  +++|                B<1,1>FCT$OCLF[0] = 0;
01586  M01S01582.sx3ucp  +++|                NEWFCT = GRX * 16 + FCT$OCL1[0];
01587  M01S01583.sx3ucp  +++|                END
01588  M01S01584.sx3ucp  +++|
01589  M01S01585.sx3ucp  +++|              ELSE
01590  M01S01586.sx3ucp  +++|                BEGIN
01591  M01S01587.sx3ucp  +++|                B<2,1>FCT$OCLF[0] = 0;
01592  M01S01588.sx3ucp  +++|                NEWFCT = GRX * 16 + FCT$OCL2[0];
01593  M01S01589.sx3ucp  +++|                END
01594  M01S01590.sx3ucp  +++|
01595  M01S01591.sx3ucp  +++|              END
01596  M01S01592.sx3ucp  +++|
01597  M01S01593.sx3ucp  +++|            IF NEWFCT GR (PRM$ENTRC[CPR$CSU[0]] + 15) OR NEWFCT LS 16
01598  M01S01594.sx3ucp  +++|              THEN                   # *FCT* OUT OF RANGE #
01599  M01S01595.sx3ucp  +++|              BEGIN
01600  M01S01596.sx3ucp  +++|              RLSCNTL = TRUE;
01601  M01S01597.sx3ucp  +++|              PRGDONE = TRUE;
01602  M01S01598.sx3ucp  +++|              GOTO EXIT$RLS;
01603  M01S01599.sx3ucp  +++|              END
01604  M01S01600.sx3ucp  +++|
01605  M01S01601.sx3ucp  +++|            END  # OFF-CARTRIDGE LINK #
01606  M01S01602.sx3ucp  +++|
01607  M01S01603.sx3ucp  +++|
01608  M01S01604.sx3ucp  +++|          IF FCT$CLKOCL(FCT$WD(FCTAU),FCT$WP(FCTAU)) EQ 0  ##
01609  M01S01605.sx3ucp  +++|            AND RLSCNTL
01610  M01S01606.sx3ucp  +++|          THEN
01611  M01S01607.sx3ucp  +++|            BEGIN
01612  M01S01608.sx3ucp  +++|            PRGDONE = TRUE;
01613  M01S01609.sx3ucp  +++|            END
01614  M01S01610.sx3ucp  +++|
01615  M01S01611.sx3ucp  +++|
01616  M01S01612.sx3ucp  +++|
01617  M01S01613.sx3ucp  +++|          NEWAU = FCT$LINK(FCT$WD(FCTAU),FCT$WP(FCTAU));
01618  M01S01614.sx3ucp  +++|
01619  M01S01615.sx3ucp  +++|EXIT$RLS:                            # CLEAR AU DETAIL #
01620  M01S01616.sx3ucp  +++|          RLSVOL(0,FCTEADDR,FCTAU,   ##
01621  M01S01617.sx3ucp  +++|            FCT$LEN(FCT$WD(FCTAU),FCT$WP(FCTAU))+1);
01622  M01S01618.sx3ucp  +++|          FCTAU = NEWAU;
01623  M01S01619.sx3ucp  +++|          END  # RELEASE LOOP #
01624  M01S01620.sx3ucp  +++|
01625  M01S01621.sx3ucp  +++|
01626  M01S01622.sx3ucp  +++|#
01627  M01S01623.sx3ucp  +++|*     UPDATE *AST* AND PREAMBLE FOR TO MATCH *FCT*.
01628  M01S01624.sx3ucp  +++|#
01629  M01S01625.sx3ucp  +++|
01630  M01S01626.sx3ucp  +++|        UASTPRM(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],FCTEADDR,ERRSTAT);
01631  M01S01627.sx3ucp  +++|
01632  M01S01628.sx3ucp  +++|
01633  M01S01629.sx3ucp  +++|#
01634  M01S01630.sx3ucp  +++|*     UPDATE THE *FCT* ENTRY.
01635  M01S01631.sx3ucp  +++|#
01636  M01S01632.sx3ucp  +++|
01637  M01S01633.sx3ucp  +++|        RLS$FCT(FCTEADDR,0,ERRSTAT);
01638  M01S01634.sx3ucp  +++|        FCTNBR = NEWFCT;
01639  M01S01635.sx3ucp  +++|        END  # MAIN LOOP #
01640  M01S01636.sx3ucp  +++|
01641  M01S01637.sx3ucp  +++|#
01642  M01S01638.sx3ucp  +++|*     IF ANY ERRORS IN MAIN LOOP, PROCESSING DOES NOT CONTINUE.
01643  M01S01639.sx3ucp  +++|#
01644  M01S01640.sx3ucp  +++|
01645  M01S01641.sx3ucp  +++|      IF FCTERR
01646  M01S01642.sx3ucp  +++|      THEN
01647  M01S01643.sx3ucp  +++|        BEGIN
01648  M01S01644.sx3ucp  +++|        GOTO ERRORTN;
01649  M01S01645.sx3ucp  +++|        END
01650  M01S01646.sx3ucp  +++|
01651  M01S01647.sx3ucp  +++|#
01652  M01S01648.sx3ucp  +++|*     UPDATE THE DATE AND TIME ON THE PURGE ORPHAN REQUEST.
01653  M01S01649.sx3ucp  +++|#
01654  M01S01650.sx3ucp  +++|

Seq #  *Modification Id* Act 
----------------------------+
01655  M02S01651.sx3ucp1 ---|      IF CPR$RQC[0] EQ REQTYP3"PURG$ORPH"
01656  M01S00005.sx3ucp1 +++|      IF CPR$RQC[0] NQ REQTYP3"PURG$FRAG"
01657  M01S01652.sx3ucp  +++|      THEN
01658  M01S01653.sx3ucp  +++|        BEGIN
01659  M01S01654.sx3ucp  +++|        CPUTPD(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],0,ERRSTAT);
01660  M01S01655.sx3ucp  +++|        END
01661  M01S01656.sx3ucp  +++|
01662  M01S01657.sx3ucp  +++|ERRORTN:
01663  M01S01658.sx3ucp  +++|      IF NOT FROZERR
01664  M01S01659.sx3ucp  +++|      THEN
01665  M01S01660.sx3ucp  +++|        BEGIN
01666  M01S01661.sx3ucp  +++|        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
01667  M01S01662.sx3ucp  +++|        END
01668  M01S01663.sx3ucp  +++|
01669  M01S01664.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
01670  M01S01665.sx3ucp  +++|      RLS$FCT(FCTEADDR,0,ERRSTAT);
01671  M01S01666.sx3ucp  +++|      LOANFCTQ(-1);
01672  M01S01667.sx3ucp  +++|      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);

Seq #  *Modification Id* Act 
----------------------------+
01673  M02S01668.sx3ucp1 ---|      UCP$RES;
01674  M01S00006.sx3ucp1 +++|      IF CPR$RQC[0] EQ REQTYP3"PURG$FRAG"
01675  M01S00007.sx3ucp1 +++|      THEN                             # SSDEBUG CALL ENDS HERE #
01676  M01S00008.sx3ucp1 +++|        BEGIN
01677  M01S00009.sx3ucp1 +++|        UCP$RES;
01678  M01S00010.sx3ucp1 +++|        END
01679  M01S00011.sx3ucp1 +++|
01680  M01S01669.sx3ucp  +++|      RETURN;
01681  M01S01670.sx3ucp  +++|
01682  M01S01671.sx3ucp  +++|
01683  M01S01672.sx3ucp  +++|      END
01684  M01S01673.sx3ucp  +++|
01685  M01S01674.sx3ucp  +++|    TERM
01686  M01S00012.sx3ucp1 +++|PROC RESETUP;
01687  M01S00013.sx3ucp1 +++|#TITLE RESETUP - CATALOG RELEASE PROCESSING AND SETUP.                #
01688  M01S00014.sx3ucp1 +++|
01689  M01S00015.sx3ucp1 +++|      BEGIN # RESETUP #
01690  M01S00016.sx3ucp1 +++|
01691  M01S00017.sx3ucp1 +++|#
01692  M01S00018.sx3ucp1 +++|**    RESETUP - CATALOG RELEASE PROCESSING AND SETUP.
01693  M01S00019.sx3ucp1 +++|*
01694  M01S00020.sx3ucp1 +++|*     * RESETUP PROCESSES THE UCP REQUEST WHICH RELEASES *SFMCAT*
01695  M01S00021.sx3ucp1 +++|*     SPACE FOR A LIST OF FILES ON FILE *RELCOM* WHICH IS SENT
01696  M01S00022.sx3ucp1 +++|*     BY *SSVAL*.
01697  M01S00023.sx3ucp1 +++|*
01698  M01S00024.sx3ucp1 +++|*     PROC RESETUP
01699  M01S00025.sx3ucp1 +++|*
01700  M01S00026.sx3ucp1 +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
01701  M01S00027.sx3ucp1 +++|*               *CPR*. THE *LTCT* ENTRY FOR THE REQUESTING UCP IS
01702  M01S00028.sx3ucp1 +++|*               POINTED TO BY *LTCENTRY*. THIS REQUEST INDICATES
01703  M01S00029.sx3ucp1 +++|*               THAT A LIST OF FILES TO BE RELEASED IS AVAILABLE ON
01704  M01S00030.sx3ucp1 +++|*               FILE *RELCOM*.
01705  M01S00031.sx3ucp1 +++|*
01706  M01S00032.sx3ucp1 +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
01707  M01S00033.sx3ucp1 +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
01708  M01S00034.sx3ucp1 +++|*               OF THE REQUEST. THE CHAINS IN THE LIST HAVE BEEN
01709  M01S00035.sx3ucp1 +++|*               PUT ON THE FREE SPACE CHAIN.
01710  M01S00036.sx3ucp1 +++|*
01711  M01S00037.sx3ucp1 +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
01712  M01S00038.sx3ucp1 +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
01713  M01S00039.sx3ucp1 +++|*                    = OK3             OK
01714  M01S00040.sx3ucp1 +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
01715  M01S00041.sx3ucp1 +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
01716  M01S00042.sx3ucp1 +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
01717  M01S00043.sx3ucp1 +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
01718  M01S00044.sx3ucp1 +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
01719  M01S00045.sx3ucp1 +++|*
01720  M01S00046.sx3ucp1 +++|*     MESSAGES  * EXEC ABNORMAL, RESETUP. *
01721  M01S00047.sx3ucp1 +++|*
01722  M01S00048.sx3ucp1 +++|#
01723  M01S00049.sx3ucp1 +++|
01724  M01S00050.sx3ucp1 +++|#
01725  M01S00051.sx3ucp1 +++|****  PROC RESETUP LIST BEGIN.
01726  M01S00052.sx3ucp1 +++|#
01727  M01S00053.sx3ucp1 +++|
01728  M01S00054.sx3ucp1 +++|      XREF
01729  M01S00055.sx3ucp1 +++|        BEGIN
01730  M01S00056.sx3ucp1 +++|        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
01731  M01S00057.sx3ucp1 +++|        PROC BZFILL;                 # ZERO BLANK FILL #
01732  M01S00058.sx3ucp1 +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
01733  M01S00059.sx3ucp1 +++|                                       *UCP* ERRORS #
01734  M01S00060.sx3ucp1 +++|        PROC CPUTPD;                 # PUT PURGE DATE #
01735  M01S00061.sx3ucp1 +++|        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
01736  M01S00062.sx3ucp1 +++|        PROC PFD;                    # PERMANENT FILE ACCESS #
01737  M01S00063.sx3ucp1 +++|        PROC PURGCHN;                # PUT CHAIN ON FREE SPACE #
01738  M01S00064.sx3ucp1 +++|        PROC READ;                   # READ *CIO* BUFFER #
01739  M01S00065.sx3ucp1 +++|        PROC READW;                  # READ TO WORKING BUFFER #
01740  M01S00066.sx3ucp1 +++|        PROC RETERN;                 # RETURN LOCAL FILE #
01741  M01S00067.sx3ucp1 +++|        PROC SETPFP;                 # SET PF PARAMETERS #
01742  M01S00068.sx3ucp1 +++|        PROC UASTPRM;                # UPDATE AST AND PREAMBLE #
01743  M01S00069.sx3ucp1 +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST
01744  M01S00070.sx3ucp1 +++|                                       COMPLETE #
01745  M01S00071.sx3ucp1 +++|        PROC ZSETFET;                # SET UP FILE *FET* #
01746  M01S00072.sx3ucp1 +++|        END
01747  M01S00073.sx3ucp1 +++|
01748  M01S00074.sx3ucp1 +++|#
01749  M01S00075.sx3ucp1 +++|****  PROC PURGCHN - XREF LIST END.
01750  M01S00076.sx3ucp1 +++|#
01751  M01S00077.sx3ucp1 +++|
01752  M01S00078.sx3ucp1 +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
01753  M01S00079.sx3ucp1 +++|*CALL COMBFAS
01754  M01S00080.sx3ucp1 +++|*CALL COMBBZF
01755  M01S00081.sx3ucp1 +++|*CALL COMBCPR
01756  M01S00082.sx3ucp1 +++|*CALL COMBMCT
01757  M01S00083.sx3ucp1 +++|*CALL COMBPFP
01758  M01S00084.sx3ucp1 +++|*CALL COMBPFS
01759  M01S00085.sx3ucp1 +++|*CALL COMSPFM
01760  M01S00086.sx3ucp1 +++|*CALL COMTVLD
01761  M01S00087.sx3ucp1 +++|*CALL COMTVLF
01762  M01S00088.sx3ucp1 +++|*CALL COMXFCQ
01763  M01S00089.sx3ucp1 +++|*CALL COMXLTC
01764  M01S00090.sx3ucp1 +++|*CALL COMXMSC
01765  M01S00091.sx3ucp1 +++|
01766  M01S00092.sx3ucp1 +++|      ITEM I          I;             # COUNTER #
01767  M01S00093.sx3ucp1 +++|      ITEM STATW      I;             # ERROR STATUS #
01768  M01S00094.sx3ucp1 +++|      ITEM SAVEPT     I;             # SAVE POINTER #
01769  M01S00095.sx3ucp1 +++|
01770  M01S00096.sx3ucp1 +++|      ARRAY CPRARRAY [0:0] S(CPRLEN);;
01771  M01S00097.sx3ucp1 +++|
01772  M01S00098.sx3ucp1 +++|
01773  M01S00099.sx3ucp1 +++|#
01774  M01S00100.sx3ucp1 +++|*     PROCESS SSDEBUG CALL, *PURGE FRAGMENT*.
01775  M01S00101.sx3ucp1 +++|#
01776  M01S00102.sx3ucp1 +++|
01777  M01S00103.sx3ucp1 +++|      IF CPR$RQC[0] EQ REQTYP3"PURG$FRAG"
01778  M01S00104.sx3ucp1 +++|      THEN                           # DELINK FRAGMENT #
01779  M01S00105.sx3ucp1 +++|        BEGIN
01780  M01S00106.sx3ucp1 +++|        PURGCHN;
01781  M01S00107.sx3ucp1 +++|        RETURN;
01782  M01S00108.sx3ucp1 +++|        END
01783  M01S00109.sx3ucp1 +++|
01784  M01S00110.sx3ucp1 +++|#
01785  M01S00111.sx3ucp1 +++|*     SWITCH TO SPECIFIED FAMILY.
01786  M01S00112.sx3ucp1 +++|#
01787  M01S00113.sx3ucp1 +++|
01788  M01S00114.sx3ucp1 +++|      PFP$WRD0[0] = 0;
01789  M01S00115.sx3ucp1 +++|      PFP$FAM[0]  = CPR$FAM[0];
01790  M01S00116.sx3ucp1 +++|      PFP$UI[0]   = DEF$UI;
01791  M01S00117.sx3ucp1 +++|      PFP$FG1[0]  = TRUE;
01792  M01S00118.sx3ucp1 +++|      PFP$FG4     = TRUE;
01793  M01S00119.sx3ucp1 +++|      SETPFP(PFP);
01794  M01S00120.sx3ucp1 +++|
01795  M01S00121.sx3ucp1 +++|      IF PFP$STAT NQ 0
01796  M01S00122.sx3ucp1 +++|      THEN                           # PROCESS ERROR #
01797  M01S00123.sx3ucp1 +++|        BEGIN
01798  M01S00124.sx3ucp1 +++|        FE$RTN[0] = "RESETUP.";
01799  M01S00125.sx3ucp1 +++|        MESSAGE(FEMSG[0],UDFL1);
01800  M01S00126.sx3ucp1 +++|        ABORT;
01801  M01S00127.sx3ucp1 +++|        END
01802  M01S00128.sx3ucp1 +++|
01803  M01S00129.sx3ucp1 +++|
01804  M01S00130.sx3ucp1 +++|#
01805  M01S00131.sx3ucp1 +++|*     ATTACH *RELCOM* FILE GENERATED BY SSVAL.
01806  M01S00132.sx3ucp1 +++|#
01807  M01S00133.sx3ucp1 +++|
01808  M01S00134.sx3ucp1 +++|      RELNAME = RELLFN;
01809  M01S00135.sx3ucp1 +++|      BZFILL(RELNAME,TYPFILL"ZFILL",7);
01810  M01S00136.sx3ucp1 +++|      PFD("ATTACH",RELNAME,0,"M","W","RC",STATW,0);
01811  M01S00137.sx3ucp1 +++|      IF STATW NQ OK
01812  M01S00138.sx3ucp1 +++|      THEN                           # ATTACH ERROR #
01813  M01S00139.sx3ucp1 +++|        BEGIN
01814  M01S00140.sx3ucp1 +++|        FE$MSG[0] = " FILE PROBLEM, ";
01815  M01S00141.sx3ucp1 +++|        FE$RTN[0] = "RESETUP.";
01816  M01S00142.sx3ucp1 +++|        MESSAGE(FEMSG[0],UDFL1);
01817  M01S00143.sx3ucp1 +++|        ABORT;
01818  M01S00144.sx3ucp1 +++|        END
01819  M01S00145.sx3ucp1 +++|
01820  M01S00146.sx3ucp1 +++|#
01821  M01S00147.sx3ucp1 +++|*     READ *RELCOM* FILE.
01822  M01S00148.sx3ucp1 +++|#
01823  M01S00149.sx3ucp1 +++|
01824  M01S00150.sx3ucp1 +++|      RELFADR = LOC(RELCFILE);
01825  M01S00151.sx3ucp1 +++|      RELBADR = LOC(RELCBUF);
01826  M01S00152.sx3ucp1 +++|      ZSETFET(RELFADR,RELLFN,RELBADR,LFIXBUF);
01827  M01S00153.sx3ucp1 +++|      READ(RELCFILE,RCL);
01828  M01S00154.sx3ucp1 +++|      SAVEPT = P<CPR>;
01829  M01S00155.sx3ucp1 +++|      P<CPR> = LOC(CPRARRAY);
01830  M01S00156.sx3ucp1 +++|
01831  M01S00157.sx3ucp1 +++|
01832  M01S00158.sx3ucp1 +++|#
01833  M01S00159.sx3ucp1 +++|*     PROCESS EACH ENTRY.
01834  M01S00160.sx3ucp1 +++|#
01835  M01S00161.sx3ucp1 +++|
01836  M01S00162.sx3ucp1 +++|
01837  M01S00163.sx3ucp1 +++|      SLOWFOR I = 0 STEP 1 WHILE STATW EQ OK
01838  M01S00164.sx3ucp1 +++|      DO
01839  M01S00165.sx3ucp1 +++|        BEGIN  # MAIN LOOP #
01840  M01S00166.sx3ucp1 +++|        READW(RELCFILE,CPRARRAY,CPRLEN,STATW);
01841  M01S00167.sx3ucp1 +++|        IF STATW NQ OK
01842  M01S00168.sx3ucp1 +++|        THEN
01843  M01S00169.sx3ucp1 +++|          BEGIN
01844  M01S00170.sx3ucp1 +++|          TEST I;
01845  M01S00171.sx3ucp1 +++|          END
01846  M01S00172.sx3ucp1 +++|
01847  M01S00173.sx3ucp1 +++|#
01848  M01S00174.sx3ucp1 +++|*      DELINK FILE CHAIN.
01849  M01S00175.sx3ucp1 +++|#
01850  M01S00176.sx3ucp1 +++|
01851  M01S00177.sx3ucp1 +++|        PURGCHN;
01852  M01S00178.sx3ucp1 +++|
01853  M01S00179.sx3ucp1 +++|        IF LTC$RQR[LTCENTRY] NQ OK
01854  M01S00180.sx3ucp1 +++|        THEN                            # ERROR IN PURGCHN #
01855  M01S00181.sx3ucp1 +++|          BEGIN
01856  M01S00182.sx3ucp1 +++|          STATW = O"777";
01857  M01S00183.sx3ucp1 +++|          TEST I;
01858  M01S00184.sx3ucp1 +++|          END
01859  M01S00185.sx3ucp1 +++|
01860  M01S00186.sx3ucp1 +++|#
01861  M01S00187.sx3ucp1 +++|*     WRITE TEMP FILE FOR DEBUGGING PURPOSES.
01862  M01S00188.sx3ucp1 +++|#
01863  M01S00189.sx3ucp1 +++|
01864  M01S00190.sx3ucp1 +++|
01865  M01S00191.sx3ucp1 +++|        END                             # MAIN LOOP #
01866  M01S00192.sx3ucp1 +++|
01867  M01S00193.sx3ucp1 +++|      RETERN(RELCFILE,RCL);
01868  M01S00194.sx3ucp1 +++|      P<CPR> = SAVEPT;
01869  M01S00195.sx3ucp1 +++|      CPR$RQR[0] = LTC$RQR[LTCENTRY];
01870  M01S00196.sx3ucp1 +++|      LTC$DATE[LTCENTRY] = I - 1;          # FILE RELEASE COUNT #
01871  M01S00197.sx3ucp1 +++|      UCP$RES;
01872  M01S00198.sx3ucp1 +++|      RETURN;
01873  M01S00199.sx3ucp1 +++|      END                               # RESETUP #
01874  M01S00200.sx3ucp1 +++|
01875  M01S00201.sx3ucp1 +++|    TERM
01876  M01S01675.sx3ucp  +++|PROC RMVCAR;
01877  M01S01676.sx3ucp  +++|# TITLE RMVCAR - REMOVE CARTRIDGE FROM SUB-FAMILY.                    #
01878  M01S01677.sx3ucp  +++|
01879  M01S01678.sx3ucp  +++|      BEGIN  # RMVCAR #
01880  M01S01679.sx3ucp  +++|
01881  M01S01680.sx3ucp  +++|#
01882  M01S01681.sx3ucp  +++|**    RMVCAR - REMOVE CARTRIDGE FROM SUB-FAMILY.
01883  M01S01682.sx3ucp  +++|*
01884  M01S01683.sx3ucp  +++|*     *RMVCAR* UPDATES THE *AST*, *FCT*, AND *SMMAP*
01885  M01S01684.sx3ucp  +++|*     TO REFLECT THAT THE GIVEN CARTRIDGE IS NO LONGER ASSIGNED TO
01886  M01S01685.sx3ucp  +++|*     THE SUB-FAMILY.
01887  M01S01686.sx3ucp  +++|*
01888  M01S01687.sx3ucp  +++|*     PROC RMVCAR
01889  M01S01688.sx3ucp  +++|*
01890  M01S01689.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
01891  M01S01690.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
01892  M01S01691.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
01893  M01S01692.sx3ucp  +++|*               *LTCENTRY*.
01894  M01S01693.sx3ucp  +++|*
01895  M01S01694.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
01896  M01S01695.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
01897  M01S01696.sx3ucp  +++|*               OF THE REQUEST.
01898  M01S01697.sx3ucp  +++|*
01899  M01S01698.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
01900  M01S01699.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
01901  M01S01700.sx3ucp  +++|*                    = OK3             OK
01902  M01S01701.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
01903  M01S01702.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
01904  M01S01703.sx3ucp  +++|*                    = NO$SUB$CAT      NO SUCH SUBCATALOG
01905  M01S01704.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
01906  M01S01705.sx3ucp  +++|*                    = MSC$NEMPTY      CARTRIDGE NOT EMPTY
01907  M01S01706.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
01908  M01S01707.sx3ucp  +++|#
01909  M01S01708.sx3ucp  +++|
01910  M01S01709.sx3ucp  +++|#
01911  M01S01710.sx3ucp  +++|****  PROC RMVCAR - XREF LIST BEGIN.
01912  M01S01711.sx3ucp  +++|#
01913  M01S01712.sx3ucp  +++|
01914  M01S01713.sx3ucp  +++|      XREF
01915  M01S01714.sx3ucp  +++|        BEGIN
01916  M01S01715.sx3ucp  +++|        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
01917  M01S01716.sx3ucp  +++|                                     #
01918  M01S01717.sx3ucp  +++|        PROC ANLZAST;                # ANALYZE THE *AST* #
01919  M01S01718.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
01920  M01S01719.sx3ucp  +++|        PROC CNTFS;                  # COUNT FREE STREAMS #
01921  M01S01720.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
01922  M01S01721.sx3ucp  +++|                                       *UCP* ERRORS #
01923  M01S01722.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
01924  M01S01723.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
01925  M01S01724.sx3ucp  +++|        PROC LOANFCTQ;               # ADD OR RECLAIM *FCTQ* ENTRY #
01926  M01S01725.sx3ucp  +++|        PROC MFLUSH;                 # FLUSH MAP TO FILE #
01927  M01S01726.sx3ucp  +++|        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
01928  M01S01727.sx3ucp  +++|                                       CALLER #
01929  M01S01728.sx3ucp  +++|        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
01930  M01S01729.sx3ucp  +++|                                     #
01931  M01S01730.sx3ucp  +++|        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
01932  M01S01731.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
01933  M01S01732.sx3ucp  +++|                                     #
01934  M01S01733.sx3ucp  +++|        PROC UPDAST;                 # UPDATE THE *AST* #
01935  M01S01734.sx3ucp  +++|        PROC ZFILL;                  # ZERO FILL ARRAY #
01936  M01S01735.sx3ucp  +++|        END
01937  M01S01736.sx3ucp  +++|
01938  M01S01737.sx3ucp  +++|#
01939  M01S01738.sx3ucp  +++|****  PROC RMVCAR - XREF LIST END.
01940  M01S01739.sx3ucp  +++|#
01941  M01S01740.sx3ucp  +++|
01942  M01S01741.sx3ucp  +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
01943  M01S01742.sx3ucp  +++|*CALL COMBFAS
01944  M01S01743.sx3ucp  +++|*CALL COMBCMD
01945  M01S01744.sx3ucp  +++|*CALL COMBCMS
01946  M01S01745.sx3ucp  +++|*CALL COMBCPR
01947  M01S01746.sx3ucp  +++|*CALL COMBMAP
01948  M01S01747.sx3ucp  +++|*CALL COMBMCT
01949  M01S01748.sx3ucp  +++|*CALL COMXFCQ
01950  M01S01749.sx3ucp  +++|*CALL COMXLTC
01951  M01S01750.sx3ucp  +++|*CALL COMXMSC
01952  M01S01751.sx3ucp  +++|
01953  M01S01752.sx3ucp  +++|      ITEM ERRCONV    B;             # ERROR CODE CONVERSION FLAG #
01954  M01S01753.sx3ucp  +++|      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS FROM
01955  M01S01754.sx3ucp  +++|                                       *ACQ$FCT* #
01956  M01S01755.sx3ucp  +++|      ITEM FXL        U;             # BEST ORDINAL FOR ALLOCATION #
01957  M01S01756.sx3ucp  +++|      ITEM FXS        U;             # BEST ORDINAL FOR ALLOCATION #
01958  M01S01757.sx3ucp  +++|      ITEM GPS        U;             # BEST GROUP ORDINAL #
01959  M01S01758.sx3ucp  +++|      ITEM GPX        U;             # BEST GROUP #
01960  M01S01759.sx3ucp  +++|      ITEM I          U;             # COUNTER #
01961  M01S01760.sx3ucp  +++|      ITEM ORD        I;             # *AST* ORDINAL #
01962  M01S01761.sx3ucp  +++|      ITEM SAVEY      U;             # SAVED Y COORDINATE #
01963  M01S01762.sx3ucp  +++|      ITEM SAVEZ      U;             # SAVED Z COORDINATE #
01964  M01S01763.sx3ucp  +++|
01965  M01S01764.sx3ucp  +++|
01966  M01S01765.sx3ucp  +++|
01967  M01S01766.sx3ucp  +++|
01968  M01S01767.sx3ucp  +++|
01969  M01S01768.sx3ucp  +++|#
01970  M01S01769.sx3ucp  +++|*     GET THE MAP ENTRY FOR THE REQUEST.
01971  M01S01770.sx3ucp  +++|#
01972  M01S01771.sx3ucp  +++|
01973  M01S01772.sx3ucp  +++|      LOANFCTQ(0);
01974  M01S01773.sx3ucp  +++|      ERRCONV = TRUE;
01975  M01S01774.sx3ucp  +++|      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
01976  M01S01775.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
01977  M01S01776.sx3ucp  +++|      THEN
01978  M01S01777.sx3ucp  +++|        BEGIN
01979  M01S01778.sx3ucp  +++|        GOTO ERRORTN;
01980  M01S01779.sx3ucp  +++|        END
01981  M01S01780.sx3ucp  +++|
01982  M01S01781.sx3ucp  +++|#
01983  M01S01782.sx3ucp  +++|*     GET THE *FCTQ* ENTRY FOR THE REQUEST.
01984  M01S01783.sx3ucp  +++|#
01985  M01S01784.sx3ucp  +++|
01986  M01S01785.sx3ucp  +++|
01987  M01S01786.sx3ucp  +++|      ACQ$FCT(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],  ##
01988  M01S01787.sx3ucp  +++|        CPR$FCT[0],FCTEADDR,0,ERRSTAT);
01989  M01S01788.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
01990  M01S01789.sx3ucp  +++|      THEN
01991  M01S01790.sx3ucp  +++|        BEGIN
01992  M01S01791.sx3ucp  +++|        GOTO ERRORTN;
01993  M01S01792.sx3ucp  +++|        END
01994  M01S01793.sx3ucp  +++|
01995  M01S01794.sx3ucp  +++|
01996  M01S01795.sx3ucp  +++|#
01997  M01S01796.sx3ucp  +++|*     GET THE ALLOCATION SUMMARY TABLE.
01998  M01S01797.sx3ucp  +++|#
01999  M01S01798.sx3ucp  +++|
02000  M01S01799.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
02001  M01S01800.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
02002  M01S01801.sx3ucp  +++|      THEN
02003  M01S01802.sx3ucp  +++|        BEGIN
02004  M01S01803.sx3ucp  +++|        GOTO ERRORTN;
02005  M01S01804.sx3ucp  +++|        END
02006  M01S01805.sx3ucp  +++|
02007  M01S01806.sx3ucp  +++|
02008  M01S01807.sx3ucp  +++|      P<FCT> = FCTEADDR + FCTQHL;
02009  M01S01808.sx3ucp  +++|      P<AST> = ASTBADR;
02010  M01S01809.sx3ucp  +++|
02011  M01S01810.sx3ucp  +++|#
02012  M01S01811.sx3ucp  +++|*     VERIFY THAT THE CARTRIDGE IS FREE AND UPDATE *AST*.
02013  M01S01812.sx3ucp  +++|#
02014  M01S01813.sx3ucp  +++|
02015  M01S01814.sx3ucp  +++|      ORD = CPR$FCT[0];
02016  M01S01815.sx3ucp  +++|      IF (AST$AULF[ORD] + AST$AUSF[ORD] + AST$FLAWS[ORD]) NQ INAVOT
02017  M01S01816.sx3ucp  +++|        THEN                         # CARTRIDGE IS NOT FREE #
02018  M01S01817.sx3ucp  +++|        BEGIN
02019  M01S01818.sx3ucp  +++|        ERRSTAT = RESPTYP3"MSC$NEMPTY";
02020  M01S01819.sx3ucp  +++|        ERRCONV = FALSE;             # BYPASS CODE CONVERSION #
02021  M01S01820.sx3ucp  +++|        GOTO ERRORTN;
02022  M01S01821.sx3ucp  +++|        END
02023  M01S01822.sx3ucp  +++|
02024  M01S01823.sx3ucp  +++|#
02025  M01S01824.sx3ucp  +++|*     UPDATE PREAMBLE.
02026  M01S01825.sx3ucp  +++|#
02027  M01S01826.sx3ucp  +++|
02028  M01S01827.sx3ucp  +++|
02029  M01S01828.sx3ucp  +++|      AST$1ST[ORD] = 0;
02030  M01S01829.sx3ucp  +++|      AST$2ND[ORD] = 0;
02031  M01S01830.sx3ucp  +++|      AST$STAT[ORD] = ASTENSTAT"UNASS$CART";
02032  M01S01831.sx3ucp  +++|
02033  M01S01832.sx3ucp  +++|      ANLZAST(CPR$CSU[0],-1,-1,FXS,FXL,GPX,GPS);
02034  M01S01833.sx3ucp  +++|      PRM$MXAUS[CPR$CSU[0]] = AST$AUSF[FXS];
02035  M01S01834.sx3ucp  +++|      PRM$MXAUL[CPR$CSU[0]] = AST$AULF[FXL];
02036  M01S01835.sx3ucp  +++|      PRM$MXAUGR[CPR$CSU[0]] = GPS;
02037  M01S01836.sx3ucp  +++|
02038  M01S01837.sx3ucp  +++|
02039  M01S01838.sx3ucp  +++|      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
02040  M01S01839.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
02041  M01S01840.sx3ucp  +++|      THEN
02042  M01S01841.sx3ucp  +++|        BEGIN
02043  M01S01842.sx3ucp  +++|        GOTO ERRORTN;
02044  M01S01843.sx3ucp  +++|        END
02045  M01S01844.sx3ucp  +++|
02046  M01S01845.sx3ucp  +++|#
02047  M01S01846.sx3ucp  +++|*     REMOVE THE CARTRIDGE FROM THE *FCT* AND MAP (*CSN* = 0).
02048  M01S01847.sx3ucp  +++|#
02049  M01S01848.sx3ucp  +++|
02050  M01S01849.sx3ucp  +++|      ZFILL(FCT,FCTENTL);
02051  M01S01850.sx3ucp  +++|      FCT$CSND[0] = "      ";
02052  M01S01851.sx3ucp  +++|      P<SMUMAP> = LOC(MAPBUFR);
02053  M01S01852.sx3ucp  +++|      CM$CSND[0] = "      ";
02054  M01S01853.sx3ucp  +++|      CM$CCOD[0] = 0;
02055  M01S01854.sx3ucp  +++|      CM$FLAG1[0] = FALSE;           # CLEAR ERROR FLAG IN MAP ENTRY #
02056  M01S01855.sx3ucp  +++|      CM$FCTORD[0] = 0;
02057  M01S01856.sx3ucp  +++|
02058  M01S01857.sx3ucp  +++|      MPUTENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
02059  M01S01858.sx3ucp  +++|
02060  M01S01859.sx3ucp  +++|ERRORTN:
02061  M01S01860.sx3ucp  +++|      IF ERRCONV
02062  M01S01861.sx3ucp  +++|      THEN                           # CONVERT ERROR CODE #
02063  M01S01862.sx3ucp  +++|        BEGIN
02064  M01S01863.sx3ucp  +++|        CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
02065  M01S01864.sx3ucp  +++|        END
02066  M01S01865.sx3ucp  +++|
02067  M01S01866.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
02068  M01S01867.sx3ucp  +++|      RLS$FCT(FCTEADDR,0,ERRSTAT);
02069  M01S01868.sx3ucp  +++|      LOANFCTQ(-1);
02070  M01S01869.sx3ucp  +++|      MFLUSH;
02071  M01S01870.sx3ucp  +++|      CFLUSH(CPR$FAM[0],CPR$SUB[0],0,ERRSTAT);
02072  M01S01871.sx3ucp  +++|      UCP$RES;
02073  M01S01872.sx3ucp  +++|      RETURN;
02074  M01S01873.sx3ucp  +++|
02075  M01S01874.sx3ucp  +++|      END  # RMVCAR #
02076  M01S01875.sx3ucp  +++|
02077  M01S01876.sx3ucp  +++|    TERM
02078  M01S01877.sx3ucp  +++|PROC RMVCSU;
02079  M01S01878.sx3ucp  +++|# TITLE RMVCSU - REMOVES *SM* FROM SUB-FAMILY CATALOG.                #
02080  M01S01879.sx3ucp  +++|
02081  M01S01880.sx3ucp  +++|      BEGIN  # RMVCSU #
02082  M01S01881.sx3ucp  +++|
02083  M01S01882.sx3ucp  +++|#
02084  M01S01883.sx3ucp  +++|**    RMVCSU - REMOVES *SM* FROM SUB-FAMILY CATALOG.
02085  M01S01884.sx3ucp  +++|*
02086  M01S01885.sx3ucp  +++|*     *RMVCSU* REMOVES A *SM* FROM THE
02087  M01S01886.sx3ucp  +++|*     CATALOG FOR A SUB-FAMILY.
02088  M01S01887.sx3ucp  +++|*
02089  M01S01888.sx3ucp  +++|*     PROC RMVCSU
02090  M01S01889.sx3ucp  +++|*
02091  M01S01890.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
02092  M01S01891.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
02093  M01S01892.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
02094  M01S01893.sx3ucp  +++|*               *LTCENTRY*.
02095  M01S01894.sx3ucp  +++|*
02096  M01S01895.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
02097  M01S01896.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
02098  M01S01897.sx3ucp  +++|*               OF THE REQUEST.
02099  M01S01898.sx3ucp  +++|*
02100  M01S01899.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
02101  M01S01900.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
02102  M01S01901.sx3ucp  +++|*                    = OK3             OK
02103  M01S01902.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
02104  M01S01903.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
02105  M01S01904.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
02106  M01S01905.sx3ucp  +++|#
02107  M01S01906.sx3ucp  +++|
02108  M01S01907.sx3ucp  +++|#
02109  M01S01908.sx3ucp  +++|****  PROC RMVCSU - XREF LIST BEGIN.
02110  M01S01909.sx3ucp  +++|#
02111  M01S01910.sx3ucp  +++|
02112  M01S01911.sx3ucp  +++|      XREF
02113  M01S01912.sx3ucp  +++|        BEGIN
02114  M01S01913.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
02115  M01S01914.sx3ucp  +++|                                       *UCP* ERRORS #
02116  M01S01915.sx3ucp  +++|        PROC CRMVSC;                 # REMOVE SUBCATALOG #
02117  M01S01916.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
02118  M01S01917.sx3ucp  +++|                                     #
02119  M01S01918.sx3ucp  +++|        END
02120  M01S01919.sx3ucp  +++|
02121  M01S01920.sx3ucp  +++|#
02122  M01S01921.sx3ucp  +++|****  PROC RMVCSU - XREF LIST END.
02123  M01S01922.sx3ucp  +++|#
02124  M01S01923.sx3ucp  +++|
02125  M01S01924.sx3ucp  +++|      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
02126  M01S01925.sx3ucp  +++|*CALL COMBFAS
02127  M01S01926.sx3ucp  +++|*CALL COMBCMS
02128  M01S01927.sx3ucp  +++|*CALL COMBCPR
02129  M01S01928.sx3ucp  +++|*CALL COMBMAP
02130  M01S01929.sx3ucp  +++|*CALL COMXLTC
02131  M01S01930.sx3ucp  +++|
02132  M01S01931.sx3ucp  +++|
02133  M01S01932.sx3ucp  +++|
02134  M01S01933.sx3ucp  +++|
02135  M01S01934.sx3ucp  +++|
02136  M01S01935.sx3ucp  +++|      CRMVSC(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],0,ERRSTAT);
02137  M01S01936.sx3ucp  +++|      CONVER3(CPR$RQT[0],CPR$RQC[0],ERRSTAT,ERRSTAT);
02138  M01S01937.sx3ucp  +++|      LTC$RQR[LTCENTRY] = ERRSTAT;
02139  M01S01938.sx3ucp  +++|      UCP$RES;
02140  M01S01939.sx3ucp  +++|      RETURN;
02141  M01S01940.sx3ucp  +++|
02142  M01S01941.sx3ucp  +++|      END  # RMVCSU #
02143  M01S01942.sx3ucp  +++|
02144  M01S01943.sx3ucp  +++|    TERM
02145  M01S01944.sx3ucp  +++|PROC RMVCUBE;
02146  M01S01945.sx3ucp  +++|# TITLE RMVCUBE - REMOVE CUBICLE FROM FAMILY.                         #
02147  M01S01946.sx3ucp  +++|
02148  M01S01947.sx3ucp  +++|      BEGIN  # RMVCUBE #
02149  M01S01948.sx3ucp  +++|
02150  M01S01949.sx3ucp  +++|#
02151  M01S01950.sx3ucp  +++|**    RMVCUBE - REMOVE CUBICLE FROM FAMILY.
02152  M01S01951.sx3ucp  +++|*
02153  M01S01952.sx3ucp  +++|*     *RMVCUBE* UPDATES THE *AST*, *FCT* AND *SMMAP* (IN THAT
02154  M01S01953.sx3ucp  +++|*     ORDER) TO REFLECT THAT THE GIVEN CUBICLE IS NO LONGER
02155  M01S01954.sx3ucp  +++|*     ASSIGNED TO THE SUB-FAMILY.
02156  M01S01955.sx3ucp  +++|*
02157  M01S01956.sx3ucp  +++|*     PROC RMVCUBE
02158  M01S01957.sx3ucp  +++|*
02159  M01S01958.sx3ucp  +++|*     ENTRY     THE TYPE 3 UCP REQUEST TO BE PROCESSED IS IN ARRAY
02160  M01S01959.sx3ucp  +++|*               *CPR*.  THE BASE POINTER FOR *CPR* IS ALREADY SET.  THE
02161  M01S01960.sx3ucp  +++|*               *LTCT* ENTRY FOR THE REQUESTING UCP IS POINTED TO BY
02162  M01S01961.sx3ucp  +++|*               *LTCENTRY*.
02163  M01S01962.sx3ucp  +++|*
02164  M01S01963.sx3ucp  +++|*     EXIT      THE TYPE 3 REQUEST HAS BEEN PROCESSED AND A RESPONSE
02165  M01S01964.sx3ucp  +++|*               HAS BEEN SENT BACK TO THE UCP INDICATING COMPLETION
02166  M01S01965.sx3ucp  +++|*               OF THE REQUEST.
02167  M01S01966.sx3ucp  +++|*
02168  M01S01967.sx3ucp  +++|*               RESPONSES ARE RETURNED VIA LTC$RQR[LTCENTRY].
02169  M01S01968.sx3ucp  +++|*               THESE RESPONSE CODE VALUES ARE DEFINED IN *COMBCPR*.
02170  M01S01969.sx3ucp  +++|*                    = OK3             OK
02171  M01S01970.sx3ucp  +++|*                    = C$M$INTLCK      CATALOG/MAP INTERLOCKED
02172  M01S01971.sx3ucp  +++|*                    = C$M$NOPEN       CATALOG/MAP NOT OPEN
02173  M01S01972.sx3ucp  +++|*                    = PF$PROB         PERMANENT FILE PROBLEM
02174  M01S01973.sx3ucp  +++|*                    = ILLEG$ORD       ORDINAL OUT OF RANGE
02175  M01S01974.sx3ucp  +++|#
02176  M01S01975.sx3ucp  +++|
02177  M01S01976.sx3ucp  +++|#
02178  M01S01977.sx3ucp  +++|****  PROC RMVCUBE - XREF LIST BEGIN.
02179  M01S01978.sx3ucp  +++|#
02180  M01S01979.sx3ucp  +++|
02181  M01S01980.sx3ucp  +++|      XREF
02182  M01S01981.sx3ucp  +++|        BEGIN
02183  M01S01982.sx3ucp  +++|        PROC ACQ$FCT;                # FIND THE *FCTQ* ENTRY FOR CALLER
02184  M01S01983.sx3ucp  +++|                                     #
02185  M01S01984.sx3ucp  +++|        PROC CFLUSH;                 # FLUSHES THE CATALOG I/O BUFFER #
02186  M01S01985.sx3ucp  +++|        PROC CONVER3;                # CONVERT MAP/CATALOG ERRORS TO
02187  M01S01986.sx3ucp  +++|                                       *UCP* ERRORS #
02188  M01S01987.sx3ucp  +++|        PROC CRDAST;                 # READ ALLOCATION SUMMARY TABLE #
02189  M01S01988.sx3ucp  +++|        PROC CWTAST;                 # WRITE ALLOCATION SUMMARY TABLE #
02190  M01S01989.sx3ucp  +++|        PROC MFLUSH;                 # FLUSH MAP TO FILE #
02191  M01S01990.sx3ucp  +++|        PROC MGETENT;                # RETURN THE MAP ENTRY TO THE
02192  M01S01991.sx3ucp  +++|                                       CALLER #
02193  M01S01992.sx3ucp  +++|        PROC MPUTENT;                # MAP ENTRY TO THE MAP FILE BUFFER
02194  M01S01993.sx3ucp  +++|                                     #
02195  M01S01994.sx3ucp  +++|        PROC RLS$FCT;                # RELEASE *FCTQ* ENTRY #
02196  M01S01995.sx3ucp  +++|        PROC UCP$RES;                # NOTIFY *UCP* OF REQUEST COMPLETE
02197  M01S01996.sx3ucp  +++|                                     #
02198  M01S01997.sx3ucp  +++|        PROC UPDAST;                 # UPDATE THE *AST* #
02199  M01S01998.sx3ucp  +++|        END
02200  M01S01999.sx3ucp  +++|
02201  M01S02000.sx3ucp  +++|#
02202  M01S02001.sx3ucp  +++|****  PROC RMVCUBE - XREF LIST END.
02203  M01S02002.sx3ucp  +++|#
02204  M01S02003.sx3ucp  +++|
02205  M01S02004.sx3ucp  +++|      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
02206  M01S02005.sx3ucp  +++|*CALL COMBFAS
02207  M01S02006.sx3ucp  +++|*CALL COMBCMD
02208  M01S02007.sx3ucp  +++|*CALL COMBCMS
02209  M01S02008.sx3ucp  +++|*CALL COMBCPR
02210  M01S02009.sx3ucp  +++|*CALL COMBMAP
02211  M01S02010.sx3ucp  +++|*CALL COMBMCT
02212  M01S02011.sx3ucp  +++|*CALL COMXFCQ
02213  M01S02012.sx3ucp  +++|*CALL COMXLTC
02214  M01S02013.sx3ucp  +++|*CALL COMXMSC
02215  M01S02014.sx3ucp  +++|
02216  M01S02015.sx3ucp  +++|      ITEM FCTEADDR   U;             # *FCTQ* ENTRY ADDRESS #
02217  M01S02016.sx3ucp  +++|      ITEM I          U;             # COUNTER #
02218  M01S02017.sx3ucp  +++|      ITEM ORD        I;             # *AST* ORDINAL #
02219  M01S02018.sx3ucp  +++|
02220  M01S02019.sx3ucp  +++|
02221  M01S02020.sx3ucp  +++|
02222  M01S02021.sx3ucp  +++|
02223  M01S02022.sx3ucp  +++|
02224  M01S02023.sx3ucp  +++|#
02225  M01S02024.sx3ucp  +++|*     GET THE MAP ENTRY FOR THE REQUEST.
02226  M01S02025.sx3ucp  +++|#
02227  M01S02026.sx3ucp  +++|
02228  M01S02027.sx3ucp  +++|      MGETENT(CPR$CSU[0],SMORD,LOC(MAPBUFR),ERRSTAT);
02229  M01S02028.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
02230  M01S02029.sx3ucp  +++|      THEN
02231  M01S02030.sx3ucp  +++|        BEGIN
02232  M01S02031.sx3ucp  +++|        GOTO ERRORTN;
02233  M01S02032.sx3ucp  +++|        END
02234  M01S02033.sx3ucp  +++|
02235  M01S02034.sx3ucp  +++|
02236  M01S02035.sx3ucp  +++|#
02237  M01S02036.sx3ucp  +++|*     GET THE ALLOCATION SUMMARY TABLE.
02238  M01S02037.sx3ucp  +++|#
02239  M01S02038.sx3ucp  +++|
02240  M01S02039.sx3ucp  +++|      P<AST> = ASTBADR;
02241  M01S02040.sx3ucp  +++|      CRDAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
02242  M01S02041.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
02243  M01S02042.sx3ucp  +++|      THEN
02244  M01S02043.sx3ucp  +++|        BEGIN
02245  M01S02044.sx3ucp  +++|        GOTO ERRORTN;
02246  M01S02045.sx3ucp  +++|        END
02247  M01S02046.sx3ucp  +++|
02248  M01S02047.sx3ucp  +++|#
02249  M01S02048.sx3ucp  +++|*     UPDATE *AST* AND PREAMBLE.
02250  M01S02049.sx3ucp  +++|#
02251  M01S02050.sx3ucp  +++|
02252  M01S02051.sx3ucp  +++|      ORD = CPR$FCT[0];
02253  M01S02052.sx3ucp  +++|      AST$STAT[ORD] = ASTENSTAT"UNASS$CUB";
02254  M01S02053.sx3ucp  +++|      CWTAST(CPR$FAM[0],CPR$SUB[0],CPR$CSU[0],ASTBADR,0,ERRSTAT);
02255  M01S02054.sx3ucp  +++|      IF ERRSTAT NQ CMASTAT"NOERR"
02256  M01S02055.sx3ucp  +++|      THEN
02257  M01S02056.sx3ucp  +++|        BEGIN
02258  M01S02057.sx3ucp  +++|        GOTO ERRORTN;
02259  M01S02058.sx3ucp  +++|        END
02260  M01S02059.sx3ucp  +++|

Proceed to Part 1