User Tools

Site Tools


cdc:nos2.source:opl.opl871:deck:sxserv

Deck SXSERV

2 Modifications

Listing Sections

Source

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
Proceed to Part 1
cdc/nos2.source/opl.opl871/deck/sxserv.txt ยท Last modified: by 127.0.0.1