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