cdc:nos2.source:opl.opl871:deck:acccat
Deck ACCCAT
1 Modification
Listing Sections
- Deck ACCCAT Start
- Deck ACCCAT Part 1 (Line 2185)
Source
Seq # *Modification Id* Act
----------------------------+
00001 M01S00001.acccat +++|PROC BFLUSH((QRADR),ERSTAT);
00002 M01S00002.acccat +++|# TITLE BFLUSH - FLUSHES THE I/O BUFFER. #
00003 M01S00003.acccat +++| BEGIN # BFLUSH #
00004 M01S00004.acccat +++|
00005 M01S00005.acccat +++|#
00006 M01S00006.acccat +++|** BFLUSH - FLUSHES THE I/O BUFFER.
00007 M01S00007.acccat +++|*
00008 M01S00008.acccat +++|* *BFLUSH* FLUSHES THE *FCT* I/O BUFFER AND CLEARS THE BUFFER
00009 M01S00009.acccat +++|* MODIFIED FLAG IF THE DATA IN THE BUFFER HAS BEEN MODIFIED.
00010 M01S00010.acccat +++|*
00011 M01S00011.acccat +++|* BFLUSH - IS CALLED BY CBUFMAN,CEXTSC,CFLUSH,CRELSLK,CRMUSC.
00012 M01S00012.acccat +++|*
00013 M01S00013.acccat +++|* BFLUSH - IS CALLED BY CBUFMAN,CEXTSC,CFLUSH,CRELSLK,
00014 M01S00014.acccat +++|* CRMVSC,ASVAL,VLAMSF,VLAPFC,VLBICT,VLBLDVT,
00015 M01S00015.acccat +++|* VLCFS,VLFIX,VLNCS,VLSCH,VLSUBFM,VLWFIX.
00016 M01S00016.acccat +++|*
00017 M01S00017.acccat +++|* PROC BFLUSH((QRADR),ERSTAT)
00018 M01S00018.acccat +++|*
00019 M01S00019.acccat +++|* ENTRY (QRADR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
00020 M01S00020.acccat +++|*
00021 M01S00021.acccat +++|* EXIT (ERSTAT) - ERROR STATUS.
00022 M01S00022.acccat +++|* (VALUES DEFINED IN *COMACMS*)
00023 M01S00023.acccat +++|* = NO ERRORS.
00024 M01S00024.acccat +++|* = *CIO* ERROR.
00025 M01S00025.acccat +++|* THE I/O BUFFER HAS BEEN FLUSHED IF NECESSARY AND THE
00026 M01S00026.acccat +++|* BUFFER MODIFIED FLAG CLEARED.
00027 M01S00027.acccat +++|#
00028 M01S00028.acccat +++|
00029 M01S00029.acccat +++| ITEM QRADR U; # *HLRQ* ENTRY ADDRESS #
00030 M01S00030.acccat +++| ITEM ERSTAT I; # ERROR STATUS #
00031 M01S00031.acccat +++|
00032 M01S00032.acccat +++|#
00033 M01S00033.acccat +++|**** PROC BFLUSH - XREF LIST BEGIN.
00034 M01S00034.acccat +++|#
00035 M01S00035.acccat +++|
00036 M01S00036.acccat +++| XREF
00037 M01S00037.acccat +++| BEGIN
00038 M01S00038.acccat +++| PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR #
00039 M01S00039.acccat +++| PROC REWRITE; # REWRITE DATA FROM IO BUFFER #
00040 M01S00040.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
00041 M01S00041.acccat +++| END
00042 M01S00042.acccat +++|
00043 M01S00043.acccat +++|#
00044 M01S00044.acccat +++|**** PROC BFLUSH - XREF LIST END.
00045 M01S00045.acccat +++|#
00046 M01S00046.acccat +++|
00047 M01S00047.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
00048 M01S00048.acccat +++|*CALL COMBFAS
00049 M01S00049.acccat +++|*CALL COMBCMD
00050 M01S00050.acccat +++|*CALL COMBCMS
00051 M01S00051.acccat +++|*CALL COMBFET
00052 M01S00052.acccat +++|*CALL COMBMCT
00053 M01S00053.acccat +++|*CALL COMSPFM
00054 M01S00054.acccat +++|
00055 M01S00055.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
00056 M01S00056.acccat +++|CONTROL EJECT;
00057 M01S00057.acccat +++|
00058 M01S00058.acccat +++| ORD = FB$ORD[0];
00059 M01S00059.acccat +++|
00060 M01S00060.acccat +++| IF FB$BMF[0]
00061 M01S00061.acccat +++| THEN
00062 M01S00062.acccat +++| BEGIN # BUFFER MODIFIED #
00063 M01S00063.acccat +++|
00064 M01S00064.acccat +++|#
00065 M01S00065.acccat +++|* WRITE OUT BUFFER.
00066 M01S00066.acccat +++|#
00067 M01S00067.acccat +++|
00068 M01S00068.acccat +++| FB$BMF[0] = FALSE; # CLEAR BUFFER MODIFIED FLAG #
00069 M01S00069.acccat +++| ZSETFET(FCTFADR,OCT$LFN[ORD],FCTBADR,OCT$BUFL[ORD],RFETL);
00070 M01S00070.acccat +++| FET$EP[0] = TRUE;
00071 M01S00071.acccat +++| FET$IN[0] = FET$FRST[0] + OCT$BUFL[ORD] - 1;
00072 M01S00072.acccat +++| FET$R[0] = TRUE;
00073 M01S00073.acccat +++| FET$RR[0] = FB$PRUNUM[0];
00074 M01S00074.acccat +++| REWRITE(FETSET[0],RCL);
00075 M01S00075.acccat +++| IF FET$AT[0] NQ 0
00076 M01S00076.acccat +++| THEN
00077 M01S00077.acccat +++| BEGIN
00078 M01S00078.acccat +++| CPIOERR(OCT$FAM[ORD],OCT$SUBF[ORD],QRADR,ERSTAT,FETSET[0]);
00079 M01S00079.acccat +++| RETURN;
00080 M01S00080.acccat +++| END
00081 M01S00081.acccat +++|
00082 M01S00082.acccat +++| END # BUFFER MODIFIED #
00083 M01S00083.acccat +++|
00084 M01S00084.acccat +++| IF OCT$ATTM[ORD] NQ "M"
00085 M01S00085.acccat +++| THEN # IF NOT OPEN IN MODIFY MODE #
00086 M01S00086.acccat +++| BEGIN
00087 M01S00087.acccat +++| FB$CWRD[ORD] = 0; # CLEAR BUFFER CONTROL WORD #
00088 M01S00088.acccat +++| END
00089 M01S00089.acccat +++|
00090 M01S00090.acccat +++| RETURN;
00091 M01S00091.acccat +++| END # BFLUSH #
00092 M01S00092.acccat +++|
00093 M01S00093.acccat +++| TERM
00094 M01S00094.acccat +++|PROC CADDSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT);
00095 M01S00095.acccat +++|# TITLE CADDSC - ADD SUBCATALOG. #
00096 M01S00096.acccat +++| BEGIN # CADDSC #
00097 M01S00097.acccat +++|
00098 M01S00098.acccat +++|#
00099 M01S00099.acccat +++|** CADDSC - ADD SUBCATALOG.
00100 M01S00100.acccat +++|*
00101 M01S00101.acccat +++|* *CADDSC* EXPANDS THE CATALOG FILE WITH SPACE FOR AN ADDITIONAL
00102 M01S00102.acccat +++|* SUBCATALOG WITH THE SPECIFIED NUMBER OF *FCT* AND *AST* ENTRIES.
00103 M01S00103.acccat +++|* THE CATALOG MUST BE OPEN IN MODIFY MODE.
00104 M01S00104.acccat +++|*
00105 M01S00105.acccat +++|* CADDSC - IS CALLED BY ADDCSU.
00106 M01S00106.acccat +++|*
00107 M01S00107.acccat +++|* CADDSC - IS CALLED BY ADDCSU.
00108 M01S00108.acccat +++|*
00109 M01S00109.acccat +++|* PROC CADDSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT)
00110 M01S00110.acccat +++|*
00111 M01S00111.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
00112 M01S00112.acccat +++|* 7 CHARACTER MAXIMUM.
00113 M01S00113.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
00114 M01S00114.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
00115 M01S00115.acccat +++|* (NUM) - NUMBER OF *FCT* (AND *AST*) ENTRIES TO ADD.
00116 M01S00116.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
00117 M01S00117.acccat +++|*
00118 M01S00118.acccat +++|* EXIT THE SUBCATALOG HAS BEEN ADDED AND THE CATALOG PREAMBLE
00119 M01S00119.acccat +++|* HAS BEEN UPDATED TO REFLECT THE CHANGE.
00120 M01S00120.acccat +++|* (ERRSTAT) - ERROR STATUS.
00121 M01S00121.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
00122 M01S00122.acccat +++|* = NO ERRORS.
00123 M01S00123.acccat +++|* = CATALOG FILE INTERLOCKED.
00124 M01S00124.acccat +++|* = CATALOG NOT OPEN.
00125 M01S00125.acccat +++|* = CATALOG NOT OPEN IN MODIFY MODE.
00126 M01S00126.acccat +++|* = SUBCATALOG ALREADY EXISTS.
00127 M01S00127.acccat +++|* = *CIO* ERROR.
00128 M01S00128.acccat +++|* IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN
00129 M01S00129.acccat +++|* ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED.
00130 M01S00130.acccat +++|*
00131 M01S00131.acccat +++|* NOTES THE CATALOG IS RE-ATTACHED IN WRITE MODE BEFORE ADDING
00132 M01S00132.acccat +++|* THE SUBCATALOG, (IN ORDER TO EXTEND THE CATALOG), AND
00133 M01S00133.acccat +++|* WHEN FINISHED, THE FILE IS ATTACHED IN MODIFY MODE
00134 M01S00134.acccat +++|* AGAIN. SPACE FOR A SUBCATALOG IS ALWAYS ADDED IN FULL
00135 M01S00135.acccat +++|* PRU-S, SO THAT EACH *FCT* AND *AST* BEGINS AT A PRU
00136 M01S00136.acccat +++|* BOUNDARY. HOWEVER, THE LENGTH OF THE *FCT* AND *AST*
00137 M01S00137.acccat +++|* MAINTAINED IN THE CATALOG PREAMBLE REFLECTS THE
00138 M01S00138.acccat +++|* NUMBER OF ENTRIES SPECIFIED BY (NUM).
00139 M01S00139.acccat +++|*
00140 M01S00140.acccat +++|* MESSAGES * PROGRAM ABNORMAL, CADDSC.*.
00141 M01S00141.acccat +++|#
00142 M01S00142.acccat +++|
00143 M01S00143.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
00144 M01S00144.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
00145 M01S00145.acccat +++| ITEM SMID U; # SM IDENTIFIER #
00146 M01S00146.acccat +++| ITEM NUM I; # NUMBER OF ENTRIES TO ADD #
00147 M01S00147.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
00148 M01S00148.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
00149 M01S00149.acccat +++|
00150 M01S00150.acccat +++|#
00151 M01S00151.acccat +++|**** PROC CADDSC - XREF LIST BEGIN.
00152 M01S00152.acccat +++|#
00153 M01S00153.acccat +++|
00154 M01S00154.acccat +++| XREF
00155 M01S00155.acccat +++| BEGIN
00156 M01S00156.acccat +++| PROC ABORT; # ABORT #
00157 M01S00157.acccat +++| PROC BKSPRU; # BACKSPACE PHYSICAL RECORDS #
00158 M01S00158.acccat +++| PROC CDEFTF; # DEFINE TEMPORARY CATALOG #
00159 M01S00159.acccat +++| PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR #
00160 M01S00160.acccat +++| PROC MESSAGE; # ISSUE MESSAGE #
00161 M01S00161.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
00162 M01S00162.acccat +++| PROC READ; # READ FILE TO *CIO* BUFFER #
00163 M01S00163.acccat +++| PROC REPLCAT; # REPLACE MSF CATALOG #
00164 M01S00164.acccat +++| PROC REWIND; # REWIND A FILE #
00165 M01S00165.acccat +++| PROC RPHR; # READ PRU TO *CIO* BUFFER #
00166 M01S00166.acccat +++| PROC SETPFP; # SET PERMANENT FILE PARAMETERS #
00167 M01S00167.acccat +++| PROC WPHR; # WRITE PRU FROM *CIO* BUFFER #
00168 M01S00168.acccat +++| PROC WRITE; # WRITE DATA FROM *CIO* BUFFER #
00169 M01S00169.acccat +++| PROC WRITEF; # WRITE END OF FILE #
00170 M01S00170.acccat +++| PROC WRITEW; # WRITE DATA FROM WORKING BUFFER #
00171 M01S00171.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
00172 M01S00172.acccat +++| END
00173 M01S00173.acccat +++|
00174 M01S00174.acccat +++|#
00175 M01S00175.acccat +++|**** PROC CADDSC - XREF LIST END.
00176 M01S00176.acccat +++|#
00177 M01S00177.acccat +++|
00178 M01S00178.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
00179 M01S00179.acccat +++|*CALL COMBFAS
00180 M01S00180.acccat +++|*CALL COMBCMD
00181 M01S00181.acccat +++|*CALL COMBCMS
00182 M01S00182.acccat +++|*CALL COMBFET
00183 M01S00183.acccat +++|*CALL COMXMSC
00184 M01S00184.acccat +++|*CALL COMBMCT
00185 M01S00185.acccat +++|*CALL COMBPFP
00186 M01S00186.acccat +++|
00187 M01S00187.acccat +++| ITEM I I; # LOOP COUNTER #
00188 M01S00188.acccat +++| ITEM LOCAT I; # LOCATION OF NEW SUBCATALOG #
00189 M01S00189.acccat +++| ITEM NAST I; # NUMBER OF PRU-S IN *AST* #
00190 M01S00190.acccat +++| ITEM NFCT I; # NUMBER OF PRU-S IN *FCT* #
00191 M01S00191.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
00192 M01S00192.acccat +++| ITEM STAT I; # ATTACH STATUS #
00193 M01S00193.acccat +++| ITEM TEMP I; # TEMPORARY STORAGE #
00194 M01S00194.acccat +++|CONTROL EJECT;
00195 M01S00195.acccat +++|
00196 M01S00196.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL #
00197 M01S00197.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00198 M01S00198.acccat +++| THEN
00199 M01S00199.acccat +++| BEGIN
00200 M01S00200.acccat +++| RETURN; # RETURN ERROR STATUS #
00201 M01S00201.acccat +++| END
00202 M01S00202.acccat +++|
00203 M01S00203.acccat +++| P<PREAMBLE> = OCT$PRMA[ORD];
00204 M01S00204.acccat +++| IF PRM$SCW1[SMID ] NQ 0
00205 M01S00205.acccat +++| THEN # SUBCATALOG ALREADY EXISTS #
00206 M01S00206.acccat +++| BEGIN
00207 M01S00207.acccat +++| ERRSTAT = CMASTAT"SCEXISTS";
00208 M01S00208.acccat +++| RETURN; # RETURN ERROR STATUS #
00209 M01S00209.acccat +++| END
00210 M01S00210.acccat +++|
00211 M01S00211.acccat +++| IF OCT$ATTM[ORD] NQ "M"
00212 M01S00212.acccat +++| THEN # NOT OPEN IN MODIFY MODE #
00213 M01S00213.acccat +++| BEGIN
00214 M01S00214.acccat +++| ERRSTAT = CMASTAT"MODERR";
00215 M01S00215.acccat +++| RETURN; # RETURN ERROR STATUS #
00216 M01S00216.acccat +++| END
00217 M01S00217.acccat +++|
00218 M01S00218.acccat +++|#
00219 M01S00219.acccat +++|* DEFINE TEMPORARY FILE AND COPY CATALOG TO IT.
00220 M01S00220.acccat +++|#
00221 M01S00221.acccat +++|
00222 M01S00222.acccat +++| PFP$WRD0[0] = 0; # SET FAMILY AND USER INDEX #
00223 M01S00223.acccat +++| PFP$FAM[0] = OCT$FAM[ORD];
00224 M01S00224.acccat +++| PFP$UI[0] = DEF$UI + OCT$SUBF[ORD];
00225 M01S00225.acccat +++| PFP$FG1[0] = TRUE;
00226 M01S00226.acccat +++| PFP$FG4[0] = TRUE;
00227 M01S00227.acccat +++| SETPFP(PFP);
00228 M01S00228.acccat +++| IF PFP$STAT[0] NQ 0
00229 M01S00229.acccat +++| THEN # FAMILY NOT FOUND #
00230 M01S00230.acccat +++| BEGIN
00231 M01S00231.acccat +++| CMA$RTN[0] = "CADDSC.";
00232 M01S00232.acccat +++| MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE #
00233 M01S00233.acccat +++| ABORT;
00234 M01S00234.acccat +++| END
00235 M01S00235.acccat +++|
00236 M01S00236.acccat +++|
00237 M01S00237.acccat +++| ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,TBUFL,RFETL);
00238 M01S00238.acccat +++| ZSETFET(TFETADR+RFETL,TSFMCAT,TBUFADR,TBUFL,RFETL);
00239 M01S00239.acccat +++| P<FETSET> = TFETADR;
00240 M01S00240.acccat +++| FET$EP[0] = TRUE;
00241 M01S00241.acccat +++| FET$EP[1] = TRUE;
00242 M01S00242.acccat +++| REWIND(FETSET[0],NRCL);
00243 M01S00243.acccat +++| CDEFTF(FETSET[1],ERRSTAT); # DEFINE TEMPORARY CATALOG FILE #
00244 M01S00244.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00245 M01S00245.acccat +++| THEN
00246 M01S00246.acccat +++| BEGIN
00247 M01S00247.acccat +++| RETURN; # RETURN ERROR STATUS #
00248 M01S00248.acccat +++| END
00249 M01S00249.acccat +++|
00250 M01S00250.acccat +++|
00251 M01S00251.acccat +++| REPEAT WHILE NOT FET$EOI[0]
00252 M01S00252.acccat +++| DO # COPY CATALOG FILE #
00253 M01S00253.acccat +++| BEGIN
00254 M01S00254.acccat +++| READ(FETSET[0],RCL);
00255 M01S00255.acccat +++| FET$IN[1] = FET$IN[0];
00256 M01S00256.acccat +++| WRITE(FETSET[1],RCL);
00257 M01S00257.acccat +++| FET$OUT[0] = FET$OUT[1];
00258 M01S00258.acccat +++| END
00259 M01S00259.acccat +++|
00260 M01S00260.acccat +++| WRITEF(FETSET[1],RCL);
00261 M01S00261.acccat +++|
00262 M01S00262.acccat +++|#
00263 M01S00263.acccat +++|* CALCULATE NUMBER OF PRU-S TO ADD.
00264 M01S00264.acccat +++|#
00265 M01S00265.acccat +++|
00266 M01S00266.acccat +++| NAST =(MAXORD/PRULEN)* 2 + 1;
00267 M01S00267.acccat +++|
00268 M01S00268.acccat +++|#
00269 M01S00269.acccat +++|* ALLOCATE SPACE AT END OF FILE.
00270 M01S00270.acccat +++|#
00271 M01S00271.acccat +++|
00272 M01S00272.acccat +++| FET$R[1] = TRUE;
00273 M01S00273.acccat +++| BKSPRU(FETSET[1],2,RCL);
00274 M01S00274.acccat +++| IF FET$AT[1] NQ 0
00275 M01S00275.acccat +++| THEN
00276 M01S00276.acccat +++| BEGIN
00277 M01S00277.acccat +++| GOTO ERR;
00278 M01S00278.acccat +++| END
00279 M01S00279.acccat +++|
00280 M01S00280.acccat +++| LOCAT = FET$CRI[1]; # LOCATION OF NEW SUBCATALOG #
00281 M01S00281.acccat +++| SLOWFOR I = 1 STEP 1 UNTIL WBUFL
00282 M01S00282.acccat +++| DO
00283 M01S00283.acccat +++| BEGIN
00284 M01S00284.acccat +++| WBUF$W[I] = 0; # ZERO FILL WORKING BUFFER #
00285 M01S00285.acccat +++| END
00286 M01S00286.acccat +++|
00287 M01S00287.acccat +++| SLOWFOR I = NAST STEP -1 UNTIL 1
00288 M01S00288.acccat +++| DO
00289 M01S00289.acccat +++| BEGIN
00290 M01S00290.acccat +++| WRITEW(FETSET[1],WBUF,WBUFL,STAT);
00291 M01S00291.acccat +++| IF STAT NQ 0
00292 M01S00292.acccat +++| THEN # *CIO* ERROR #
00293 M01S00293.acccat +++| BEGIN
00294 M01S00294.acccat +++| GOTO ERR;
00295 M01S00295.acccat +++| END
00296 M01S00296.acccat +++|
00297 M01S00297.acccat +++| END
00298 M01S00298.acccat +++|
00299 M01S00299.acccat +++| WRITEF(FETSET[1],RCL);
00300 M01S00300.acccat +++| IF FET$AT[1] NQ 0
00301 M01S00301.acccat +++| THEN
00302 M01S00302.acccat +++| BEGIN
00303 M01S00303.acccat +++| GOTO ERR;
00304 M01S00304.acccat +++| END
00305 M01S00305.acccat +++|
00306 M01S00306.acccat +++|#
00307 M01S00307.acccat +++|* UPDATE CATALOG PREAMBLE.
00308 M01S00308.acccat +++|#
00309 M01S00309.acccat +++|
00310 M01S00310.acccat +++| PRM$SMID[SMID ] = SMID ;
00311 M01S00311.acccat +++| PRM$ENTRC[SMID] = 0;
00312 M01S00312.acccat +++| PRM$ASTLOC[SMID] = LOCAT ;
00313 M01S00313.acccat +++| PRM$FCTLOC[SMID] = LOCAT + NAST;
00314 M01S00314.acccat +++| PRM$MXAUS[SMID] = 0;
00315 M01S00315.acccat +++| PRM$MXAUL[SMID] = 0;
00316 M01S00316.acccat +++| PRM$PDATE[SMID] = 0;
00317 M01S00317.acccat +++| FET$RR[1] = 1; # WRITE UPDATED PREAMBLE #
00318 M01S00318.acccat +++| FET$IN[1] = FET$FRST[1];
00319 M01S00319.acccat +++| FET$OUT[1] = FET$FRST[1];
00320 M01S00320.acccat +++| RPHR(FETSET[1],RCL);
00321 M01S00321.acccat +++| IF FET$AT[1] NQ 0
00322 M01S00322.acccat +++| THEN
00323 M01S00323.acccat +++| BEGIN
00324 M01S00324.acccat +++| GOTO ERR;
00325 M01S00325.acccat +++| END
00326 M01S00326.acccat +++|
00327 M01S00327.acccat +++| TBUF$W[SMID +1] = PRM$SCW1[SMID];
00328 M01S00328.acccat +++| TBUF$W1[SMID+1] = PRM$SCW2[SMID];
00329 M01S00329.acccat +++| TBUF$W2[SMID+1] = PRM$SCW2[SMID];
00330 M01S00330.acccat +++| FET$RR[1] = 1;
00331 M01S00331.acccat +++| FET$W[1] = TRUE;
00332 M01S00332.acccat +++| WPHR(FETSET[1],RCL);
00333 M01S00333.acccat +++| IF FET$AT[1] NQ 0
00334 M01S00334.acccat +++| THEN
00335 M01S00335.acccat +++| BEGIN
00336 M01S00336.acccat +++| GOTO ERR;
00337 M01S00337.acccat +++| END
00338 M01S00338.acccat +++|
00339 M01S00339.acccat +++|#
00340 M01S00340.acccat +++|* REPLACE MSF CATALOG WITH NEW CATALOG (*TSFMCAT*).
00341 M01S00341.acccat +++|#
00342 M01S00342.acccat +++|
00343 M01S00343.acccat +++| REPLCAT(ORD,ERRSTAT);
00344 M01S00344.acccat +++| RETURN;
00345 M01S00345.acccat +++|
00346 M01S00346.acccat +++|ERR: # PROCESS *CIO* ERROR #
00347 M01S00347.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[1]);
00348 M01S00348.acccat +++| END # CADDSC #
00349 M01S00349.acccat +++|
00350 M01S00350.acccat +++| TERM
00351 M01S00351.acccat +++|PROC CBUFMAN((FAMNM),(SUBF),(SMID),(FCTORD),(MODF),
00352 M01S00352.acccat +++| (QRADDR),ERRSTAT);
00353 M01S00353.acccat +++|# TITLE CBUFMAN - MANAGE CATALOG *FCT* BUFFER. #
00354 M01S00354.acccat +++| BEGIN # CBUFMAN #
00355 M01S00355.acccat +++|
00356 M01S00356.acccat +++|#
00357 M01S00357.acccat +++|** CBUFMAN - MANAGE CATALOG *FCT* BUFFER.
00358 M01S00358.acccat +++|*
00359 M01S00359.acccat +++|* *CBUFMAN* ENSURES THAT THE REQUESTED FILE AND CARTRIDGE TABLE
00360 M01S00360.acccat +++|* ENTRY IS IN THE CATALOG *FCT* I/O BUFFER. THE WORD OFFSET OF THE
00361 M01S00361.acccat +++|* ENTRY WITHIN THE BUFFER IS RETURNED TO THE CALLER.
00362 M01S00362.acccat +++|*
00363 M01S00363.acccat +++|* CBUFMAN - IS CALLED BY CGETFCT,CPUTFCT.
00364 M01S00364.acccat +++|*
00365 M01S00365.acccat +++|* PROC CBUFMAN((FAMNM),(SUBF),(SMID ),(FCTORD),OFFSET,(MODF),
00366 M01S00366.acccat +++|* (QRADDR),ERRSTAT)
00367 M01S00367.acccat +++|*
00368 M01S00368.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
00369 M01S00369.acccat +++|* 7 CHARACTER MAXIMUM.
00370 M01S00370.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
00371 M01S00371.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
00372 M01S00372.acccat +++|* (FCTORD) - ORDINAL OF ENTRY IN *FCT*.
00373 M01S00373.acccat +++|* (MODF) - CATALOG ATTACH MODE FLAG.
00374 M01S00374.acccat +++|* = FALSE, MODIFY MODE NOT REQUIRED.
00375 M01S00375.acccat +++|* = TRUE, MODIFY MODE IS REQUIRED.
00376 M01S00376.acccat +++|* (QRADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO.
00377 M01S00377.acccat +++|*
00378 M01S00378.acccat +++|* EXIT THE REQUESTED *FCT* ENTRY IS IN THE *FCT* I/O BUFFER.
00379 M01S00379.acccat +++|* (OFFSET) - WORD OFFSET OF ENTRY WITHIN BUFFER.
00380 M01S00380.acccat +++|* (ERRSTAT) - ERROR STATUS.
00381 M01S00381.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
00382 M01S00382.acccat +++|* = NO ERROR.
00383 M01S00383.acccat +++|* = CATALOG FILE INTERLOCKED.
00384 M01S00384.acccat +++|* = CATALOG NOT OPEN.
00385 M01S00385.acccat +++|* = CATALOG NOT OPEN IN MODIFY MODE.
00386 M01S00386.acccat +++|* = NO SUCH SUBCATALOG.
00387 M01S00387.acccat +++|* = *CIO* ERROR.
00388 M01S00388.acccat +++|* = *FCT* ORDINAL OUT OF RANGE.
00389 M01S00389.acccat +++|#
00390 M01S00390.acccat +++|
00391 M01S00391.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
00392 M01S00392.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
00393 M01S00393.acccat +++| ITEM SMID U; # SM IDENTIFIER #
00394 M01S00394.acccat +++| ITEM FCTORD I; # *FCT* ORDINAL #
00395 M01S00395.acccat +++| ITEM OFFSET I; # WORD OFFSET WITHIN BUFFER #
00396 M01S00396.acccat +++| ITEM MODF B; # MODIFY MODE FLAG #
00397 M01S00397.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
00398 M01S00398.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
00399 M01S00399.acccat +++|
00400 M01S00400.acccat +++|#
00401 M01S00401.acccat +++|**** PROC CBUFMAN - XREF LIST BEGIN.
00402 M01S00402.acccat +++|#
00403 M01S00403.acccat +++|
00404 M01S00404.acccat +++| XREF
00405 M01S00405.acccat +++| BEGIN
00406 M01S00406.acccat +++| PROC BFLUSH; # BUFFER FLUSH #
00407 M01S00407.acccat +++| PROC CCLOSE; # CLOSE CATALOG #
00408 M01S00408.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
00409 M01S00409.acccat +++| PROC READ; # READ FILE TO *CIO* BUFFER #
00410 M01S00410.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
00411 M01S00411.acccat +++| END
00412 M01S00412.acccat +++|
00413 M01S00413.acccat +++|#
00414 M01S00414.acccat +++|**** PROC CBUFMAN - XREF LIST END.
00415 M01S00415.acccat +++|#
00416 M01S00416.acccat +++|
00417 M01S00417.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
00418 M01S00418.acccat +++|*CALL COMBFAS
00419 M01S00419.acccat +++|*CALL COMBCMD
00420 M01S00420.acccat +++|*CALL COMBCMS
00421 M01S00421.acccat +++|*CALL COMBFET
00422 M01S00422.acccat +++|*CALL COMBMCT
00423 M01S00423.acccat +++|*CALL COMXMSC
00424 M01S00424.acccat +++|*CALL COMSPFM
00425 M01S00425.acccat +++|
00426 M01S00426.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
00427 M01S00427.acccat +++| ITEM PRUNUM I; # PRU NUMBER #
00428 M01S00428.acccat +++| ITEM TEMP I; # TEMPORARY STORAGE ITEM #
00429 M01S00429.acccat +++|
00430 M01S00430.acccat +++|CONTROL EJECT;
00431 M01S00431.acccat +++|
00432 M01S00432.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL #
00433 M01S00433.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00434 M01S00434.acccat +++| THEN
00435 M01S00435.acccat +++| BEGIN
00436 M01S00436.acccat +++| RETURN; # RETURN ERROR STATUS #
00437 M01S00437.acccat +++| END
00438 M01S00438.acccat +++|
00439 M01S00439.acccat +++| P<PREAMBLE> = OCT$PRMA[ORD];
00440 M01S00440.acccat +++| IF PRM$SCW1[SMID ] EQ 0
00441 M01S00441.acccat +++| THEN # IF NO SUCH SUBCATALOG EXISTS #
00442 M01S00442.acccat +++| BEGIN
00443 M01S00443.acccat +++| ERRSTAT = CMASTAT"NOSUBCAT";
00444 M01S00444.acccat +++| RETURN; # RETURN ERROR STATUS #
00445 M01S00445.acccat +++| END
00446 M01S00446.acccat +++|
00447 M01S00447.acccat +++| IF FCTORD GR (PRM$ENTRC[SMID] + 15) OR FCTORD LQ 15
00448 M01S00448.acccat +++| THEN # IF *FCT* ORDINAL BAD #
00449 M01S00449.acccat +++| BEGIN
00450 M01S00450.acccat +++| ERRSTAT = CMASTAT"ORDERR";
00451 M01S00451.acccat +++| RETURN; # RETURN ERROR STATUS #
00452 M01S00452.acccat +++| END
00453 M01S00453.acccat +++|
00454 M01S00454.acccat +++| IF MODF AND OCT$ATTM[ORD] NQ "M"
00455 M01S00455.acccat +++| THEN # IF NOT OPEN IN MODIFY MODE #
00456 M01S00456.acccat +++| BEGIN
00457 M01S00457.acccat +++| ERRSTAT = CMASTAT"MODERR";
00458 M01S00458.acccat +++| RETURN; # RETURN ERROR STATUS #
00459 M01S00459.acccat +++| END
00460 M01S00460.acccat +++|
00461 M01S00461.acccat +++|#
00462 M01S00462.acccat +++|* CALCULATE POSITION OF REQUESTED *FCT* ENTRY.
00463 M01S00463.acccat +++|* (PRUNUM) = PRU OFFSET WITHIN CATALOG.
00464 M01S00464.acccat +++|#
00465 M01S00465.acccat +++|
00466 M01S00466.acccat +++| TEMP = 16 * (FCTORD - 16);
00467 M01S00467.acccat +++| PRUNUM = PRM$FCTLOC[SMID ] + TEMP;
00468 M01S00468.acccat +++|
00469 M01S00469.acccat +++|#
00470 M01S00470.acccat +++|* ENSURE THAT REQUESTED *FCT* ENTRY IS IN I/O BUFFER.
00471 M01S00471.acccat +++|#
00472 M01S00472.acccat +++|
00473 M01S00473.acccat +++| IF PRUNUM NQ FB$PRUNUM[0]
00474 M01S00474.acccat +++| OR ORD NQ FB$ORD[0]
00475 M01S00475.acccat +++| OR PRM$SUBF[0] NQ SUBF
00476 M01S00476.acccat +++| OR PRM$FAM[0] NQ FAMNM
00477 M01S00477.acccat +++| THEN # IF ENTRY NOT IN BUFFER #
00478 M01S00478.acccat +++| BEGIN # READ ENTRY INTO BUFFER #
00479 M01S00479.acccat +++| IF PRM$SUBF[0] EQ SUBF
00480 M01S00480.acccat +++| AND PRM$FAM[0] EQ FAMNM
00481 M01S00481.acccat +++| THEN
00482 M01S00482.acccat +++| BEGIN
00483 M01S00483.acccat +++| BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER #
00484 M01S00484.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00485 M01S00485.acccat +++| THEN
00486 M01S00486.acccat +++| BEGIN
00487 M01S00487.acccat +++| RETURN;
00488 M01S00488.acccat +++| END
00489 M01S00489.acccat +++| END
00490 M01S00490.acccat +++|
00491 M01S00491.acccat +++|
00492 M01S00492.acccat +++| ZSETFET(FCTFADR,OCT$LFN[ORD],FCTBADR,OCT$BUFL[ORD],RFETL);
00493 M01S00493.acccat +++| P<FETSET> = FCTFADR;
00494 M01S00494.acccat +++| FET$EP[0] = TRUE;
00495 M01S00495.acccat +++| FET$R[0] = TRUE;
00496 M01S00496.acccat +++| FET$RR[0] = PRUNUM;
00497 M01S00497.acccat +++| READ(FETSET[0],RCL);
00498 M01S00498.acccat +++| IF FET$AT[0] NQ 0
00499 M01S00499.acccat +++| THEN
00500 M01S00500.acccat +++| BEGIN
00501 M01S00501.acccat +++| CCLOSE(FAMNM,SUBF,QRADDR,ERRSTAT); # CLOSE CATALOG #
00502 M01S00502.acccat +++| ERRSTAT = CMASTAT"CIOERR"; # RETURN ERROR STATUS #
00503 M01S00503.acccat +++| RETURN;
00504 M01S00504.acccat +++| END
00505 M01S00505.acccat +++|
00506 M01S00506.acccat +++| FB$ORD[0] = ORD; # SET BUFFER CONTROL WORD #
00507 M01S00507.acccat +++| FB$PRUCNT[0] = OCT$BUFL[ORD]/PRULEN;
00508 M01S00508.acccat +++| FB$PRUNUM[0] = PRUNUM;
00509 M01S00509.acccat +++| END # READ ENTRY INTO BUFFER #
00510 M01S00510.acccat +++|
00511 M01S00511.acccat +++|
00512 M01S00512.acccat +++| RETURN;
00513 M01S00513.acccat +++| END # CBUFMAN #
00514 M01S00514.acccat +++|
00515 M01S00515.acccat +++| TERM
00516 M01S00516.acccat +++|PROC CCLOSE((FAMNM),(SUBF),(QRADDR),ERRSTAT);
00517 M01S00517.acccat +++|# TITLE CCLOSE - CLOSE CATALOG. #
00518 M01S00518.acccat +++| BEGIN # CCLOSE #
00519 M01S00519.acccat +++|
00520 M01S00520.acccat +++|#
00521 M01S00521.acccat +++|** CCLOSE - CLOSE CATALOG.
00522 M01S00522.acccat +++|*
00523 M01S00523.acccat +++|* *CCLOSE* TERMINATES CATALOG USAGE. IF THE CATALOG WAS
00524 M01S00524.acccat +++|* OPEN IN MODIFY MODE, THE UPDATED PREAMBLE IS WRITTEN
00525 M01S00525.acccat +++|* BACK TO THE CATALOG AND THE *FCT* I/O BUFFER IS FLUSHED
00526 M01S00526.acccat +++|* (IF THE DATA IN THE BUFFER WAS MODIFIED).
00527 M01S00527.acccat +++|* THE CATALOG FILE IS RETURNED AND THE *OCT* ENTRY IS CLEARED.
00528 M01S00528.acccat +++|*
00529 M01S00529.acccat +++|* CCLOSE - IS CALLED BY CBUFMAN,CPIOERR,CRDPRM,DBFLAG,DBFMAP,
00530 M01S00530.acccat +++|* DBRDFIL,DBREL,TERMCAT,USRPBAS,USRPDE,VLSUBFM.
00531 M01S00531.acccat +++|*
00532 M01S00532.acccat +++|* PROC CCLOSE((FAMNM),(SUBF),(QRADDR),ERRSTAT)
00533 M01S00533.acccat +++|*
00534 M01S00534.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
00535 M01S00535.acccat +++|* 7 CHARACTER MAXIMUM.
00536 M01S00536.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
00537 M01S00537.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
00538 M01S00538.acccat +++|*
00539 M01S00539.acccat +++|* EXIT (ERRSTAT) - ERROR STATUS.
00540 M01S00540.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
00541 M01S00541.acccat +++|* = NO ERRORS.
00542 M01S00542.acccat +++|* = CATALOG FILE INTERLOCKED.
00543 M01S00543.acccat +++|* = CATALOG NOT OPEN.
00544 M01S00544.acccat +++|* = *CIO* ERROR.
00545 M01S00545.acccat +++|*
00546 M01S00546.acccat +++|#
00547 M01S00547.acccat +++|
00548 M01S00548.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
00549 M01S00549.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
00550 M01S00550.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
00551 M01S00551.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
00552 M01S00552.acccat +++|
00553 M01S00553.acccat +++|#
00554 M01S00554.acccat +++|**** PROC CCLOSE - XREF LIST BEGIN.
00555 M01S00555.acccat +++|#
00556 M01S00556.acccat +++|
00557 M01S00557.acccat +++| XREF
00558 M01S00558.acccat +++| BEGIN
00559 M01S00559.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
00560 M01S00560.acccat +++| PROC RETERN; # RETURN FILE TO SYSTEM #
00561 M01S00561.acccat +++| PROC REWRITE; # REWRITE DATA FROM I/O BUFFER #
00562 M01S00562.acccat +++| PROC RPHR; # READ PRU TO *CIO* BUFFER #
00563 M01S00563.acccat +++| PROC WPHR; # WRITE PRU FROM *CIO* BUFFER #
00564 M01S00564.acccat +++| PROC ZFILL; # ZERO FILLS A BUFFER #
00565 M01S00565.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
00566 M01S00566.acccat +++| END
00567 M01S00567.acccat +++|
00568 M01S00568.acccat +++|#
00569 M01S00569.acccat +++|**** PROC CCLOSE - XREF LIST END.
00570 M01S00570.acccat +++|#
00571 M01S00571.acccat +++|
00572 M01S00572.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
00573 M01S00573.acccat +++|*CALL COMBFAS
00574 M01S00574.acccat +++|*CALL COMBCMD
00575 M01S00575.acccat +++|*CALL COMBCMS
00576 M01S00576.acccat +++|*CALL COMBFET
00577 M01S00577.acccat +++|*CALL COMBMCT
00578 M01S00578.acccat +++|*CALL COMSPFM
00579 M01S00579.acccat +++|
00580 M01S00580.acccat +++| ITEM I I; # LOOP COUNTER #
00581 M01S00581.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
00582 M01S00582.acccat +++|CONTROL EJECT;
00583 M01S00583.acccat +++|
00584 M01S00584.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL #
00585 M01S00585.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00586 M01S00586.acccat +++| THEN
00587 M01S00587.acccat +++| BEGIN
00588 M01S00588.acccat +++| RETURN; # RETURN ERROR STATUS #
00589 M01S00589.acccat +++| END
00590 M01S00590.acccat +++|
00591 M01S00591.acccat +++| IF FB$BMF[0] AND ORD EQ FB$ORD[0]
00592 M01S00592.acccat +++| THEN
00593 M01S00593.acccat +++| BEGIN # FLUSH BUFFER #
00594 M01S00594.acccat +++| ZSETFET(FCTFADR,OCT$LFN[ORD],FCTBADR,OCT$BUFL[ORD],RFETL);
00595 M01S00595.acccat +++| FET$EP[0] = TRUE;
00596 M01S00596.acccat +++| FET$R[0] = TRUE;
00597 M01S00597.acccat +++| FET$IN[0] = FET$FRST[0] + OCT$BUFL[ORD] - 1;
00598 M01S00598.acccat +++| FET$RR[0] = FB$PRUNUM[0];
00599 M01S00599.acccat +++| REWRITE(FETSET[0],RCL);
00600 M01S00600.acccat +++| IF FET$AT[0] NQ 0
00601 M01S00601.acccat +++| THEN
00602 M01S00602.acccat +++| BEGIN
00603 M01S00603.acccat +++| ERRSTAT = CMASTAT"CIOERR";
00604 M01S00604.acccat +++| FET$AT[0] = 0;
00605 M01S00605.acccat +++| END
00606 M01S00606.acccat +++|
00607 M01S00607.acccat +++| FB$CWRD[0] = 0;
00608 M01S00608.acccat +++| END # FLUSH BUFFER #
00609 M01S00609.acccat +++|
00610 M01S00610.acccat +++| ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,2*PRULEN,RFETL);
00611 M01S00611.acccat +++|
00612 M01S00612.acccat +++|#
00613 M01S00613.acccat +++|* WRITE UPDATED PREAMBLE BACK TO THE CATALOG FILE.
00614 M01S00614.acccat +++|#
00615 M01S00615.acccat +++|
00616 M01S00616.acccat +++| IF OCT$ATTM[ORD] EQ "M"
00617 M01S00617.acccat +++| THEN # IF CATALOG OPEN IN MODIFY MODE #
00618 M01S00618.acccat +++| BEGIN # UPDATE CATALOG PREAMBLE #
00619 M01S00619.acccat +++| FET$EP[0] = TRUE;
00620 M01S00620.acccat +++| FET$R[0] = TRUE;
00621 M01S00621.acccat +++| FET$RR[0] = 1;
00622 M01S00622.acccat +++| RPHR(FETSET[0],RCL);
00623 M01S00623.acccat +++| IF FET$AT[0] NQ 0
00624 M01S00624.acccat +++| THEN
00625 M01S00625.acccat +++| BEGIN
00626 M01S00626.acccat +++| ERRSTAT = CMASTAT"CIOERR";
00627 M01S00627.acccat +++| FET$AT[0] = 0;
00628 M01S00628.acccat +++| END
00629 M01S00629.acccat +++|
00630 M01S00630.acccat +++| P<PREAMBLE> = OCT$PRMA[ORD];
00631 M01S00631.acccat +++| FASTFOR I = 0 STEP 1 UNTIL MAXSM
00632 M01S00632.acccat +++| DO
00633 M01S00633.acccat +++| BEGIN
00634 M01S00634.acccat +++| TBUF$W[I+1] = PRM$SCW1[I];
00635 M01S00635.acccat +++| TBUF$W1[I+1] = PRM$SCW2[I];
00636 M01S00636.acccat +++| TBUF$W2[I+1] = PRM$SCW3[I];
00637 M01S00637.acccat +++| END
00638 M01S00638.acccat +++|
00639 M01S00639.acccat +++| FET$RR[0] = 1;
00640 M01S00640.acccat +++| FET$W[0] = TRUE;
00641 M01S00641.acccat +++| WPHR(FETSET[0],RCL);
00642 M01S00642.acccat +++| IF FET$AT[0] NQ 0
00643 M01S00643.acccat +++| THEN
00644 M01S00644.acccat +++| BEGIN
00645 M01S00645.acccat +++| ERRSTAT = CMASTAT"CIOERR";
00646 M01S00646.acccat +++| FET$AT[0] = 0;
00647 M01S00647.acccat +++| END
00648 M01S00648.acccat +++|
00649 M01S00649.acccat +++| END # UPDATE CATALOG PREAMBLE #
00650 M01S00650.acccat +++|
00651 M01S00651.acccat +++|#
00652 M01S00652.acccat +++|* RETURN CATALOG FILE.
00653 M01S00653.acccat +++|#
00654 M01S00654.acccat +++|
00655 M01S00655.acccat +++| RETERN(FETSET[0],RCL);
00656 M01S00656.acccat +++|
00657 M01S00657.acccat +++|#
00658 M01S00658.acccat +++|* CLEAR ENTRY IN OPEN CATALOG TABLE.
00659 M01S00659.acccat +++|#
00660 M01S00660.acccat +++|
00661 M01S00661.acccat +++| ZFILL(OCT[ORD],OCTENTL);
00662 M01S00662.acccat +++| RETURN;
00663 M01S00663.acccat +++| END # CCLOSE #
00664 M01S00664.acccat +++|
00665 M01S00665.acccat +++| TERM
00666 M01S00666.acccat +++|PROC CDEFTF(FET,ERSTAT);
00667 M01S00667.acccat +++|# TITLE CDEFTF - DEFINE TEMPORARY CATALOG. #
00668 M01S00668.acccat +++| BEGIN # CDEFTF #
00669 M01S00669.acccat +++|
00670 M01S00670.acccat +++|#
00671 M01S00671.acccat +++|** CDEFTF - DEFINE TEMPORARY CATALOG.
00672 M01S00672.acccat +++|*
00673 M01S00673.acccat +++|* *CDEFTF* DEFINES A FILE TO BE USED FOR CHANGING THE
00674 M01S00674.acccat +++|* SIZE OF THE MSS CATALOG.
00675 M01S00675.acccat +++|*
00676 M01S00676.acccat +++|* CDEFTF - IS CALLED BY CADDSC, CEXTSC,CRMVSC.
00677 M01S00677.acccat +++|*
00678 M01S00678.acccat +++|*
00679 M01S00679.acccat +++|* PROC CDEFTF(FET,ERSTAT)
00680 M01S00680.acccat +++|*
00681 M01S00681.acccat +++|* ENTRY FET - AN ARRAY CONTAINING THE FET FOR *TSFMCAT*.
00682 M01S00682.acccat +++|*
00683 M01S00683.acccat +++|* EXIT A FILE NAMED *TSFMCAT* HAS BEEN DEFINED.
00684 M01S00684.acccat +++|* (ERSTAT) - ERROR STATUS.
00685 M01S00685.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
00686 M01S00686.acccat +++|* = NO ERRORS.
00687 M01S00687.acccat +++|* = *CIO* ERROR.
00688 M01S00688.acccat +++|* = FILE DEFINE ERROR.
00689 M01S00689.acccat +++|* = FILE PURGE ERROR.
00690 M01S00690.acccat +++|*
00691 M01S00691.acccat +++|*
00692 M01S00692.acccat +++|* NOTES IF THE FILE ALREADY EXISTS, IT IS PURGED AND
00693 M01S00693.acccat +++|* REDEFINED.
00694 M01S00694.acccat +++|#
00695 M01S00695.acccat +++|
00696 M01S00696.acccat +++| ARRAY FET [0:0] P(1); ; # FET FOR FILE *TSFMCAT* #
00697 M01S00697.acccat +++| ITEM ERSTAT I; # ERROR STATUS #
00698 M01S00698.acccat +++|
00699 M01S00699.acccat +++|#
00700 M01S00700.acccat +++|**** PROC CDEFTF - XREF LIST BEGIN.
00701 M01S00701.acccat +++|#
00702 M01S00702.acccat +++|
00703 M01S00703.acccat +++| XREF
00704 M01S00704.acccat +++| BEGIN
00705 M01S00705.acccat +++| PROC PFD; # PERMANENT FILE REQUEST DELAYS #
00706 M01S00706.acccat +++| PROC RETERN; # RETURN FILE TO SYSTEM #
00707 M01S00707.acccat +++| END
00708 M01S00708.acccat +++|
00709 M01S00709.acccat +++|#
00710 M01S00710.acccat +++|**** PROC CDEFTF - XREF LIST END.
00711 M01S00711.acccat +++|#
00712 M01S00712.acccat +++|
00713 M01S00713.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
00714 M01S00714.acccat +++|*CALL COMBFAS
00715 M01S00715.acccat +++|*CALL COMBCMS
00716 M01S00716.acccat +++|*CALL COMBPFS
00717 M01S00717.acccat +++|*CALL COMXMSC
00718 M01S00718.acccat +++|*CALL COMSPFM
00719 M01S00719.acccat +++|CONTROL EJECT;
00720 M01S00720.acccat +++|
00721 M01S00721.acccat +++| PFD("DEFINE",TSFMCAT,0,"BR","Y","SR","MR","RC",PFSTAT,"UP",0,0);
00722 M01S00722.acccat +++| IF PFSTAT NQ 0
00723 M01S00723.acccat +++| THEN
00724 M01S00724.acccat +++| BEGIN # DEFINE ERROR #
00725 M01S00725.acccat +++| IF PFSTAT EQ FAP
00726 M01S00726.acccat +++| THEN
00727 M01S00727.acccat +++| BEGIN # FILE ALREADY EXISTS #
00728 M01S00728.acccat +++| PFD("PURGE",TSFMCAT,"RC",PFSTAT,"UP",0,0);
00729 M01S00729.acccat +++| IF PFSTAT NQ 0
00730 M01S00730.acccat +++| THEN # IF PURGE ERROR #
00731 M01S00731.acccat +++| BEGIN
00732 M01S00732.acccat +++| ERSTAT = CMASTAT"TPRGERR";
00733 M01S00733.acccat +++| RETURN;
00734 M01S00734.acccat +++| END
00735 M01S00735.acccat +++|
00736 M01S00736.acccat +++| RETERN(FET[0],RCL);
00737 M01S00737.acccat +++| PFD("DEFINE",TSFMCAT,0,"BR","Y","SR","MR",
00738 M01S00738.acccat +++| "RC",PFSTAT,"UP",0,0);
00739 M01S00739.acccat +++| IF PFSTAT NQ 0
00740 M01S00740.acccat +++| THEN # IF DEFINE ERROR #
00741 M01S00741.acccat +++| BEGIN
00742 M01S00742.acccat +++| ERSTAT = CMASTAT"TDEFERR";
00743 M01S00743.acccat +++| RETURN;
00744 M01S00744.acccat +++| END
00745 M01S00745.acccat +++|
00746 M01S00746.acccat +++| END # FILE ALREADY EXISTS #
00747 M01S00747.acccat +++|
00748 M01S00748.acccat +++| ELSE
00749 M01S00749.acccat +++| BEGIN
00750 M01S00750.acccat +++| ERSTAT = CMASTAT"TDEFERR";
00751 M01S00751.acccat +++| RETURN;
00752 M01S00752.acccat +++| END
00753 M01S00753.acccat +++|
00754 M01S00754.acccat +++| END # DEFINE ERROR #
00755 M01S00755.acccat +++|
00756 M01S00756.acccat +++| END # CDEFTF #
00757 M01S00757.acccat +++|
00758 M01S00758.acccat +++| TERM
00759 M01S00759.acccat +++|PROC CEXTSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT);
00760 M01S00760.acccat +++|# TITLE CEXTSC - EXTEND SUBCATALOG. #
00761 M01S00761.acccat +++| BEGIN # CEXTSC #
00762 M01S00762.acccat +++|
00763 M01S00763.acccat +++|#
00764 M01S00764.acccat +++|** CEXTSC - EXTEND SUBCATALOG.
00765 M01S00765.acccat +++|*
00766 M01S00766.acccat +++|* *CEXTSC* EXPANDS AND REORGANIZES THE CATALOG FILE TO ACCOMODATE
00767 M01S00767.acccat +++|* AN INCREASE IN THE SIZE OF THE SUBCATALOG. THE CATALOG MUST BE
00768 M01S00768.acccat +++|* OPEN IN MODIFY MODE.
00769 M01S00769.acccat +++|*
00770 M01S00770.acccat +++|* CEXTSC - IS CALLED BY ADDCUBE.
00771 M01S00771.acccat +++|*
00772 M01S00772.acccat +++|* PROC CEXTSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT)
00773 M01S00773.acccat +++|*
00774 M01S00774.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
00775 M01S00775.acccat +++|* 7 CHARACTER MAXIMUM.
00776 M01S00776.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
00777 M01S00777.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
00778 M01S00778.acccat +++|* (NUM) - NUMBER OF *FCT* (AND *AST*) ENTRIES TO ADD.
00779 M01S00779.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
00780 M01S00780.acccat +++|*
00781 M01S00781.acccat +++|* EXIT THE SIZE OF THE SPECIFIED SUBCATALOG HAS BEEN
00782 M01S00782.acccat +++|* INCREASED AND THE PREAMBLE HAS BEEN UPDATED TO
00783 M01S00783.acccat +++|* REFLECT THE CHANGE.
00784 M01S00784.acccat +++|* (ERRSTAT) - ERROR STATUS.
00785 M01S00785.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
00786 M01S00786.acccat +++|* = NO ERRORS.
00787 M01S00787.acccat +++|* = CATALOG FILE INTERLOCKED.
00788 M01S00788.acccat +++|* = CATALOG NOT OPEN.
00789 M01S00789.acccat +++|* = CATALOG NOT OPEN IN MODIFY MODE.
00790 M01S00790.acccat +++|* = NO SUCH SUBCATALOG.
00791 M01S00791.acccat +++|* = *CIO* ERROR.
00792 M01S00792.acccat +++|* = FILE DEFINE ERROR.
00793 M01S00793.acccat +++|* = FILE ATTACH ERROR.
00794 M01S00794.acccat +++|* = FILE PURGE ERROR.
00795 M01S00795.acccat +++|* = FILE RENAME ERROR.
00796 M01S00796.acccat +++|* IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN
00797 M01S00797.acccat +++|* ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED.
00798 M01S00798.acccat +++|*
00799 M01S00799.acccat +++|* NOTES THE CATALOG IS RE-ATTACHED IN WRITE MODE IN ORDER TO
00800 M01S00800.acccat +++|* EXTEND THE SUBCATALOG, AND WHEN FINISHED, THE FILE IS
00801 M01S00801.acccat +++|* ATTACHED IN MODIFY MODE AGAIN.
00802 M01S00802.acccat +++|*
00803 M01S00803.acccat +++|* MESSAGES * PROGRAM ABNORMAL, CEXTSC.*.
00804 M01S00804.acccat +++|#
00805 M01S00805.acccat +++|
00806 M01S00806.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
00807 M01S00807.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
00808 M01S00808.acccat +++| ITEM SMID U; # SM IDENTIFIER #
00809 M01S00809.acccat +++| ITEM NUM I; # NUMBER OF ENTRIES TO ADD #
00810 M01S00810.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
00811 M01S00811.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
00812 M01S00812.acccat +++|
00813 M01S00813.acccat +++|#
00814 M01S00814.acccat +++|**** PROC CEXTSC - XREF LIST BEGIN.
00815 M01S00815.acccat +++|#
00816 M01S00816.acccat +++|
00817 M01S00817.acccat +++| XREF
00818 M01S00818.acccat +++| BEGIN
00819 M01S00819.acccat +++| PROC ABORT; # ABORT #
00820 M01S00820.acccat +++| PROC BFLUSH; # FLUSH *FCT* I/O BUFFER #
00821 M01S00821.acccat +++| PROC CDEFTF; # DEFINE TEMPORARY CATALOG #
00822 M01S00822.acccat +++| PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR #
00823 M01S00823.acccat +++| PROC MESSAGE; # ISSUE MESSAGE #
00824 M01S00824.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
00825 M01S00825.acccat +++| PROC READ; # READ FILE TO *CIO* BUFFER #
00826 M01S00826.acccat +++| PROC READW; # READ DATA TO WORKING BUFFER #
00827 M01S00827.acccat +++| PROC REPLCAT; # REPLACE MSF CATALOG #
00828 M01S00828.acccat +++| PROC REWIND; # REWIND A FILE #
00829 M01S00829.acccat +++| PROC SETPFP; # SET PERMANENT FILE PARAMETERS #
00830 M01S00830.acccat +++| PROC WRITEF; # WRITE END OF FILE #
00831 M01S00831.acccat +++| PROC WRITEW; # WRITE DATA FROM WORKING BUFFER #
00832 M01S00832.acccat +++| PROC ZFILL; # ZERO FILL BUFFER #
00833 M01S00833.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
00834 M01S00834.acccat +++| END
00835 M01S00835.acccat +++|
00836 M01S00836.acccat +++|#
00837 M01S00837.acccat +++|**** PROC CEXTSC - XREF LIST END.
00838 M01S00838.acccat +++|#
00839 M01S00839.acccat +++|
00840 M01S00840.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
00841 M01S00841.acccat +++|*CALL COMBFAS
00842 M01S00842.acccat +++|*CALL COMBBZF
00843 M01S00843.acccat +++|*CALL COMBCMD
00844 M01S00844.acccat +++|*CALL COMBCMS
00845 M01S00845.acccat +++|*CALL COMBFET
00846 M01S00846.acccat +++|*CALL COMBMCT
00847 M01S00847.acccat +++|*CALL COMBPFP
00848 M01S00848.acccat +++|*CALL COMXMSC
00849 M01S00849.acccat +++|
00850 M01S00850.acccat +++| ITEM EXT1 I; # EXTEND VALUE 1 #
00851 M01S00851.acccat +++| ITEM EXT2 I; # EXTEND VALUE 2 #
00852 M01S00852.acccat +++| ITEM I I; # LOOP COUNTER #
00853 M01S00853.acccat +++| ITEM J I; # LOOP COUNTER #
00854 M01S00854.acccat +++| ITEM N I; # COUNTER #
00855 M01S00855.acccat +++| ITEM NAST I; # NUMBER OF PRU-S IN *AST* #
00856 M01S00856.acccat +++| ITEM NFCT I; # NUMBER OF PRU-S IN *FCT* #
00857 M01S00857.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
00858 M01S00858.acccat +++| ITEM STAT I; # STATUS #
00859 M01S00859.acccat +++| ITEM TEMP I; # TEMPORARY STORAGE #
00860 M01S00860.acccat +++| ITEM WRD$AV I; # NUMBER OF WORDS AVAILABLE #
00861 M01S00861.acccat +++| ITEM WRD$ND I; # NUMBER OF WORDS NEEDED #
00862 M01S00862.acccat +++|CONTROL EJECT;
00863 M01S00863.acccat +++|
00864 M01S00864.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL #
00865 M01S00865.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00866 M01S00866.acccat +++| THEN
00867 M01S00867.acccat +++| BEGIN
00868 M01S00868.acccat +++| RETURN; # RETURN ERROR STATUS #
00869 M01S00869.acccat +++| END
00870 M01S00870.acccat +++|
00871 M01S00871.acccat +++| IF OCT$ATTM[ORD] NQ "M"
00872 M01S00872.acccat +++| THEN # IF NOT OPEN IN MODIFY MODE #
00873 M01S00873.acccat +++| BEGIN
00874 M01S00874.acccat +++| ERRSTAT = CMASTAT"MODERR";
00875 M01S00875.acccat +++| RETURN; # RETURN ERROR STATUS #
00876 M01S00876.acccat +++| END
00877 M01S00877.acccat +++|
00878 M01S00878.acccat +++| P<PREAMBLE> = OCT$PRMA[ORD];
00879 M01S00879.acccat +++| IF PRM$SCW1[SMID ] EQ 0
00880 M01S00880.acccat +++| THEN # IF NO SUCH SUBCATALOG #
00881 M01S00881.acccat +++| BEGIN
00882 M01S00882.acccat +++| ERRSTAT = CMASTAT"NOSUBCAT";
00883 M01S00883.acccat +++| RETURN; # RETURN ERROR STATUS #
00884 M01S00884.acccat +++| END
00885 M01S00885.acccat +++|
00886 M01S00886.acccat +++| BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER #
00887 M01S00887.acccat +++| FB$CWRD[0] = 0;
00888 M01S00888.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00889 M01S00889.acccat +++| THEN
00890 M01S00890.acccat +++| BEGIN
00891 M01S00891.acccat +++| RETURN;
00892 M01S00892.acccat +++| END
00893 M01S00893.acccat +++|
00894 M01S00894.acccat +++|#
00895 M01S00895.acccat +++|* SET FAMILY AND USER INDEX.
00896 M01S00896.acccat +++|#
00897 M01S00897.acccat +++|
00898 M01S00898.acccat +++| PFP$WRD0[0] = 0;
00899 M01S00899.acccat +++| PFP$FAM[0] = OCT$FAM[ORD];
00900 M01S00900.acccat +++| PFP$UI[0] = DEF$UI + OCT$SUBF[ORD];
00901 M01S00901.acccat +++| PFP$FG1[0] = TRUE;
00902 M01S00902.acccat +++| PFP$FG4[0] = TRUE;
00903 M01S00903.acccat +++| SETPFP(PFP);
00904 M01S00904.acccat +++| IF PFP$STAT[0] NQ 0
00905 M01S00905.acccat +++| THEN # IF FAMILY NOT FOUND #
00906 M01S00906.acccat +++| BEGIN
00907 M01S00907.acccat +++| CMA$RTN[0] = "CEXTSC.";
00908 M01S00908.acccat +++| MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE #
00909 M01S00909.acccat +++| ABORT;
00910 M01S00910.acccat +++| END
00911 M01S00911.acccat +++|
00912 M01S00912.acccat +++| ZSETFET(TFETADR,OCT$LFN[ORD],FCTBADR,SEQBL,RFETL);
00913 M01S00913.acccat +++| FET$EP[0] = TRUE;
00914 M01S00914.acccat +++| ZSETFET(TFETADR+RFETL,TSFMCAT,TBUFADR,TBUFL,RFETL);
00915 M01S00915.acccat +++| FET$EP[0] = TRUE;
00916 M01S00916.acccat +++| REWIND(TFET[0],NRCL);
00917 M01S00917.acccat +++| CDEFTF(TFET[1],ERRSTAT); # DEFINE TEMPORARY CATALOG FILE #
00918 M01S00918.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
00919 M01S00919.acccat +++| THEN
00920 M01S00920.acccat +++| BEGIN
00921 M01S00921.acccat +++| RETURN; # RETURN ERROR STATUS #
00922 M01S00922.acccat +++| END
00923 M01S00923.acccat +++|
00924 M01S00924.acccat +++|#
00925 M01S00925.acccat +++|* DETERMINE CATALOG EXTENSION VALUES.
00926 M01S00926.acccat +++|* (EXT1) = RELATIVE SECTOR ADDRESS TO BEGIN *FCT* EXTENSION AT.
00927 M01S00927.acccat +++|* (NFCT) = NUMBER OF PRU-S NEEDED FOR THE *FCT* EXTENSION.
00928 M01S00928.acccat +++|#
00929 M01S00929.acccat +++|
00930 M01S00930.acccat +++| EXT1 = PRM$FCTLOC[SMID] + PRM$ENTRC[SMID] * 16;
00931 M01S00931.acccat +++| NFCT = 16 * NUM;
00932 M01S00932.acccat +++|
00933 M01S00933.acccat +++|
00934 M01S00934.acccat +++|#
00935 M01S00935.acccat +++|* UPDATE CATALOG PREAMBLE.
00936 M01S00936.acccat +++|#
00937 M01S00937.acccat +++|
00938 M01S00938.acccat +++| PRM$ENTRC[SMID ] = PRM$ENTRC[SMID ] + NUM;
00939 M01S00939.acccat +++| FASTFOR I = 1 STEP 1 UNTIL MAXSM
00940 M01S00940.acccat +++| DO
00941 M01S00941.acccat +++| BEGIN
00942 M01S00942.acccat +++| IF PRM$ASTLOC[I] GR PRM$ASTLOC[SMID]
00943 M01S00943.acccat +++| THEN # IF SUBCATALOG LOCATION CHANGED #
00944 M01S00944.acccat +++| BEGIN
00945 M01S00945.acccat +++| PRM$FCTLOC[I] = PRM$FCTLOC[I] + NFCT;
00946 M01S00946.acccat +++| PRM$ASTLOC[I] = PRM$ASTLOC[I] + NFCT;
00947 M01S00947.acccat +++| END
00948 M01S00948.acccat +++|
00949 M01S00949.acccat +++| END
00950 M01S00950.acccat +++|
00951 M01S00951.acccat +++|#
00952 M01S00952.acccat +++|* TRANSFER CATALOG FILE TO TEMPORARY FILE, EXTENDING SUBCATALOG.
00953 M01S00953.acccat +++|#
00954 M01S00954.acccat +++|
00955 M01S00955.acccat +++| READ(TFET[0],RCL);
00956 M01S00956.acccat +++| READW(TFET[0],WBUF,WBUFL,STAT);
00957 M01S00957.acccat +++| IF STAT EQ CIOERR
00958 M01S00958.acccat +++| THEN # IF *CIO* ERROR #
00959 M01S00959.acccat +++| BEGIN
00960 M01S00960.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]);
00961 M01S00961.acccat +++| RETURN;
00962 M01S00962.acccat +++| END
00963 M01S00963.acccat +++|
00964 M01S00964.acccat +++| IF STAT NQ 0
00965 M01S00965.acccat +++| THEN # IF TRANSFER NOT COMPLETE #
00966 M01S00966.acccat +++| BEGIN
00967 M01S00967.acccat +++| CMA$RTN[0] = "CEXTSC.";
00968 M01S00968.acccat +++| MESSAGE(CMAMSG,UDFL1);
00969 M01S00969.acccat +++| ABORT;
00970 M01S00970.acccat +++| END
00971 M01S00971.acccat +++|
00972 M01S00972.acccat +++| P<TBUF> = WBUFADR;
00973 M01S00973.acccat +++| FASTFOR I = 0 STEP 1 UNTIL MAXSM
00974 M01S00974.acccat +++| DO
00975 M01S00975.acccat +++| BEGIN
00976 M01S00976.acccat +++| TBUF$W[I+1] = PRM$SCW1[I];
00977 M01S00977.acccat +++| TBUF$W1[I+1] = PRM$SCW2[I];
00978 M01S00978.acccat +++| TBUF$W2[I+1] = PRM$SCW3[I];
00979 M01S00979.acccat +++| END
00980 M01S00980.acccat +++| P<TBUF> = TBUFADR;
00981 M01S00981.acccat +++|
00982 M01S00982.acccat +++| WRITEW(TFET[1],WBUF,WBUFL,STAT);
00983 M01S00983.acccat +++| SLOWFOR I = 2 STEP 1 WHILE STAT EQ 0
00984 M01S00984.acccat +++| DO
00985 M01S00985.acccat +++| BEGIN # TRANSFER CATALOG #
00986 M01S00986.acccat +++| IF I EQ EXT1
00987 M01S00987.acccat +++| THEN
00988 M01S00988.acccat +++| BEGIN # FILE TO BE EXTENDED #
00989 M01S00989.acccat +++|
00990 M01S00990.acccat +++| ZFILL(WBUF,WBUFL);
00991 M01S00991.acccat +++|
00992 M01S00992.acccat +++| SLOWFOR J = 1 STEP 1 UNTIL NFCT
00993 M01S00993.acccat +++| DO
00994 M01S00994.acccat +++| BEGIN
00995 M01S00995.acccat +++| WRITEW(TFET[1],WBUF,WBUFL,STAT);
00996 M01S00996.acccat +++| IF STAT NQ 0
00997 M01S00997.acccat +++| THEN # IF *CIO* ERROR #
00998 M01S00998.acccat +++| BEGIN
00999 M01S00999.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]);
01000 M01S01000.acccat +++| RETURN;
01001 M01S01001.acccat +++| END
01002 M01S01002.acccat +++|
01003 M01S01003.acccat +++| END
01004 M01S01004.acccat +++|
01005 M01S01005.acccat +++| END # FILE TO BE EXTENDED #
01006 M01S01006.acccat +++|
01007 M01S01007.acccat +++| READW(TFET[0],WBUF,WBUFL,STAT);
01008 M01S01008.acccat +++| IF STAT EQ CIOERR
01009 M01S01009.acccat +++| THEN # IF *CIO* ERROR #
01010 M01S01010.acccat +++| BEGIN
01011 M01S01011.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]);
01012 M01S01012.acccat +++| RETURN;
01013 M01S01013.acccat +++| END
01014 M01S01014.acccat +++|
01015 M01S01015.acccat +++| IF STAT NQ 0 AND (I + 1) EQ EXT1
01016 M01S01016.acccat +++| THEN # ADD SPACE AT END OF FILE #
01017 M01S01017.acccat +++| BEGIN
01018 M01S01018.acccat +++| SLOWFOR J = 1 STEP 1 UNTIL NFCT
01019 M01S01019.acccat +++| DO
01020 M01S01020.acccat +++| BEGIN
01021 M01S01021.acccat +++| WRITEW(TFET[1],WBUF,WBUFL,STAT);
01022 M01S01022.acccat +++| IF STAT NQ 0
01023 M01S01023.acccat +++| THEN
01024 M01S01024.acccat +++| BEGIN
01025 M01S01025.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]);
01026 M01S01026.acccat +++| RETURN;
01027 M01S01027.acccat +++| END
01028 M01S01028.acccat +++|
01029 M01S01029.acccat +++| END
01030 M01S01030.acccat +++|
01031 M01S01031.acccat +++| STAT = -1;
01032 M01S01032.acccat +++| TEST I;
01033 M01S01033.acccat +++| END
01034 M01S01034.acccat +++|
01035 M01S01035.acccat +++|
01036 M01S01036.acccat +++| IF STAT NQ 0
01037 M01S01037.acccat +++| THEN # IF *EOR*, *EOF* OR *EOI* #
01038 M01S01038.acccat +++| BEGIN
01039 M01S01039.acccat +++| TEST I; # EXIT LOOP #
01040 M01S01040.acccat +++| END
01041 M01S01041.acccat +++|
01042 M01S01042.acccat +++| WRITEW(TFET[1],WBUF,WBUFL,STAT);
01043 M01S01043.acccat +++| IF STAT NQ 0
01044 M01S01044.acccat +++| THEN # *CIO* ERROR #
01045 M01S01045.acccat +++| BEGIN
01046 M01S01046.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]);
01047 M01S01047.acccat +++| RETURN;
01048 M01S01048.acccat +++| END
01049 M01S01049.acccat +++|
01050 M01S01050.acccat +++|
01051 M01S01051.acccat +++| END # TRANSFER CATALOG #
01052 M01S01052.acccat +++|
01053 M01S01053.acccat +++| WRITEF(TFET[1],RCL);
01054 M01S01054.acccat +++| IF FET$AT[0] NQ 0
01055 M01S01055.acccat +++| THEN
01056 M01S01056.acccat +++| BEGIN
01057 M01S01057.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]);
01058 M01S01058.acccat +++| RETURN;
01059 M01S01059.acccat +++| END
01060 M01S01060.acccat +++|
01061 M01S01061.acccat +++|#
01062 M01S01062.acccat +++|* REPLACE MSF CATALOG WITH NEW CATALOG (*TSFMCAT*).
01063 M01S01063.acccat +++|#
01064 M01S01064.acccat +++|
01065 M01S01065.acccat +++| REPLCAT(ORD,ERRSTAT);
01066 M01S01066.acccat +++| RETURN;
01067 M01S01067.acccat +++| END # CEXTSC #
01068 M01S01068.acccat +++|
01069 M01S01069.acccat +++| TERM
01070 M01S01070.acccat +++|PROC CFLUSH((FAMNM),(SUBF),(QRADDR),ERRSTAT);
01071 M01S01071.acccat +++|# TITLE CFLUSH - FLUSHES THE CATALOG I/O BUFFER. #
01072 M01S01072.acccat +++| BEGIN # CFLUSH #
01073 M01S01073.acccat +++|
01074 M01S01074.acccat +++|#
01075 M01S01075.acccat +++|** CFLUSH - FLUSHES THE CATALOG I/O BUFFER.
01076 M01S01076.acccat +++|*
01077 M01S01077.acccat +++|* *CFLUSH* CHECKS FOR ERRORS AND CALLS *BFLUSH* TO FLUSH THE
01078 M01S01078.acccat +++|* CATALOG I/O BUFFER, WHICH IS USED FOR READING AND WRITING
01079 M01S01079.acccat +++|* *FCT* ENTRIES. THE CATALOG MUST BE OPEN IN MODIFY MODE.
01080 M01S01080.acccat +++|*
01081 M01S01081.acccat +++|* CFLUSH - IS CALLED BY ADDCAR,ADDCSU,ADDCUBE,DESTAGR,PURGCHN,
01082 M01S01082.acccat +++|* PURGFCT,RMVCAR,RMVCUBE,STAGER.
01083 M01S01083.acccat +++|*
01084 M01S01084.acccat +++|*
01085 M01S01085.acccat +++|* PROC CFLUSH((FAMNM),(SUBF),(QRADDR),ERRSTAT)
01086 M01S01086.acccat +++|*
01087 M01S01087.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
01088 M01S01088.acccat +++|* 7 CHARACTER MAXIMUM.
01089 M01S01089.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01090 M01S01090.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
01091 M01S01091.acccat +++|*
01092 M01S01092.acccat +++|* EXIT (ERRSTAT) - ERROR STATUS.
01093 M01S01093.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01094 M01S01094.acccat +++|* = NO ERRORS.
01095 M01S01095.acccat +++|* = CATALOG FILE INTERLOCKED.
01096 M01S01096.acccat +++|* = CATALOG NOT OPEN.
01097 M01S01097.acccat +++|* = CATALOG NOT OPEN IN MODIFY MODE.
01098 M01S01098.acccat +++|* = *CIO* ERROR.
01099 M01S01099.acccat +++|#
01100 M01S01100.acccat +++|
01101 M01S01101.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01102 M01S01102.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01103 M01S01103.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
01104 M01S01104.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01105 M01S01105.acccat +++|
01106 M01S01106.acccat +++|#
01107 M01S01107.acccat +++|**** PROC CFLUSH - XREF LIST BEGIN.
01108 M01S01108.acccat +++|#
01109 M01S01109.acccat +++|
01110 M01S01110.acccat +++| XREF
01111 M01S01111.acccat +++| BEGIN
01112 M01S01112.acccat +++| PROC BFLUSH; # BUFFER FLUSH #
01113 M01S01113.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
01114 M01S01114.acccat +++| END
01115 M01S01115.acccat +++|
01116 M01S01116.acccat +++|#
01117 M01S01117.acccat +++|**** PROC CFLUSH - XREF LIST END.
01118 M01S01118.acccat +++|#
01119 M01S01119.acccat +++|
01120 M01S01120.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01121 M01S01121.acccat +++|*CALL COMBFAS
01122 M01S01122.acccat +++|*CALL COMBCMD
01123 M01S01123.acccat +++|*CALL COMBCMS
01124 M01S01124.acccat +++|*CALL COMSPFM
01125 M01S01125.acccat +++|
01126 M01S01126.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
01127 M01S01127.acccat +++|CONTROL EJECT;
01128 M01S01128.acccat +++|
01129 M01S01129.acccat +++|#
01130 M01S01130.acccat +++|* FIND ENTRY IN THE OPEN CATALOG TABLE.
01131 M01S01131.acccat +++|#
01132 M01S01132.acccat +++|
01133 M01S01133.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT);
01134 M01S01134.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
01135 M01S01135.acccat +++| THEN
01136 M01S01136.acccat +++| BEGIN
01137 M01S01137.acccat +++| RETURN; # RETURN ERROR STATUS #
01138 M01S01138.acccat +++| END
01139 M01S01139.acccat +++|
01140 M01S01140.acccat +++| IF OCT$ATTM[ORD] NQ "M"
01141 M01S01141.acccat +++| THEN # IF NOT OPEN IN MODIFY MODE #
01142 M01S01142.acccat +++| BEGIN
01143 M01S01143.acccat +++| ERRSTAT = CMASTAT"MODERR"; # RETURN ERROR STATUS #
01144 M01S01144.acccat +++| RETURN;
01145 M01S01145.acccat +++| END
01146 M01S01146.acccat +++|
01147 M01S01147.acccat +++| BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER #
01148 M01S01148.acccat +++| RETURN;
01149 M01S01149.acccat +++| END # CFLUSH #
01150 M01S01150.acccat +++|
01151 M01S01151.acccat +++| TERM
01152 M01S01152.acccat +++|PROC CGETFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR),(QRADDR),
01153 M01S01153.acccat +++| ERRSTAT);
01154 M01S01154.acccat +++|# TITLE CGETFCT - GET AN *FCT* ENTRY. #
01155 M01S01155.acccat +++| BEGIN # CGETFCT #
01156 M01S01156.acccat +++|
01157 M01S01157.acccat +++|#
01158 M01S01158.acccat +++|** CGETFCT - GET AN *FCT* ENTRY.
01159 M01S01159.acccat +++|*
01160 M01S01160.acccat +++|*
01161 M01S01161.acccat +++|* *CGETFCT* RETURNS THE REQUESTED FILE AND CARTRIDGE TABLE ENTRY
01162 M01S01162.acccat +++|* TO THE CALLER.
01163 M01S01163.acccat +++|*
01164 M01S01164.acccat +++|* CGETFCT - IS CALLED BY ACQ$FCT,DBFLAG,DBFMAP,DBRDFIL,DBREL,
01165 M01S01165.acccat +++|* LBRMMSC,OPENCAT,USANALF,USRPDE,VLBLDVT.
01166 M01S01166.acccat +++|*
01167 M01S01167.acccat +++|* PROC CGETFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR),
01168 M01S01168.acccat +++|* (QRADDR),ERRSTAT)
01169 M01S01169.acccat +++|*
01170 M01S01170.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
01171 M01S01171.acccat +++|* 7 CHARACTER MAXIMUM.
01172 M01S01172.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01173 M01S01173.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
01174 M01S01174.acccat +++|* (FCTORD) - ORDINAL OF ENTRY IN *FCT*.
01175 M01S01175.acccat +++|* (BADDR) - ADDRESS OF BUFFER TO RECEIVE *FCT* ENTRY.
01176 M01S01176.acccat +++|* (QRADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO.
01177 M01S01177.acccat +++|*
01178 M01S01178.acccat +++|* EXIT THE REQUESTED *FCT* ENTRY IS RETURNED TO THE CALLER AT
01179 M01S01179.acccat +++|* THE ADDRESS SPECIFIED BY (BADDR).
01180 M01S01180.acccat +++|* (ERRSTAT) - ERROR STATUS.
01181 M01S01181.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01182 M01S01182.acccat +++|* = NO ERROR.
01183 M01S01183.acccat +++|* = CATALOG FILE INTERLOCKED.
01184 M01S01184.acccat +++|* = CATALOG NOT OPEN.
01185 M01S01185.acccat +++|* = NO SUCH SUBCATALOG.
01186 M01S01186.acccat +++|* = *CIO* ERROR.
01187 M01S01187.acccat +++|* = *FCT* ORDINAL OUT OF RANGE.
01188 M01S01188.acccat +++|#
01189 M01S01189.acccat +++|
01190 M01S01190.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01191 M01S01191.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01192 M01S01192.acccat +++| ITEM SMID U; # SM IDENTIFIER #
01193 M01S01193.acccat +++| ITEM FCTORD I; # *FCT* ORDINAL #
01194 M01S01194.acccat +++| ITEM BADDR U; # ADDRESS OF *FCT* ENTRY BUFFER #
01195 M01S01195.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
01196 M01S01196.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01197 M01S01197.acccat +++|
01198 M01S01198.acccat +++|#
01199 M01S01199.acccat +++|**** PROC CGETFCT - XREF LIST BEGIN.
01200 M01S01200.acccat +++|#
01201 M01S01201.acccat +++|
01202 M01S01202.acccat +++| XREF
01203 M01S01203.acccat +++| BEGIN
01204 M01S01204.acccat +++| PROC CBUFMAN; # MANAGE CATALOG *FCT* BUFFER #
01205 M01S01205.acccat +++| END
01206 M01S01206.acccat +++|
01207 M01S01207.acccat +++|#
01208 M01S01208.acccat +++|**** PROC CGETFCT - XREF LIST END.
01209 M01S01209.acccat +++|#
01210 M01S01210.acccat +++|
01211 M01S01211.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01212 M01S01212.acccat +++|*CALL COMBFAS
01213 M01S01213.acccat +++|*CALL COMBCMD
01214 M01S01214.acccat +++|*CALL COMBCMS
01215 M01S01215.acccat +++|*CALL COMBMCT
01216 M01S01216.acccat +++|
01217 M01S01217.acccat +++| ITEM I I; # LOOP COUNTER #
01218 M01S01218.acccat +++| ITEM MODF B = FALSE; # MODIFY MODE FLAG #
01219 M01S01219.acccat +++| ITEM OFFSET I; # WORD OFFSET WITHIN BUFFER #
01220 M01S01220.acccat +++|
01221 M01S01221.acccat +++| BASED
01222 M01S01222.acccat +++| ARRAY ENTBUF [1:FCTENTL] P(1); # *FCT* ENTRY BUFFER #
01223 M01S01223.acccat +++| BEGIN
01224 M01S01224.acccat +++| ITEM ENT$WRD I(00,00,60); # ENTRY WORD #
01225 M01S01225.acccat +++| END
01226 M01S01226.acccat +++|
01227 M01S01227.acccat +++|CONTROL EJECT;
01228 M01S01228.acccat +++|
01229 M01S01229.acccat +++|#
01230 M01S01230.acccat +++|* ENSURE THAT REQUESTED *FCT* ENTRY IS WITHIN I/O BUFFER.
01231 M01S01231.acccat +++|#
01232 M01S01232.acccat +++|
01233 M01S01233.acccat +++| CBUFMAN(FAMNM,SUBF,SMID,FCTORD,MODF,QRADDR,ERRSTAT);
01234 M01S01234.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
01235 M01S01235.acccat +++| THEN
01236 M01S01236.acccat +++| BEGIN
01237 M01S01237.acccat +++| RETURN; # RETURN ERROR STATUS #
01238 M01S01238.acccat +++| END
01239 M01S01239.acccat +++|
01240 M01S01240.acccat +++|#
01241 M01S01241.acccat +++|* TRANSFER ENTRY TO CALLERS BUFFER.
01242 M01S01242.acccat +++|#
01243 M01S01243.acccat +++|
01244 M01S01244.acccat +++| P<ENTBUF> = BADDR;
01245 M01S01245.acccat +++| SLOWFOR I = 1 STEP 1 UNTIL FCTENTL
01246 M01S01246.acccat +++| DO
01247 M01S01247.acccat +++| BEGIN
01248 M01S01248.acccat +++| ENT$WRD[I] = FCTB$WRD[I];
01249 M01S01249.acccat +++| END
01250 M01S01250.acccat +++|
01251 M01S01251.acccat +++| RETURN;
01252 M01S01252.acccat +++| END # CGETFCT #
01253 M01S01253.acccat +++|
01254 M01S01254.acccat +++| TERM
01255 M01S01255.acccat +++|PROC CGETPD((FAMNM),(SUBF),(SMID ),LASTPRG,(QRADDR),ERRSTAT);
01256 M01S01256.acccat +++|# TITLE CGETPD - GET PURGE DATE. #
01257 M01S01257.acccat +++| BEGIN # CGETPD #
01258 M01S01258.acccat +++|
01259 M01S01259.acccat +++|#
01260 M01S01260.acccat +++|** CGETPD - GET PURGE DATE.
01261 M01S01261.acccat +++|*
01262 M01S01262.acccat +++|*
01263 M01S01263.acccat +++|* *CGETPD* GETS THE DATE AND TIME OF THE LAST PURGE OF ORPHAN
01264 M01S01264.acccat +++|* FILES (AN MSF FILE WITH NO REFERENCE TO IT IN THE *PFC*) FROM THE
01265 M01S01265.acccat +++|* APPROPRIATE CATALOG PREAMBLE ENTRY.
01266 M01S01266.acccat +++|*
01267 M01S01267.acccat +++|* CGETPD - IS CALLED BY GETPD AND VLSUBTD.
01268 M01S01268.acccat +++|*
01269 M01S01269.acccat +++|* PROC CGETPD((FAMNM),(SUBF),(SMID ),LASTPRG,(QRADDR),ERRSTAT)
01270 M01S01270.acccat +++|*
01271 M01S01271.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED
01272 M01S01272.acccat +++|* 7 CHARACTER MAXIMUM.
01273 M01S01273.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01274 M01S01274.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
01275 M01S01275.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
01276 M01S01276.acccat +++|*
01277 M01S01277.acccat +++|* EXIT (LASTPRG) - LAST PURGE DATE AND TIME IN PACKED FORMAT,
01278 M01S01278.acccat +++|* AS RETURNED BY THE *PDATE* MACRO.
01279 M01S01279.acccat +++|* (ERRSTAT) - ERROR STATUS.
01280 M01S01280.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01281 M01S01281.acccat +++|* = NO ERROR.
01282 M01S01282.acccat +++|* = CATALOG FILE INTERLOCKED.
01283 M01S01283.acccat +++|* = CATALOG NOT OPEN.
01284 M01S01284.acccat +++|* = NO SUCH SUBCATALOG EXISTS.
01285 M01S01285.acccat +++|* = *CIO* ERROR.
01286 M01S01286.acccat +++|*
01287 M01S01287.acccat +++|* NOTES THE PREAMBLE TABLE DOES NOT CONTAIN THE LAST PURGE
01288 M01S01288.acccat +++|* DATE AND TIME (ONLY THE FIRST WORD OF EACH SUBCATALOG
01289 M01S01289.acccat +++|* ENTRY IS IN THE TABLE), SO THE PREAMBLE MUST BE READ
01290 M01S01290.acccat +++|* FROM THE CATALOG.
01291 M01S01291.acccat +++|#
01292 M01S01292.acccat +++|
01293 M01S01293.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01294 M01S01294.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01295 M01S01295.acccat +++| ITEM SMID U; # SM IDENTIFIER #
01296 M01S01296.acccat +++| ITEM LASTPRG U; # LAST PURGE DATE #
01297 M01S01297.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
01298 M01S01298.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01299 M01S01299.acccat +++|
01300 M01S01300.acccat +++|#
01301 M01S01301.acccat +++|**** PROC CGETPD - XREF LIST BEGIN.
01302 M01S01302.acccat +++|#
01303 M01S01303.acccat +++|
01304 M01S01304.acccat +++| XREF
01305 M01S01305.acccat +++| BEGIN
01306 M01S01306.acccat +++| PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR #
01307 M01S01307.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
01308 M01S01308.acccat +++| PROC REWIND; # REWIND FILE #
01309 M01S01309.acccat +++| PROC RPHR; # READ PRU TO *CIO* BUFFER #
01310 M01S01310.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
01311 M01S01311.acccat +++| END
01312 M01S01312.acccat +++|
01313 M01S01313.acccat +++|#
01314 M01S01314.acccat +++|**** PROC CGETPD - XREF LIST END.
01315 M01S01315.acccat +++|#
01316 M01S01316.acccat +++|
01317 M01S01317.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01318 M01S01318.acccat +++|*CALL COMBFAS
01319 M01S01319.acccat +++|*CALL COMBCMD
01320 M01S01320.acccat +++|*CALL COMBCMS
01321 M01S01321.acccat +++|*CALL COMBFET
01322 M01S01322.acccat +++|*CALL COMBMCT
01323 M01S01323.acccat +++|*CALL COMXMSC
01324 M01S01324.acccat +++|
01325 M01S01325.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
01326 M01S01326.acccat +++|CONTROL EJECT;
01327 M01S01327.acccat +++|
01328 M01S01328.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL #
01329 M01S01329.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
01330 M01S01330.acccat +++| THEN
01331 M01S01331.acccat +++| BEGIN
01332 M01S01332.acccat +++| RETURN; # RETURN ERROR STATUS #
01333 M01S01333.acccat +++| END
01334 M01S01334.acccat +++|
01335 M01S01335.acccat +++| P<PREAMBLE> = OCT$PRMA[ORD];
01336 M01S01336.acccat +++| IF PRM$SCW1[SMID ] EQ 0
01337 M01S01337.acccat +++| THEN # IF NO SUCH SUBCATALOG #
01338 M01S01338.acccat +++| BEGIN
01339 M01S01339.acccat +++| ERRSTAT = CMASTAT"NOSUBCAT";
01340 M01S01340.acccat +++| RETURN;
01341 M01S01341.acccat +++| END
01342 M01S01342.acccat +++|
01343 M01S01343.acccat +++|
01344 M01S01344.acccat +++|#
01345 M01S01345.acccat +++|* GET DATE AND TIME OF LAST PURGE OF ORPHAN FILES.
01346 M01S01346.acccat +++|#
01347 M01S01347.acccat +++|
01348 M01S01348.acccat +++| ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,TBUFL,RFETL);
01349 M01S01349.acccat +++| FET$EP[0] = TRUE;
01350 M01S01350.acccat +++| REWIND(FETSET[0],RCL);
01351 M01S01351.acccat +++| RPHR(FETSET[0],RCL);
01352 M01S01352.acccat +++| IF FET$AT[0] NQ 0
01353 M01S01353.acccat +++| THEN
01354 M01S01354.acccat +++| BEGIN
01355 M01S01355.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[0]);
01356 M01S01356.acccat +++| RETURN;
01357 M01S01357.acccat +++| END
01358 M01S01358.acccat +++|
01359 M01S01359.acccat +++| P<PREAMBLE> = TBUFADR;
01360 M01S01360.acccat +++| LASTPRG = PRM$PDATE[SMID ];
01361 M01S01361.acccat +++| RETURN;
01362 M01S01362.acccat +++| END # CGETPD #
01363 M01S01363.acccat +++|
01364 M01S01364.acccat +++| TERM
01365 M01S01365.acccat +++|PROC CINIT((FAMNM),(SUBF),(FLNM),ERRSTAT);
01366 M01S01366.acccat +++|# TITLE CINIT - MSS CATALOG INITIALIZATION. #
01367 M01S01367.acccat +++| BEGIN # CINIT #
01368 M01S01368.acccat +++|
01369 M01S01369.acccat +++|#
01370 M01S01370.acccat +++|** CINIT - MSS CATALOG INITIALIZATION.
01371 M01S01371.acccat +++|*
01372 M01S01372.acccat +++|* CINIT - IS CALLED BY DFCAT OF THE SSDEF DECK.
01373 M01S01373.acccat +++|*
01374 M01S01374.acccat +++|* *CINIT* CREATES A FILE AND INITIALIZES IT AS A SKELETON CATALOG
01375 M01S01375.acccat +++|* CONTAINING A PREAMBLE BUT NO SUBCATALOGS. THE PREAMBLE CONTAINS
01376 M01S01376.acccat +++|* THE FAMILY NAME AND SUBFAMILY DESIGNATOR IN THE HEADER.
01377 M01S01377.acccat +++|*
01378 M01S01378.acccat +++|* PROC CINIT((FAMNM),(SUBF),(FLNM),ERRSTAT)
01379 M01S01379.acccat +++|*
01380 M01S01380.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
01381 M01S01381.acccat +++|* 7 CHARACTER MAXIMUM.
01382 M01S01382.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01383 M01S01383.acccat +++|* (FLNM) - CATALOG FILE NAME, LEFT JUSTIFIED, ZERO
01384 M01S01384.acccat +++|* FILLED, 7 CHARACTER MAXIMUM.
01385 M01S01385.acccat +++|*
01386 M01S01386.acccat +++|* EXIT (ERRSTAT) - ERROR STATUS.
01387 M01S01387.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01388 M01S01388.acccat +++|* = NO ERROR.
01389 M01S01389.acccat +++|* = CATALOG FILE ALREADY EXISTS.
01390 M01S01390.acccat +++|* = *CIO* ERROR.
01391 M01S01391.acccat +++|* = CATALOG DEFINE ERROR.
01392 M01S01392.acccat +++|#
01393 M01S01393.acccat +++|
01394 M01S01394.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01395 M01S01395.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01396 M01S01396.acccat +++| ITEM FLNM C(7); # CATALOG FILE NAME #
01397 M01S01397.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01398 M01S01398.acccat +++|
01399 M01S01399.acccat +++|#
01400 M01S01400.acccat +++|**** PROC CINIT - XREF LIST BEGIN.
01401 M01S01401.acccat +++|#
01402 M01S01402.acccat +++|
01403 M01S01403.acccat +++| XREF
01404 M01S01404.acccat +++| BEGIN
01405 M01S01405.acccat +++| PROC PFD; # PERMANENT FILE REQUEST DELAYS #
01406 M01S01406.acccat +++| PROC RETERN; # RETURN FILE TO SYSTEM #
01407 M01S01407.acccat +++| PROC WRITEF; # WRITE END OF FILE #
01408 M01S01408.acccat +++| PROC WRITEW; # WRITE DATA FROM WORKING BUFFER #
01409 M01S01409.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
01410 M01S01410.acccat +++| END
01411 M01S01411.acccat +++|
01412 M01S01412.acccat +++|#
01413 M01S01413.acccat +++|**** PROC CINIT - XREF LIST END.
01414 M01S01414.acccat +++|#
01415 M01S01415.acccat +++|
01416 M01S01416.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01417 M01S01417.acccat +++|*CALL COMBFAS
01418 M01S01418.acccat +++|*CALL COMBCMD
01419 M01S01419.acccat +++|*CALL COMBCMS
01420 M01S01420.acccat +++|*CALL COMBFET
01421 M01S01421.acccat +++|*CALL COMBMCT
01422 M01S01422.acccat +++|*CALL COMBPFS
01423 M01S01423.acccat +++|*CALL COMXMSC
01424 M01S01424.acccat +++|*CALL COMSPFM
01425 M01S01425.acccat +++|
01426 M01S01426.acccat +++| ITEM I I; # LOOP COUNTER #
01427 M01S01427.acccat +++| ITEM STAT I; # DEFINE STATUS #
01428 M01S01428.acccat +++|CONTROL EJECT;
01429 M01S01429.acccat +++|
01430 M01S01430.acccat +++|#
01431 M01S01431.acccat +++|* DEFINE CATALOG FILE.
01432 M01S01432.acccat +++|#
01433 M01S01433.acccat +++|
01434 M01S01434.acccat +++| ERRSTAT = CMASTAT"NOERR";
01435 M01S01435.acccat +++| PFD("DEFINE",FLNM,0,"BR","Y","SR","MR","RC",PFSTAT,"UP",0,0);
01436 M01S01436.acccat +++| IF PFSTAT NQ 0
01437 M01S01437.acccat +++| THEN
01438 M01S01438.acccat +++| BEGIN # DEFINE ERROR #
01439 M01S01439.acccat +++| IF PFSTAT EQ FAP
01440 M01S01440.acccat +++| THEN # IF FILE ALREADY EXISTS #
01441 M01S01441.acccat +++| BEGIN
01442 M01S01442.acccat +++| ERRSTAT = CMASTAT"INTLZD";
01443 M01S01443.acccat +++| END
01444 M01S01444.acccat +++|
01445 M01S01445.acccat +++| ELSE
01446 M01S01446.acccat +++| BEGIN
01447 M01S01447.acccat +++| ERRSTAT = CMASTAT"DEFERR";
01448 M01S01448.acccat +++| END
01449 M01S01449.acccat +++|
01450 M01S01450.acccat +++| RETURN; # RETURN ERROR STATUS #
01451 M01S01451.acccat +++| END # DEFINE ERROR #
01452 M01S01452.acccat +++|
01453 M01S01453.acccat +++|#
01454 M01S01454.acccat +++|* CREATE SKELETON CATALOG.
01455 M01S01455.acccat +++|#
01456 M01S01456.acccat +++|
01457 M01S01457.acccat +++| FASTFOR I = 1 STEP 1 UNTIL WBUFL
01458 M01S01458.acccat +++| DO # ZERO FILL WORKING BUFFER #
01459 M01S01459.acccat +++| BEGIN
01460 M01S01460.acccat +++| WBUF$W[I] = 0;
01461 M01S01461.acccat +++| END
01462 M01S01462.acccat +++|
01463 M01S01463.acccat +++| P<PREAMBLE> = WBUFADR;
01464 M01S01464.acccat +++| PRM$FAM[0] = FAMNM;
01465 M01S01465.acccat +++| PRM$SUBF[0] = SUBF;
01466 M01S01466.acccat +++|#
01467 M01S01467.acccat +++|* THE PRM$ID IS SET TO 1 FOR THE M860 SFMCAT SO THAT IF
01468 M01S01468.acccat +++|* MSS AMD M860 ARE EVER RUN IN PARALLEL PFDUMP CAN DISTINGUISH
01469 M01S01469.acccat +++|* BETWEEN THE TWO.
01470 M01S01470.acccat +++|#
01471 M01S01471.acccat +++| PRM$ID[0] = 1;
01472 M01S01472.acccat +++| ZSETFET(TFETADR,FLNM,TBUFADR,TBUFL,RFETL); # SET UP FET #
01473 M01S01473.acccat +++| FET$EP[0] = TRUE;
01474 M01S01474.acccat +++| WRITEW(FETSET[0],PREAMBLE,WBUFL,STAT);
01475 M01S01475.acccat +++| WRITEF(FETSET[0],RCL);
01476 M01S01476.acccat +++| IF FET$AT[0] NQ 0
01477 M01S01477.acccat +++| THEN
01478 M01S01478.acccat +++| BEGIN
01479 M01S01479.acccat +++| ERRSTAT = CMASTAT"CIOERR";
01480 M01S01480.acccat +++| END
01481 M01S01481.acccat +++|
01482 M01S01482.acccat +++| RETERN(FETSET[0],RCL);
01483 M01S01483.acccat +++| RETURN;
01484 M01S01484.acccat +++| END # CINIT #
01485 M01S01485.acccat +++|
01486 M01S01486.acccat +++| TERM
01487 M01S01487.acccat +++|PROC CNAME(FLNM);
01488 M01S01488.acccat +++|# TITLE CNAME - GET LFN FOR CATALOG. #
01489 M01S01489.acccat +++| BEGIN # CNAME #
01490 M01S01490.acccat +++|
01491 M01S01491.acccat +++|#
01492 M01S01492.acccat +++|** CNAME - GET LFN FOR CATALOG.
01493 M01S01493.acccat +++|*
01494 M01S01494.acccat +++|* *CNAME* SUPPLIES A 7 CHARACTER NAME TO BE USED AS THE LFN ON AN
01495 M01S01495.acccat +++|* ATTACH OF A CATALOG FILE.
01496 M01S01496.acccat +++|*
01497 M01S01497.acccat +++|* CNAME - IS CALLED BY COPEN.
01498 M01S01498.acccat +++|* PROC CNAME(FLNM)
01499 M01S01499.acccat +++|*
01500 M01S01500.acccat +++|* EXIT (FLNM) - A SEVEN CHARACTER FILE NAME.
01501 M01S01501.acccat +++|*
01502 M01S01502.acccat +++|* NOTES *INT$NUM* IS INITIALIZED TO 1000000D SO THAT
01503 M01S01503.acccat +++|* WHEN IT IS CONVERTED TO DISPLAY CODE, THE RESULT
01504 M01S01504.acccat +++|* WILL CONTAIN DISPLAY CODED NUMBERS IN THE BOTTOM
01505 M01S01505.acccat +++|* 6 CHARACTERS RATHER THAN BLANKS.
01506 M01S01506.acccat +++|#
01507 M01S01507.acccat +++|
01508 M01S01508.acccat +++| ITEM FLNM C(7); # FILE NAME #
01509 M01S01509.acccat +++|
01510 M01S01510.acccat +++|#
01511 M01S01511.acccat +++|**** PROC CNAME - XREF LIST BEGIN.
01512 M01S01512.acccat +++|#
01513 M01S01513.acccat +++|
01514 M01S01514.acccat +++| XREF
01515 M01S01515.acccat +++| BEGIN
01516 M01S01516.acccat +++| FUNC XCDD C(10); # INTEGER TO DISPLAY CODE
01517 M01S01517.acccat +++| CONVERSION #
01518 M01S01518.acccat +++| END
01519 M01S01519.acccat +++|
01520 M01S01520.acccat +++|#
01521 M01S01521.acccat +++|**** PROC CNAME - XREF LIST END.
01522 M01S01522.acccat +++|#
01523 M01S01523.acccat +++|
01524 M01S01524.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01525 M01S01525.acccat +++|*CALL COMBFAS
01526 M01S01526.acccat +++|*CALL COMBCMD
01527 M01S01527.acccat +++|
01528 M01S01528.acccat +++| ITEM DC$NUM C(10); # DISPLAY CODE NUMBER #
01529 M01S01529.acccat +++| ITEM INT$NUM I = 1000000; # INTEGER NUMBER #
01530 M01S01530.acccat +++| ITEM NEXTNM C(7) = "C000000"; # NEXT FILE NAME #
01531 M01S01531.acccat +++|CONTROL EJECT;
01532 M01S01532.acccat +++|
01533 M01S01533.acccat +++| FLNM = NEXTNM; # SET FILE NAME #
01534 M01S01534.acccat +++|
01535 M01S01535.acccat +++|#
01536 M01S01536.acccat +++|* INCREMENT FILE NAME.
01537 M01S01537.acccat +++|#
01538 M01S01538.acccat +++|
01539 M01S01539.acccat +++| INT$NUM = INT$NUM + 1;
01540 M01S01540.acccat +++| DC$NUM = XCDD(INT$NUM);
01541 M01S01541.acccat +++| C<1,6>NEXTNM = C<4,6>DC$NUM;
01542 M01S01542.acccat +++| B<0,60>DC$NUM = 0; # CLEAR DISPLAY CODE VALUE #
01543 M01S01543.acccat +++| RETURN;
01544 M01S01544.acccat +++| END # CNAME #
01545 M01S01545.acccat +++|
01546 M01S01546.acccat +++| TERM
01547 M01S01547.acccat +++|PROC COPEN((FAMNM),(SUBF),(FLNM),(ATTM),(ACCM),ERRSTAT);
01548 M01S01548.acccat +++|# TITLE COPEN - OPEN CATALOG. #
01549 M01S01549.acccat +++| BEGIN # COPEN #
01550 M01S01550.acccat +++|
01551 M01S01551.acccat +++|#
01552 M01S01552.acccat +++|** COPEN - OPEN CATALOG.
01553 M01S01553.acccat +++|*
01554 M01S01554.acccat +++|* *COPEN* PREPARES THE GIVEN CATALOG FOR SUBSEQUENT REFERENCE
01555 M01S01555.acccat +++|* BY THE CALLER.
01556 M01S01556.acccat +++|*
01557 M01S01557.acccat +++|* COPEN - IS CALLED BY DBMAIN,LBRMMSC,OPENCAT,USRPDE,USRPBAS,
01558 M01S01558.acccat +++|* VLSUBFM.
01559 M01S01559.acccat +++|*
01560 M01S01560.acccat +++|* PROC COPEN((FAMNM),(SUBF),(FLNM),(ATTM),(ACCM),ERRSTAT)
01561 M01S01561.acccat +++|*
01562 M01S01562.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
01563 M01S01563.acccat +++|* 7 CHARACTER MAXIMUM.
01564 M01S01564.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01565 M01S01565.acccat +++|* (FLNM) - CATALOG FILE NAME, LEFT JUSTIFIED, ZERO
01566 M01S01566.acccat +++|* FILLED, 7 CHARACTER MAXIMUM.
01567 M01S01567.acccat +++|* (ATTM) - FILE ATTACH MODE IN DISPLAY CODE.
01568 M01S01568.acccat +++|* = *M*, MODIFY MODE.
01569 M01S01569.acccat +++|* = *RM*, READ/ALLOW MODIFY MODE.
01570 M01S01570.acccat +++|* (ACCM) - FILE ACCESS MODE.
01571 M01S01571.acccat +++|* = FALSE, RANDOM ACCESS.
01572 M01S01572.acccat +++|* = TRUE, SEQUENTIAL ACCESS.
01573 M01S01573.acccat +++|*
01574 M01S01574.acccat +++|* CALLER MUST ISSUE *SETPFP* TO APPROPRIATE FAMILY AND
01575 M01S01575.acccat +++|* USER INDEX, IF THE CATALOG FILE IS NOT LOCAL.
01576 M01S01576.acccat +++|*
01577 M01S01577.acccat +++|* EXIT (ERRSTAT) - ERROR STATUS.
01578 M01S01578.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01579 M01S01579.acccat +++|* = NO ERRORS.
01580 M01S01580.acccat +++|* = CATALOG FILE INTERLOCKED.
01581 M01S01581.acccat +++|* = CATALOG ALREADY OPEN.
01582 M01S01582.acccat +++|* = *CIO* ERROR.
01583 M01S01583.acccat +++|* = CATALOG ATTACH ERROR.
01584 M01S01584.acccat +++|* = OPEN CATALOG TABLE FULL.
01585 M01S01585.acccat +++|*
01586 M01S01586.acccat +++|* NOTES THE PFN OF AN MSF CATALOG IS *SFMCATX*, WHERE *X* IS
01587 M01S01587.acccat +++|* THE SUBFAMILY DESIGNATOR.
01588 M01S01588.acccat +++|* *COPEN* ATTACHES THE CATALOG FILE *SFMCATX*, CREATES
01589 M01S01589.acccat +++|* AN ENTRY IN THE *OCT* AND IF THE CATALOG IS NOT
01590 M01S01590.acccat +++|* INTERLOCKED, THE FIRST WORD OF THE HEADER AND OF EACH
01591 M01S01591.acccat +++|* SUBCATALOG ENTRY IN THE PREAMBLE IS READ INTO A
01592 M01S01592.acccat +++|* TABLE. IF THE CALLER HAS ALREADY ATTACHED THE
01593 M01S01593.acccat +++|* CATALOG FILE, (FLNM) MUST BE THE LFN OF THE FILE
01594 M01S01594.acccat +++|* INSTEAD OF THE PFN, SO THAT THE ATTACH WILL BE
01595 M01S01595.acccat +++|* BYPASSED.
01596 M01S01596.acccat +++|#
01597 M01S01597.acccat +++|
01598 M01S01598.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01599 M01S01599.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01600 M01S01600.acccat +++| ITEM FLNM C(7); # CATALOG FILE NAME #
01601 M01S01601.acccat +++| ITEM ATTM C(2); # FILE ATTACH MODE #
01602 M01S01602.acccat +++| ITEM ACCM B; # FILE ACCESS MODE #
01603 M01S01603.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01604 M01S01604.acccat +++|
01605 M01S01605.acccat +++|#
01606 M01S01606.acccat +++|**** PROC COPEN - XREF LIST BEGIN.
01607 M01S01607.acccat +++|#
01608 M01S01608.acccat +++|
01609 M01S01609.acccat +++| XREF
01610 M01S01610.acccat +++| BEGIN
01611 M01S01611.acccat +++| PROC CNAME; # GET CATALOG LFN #
01612 M01S01612.acccat +++| PROC CRDPRM; # READ CATALOG PREAMBLE #
01613 M01S01613.acccat +++| PROC PFD; # PERMANENT FILE REQUEST DELAYS #
01614 M01S01614.acccat +++| END
01615 M01S01615.acccat +++|
01616 M01S01616.acccat +++|#
01617 M01S01617.acccat +++|**** PROC COPEN - XREF LIST END.
01618 M01S01618.acccat +++|#
01619 M01S01619.acccat +++|
01620 M01S01620.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01621 M01S01621.acccat +++|*CALL COMBFAS
01622 M01S01622.acccat +++|*CALL COMBCMD
01623 M01S01623.acccat +++|*CALL COMBCMS
01624 M01S01624.acccat +++|*CALL COMBMCT
01625 M01S01625.acccat +++|*CALL COMBPFS
01626 M01S01626.acccat +++|*CALL COMXCTF
01627 M01S01627.acccat +++|*CALL COMXMSC
01628 M01S01628.acccat +++|*CALL COMSPFM
01629 M01S01629.acccat +++|
01630 M01S01630.acccat +++| ITEM I I; # LOOP COUNTER #
01631 M01S01631.acccat +++| ITEM LFN C(7); # LOCAL FILE NAME #
01632 M01S01632.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
01633 M01S01633.acccat +++|CONTROL EJECT;
01634 M01S01634.acccat +++|
01635 M01S01635.acccat +++| ERRSTAT = CMASTAT"NOERR";
01636 M01S01636.acccat +++| IF C<0,6>FLNM EQ SFMCAT
01637 M01S01637.acccat +++| THEN # IF FILE NOT ALREADY ATTACHED #
01638 M01S01638.acccat +++| BEGIN
01639 M01S01639.acccat +++|
01640 M01S01640.acccat +++|#
01641 M01S01641.acccat +++|* ATTACH CATALOG FILE.
01642 M01S01642.acccat +++|#
01643 M01S01643.acccat +++|
01644 M01S01644.acccat +++| CNAME(LFN);
01645 M01S01645.acccat +++| PFD("ATTACH",LFN,FLNM,"M",ATTM,"RC",PFSTAT,"NA",0,"UP",0,0);
01646 M01S01646.acccat +++| IF PFSTAT NQ 0 AND PFSTAT NQ FBS
01647 M01S01647.acccat +++| THEN # IF ATTACH ERROR #
01648 M01S01648.acccat +++| BEGIN
01649 M01S01649.acccat +++| ERRSTAT = CMASTAT"ATTERR";
01650 M01S01650.acccat +++| RETURN; # RETURN ERROR STATUS #
01651 M01S01651.acccat +++| END
01652 M01S01652.acccat +++|
01653 M01S01653.acccat +++| END
01654 M01S01654.acccat +++|
01655 M01S01655.acccat +++| ELSE
01656 M01S01656.acccat +++| BEGIN
01657 M01S01657.acccat +++| LFN = FLNM;
01658 M01S01658.acccat +++| END
01659 M01S01659.acccat +++|
01660 M01S01660.acccat +++|#
01661 M01S01661.acccat +++|* CREATE AN OPEN CATALOG TABLE ENTRY.
01662 M01S01662.acccat +++|#
01663 M01S01663.acccat +++|
01664 M01S01664.acccat +++| ORD = 0;
01665 M01S01665.acccat +++| FASTFOR I = 1 STEP 1 WHILE I LQ OCTLEN AND ORD EQ 0
01666 M01S01666.acccat +++| DO
01667 M01S01667.acccat +++| BEGIN # SEARCH *OCT* #
01668 M01S01668.acccat +++| IF OCT$SUBF[I] EQ SUBF ##
01669 M01S01669.acccat +++| AND OCT$FAM[I] EQ FAMNM
01670 M01S01670.acccat +++| THEN # IF CATALOG ALREADY OPEN #
01671 M01S01671.acccat +++| BEGIN
01672 M01S01672.acccat +++| ERRSTAT = CMASTAT"FOPEN";
01673 M01S01673.acccat +++| RETURN; # RETURN ERROR STATUS #
01674 M01S01674.acccat +++| END
01675 M01S01675.acccat +++|
01676 M01S01676.acccat +++| IF OCT$W1[I] EQ 0
01677 M01S01677.acccat +++| THEN # IF EMPTY ENTRY #
01678 M01S01678.acccat +++| BEGIN
01679 M01S01679.acccat +++| ORD = I;
01680 M01S01680.acccat +++| END
01681 M01S01681.acccat +++|
01682 M01S01682.acccat +++| END # SEARCH *OCT* #
01683 M01S01683.acccat +++|
01684 M01S01684.acccat +++| IF ORD EQ 0
01685 M01S01685.acccat +++| THEN # IF NO EMPTY ENTRIES #
01686 M01S01686.acccat +++| BEGIN
01687 M01S01687.acccat +++| ERRSTAT = CMASTAT"OCTFULL";
01688 M01S01688.acccat +++| RETURN; # RETURN ERROR STATUS #
01689 M01S01689.acccat +++| END
01690 M01S01690.acccat +++|
01691 M01S01691.acccat +++| OCT$FAM[ORD] = FAMNM;
01692 M01S01692.acccat +++| OCT$SUBF[ORD] = SUBF;
01693 M01S01693.acccat +++| OCT$LFN[ORD] = LFN;
01694 M01S01694.acccat +++| OCT$ATTM[ORD] = ATTM;
01695 M01S01695.acccat +++| OCT$BUFL[ORD] = SEQBL;
01696 M01S01696.acccat +++|
01697 M01S01697.acccat +++|#
01698 M01S01698.acccat +++|* CHECK FOR CATALOG INTERLOCK.
01699 M01S01699.acccat +++|#
01700 M01S01700.acccat +++|
01701 M01S01701.acccat +++| IF PFSTAT EQ FBS
01702 M01S01702.acccat +++| THEN # IF CATALOG INTERLOCKED #
01703 M01S01703.acccat +++| BEGIN
01704 M01S01704.acccat +++| OCT$INTLK[ORD] = TRUE; # SET INTERLOCK FLAGS #
01705 M01S01705.acccat +++| GLBINTLK = TRUE;
01706 M01S01706.acccat +++| ERRSTAT = CMASTAT"INTLK";
01707 M01S01707.acccat +++| RETURN; # RETURN WITH INTERLOCK STATUS #
01708 M01S01708.acccat +++| END
01709 M01S01709.acccat +++|
01710 M01S01710.acccat +++| CRDPRM(ORD,ERRSTAT); # READ AND UPDATE PREAMBLE #
01711 M01S01711.acccat +++| RETURN;
01712 M01S01712.acccat +++| END # COPEN #
01713 M01S01713.acccat +++|
01714 M01S01714.acccat +++| TERM
01715 M01S01715.acccat +++|PROC CPIOERR((FAMNM),(SUBF),(QRADDR),ERRSTAT,FET);
01716 M01S01716.acccat +++|# TITLE CPIOERR - PROCESS I/O ERROR ON MSF CATALOG. #
01717 M01S01717.acccat +++|
01718 M01S01718.acccat +++| BEGIN # CPIOERR #
01719 M01S01719.acccat +++|
01720 M01S01720.acccat +++|#
01721 M01S01721.acccat +++|** CPIOERR - PROCESS I/O ERROR ON MSF CATALOG.
01722 M01S01722.acccat +++|*
01723 M01S01723.acccat +++|* *CPIOERR* CLOSES THE MSF CATALOG WITH THE I/O ERROR AND SETS
01724 M01S01724.acccat +++|* AN I/O ERROR STATUS. IF CALLED BY THE MSS EXECUTIVE IT ALSO
01725 M01S01725.acccat +++|* DUMPS THE FET FOR THE CATALOG TO *LOGFILE* AND ISSUES
01726 M01S01726.acccat +++|* AN ERROR MESSAGE TO THE K-DISPLAY AND TO EXEC-S DAYFILE.
01727 M01S01727.acccat +++|*
01728 M01S01728.acccat +++|* CPIOERR - IS CALLED BY BFLUSH,CADDSC,CEXTSC,CGETPD,CPUTPD,
01729 M01S01729.acccat +++|* CRDAST,CWTAST.
01730 M01S01730.acccat +++|*
01731 M01S01731.acccat +++|* PROC CPIOERR((FAMNM),(SUBF),(QRADDR),ERRSTAT,FET)
01732 M01S01732.acccat +++|*
01733 M01S01733.acccat +++|* ENTRY (FAMNM) - FAMILY NAME.
01734 M01S01734.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01735 M01S01735.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
01736 M01S01736.acccat +++|* FET - AN ARRAY CONTAINING THE FET FOR THE MSF CATALOG.
01737 M01S01737.acccat +++|*
01738 M01S01738.acccat +++|* EXIT (ERRSTAT) - ERROR STATUS (VALUES DEFINED IN
01739 M01S01739.acccat +++|* *COMBCMS*).
01740 M01S01740.acccat +++|* = *CIO* ERROR.
01741 M01S01741.acccat +++|*
01742 M01S01742.acccat +++|* MESSAGES * I/O ERROR ON SFMCATN, CATALOG CLOSED.
01743 M01S01743.acccat +++|* RESPOND GO TO ACKNOWLEDGE.*
01744 M01S01744.acccat +++|#
01745 M01S01745.acccat +++|
01746 M01S01746.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01747 M01S01747.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01748 M01S01748.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
01749 M01S01749.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01750 M01S01750.acccat +++|
01751 M01S01751.acccat +++|#
01752 M01S01752.acccat +++|**** PROC CPIOERR - XREF LIST BEGIN.
01753 M01S01753.acccat +++|#
01754 M01S01754.acccat +++|
01755 M01S01755.acccat +++| XREF
01756 M01S01756.acccat +++| BEGIN
01757 M01S01757.acccat +++| PROC CCLOSE; # CLOSE MSF CATALOG #
01758 M01S01758.acccat +++| PROC KREQ; # K-DISPLAY REQUEST #
01759 M01S01759.acccat +++| PROC RECALL; # RECALL #
01760 M01S01760.acccat +++| END
01761 M01S01761.acccat +++|
01762 M01S01762.acccat +++|#
01763 M01S01763.acccat +++|**** PROC CPIOERR - XREF LIST END.
01764 M01S01764.acccat +++|#
01765 M01S01765.acccat +++|
01766 M01S01766.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01767 M01S01767.acccat +++|*CALL COMBFAS
01768 M01S01768.acccat +++|*CALL COMBCMD
01769 M01S01769.acccat +++|*CALL COMBCMS
01770 M01S01770.acccat +++|*CALL COMBKDD
01771 M01S01771.acccat +++|
01772 M01S01772.acccat +++| ARRAY FET [0:0] P(RFETL); ; # MSF CATALOG FET #
01773 M01S01773.acccat +++| CONTROL EJECT;
01774 M01S01774.acccat +++|
01775 M01S01775.acccat +++| IF EXEC
01776 M01S01776.acccat +++| THEN
01777 M01S01777.acccat +++| BEGIN # MSS EXECUTIVE PROCESSING #
01778 M01S01778.acccat +++|
01779 M01S01779.acccat +++|#
01780 M01S01780.acccat +++|* ISSUE ERROR MESSAGE TO EXEC-S DAYFILE AND TO THE K-DISPLAY.
01781 M01S01781.acccat +++|#
01782 M01S01782.acccat +++|
01783 M01S01783.acccat +++| P<KWORD> = LOC(KDISBLK[0]);
01784 M01S01784.acccat +++| IF KW$WORD[0] NQ 0 AND NOT KW$COMP[0]
01785 M01S01785.acccat +++| THEN # PREVIOUS MESSAGE NOT ISSUED #
01786 M01S01786.acccat +++| BEGIN # K-DISPLAY WORD BUSY #
01787 M01S01787.acccat +++| REPEAT WHILE NOT KW$COMP[0]
01788 M01S01788.acccat +++| DO # WAIT FOR MESSAGE TO BE ISSUED #
01789 M01S01789.acccat +++| BEGIN
01790 M01S01790.acccat +++| RECALL(0);
01791 M01S01791.acccat +++| END
01792 M01S01792.acccat +++|
01793 M01S01793.acccat +++| END # K-DISPLAY WORD BUSY #
01794 M01S01794.acccat +++|
01795 M01S01795.acccat +++| KW$WORD[0] = 0;
01796 M01S01796.acccat +++| KW$IC[0] = TRUE;
01797 M01S01797.acccat +++| KW$RPGO[0] = TRUE;
01798 M01S01798.acccat +++| KW$DF[0] = TRUE;
01799 M01S01799.acccat +++| KW$LINE1[0] = KM"KM13";
01800 M01S01800.acccat +++| KW$LINE2[0] = KM"KM21";
01801 M01S01801.acccat +++| KP$SF = SUBF;
01802 M01S01802.acccat +++| KREQ(P<KWORD>,KLINK);
01803 M01S01803.acccat +++| END # MSS EXECUTIVE PROCESSING #
01804 M01S01804.acccat +++|
01805 M01S01805.acccat +++| CCLOSE(FAMNM,SUBF,QRADDR,ERRSTAT); # CLOSE MSF CATALOG #
01806 M01S01806.acccat +++| ERRSTAT = CMASTAT"CIOERR";
01807 M01S01807.acccat +++| RETURN;
01808 M01S01808.acccat +++| END # CPIOERR #
01809 M01S01809.acccat +++|
01810 M01S01810.acccat +++| TERM
01811 M01S01811.acccat +++|PROC CPUTFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR),(QRADDR),
01812 M01S01812.acccat +++| ERRSTAT);
01813 M01S01813.acccat +++|# TITLE CPUTFCT - PUT AN *FCT* ENTRY. #
01814 M01S01814.acccat +++| BEGIN # CPUTFCT #
01815 M01S01815.acccat +++|
01816 M01S01816.acccat +++|#
01817 M01S01817.acccat +++|** CPUTFCT - PUT AN *FCT* ENTRY.
01818 M01S01818.acccat +++|*
01819 M01S01819.acccat +++|* *CPUTFCT* TRANSFERS THE SPECIFIED FILE AND CARTRIDGE TABLE ENTRY
01820 M01S01820.acccat +++|* FROM THE CALLERS BUFFER TO THE I/O BUFFER. THE CATALOG MUST
01821 M01S01821.acccat +++|* BE OPEN IN MODIFY MODE.
01822 M01S01822.acccat +++|*
01823 M01S01823.acccat +++|* CPUTFCT - IS CALLED BY RLS$FCT.
01824 M01S01824.acccat +++|* PROC CPUTFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR),
01825 M01S01825.acccat +++|* (QRADDR),ERRSTAT)
01826 M01S01826.acccat +++|*
01827 M01S01827.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
01828 M01S01828.acccat +++|* 7 CHARACTER MAXIMUM.
01829 M01S01829.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01830 M01S01830.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
01831 M01S01831.acccat +++|* (FCTORD) - ORDINAL OF ENTRY IN *FCT*.
01832 M01S01832.acccat +++|* (BADDR) - ADDRESS OF BUFFER TO RECEIVE *FCT* ENTRY.
01833 M01S01833.acccat +++|* (QRADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO.
01834 M01S01834.acccat +++|*
01835 M01S01835.acccat +++|* EXIT THE REQUESTED *FCT* ENTRY IS TRANSFERRED TO THE *FCT*
01836 M01S01836.acccat +++|* I/O BUFFER FROM THE ADDRESS SPECIFIED BY (BADDR).
01837 M01S01837.acccat +++|* (ERRSTAT) - ERROR STATUS.
01838 M01S01838.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01839 M01S01839.acccat +++|* = NO ERROR.
01840 M01S01840.acccat +++|* = CATALOG FILE INTERLOCKED.
01841 M01S01841.acccat +++|* = CATALOG NOT OPEN.
01842 M01S01842.acccat +++|* = CATALOG NOT OPEN IN MODIFY MODE.
01843 M01S01843.acccat +++|* = NO SUCH SUBCATALOG.
01844 M01S01844.acccat +++|* = *CIO* ERROR.
01845 M01S01845.acccat +++|* = *FCT* ORDINAL OUT OF RANGE.
01846 M01S01846.acccat +++|*
01847 M01S01847.acccat +++|* NOTES THE *FCT* ENTRY IS TRANSFERRED FROM THE CALLERS BUFFER
01848 M01S01848.acccat +++|* BACK TO THE I/O BUFFER, BUT IS NOT WRITTEN TO THE
01849 M01S01849.acccat +++|* CATALOG FILE UNTIL SOME SUBSEQUENT REQUEST CAUSES
01850 M01S01850.acccat +++|* THE I/O BUFFER TO BE FLUSHED.
01851 M01S01851.acccat +++|#
01852 M01S01852.acccat +++|
01853 M01S01853.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01854 M01S01854.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01855 M01S01855.acccat +++| ITEM SMID U; # SM IDENTIFIER #
01856 M01S01856.acccat +++| ITEM FCTORD I; # *FCT* ORDINAL #
01857 M01S01857.acccat +++| ITEM BADDR U; # ADDRESS OF *FCT* ENTRY BUFFER #
01858 M01S01858.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
01859 M01S01859.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01860 M01S01860.acccat +++|
01861 M01S01861.acccat +++|#
01862 M01S01862.acccat +++|**** PROC CPUTFCT - XREF LIST BEGIN.
01863 M01S01863.acccat +++|#
01864 M01S01864.acccat +++|
01865 M01S01865.acccat +++| XREF
01866 M01S01866.acccat +++| BEGIN
01867 M01S01867.acccat +++| PROC CBUFMAN; # MANAGE CATALOG *FCT* BUFFER #
01868 M01S01868.acccat +++| END
01869 M01S01869.acccat +++|
01870 M01S01870.acccat +++|#
01871 M01S01871.acccat +++|**** PROC CPUTFCT - XREF LIST END.
01872 M01S01872.acccat +++|#
01873 M01S01873.acccat +++|
01874 M01S01874.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01875 M01S01875.acccat +++|*CALL COMBFAS
01876 M01S01876.acccat +++|*CALL COMBCMD
01877 M01S01877.acccat +++|*CALL COMBCMS
01878 M01S01878.acccat +++|*CALL COMBMCT
01879 M01S01879.acccat +++|
01880 M01S01880.acccat +++| ITEM I I; # LOOP COUNTER #
01881 M01S01881.acccat +++| ITEM MODF B = TRUE; # MODIFY MODE FLAG #
01882 M01S01882.acccat +++| ITEM OFFSET I; # WORD OFFSET WITHIN BUFFER #
01883 M01S01883.acccat +++|
01884 M01S01884.acccat +++| BASED
01885 M01S01885.acccat +++| ARRAY ENTBUF [1:FCTENTL] P(1); # *FCT* ENTRY BUFFER #
01886 M01S01886.acccat +++| BEGIN
01887 M01S01887.acccat +++| ITEM ENT$WRD I(00,00,60); # ENTRY WORD #
01888 M01S01888.acccat +++| END
01889 M01S01889.acccat +++|
01890 M01S01890.acccat +++|CONTROL EJECT;
01891 M01S01891.acccat +++|
01892 M01S01892.acccat +++|#
01893 M01S01893.acccat +++|* ENSURE THAT REQUESTED *FCT* ENTRY IS WITHIN I/O BUFFER.
01894 M01S01894.acccat +++|#
01895 M01S01895.acccat +++|
01896 M01S01896.acccat +++| CBUFMAN(FAMNM,SUBF,SMID,FCTORD,MODF,QRADDR,ERRSTAT);
01897 M01S01897.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
01898 M01S01898.acccat +++| THEN
01899 M01S01899.acccat +++| BEGIN
01900 M01S01900.acccat +++| RETURN; # RETURN ERROR STATUS #
01901 M01S01901.acccat +++| END
01902 M01S01902.acccat +++|
01903 M01S01903.acccat +++|#
01904 M01S01904.acccat +++|* TRANSFER ENTRY TO *FCT* I/O BUFFER.
01905 M01S01905.acccat +++|#
01906 M01S01906.acccat +++|
01907 M01S01907.acccat +++| P<FCTBUF> = FCTBADR;
01908 M01S01908.acccat +++| P<ENTBUF> = BADDR;
01909 M01S01909.acccat +++| SLOWFOR I = 1 STEP 1 UNTIL FCTENTL
01910 M01S01910.acccat +++| DO
01911 M01S01911.acccat +++| BEGIN
01912 M01S01912.acccat +++| FCTB$WRD[I] = ENT$WRD[I];
01913 M01S01913.acccat +++| END
01914 M01S01914.acccat +++|
01915 M01S01915.acccat +++| FB$BMF[0] = TRUE; # SET BUFFER MODIFIED FLAG #
01916 M01S01916.acccat +++| RETURN;
01917 M01S01917.acccat +++| END # CPUTFCT #
01918 M01S01918.acccat +++|
01919 M01S01919.acccat +++| TERM
01920 M01S01920.acccat +++|PROC CPUTPD((FAMNM),(SUBF),(SMID ),(QRADDR),ERRSTAT);
01921 M01S01921.acccat +++|# TITLE CPUTPD - PUT PURGE DATE. #
01922 M01S01922.acccat +++| BEGIN # CPUTPD #
01923 M01S01923.acccat +++|
01924 M01S01924.acccat +++|#
01925 M01S01925.acccat +++|** CPUTPD - PUT PURGE DATE.
01926 M01S01926.acccat +++|*
01927 M01S01927.acccat +++|* *CPUTPD* PUTS THE DATE AND TIME OF THE LAST PURGE OF ORPHAN
01928 M01S01928.acccat +++|* FILES (AN MSF FILE WITH NO REFERENCE TO IT IN THE PFC) INTO THE
01929 M01S01929.acccat +++|* APPROPRIATE CATALOG PREAMBLE ENTRY. THE CURRENT PACKED DATE AND
01930 M01S01930.acccat +++|* TIME IS USED. THE CATALOG MUST BE OPEN IN MODIFY MODE.
01931 M01S01931.acccat +++|*
01932 M01S01932.acccat +++|* CPUTPD - IS CALLED BY PURGCHN,UPDCAT.
01933 M01S01933.acccat +++|*
01934 M01S01934.acccat +++|* PROC CPUTPD((FAMNM),(SUBF),(SMID ),(QRADDR),ERRSTAT)
01935 M01S01935.acccat +++|*
01936 M01S01936.acccat +++|* ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED,
01937 M01S01937.acccat +++|* 7 CHARACTER MAXIMUM.
01938 M01S01938.acccat +++|* (SUBF) - SUBFAMILY DESIGNATOR.
01939 M01S01939.acccat +++|* (SMID ) - NUMERIC SM IDENTIFIER.
01940 M01S01940.acccat +++|* (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO.
01941 M01S01941.acccat +++|*
01942 M01S01942.acccat +++|* EXIT THE CURRENT PACKED DATE AND TIME IS WRITTEN IN THE
01943 M01S01943.acccat +++|* SPECIFIED SUBCATALOG ENTRY IN THE PREAMBLE.
01944 M01S01944.acccat +++|* (ERRSTAT) - ERROR STATUS.
01945 M01S01945.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
01946 M01S01946.acccat +++|* = NO ERRORS.
01947 M01S01947.acccat +++|* = CATALOG FILE INTERLOCKED.
01948 M01S01948.acccat +++|* = CATALOG NOT OPEN.
01949 M01S01949.acccat +++|* = CATALOG NOT OPEN IN MODIFY MODE.
01950 M01S01950.acccat +++|* = NO SUCH SUBCATALOG EXISTS.
01951 M01S01951.acccat +++|* = *CIO* ERROR.
01952 M01S01952.acccat +++|*
01953 M01S01953.acccat +++|* NOTE THE PREAMBLE TABLE DOES NOT CONTAIN THE LAST PURGE
01954 M01S01954.acccat +++|* DATE AND TIME (ONLY THE FIRST WORD OF EACH SUBCATALOG
01955 M01S01955.acccat +++|* ENTRY IS IN THE TABLE), SO THE PREAMBLE MUST BE READ
01956 M01S01956.acccat +++|* FROM AND WRITTEN TO THE CATALOG.
01957 M01S01957.acccat +++|#
01958 M01S01958.acccat +++|
01959 M01S01959.acccat +++| ITEM FAMNM C(7); # FAMILY NAME #
01960 M01S01960.acccat +++| ITEM SUBF U; # SUBFAMILY DESIGNATOR #
01961 M01S01961.acccat +++| ITEM SMID U; # SM IDENTIFIER #
01962 M01S01962.acccat +++| ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS #
01963 M01S01963.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
01964 M01S01964.acccat +++|
01965 M01S01965.acccat +++|#
01966 M01S01966.acccat +++|**** PROC CPUTPD - XREF LIST BEGIN.
01967 M01S01967.acccat +++|#
01968 M01S01968.acccat +++|
01969 M01S01969.acccat +++| XREF
01970 M01S01970.acccat +++| BEGIN
01971 M01S01971.acccat +++| PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR #
01972 M01S01972.acccat +++| PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE #
01973 M01S01973.acccat +++| PROC PDATE; # OBTAIN PACKED DATE AND TIME #
01974 M01S01974.acccat +++| PROC RPHR; # READ PRU TO *CIO* BUFFER #
01975 M01S01975.acccat +++| PROC WPHR; # WRITE PRU FROM *CIO* BUFFER #
01976 M01S01976.acccat +++| PROC ZSETFET; # INITIALIZES A FET #
01977 M01S01977.acccat +++| END
01978 M01S01978.acccat +++|
01979 M01S01979.acccat +++|#
01980 M01S01980.acccat +++|**** PROC CPUTPD - XREF LIST END.
01981 M01S01981.acccat +++|#
01982 M01S01982.acccat +++|
01983 M01S01983.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
01984 M01S01984.acccat +++|*CALL COMBFAS
01985 M01S01985.acccat +++|*CALL COMBCMD
01986 M01S01986.acccat +++|*CALL COMBCMS
01987 M01S01987.acccat +++|*CALL COMBFET
01988 M01S01988.acccat +++|*CALL COMBMCT
01989 M01S01989.acccat +++|*CALL COMXMSC
01990 M01S01990.acccat +++|*CALL COMSPFM
01991 M01S01991.acccat +++|
01992 M01S01992.acccat +++| ITEM LASTPRG U; # LAST PURGE DATE #
01993 M01S01993.acccat +++| ITEM ORD I; # ORDINAL OF *OCT* ENTRY #
01994 M01S01994.acccat +++|CONTROL EJECT;
01995 M01S01995.acccat +++|
01996 M01S01996.acccat +++| OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL #
01997 M01S01997.acccat +++| IF ERRSTAT NQ CMASTAT"NOERR"
01998 M01S01998.acccat +++| THEN
01999 M01S01999.acccat +++| BEGIN
02000 M01S02000.acccat +++| RETURN; # RETURN ERROR STATUS #
02001 M01S02001.acccat +++| END
02002 M01S02002.acccat +++|
02003 M01S02003.acccat +++| IF OCT$ATTM[ORD] NQ "M"
02004 M01S02004.acccat +++| THEN # IF NOT OPEN IN MODIFY MODE #
02005 M01S02005.acccat +++| BEGIN
02006 M01S02006.acccat +++| ERRSTAT = CMASTAT"MODERR";
02007 M01S02007.acccat +++| RETURN; # RETURN ERROR STATUS #
02008 M01S02008.acccat +++| END
02009 M01S02009.acccat +++|
02010 M01S02010.acccat +++| P<PREAMBLE> = OCT$PRMA[ORD];
02011 M01S02011.acccat +++| IF PRM$SCW1[SMID ] EQ 0
02012 M01S02012.acccat +++| THEN # IF NO SUCH SUBCATALOG #
02013 M01S02013.acccat +++| BEGIN
02014 M01S02014.acccat +++| ERRSTAT = CMASTAT"NOSUBCAT";
02015 M01S02015.acccat +++| RETURN;
02016 M01S02016.acccat +++| END
02017 M01S02017.acccat +++|
02018 M01S02018.acccat +++|#
02019 M01S02019.acccat +++|* PUT DATE AND TIME OF LAST PURGE OF ORPHAN FILES INTO PREAMBLE.
02020 M01S02020.acccat +++|#
02021 M01S02021.acccat +++|
02022 M01S02022.acccat +++| PDATE(LASTPRG); # GET PACKED DATE AND TIME #
02023 M01S02023.acccat +++| PRM$PDATE[SMID] = LASTPRG;
02024 M01S02024.acccat +++| ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,TBUFL,RFETL);
02025 M01S02025.acccat +++| FET$EP[0] = TRUE;
02026 M01S02026.acccat +++| FET$R[0] = TRUE;
02027 M01S02027.acccat +++| FET$RR[0] = 1;
02028 M01S02028.acccat +++| RPHR(FETSET[0],RCL);
02029 M01S02029.acccat +++| IF FET$AT[0] NQ 0
02030 M01S02030.acccat +++| THEN
02031 M01S02031.acccat +++| BEGIN
02032 M01S02032.acccat +++| GOTO ERR;
02033 M01S02033.acccat +++| END
02034 M01S02034.acccat +++|
02035 M01S02035.acccat +++| P<PREAMBLE> = TBUFADR;
02036 M01S02036.acccat +++| PRM$PDATE[SMID ] = LASTPRG;
02037 M01S02037.acccat +++| FET$RR[0] = 1;
02038 M01S02038.acccat +++| FET$W[0] = TRUE;
02039 M01S02039.acccat +++| WPHR(FETSET[0],RCL);
02040 M01S02040.acccat +++| IF FET$AT[0] NQ 0
02041 M01S02041.acccat +++| THEN
02042 M01S02042.acccat +++| BEGIN
02043 M01S02043.acccat +++| GOTO ERR;
02044 M01S02044.acccat +++| END
02045 M01S02045.acccat +++|
02046 M01S02046.acccat +++| RETURN;
02047 M01S02047.acccat +++|
02048 M01S02048.acccat +++|ERR: # PROCESS *CIO* ERROR #
02049 M01S02049.acccat +++| CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[0]);
02050 M01S02050.acccat +++| RETURN;
02051 M01S02051.acccat +++| END # CPUTPD #
02052 M01S02052.acccat +++|
02053 M01S02053.acccat +++| TERM
02054 M01S02054.acccat +++|PROC CRCLMLK(ERRSTAT);
02055 M01S02055.acccat +++|# TITLE CRCLMLK - RECLAIM CATALOG INTERLOCKS. #
02056 M01S02056.acccat +++| BEGIN # CRCLMLK #
02057 M01S02057.acccat +++|
02058 M01S02058.acccat +++|#
02059 M01S02059.acccat +++|** CRCLMLK - RECLAIM CATALOG INTERLOCKS.
02060 M01S02060.acccat +++|*
02061 M01S02061.acccat +++|* *CRCLMLK* TRIES TO RECLAIM ALL MSF CATALOG INTERLOCKS. IF THE
02062 M01S02062.acccat +++|* INTERLOCK IS RECLAIMED, (THE CATALOG IS SUCCESSFULLY ATTACHED)
02063 M01S02063.acccat +++|* THE STATUS OF ALL WAITING-FOR-INTERLOCK REQUESTS ARE SET
02064 M01S02064.acccat +++|* TO READY.
02065 M01S02065.acccat +++|*
02066 M01S02066.acccat +++|* CRCLMLK - IS CALLED BY RCLMLK.
02067 M01S02067.acccat +++|*
02068 M01S02068.acccat +++|* PROC CRCLMLK(ERRSTAT)
02069 M01S02069.acccat +++|*
02070 M01S02070.acccat +++|* EXIT THE CATALOG INTERLOCK IS RECLAIMED IF THE CATALOG
02071 M01S02071.acccat +++|* WAS SUCCESSFULLY ATTACHED.
02072 M01S02072.acccat +++|* (ERRSTAT) - ERROR STATUS.
02073 M01S02073.acccat +++|* (VALUES DEFINED IN *COMBCMS*)
02074 M01S02074.acccat +++|* = NO ERRORS.
02075 M01S02075.acccat +++|* = *CIO* ERROR.
02076 M01S02076.acccat +++|* = CATALOG ATTACH ERROR.
02077 M01S02077.acccat +++|* IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN
02078 M01S02078.acccat +++|* ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED.
02079 M01S02079.acccat +++|*
02080 M01S02080.acccat +++|* NOTES IF A CATALOG OPEN REQUEST WAS PREVIOUSLY ISSUED BUT
02081 M01S02081.acccat +++|* THE CATALOG WAS INTERLOCKED AT THAT TIME, THE
02082 M01S02082.acccat +++|* REMAINDER OF THE OPEN PROCESSING WILL BE DONE IF THE
02083 M01S02083.acccat +++|* CATALOG INTERLOCK IS RECLAIMED. FOR ALL OTHER
02084 M01S02084.acccat +++|* REQUESTS, THE INTERLOCK BIT IN THE *OCT* IS MERELY
02085 M01S02085.acccat +++|* CLEARED.
02086 M01S02086.acccat +++|*
02087 M01S02087.acccat +++|* MESSAGES * PROGRAM ABNORMAL, CRCLMLK.*.
02088 M01S02088.acccat +++|* * UNABLE TO REATTACH MSF CATALOG.
02089 M01S02089.acccat +++|* SFMCATN FOR FAMILY FFFFFFF CLOSED.*
02090 M01S02090.acccat +++|#
02091 M01S02091.acccat +++|
02092 M01S02092.acccat +++| ITEM ERRSTAT I; # ERROR STATUS #
02093 M01S02093.acccat +++|
02094 M01S02094.acccat +++|#
02095 M01S02095.acccat +++|**** PROC CRCLMLK - XREF LIST BEGIN.
02096 M01S02096.acccat +++|#
02097 M01S02097.acccat +++|
02098 M01S02098.acccat +++| XREF
02099 M01S02099.acccat +++| BEGIN
02100 M01S02100.acccat +++| PROC ABORT; # ABORT #
02101 M01S02101.acccat +++| PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN #
02102 M01S02102.acccat +++| PROC BZFILL; # BLANK OR ZERO FILL WORD #
02103 M01S02103.acccat +++| PROC CRDPRM; # READ CATALOG PREAMBLE #
02104 M01S02104.acccat +++| PROC MESSAGE; # ISSUE MESSAGE #
02105 M01S02105.acccat +++| PROC PF; # *PFM* REQUEST INTERFACE #
02106 M01S02106.acccat +++| PROC RMVBLNK; # REMOVE MULTIPLE BLANKS #
02107 M01S02107.acccat +++| PROC RTIME; # GET REAL TIME CLOCK READING #
02108 M01S02108.acccat +++| PROC SETPFP; # SET PERMANENT FILE PARAMETERS #
02109 M01S02109.acccat +++| FUNC XCDD C(10); # INTEGER TO DISPLAY CODE
02110 M01S02110.acccat +++| CONVERSION #
02111 M01S02111.acccat +++| PROC ZFILL; # ZERO FILL A BUFFER #
02112 M01S02112.acccat +++| END
02113 M01S02113.acccat +++|
02114 M01S02114.acccat +++|#
02115 M01S02115.acccat +++|**** PROC CRCLMLK - XREF LIST END.
02116 M01S02116.acccat +++|#
02117 M01S02117.acccat +++|
02118 M01S02118.acccat +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS #
02119 M01S02119.acccat +++|*CALL COMBFAS
02120 M01S02120.acccat +++|*CALL COMBBZF
02121 M01S02121.acccat +++|*CALL COMBCHN
02122 M01S02122.acccat +++|*CALL COMBCMD
02123 M01S02123.acccat +++|*CALL COMBCMS
02124 M01S02124.acccat +++|*CALL COMBMCT
02125 M01S02125.acccat +++|*CALL COMBPFP
02126 M01S02126.acccat +++|*CALL COMXCTF
02127 M01S02127.acccat +++|*CALL COMXHLR
02128 M01S02128.acccat +++|*CALL COMXIPR
02129 M01S02129.acccat +++|*CALL COMXMSC
02130 M01S02130.acccat +++|*CALL COMSPFM
02131 M01S02131.acccat +++|
02132 M01S02132.acccat +++| ITEM CATPFN C(7); # MSS CATALOG PFN #
02133 M01S02133.acccat +++| ITEM DIS$SUBF C(10); # SUBFAMILY (DISPLAY CODE) #
02134 M01S02134.acccat +++| ITEM FAMILY C(7); # FAMILY NAME #
02135 M01S02135.acccat +++| ITEM I I; # LOOP COUNTER #
02136 M01S02136.acccat +++| ITEM INTLK B; # INTERLOCK STATUS #
02137 M01S02137.acccat +++| ITEM STAT I; # ATTACH STATUS #
02138 M01S02138.acccat +++| ITEM TEMP U; # TEMPORARY STORAGE #
02139 M01S02139.acccat +++|CONTROL EJECT;
02140 M01S02140.acccat +++|
02141 M01S02141.acccat +++| ERRSTAT = CMASTAT"NOERR"; # INITIALIZE VALUES #
02142 M01S02142.acccat +++| INTLK = FALSE;
02143 M01S02143.acccat +++| PFP$WRD0[0] = 0;
02144 M01S02144.acccat +++| PFP$FG1[0] = TRUE;
02145 M01S02145.acccat +++| PFP$FG4[0] = TRUE;
02146 M01S02146.acccat +++|
02147 M01S02147.acccat +++|#
02148 M01S02148.acccat +++|* SEARCH OPEN CATALOG TABLE FOR INTERLOCKED CATALOGS.
02149 M01S02149.acccat +++|#
02150 M01S02150.acccat +++|
02151 M01S02151.acccat +++| FASTFOR I = 1 STEP 1 UNTIL OCTLEN
02152 M01S02152.acccat +++| DO
02153 M01S02153.acccat +++| BEGIN # SEARCH *OCT* #
02154 M01S02154.acccat +++| IF NOT OCT$INTLK[I]
02155 M01S02155.acccat +++| THEN # IF CATALOG NOT INTERLOCKED #
02156 M01S02156.acccat +++| BEGIN
02157 M01S02157.acccat +++| TEST I; # CHECK NEXT ENTRY #
02158 M01S02158.acccat +++| END
02159 M01S02159.acccat +++|
02160 M01S02160.acccat +++| PFP$FAM[0] = OCT$FAM[I]; # SET FAMILY AND USER INDEX #
02161 M01S02161.acccat +++| PFP$UI[0] = DEF$UI + OCT$SUBF[I];
02162 M01S02162.acccat +++| SETPFP(PFP);
02163 M01S02163.acccat +++| IF PFP$STAT[0] NQ 0
02164 M01S02164.acccat +++| THEN # IF FAMILY NOT FOUND #
02165 M01S02165.acccat +++| BEGIN
02166 M01S02166.acccat +++| CMA$RTN[0] = "CRCLMLK.";
02167 M01S02167.acccat +++| MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE #
02168 M01S02168.acccat +++| ABORT;
02169 M01S02169.acccat +++| END
02170 M01S02170.acccat +++|
02171 M01S02171.acccat +++|#
02172 M01S02172.acccat +++|* ATTEMPT CATALOG FILE ATTACH.
02173 M01S02173.acccat +++|#
02174 M01S02174.acccat +++|
02175 M01S02175.acccat +++| CATPFN = SFMCAT; # BUILD CATALOG PFN #
02176 M01S02176.acccat +++| DIS$SUBF = XCDD(OCT$SUBF[I]);
02177 M01S02177.acccat +++| C<6,1>CATPFN = C<9,1>DIS$SUBF;
02178 M01S02178.acccat +++| PF("ATTACH",OCT$LFN[I],CATPFN,"M",OCT$ATTM[I],
| Line S02179 Modification History | |
|---|---|
M01 (Added by) | acccat |
M02 (Updated by) | msea016 |
Seq # *Modification Id* Act ----------------------------+ 02179 M02S02179.msea016 ---| "RC",STAT,"NA",0,"UP",0,0); 02180 M01S00001.msea016 +++| "RC",STAT,"NA",0,"UP",0,"SR","IE",0); 02181 M01S02180.acccat +++| IF STAT EQ FBS OR STAT EQ PFA OR STAT EQ INA ## 02182 M01S02181.acccat +++| OR STAT EQ FTF OR STAT EQ PEA 02183 M01S02182.acccat +++| THEN # FILE BUSY OR TEMPORARY ERROR # 02184 M01S02183.acccat +++| BEGIN
Proceed to Part 1
cdc/nos2.source/opl.opl871/deck/acccat.txt · Last modified: by 127.0.0.1