cdc:nos2.source:opl.opl871:deck:sxserv
Deck SXSERV
Library Member Format: MODIFY
Listing Sections
- Deck SXSERV Start
- Deck SXSERV Part 1 (Line 2276)
Source
Seq # *Modification Id* Act ----------------------------+ 00001 M00S00001.sxserv +++|PROC ACQ$FCT((FAMNAME),(SUBFAM),(SMID),(FCTORD),FCTQADDR,(REQADDR) 00002 M00S00002.sxserv +++| , RSTATUS); 00003 M00S00003.sxserv +++| 00004 M00S00004.sxserv +++|# TITLE ACQ$FCT - ACQUIRE AN *FCTQ* ENTRY. # 00005 M00S00005.sxserv +++| 00006 M00S00006.sxserv +++| BEGIN # ACQ$FCT # 00007 M00S00007.sxserv +++| 00008 M00S00008.sxserv +++|# 00009 M00S00009.sxserv +++|** ACQ$FCT - ACQUIRE AN *FCTQ* ENTRY. 00010 M00S00010.sxserv +++|* 00011 M00S00011.sxserv +++|* *ACQ$FCT* READS AN *FCT* ENTRY INTO THE *FCTQ* (IF NOT ALREADY 00012 M00S00012.sxserv +++|* THERE) AND RETURNS ITS ADDRESS TO THE CALLER. 00013 M00S00013.sxserv +++|* 00014 M00S00014.sxserv +++|* PROC ACQ$FCT((FAMNAME),(SUBFAM),(SMID),(FCTORD),FCTQADDR, 00015 M00S00015.sxserv +++|* (REQADDR),RSTATUS) 00016 M00S00016.sxserv +++|* 00017 M00S00017.sxserv +++|* ENTRY (FAMNAME) - FAMILY NAME. 00018 M00S00018.sxserv +++|* (SUBFAM) - SUBFAMILY ID. 00019 M00S00019.sxserv +++|* (SMID) - *SM* NUMBER. 00020 M00S00020.sxserv +++|* (FCTORD) - *FCT* ORDINAL. 00021 M00S00021.sxserv +++|* (REQADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. 00022 M00S00022.sxserv +++|* 00023 M00S00023.sxserv +++|* EXIT (FCTQADDR) - ADDRESS OF *FCTQ* ENTRY. 00024 M00S00024.sxserv +++|* (RSTATUS) - *CGETFCT* ERROR STATUS (DEFINED IN 00025 M00S00025.sxserv +++|* PROC *CGETFCT* IN DECK *CATACC*). 00026 M00S00026.sxserv +++|* 00027 M00S00027.sxserv +++|* NOTES IF THE CATALOG IS INTERLOCKED AND IF *REQADDR* IS 00028 M00S00028.sxserv +++|* NONZERO, *CGETFCT* WILL PUT THE *HLRQ* ENTRY ON THE 00029 M00S00029.sxserv +++|* "WAITING-FOR-CATALOG-INTERLOCK" CHAIN. 00030 M00S00030.sxserv +++|# 00031 M00S00031.sxserv +++| 00032 M00S00032.sxserv +++| ITEM FAMNAME C(7); # FAMILY NAME # 00033 M00S00033.sxserv +++| ITEM SUBFAM U; # SUBFAMILY ID # 00034 M00S00034.sxserv +++| ITEM SMID U; # *SM* NUMBER # 00035 M00S00035.sxserv +++| ITEM FCTORD U; # *FCT* ORDINAL # 00036 M00S00036.sxserv +++| ITEM FCTQADDR U; # *FCTQ* ADDRESS # 00037 M00S00037.sxserv +++| ITEM REQADDR U; # *HLRQ* REQUEST ADDRESS # 00038 M00S00038.sxserv +++| ITEM RSTATUS U; # *CGETFCT* ERROR STATUS # 00039 M00S00039.sxserv +++| 00040 M00S00040.sxserv +++|# 00041 M00S00041.sxserv +++|**** PROC ACQ$FCT - XREF LIST BEGIN. 00042 M00S00042.sxserv +++|# 00043 M00S00043.sxserv +++| 00044 M00S00044.sxserv +++| XREF 00045 M00S00045.sxserv +++| BEGIN 00046 M00S00046.sxserv +++| PROC ABORT; # ABORT # 00047 M00S00047.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO CHAIN # 00048 M00S00048.sxserv +++| PROC CGETFCT; # GET AN *FCT* ENTRY # 00049 M00S00049.sxserv +++| PROC DEL$LNK; # DELETE ENTRY FROM CHAIN # 00050 M00S00050.sxserv +++| PROC MESSAGE; # INTERFACE TO *MESSAGE* MACRO # 00051 M00S00051.sxserv +++| END 00052 M00S00052.sxserv +++| 00053 M00S00053.sxserv +++|# 00054 M00S00054.sxserv +++|**** PROC ACQ$FCT - XREF LIST END. 00055 M00S00055.sxserv +++|# 00056 M00S00056.sxserv +++| 00057 M00S00057.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00058 M00S00058.sxserv +++|*CALL,COMBFAS 00059 M00S00059.sxserv +++|*CALL,COMBCHN 00060 M00S00060.sxserv +++|*CALL,COMBCMD 00061 M00S00061.sxserv +++|*CALL,COMBMCT 00062 M00S00062.sxserv +++|*CALL,COMXFCQ 00063 M00S00063.sxserv +++|*CALL,COMXMSC 00064 M00S00064.sxserv +++| 00065 M00S00065.sxserv +++| ITEM I U; # COUNTER # 00066 M00S00066.sxserv +++| 00067 M00S00067.sxserv +++| CONTROL EJECT; 00068 M00S00068.sxserv +++| 00069 M00S00069.sxserv +++|# 00070 M00S00070.sxserv +++|* SEARCH THE *FCTQ* TO SEE IF AN ENTRY EXISTS WHICH WILL SATISFY 00071 M00S00071.sxserv +++|* THE REQUEST. IF FOUND, PASS ITS ADDRESS TO THE CALLER AND 00072 M00S00072.sxserv +++|* INCREASE THE ACTIVE USER COUNT BY 1. 00073 M00S00073.sxserv +++|# 00074 M00S00074.sxserv +++| 00075 M00S00075.sxserv +++| RSTATUS = 0; 00076 M00S00076.sxserv +++| FCTQADDR = 0; 00077 M00S00077.sxserv +++| P<FCTQ> = CHN$BOC[LCHN"FCT$ACT"]; 00078 M00S00078.sxserv +++| SLOWFOR I = 0 WHILE P<FCTQ> NQ 0 00079 M00S00079.sxserv +++| DO 00080 M00S00080.sxserv +++| BEGIN # SEARCH THE *FCTQ* # 00081 M00S00081.sxserv +++| IF FAMNAME EQ FCTQFAMILY[0] AND SUBFAM EQ FCTQSUBF[0] ## 00082 M00S00082.sxserv +++| AND SMID EQ FCTQSMID[0] AND FCTORD EQ FCTQFCTORD[0] 00083 M00S00083.sxserv +++| THEN 00084 M00S00084.sxserv +++| BEGIN 00085 M00S00085.sxserv +++| FCTQACTCNT[0] = FCTQACTCNT[0] + 1; 00086 M00S00086.sxserv +++| FCTQADDR = P<FCTQ>; 00087 M00S00087.sxserv +++| RETURN; 00088 M00S00088.sxserv +++| END 00089 M00S00089.sxserv +++| 00090 M00S00090.sxserv +++| P<FCTQ> = FCTQLINK1[0]; 00091 M00S00091.sxserv +++| END # SEARCH THE *FCTQ* # 00092 M00S00092.sxserv +++| 00093 M00S00093.sxserv +++|# 00094 M00S00094.sxserv +++|* REQUIRED ENTRY IS NOT CURRENTLY IN THE *FCTQ*. 00095 M00S00095.sxserv +++|# 00096 M00S00096.sxserv +++| 00097 M00S00097.sxserv +++| FCTQADDR = CHN$BOC[LCHN"FCT$FRSPC"]; 00098 M00S00098.sxserv +++| 00099 M00S00099.sxserv +++|# 00100 M00S00100.sxserv +++|* ABORT IF THERE IS NO SPACE FOR NEW *FCTQ* ENTRIES. 00101 M00S00101.sxserv +++|# 00102 M00S00102.sxserv +++| 00103 M00S00103.sxserv +++| IF FCTQADDR EQ 0 00104 M00S00104.sxserv +++| THEN 00105 M00S00105.sxserv +++| BEGIN 00106 M00S00106.sxserv +++| FE$RTN[0] = "ACQ$FCT."; 00107 M00S00107.sxserv +++| MESSAGE(FEMSG,UDFL1); 00108 M00S00108.sxserv +++| ABORT; 00109 M00S00109.sxserv +++| END 00110 M00S00110.sxserv +++| 00111 M00S00111.sxserv +++|# 00112 M00S00112.sxserv +++|* GET THE *FCT* ENTRY FROM THE FILE. 00113 M00S00113.sxserv +++|# 00114 M00S00114.sxserv +++| 00115 M00S00115.sxserv +++| P<FCT> = FCTQADDR + FCTQHL; 00116 M00S00116.sxserv +++| CGETFCT(FAMNAME,SUBFAM,SMID,FCTORD,P<FCT>,REQADDR,RSTATUS); 00117 M00S00117.sxserv +++| IF RSTATUS NQ 0 00118 M00S00118.sxserv +++| THEN 00119 M00S00119.sxserv +++| BEGIN 00120 M00S00120.sxserv +++| FCTQADDR = 0; 00121 M00S00121.sxserv +++| RETURN; 00122 M00S00122.sxserv +++| END 00123 M00S00123.sxserv +++| 00124 M00S00124.sxserv +++|# 00125 M00S00125.sxserv +++|* BUILD A *FCTQ* ENTRY AND SET THE ACTIVE USER COUNT TO 1. 00126 M00S00126.sxserv +++|# 00127 M00S00127.sxserv +++| 00128 M00S00128.sxserv +++| DEL$LNK(FCTQADDR,LCHN"FCT$FRSPC",0); 00129 M00S00129.sxserv +++| ADD$LNK(FCTQADDR,LCHN"FCT$ACT",0); 00130 M00S00130.sxserv +++| P<FCTQ> = FCTQADDR; 00131 M00S00131.sxserv +++| FCTQFAMILY[0] = FAMNAME; 00132 M00S00132.sxserv +++| FCTQSUBF[0] = SUBFAM; 00133 M00S00133.sxserv +++| FCTQSMID[0] = SMID; 00134 M00S00134.sxserv +++| FCTQFCTORD[0] = FCTORD; 00135 M00S00135.sxserv +++| FCTQACTCNT[0] = 1; 00136 M00S00136.sxserv +++| 00137 M00S00137.sxserv +++| 00138 M00S00138.sxserv +++| RETURN; 00139 M00S00139.sxserv +++| END # ACQ$FCT # 00140 M00S00140.sxserv +++| 00141 M00S00141.sxserv +++| TERM 00142 M00S00142.sxserv +++|PROC ADD$LNK((ADDR),(CHNTYP),(WRD)); 00143 M00S00143.sxserv +++| 00144 M00S00144.sxserv +++|# TITLE ADD$LNK - ADD ENTRY TO END OF CHAIN. # 00145 M00S00145.sxserv +++| 00146 M00S00146.sxserv +++| BEGIN # ADD$LNK # 00147 M00S00147.sxserv +++| 00148 M00S00148.sxserv +++|# 00149 M00S00149.sxserv +++|** ADD$LNK - ADD ENTRY TO END OF CHAIN. 00150 M00S00150.sxserv +++|* 00151 M00S00151.sxserv +++|* *ADD$LNK* LINKS AN ENTRY INTO A CHAIN BY ADDING IT TO THE END 00152 M00S00152.sxserv +++|* OF THE CHAIN. 00153 M00S00153.sxserv +++|* 00154 M00S00154.sxserv +++|* PROC ADD$LNK((ADDR),(CHNTYP),(WRD)) 00155 M00S00155.sxserv +++|* 00156 M00S00156.sxserv +++|* ENTRY (ADDR) - ADDRESS OF THE ENTRY. 00157 M00S00157.sxserv +++|* (CHNTYP) - CHAIN TYPE INDICATOR. 00158 M00S00158.sxserv +++|* (VALUES DEFINED IN *COMBCHN*). 00159 M00S00159.sxserv +++|* (WRD) - WORD NUMBER WITHIN ENTRY WHICH CONTAINS 00160 M00S00160.sxserv +++|* THE LINKAGE FIELD. 00161 M00S00161.sxserv +++|* 00162 M00S00162.sxserv +++|* EXIT THE LINKAGE FIELD HAS BEEN CLEARED IN THE ENTRY ADDED 00163 M00S00163.sxserv +++|* TO THE END OF THE CHAIN. 00164 M00S00164.sxserv +++|* 00165 M00S00165.sxserv +++|* NOTES THE LINKAGE FIELD IS ASSUMED TO BE IN THE LOWER 00166 M00S00166.sxserv +++|* 18 BITS OF WORD *WRD* OF THE ENTRY. 00167 M00S00167.sxserv +++|# 00168 M00S00168.sxserv +++| 00169 M00S00169.sxserv +++| ITEM ADDR U; # ADDRESS OF ENTRY # 00170 M00S00170.sxserv +++| ITEM CHNTYP I; # CHAIN TYPE INDICATOR # 00171 M00S00171.sxserv +++| ITEM WRD I; # LINKAGE WORD # 00172 M00S00172.sxserv +++| 00173 M00S00173.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00174 M00S00174.sxserv +++|*CALL,COMBFAS 00175 M00S00175.sxserv +++|*CALL,COMBCHN 00176 M00S00176.sxserv +++| CONTROL EJECT; 00177 M00S00177.sxserv +++| 00178 M00S00178.sxserv +++| P<LINKWRD> = ADDR; # CLEAR LINK FIELD IN ENTRY # 00179 M00S00179.sxserv +++| LINK$ADR[WRD] = 0; 00180 M00S00180.sxserv +++| IF CHN$BOC[CHNTYP] EQ 0 00181 M00S00181.sxserv +++| THEN # IF EMPTY CHAIN # 00182 M00S00182.sxserv +++| BEGIN 00183 M00S00183.sxserv +++| CHN$BOC[CHNTYP] = ADDR; 00184 M00S00184.sxserv +++| END 00185 M00S00185.sxserv +++| 00186 M00S00186.sxserv +++| ELSE 00187 M00S00187.sxserv +++| BEGIN 00188 M00S00188.sxserv +++| P<LINKWRD> = CHN$EOC[CHNTYP]; # ADD ENTRY TO END OF CHAIN # 00189 M00S00189.sxserv +++| LINK$ADR[WRD] = ADDR; 00190 M00S00190.sxserv +++| END 00191 M00S00191.sxserv +++| 00192 M00S00192.sxserv +++| CHN$EOC[CHNTYP] = ADDR; # RESET END OF CHAIN POINTER # 00193 M00S00193.sxserv +++| RETURN; 00194 M00S00194.sxserv +++| 00195 M00S00195.sxserv +++| END # ADD$LNK # 00196 M00S00196.sxserv +++| 00197 M00S00197.sxserv +++| TERM 00198 M00S00198.sxserv +++|PROC ANLZAST((SM),(NEED$S),(NEED$L),FCTX$S,FCTX$L,GPX,GPS); 00199 M00S00199.sxserv +++| 00200 M00S00200.sxserv +++|# TITLE ANLZAST - SCAN *AST* TO DETERMINE BEST CARTRIDGES AND GROUP. # 00201 M00S00201.sxserv +++| 00202 M00S00202.sxserv +++| BEGIN # ANLZAST # 00203 M00S00203.sxserv +++| 00204 M00S00204.sxserv +++|# 00205 M00S00205.sxserv +++|** ANLZAST - SCAN *AST* TO DETERMINE BEST CARTRIDGES AND GROUP. 00206 M00S00206.sxserv +++|* 00207 M00S00207.sxserv +++|* THE BEST CARTRIDGE FOR SHORT FILES IS THE ONE WITH THE 00208 M00S00208.sxserv +++|* MOST FREE AU FOR LONG FILES AMONG THOSE CARTRIDGES WHICH 00209 M00S00209.sxserv +++|* HAVE AT LEAST THE NUMBER OF FREE AU SPECIFIED BY *NEED$S*. 00210 M00S00210.sxserv +++|* IF NO CARTRIDGE HAS AT LEAST *NEED$S* FREE AU, THEN THE BEST 00211 M00S00211.sxserv +++|* CARTRIDGE IS THE ONE WITH THE MOST FREE AU. 00212 M00S00212.sxserv +++|* 00213 M00S00213.sxserv +++|* THE BEST CARTRIDGE FOR LONG FILES IS SIMPLY THE ONE WITH THE 00214 M00S00214.sxserv +++|* MOST NUMBER OF FREE AU. 00215 M00S00215.sxserv +++|* 00216 M00S00216.sxserv +++|* THE BEST GROUP FOR LONG FILES IS THE ONE WITH THE CARTRIDGE 00217 M00S00217.sxserv +++|* HAVING THE MOST FREE AU AND AN OFF-CARTRIDGE LINK (OCL) 00218 M00S00218.sxserv +++|* AMONG THE CARTRIDGES IN GROUPS WHICH HAVE AT LEAST *NEED$L* 00219 M00S00219.sxserv +++|* FREE AU AVAILABLE FOR LONG FILES. IF NO GROUP HAS THIS 00220 M00S00220.sxserv +++|* MUCH FREE SPACE, THEN THE GROUP WITH THE MOST USABLE SPACE 00221 M00S00221.sxserv +++|* FOR A LARGE FILE IS SELECTED. NOTE THAT THE USABLE SPACE 00222 M00S00222.sxserv +++|* FOR A LARGE FILE IS THE SUM OF THE FREE AU ON CARTRIDGES 00223 M00S00223.sxserv +++|* WITH AN *OCL* PLUS THE SPACE ON THE ONE CARTRIDGE IN THE 00224 M00S00224.sxserv +++|* GROUP HAVING THE MOST FREE SPACE, BUT NO *OCL*. 00225 M00S00225.sxserv +++|* 00226 M00S00226.sxserv +++|* PROC ANLZAST(NEED$S,NEED$L,FCTX$S,FCTX$L,GPX,GPS) 00227 M00S00227.sxserv +++|* 00228 M00S00228.sxserv +++|* ENTRY (SM) - INDEX OF DESIRED STORAGE MODULE. 00229 M00S00229.sxserv +++|* (NEED$S) - =N, AU NEEDED FOR SHORT FILES. 00230 M00S00230.sxserv +++|* =0, *FCTX$S* IS NOT TO BE RETURNED. 00231 M00S00231.sxserv +++|* (NEED$L) - =N, AU NEEDED FOR LONG FILES. 00232 M00S00232.sxserv +++|* =0, *FCTX$L*, *GPX* AND *GPS* 00233 M00S00233.sxserv +++|* ARE NOT TO BE RETURNED. 00234 M00S00234.sxserv +++|* 00235 M00S00235.sxserv +++|* (P<PREAMBLE>)- POINTS TO THE PREAMBLE. 00236 M00S00236.sxserv +++|* 00237 M00S00237.sxserv +++|* EXIT (FCTX$S) - *FCT* INDEX OF THE BEST CARTRIDGE 00238 M00S00238.sxserv +++|* FOR SHORT FILES. 00239 M00S00239.sxserv +++|* (FCTX$L) - *FCT* INDEX OF THE BEST CARTRIDGE 00240 M00S00240.sxserv +++|* FOR LONG FILES. 00241 M00S00241.sxserv +++|* (GPX) - INDEX OF THE BEST GROUP. 00242 M00S00242.sxserv +++|* (GPS) - AVAILABLE SPACE IN THE BEST GROUP. 00243 M00S00243.sxserv +++|# 00244 M00S00244.sxserv +++| 00245 M00S00245.sxserv +++| ITEM SM U; # STORAGE MODULE INDEX # 00246 M00S00246.sxserv +++| ITEM NEED$S U; # AU FOR SHORT FILES # 00247 M00S00247.sxserv +++| ITEM NEED$L U; # AU FOR LONG FILES # 00248 M00S00248.sxserv +++| ITEM FCTX$S U; # BEST CARTRIDGE FOR SHORT FILES # 00249 M00S00249.sxserv +++| ITEM FCTX$L U; # BEST CARTRIDGE FOR LONG FILES # 00250 M00S00250.sxserv +++| ITEM GPX U; # BEST GROUP # 00251 M00S00251.sxserv +++| ITEM GPS U; # AU AVAILABLE ON BEST GROUP # 00252 M00S00252.sxserv +++| 00253 M00S00253.sxserv +++|# 00254 M00S00254.sxserv +++|**** PROC ALLOCAT - XREF LIST BEGIN. 00255 M00S00255.sxserv +++|# 00256 M00S00256.sxserv +++| 00257 M00S00257.sxserv +++|# 00258 M00S00258.sxserv +++|**** PROC ANLZAST - XREF LIST END. 00259 M00S00259.sxserv +++|# 00260 M00S00260.sxserv +++| 00261 M00S00261.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00262 M00S00262.sxserv +++|*CALL,COMBFAS 00263 M00S00263.sxserv +++|*CALL,COMBCMD 00264 M00S00264.sxserv +++|*CALL,COMBMCT 00265 M00S00265.sxserv +++| 00266 M00S00266.sxserv +++| 00267 M00S00267.sxserv +++| ITEM BESTGR I; # BEST GROUP # 00268 M00S00268.sxserv +++| ITEM BESTL I; # BEST CARTRIDGE FOR LONG FILES # 00269 M00S00269.sxserv +++| ITEM BESTSH I; # BEST CARTRIDGE FOR SHORT FILES # 00270 M00S00270.sxserv +++| ITEM CURRGR I; # GROUP FOR LAST USABLE CARTRIDGE 00271 M00S00271.sxserv +++| # 00272 M00S00272.sxserv +++| ITEM GRSIZE I; # FREE AU IN A GROUP # 00273 M00S00273.sxserv +++| ITEM GRSUMOCL I; # FREE AU IN GROUP ON CARTRIDGES 00274 M00S00274.sxserv +++| WITH AN OFF CARTRIDGE LINK # 00275 M00S00275.sxserv +++| ITEM I I; # LOOP INDEX # 00276 M00S00276.sxserv +++| ITEM LAST I; # LAST *FCT* INDEX + 1 # 00277 M00S00277.sxserv +++| ITEM MAXAUGR I; # AU IN BEST GROUP # 00278 M00S00278.sxserv +++| ITEM MAXAUL I; # AU ON BEST CARTRIDGE FOR LONG 00279 M00S00279.sxserv +++| FILES # 00280 M00S00280.sxserv +++| ITEM MAXAUNOCL I; # AU ON BEST CARTRIDGE W/O OCL # 00281 M00S00281.sxserv +++| ITEM MAXAUOCL I; # AU ON BEST CARTRIDGE WITH OCL # 00282 M00S00282.sxserv +++| ITEM MAXAUS I; # AU ON BEST CARTRIDGE FOR SHORT 00283 M00S00283.sxserv +++| FILES # 00284 M00S00284.sxserv +++| ITEM SZBSTGR I; # SIZE OF THE BEST GROUP # 00285 M00S00285.sxserv +++| ITEM USABLE B; # TRUE IF CARTRIDGE CAN BE USED # 00286 M00S00286.sxserv +++| ITEM USE I; # TEMPORARY # 00287 M00S00287.sxserv +++| CONTROL EJECT; 00288 M00S00288.sxserv +++| 00289 M00S00289.sxserv +++|# 00290 M00S00290.sxserv +++|* INITIALIZE VARIABLES. 00291 M00S00291.sxserv +++|# 00292 M00S00292.sxserv +++| 00293 M00S00293.sxserv +++| P<AST> = ASTBADR; 00294 M00S00294.sxserv +++| 00295 M00S00295.sxserv +++| BESTGR = 0; 00296 M00S00296.sxserv +++| BESTL = 0; 00297 M00S00297.sxserv +++| BESTSH = 0; 00298 M00S00298.sxserv +++| CURRGR = 1; 00299 M00S00299.sxserv +++| GRSUMOCL = 0; 00300 M00S00300.sxserv +++| 00301 M00S00301.sxserv +++| MAXAUGR = 0; 00302 M00S00302.sxserv +++| MAXAUL = 0; 00303 M00S00303.sxserv +++| MAXAUNOCL = 0; 00304 M00S00304.sxserv +++| MAXAUOCL = 0; 00305 M00S00305.sxserv +++| MAXAUS = 0;
| Line S00001 Modification History | |
|---|---|
M01 (Added by) | mse0037 |
Seq # *Modification Id* Act ----------------------------+ 00306 M01S00001.mse0037 +++| SZBSTGR = 0; 00307 M00S00306.sxserv +++| 00308 M00S00307.sxserv +++| LAST = MAXGRT + PRM$ENTRC[SM]; 00309 M00S00308.sxserv +++| 00310 M00S00309.sxserv +++| FOR I = MAXGRT STEP 1 UNTIL LAST+1 00311 M00S00310.sxserv +++| DO 00312 M00S00311.sxserv +++| BEGIN # MAIN LOOP # 00313 M00S00312.sxserv +++| 00314 M00S00313.sxserv +++| USABLE = AST$AAF[I] AND (I LQ LAST) AND ## 00315 M00S00314.sxserv +++| (AST$STAT[I] EQ ASTENSTAT"ASS$CART"); 00316 M00S00315.sxserv +++| 00317 M00S00316.sxserv +++| IF USABLE AND (NEED$S NQ 0) 00318 M00S00317.sxserv +++| THEN # SELECT BEST CARTRIDGE FOR SHORT 00319 M00S00318.sxserv +++| FILES # 00320 M00S00319.sxserv +++| BEGIN 00321 M00S00320.sxserv +++| 00322 M00S00321.sxserv +++| IF AST$AUSF[I] GQ NEED$S 00323 M00S00322.sxserv +++| THEN 00324 M00S00323.sxserv +++| BEGIN 00325 M00S00324.sxserv +++| USE = AST$AULF[I] + NEED$S; 00326 M00S00325.sxserv +++| END 00327 M00S00326.sxserv +++| 00328 M00S00327.sxserv +++| ELSE 00329 M00S00328.sxserv +++| 00330 M00S00329.sxserv +++| BEGIN 00331 M00S00330.sxserv +++| USE = AST$AUSF[I]; 00332 M00S00331.sxserv +++| END 00333 M00S00332.sxserv +++| 00334 M00S00333.sxserv +++| IF USE GR MAXAUS 00335 M00S00334.sxserv +++| THEN # PICK THIS CARTRIDGE # 00336 M00S00335.sxserv +++| BEGIN 00337 M00S00336.sxserv +++| BESTSH = I; 00338 M00S00337.sxserv +++| MAXAUS = USE; 00339 M00S00338.sxserv +++| END 00340 M00S00339.sxserv +++| 00341 M00S00340.sxserv +++| END 00342 M00S00341.sxserv +++| 00343 M00S00342.sxserv +++| IF NEED$L NQ 0 00344 M00S00343.sxserv +++| THEN # CALCULATE LARGE FILE DATA # 00345 M00S00344.sxserv +++| BEGIN # LARGE FILE ANALYSIS # 00346 M00S00345.sxserv +++| 00347 M00S00346.sxserv +++|# 00348 M00S00347.sxserv +++|* PICK CARTRIDGE WITH THE MAXIMUM AU FOR LONG FILES. 00349 M00S00348.sxserv +++|# 00350 M00S00349.sxserv +++|
| Line S00350 Modification History | |
|---|---|
M01 (Removed by) | mse0037 |
Seq # *Modification Id* Act ----------------------------+ 00351 M01S00350.mse0037 ---| IF USABLE AND (AST$AULF[0] GR MAXAUL) ## 00352 M01S00351.mse0037 ---| AND (NEED$L GR AST$AULF[I] AND NOT AST$NOCLF[I])
| Line S00002 Modification History | |
|---|---|
M01 (Added by) | mse0037 |
Seq # *Modification Id* Act ----------------------------+ 00353 M01S00002.mse0037 +++| IF USABLE AND (AST$AULF[I] GR MAXAUL) ## 00354 M01S00003.mse0037 +++| AND ((NEED$L LQ AST$AULF[I]) ## 00355 M01S00004.mse0037 +++| OR (NEED$L GR AST$AULF[I] AND NOT AST$NOCLF[I])) 00356 M00S00352.sxserv +++| THEN # SELECT THIS CARTRIDGE # 00357 M00S00353.sxserv +++| BEGIN 00358 M00S00354.sxserv +++| BESTL = I; 00359 M00S00355.sxserv +++| MAXAUL = AST$AULF[I]; 00360 M00S00356.sxserv +++| END 00361 M00S00357.sxserv +++| 00362 M00S00358.sxserv +++|# 00363 M00S00359.sxserv +++|* PICK BEST GROUP WHEN NEW GROUP MET OR AFTER LAST CARTRIDGE. 00364 M00S00360.sxserv +++|# 00365 M00S00361.sxserv +++| 00366 M00S00362.sxserv +++| IF (I GR LAST) OR ## 00367 M00S00363.sxserv +++| ((AST$GR[I] NQ CURRGR) ##
| Line S00005 Modification History | |
|---|---|
M01 (Added by) | mse0037 |
Seq # *Modification Id* Act ----------------------------+ 00368 M01S00005.mse0037 +++| AND AST$AAF[I] ## 00369 M00S00364.sxserv +++| AND (AST$STAT[I] EQ ASTENSTAT"ASS$CART")) 00370 M00S00365.sxserv +++| THEN # COMPARE THIS GROUP WITH PREVIOUS 00371 M00S00366.sxserv +++| BEST # 00372 M00S00367.sxserv +++| BEGIN # SELECT BEST GROUP # 00373 M00S00368.sxserv +++| GRSIZE = GRSUMOCL + MAXAUNOCL; 00374 M00S00369.sxserv +++| 00375 M00S00370.sxserv +++| IF GRSIZE GR NEED$L 00376 M00S00371.sxserv +++| THEN 00377 M00S00372.sxserv +++| BEGIN 00378 M00S00373.sxserv +++| USE = MAXAUOCL + NEED$L; 00379 M00S00374.sxserv +++| END 00380 M00S00375.sxserv +++| 00381 M00S00376.sxserv +++| ELSE 00382 M00S00377.sxserv +++| BEGIN 00383 M00S00378.sxserv +++| USE = GRSIZE; 00384 M00S00379.sxserv +++| END 00385 M00S00380.sxserv +++| 00386 M00S00381.sxserv +++| IF USE GR MAXAUGR 00387 M00S00382.sxserv +++| THEN 00388 M00S00383.sxserv +++| BEGIN 00389 M00S00384.sxserv +++| BESTGR = CURRGR; 00390 M00S00385.sxserv +++| MAXAUGR = USE; 00391 M00S00386.sxserv +++| SZBSTGR = GRSIZE; 00392 M00S00387.sxserv +++| END 00393 M00S00388.sxserv +++| 00394 M00S00389.sxserv +++| GRSUMOCL = 0; 00395 M00S00390.sxserv +++| MAXAUNOCL = 0; 00396 M00S00391.sxserv +++| MAXAUOCL = 0; 00397 M00S00392.sxserv +++| 00398 M00S00393.sxserv +++| END # SELECT BEST GROUP # 00399 M00S00394.sxserv +++| 00400 M00S00395.sxserv +++|# 00401 M00S00396.sxserv +++|* UPDATE GROUP STATISTICS TO REFLECT THIS CARTRIDGE 00402 M00S00397.sxserv +++|* - SUM OF AU AVAILABLE IF OCL EXISTS. 00403 M00S00398.sxserv +++|* - CARTRIDGE WITH MOST AU WITH AN OCL. 00404 M00S00399.sxserv +++|* - CARTRIDGE WITH MOST AU WITHOUT AN OCL. 00405 M00S00400.sxserv +++|# 00406 M00S00401.sxserv +++| 00407 M00S00402.sxserv +++| IF USABLE 00408 M00S00403.sxserv +++| THEN # INCLUDE THIS CARTRIDGE # 00409 M00S00404.sxserv +++| BEGIN # DO GROUP STATISTICS # 00410 M00S00405.sxserv +++| 00411 M00S00406.sxserv +++| CURRGR = AST$GR[I]; 00412 M00S00407.sxserv +++| 00413 M00S00408.sxserv +++| IF AST$NOCLF[I] 00414 M00S00409.sxserv +++| THEN # NO OVERFLOW # 00415 M00S00410.sxserv +++| BEGIN 00416 M00S00411.sxserv +++| IF AST$AULF[I] GR MAXAUNOCL 00417 M00S00412.sxserv +++| THEN 00418 M00S00413.sxserv +++| BEGIN 00419 M00S00414.sxserv +++| MAXAUNOCL = AST$AULF[I]; 00420 M00S00415.sxserv +++| END 00421 M00S00416.sxserv +++| 00422 M00S00417.sxserv +++| END 00423 M00S00418.sxserv +++| 00424 M00S00419.sxserv +++| ELSE # OVERFLOW LINK AVAILABLE # 00425 M00S00420.sxserv +++| BEGIN 00426 M00S00421.sxserv +++| GRSUMOCL = GRSUMOCL + AST$AULF[I]; 00427 M00S00422.sxserv +++| IF AST$AULF[I] GR MAXAUOCL 00428 M00S00423.sxserv +++| THEN 00429 M00S00424.sxserv +++| BEGIN 00430 M00S00425.sxserv +++| MAXAUOCL = AST$AULF[I]; 00431 M00S00426.sxserv +++| END 00432 M00S00427.sxserv +++| 00433 M00S00428.sxserv +++| END 00434 M00S00429.sxserv +++| 00435 M00S00430.sxserv +++| END # DO GROUP STATISTICS # 00436 M00S00431.sxserv +++| 00437 M00S00432.sxserv +++| END # LARGE FILE ANALYSIS # 00438 M00S00433.sxserv +++| 00439 M00S00434.sxserv +++| END # MAIN LOOP # 00440 M00S00435.sxserv +++| 00441 M00S00436.sxserv +++|# 00442 M00S00437.sxserv +++|* RETURN OUTPUT PARAMETERS. 00443 M00S00438.sxserv +++|# 00444 M00S00439.sxserv +++| 00445 M00S00440.sxserv +++| IF NEED$S NQ 0 00446 M00S00441.sxserv +++| THEN 00447 M00S00442.sxserv +++| BEGIN 00448 M00S00443.sxserv +++| FCTX$S = BESTSH; 00449 M00S00444.sxserv +++| END 00450 M00S00445.sxserv +++| 00451 M00S00446.sxserv +++| IF NEED$L NQ 0 00452 M00S00447.sxserv +++| THEN 00453 M00S00448.sxserv +++| BEGIN 00454 M00S00449.sxserv +++| FCTX$L = BESTL; 00455 M00S00450.sxserv +++| GPX = BESTGR; 00456 M00S00451.sxserv +++| GPS = SZBSTGR; 00457 M00S00452.sxserv +++| END 00458 M00S00453.sxserv +++| 00459 M00S00454.sxserv +++| RETURN; 00460 M00S00455.sxserv +++| END # ANLZAST # 00461 M00S00456.sxserv +++| 00462 M00S00457.sxserv +++| TERM 00463 M00S00458.sxserv +++|PROC DELAY((DTIME),(ADDR),(TYP)); 00464 M00S00459.sxserv +++| 00465 M00S00460.sxserv +++|# TITLE DELAY - TIMED DELAY. # 00466 M00S00461.sxserv +++| 00467 M00S00462.sxserv +++| BEGIN # DELAY # 00468 M00S00463.sxserv +++| 00469 M00S00464.sxserv +++|# 00470 M00S00465.sxserv +++|** DELAY - TIMED DELAY. 00471 M00S00466.sxserv +++|* 00472 M00S00467.sxserv +++|* *DELAY* CALCULATES A WAKE-UP TIME AND PUTS AN *HLRQ* OR *LLRQ* 00473 M00S00468.sxserv +++|* ENTRY ON THE APPROPRIATE DELAY CHAIN. 00474 M00S00469.sxserv +++|* 00475 M00S00470.sxserv +++|* PROC DELAY((DTIME),(ADDR),(TYP)) 00476 M00S00471.sxserv +++|* 00477 M00S00472.sxserv +++|* ENTRY (DTIME) - DELAY TIME IN SECONDS. 00478 M00S00473.sxserv +++|* (ADDR) - ADDRESS OF ENTRY. 00479 M00S00474.sxserv +++|* (TYP) - *HLRQ* OR *LLRQ* INDICATOR. 00480 M00S00475.sxserv +++|* = FALSE, *LLRQ* ENTRY. 00481 M00S00476.sxserv +++|* = TRUE, *HLRQ* ENTRY. 00482 M00S00477.sxserv +++|* 00483 M00S00478.sxserv +++|* EXIT A WAKE-UP TIME IS IN THE *HLRQ* OR *LLRQ* ENTRY. 00484 M00S00479.sxserv +++|# 00485 M00S00480.sxserv +++| 00486 M00S00481.sxserv +++| ITEM DTIME U; # DELAY TIME # 00487 M00S00482.sxserv +++| ITEM ADDR U; # ADDRESS OF ENTRY # 00488 M00S00483.sxserv +++| ITEM TYP B; # ENTRY TYPE INDICATOR # 00489 M00S00484.sxserv +++| 00490 M00S00485.sxserv +++|# 00491 M00S00486.sxserv +++|**** PROC DELAY - XREF LIST BEGIN. 00492 M00S00487.sxserv +++|# 00493 M00S00488.sxserv +++| 00494 M00S00489.sxserv +++| XREF 00495 M00S00490.sxserv +++| BEGIN 00496 M00S00491.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # 00497 M00S00492.sxserv +++| PROC RTIME; # OBTAIN REAL TIME CLOCK READING # 00498 M00S00493.sxserv +++| END 00499 M00S00494.sxserv +++| 00500 M00S00495.sxserv +++|# 00501 M00S00496.sxserv +++|**** PROC DELAY - XREF LIST END. 00502 M00S00497.sxserv +++|# 00503 M00S00498.sxserv +++| 00504 M00S00499.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00505 M00S00500.sxserv +++|*CALL,COMBFAS 00506 M00S00501.sxserv +++|*CALL,COMBCHN 00507 M00S00502.sxserv +++|*CALL,COMBLRQ 00508 M00S00503.sxserv +++|*CALL,COMXHLR 00509 M00S00504.sxserv +++| 00510 M00S00505.sxserv +++| ITEM WAKEUP U; # WAKEUP TIME # 00511 M00S00506.sxserv +++| 00512 M00S00507.sxserv +++| 00513 M00S00508.sxserv +++| 00514 M00S00509.sxserv +++| 00515 M00S00510.sxserv +++| RTIME(RTIMESTAT[0]); # CALCULATE WAKE-UP TIME # 00516 M00S00511.sxserv +++| WAKEUP = RTIMSECS[0] + DTIME; 00517 M00S00512.sxserv +++| IF TYP 00518 M00S00513.sxserv +++| THEN # IF ENTRY IS FROM *HLRQ* # 00519 M00S00514.sxserv +++| BEGIN 00520 M00S00515.sxserv +++| P<HLRQ> = ADDR; # PUT ENTRY ON *HLRQ* DELAY CHAIN 00521 M00S00516.sxserv +++| # 00522 M00S00517.sxserv +++| HLR$RTIME[0] = WAKEUP; 00523 M00S00518.sxserv +++| ADD$LNK(ADDR,LCHN"HL$DELAY",0); 00524 M00S00519.sxserv +++| END 00525 M00S00520.sxserv +++| 00526 M00S00521.sxserv +++| ELSE # IF ENTRY IS FROM *LLRQ* # 00527 M00S00522.sxserv +++| BEGIN 00528 M00S00523.sxserv +++| P<LLRQ> = ADDR; # PUT ENTRY ON *LLRQ* DELAY CHAIN 00529 M00S00524.sxserv +++| # 00530 M00S00525.sxserv +++| LLR$RTIME[0] = WAKEUP; 00531 M00S00526.sxserv +++| ADD$LNK(ADDR,LCHN"LL$DELAY",0); 00532 M00S00527.sxserv +++| END 00533 M00S00528.sxserv +++| 00534 M00S00529.sxserv +++| RETURN; 00535 M00S00530.sxserv +++| END # DELAY # 00536 M00S00531.sxserv +++| 00537 M00S00532.sxserv +++| TERM 00538 M00S00533.sxserv +++|PROC DEL$LNK((ADDR),(CHNTYP),(WRD)); 00539 M00S00534.sxserv +++| 00540 M00S00535.sxserv +++|# TITLE DEL$LNK - DELETE ENTRY FROM CHAIN. # 00541 M00S00536.sxserv +++| 00542 M00S00537.sxserv +++| BEGIN # DEL$LNK # 00543 M00S00538.sxserv +++| 00544 M00S00539.sxserv +++|# 00545 M00S00540.sxserv +++|** DEL$LNK - DELETE ENTRY FROM CHAIN. 00546 M00S00541.sxserv +++|* 00547 M00S00542.sxserv +++|* *DEL$LNK* DELINKS AN ENTRY FROM A CHAIN AND RESETS THE BEGINNING 00548 M00S00543.sxserv +++|* AND END OF CHAIN POINTERS IF NECESSARY. 00549 M00S00544.sxserv +++|* 00550 M00S00545.sxserv +++|* PROC DEL$LNK((ADDR),(CHNTYP),(WRD)) 00551 M00S00546.sxserv +++|* 00552 M00S00547.sxserv +++|* ENTRY (ADDR) - ADDRESS OF THE ENTRY. 00553 M00S00548.sxserv +++|* (CHNTYP) - CHAIN TYPE INDICATOR. 00554 M00S00549.sxserv +++|* (VALUES DEFINED IN *COMBCHN*). 00555 M00S00550.sxserv +++|* (WRD) - WORD NUMBER WITHIN ENTRY WHICH CONTAINS 00556 M00S00551.sxserv +++|* THE LINKAGE FIELD. 00557 M00S00552.sxserv +++|* 00558 M00S00553.sxserv +++|* EXIT IF THE CHAIN LINKAGE IS BAD, AN ERROR MESSAGE IS 00559 M00S00554.sxserv +++|* ISSUED AND THE PROGRAM IS ABORTED, OTHERWISE THE ENTRY 00560 M00S00555.sxserv +++|* IS DELETED FROM THE CHAIN. 00561 M00S00556.sxserv +++|* 00562 M00S00557.sxserv +++|* MESSAGES * EXEC ABNORMAL, DEL$LNK.*. 00563 M00S00558.sxserv +++|* 00564 M00S00559.sxserv +++|* NOTES THE LINKAGE FIELD IS ASSUMED TO BE IN THE LOWER 18 00565 M00S00560.sxserv +++|* BITS IN WORD *WRD* OF THE ENTRY. 00566 M00S00561.sxserv +++|# 00567 M00S00562.sxserv +++| 00568 M00S00563.sxserv +++| ITEM ADDR U; # ADDRESS OF ENTRY # 00569 M00S00564.sxserv +++| ITEM CHNTYP I; # CHAIN TYPE INDICATOR # 00570 M00S00565.sxserv +++| ITEM WRD I; # LINKAGE WORD # 00571 M00S00566.sxserv +++| 00572 M00S00567.sxserv +++|# 00573 M00S00568.sxserv +++|**** PROC DEL$LNK - XREF LIST BEGIN. 00574 M00S00569.sxserv +++|# 00575 M00S00570.sxserv +++| 00576 M00S00571.sxserv +++| XREF 00577 M00S00572.sxserv +++| BEGIN 00578 M00S00573.sxserv +++| PROC ABORT; # ABORT # 00579 M00S00574.sxserv +++| PROC MESSAGE; # ISSUE A MESSAGE # 00580 M00S00575.sxserv +++| END 00581 M00S00576.sxserv +++| 00582 M00S00577.sxserv +++|# 00583 M00S00578.sxserv +++|**** PROC DEL$LNK - XREF LIST END. 00584 M00S00579.sxserv +++|# 00585 M00S00580.sxserv +++| 00586 M00S00581.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00587 M00S00582.sxserv +++|*CALL,COMBFAS 00588 M00S00583.sxserv +++|*CALL,COMBCHN 00589 M00S00584.sxserv +++|*CALL,COMXMSC 00590 M00S00585.sxserv +++| 00591 M00S00586.sxserv +++| ITEM CADDR U; # ADDRESS OF CURRENT ENTRY # 00592 M00S00587.sxserv +++| ITEM NEXT U; # NEXT ENTRY ON CHAIN # 00593 M00S00588.sxserv +++| 00594 M00S00589.sxserv +++| CONTROL EJECT; 00595 M00S00590.sxserv +++| 00596 M00S00591.sxserv +++| P<LINKWRD> = ADDR; # FIND NEXT ENTRY ON CHAIN # 00597 M00S00592.sxserv +++| NEXT = LINK$ADR[WRD]; 00598 M00S00593.sxserv +++| IF CHN$BOC[CHNTYP] EQ 0 ## 00599 M00S00594.sxserv +++| OR (NEXT EQ 0 AND ADDR NQ CHN$EOC[CHNTYP]) 00600 M00S00595.sxserv +++| THEN # IF CHAIN IS BAD # 00601 M00S00596.sxserv +++| BEGIN 00602 M00S00597.sxserv +++| GOTO BAD$CHN; 00603 M00S00598.sxserv +++| END 00604 M00S00599.sxserv +++| 00605 M00S00600.sxserv +++| LINK$ADR[WRD] = 0; # CLEAR LINKAGE IN ENTRY # 00606 M00S00601.sxserv +++| IF ADDR EQ CHN$BOC[CHNTYP] 00607 M00S00602.sxserv +++| THEN # IF ENTRY IS AT *BOC* # 00608 M00S00603.sxserv +++| BEGIN 00609 M00S00604.sxserv +++| CHN$BOC[CHNTYP] = NEXT; 00610 M00S00605.sxserv +++| IF ADDR EQ CHN$EOC[CHNTYP] 00611 M00S00606.sxserv +++| THEN # IF ENTRY IS AT *EOC* # 00612 M00S00607.sxserv +++| BEGIN 00613 M00S00608.sxserv +++| CHN$EOC[CHNTYP] = 0; # CLEAR END OF CHAIN POINTER # 00614 M00S00609.sxserv +++| END 00615 M00S00610.sxserv +++| 00616 M00S00611.sxserv +++| RETURN; 00617 M00S00612.sxserv +++| END 00618 M00S00613.sxserv +++| 00619 M00S00614.sxserv +++| CADDR = CHN$BOC[CHNTYP]; 00620 M00S00615.sxserv +++| P<LINKWRD> = CADDR; 00621 M00S00616.sxserv +++| REPEAT WHILE LINK$ADR[WRD] NQ ADDR AND LINK$ADR[WRD] NQ 0 00622 M00S00617.sxserv +++| DO # SEARCH FOR ENTRY ON CHAIN # 00623 M00S00618.sxserv +++| BEGIN 00624 M00S00619.sxserv +++| CADDR = LINK$ADR[WRD]; 00625 M00S00620.sxserv +++| P<LINKWRD> = CADDR; 00626 M00S00621.sxserv +++| END 00627 M00S00622.sxserv +++| 00628 M00S00623.sxserv +++| IF LINK$ADR[WRD] EQ 0 00629 M00S00624.sxserv +++| THEN # IF ENTRY NOT FOUND # 00630 M00S00625.sxserv +++| BEGIN 00631 M00S00626.sxserv +++| GOTO BAD$CHN; 00632 M00S00627.sxserv +++| END 00633 M00S00628.sxserv +++| 00634 M00S00629.sxserv +++| LINK$ADR[WRD] = NEXT; 00635 M00S00630.sxserv +++| IF NEXT EQ 0 00636 M00S00631.sxserv +++| THEN # IF DELINKED ENTRY IS AT *EOC* # 00637 M00S00632.sxserv +++| BEGIN 00638 M00S00633.sxserv +++| CHN$EOC[CHNTYP] = CADDR; # RESET *EOC* POINTER # 00639 M00S00634.sxserv +++| END 00640 M00S00635.sxserv +++| 00641 M00S00636.sxserv +++| RETURN; 00642 M00S00637.sxserv +++| 00643 M00S00638.sxserv +++|BAD$CHN: # BAD CHAIN ENCOUNTERED # 00644 M00S00639.sxserv +++| FE$RTN[0] = "DEL$LNK."; 00645 M00S00640.sxserv +++| MESSAGE(FEMSG,UDFL1); 00646 M00S00641.sxserv +++| ABORT; 00647 M00S00642.sxserv +++| END # DEL$LNK # 00648 M00S00643.sxserv +++| 00649 M00S00644.sxserv +++| TERM 00650 M00S00645.sxserv +++|PROC GETBUF((REQADR),(REQIND),FLAG); 00651 M00S00646.sxserv +++| 00652 M00S00647.sxserv +++|# TITLE GETBUF - GET LARGE BUFFER. # 00653 M00S00648.sxserv +++| 00654 M00S00649.sxserv +++| BEGIN # GETBUF # 00655 M00S00650.sxserv +++| 00656 M00S00651.sxserv +++|# 00657 M00S00652.sxserv +++|** GETBUF - GET LARGE BUFFER. 00658 M00S00653.sxserv +++|* 00659 M00S00654.sxserv +++|* *GETBUF* ASSIGNS THE BUFFERS AND FET-S TO BE USED FOR A FILE 00660 M00S00655.sxserv +++|* TRANSFER. IF NO ACQUIRED BUFFERS ARE AVAILABLE AND THERE ARE ANY 00661 M00S00656.sxserv +++|* AUTHORIZED ENTRIES IN THE *BST*, AN ATTEMPT IS MADE TO ACQUIRE 00662 M00S00657.sxserv +++|* ANOTHER BUFFER. 00663 M00S00658.sxserv +++|* 00664 M00S00659.sxserv +++|* PROC GETBUF((REQADR),(REQIND),FLAG) 00665 M00S00660.sxserv +++|* 00666 M00S00661.sxserv +++|* ENTRY (REQADR) - ADDRESS OF THE HIGH LEVEL/LOW LEVEL REQUEST 00667 M00S00662.sxserv +++|* QUEUE ENTRY. 00668 M00S00663.sxserv +++|* (REQIND) - HIGH LEVEL/LOW LEVEL REQUEST INDICATOR. 00669 M00S00664.sxserv +++|* = TRUE, A HIGH LEVEL REQUEST. 00670 M00S00665.sxserv +++|* = FALSE, A LOW LEVEL REQUEST. 00671 M00S00666.sxserv +++|* 00672 M00S00667.sxserv +++|* EXIT (FLAG) - BUFFER AVAILABLE FLAG. 00673 M00S00668.sxserv +++|* = TRUE, BUFFER ASSIGNED. 00674 M00S00669.sxserv +++|* = FALSE, NO BUFFER AVAILABLE. 00675 M00S00670.sxserv +++|* THE LOCATION OF THE LARGE BUFFER SPACE IS RETURNED IN 00676 M00S00671.sxserv +++|* THE REQUEST QUEUE ENTRY, IF A BUFFER IS ASSIGNED. 00677 M00S00672.sxserv +++|* 00678 M00S00673.sxserv +++|* NOTES IF NO BUFFER IS AVAILABLE, THE CALLER SHOULD ADD THE 00679 M00S00674.sxserv +++|* ENTRY TO THE *HLRQ*/*LLRQ* WAITING FOR LARGE BUFFER 00680 M00S00675.sxserv +++|* CHAIN AND THEN DROP OUT UNTIL ONE BECOMES AVAILABLE. 00681 M00S00676.sxserv +++|* WHEN A BUFFER BECOMES AVAILABLE, *GOBUF* WILL PUT THE 00682 M00S00677.sxserv +++|* *HLRQ*/*LLRQ* ENTRY ON THE APPROPRIATE READY CHAIN. 00683 M00S00678.sxserv +++|# 00684 M00S00679.sxserv +++| 00685 M00S00680.sxserv +++| ITEM REQADR U; # REQUEST ADDRESS # 00686 M00S00681.sxserv +++| ITEM REQIND B; # REQUEST TYPE INDICATOR # 00687 M00S00682.sxserv +++| ITEM FLAG B; # BUFFER AVAILABLE FLAG # 00688 M00S00683.sxserv +++| 00689 M00S00684.sxserv +++|# 00690 M00S00685.sxserv +++|**** PROC GETBUF - XREF LIST BEGIN. 00691 M00S00686.sxserv +++|# 00692 M00S00687.sxserv +++| 00693 M00S00688.sxserv +++| XREF 00694 M00S00689.sxserv +++| BEGIN 00695 M00S00690.sxserv +++| PROC REQBS; # REQUEST BUFFER SPACE # 00696 M00S00691.sxserv +++| PROC SETBSTE; # SET *BST* ENTRY # 00697 M00S00692.sxserv +++| END 00698 M00S00693.sxserv +++| 00699 M00S00694.sxserv +++|# 00700 M00S00695.sxserv +++|**** PROC GETBUF - XREF LIST END. 00701 M00S00696.sxserv +++|# 00702 M00S00697.sxserv +++| 00703 M00S00698.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00704 M00S00699.sxserv +++|*CALL,COMBFAS 00705 M00S00700.sxserv +++|*CALL,COMXBST 00706 M00S00701.sxserv +++| 00707 M00S00702.sxserv +++| ITEM I I; # LOOP COUNTER # 00708 M00S00703.sxserv +++| ITEM ORD I; # *BST* ENTRY ORDINAL # 00709 M00S00704.sxserv +++| CONTROL EJECT; 00710 M00S00705.sxserv +++| 00711 M00S00706.sxserv +++| ORD = 0; 00712 M00S00707.sxserv +++| 00713 M00S00708.sxserv +++| SLOWFOR I = 1 STEP 1 WHILE I LQ BSTL AND ORD EQ 0 00714 M00S00709.sxserv +++| DO # SEARCH BST FOR AVAILABLE ENTRY # 00715 M00S00710.sxserv +++| BEGIN 00716 M00S00711.sxserv +++| IF BST$ACQD[I] AND NOT BST$BUSY[I] 00717 M00S00712.sxserv +++| THEN 00718 M00S00713.sxserv +++| BEGIN 00719 M00S00714.sxserv +++| ORD = I; 00720 M00S00715.sxserv +++| END 00721 M00S00716.sxserv +++| 00722 M00S00717.sxserv +++| END 00723 M00S00718.sxserv +++| 00724 M00S00719.sxserv +++| IF ORD EQ 0 00725 M00S00720.sxserv +++| THEN 00726 M00S00721.sxserv +++| BEGIN # NO AVAILABLE ENTRY # 00727 M00S00722.sxserv +++| SLOWFOR I = 1 STEP 1 WHILE I LQ BSTL AND ORD EQ 0 00728 M00S00723.sxserv +++| DO 00729 M00S00724.sxserv +++| BEGIN # SEARCH FOR AUTHORIZED ENTRY # 00730 M00S00725.sxserv +++| IF BST$AUTH[I] AND NOT BST$ACQD[I] 00731 M00S00726.sxserv +++| THEN 00732 M00S00727.sxserv +++| BEGIN # ENTRY FOUND # 00733 M00S00728.sxserv +++| REQBS(I,FLAG); 00734 M00S00729.sxserv +++| IF NOT FLAG 00735 M00S00730.sxserv +++| THEN 00736 M00S00731.sxserv +++| BEGIN 00737 M00S00732.sxserv +++| RETURN; # NO BUFFER AVAILABLE # 00738 M00S00733.sxserv +++| END 00739 M00S00734.sxserv +++| 00740 M00S00735.sxserv +++| ORD = I; 00741 M00S00736.sxserv +++| END # ENTRY FOUND # 00742 M00S00737.sxserv +++| 00743 M00S00738.sxserv +++| END # SEARCH FOR AUTHORIZED ENTRY # 00744 M00S00739.sxserv +++| 00745 M00S00740.sxserv +++| END # NO AVAILABLE ENTRY # 00746 M00S00741.sxserv +++| 00747 M00S00742.sxserv +++| IF ORD NQ 0 00748 M00S00743.sxserv +++| THEN # IF AVAILABLE ENTRY FOUND # 00749 M00S00744.sxserv +++| BEGIN 00750 M00S00745.sxserv +++| SETBSTE(REQADR,REQIND,ORD); # RETURN ADDRESSES TO CALLER # 00751 M00S00746.sxserv +++| FLAG = TRUE; # BUFFER ASSIGNED # 00752 M00S00747.sxserv +++| END 00753 M00S00748.sxserv +++| 00754 M00S00749.sxserv +++| ELSE 00755 M00S00750.sxserv +++| BEGIN 00756 M00S00751.sxserv +++| FLAG = FALSE; # NO BUFFER AVAILABLE # 00757 M00S00752.sxserv +++| END 00758 M00S00753.sxserv +++| 00759 M00S00754.sxserv +++| RETURN; 00760 M00S00755.sxserv +++| END # GETBUF # 00761 M00S00756.sxserv +++| 00762 M00S00757.sxserv +++| TERM 00763 M00S00758.sxserv +++| 00764 M00S00759.sxserv +++|PROC GOBUF; 00765 M00S00760.sxserv +++| 00766 M00S00761.sxserv +++|# TITLE GOBUF - ASSIGN AVAILABLE BUFFERS. # 00767 M00S00762.sxserv +++| 00768 M00S00763.sxserv +++| BEGIN # GOBUF # 00769 M00S00764.sxserv +++| 00770 M00S00765.sxserv +++|# 00771 M00S00766.sxserv +++|** GOBUF - ASSIGN AVAILABLE BUFFERS. 00772 M00S00767.sxserv +++|* 00773 M00S00768.sxserv +++|* *GOBUF* PROCESSES THE *BST* TO SEE IF ANY ENTRIES ON THE WAITING 00774 M00S00769.sxserv +++|* FOR LARGE BUFFER CHAINS CAN BE ASSIGNED A BUFFER. 00775 M00S00770.sxserv +++|* 00776 M00S00771.sxserv +++|* PROC GOBUF. 00777 M00S00772.sxserv +++|* 00778 M00S00773.sxserv +++|* EXIT ALL ENTRIES WHICH HAVE BEEN ASSIGNED A BUFFER ARE ON 00779 M00S00774.sxserv +++|* THE *HLRQ*/*LLRQ* READY CHAIN. THE LOCATION OF THE 00780 M00S00775.sxserv +++|* LARGE BUFFER SPACE IS RETURNED IN THE REQUEST QUEUE 00781 M00S00776.sxserv +++|* ENTRY. 00782 M00S00777.sxserv +++|# 00783 M00S00778.sxserv +++| 00784 M00S00779.sxserv +++|# 00785 M00S00780.sxserv +++|**** PROC GOBUF - XREF LIST BEGIN. 00786 M00S00781.sxserv +++|# 00787 M00S00782.sxserv +++| 00788 M00S00783.sxserv +++| XREF 00789 M00S00784.sxserv +++| BEGIN 00790 M00S00785.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO CHAIN # 00791 M00S00786.sxserv +++| PROC DEL$LNK; # DELETE ENTRY FROM CHAIN # 00792 M00S00787.sxserv +++| PROC REQBS; # REQUEST BUFFER SPACE # 00793 M00S00788.sxserv +++| PROC SETBSTE; # SET *BST* ENTRY # 00794 M00S00789.sxserv +++| END 00795 M00S00790.sxserv +++| 00796 M00S00791.sxserv +++|# 00797 M00S00792.sxserv +++|**** PROC GOBUF - XREF LIST END. 00798 M00S00793.sxserv +++|# 00799 M00S00794.sxserv +++| 00800 M00S00795.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00801 M00S00796.sxserv +++|*CALL,COMBFAS 00802 M00S00797.sxserv +++|*CALL,COMBCHN 00803 M00S00798.sxserv +++|*CALL,COMXBST 00804 M00S00799.sxserv +++|*CALL,COMXMSC 00805 M00S00800.sxserv +++| 00806 M00S00801.sxserv +++| ITEM ACQFLAG B; # BUFFER ACQUIRED FLAG # 00807 M00S00802.sxserv +++| ITEM ENTADR U; # ENTRY ADDRESS # 00808 M00S00803.sxserv +++| ITEM I I; # LOOP COUNTER # 00809 M00S00804.sxserv +++| CONTROL EJECT; 00810 M00S00805.sxserv +++| 00811 M00S00806.sxserv +++| SLOWFOR I = 1 STEP 1 WHILE I LQ BSTL AND BST$AUTH[I] ## 00812 M00S00807.sxserv +++| AND (CHN$BOC[LCHN"LL$LGBUF"] NQ 0) 00813 M00S00808.sxserv +++| DO 00814 M00S00809.sxserv +++| BEGIN # ASSIGN AVAILABLE BUFFERS # 00815 M00S00810.sxserv +++| IF BST$BUSY[I] 00816 M00S00811.sxserv +++| THEN 00817 M00S00812.sxserv +++| BEGIN 00818 M00S00813.sxserv +++| TEST I; 00819 M00S00814.sxserv +++| END 00820 M00S00815.sxserv +++| 00821 M00S00816.sxserv +++| IF NOT BST$ACQD[I] 00822 M00S00817.sxserv +++| THEN 00823 M00S00818.sxserv +++| BEGIN # ACQUIRE BUFFER # 00824 M00S00819.sxserv +++| REQBS(I,ACQFLAG); 00825 M00S00820.sxserv +++| IF NOT ACQFLAG 00826 M00S00821.sxserv +++| THEN 00827 M00S00822.sxserv +++| BEGIN 00828 M00S00823.sxserv +++| RETURN; # NO BUFFER AVAILABLE # 00829 M00S00824.sxserv +++| END 00830 M00S00825.sxserv +++| 00831 M00S00826.sxserv +++| END # ACQUIRE BUFFER # 00832 M00S00827.sxserv +++| 00833 M00S00828.sxserv +++| IF CHN$BOC[LCHN"LL$LGBUF"] NQ 0 00834 M00S00829.sxserv +++| THEN # IF *LLRQ* ENTRY WAITING # 00835 M00S00830.sxserv +++| BEGIN 00836 M00S00831.sxserv +++| ENTADR = CHN$BOC[LCHN"LL$LGBUF"]; 00837 M00S00832.sxserv +++| SETBSTE(ENTADR,LLRQIND,I); 00838 M00S00833.sxserv +++| DEL$LNK(ENTADR,LCHN"LL$LGBUF",0); 00839 M00S00834.sxserv +++| ADD$LNK(ENTADR,LCHN"LL$READY",0); 00840 M00S00835.sxserv +++| END 00841 M00S00836.sxserv +++| 00842 M00S00837.sxserv +++| END # ASSIGN AVAILABLE BUFFERS # 00843 M00S00838.sxserv +++| 00844 M00S00839.sxserv +++| RETURN; 00845 M00S00840.sxserv +++| END # GOBUF # 00846 M00S00841.sxserv +++| 00847 M00S00842.sxserv +++| TERM 00848 M00S00843.sxserv +++|PROC HLCPYCD((HLRQADR)); 00849 M00S00844.sxserv +++| 00850 M00S00845.sxserv +++|# TITLE HLCPYCD - *HLRQ*/*LLRQ* ROUTINE TO COPY CARTRIDGE TO DISK. # 00851 M00S00846.sxserv +++| 00852 M00S00847.sxserv +++| BEGIN # HLCPYCD # 00853 M00S00848.sxserv +++| 00854 M00S00849.sxserv +++|# 00855 M00S00850.sxserv +++|** HLCPYCD - *HLRQ*/*LLRQ* LINK ROUTINE TO COPY CARTRIDGE TO DISK. 00856 M00S00851.sxserv +++|* 00857 M00S00852.sxserv +++|* *HLCPYCD* CALLS *CPY$SD* TO COPY DATA FROM A CARTRIDGE BUFFER 00858 M00S00853.sxserv +++|* TO THE DISK SPECIFIED IN THE *HLRQ* ENTRY. 00859 M00S00854.sxserv +++|* *HLCPYCD* CHECKS THE STATUS AFTER THE REQUEST IS PROCESSED 00860 M00S00855.sxserv +++|* AND DOES THE APPROPRIATE ERROR PROCESSING IF AN ERROR 00861 M00S00856.sxserv +++|* IS ENCOUNTERED IN WRITING THE DATA. 00862 M00S00857.sxserv +++|* 00863 M00S00858.sxserv +++|* PROC HLCPYCD((HLRQADR)) 00864 M00S00859.sxserv +++|* 00865 M00S00860.sxserv +++|* ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. 00866 M00S00861.sxserv +++|* 00867 M00S00862.sxserv +++|* EXIT VOLUME COPIED TO M860 CARTRIDGE. 00868 M00S00863.sxserv +++|* 00869 M00S00864.sxserv +++|# 00870 M00S00865.sxserv +++| 00871 M00S00866.sxserv +++| ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # 00872 M00S00867.sxserv +++| 00873 M00S00868.sxserv +++|# 00874 M00S00869.sxserv +++|**** PROC HLCPYCD - XREF LIST BEGIN. 00875 M00S00870.sxserv +++|# 00876 M00S00871.sxserv +++| 00877 M00S00872.sxserv +++| XREF 00878 M00S00873.sxserv +++| BEGIN 00879 M00S00874.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # 00880 M00S00875.sxserv +++| END 00881 M00S00876.sxserv +++| 00882 M00S00877.sxserv +++|# 00883 M00S00878.sxserv +++|**** PROC HLCPYCD - XREF LIST END. 00884 M00S00879.sxserv +++|# 00885 M00S00880.sxserv +++| 00886 M00S00881.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 00887 M00S00882.sxserv +++|*CALL,COMBFAS 00888 M00S00883.sxserv +++|*CALL,COMBCHN 00889 M00S00884.sxserv +++|*CALL,COMBCPR 00890 M00S00885.sxserv +++|*CALL,COMBLRQ 00891 M00S00886.sxserv +++|*CALL,COMBMCT 00892 M00S00887.sxserv +++|*CALL,COMSPFM 00893 M00S00888.sxserv +++|*CALL,COMXEMC 00894 M00S00889.sxserv +++|*CALL,COMXFCQ 00895 M00S00890.sxserv +++|*CALL,COMXHLR 00896 M00S00891.sxserv +++|*CALL,COMXMSC 00897 M00S00892.sxserv +++| 00898 M00S00893.sxserv +++| ITEM FLAG B; # STATUS FLAG # 00899 M00S00894.sxserv +++| ITEM STAT U; # DRIVER ERROR STATUS # 00900 M00S00895.sxserv +++| ITEM TEMP U; # SCRATCH CELL # 00901 M00S00896.sxserv +++| 00902 M00S00897.sxserv +++| CONTROL EJECT; 00903 M00S00898.sxserv +++| P<HLRQ> = HLRQADR; 00904 M00S00899.sxserv +++| P<LLRQ> = HLR$LRQADR[0]; 00905 M00S00900.sxserv +++| 00906 M00S00901.sxserv +++| STAT = HLR$RESP[0]; 00907 M00S00902.sxserv +++| IF STAT EQ RESPTYP4"OK4" 00908 M00S00903.sxserv +++| THEN 00909 M00S00904.sxserv +++| BEGIN # INDICATE NO ERROR # 00910 M00S00905.sxserv +++| HLR$RESP[0] = ERRST"NOERR"; 00911 M00S00906.sxserv +++| END # INDICATE NO ERROR # 00912 M00S00907.sxserv +++| 00913 M00S00908.sxserv +++| ELSE 00914 M00S00909.sxserv +++| BEGIN # PROCESS ERROR # 00915 M00S00910.sxserv +++| HLR$RESP[0] = ERRST"TEMP"; # RESPONSE, UNLESS MODIFIED # 00916 M00S00911.sxserv +++| HLR$ERRC[0] = STGERRC"HWPROB"; 00917 M00S00912.sxserv +++| 00918 M00S00913.sxserv +++| IF STAT EQ RESPTYP4"DISK$FULL" 00919 M00S00914.sxserv +++| THEN 00920 M00S00915.sxserv +++| BEGIN 00921 M00S00916.sxserv +++| HLR$RESP[0] = ERRST"ABANDON"; 00922 M00S00917.sxserv +++| HLR$ERRC[0] = STGERRC"DSKFULL"; 00923 M00S00918.sxserv +++| END 00924 M00S00919.sxserv +++| 00925 M00S00920.sxserv +++| IF STAT EQ RESPTYP4"RMS$FL$ERR" 00926 M00S00921.sxserv +++| THEN 00927 M00S00922.sxserv +++| BEGIN 00928 M00S00923.sxserv +++| HLR$RESP[0] = ERRST"ABANDON"; 00929 M00S00924.sxserv +++| HLR$ERRC[0] = STGERRC"DSKERR"; 00930 M00S00925.sxserv +++| END 00931 M00S00926.sxserv +++| 00932 M00S00927.sxserv +++| IF STAT EQ RESPTYP4"UN$RD$ERR" 00933 M00S00928.sxserv +++| THEN 00934 M00S00929.sxserv +++| BEGIN 00935 M00S00930.sxserv +++| IF HLR$RETRY[0] 00936 M00S00931.sxserv +++| THEN # FATAL ERROR # 00937 M00S00932.sxserv +++| BEGIN 00938 M00S00933.sxserv +++| HLR$RESP[0] = ERRST"PERM"; 00939 M00S00934.sxserv +++| HLR$PEF[0] = AFPDE; 00940 M00S00935.sxserv +++| HLR$ERRC[0] = STGERRC"DATAERR"; 00941 M00S00936.sxserv +++| END 00942 M00S00937.sxserv +++| 00943 M00S00938.sxserv +++| ELSE # RETRY ONE TIME # 00944 M00S00939.sxserv +++| BEGIN 00945 M00S00940.sxserv +++| HLR$RESP[0] = ERRST"RETRY"; 00946 M00S00941.sxserv +++| HLR$RETRY[0] = TRUE; 00947 M00S00942.sxserv +++| END 00948 M00S00943.sxserv +++| 00949 M00S00944.sxserv +++| END 00950 M00S00945.sxserv +++|
| Line S00001 Modification History | |
|---|---|
M01 (Added by) | sxserv1 |
Seq # *Modification Id* Act ----------------------------+ 00951 M01S00001.sxserv1 +++| IF STAT EQ RESPTYP4"PPU$D$PROB" 00952 M01S00002.sxserv1 +++| THEN 00953 M01S00003.sxserv1 +++| BEGIN 00954 M01S00004.sxserv1 +++| IF HLR$RETRY[0] 00955 M01S00005.sxserv1 +++| THEN 00956 M01S00006.sxserv1 +++| BEGIN # FATAL PASS # 00957 M01S00007.sxserv1 +++| HLR$RESP[0] = ERRST"PERM"; 00958 M01S00008.sxserv1 +++| HLR$PEF[0] = AFTMP; # TEMPORARY PFM ERROR # 00959 M01S00009.sxserv1 +++| HLR$ERRC[0] = STGERRC"PPUDPRB"; 00960 M01S00010.sxserv1 +++| END 00961 M01S00011.sxserv1 +++| 00962 M01S00012.sxserv1 +++| ELSE 00963 M01S00013.sxserv1 +++| BEGIN # RETRY ONE TIME # 00964 M01S00014.sxserv1 +++| HLR$RESP[0] = ERRST"RETRY"; 00965 M01S00015.sxserv1 +++| HLR$RETRY[0] = TRUE; 00966 M01S00016.sxserv1 +++| END 00967 M01S00017.sxserv1 +++| 00968 M01S00018.sxserv1 +++| END 00969 M01S00019.sxserv1 +++| 00970 M00S00946.sxserv +++| IF STAT EQ RESPTYP4"VOL$HD$ERR" 00971 M00S00947.sxserv +++| THEN 00972 M00S00948.sxserv +++| BEGIN 00973 M00S00949.sxserv +++| P<FCT> = HLR$FCTQ[0] + FCTQHL; 00974 M00S00950.sxserv +++| SETFCTX(HLR$VOLAU[0]); 00975 M00S00951.sxserv +++| FCT$AUCF(FWD,FPS) = 1; # SET CONFLICT FLAG # 00976 M00S00952.sxserv +++| HLR$RESP[0] = ERRST"PERM"; 00977 M00S00953.sxserv +++| HLR$PEF[0] = AFPSE; 00978 M00S00954.sxserv +++| HLR$ERRC[0] = STGERRC"CHKERR"; 00979 M00S00955.sxserv +++| END 00980 M00S00956.sxserv +++| 00981 M00S00957.sxserv +++| IF STAT EQ RESPTYP4"M86$HDW$PR" 00982 M00S00958.sxserv +++| THEN 00983 M00S00959.sxserv +++| BEGIN 00984 M00S00960.sxserv +++| HLR$RESP[0] = ERRST"RETRY"; 00985 M00S00961.sxserv +++| HLR$RETRY[0] = FALSE; 00986 M00S00962.sxserv +++| END 00987 M00S00963.sxserv +++| 00988 M00S00964.sxserv +++| END # PROCESS ERROR # 00989 M00S00965.sxserv +++| 00990 M00S00966.sxserv +++|# 00991 M00S00967.sxserv +++|* RETURN TO CALLING PROGRAM. 00992 M00S00968.sxserv +++|# 00993 M00S00969.sxserv +++| 00994 M00S00970.sxserv +++| RETURN; 00995 M00S00971.sxserv +++| 00996 M00S00972.sxserv +++| END # HLCPYCD # 00997 M00S00973.sxserv +++| 00998 M00S00974.sxserv +++| TERM 00999 M00S00975.sxserv +++|PROC HLCPYDC((HLRQADR)); 01000 M00S00976.sxserv +++| 01001 M00S00977.sxserv +++|# TITLE HLCPYDC - CONTROL ROUTINE FOR COPYING DISK TO CARTRIDGE. # 01002 M00S00978.sxserv +++| 01003 M00S00979.sxserv +++| BEGIN # HLCPYDC # 01004 M00S00980.sxserv +++| 01005 M00S00981.sxserv +++|# 01006 M00S00982.sxserv +++|** HLCPYDC - *HLRQ*/*LLRQ* LINK ROUTINE TO COPY DISK TO CARTRIDGE. 01007 M00S00983.sxserv +++|* 01008 M00S00984.sxserv +++|* *HLCPYDC* CALLS *CPY$DS* TO COPY DATA FROM A DISK BUFFER 01009 M00S00985.sxserv +++|* TO THE CARTRIDGE SPECIFIED IN THE *HLRQ* ENTRY. 01010 M00S00986.sxserv +++|* *HLCPYDC* CHECKS THE STATUS AFTER THE REQUEST IS PROCESSED 01011 M00S00987.sxserv +++|* AND DOES THE APPROPRIATE ERROR PROCESSING IF AN ERROR 01012 M00S00988.sxserv +++|* IS ENCOUNTERED IN WRITING THE DATA. 01013 M00S00989.sxserv +++|* 01014 M00S00990.sxserv +++|* PROC HLCPYDC((HLRQADR)) 01015 M00S00991.sxserv +++|* 01016 M00S00992.sxserv +++|* ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. 01017 M00S00993.sxserv +++|* 01018 M00S00994.sxserv +++|* EXIT VOLUME COPIED TO M860 CARTRIDGE. 01019 M00S00995.sxserv +++|* 01020 M00S00996.sxserv +++|# 01021 M00S00997.sxserv +++| 01022 M00S00998.sxserv +++| ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # 01023 M00S00999.sxserv +++| 01024 M00S01000.sxserv +++|# 01025 M00S01001.sxserv +++|**** PROC HLCPYDC - XREF LIST BEGIN. 01026 M00S01002.sxserv +++|# 01027 M00S01003.sxserv +++| 01028 M00S01004.sxserv +++| XREF 01029 M00S01005.sxserv +++| BEGIN 01030 M00S01006.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # 01031 M00S01007.sxserv +++| PROC RLSVOL; # RELEASE UNUSED AU # 01032 M00S01008.sxserv +++| END 01033 M00S01009.sxserv +++| 01034 M00S01010.sxserv +++|# 01035 M00S01011.sxserv +++|**** PROC HLCPYDC - XREF LIST END. 01036 M00S01012.sxserv +++|# 01037 M00S01013.sxserv +++| 01038 M00S01014.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01039 M00S01015.sxserv +++|*CALL,COMBFAS 01040 M00S01016.sxserv +++|*CALL,COMBCHN 01041 M00S01017.sxserv +++|*CALL,COMBCPR 01042 M00S01018.sxserv +++|*CALL,COMBLRQ 01043 M00S01019.sxserv +++|*CALL,COMBMCT 01044 M00S01020.sxserv +++|*CALL,COMBTDM 01045 M00S01021.sxserv +++|*CALL,COMXFCQ 01046 M00S01022.sxserv +++|*CALL,COMXHLR 01047 M00S01023.sxserv +++|*CALL,COMXMSC 01048 M00S01024.sxserv +++| 01049 M00S01025.sxserv +++| 01050 M00S01026.sxserv +++| ITEM FLAG B; # STATUS FLAG # 01051 M00S01027.sxserv +++| ITEM RELFIRST U; # FIRST AU TO RELEASE # 01052 M00S01028.sxserv +++| ITEM RELNUM U; # NUMBER OF AU TO RELEASE # 01053 M00S01029.sxserv +++| ITEM STAT U; # STATUS FROM *HLR$RESP* # 01054 M00S01030.sxserv +++| ITEM TEMP U; # SCRATCH CELL # 01055 M00S01031.sxserv +++| 01056 M00S01032.sxserv +++| CONTROL EJECT; 01057 M00S01033.sxserv +++| P<HLRQ> = HLRQADR; 01058 M00S01034.sxserv +++| P<LLRQ> = HLR$LRQADR[0]; 01059 M00S01035.sxserv +++| 01060 M00S01036.sxserv +++|# 01061 M00S01037.sxserv +++|* SET DEFAULT *HLR$RESP* VALUE AND RELEASE PARAMETERS 01062 M00S01038.sxserv +++|* IN CASE THEY ARE NOT SPECIFICALLY MODIFIED. 01063 M00S01039.sxserv +++|# 01064 M00S01040.sxserv +++| 01065 M00S01041.sxserv +++| STAT = HLR$RESP[0]; 01066 M00S01042.sxserv +++| 01067 M00S01043.sxserv +++| IF STAT EQ RESPTYP4"OK4" 01068 M00S01044.sxserv +++| THEN 01069 M00S01045.sxserv +++| BEGIN # INDICATE NO ERROR # 01070 M00S01046.sxserv +++| HLR$RESP[0] = ERRST"NOERR"; 01071 M00S01047.sxserv +++| END # INDICATE NO ERROR # 01072 M00S01048.sxserv +++| 01073 M00S01049.sxserv +++| ELSE 01074 M00S01050.sxserv +++| BEGIN # PROCESS ERROR # 01075 M00S01051.sxserv +++| 01076 M00S01052.sxserv +++| RELFIRST = HLR$VOLAU[0]; 01077 M00S01053.sxserv +++| RELNUM = HLR$VOLLN[0]; 01078 M00S01054.sxserv +++| HLR$RESP[0] = ERRST"RETRY"; 01079 M00S01055.sxserv +++| 01080 M00S01056.sxserv +++| IF STAT EQ RESPTYP4"RMS$FL$ERR" 01081 M00S01057.sxserv +++| THEN 01082 M00S01058.sxserv +++| BEGIN 01083 M00S01059.sxserv +++| HLR$RESP[0] = ERRST"ABANDON"; 01084 M00S01060.sxserv +++| HLR$ERRC[0] = ABANDON"DSKRDERR"; 01085 M00S01061.sxserv +++| END 01086 M00S01062.sxserv +++| 01087 M00S01063.sxserv +++| P<FCT> = HLR$FCTQ[0] + FCTQHL; 01088 M00S01064.sxserv +++| 01089 M00S01065.sxserv +++| IF STAT EQ RESPTYP4"UN$WRT$ERR" 01090 M00S01066.sxserv +++| THEN 01091 M00S01067.sxserv +++| BEGIN # UNRECOVERED WRITE ERROR PROCESSING # 01092 M00S01068.sxserv +++| 01093 M00S01069.sxserv +++| RELNUM = HLR$AUUD[0] - HLR$VOLAU[0]; 01094 M00S01070.sxserv +++| RLSVOL(HLRQADR,HLR$FCTQ[0],HLR$AUUD[0]+1, ## 01095 M00S01071.sxserv +++| HLR$VOLLN[0] - RELNUM - 1); # RELEASE AU AFTER FLAW # 01096 M00S01072.sxserv +++| 01097 M00S01073.sxserv +++| SETFCTX(HLR$AUUD[0]); 01098 M00S01074.sxserv +++| FCT$FAUF(FWD,FPS) = 1; 01099 M00S01075.sxserv +++| FCT$FLAWS[0] = FCT$FLAWS[0] + 1; 01100 M00S01076.sxserv +++| END # UNRECOVERED WRITE ERROR PROCESSING # 01101 M00S01077.sxserv +++| 01102 M00S01078.sxserv +++| IF STAT EQ RESPTYP4"EX$DMARK" 01103 M00S01079.sxserv +++| THEN 01104 M00S01080.sxserv +++| BEGIN # EXCESSIVE DEMARKS # 01105 M00S01081.sxserv +++| SLOWFOR TEMP = HLR$VOLAU[0] STEP 1 UNTIL HLR$AUUD[0] 01106 M00S01082.sxserv +++| DO 01107 M00S01083.sxserv +++| BEGIN # FLAW ALL AU THAT WERE USED # 01108 M00S01084.sxserv +++| 01109 M00S01085.sxserv +++| SETFCTX(TEMP); 01110 M00S01086.sxserv +++| FCT$FAUF(FWD,FPS) = 1; 01111 M00S01087.sxserv +++| FCT$FLAWS[0] = FCT$FLAWS[0] + 1; 01112 M00S01088.sxserv +++| END # FLAW ALL AU THAT WERE USED # 01113 M00S01089.sxserv +++| 01114 M00S01090.sxserv +++| RELNUM = HLR$VOLLN[0] - ( HLR$AUUD[0] - HLR$VOLAU[0]) - 1; 01115 M00S01091.sxserv +++| RELFIRST = HLR$AUUD[0]+1; # RELEASE REST OF AU # 01116 M00S01092.sxserv +++| END # EXCESSIVE DEMARKS # 01117 M00S01093.sxserv +++| 01118 M00S01094.sxserv +++| IF STAT EQ RESPTYP4"M86$HDW$PR" 01119 M00S01095.sxserv +++| THEN # FORCE CARTRIDGE UNLOAD # 01120 M00S01096.sxserv +++| BEGIN 01121 M00S01097.sxserv +++| HLR$ERRC[0] = ERRST"SPECIAL"; 01122 M00S01098.sxserv +++| END 01123 M00S01099.sxserv +++| 01124 M00S01100.sxserv +++|# 01125 M00S01101.sxserv +++|* IF ERRORS, RELEASE ANY REMAINING UNFLAWED AU. THEN RETURN 01126 M00S01102.sxserv +++|* TO CALLING PROGRAM. 01127 M00S01103.sxserv +++|# 01128 M00S01104.sxserv +++| 01129 M00S01105.sxserv +++| HLR$VOLLN[0] = 0; 01130 M00S01106.sxserv +++| RLSVOL(HLRQADR,HLR$FCTQ[0], RELFIRST, RELNUM); # RELEASE AU # 01131 M00S01107.sxserv +++| 01132 M00S01108.sxserv +++| END # PROCESS ERROR # 01133 M00S01109.sxserv +++| 01134 M00S01110.sxserv +++| RETURN; 01135 M00S01111.sxserv +++| END # HLCPYDC # 01136 M00S01112.sxserv +++| 01137 M00S01113.sxserv +++| TERM 01138 M00S01114.sxserv +++|PROC HLLDSET((HLRQADR)); 01139 M00S01115.sxserv +++| 01140 M00S01116.sxserv +++|# TITLE HLLDSET - TRANSFER *HLRQ* DATA TO *LLRQ*. # 01141 M00S01117.sxserv +++| 01142 M00S01118.sxserv +++| BEGIN # HLLDSET # 01143 M00S01119.sxserv +++| 01144 M00S01120.sxserv +++|# 01145 M00S01121.sxserv +++|** HLLDSET - TRANSFER *HLRQ* DATA TO *LLRQ*. 01146 M00S01122.sxserv +++|* 01147 M00S01123.sxserv +++|* *HLLDSET* MOVES RELEVANT *HLRQ* INFORMATION TO THE *LLRQ* ENTRY 01148 M00S01124.sxserv +++|* SO THE DRIVER HAS SUFFICIENT INFORMATION TO PROCESS THE 01149 M00S01125.sxserv +++|* FORTHCOMING LOAD CARTRIDGE REQUEST. 01150 M00S01126.sxserv +++|* 01151 M00S01127.sxserv +++|* PROC HLLDSET((HLRQADR)) 01152 M00S01128.sxserv +++|* 01153 M00S01129.sxserv +++|* ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. 01154 M00S01130.sxserv +++|* 01155 M00S01131.sxserv +++|* EXIT NONE 01156 M00S01132.sxserv +++|# 01157 M00S01133.sxserv +++| 01158 M00S01134.sxserv +++| ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # 01159 M00S01135.sxserv +++| 01160 M00S01136.sxserv +++|# 01161 M00S01137.sxserv +++|**** PROC HLLDSET - XREF LIST BEGIN. 01162 M00S01138.sxserv +++|# 01163 M00S01139.sxserv +++| 01164 M00S01140.sxserv +++| XREF 01165 M00S01141.sxserv +++| BEGIN 01166 M00S01142.sxserv +++| PROC LLRQENQ; # *LLRQ* ENQUEUER # 01167 M00S01143.sxserv +++| END 01168 M00S01144.sxserv +++| 01169 M00S01145.sxserv +++|# 01170 M00S01146.sxserv +++|**** HLLDSET - XREF LIST END. 01171 M00S01147.sxserv +++|# 01172 M00S01148.sxserv +++| 01173 M00S01149.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01174 M00S01150.sxserv +++|*CALL,COMBFAS 01175 M00S01151.sxserv +++|*CALL,COMBCPR 01176 M00S01152.sxserv +++|*CALL,COMBLRQ 01177 M00S01153.sxserv +++|*CALL,COMBMCT 01178 M00S01154.sxserv +++|*CALL,COMBUCR 01179 M00S01155.sxserv +++|*CALL,COMXEMC 01180 M00S01156.sxserv +++|*CALL,COMXFCQ 01181 M00S01157.sxserv +++|*CALL,COMXHLR 01182 M00S01158.sxserv +++|*CALL,COMXMSC 01183 M00S01159.sxserv +++| 01184 M00S01160.sxserv +++| 01185 M00S01161.sxserv +++| ITEM LLRQADR U; # *LLRQ* ENTRY ADDRESS # 01186 M00S01162.sxserv +++| 01187 M00S01163.sxserv +++| 01188 M00S01164.sxserv +++| 01189 M00S01165.sxserv +++| 01190 M00S01166.sxserv +++| 01191 M00S01167.sxserv +++| P<HLRQ> = HLRQADR; 01192 M00S01168.sxserv +++| LLRQENQ(LLRQADR); # GET *LLRQ* ENTRY # 01193 M00S01169.sxserv +++| P<LLRQ> = LLRQADR; 01194 M00S01170.sxserv +++| HLR$LRQADR[0] = LLRQADR; 01195 M00S01171.sxserv +++| LLR$UCPRA[0] = HLRQADR; 01196 M00S01172.sxserv +++| LLR$CSNT[0] = HLR$CSNTCU[0]; 01197 M00S01173.sxserv +++| LLR$Y[0] = HLR$Y[0]; 01198 M00S01174.sxserv +++| LLR$Z[0] = HLR$Z[0]; 01199 M00S01175.sxserv +++| LLR$SMA[0] = HLR$SM[0]; 01200 M00S01176.sxserv +++| LLR$RQI[0] = REQNAME"RQIINT"; 01201 M00S01177.sxserv +++| LLR$PRCNME[0] = REQTYP4"LOAD$CART"; 01202 M00S01178.sxserv +++| LLR$PRCST[0] = PROCST"INITIAL"; 01203 M00S01179.sxserv +++| P<FCT> = HLR$FCTQ[0] + FCTQHL; 01204 M00S01180.sxserv +++| 01205 M00S01181.sxserv +++| END # HLLDSET # 01206 M00S01182.sxserv +++| 01207 M00S01183.sxserv +++| TERM 01208 M00S01184.sxserv +++|PROC HLLOAD((HLRQADR)); 01209 M00S01185.sxserv +++| 01210 M00S01186.sxserv +++|# TITLE HLLOAD - *HLRQ*/*LLRQ* INTERFACE ROUTINE TO LOAD CARTRIDGE. # 01211 M00S01187.sxserv +++| 01212 M00S01188.sxserv +++| BEGIN # HLLOAD # 01213 M00S01189.sxserv +++| 01214 M00S01190.sxserv +++|# 01215 M00S01191.sxserv +++|** HLLOAD - *HLRQ*/*LLRQ* LINKING ROUTINE FOR LOADING CARTRIDGES. 01216 M00S01192.sxserv +++|* 01217 M00S01193.sxserv +++|* *HLLOAD* CALLS *HLLDSET* TO TRANSFER RELEVANT INFORMATION 01218 M00S01194.sxserv +++|* FROM THE *HLRQ* ENTRY TO THE *LLRQ* ENTRY FOR LOADING FILES. 01219 M00S01195.sxserv +++|* *HLLOAD* CHECKS THE STATUS AFTER THE LOAD REQUEST IS PROCESSED 01220 M00S01196.sxserv +++|* AND DOES THE APPROPRIATE ERROR PROCESSING IF AN ERROR 01221 M00S01197.sxserv +++|* IS ENCOUNTERED IN LOADING A CARTRIDGE. 01222 M00S01198.sxserv +++|* 01223 M00S01199.sxserv +++|* PROC HLLOAD((HLRQADR)) 01224 M00S01200.sxserv +++|* 01225 M00S01201.sxserv +++|* ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. 01226 M00S01202.sxserv +++|* 01227 M00S01203.sxserv +++|* EXIT *HLRQ* ENTRY ESTABLISHED. 01228 M00S01204.sxserv +++|* 01229 M00S01205.sxserv +++|# 01230 M00S01206.sxserv +++| 01231 M00S01207.sxserv +++| ITEM FLAG B; # STATUS FLAG # 01232 M00S01208.sxserv +++| ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # 01233 M00S01209.sxserv +++| 01234 M00S01210.sxserv +++|# 01235 M00S01211.sxserv +++|**** PROC HLLOAD - XREF LIST BEGIN. 01236 M00S01212.sxserv +++|# 01237 M00S01213.sxserv +++| 01238 M00S01214.sxserv +++| XREF 01239 M00S01215.sxserv +++| BEGIN 01240 M00S01216.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # 01241 M00S01217.sxserv +++| PROC MSGAFDF; # ISSUE ACCOUNT-DAYFILE MESSAGE # 01242 M00S01218.sxserv +++| PROC HLLDSET; # TRANSFER DATA TO *LLRQ* # 01243 M00S01219.sxserv +++| END 01244 M00S01220.sxserv +++| 01245 M00S01221.sxserv +++|# 01246 M00S01222.sxserv +++|**** PROC HLLOAD - XREF LIST END. 01247 M00S01223.sxserv +++|# 01248 M00S01224.sxserv +++| 01249 M00S01225.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01250 M00S01226.sxserv +++|*CALL,COMBFAS 01251 M00S01227.sxserv +++|*CALL,COMBCHN 01252 M00S01228.sxserv +++|*CALL,COMBCPR 01253 M00S01229.sxserv +++|*CALL,COMBLRQ 01254 M00S01230.sxserv +++|*CALL,COMBMCT 01255 M00S01231.sxserv +++|*CALL,COMBTDM 01256 M00S01232.sxserv +++|*CALL,COMSPFM 01257 M00S01233.sxserv +++|*CALL,COMXEMC 01258 M00S01234.sxserv +++|*CALL,COMXFCQ 01259 M00S01235.sxserv +++|*CALL,COMXHLR 01260 M00S01236.sxserv +++|*CALL,COMXMSC 01261 M00S01237.sxserv +++| 01262 M00S01238.sxserv +++| ITEM STAGE B; # TRUE IF CALLED FROM *STAGER* # 01263 M00S01239.sxserv +++| ITEM STAT U; # STATUS (FROM *HLR$RESP*) # 01264 M00S01240.sxserv +++| 01265 M00S01241.sxserv +++| 01266 M00S01242.sxserv +++| CONTROL EJECT; 01267 M00S01243.sxserv +++| P<HLRQ> = HLRQADR; 01268 M00S01244.sxserv +++| P<LLRQ> = HLR$LRQADR[0]; 01269 M00S01245.sxserv +++| P<FCT> = HLR$FCTQ[0] + FCTQHL; 01270 M00S01246.sxserv +++| STAGE = HLR$HPN[0] EQ HLRPN"STAGE"; 01271 M00S01247.sxserv +++| IF HLR$RESP[0] EQ RESPTYP4"OK4" 01272 M00S01248.sxserv +++| THEN 01273 M00S01249.sxserv +++| BEGIN # NO ERROR # 01274 M00S01250.sxserv +++| HLR$RESP[0] = ERRST"NOERR"; 01275 M00S01251.sxserv +++| FCT$LCF[0] = FALSE; # CLEAR LOST CARTRIDGEFLAG # 01276 M00S01252.sxserv +++| END # NO ERROR # 01277 M00S01253.sxserv +++| 01278 M00S01254.sxserv +++| ELSE 01279 M00S01255.sxserv +++| BEGIN # PROCESS ERROR # 01280 M00S01256.sxserv +++| 01281 M00S01257.sxserv +++| STAT = HLR$RESP[0]; 01282 M00S01258.sxserv +++| 01283 M00S01259.sxserv +++| IF STAGE 01284 M00S01260.sxserv +++| THEN 01285 M00S01261.sxserv +++| BEGIN 01286 M00S01262.sxserv +++| HLR$RESP[0] = ERRST"TEMP"; # DEFAULT FOR STAGE # 01287 M00S01263.sxserv +++| HLR$ERRC[0] = STGERRC"HWPROB"; 01288 M00S01264.sxserv +++| END 01289 M00S01265.sxserv +++| 01290 M00S01266.sxserv +++| ELSE 01291 M00S01267.sxserv +++| BEGIN 01292 M00S01268.sxserv +++| HLR$RESP[0] = ERRST"RETRY"; # DEFAULT FOR DESTAGER # 01293 M00S01269.sxserv +++| END 01294 M00S01270.sxserv +++| 01295 M00S01271.sxserv +++| IF STAT EQ RESPTYP4"CELL$EMP" 01296 M00S01272.sxserv +++| THEN 01297 M00S01273.sxserv +++| BEGIN # SET LOST FLAG IN *FCT* # 01298 M00S01274.sxserv +++| FCT$LCF[0] = TRUE; 01299 M00S01275.sxserv +++| 01300 M00S01276.sxserv +++| IF STAGE 01301 M00S01277.sxserv +++| THEN 01302 M00S01278.sxserv +++| BEGIN 01303 M00S01279.sxserv +++| HLR$ERRC[0] = STGERRC"LOSTCART"; 01304 M00S01280.sxserv +++| END 01305 M00S01281.sxserv +++| 01306 M00S01282.sxserv +++| END # SET LOST FLAG IN *FCT* # 01307 M00S01283.sxserv +++| 01308 M00S01284.sxserv +++| IF STAT EQ RESPTYP4"CART$LB$ERR" 01309 M00S01285.sxserv +++| THEN 01310 M00S01286.sxserv +++| BEGIN # PROCESS CARTRIDGE LABEL ERROR # 01311 M00S01287.sxserv +++| FCT$IAF[0] = TRUE; 01312 M00S01288.sxserv +++| 01313 M00S01289.sxserv +++| IF STAGE 01314 M00S01290.sxserv +++| THEN 01315 M00S01291.sxserv +++| BEGIN 01316 M00S01292.sxserv +++| HLR$RESP[0] = ERRST"PERM"; 01317 M00S01293.sxserv +++| HLR$PEF[0] = AFPSE; 01318 M00S01294.sxserv +++| HLR$ERRC[0] = STGERRC"CARTLBL"; 01319 M00S01295.sxserv +++| END 01320 M00S01296.sxserv +++| 01321 M00S01297.sxserv +++| END # PROCESS CARTRIDGE LABEL ERROR # 01322 M00S01298.sxserv +++| 01323 M00S01299.sxserv +++| IF STAGE 01324 M00S01300.sxserv +++| THEN # DIAGNOSE OTHER PROBLEMS # 01325 M00S01301.sxserv +++| BEGIN 01326 M00S01302.sxserv +++| IF STAT EQ RESPTYP4"UNK$CART" 01327 M00S01303.sxserv +++| THEN 01328 M00S01304.sxserv +++| BEGIN 01329 M00S01305.sxserv +++| HLR$RESP[0] = ERRST"RETRY"; 01330 M00S01306.sxserv +++| END 01331 M00S01307.sxserv +++| 01332 M00S01308.sxserv +++| IF STAT EQ RESPTYP4"SMA$OFF" 01333 M00S01309.sxserv +++| THEN 01334 M00S01310.sxserv +++| BEGIN 01335 M00S01311.sxserv +++| HLR$ERRC[0] = STGERRC"SMOFF"; 01336 M00S01312.sxserv +++| END 01337 M00S01313.sxserv +++| 01338 M00S01314.sxserv +++| END 01339 M00S01315.sxserv +++| 01340 M00S01316.sxserv +++| IF STAT EQ RESPTYP4"CSN$IN$USE" 01341 M00S01317.sxserv +++| THEN 01342 M00S01318.sxserv +++| BEGIN 01343 M00S01319.sxserv +++| HLR$RESP[0] = ERRST"RSFULL"; 01344 M00S01320.sxserv +++| IF STAGE 01345 M00S01321.sxserv +++| THEN 01346 M00S01322.sxserv +++| BEGIN 01347 M00S01323.sxserv +++| HLR$ERRC[0] = STGERRC"CARTINUSE"; 01348 M00S01324.sxserv +++| END 01349 M00S01325.sxserv +++| 01350 M00S01326.sxserv +++| END 01351 M00S01327.sxserv +++| 01352 M00S01328.sxserv +++| 01353 M00S01329.sxserv +++| END # PROCESS ERROR # 01354 M00S01330.sxserv +++| 01355 M00S01331.sxserv +++| RETURN; 01356 M00S01332.sxserv +++| END # HLLOAD # 01357 M00S01333.sxserv +++| 01358 M00S01334.sxserv +++| TERM 01359 M00S01335.sxserv +++|PROC MSG((DFMSG),(OP)); 01360 M00S01336.sxserv +++| 01361 M00S01337.sxserv +++|# TITLE MSG - DISPLAY DAYFILE MESSAGE. # 01362 M00S01338.sxserv +++| 01363 M00S01339.sxserv +++| BEGIN # MSG # 01364 M00S01340.sxserv +++| 01365 M00S01341.sxserv +++|# 01366 M00S01342.sxserv +++|** MSG - DISPLAY DAYFILE MESSAGE. 01367 M00S01343.sxserv +++|* 01368 M00S01344.sxserv +++|* *MSG* SEARCHES A MESSAGE FOR A TERMINATING CHARACTER AND 01369 M00S01345.sxserv +++|* ZERO FILLS THE MESSAGE FROM THE TERMINATOR TO THE END 01370 M00S01346.sxserv +++|* OF THE MESSAGE. 01371 M00S01347.sxserv +++|* 01372 M00S01348.sxserv +++|* PROC MSG((DFMSG),(OP)) 01373 M00S01349.sxserv +++|* 01374 M00S01350.sxserv +++|* ENTRY (DFMSG) - MESSAGE TO BE DISPLAYED, 40 CHARACTER 01375 M00S01351.sxserv +++|* MAXIMUM. 01376 M00S01352.sxserv +++|* (OP) - MESSAGE ROUTING OPTION. 01377 M00S01353.sxserv +++|* (VALUES DEFINED IN *COMBFAS*) 01378 M00S01354.sxserv +++|* 01379 M00S01355.sxserv +++|* EXIT THE MESSAGE HAS BEEN DISPLAYED AT THE LOCATION 01380 M00S01356.sxserv +++|* SPECIFIED BY (OP). 01381 M00S01357.sxserv +++|# 01382 M00S01358.sxserv +++| 01383 M00S01359.sxserv +++| ITEM DFMSG C(40); # MESSAGE TEXT # 01384 M00S01360.sxserv +++| ITEM OP I; # MESSAGE ROUTING OPTION # 01385 M00S01361.sxserv +++| 01386 M00S01362.sxserv +++|# 01387 M00S01363.sxserv +++|* PROC MSG - XREF LIST BEGIN. 01388 M00S01364.sxserv +++|# 01389 M00S01365.sxserv +++| 01390 M00S01366.sxserv +++| XREF 01391 M00S01367.sxserv +++| BEGIN 01392 M00S01368.sxserv +++| PROC MESSAGE; # ISSUE MESSAGE # 01393 M00S01369.sxserv +++| END 01394 M00S01370.sxserv +++| 01395 M00S01371.sxserv +++|# 01396 M00S01372.sxserv +++|* PROC MSG - XREF LIST END. 01397 M00S01373.sxserv +++|# 01398 M00S01374.sxserv +++| 01399 M00S01375.sxserv +++| DEF BLANK #" "#; # BLANK CHARACTER # 01400 M00S01376.sxserv +++| DEF TERMCHAR #";"#; # TERMINATOR CHARACTER # 01401 M00S01377.sxserv +++| 01402 M00S01378.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01403 M00S01379.sxserv +++|*CALL,COMBFAS 01404 M00S01380.sxserv +++| 01405 M00S01381.sxserv +++| ITEM I I; # LOOP COUNTER # 01406 M00S01382.sxserv +++| ITEM CP I; # CHARACTER POSITION # 01407 M00S01383.sxserv +++| 01408 M00S01384.sxserv +++| CONTROL EJECT; 01409 M00S01385.sxserv +++| 01410 M00S01386.sxserv +++| CP = 0; 01411 M00S01387.sxserv +++| FASTFOR I = 0 STEP 1 WHILE I LS 40 AND CP EQ 0 01412 M00S01388.sxserv +++| DO # FIND TERMINATOR # 01413 M00S01389.sxserv +++| BEGIN 01414 M00S01390.sxserv +++| IF C<I,1>DFMSG EQ TERMCHAR 01415 M00S01391.sxserv +++| THEN 01416 M00S01392.sxserv +++| BEGIN 01417 M00S01393.sxserv +++| CP = I; 01418 M00S01394.sxserv +++| END 01419 M00S01395.sxserv +++| 01420 M00S01396.sxserv +++| END 01421 M00S01397.sxserv +++| 01422 M00S01398.sxserv +++| IF CP NQ 0 01423 M00S01399.sxserv +++| THEN # ZERO FILL END OF MESSAGE # 01424 M00S01400.sxserv +++| BEGIN 01425 M00S01401.sxserv +++| B<CP*6,(40-CP)*6>DFMSG = 0; 01426 M00S01402.sxserv +++| END 01427 M00S01403.sxserv +++| 01428 M00S01404.sxserv +++| MESSAGE(DFMSG,OP); # ISSUE MESSAGE # 01429 M00S01405.sxserv +++| RETURN; 01430 M00S01406.sxserv +++| END # MSG # 01431 M00S01407.sxserv +++| 01432 M00S01408.sxserv +++| TERM 01433 M00S01409.sxserv +++|PROC REQBS((ORD),ACQFLAG); 01434 M00S01410.sxserv +++| 01435 M00S01411.sxserv +++|# TITLE REQBS - REQUEST LARGE BUFFER SPACE. # 01436 M00S01412.sxserv +++| 01437 M00S01413.sxserv +++| BEGIN # REQBS # 01438 M00S01414.sxserv +++| 01439 M00S01415.sxserv +++|# 01440 M00S01416.sxserv +++|** REQBS - REQUEST LARGE BUFFER SPACE. 01441 M00S01417.sxserv +++|* 01442 M00S01418.sxserv +++|* *REQBS* REQUESTS ADDITIONAL MEMORY FOR A LARGE BUFFER. 01443 M00S01419.sxserv +++|* 01444 M00S01420.sxserv +++|* PROC REQBS((ORD),ACQFLAG) 01445 M00S01421.sxserv +++|* 01446 M00S01422.sxserv +++|* ENTRY (ORD) - ORDINAL OF *BST* ENTRY. 01447 M00S01423.sxserv +++|* 01448 M00S01424.sxserv +++|* EXIT (ACQFLAG) - BUFFER ACQUIRED FLAG. 01449 M00S01425.sxserv +++|* = TRUE, BUFFER SPACE ACQUIRED. 01450 M00S01426.sxserv +++|* = FALSE, MEMORY NOT AVAILABLE. 01451 M00S01427.sxserv +++|* IF THE BUFFER SPACE IS ACQUIRED, THE ADDRESSES OF THE 01452 M00S01428.sxserv +++|* COPY CONTROL BLOCK, MSF FET, DISK FET, LABEL BUFFER 01453 M00S01429.sxserv +++|* AND DATA BUFFER (WHICH MAKE UP THE LARGE BUFFER SPACE) 01454 M00S01430.sxserv +++|* ARE STORED IN THE *BST* ENTRY. 01455 M00S01431.sxserv +++|* 01456 M00S01432.sxserv +++|* MESSAGES *STF1, NNNNNN.*. 01457 M00S01433.sxserv +++|# 01458 M00S01434.sxserv +++| 01459 M00S01435.sxserv +++| ITEM ORD I; # ORDINAL OF *BST* ENTRY # 01460 M00S01436.sxserv +++| ITEM ACQFLAG B; # BUFFER ACQUIRED FLAG # 01461 M00S01437.sxserv +++| 01462 M00S01438.sxserv +++|# 01463 M00S01439.sxserv +++|**** PROC REQBS - XREF LIST BEGIN. 01464 M00S01440.sxserv +++|# 01465 M00S01441.sxserv +++| 01466 M00S01442.sxserv +++| XREF 01467 M00S01443.sxserv +++| BEGIN 01468 M00S01444.sxserv +++| PROC MNGMEM; # MANAGE MEMORY # 01469 M00S01445.sxserv +++| PROC MSG; # ISSUE MESSAGE # 01470 M00S01446.sxserv +++| FUNC XCDD C(10); # CONVERT TO DISPLAY CODE # 01471 M00S01447.sxserv +++| END 01472 M00S01448.sxserv +++| 01473 M00S01449.sxserv +++|# 01474 M00S01450.sxserv +++|**** PROC REQBS - XREF LIST END. 01475 M00S01451.sxserv +++|# 01476 M00S01452.sxserv +++| 01477 M00S01453.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01478 M00S01454.sxserv +++|*CALL,COMBFAS 01479 M00S01455.sxserv +++|*CALL,COMBLBL 01480 M00S01456.sxserv +++|*CALL,COMXACM 01481 M00S01457.sxserv +++|*CALL,COMXBST 01482 M00S01458.sxserv +++|*CALL,COMXCCB 01483 M00S01459.sxserv +++|*CALL,COMXCTF 01484 M00S01460.sxserv +++|*CALL,COMXJCA 01485 M00S01461.sxserv +++|*CALL,COMXMSC 01486 M00S01462.sxserv +++| 01487 M00S01463.sxserv +++| ITEM BUFADR U; # BUFFER ADDRESS # 01488 M00S01464.sxserv +++| ITEM DC$FL C(10); # DISPLAY CODED FIELD LENGTH # 01489 M00S01465.sxserv +++| ITEM LBUFLEN I; # LARGE BUFFER SPACE LENGTH # 01490 M00S01466.sxserv +++| CONTROL EJECT; 01491 M00S01467.sxserv +++| 01492 M00S01468.sxserv +++| LBUFLEN = CCBLEN + RFETL + RFHBL + DATABL; 01493 M00S01469.sxserv +++| MNGMEM(LBUFLEN,BUFADR); # GET ADDITIONAL FIELD LENGTH # 01494 M00S01470.sxserv +++| IF BUFADR EQ 0 01495 M00S01471.sxserv +++| THEN # IF REQUEST DENIED # 01496 M00S01472.sxserv +++| BEGIN 01497 M00S01473.sxserv +++| ACQFLAG = FALSE; # NO BUFFER SPACE AVAILABLE # 01498 M00S01474.sxserv +++| RETURN; 01499 M00S01475.sxserv +++| END 01500 M00S01476.sxserv +++| 01501 M00S01477.sxserv +++| BST$CCB[ORD] = BUFADR; # STORE LOCATIONS IN ENTRY # 01502 M00S01478.sxserv +++| BST$DISKF[ORD] = BUFADR + CCBLEN; 01503 M00S01479.sxserv +++| BST$M86F[ORD] = BST$DISKF[ORD] + RFETL; 01504 M00S01480.sxserv +++| BST$DATA[ORD] = BST$M86F[ORD] + RFHBL; 01505 M00S01481.sxserv +++| BST$ACQD[ORD] = TRUE; 01506 M00S01482.sxserv +++| ACQFLAG = TRUE; # BUFFER SPACE ACQUIRED # 01507 M00S01483.sxserv +++| RETURN; 01508 M00S01484.sxserv +++| END # REQBS # 01509 M00S01485.sxserv +++| 01510 M00S01486.sxserv +++| TERM 01511 M00S01487.sxserv +++|PROC RLSBUF((REQADR)); 01512 M00S01488.sxserv +++| 01513 M00S01489.sxserv +++|# TITLE RLSBUF - RELEASE LARGE BUFFER. # 01514 M00S01490.sxserv +++| 01515 M00S01491.sxserv +++| BEGIN # RLSBUF # 01516 M00S01492.sxserv +++| 01517 M00S01493.sxserv +++|# 01518 M00S01494.sxserv +++|** RLSBUF - RELEASE LARGE BUFFER. 01519 M00S01495.sxserv +++|* 01520 M00S01496.sxserv +++|* *RLSBUF* ALLOWS THE CALLER TO RELINQUISH CONTROL OF A LARGE 01521 M00S01497.sxserv +++|* BUFFER AND CALLS *GOBUF* TO ASSIGN ANY AVAILABLE BUFFERS TO 01522 M00S01498.sxserv +++|* WAITING *HLRQ*/*LLRQ* PROCESSES. 01523 M00S01499.sxserv +++|* 01524 M00S01500.sxserv +++|* PROC RLSBUF((REQADR)) 01525 M00S01501.sxserv +++|* 01526 M00S01502.sxserv +++|* ENTRY (REQADR) - ADDRESS OF REQUEST QUEUE ENTRY. 01527 M00S01503.sxserv +++|* 01528 M00S01504.sxserv +++|* EXIT IF A *BST* ENTRY CONTROLLED BY *REQADR* IS FOUND, THE 01529 M00S01505.sxserv +++|* ENTRY IS MARKED AVAILABLE AND THE *GLBRTRNB* FLAG IS 01530 M00S01506.sxserv +++|* SET. 01531 M00S01507.sxserv +++|# 01532 M00S01508.sxserv +++| 01533 M00S01509.sxserv +++| ITEM REQADR U; # REQUEST QUEUE ENTRY ADDRESS # 01534 M00S01510.sxserv +++| 01535 M00S01511.sxserv +++|# 01536 M00S01512.sxserv +++|**** PROC RLSBUF - XREF LIST BEGIN. 01537 M00S01513.sxserv +++|# 01538 M00S01514.sxserv +++| 01539 M00S01515.sxserv +++| XREF 01540 M00S01516.sxserv +++| BEGIN 01541 M00S01517.sxserv +++| PROC GOBUF; # ASSIGN AVAILABLE BUFFERS # 01542 M00S01518.sxserv +++| END 01543 M00S01519.sxserv +++| 01544 M00S01520.sxserv +++|# 01545 M00S01521.sxserv +++|**** PROC RLSBUF - XREF LIST END. 01546 M00S01522.sxserv +++|# 01547 M00S01523.sxserv +++| 01548 M00S01524.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01549 M00S01525.sxserv +++|*CALL,COMBFAS 01550 M00S01526.sxserv +++|*CALL,COMXBST 01551 M00S01527.sxserv +++|*CALL,COMXCTF 01552 M00S01528.sxserv +++| 01553 M00S01529.sxserv +++| ITEM I I; # LOOP VARIABLE # 01554 M00S01530.sxserv +++| CONTROL EJECT; 01555 M00S01531.sxserv +++| 01556 M00S01532.sxserv +++| SLOWFOR I = 1 STEP 1 WHILE I LQ BSTL 01557 M00S01533.sxserv +++| DO 01558 M00S01534.sxserv +++| BEGIN # FIND ENTRY TO BE RELEASED # 01559 M00S01535.sxserv +++| IF BST$REQA[I] EQ REQADR 01560 M00S01536.sxserv +++| THEN 01561 M00S01537.sxserv +++| BEGIN 01562 M00S01538.sxserv +++| BST$REQA[I] = 0; # SET BUFFER AVAILABLE # 01563 M00S01539.sxserv +++| BST$BUSY[I] = FALSE; 01564 M00S01540.sxserv +++| GOBUF; 01565 M00S01541.sxserv +++| GLBRTRNB = TRUE; 01566 M00S01542.sxserv +++| RETURN; 01567 M00S01543.sxserv +++| END 01568 M00S01544.sxserv +++| 01569 M00S01545.sxserv +++| END # FIND ENTRY TO BE RELEASED # 01570 M00S01546.sxserv +++| 01571 M00S01547.sxserv +++| RETURN; 01572 M00S01548.sxserv +++| END # RLSBUF # 01573 M00S01549.sxserv +++| 01574 M00S01550.sxserv +++| TERM 01575 M00S01551.sxserv +++|PROC RLSVOL(HLRQADR,FCTADR,VOLAU,VOLLN); 01576 M00S01552.sxserv +++| 01577 M00S01553.sxserv +++|# TITLE RLSVOL - RELEASE UNUSED AU. # 01578 M00S01554.sxserv +++| 01579 M00S01555.sxserv +++| BEGIN # RLSVOL # 01580 M00S01556.sxserv +++| 01581 M00S01557.sxserv +++|# 01582 M00S01558.sxserv +++|** RLSVOL - RELEASE UNUSED AU. 01583 M00S01559.sxserv +++|* 01584 M00S01560.sxserv +++|* THIS PROCEDURE UPDATES AN *FCT* ENTRY TO MAKE THE 01585 M00S01561.sxserv +++|* INDICATED AU AVAILABLE FOR RE-ALLOCATION. *RLSVOL* 01586 M00S01562.sxserv +++|* WILL CREATE THESE AU INTO ONE VOLUME AND LINK THIS 01587 M00S01563.sxserv +++|* VOLUME INTO THE CORRECT CHAIN OF FREE AU. 01588 M00S01564.sxserv +++|* 01589 M00S01565.sxserv +++|* RLSVOL(HLRQADR,FCTADR,VOLAU,VOLLN) 01590 M00S01566.sxserv +++|* 01591 M00S01567.sxserv +++|* ENTRY (HLRQADR) - ADDRESS OF *HLRQ* ENTRY. 01592 M00S01568.sxserv +++|* (FCTADR) - ADDRESS OF *FCT* ENTRY. 01593 M00S01569.sxserv +++|* (VOLAU) - FIRST AU OF THE VOLUME TO BE 01594 M00S01570.sxserv +++|* MADE AVAILABLE FOR REUSE. 01595 M00S01571.sxserv +++|* (VOLLN) - LENGTH OF THE VOLUME TO BE RELEASED. 01596 M00S01572.sxserv +++|* (ZERO OR NEGATIVE IS LEGAL) 01597 M00S01573.sxserv +++|* 01598 M00S01574.sxserv +++|* EXIT - THE CORRECT (LONG OR SHORT FILE) CHAIN 01599 M00S01575.sxserv +++|* OF VOLUMES AVAILABLE FOR ALLOCATION 01600 M00S01576.sxserv +++|* IS UPDATED TO INCLUDE THIS VOLUME. 01601 M00S01577.sxserv +++|# 01602 M00S01578.sxserv +++| 01603 M00S01579.sxserv +++| ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # 01604 M00S01580.sxserv +++| ITEM FCTADR U; # ADDRESS OF *FCT* ENTRY # 01605 M00S01581.sxserv +++| ITEM VOLAU U; # INDEX OF FIRST AU OF THE VOLUME 01606 M00S01582.sxserv +++| # 01607 M00S01583.sxserv +++| ITEM VOLLN I; # LENGTH OF THE VOLUME # 01608 M00S01584.sxserv +++| 01609 M00S01585.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01610 M00S01586.sxserv +++|*CALL,COMBFAS 01611 M00S01587.sxserv +++|*CALL,COMBMCT 01612 M00S01588.sxserv +++|*CALL,COMXFCQ 01613 M00S01589.sxserv +++|*CALL,COMXHLR 01614 M00S01590.sxserv +++| 01615 M00S01591.sxserv +++| ITEM CAUF U; # CONTINUATION AU FIELD VALUE # 01616 M00S01592.sxserv +++| ITEM I I; # LOOP INDEX # 01617 M00S01593.sxserv +++| ITEM LINK U; # VALUE OF LINK FIELD # 01618 M00S01594.sxserv +++| ITEM NOTYET B; # LOOP TERMINATOR # 01619 M00S01595.sxserv +++| ITEM PREV U; # LINK FIELD OF PREVIOUS CHAIN 01620 M00S01596.sxserv +++| ELEMENT # 01621 M00S01597.sxserv +++| ITEM PREVLN U; # LENGTH OF PREVIOUS VOLUME # 01622 M00S01598.sxserv +++| CONTROL EJECT; 01623 M00S01599.sxserv +++| P<FCT> = FCTADR + FCTQHL; 01624 M00S01600.sxserv +++| P<HLRQ> = HLRQADR; 01625 M00S01601.sxserv +++| 01626 M00S01602.sxserv +++| IF VOLLN LQ 0 01627 M00S01603.sxserv +++| THEN # NO-OP CALL # 01628 M00S01604.sxserv +++| BEGIN 01629 M00S01605.sxserv +++| RETURN; 01630 M00S01606.sxserv +++| END 01631 M00S01607.sxserv +++| 01632 M00S01608.sxserv +++|# 01633 M00S01609.sxserv +++|* INITIALIZE FOR SEARCH OF FREE VOLUME CHAIN. 01634 M00S01610.sxserv +++|# 01635 M00S01611.sxserv +++| 01636 M00S01612.sxserv +++| IF VOLAU LS FCT$CDP[0] 01637 M00S01613.sxserv +++| THEN # USE SHORT FILE CHAIN # 01638 M00S01614.sxserv +++| BEGIN 01639 M00S01615.sxserv +++| LINK = FCT$FAUSF[0]; 01640 M00S01616.sxserv +++| END 01641 M00S01617.sxserv +++| 01642 M00S01618.sxserv +++| ELSE # USE LONG FILE CHAIN # 01643 M00S01619.sxserv +++| BEGIN 01644 M00S01620.sxserv +++| LINK = FCT$FAULF[0]; 01645 M00S01621.sxserv +++| END 01646 M00S01622.sxserv +++| 01647 M00S01623.sxserv +++| PREV = 0; 01648 M00S01624.sxserv +++| 01649 M00S01625.sxserv +++|# 01650 M00S01626.sxserv +++|* SEARCH FREE VOLUME CHAIN TO DETERMINE WHERE TO ADD THIS VOLUME. 01651 M00S01627.sxserv +++|# 01652 M00S01628.sxserv +++| 01653 M00S01629.sxserv +++| NOTYET = TRUE; 01654 M00S01630.sxserv +++| FOR I = 0 STEP 1 WHILE NOTYET 01655 M00S01631.sxserv +++| DO 01656 M00S01632.sxserv +++| BEGIN 01657 M00S01633.sxserv +++| IF (LINK NQ 0) # NOT END OF CHAIN # 01658 M00S01634.sxserv +++| AND (LINK LS VOLAU) # NOT BEFORE THIS VOLUME # 01659 M00S01635.sxserv +++| THEN # TRY THE NEXT FREE VOLUME # 01660 M00S01636.sxserv +++| BEGIN 01661 M00S01637.sxserv +++| PREV = LINK; 01662 M00S01638.sxserv +++| SETFCTX(LINK); 01663 M00S01639.sxserv +++| PREVLN = FCT$LEN(FWD,FPS); 01664 M00S01640.sxserv +++| LINK = FCT$LINK(FWD,FPS); 01665 M00S01641.sxserv +++| TEST I; 01666 M00S01642.sxserv +++| END 01667 M00S01643.sxserv +++| 01668 M00S01644.sxserv +++| NOTYET = FALSE; # TERMINATE SEARCH LOOP # 01669 M00S01645.sxserv +++| END 01670 M00S01646.sxserv +++| 01671 M00S01647.sxserv +++|# 01672 M00S01648.sxserv +++|* VERIFY THAT THE NEW VOLUME DOES NOT INCLUDE ANY AU BELONGING 01673 M00S01649.sxserv +++|* TO EITHER OF THE VOLUMES BETWEEN WHICH IT IS TO BE LINKED. 01674 M00S01650.sxserv +++|# 01675 M00S01651.sxserv +++| 01676 M00S01652.sxserv +++| IF # NEW VOLUME OVERLAPS NEXT ONE # 01677 M00S01653.sxserv +++| (( LINK NQ 0) ## 01678 M00S01654.sxserv +++| AND (VOLAU+VOLLN GR LINK)) ## 01679 M00S01655.sxserv +++| OR # PREVIOUS VOLUME OVERLAPS NEW ONE 01680 M00S01656.sxserv +++| # 01681 M00S01657.sxserv +++| ((PREV NQ 0) ## 01682 M00S01658.sxserv +++| AND (PREV+PREVLN GR VOLAU)) 01683 M00S01659.sxserv +++| THEN # DO NOT ADD IN THE NEW VOLUME # 01684 M00S01660.sxserv +++| BEGIN 01685 M00S01661.sxserv +++| RETURN; 01686 M00S01662.sxserv +++| END 01687 M00S01663.sxserv +++| 01688 M00S01664.sxserv +++|# 01689 M00S01665.sxserv +++|* INITIALIZE NEW VOLUME ELEMENTS AND 01690 M00S01666.sxserv +++|* INSERT NEW VOLUME INTO CHAIN AT THIS SPOT. 01691 M00S01667.sxserv +++|# 01692 M00S01668.sxserv +++| 01693 M00S01669.sxserv +++| CAUF = 0; # FIRST CAUF FIELD = 0 # 01694 M00S01670.sxserv +++| 01695 M00S01671.sxserv +++| FOR I = 0 STEP 1 UNTIL VOLLN-1 01696 M00S01672.sxserv +++| DO 01697 M00S01673.sxserv +++| BEGIN 01698 M00S01674.sxserv +++| SETFCTX(VOLAU+I); # DEFINE *FWD* AND *FPS* # 01699 M00S01675.sxserv +++| 01700 M00S01676.sxserv +++| FCT$CLFG(FWD,FPS) = 0; 01701 M00S01677.sxserv +++| FCT$CAUF(FWD,FPS) = CAUF; 01702 M00S01678.sxserv +++| FCT$LEN(FWD,FPS) = VOLLN-I-1; 01703 M00S01679.sxserv +++| FCT$LINK(FWD,FPS) = LINK; 01704 M00S01680.sxserv +++| 01705 M00S01681.sxserv +++| LINK = VOLAU; 01706 M00S01682.sxserv +++| CAUF = 1; # REMAINING CAUF FIELDS = 1 # 01707 M00S01683.sxserv +++| END 01708 M00S01684.sxserv +++| 01709 M00S01685.sxserv +++| IF PREV NQ 0 01710 M00S01686.sxserv +++| THEN # LINK PREVIOUS VOLUME TO NEW 01711 M00S01687.sxserv +++| VOLUME # 01712 M00S01688.sxserv +++| BEGIN 01713 M00S01689.sxserv +++| SETFCTX(PREV); 01714 M00S01690.sxserv +++| FCT$LINK(FWD,FPS) = VOLAU; 01715 M00S01691.sxserv +++| END 01716 M00S01692.sxserv +++| 01717 M00S01693.sxserv +++| ELSE # UPDATE HEAD OF CORRECT CHAIN TO 01718 M00S01694.sxserv +++| POINT TO NEW VOLUME # 01719 M00S01695.sxserv +++| BEGIN 01720 M00S01696.sxserv +++| IF VOLAU LS FCT$CDP[0] 01721 M00S01697.sxserv +++| THEN # UPDATE SHORT FILE POINTER # 01722 M00S01698.sxserv +++| BEGIN 01723 M00S01699.sxserv +++| FCT$FAUSF[0] = VOLAU; 01724 M00S01700.sxserv +++| END 01725 M00S01701.sxserv +++| 01726 M00S01702.sxserv +++| ELSE # UPDATE LONG FILE POINTER # 01727 M00S01703.sxserv +++| BEGIN 01728 M00S01704.sxserv +++| FCT$FAULF[0] = VOLAU; 01729 M00S01705.sxserv +++| END 01730 M00S01706.sxserv +++| 01731 M00S01707.sxserv +++| END 01732 M00S01708.sxserv +++| 01733 M00S01709.sxserv +++| IF HLRQADR NQ 0 01734 M00S01710.sxserv +++| THEN # UPDATE AVAILABLE AU LEFT ON 01735 M00S01711.sxserv +++| CARTRIDGE # 01736 M00S01712.sxserv +++| BEGIN 01737 M00S01713.sxserv +++| IF HLR$SH[0] 01738 M00S01714.sxserv +++| THEN 01739 M00S01715.sxserv +++| BEGIN 01740 M00S01716.sxserv +++| HLR$AUSF[0] = HLR$AUSF[0] + VOLLN; 01741 M00S01717.sxserv +++| END 01742 M00S01718.sxserv +++| 01743 M00S01719.sxserv +++| ELSE 01744 M00S01720.sxserv +++| BEGIN 01745 M00S01721.sxserv +++| HLR$AULF[0] = HLR$AULF[0] + VOLLN; 01746 M00S01722.sxserv +++| END 01747 M00S01723.sxserv +++| 01748 M00S01724.sxserv +++| END 01749 M00S01725.sxserv +++| 01750 M00S01726.sxserv +++| RETURN; 01751 M00S01727.sxserv +++| END # RLSVOL # 01752 M00S01728.sxserv +++| 01753 M00S01729.sxserv +++| TERM 01754 M00S01730.sxserv +++|PROC RLS$FCT(FCTQADDR,(REQADDR),RSTATUS); 01755 M00S01731.sxserv +++| 01756 M00S01732.sxserv +++|# TITLE RLS$FCT - RELEASE AN *FCTQ* ENTRY. # 01757 M00S01733.sxserv +++| 01758 M00S01734.sxserv +++| BEGIN # RLS$FCT # 01759 M00S01735.sxserv +++| 01760 M00S01736.sxserv +++|# 01761 M00S01737.sxserv +++|** RLS$FCT - RELEASE AN *FCTQ* ENTRY. 01762 M00S01738.sxserv +++|* 01763 M00S01739.sxserv +++|* *RLS$FCT* RELEASES AN *FCT* ENTRY WHEN IT IS NO LONGER 01764 M00S01740.sxserv +++|* NEEDED BY A PROCESS. 01765 M00S01741.sxserv +++|* 01766 M00S01742.sxserv +++|* PROC RLS$FCT(FCTQADDR,(REQADDR),RSTATUS) 01767 M00S01743.sxserv +++|* 01768 M00S01744.sxserv +++|* ENTRY (FCTQADDR) - ADDRESS OF *FCTQ* ENTRY TO BE RELEASED. 01769 M00S01745.sxserv +++|* (REQADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. 01770 M00S01746.sxserv +++|* 01771 M00S01747.sxserv +++|* EXIT (RSTATUS) - *CPUTFCT* ERROR STATUS (DEFINED IN 01772 M00S01748.sxserv +++|* PROC *CPUTFCT* IN DECK *CATACC*). 01773 M00S01749.sxserv +++|* 01774 M00S01750.sxserv +++|* NOTES *FCTQADDR* WILL BE ZERO UPON RETURN FROM THIS 01775 M00S01751.sxserv +++|* PROCEDURE PROVIDING THE *FCTQ* ENTRY WAS FOUND AND 01776 M00S01752.sxserv +++|* THE USER COUNT DECREMENTED. 01777 M00S01753.sxserv +++|* 01778 M00S01754.sxserv +++|* IF THE CATALOG IS INTERLOCKED AND IF *REQADDR* IS 01779 M00S01755.sxserv +++|* NONZERO, *CGETFCT* WILL PUT THE *HLRQ* ENTRY ON THE 01780 M00S01756.sxserv +++|* "WAITING-FOR-CATALOG-INTERLOCK" CHAIN. 01781 M00S01757.sxserv +++|# 01782 M00S01758.sxserv +++| 01783 M00S01759.sxserv +++| ITEM FCTQADDR U; # *FCTQ* ADDRESS TO BE RELEASED # 01784 M00S01760.sxserv +++| ITEM REQADDR U; # *HLRQ* REQUEST ADDRESS # 01785 M00S01761.sxserv +++| ITEM RSTATUS U; # *CPUTFCT* ERROR STATUS # 01786 M00S01762.sxserv +++| 01787 M00S01763.sxserv +++|# 01788 M00S01764.sxserv +++|**** PROC RLS$FCT - XREF LIST BEGIN. 01789 M00S01765.sxserv +++|# 01790 M00S01766.sxserv +++| 01791 M00S01767.sxserv +++| XREF 01792 M00S01768.sxserv +++| BEGIN 01793 M00S01769.sxserv +++| PROC ABORT; # ABORT # 01794 M00S01770.sxserv +++| PROC ADD$LNK; # ADD ENTRY TO CHAIN # 01795 M00S01771.sxserv +++| PROC CPUTFCT; # PUT AN *FCT* ENTRY # 01796 M00S01772.sxserv +++| PROC DEL$LNK; # DELETE ENTRY FROM CHAIN # 01797 M00S01773.sxserv +++| PROC MESSAGE; # INTERFACE TO *MESSAGE* MACRO # 01798 M00S01774.sxserv +++| PROC ZFILL; # ZERO FILL BUFFER # 01799 M00S01775.sxserv +++| END 01800 M00S01776.sxserv +++| 01801 M00S01777.sxserv +++|# 01802 M00S01778.sxserv +++|**** PROC RLS$FCT - XREF LIST END. 01803 M00S01779.sxserv +++|# 01804 M00S01780.sxserv +++| 01805 M00S01781.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01806 M00S01782.sxserv +++|*CALL,COMBFAS 01807 M00S01783.sxserv +++|*CALL,COMBCHN 01808 M00S01784.sxserv +++|*CALL,COMBMCT 01809 M00S01785.sxserv +++|*CALL,COMXFCQ 01810 M00S01786.sxserv +++|*CALL,COMXMSC 01811 M00S01787.sxserv +++| CONTROL EJECT; 01812 M00S01788.sxserv +++| 01813 M00S01789.sxserv +++| RSTATUS = 0; 01814 M00S01790.sxserv +++| 01815 M00S01791.sxserv +++|# 01816 M00S01792.sxserv +++|* IF THERE IS NO *FCTQ* ENTRY TO RELEASE, RETURN TO CALLER. 01817 M00S01793.sxserv +++|# 01818 M00S01794.sxserv +++| 01819 M00S01795.sxserv +++| IF FCTQADDR EQ 0 01820 M00S01796.sxserv +++| THEN 01821 M00S01797.sxserv +++| BEGIN 01822 M00S01798.sxserv +++| RETURN; 01823 M00S01799.sxserv +++| END 01824 M00S01800.sxserv +++| 01825 M00S01801.sxserv +++| IF CHN$BOC[LCHN"FCT$ACT"] EQ 0 01826 M00S01802.sxserv +++| THEN # NO *FCTQ* ENTRIES # 01827 M00S01803.sxserv +++| BEGIN 01828 M00S01804.sxserv +++| FE$RTN[0] = "RLS$FCT."; 01829 M00S01805.sxserv +++| MESSAGE(FEMSG[0],UDFL1); 01830 M00S01806.sxserv +++| ABORT; 01831 M00S01807.sxserv +++| END 01832 M00S01808.sxserv +++| 01833 M00S01809.sxserv +++|# 01834 M00S01810.sxserv +++|* UPDATE *FCT* WITH THE CONTENT OF THE *FCTQ* ENTRY. 01835 M00S01811.sxserv +++|# 01836 M00S01812.sxserv +++| 01837 M00S01813.sxserv +++| P<FCTQ> = FCTQADDR; 01838 M00S01814.sxserv +++| P<FCT> = FCTQADDR + FCTQHL; 01839 M00S01815.sxserv +++| CPUTFCT(FCTQFAMILY[0],FCTQSUBF[0],FCTQSMID[0],FCTQFCTORD[0], ## 01840 M00S01816.sxserv +++| P<FCT>,REQADDR,RSTATUS); 01841 M00S01817.sxserv +++| IF RSTATUS NQ 0 01842 M00S01818.sxserv +++| THEN 01843 M00S01819.sxserv +++| BEGIN 01844 M00S01820.sxserv +++| RETURN; 01845 M00S01821.sxserv +++| END 01846 M00S01822.sxserv +++| 01847 M00S01823.sxserv +++|# 01848 M00S01824.sxserv +++|* DO NOT DELETE THE *FCTQ* ENTRY IF THERE ARE STILL ACTIVE USERS. 01849 M00S01825.sxserv +++|# 01850 M00S01826.sxserv +++| 01851 M00S01827.sxserv +++| FCTQACTCNT[0] = FCTQACTCNT[0] - 1; 01852 M00S01828.sxserv +++| IF FCTQACTCNT[0] NQ 0 01853 M00S01829.sxserv +++| THEN 01854 M00S01830.sxserv +++| BEGIN 01855 M00S01831.sxserv +++| FCTQADDR = 0; 01856 M00S01832.sxserv +++| RETURN; 01857 M00S01833.sxserv +++| END 01858 M00S01834.sxserv +++| 01859 M00S01835.sxserv +++|# 01860 M00S01836.sxserv +++|* DELETE THE ENTRY FROM THE ACTIVE CHAIN. 01861 M00S01837.sxserv +++|# 01862 M00S01838.sxserv +++| 01863 M00S01839.sxserv +++| DEL$LNK(FCTQADDR,LCHN"FCT$ACT",0); 01864 M00S01840.sxserv +++| ZFILL(FCTQ[0],FCTQHL+FCTENTL); 01865 M00S01841.sxserv +++| 01866 M00S01842.sxserv +++|# 01867 M00S01843.sxserv +++|* MOVE THE DELETED ENTRY TO THE FREE SPACE CHAIN. 01868 M00S01844.sxserv +++|# 01869 M00S01845.sxserv +++| 01870 M00S01846.sxserv +++| ADD$LNK(FCTQADDR,LCHN"FCT$FRSPC",0); 01871 M00S01847.sxserv +++| P<FCTQ> = FCTQADDR; 01872 M00S01848.sxserv +++| FCTQADDR = 0; 01873 M00S01849.sxserv +++| RETURN; 01874 M00S01850.sxserv +++| END # RLS$FCT # 01875 M00S01851.sxserv +++| 01876 M00S01852.sxserv +++| TERM 01877 M00S01853.sxserv +++|PROC RMVBLNK(CHARBUF,(COUNT)); 01878 M00S01854.sxserv +++| 01879 M00S01855.sxserv +++|# TITLE RMVBLNK - REMOVE MULTIPLE BLANKS. # 01880 M00S01856.sxserv +++| 01881 M00S01857.sxserv +++| BEGIN # RMVBLNK # 01882 M00S01858.sxserv +++| 01883 M00S01859.sxserv +++|# 01884 M00S01860.sxserv +++|** RMVBLNK - REMOVE MULTIPLE BLANKS. 01885 M00S01861.sxserv +++|* 01886 M00S01862.sxserv +++|* *RMVBLNK* REPLACES STRINGS OF MULTIPLE BLANKS WITH A SINGLE 01887 M00S01863.sxserv +++|* BLANK AND REMOVES ALL BLANKS IMMEDIATELY PRECEEDING A COMMA 01888 M00S01864.sxserv +++|* OR A PERIOD. 01889 M00S01865.sxserv +++|* 01890 M00S01866.sxserv +++|* PROC RMVBLNK(CHARBUF,(COUNT)) 01891 M00S01867.sxserv +++|* 01892 M00S01868.sxserv +++|* ENTRY (CHARBUF) - CHARACTER STRING, LEFT JUSTIFIED, MAXIMUM 01893 M00S01869.sxserv +++|* OF 80 CHARACTERS. 01894 M00S01870.sxserv +++|* (COUNT) - NUMBER OF CHARACTERS. 01895 M00S01871.sxserv +++|* 01896 M00S01872.sxserv +++|* EXIT (CHARBUF) - CHARACTER STRING PASSED IN WITH EXCESS 01897 M00S01873.sxserv +++|* BLANKS REMOVED. 01898 M00S01874.sxserv +++|# 01899 M00S01875.sxserv +++| 01900 M00S01876.sxserv +++| ITEM CHARBUF C(80); # CHARACTER BUFFER # 01901 M00S01877.sxserv +++| ITEM COUNT I; # CHARACTER COUNT # 01902 M00S01878.sxserv +++| 01903 M00S01879.sxserv +++| DEF BLANK #" "#; # DISPLAY CODE BLANK # 01904 M00S01880.sxserv +++| DEF COMMA #","#; # DISPLAY CODE COMMA # 01905 M00S01881.sxserv +++| DEF PERIOD #"."#; # DISPLAY CODE PERIOD # 01906 M00S01882.sxserv +++| 01907 M00S01883.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01908 M00S01884.sxserv +++|*CALL,COMBFAS 01909 M00S01885.sxserv +++| 01910 M00S01886.sxserv +++| ITEM CHARPOS I; # CHARACTER POSITION # 01911 M00S01887.sxserv +++| ITEM I I; # LOOP COUNTER # 01912 M00S01888.sxserv +++| ITEM NEXTCHAR C(1); # NEXT CHARACTER # 01913 M00S01889.sxserv +++| ITEM TEMPBUF C(80); # TEMPORARY BUFFER # 01914 M00S01890.sxserv +++| CONTROL EJECT; 01915 M00S01891.sxserv +++| 01916 M00S01892.sxserv +++| TEMPBUF = CHARBUF; 01917 M00S01893.sxserv +++| C<0,COUNT>CHARBUF = BLANK; 01918 M00S01894.sxserv +++| CHARPOS = 0; 01919 M00S01895.sxserv +++| 01920 M00S01896.sxserv +++|# 01921 M00S01897.sxserv +++|* TRANSFER CHARACTERS, REMOVING MULTIPLE BLANKS. 01922 M00S01898.sxserv +++|# 01923 M00S01899.sxserv +++| 01924 M00S01900.sxserv +++| SLOWFOR I = 0 STEP 1 WHILE I LS COUNT 01925 M00S01901.sxserv +++| DO 01926 M00S01902.sxserv +++| BEGIN # TRANSFER # 01927 M00S01903.sxserv +++| NEXTCHAR = C<I+1,1>TEMPBUF; 01928 M00S01904.sxserv +++| IF C<I,1> TEMPBUF EQ BLANK ## 01929 M00S01905.sxserv +++| AND (NEXTCHAR EQ BLANK OR NEXTCHAR EQ COMMA ## 01930 M00S01906.sxserv +++| OR NEXTCHAR EQ PERIOD) AND I NQ COUNT-1 01931 M00S01907.sxserv +++| THEN 01932 M00S01908.sxserv +++| BEGIN 01933 M00S01909.sxserv +++| TEST I; # IGNORE MULTIPLE BLANKS # 01934 M00S01910.sxserv +++| END 01935 M00S01911.sxserv +++| 01936 M00S01912.sxserv +++| C<CHARPOS,1>CHARBUF = C<I,1>TEMPBUF; 01937 M00S01913.sxserv +++| CHARPOS = CHARPOS + 1; 01938 M00S01914.sxserv +++| END # TRANSFER # 01939 M00S01915.sxserv +++| 01940 M00S01916.sxserv +++| RETURN; 01941 M00S01917.sxserv +++| END # RMVBLNK # 01942 M00S01918.sxserv +++| 01943 M00S01919.sxserv +++| TERM 01944 M00S01920.sxserv +++|PROC RTRNBUF; 01945 M00S01921.sxserv +++| 01946 M00S01922.sxserv +++|# TITLE RTRNBUF - RETURN LARGE BUFFER SPACE. # 01947 M00S01923.sxserv +++| 01948 M00S01924.sxserv +++| BEGIN # RTRNBUF # 01949 M00S01925.sxserv +++| 01950 M00S01926.sxserv +++|# 01951 M00S01927.sxserv +++|** RTRNBUF - RETURN LARGE BUFFER SPACE. 01952 M00S01928.sxserv +++|* 01953 M00S01929.sxserv +++|* *RTRNBUF* RETURNS MEMORY OCCUPIED BY UNUSED BUFFERS TO REDUCE 01954 M00S01930.sxserv +++|* EXEC-S FIELD LENGTH. 01955 M00S01931.sxserv +++|* 01956 M00S01932.sxserv +++|* PROC RTRNBUF. 01957 M00S01933.sxserv +++|* 01958 M00S01934.sxserv +++|* EXIT (GLBRTRNB) - FALSE. 01959 M00S01935.sxserv +++|* THE ACQUIRED FLAG IS CLEARED IN *BST* ENTRIES WHOSE 01960 M00S01936.sxserv +++|* BUFFER SPACE IS RELEASED. 01961 M00S01937.sxserv +++|* 01962 M00S01938.sxserv +++|* MESSAGES *STF2, NNNNNN.*. 01963 M00S01939.sxserv +++|# 01964 M00S01940.sxserv +++| 01965 M00S01941.sxserv +++|# 01966 M00S01942.sxserv +++|**** PROC RTRNBUF - XREF LIST BEGIN. 01967 M00S01943.sxserv +++|# 01968 M00S01944.sxserv +++| 01969 M00S01945.sxserv +++| XREF 01970 M00S01946.sxserv +++| BEGIN 01971 M00S01947.sxserv +++| PROC MNGMEM; # MANAGE MEMORY # 01972 M00S01948.sxserv +++| PROC MSG; # ISSUE MESSAGE # 01973 M00S01949.sxserv +++| FUNC XCDD C(10); # CONVERT TO DISPLAY CODE # 01974 M00S01950.sxserv +++| END 01975 M00S01951.sxserv +++| 01976 M00S01952.sxserv +++|# 01977 M00S01953.sxserv +++|**** PROC RTRNBUF - XREF LIST END. 01978 M00S01954.sxserv +++|# 01979 M00S01955.sxserv +++| 01980 M00S01956.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 01981 M00S01957.sxserv +++|*CALL,COMBFAS 01982 M00S01958.sxserv +++|*CALL,COMBLBL 01983 M00S01959.sxserv +++|*CALL,COMXACM 01984 M00S01960.sxserv +++|*CALL,COMXBST 01985 M00S01961.sxserv +++|*CALL,COMXCCB 01986 M00S01962.sxserv +++|*CALL,COMXCTF 01987 M00S01963.sxserv +++|*CALL,COMXJCA 01988 M00S01964.sxserv +++|*CALL,COMXMSC 01989 M00S01965.sxserv +++| 01990 M00S01966.sxserv +++| ITEM COUNT I; # UNUSED BUFFER COUNT # 01991 M00S01967.sxserv +++| ITEM DC$FL C(10); # DISPLAY CODED FIELD LENGTH # 01992 M00S01968.sxserv +++| ITEM I I; # LOOP COUNTER # 01993 M00S01969.sxserv +++| ITEM REDUCEFL I; # FIELD LENGTH REDUCTION VALUE # 01994 M00S01970.sxserv +++| ITEM STAT I; # STATUS # 01995 M00S01971.sxserv +++| CONTROL EJECT; 01996 M00S01972.sxserv +++| 01997 M00S01973.sxserv +++| GLBRTRNB = FALSE; 01998 M00S01974.sxserv +++| COUNT = 0; 01999 M00S01975.sxserv +++| SLOWFOR I = BSTL STEP -1 WHILE I GR 0 AND NOT BST$BUSY[I] 02000 M00S01976.sxserv +++| DO # SEARCH *BST* FOR FREE ENTRIES # 02001 M00S01977.sxserv +++| BEGIN 02002 M00S01978.sxserv +++| IF BST$ACQD[I] 02003 M00S01979.sxserv +++| THEN 02004 M00S01980.sxserv +++| BEGIN 02005 M00S01981.sxserv +++| COUNT = COUNT + 1; # COUNT ACQUIRED, FREE ENTRIES # 02006 M00S01982.sxserv +++| END 02007 M00S01983.sxserv +++| 02008 M00S01984.sxserv +++| END 02009 M00S01985.sxserv +++| 02010 M00S01986.sxserv +++| IF COUNT EQ 0 02011 M00S01987.sxserv +++| THEN # NO BUFFER SPACE TO BE RELEASED # 02012 M00S01988.sxserv +++| BEGIN 02013 M00S01989.sxserv +++| RETURN; 02014 M00S01990.sxserv +++| END 02015 M00S01991.sxserv +++| 02016 M00S01992.sxserv +++| REDUCEFL = -(COUNT * (CCBLEN + (2 * RFETL) + DATABL + LABLEN)); 02017 M00S01993.sxserv +++| MNGMEM(REDUCEFL,STAT); 02018 M00S01994.sxserv +++| IF STAT NQ 0 02019 M00S01995.sxserv +++| THEN 02020 M00S01996.sxserv +++| BEGIN # MEMORY REDUCTION HONORED # 02021 M00S01997.sxserv +++| FASTFOR I = BSTL STEP -1 WHILE COUNT NQ 0 02022 M00S01998.sxserv +++| DO 02023 M00S01999.sxserv +++| BEGIN 02024 M00S02000.sxserv +++| IF BST$ACQD[I] 02025 M00S02001.sxserv +++| THEN 02026 M00S02002.sxserv +++| BEGIN 02027 M00S02003.sxserv +++| COUNT = COUNT - 1; 02028 M00S02004.sxserv +++| BST$ACQD[I] = FALSE; # CLEAR ACQUIRED FLAG # 02029 M00S02005.sxserv +++| END 02030 M00S02006.sxserv +++| 02031 M00S02007.sxserv +++| END 02032 M00S02008.sxserv +++| 02033 M00S02009.sxserv +++| END # MEMORY REDUCTION HONORED # 02034 M00S02010.sxserv +++| 02035 M00S02011.sxserv +++| RETURN; 02036 M00S02012.sxserv +++| END # RTRNBUF # 02037 M00S02013.sxserv +++| 02038 M00S02014.sxserv +++| TERM 02039 M00S02015.sxserv +++|PROC SETBSTE((REQADR),(REQIND),(ORD)); 02040 M00S02016.sxserv +++| 02041 M00S02017.sxserv +++|# TITLE SETBSTE - SET *BST* ENTRY BUSY. # 02042 M00S02018.sxserv +++| 02043 M00S02019.sxserv +++| BEGIN # SETBSTE # 02044 M00S02020.sxserv +++| 02045 M00S02021.sxserv +++|# 02046 M00S02022.sxserv +++|** SETBSTE - SET *BST* ENTRY BUSY. 02047 M00S02023.sxserv +++|* 02048 M00S02024.sxserv +++|* *SETBSTE* ASSIGNS THE SPECIFIED *BST* ENTRY TO A HIGH LEVEL/LOW 02049 M00S02025.sxserv +++|* LEVEL PROCESS AND RETURNS THE LOCATION OF THE LARGE BUFFER SPACE 02050 M00S02026.sxserv +++|* IN THE REQUEST QUEUE ENTRY. 02051 M00S02027.sxserv +++|* 02052 M00S02028.sxserv +++|* PROC SETBSTE((REQADR),(REQIND),(ORD)) 02053 M00S02029.sxserv +++|* 02054 M00S02030.sxserv +++|* ENTRY (REQADR) - ADDRESS OF HIGH LEVEL/LOW LEVEL REQUEST 02055 M00S02031.sxserv +++|* QUEUE ENTRY. 02056 M00S02032.sxserv +++|* (REQIND) - HIGH LEVEL/LOW LEVEL REQUEST INDICATOR. 02057 M00S02033.sxserv +++|* = TRUE, HIGH LEVEL REQUEST. 02058 M00S02034.sxserv +++|* = FALSE, LOW LEVEL REQUEST. 02059 M00S02035.sxserv +++|* (ORD) - *BST* ENTRY ORDINAL. 02060 M00S02036.sxserv +++|* 02061 M00S02037.sxserv +++|* EXIT (BST$REQA[ORD]) = (REQADR). 02062 M00S02038.sxserv +++|* (BST$BUSY[ORD]) = TRUE. 02063 M00S02039.sxserv +++|* IF THE REQUEST IS A HIGH LEVEL REQUEST, THE ADDRESSES 02064 M00S02040.sxserv +++|* OF THE COPY CONTROL BLOCK, MSF FET, DISK FET, LABEL 02065 M00S02041.sxserv +++|* BUFFER AND DATA BUFFER (WHICH MAKE UP THE LARGE 02066 M00S02042.sxserv +++|* BUFFER) ARE RETURNED IN THE *HLRQ* ENTRY. IF THE 02067 M00S02043.sxserv +++|* REQUEST IS A LOW LEVEL REQUEST, THE ADDRESSES OF THE 02068 M00S02044.sxserv +++|* MSF AND DISK FET-S ARE RETURNED IN THE *LLRQ* ENTRY 02069 M00S02045.sxserv +++|* AND THE FET-S ARE INITIALIZED (BUFFER POINTERS SET). 02070 M00S02046.sxserv +++|# 02071 M00S02047.sxserv +++| 02072 M00S02048.sxserv +++| ITEM REQADR U; # REQUEST ADDRESS # 02073 M00S02049.sxserv +++| ITEM REQIND B; # REQUEST TYPE INDICATOR # 02074 M00S02050.sxserv +++| ITEM ORD I; # *BST* ENTRY ORDINAL # 02075 M00S02051.sxserv +++| 02076 M00S02052.sxserv +++|# 02077 M00S02053.sxserv +++|**** PROC SETBSTE - XREF LIST BEGIN. 02078 M00S02054.sxserv +++|# 02079 M00S02055.sxserv +++| 02080 M00S02056.sxserv +++| XREF 02081 M00S02057.sxserv +++| BEGIN 02082 M00S02058.sxserv +++| PROC ZFILL; # ZERO FILL BUFFER # 02083 M00S02059.sxserv +++| PROC ZSETFET; # INITIALIZE A FET # 02084 M00S02060.sxserv +++| END 02085 M00S02061.sxserv +++| 02086 M00S02062.sxserv +++|# 02087 M00S02063.sxserv +++|**** PROC SETBSTE - XREF LIST END. 02088 M00S02064.sxserv +++|# 02089 M00S02065.sxserv +++| 02090 M00S02066.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 02091 M00S02067.sxserv +++|*CALL,COMBFAS 02092 M00S02068.sxserv +++|*CALL,COMBFET 02093 M00S02069.sxserv +++|*CALL,COMBLBL 02094 M00S02070.sxserv +++|*CALL,COMBLRQ 02095 M00S02071.sxserv +++|*CALL,COMXBST 02096 M00S02072.sxserv +++|*CALL,COMXCCB 02097 M00S02073.sxserv +++|*CALL,COMXHLR 02098 M00S02074.sxserv +++| 02099 M00S02075.sxserv +++| ITEM LENGTH I; # BUFFER SPACE LENGTH # 02100 M00S02076.sxserv +++| 02101 M00S02077.sxserv +++| BASED 02102 M00S02078.sxserv +++| ARRAY LBUF [0:0] P(1); ; # LARGE BUFFER SPACE # 02103 M00S02079.sxserv +++| CONTROL EJECT; 02104 M00S02080.sxserv +++| 02105 M00S02081.sxserv +++| BST$REQA[ORD] = REQADR; # SET *BST* ENTRY BUSY # 02106 M00S02082.sxserv +++| BST$BUSY[ORD] = TRUE; 02107 M00S02083.sxserv +++| P<LBUF> = BST$CCB[ORD]; # ZERO FILL BUFFER SPACE # 02108 M00S02084.sxserv +++| LENGTH = CCBLEN + RFETL + RFHBL + DATABL; 02109 M00S02085.sxserv +++| ZFILL(LBUF[0],LENGTH); 02110 M00S02086.sxserv +++| P<LLRQ> = REQADR; 02111 M00S02087.sxserv +++| 02112 M00S02088.sxserv +++| LLR$CCB[0] = BST$CCB[ORD]; 02113 M00S02089.sxserv +++| LLR$DSKFET[0] = BST$DISKF[ORD]; 02114 M00S02090.sxserv +++| LLR$MSFET[0] = BST$M86F[ORD]; 02115 M00S02091.sxserv +++| LLR$DA[0] = BST$DATA[ORD]; 02116 M00S02092.sxserv +++| 02117 M00S02093.sxserv +++| RETURN; 02118 M00S02094.sxserv +++| END # SETBSTE # 02119 M00S02095.sxserv +++| 02120 M00S02096.sxserv +++| TERM 02121 M00S02097.sxserv +++|PROC UASTPRM((FAM),(SFX),(SMX),(FCTADR),STAT); 02122 M00S02098.sxserv +++| 02123 M00S02099.sxserv +++|# TITLE UASTPRM - UPDATE *AST* AND PREAMBLE. # 02124 M00S02100.sxserv +++| 02125 M00S02101.sxserv +++| BEGIN # UASTPRM # 02126 M00S02102.sxserv +++| 02127 M00S02103.sxserv +++|# 02128 M00S02104.sxserv +++|** UASTPRM((FAM),(SFX),(SMX),(FCTADR),STAT). 02129 M00S02105.sxserv +++|* 02130 M00S02106.sxserv +++|* WHEN AN *FCT* ENTRY HAS BEEN UPDATED SUCH THAT ITS 02131 M00S02107.sxserv +++|* ALLOCATION STATUS HAS CHANGED (MORE OR FEWER AU AVAILABLE, 02132 M00S02108.sxserv +++|* CHANGE IN *OCL* OR USABILITY, ETE.), THIS ROUTINE IS 02133 M00S02109.sxserv +++|* CALLED TO UPDATE THE CORRESPONDING *AST* ENTRY AND THEN 02134 M00S02110.sxserv +++|* UPDATE THE PREAMBLE FOR THE ASSOCIATED STORAGE MODULE. 02135 M00S02111.sxserv +++|* 02136 M00S02112.sxserv +++|* ENTRY (FAM) - FAMILY NAME. 02137 M00S02113.sxserv +++|* (SFX) - SUBFAMILY INDEX. 02138 M00S02114.sxserv +++|* (SMX) - STORAGE MODULE INDEX. 02139 M00S02115.sxserv +++|* (FCTADR) - ADDRESS OF *FCT* ENTRY. 02140 M00S02116.sxserv +++|* =0 *AST* IS IN CORE ALREADY. 02141 M00S02117.sxserv +++|* 02142 M00S02118.sxserv +++|* EXIT (STAT) - STATUS. =0, IF NO ERRORS. 02143 M00S02119.sxserv +++|* AST - UPDATED ON DISK. 02144 M00S02120.sxserv +++|* PREAMBLE - UPDATED ON DISK AND IN MEMORY. 02145 M00S02121.sxserv +++|# 02146 M00S02122.sxserv +++| 02147 M00S02123.sxserv +++| ITEM FAM C(7); # FAMILY # 02148 M00S02124.sxserv +++| ITEM SFX U; # SUBFAMILY INDEX # 02149 M00S02125.sxserv +++| ITEM SMX U; # STORAGE MODULE INDEX # 02150 M00S02126.sxserv +++| ITEM FCTADR U; # ADDRESS OF *FCT* ENTRY # 02151 M00S02127.sxserv +++| ITEM STAT U; # REPLAY STATUS # 02152 M00S02128.sxserv +++| 02153 M00S02129.sxserv +++|# 02154 M00S02130.sxserv +++|**** PROC UASTPRM - XREF LIST BEGIN. 02155 M00S02131.sxserv +++|# 02156 M00S02132.sxserv +++| 02157 M00S02133.sxserv +++| XREF 02158 M00S02134.sxserv +++| BEGIN 02159 M00S02135.sxserv +++| PROC ANLZAST; # ANALYZE *AST* # 02160 M00S02136.sxserv +++| PROC CRDAST; # READ *AST* TO MEMORY # 02161 M00S02137.sxserv +++| PROC CWTAST; # WRITE *AST* BACK TO DISK # 02162 M00S02138.sxserv +++| PROC OCTSRCH; # OPEN CATALOG SEARCH # 02163 M00S02139.sxserv +++| END 02164 M00S02140.sxserv +++| 02165 M00S02141.sxserv +++|# 02166 M00S02142.sxserv +++|**** PROC UASTPRM - XREF LIST END. 02167 M00S02143.sxserv +++|# 02168 M00S02144.sxserv +++| 02169 M00S02145.sxserv +++| 02170 M00S02146.sxserv +++| DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # 02171 M00S02147.sxserv +++|*CALL,COMBFAS 02172 M00S02148.sxserv +++|*CALL,COMBCMD 02173 M00S02149.sxserv +++|*CALL,COMBCMS 02174 M00S02150.sxserv +++|*CALL,COMBMCT 02175 M00S02151.sxserv +++|*CALL,COMXFCQ 02176 M00S02152.sxserv +++|*CALL,COMXMSC 02177 M00S02153.sxserv +++| 02178 M00S02154.sxserv +++| 02179 M00S02155.sxserv +++| ITEM FCTLX U; # INDEX TO BEST CARTRIDGE FOR LONG 02180 M00S02156.sxserv +++| FILES # 02181 M00S02157.sxserv +++| ITEM FCTSX U; # INDEX TO BEST CARTRIDGE FOR 02182 M00S02158.sxserv +++| SHORT FILES # 02183 M00S02159.sxserv +++| ITEM GPLN U; # AU ON BEST GROUP # 02184 M00S02160.sxserv +++| ITEM I U; # LOOP INDEX # 02185 M00S02161.sxserv +++| ITEM J U; # LOOP INDEX # 02186 M00S02162.sxserv +++| ITEM LINK U; # INDEX OF NEXT VOLUME IN CHAIN # 02187 M00S02163.sxserv +++| ITEM PREV U; # PREVIOUS LINK VALUE # 02188 M00S02164.sxserv +++| ITEM TMP1 U; # TEMPORARY # 02189 M00S02165.sxserv +++| ITEM TOTAL U; # TOTAL AU AVAILABLE FOR 02190 M00S02166.sxserv +++| ALLOCATION # 02191 M00S02167.sxserv +++| 02192 M00S02168.sxserv +++| CONTROL EJECT; 02193 M00S02169.sxserv +++| 02194 M00S02170.sxserv +++|# 02195 M00S02171.sxserv +++|* LOCATE PREAMBLE AND READ IN *AST* (IF *FCTADR* NQ 0). 02196 M00S02172.sxserv +++|# 02197 M00S02173.sxserv +++| 02198 M00S02174.sxserv +++| OCTSRCH(FAM,SFX,TMP1,0,STAT); 02199 M00S02175.sxserv +++| IF STAT EQ CMASTAT"NOERR" AND FCTADR NQ 0 02200 M00S02176.sxserv +++| THEN 02201 M00S02177.sxserv +++| BEGIN 02202 M00S02178.sxserv +++| CRDAST(FAM,SFX,SMX,ASTBADR,0,STAT); 02203 M00S02179.sxserv +++| END 02204 M00S02180.sxserv +++| 02205 M00S02181.sxserv +++| IF STAT NQ CMASTAT"NOERR" 02206 M00S02182.sxserv +++| THEN 02207 M00S02183.sxserv +++| BEGIN 02208 M00S02184.sxserv +++| RETURN; 02209 M00S02185.sxserv +++| END 02210 M00S02186.sxserv +++| 02211 M00S02187.sxserv +++| P<AST> = ASTBADR; 02212 M00S02188.sxserv +++| P<PREAMBLE> = OCT$PRMA[TMP1]; 02213 M00S02189.sxserv +++| 02214 M00S02190.sxserv +++|# 02215 M00S02191.sxserv +++|* UPDATE *AST INFORMATION FOR CARTRIDGE. 02216 M00S02192.sxserv +++|# 02217 M00S02193.sxserv +++| 02218 M00S02194.sxserv +++| IF FCTADR NQ 0 02219 M00S02195.sxserv +++| THEN 02220 M00S02196.sxserv +++| BEGIN # *AST* UPDATE # 02221 M00S02197.sxserv +++| P<FCT> = FCTADR + FCTQHL; 02222 M00S02198.sxserv +++| TMP1 = FCT$ORD[0]; 02223 M00S02199.sxserv +++| FOR I = 1 STEP 1 UNTIL 2 02224 M00S02200.sxserv +++| DO 02225 M00S02201.sxserv +++| BEGIN # FREE SPACE CALCULATIONS # 02226 M00S02202.sxserv +++| IF I EQ 1 02227 M00S02203.sxserv +++| THEN 02228 M00S02204.sxserv +++| BEGIN 02229 M00S02205.sxserv +++| LINK = FCT$FAUSF[0]; 02230 M00S02206.sxserv +++| END 02231 M00S02207.sxserv +++| 02232 M00S02208.sxserv +++| ELSE 02233 M00S02209.sxserv +++| BEGIN 02234 M00S02210.sxserv +++| LINK = FCT$FAULF[0]; 02235 M00S02211.sxserv +++| AST$AUSF[TMP1] = TOTAL; 02236 M00S02212.sxserv +++| END 02237 M00S02213.sxserv +++| 02238 M00S02214.sxserv +++| TOTAL = 0; 02239 M00S02215.sxserv +++| PREV = 0; 02240 M00S02216.sxserv +++| SLOWFOR J = 0 WHILE LINK GR PREV 02241 M00S02217.sxserv +++| DO 02242 M00S02218.sxserv +++| BEGIN 02243 M00S02219.sxserv +++| SETFCTX(LINK); 02244 M00S02220.sxserv +++| TOTAL = TOTAL + FCT$LEN(FWD,FPS) + 1; 02245 M00S02221.sxserv +++| PREV = LINK; 02246 M00S02222.sxserv +++| LINK = FCT$LINK(FWD,FPS); 02247 M00S02223.sxserv +++| END 02248 M00S02224.sxserv +++| 02249 M00S02225.sxserv +++| END # FREE SPACE CALCULATIONS # 02250 M00S02226.sxserv +++| 02251 M00S02227.sxserv +++| AST$FLAWS[TMP1] = FCT$FLAWS[0]; 02252 M00S02228.sxserv +++| AST$AULF[TMP1] = TOTAL; 02253 M00S02229.sxserv +++| AST$NOCLF[TMP1] = FCT$OCLF[0] EQ 7; 02254 M00S02230.sxserv +++| AST$AAF[TMP1] = NOT ( FCT$IAF[0] ## 02255 M00S02231.sxserv +++| OR FCT$LCF[0] OR FCT$FCF[0] OR FCT$EEF[0]); 02256 M00S02232.sxserv +++| 02257 M00S02233.sxserv +++| END # *AST* UPDATE # 02258 M00S02234.sxserv +++| 02259 M00S02235.sxserv +++|# 02260 M00S02236.sxserv +++|* DETERMINE THE BEST CARTRIDGES AND GROUP FOR SHORT AND 02261 M00S02237.sxserv +++|* LONG FILES. ENTER AVAILABLE AU FOR EACH INTO *AST*. 02262 M00S02238.sxserv +++|# 02263 M00S02239.sxserv +++| 02264 M00S02240.sxserv +++| ANLZAST(SMX,999999,999999,FCTSX,FCTLX,TMP1,GPLN);
| Line S02241 Modification History | |
|---|---|
M01 (Removed by) | mse0037 |
Seq # *Modification Id* Act ----------------------------+ 02265 M01S02241.mse0037 ---| PRM$MXAUS[SMX] = AST$AUSF[FCTSX]; 02266 M01S02242.mse0037 ---| PRM$MXAUL[SMX] = AST$AULF[FCTLX];
| Line S00006 Modification History | |
|---|---|
M01 (Added by) | mse0037 |
Seq # *Modification Id* Act ----------------------------+ 02267 M01S00006.mse0037 +++| IF FCTSX EQ 0 02268 M01S00007.mse0037 +++| THEN 02269 M01S00008.mse0037 +++| BEGIN 02270 M01S00009.mse0037 +++| PRM$MXAUS[SMX] = 0; 02271 M01S00010.mse0037 +++| END 02272 M01S00011.mse0037 +++| ELSE 02273 M01S00012.mse0037 +++| BEGIN 02274 M01S00013.mse0037 +++| PRM$MXAUS[SMX] = AST$AUSF[FCTSX]; 02275 M01S00014.mse0037 +++| END
Proceed to Part 1
cdc/nos2.source/opl.opl871/deck/sxserv.txt · Last modified: by 127.0.0.1