User Tools

Site Tools


Action unknown: copypageplugin__copy
cdc:nos2.source:opl.opl871:deck:sxserv

Deck SXSERV

Library Member Format: MODIFY

Listing Sections

Source

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