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