Retro1.org codex

PROC CALCTS; 
# TITLE CALCTS - CALCULATE TABLE SPACE.                               #
      BEGIN  # CALCTS #
 
#
**    CALCTS - CALCULATE TABLE SPACE.
*
*     THIS PROCEDURE WILL CALCULATE THE NUMBER OF ENTRIES AND THE SPACE
*     REQUIRED FOR EACH OF THE VARIABLE TABLES, AND STORE THE RESULTS
*     IN THE ARRAY *MAT*.
*
*     EXIT      TABLE CALCULATIONS COMPLETED.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBLBL
*CALL COMBLRQ
*CALL COMBMAT
*CALL COMBMCT
*CALL COMBTDM
*CALL COMBUDT
*CALL COMXBST
*CALL COMXCTF
*CALL COMXEXP
*CALL COMXFCQ
*CALL COMXHLR
*CALL,COMXIPR
*CALL COMXINT
*CALL COMXLTC
*CALL COMXMFD
*CALL COMXMSC
 
      ITEM TEMPCOUNT  U;             # TEMPORARY COUNT FIELD #
                                               CONTROL EJECT;
 
#
*     CALCULATES THE SPACE REQUIRED AND THE NUMBER OF ENTRIES FOR EACH
*     OF THE VARIABLE TABLES, AND STORES THE RESULTS IN THE ARRAY
*     *MAT*.
#
 
      TEMPCOUNT = Q+2;
 
      MAT$COUNT[MAT$ENTRY"HLRQ"] = TEMPCOUNT;
      MAT$SPACE[MAT$ENTRY"HLRQ"] = HLRQLEN * TEMPCOUNT;
 
 
      MAT$COUNT[MAT$ENTRY"LLRQ"] = TEMPCOUNT;
      MAT$SPACE[MAT$ENTRY"LLRQ"] = LLRQENTL * TEMPCOUNT;
 
      MAT$COUNT[MAT$ENTRY"RTRQ"] = Q * RTRQ$SPACE;
      MAT$SPACE[MAT$ENTRY"RTRQ"] = (TDAMLEN + 1) * (Q * RTRQ$SPACE);
 
      MAT$COUNT[MAT$ENTRY"FCTQ"] = Q;        # SET FCTQ FIELD #
      MAT$SPACE[MAT$ENTRY"FCTQ"] = (FCTQHL+FCTENTL) * Q;
 
      BSTL = MAXCTN * 2;
      MAT$COUNT[MAT$ENTRY"BST"] = BSTL;
      MAT$SPACE[MAT$ENTRY"BST"] = BSTENTL * BSTL;
 
      LTCTCNT = FAMCNT + 3;
      MAT$COUNT[MAT$ENTRY"LTCT"] = FAMCNT + 3;
      MAT$SPACE[MAT$ENTRY"LTCT"] = LTCL * (FAMCNT + 3);
 
      MAT$COUNT[MAT$ENTRY"MRFT"] = FAMCNT;
      MAT$SPACE[MAT$ENTRY"MRFT"] = MRFTLEN * FAMCNT;
 
      MAT$COUNT[MAT$ENTRY"OMT"] = MAXSM;
      MAT$SPACE[MAT$ENTRY"OMT"] = OMTENTL * MAXSM;
 
      MAT$COUNT[MAT$ENTRY"OCT"] = 8 * FAMCNT;
      MAT$SPACE[MAT$ENTRY"OCT"] = OCTENTL * 8 * FAMCNT;
 
      MAT$COUNT[MAT$ENTRY"PREAMBLE"] = 8 * FAMCNT;
      MAT$SPACE[MAT$ENTRY"PREAMBLE"] = PRMTLEN * 8 * FAMCNT * 3;
 
      MAT$COUNT[MAT$ENTRY"SCR$BUF"] = BSTL;
      MAT$SPACE[MAT$ENTRY"SCR$BUF"] = SCCBL * BSTL;
 
      MAT$COUNT[MAT$ENTRY"UDT$CONT"] = MAXCTN;
      MAT$SPACE[MAT$ENTRY"UDT$CONT"] = UDTCUL + 1;  # HEADER INCLUDED #
 
      MAT$COUNT[MAT$ENTRY"UDT$SM"] = MAXSMUNIT;
      MAT$SPACE[MAT$ENTRY"UDT$SM"] = UDTSML;
 
      MAT$COUNT[MAT$ENTRY"CAT$FET"] = 1;
      MAT$SPACE[MAT$ENTRY"CAT$FET"] = RFETL;
 
      MAT$COUNT[MAT$ENTRY"CAT$BUF"] = 1;
      MAT$SPACE[MAT$ENTRY"CAT$BUF"] = FCTBL;
 
      MAT$COUNT[MAT$ENTRY"MAP$FET"] = 1;
      MAT$SPACE[MAT$ENTRY"MAP$FET"] = RFETL;
 
      MAT$COUNT[MAT$ENTRY"MAP$BUF"] = 1;
      MAT$SPACE[MAT$ENTRY"MAP$BUF"] = MAPBUFL;
 
      MAT$COUNT[MAT$ENTRY"TEMP$FET"] = 1;
      MAT$SPACE[MAT$ENTRY"TEMP$FET"] = RFETL * 2;
 
      MAT$COUNT[MAT$ENTRY"TEMP$BUF"] = 1;
      MAT$SPACE[MAT$ENTRY"TEMP$BUF"] = TBUFL;
 
      MAT$COUNT[MAT$ENTRY"TEMP$WB"] = 1;
      MAT$SPACE[MAT$ENTRY"TEMP$WB"] = WBUFL;
 
      MAT$COUNT[MAT$ENTRY"AST$BUF"] = 1;
      MAT$SPACE[MAT$ENTRY"AST$BUF"] = ABUFLEN;
 
      MAT$COUNT[MAT$ENTRY"LABBUF"] = 1;
      MAT$SPACE[MAT$ENTRY"LABBUF"] = LABLEN;
 
      MAT$COUNT[MAT$ENTRY"MW$BUFS"] = MAXCTUNIT * CHANPC;
      MAT$SPACE[MAT$ENTRY"MW$BUFS"] = MAXCTUNIT * CHANPC *
                                      (MWBUFL + SFMWL + 1);
                                     # READ BUFFER ADDRESS INCLUDED #
 
      MAT$COUNT[MAT$ENTRY"MR$BUFS"] = MAXCTUNIT * CHANPC;
      MAT$SPACE[MAT$ENTRY"MR$BUFS"] = MAXCTUNIT*CHANPC*(MRBUFL+SFMRL);
 
      MAT$COUNT[MAT$ENTRY"SBT"] = MAXCTUNIT + (2 * MAXSMUNIT) + 1;
      MAT$SPACE[MAT$ENTRY"SBT"] = (MAXCTUNIT+(2*MAXSMUNIT)+1) * MSGLT;
 
      END  # CALCTS #
 
    TERM
PROC CRAST((FCTX),(QADDR),(ASTADDR));
 
# TITLE CRAST - CREATE *AST* ENTRY.                                   #
      BEGIN  # CRAST #
 
#
**    CRAST - CREATE *AST* ENTRY.
*
*     THIS PROCEDURE WILL SCAN THE *FCT* ENTRY AT ORDINAL *FCTX* TO
*     CREATE THE CORRESPONDING TRIAL *AST* ENTRY TO BE
*     CHECKED WITH THE EXISTING AST IN THE PROCEDURE OPENCAT.
*
*     PROC      CRAST((FCTX),(QADDR),(ASTADDR))
*
*     ENTRY     (FCTX)    = ORDINAL OF *FCT* ENTRY.
*               (QADDR)   = ADDRESS OF *FCTQ* ENTRY.
*               (ASTADDR) = ADDRESS OF *AST* BUFFER.
*
*     EXIT      *AST* ENTRY HAS BEEN CONSTRUCTED.
#
 
      ITEM FCTX       U;             # ORDINAL OF *FCT* ENTRY #
      ITEM QADDR      U;             # ADDRESS OF *FCTQ* ENTRY #
      ITEM ASTADDR    U;             # ADDRESS OF *AST* BUFFER #
 
      DEF SPACES #" "#;              # SPACES #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
 
*CALL COMBFAS
*CALL COMBMCT
*CALL COMXCTF
*CALL COMXFCQ
*CALL COMXINT
*CALL COMXMSC
 
      ITEM ATBNDRY    B;             # TRUE IF AT *CDP* OR DONE #
      ITEM DONE       B;             # TRUE IF AFTER LAST AU #
      ITEM I          U;             # INDEX #
      ITEM LASTBUSY   U;             # LAST PROTECTED AU #
      ITEM NXTFREE    U;             # NEXT (EXPECTED) FREE VOLUME #
      ITEM PREVVOL    U;             # AU OF PREVIOUS VOLUME #
      ITEM TEMP       U;             # TEMPORARY #
      ITEM THISAU     U;             # LOOP INDEX #
      ITEM TOTAU      U;             # TOTAL AU AVAILABLE FOR
                                       ALLOCATION #
      ITEM VOLLN      U;             # NUMBER OF (EXPECTED)
                                       CONTINUATION AU #
 
 
                                               CONTROL EJECT;
 
      P<FCT> = QADDR + FCTQHL;
      P<AST> = ASTADDR;
      IF AST$STAT[FCTX] NQ ASTENSTAT"ASS$CART"
      THEN
        BEGIN
        RETURN;
        END
 
#
*     DET OFF CARTRIDGE LINK AND ALLOCATION ALLOWED FLAGS IS AST.
#
 
      AST$NOCLF[FCTX] = FCT$OCLF[FCTX] EQ 7;
      AST$AAF[FCTX] = NOT ( FCT$IAF[0] OR FCT$LCF[0] OR  ##
        FCT$EEF[0] OR FCT$SEF[0] OR  ##
        FCT$FCF[0]) OR (FCT$ORD[0] NQ FCTX);
 
#
*     THE OBJECTIVES OF THE FOLLOWING ANALYSIS OF THE *FCT* ENTRY
*     ARE THREEFOLD:
*
*     1)  COUNT THE AU AVAILABLE FOR ALLOCATION.
*
*     2)  IDENTIFY THE FREE AU WHICH CAN SAFELY BE ALLOCATED
*         FOR STORAGE OF FILE DATA, LEAVING ALONE THOSE AU
*         WHICH ARE UNALLOCATED, BUT ARE FLAGGED, FLAWED OR
*         INCLUDED WITHIN THE COUNT OF CONTINUATION AU OF
*         AN AU OR VOLUME WHICH IS ALLOCATED.
*
*     3)  RE-ORGANIZE THESE USABLE AU INTO VOLUMES AND REBUILD
*         THE CHAIN OF AVAILABLE VOLUMES FOR USE BY THE ALLOCATOR.
*
*     A LOOP EXAMINES EACH AU IN THE *FCT* ENTRY.  EACH AU IS
*     REJECTED AS BEING AVAILABLE IF IT IS BUSY, FLAWED, OR HAS
*     OTHER FLAGS SET.  AN AU WHICH IS EXPECTED TO BE A
*     CONTINUATION AU FOR A VOLUME AVAILABLE FOR ALLOCATION IS
*     ACCEPTED IN THE VOLUME IF IT IS NOT BUSY OR FLAGGED.
*     ANY AU WHICH IS NOT BUSY, FLAGGED, OR PART OF A VOLUME IS
*     TREATED AS THE START OF A NEW VOLUME, AND PROPERLY LINKED
*     INTO THE CHAIN OF FREE VOLUMES.
*
*     THE FOLLOWING SEQUENCE OF STEPS IS TAKEN TO ACHIEVE THE ABOVE:
*
*     1)  DETERMINE IF THIS AU IS JUST AFTER A BOUNDARY POINT,
*         I.E., IT IS JUST AFTER THE LAST AU FOR SHORT OR LONG FILES.
*
*     2)  IF A VOLUME OF FREE AU IS BEING ACCUMULATED, REDUCE THE
*         VOLUME LENGTH IF IT WOULD OTHERWISE INCLUDE AN AU WHICH
*         SHOULD NOT BE PART OF THE VOLUME.
*
*     3)  IF THIS AU IS JUST AFTER A BOUNDARY POINT (SEE STEP 1),
*         - VERIFY THAT THE FREE VOLUME CHAIN IS TERMINATED WITH A
*           LINK=0.
*         - SAVE THE COUNT OF FREE AU IN THE *FCT* HEADER.
*         - IF AT START OF AU FOR LONG FILES, RESET COUNTERS.
*
*     4)  IF THIS AU IS BUSY,
*         - SET A VARIABLE SO THAT ANY AU WHICH ARE CLAIMED TO
*           BE CONTINUATION AU ARE NOT TREATED AS AVAILABLE FOR
*           ALLOCATION REGARDLESS OF THEIR *FCT* ENTRY.
*         - LOOP TO EXAMINE THE NEXT AU.
*
*     5)  IF THE AU IS PROTECTED (SEE STEP 4) OR FLAGGED, LOOP TO
*         EXAMINE THE NEXT AU.
*
*     6)  PROCESS THE AU WHICH IS REALLY AVAILABLE FOR ALLOCATION.
*         - CLEAR CONTINUATION FLAG..FORCE A HEAD OF VOLUME STATUS.
*         - ADJUST IF NECESSARY THE FREE VOLUME LINKAGE TO POINT
*           TO THIS AU (VOLUME).
*         - SAVE LENGTH FIELD AS THE COUNT OF NUMBER OF EXPECTED
*           CONTINUATION AU.
*         - SAVE LINK FIELD AS THE NEXT EXPECTED FREE VOLUME.
*         - SAVE THE ID OF THIS VOLUME IN CASE ITS LENGTH HAS
*           TO BE REDUCED (SEE STEP 2), OR ITS LINK HAS TO BE
*           ADJUSTED (SEE ABOVE SUBSTEP).
#
 
      FCT$FLAWS[0] = 0;
      PREVVOL = 0;
      NXTFREE = FCT$FAUSF[0];
      TOTAU = 0;
      VOLLN = 0;
      LASTBUSY = 0;
      DONE = FALSE;
 
      FOR THISAU = 1 STEP 1 WHILE NOT DONE
      DO
        BEGIN  # THISAU LOOP #
 
#
*     STEP 1 - DETERMINE IF AT A BOUNDARY POINT.
#
 
        SETFCTX(THISAU);
        DONE = THISAU GR FCT$AVOT[0];
        ATBNDRY = (THISAU EQ FCT$CDP[0]) OR DONE;
 
#
*     STEP 2 - IF IN A SEQUENCE OF CONTINUATION AU, VERIFY THAT
*              THIS AU CAN BE INCLUDED.  IF NOT, CORRECT VOLUME LENGTH.
#
 
        IF VOLLN NQ 0
        THEN
          BEGIN  # STEP 2 #
          FCT$CLFG(0,0) = FCT$CLFG(FWD,FPS);
          FCT$CAUF(0,0) = 1-FCT$CAUF(0,0);
 
          IF (FCT$FLGS1(0,0) EQ 0)   ##
            AND NOT ATBNDRY
          THEN                       # AU IS OK AS A CONTINUATION AU #
            BEGIN
            TOTAU = TOTAU + 1;
            FCT$CLFG(FWD,FPS) = 0;
            FCT$CAUF(FWD,FPS) = 1;
            FCT$LEN(FWD,FPS) = VOLLN - 1;
            FCT$LINK(FWD,FPS) = PREVVOL;
            VOLLN = VOLLN - 1;
            TEST THISAU;
            END
 
          ELSE                       # TERMINATE THIS VOLUME AND ADJUST
                                       ITS LENGTH #
            BEGIN
            SETFCTX(PREVVOL);
            FCT$LEN(FWD,FPS) = FCT$LEN(FWD,FPS) - VOLLN;
            VOLLN = 0;
            END
 
          END  # STEP 2 #
 
#
*     STEP 3 - PROCESS BOUNDARY CONDITION.
#
 
        IF ATBNDRY
        THEN
          BEGIN  # STEP 3 #
          SETFCTX(PREVVOL);
          IF NXTFREE NQ 0
          THEN                       # SET LINK TO ZERO #
            BEGIN
            FCT$LINK(FWD,FPS) = 0;
            END
 
          IF DONE
          THEN                       # FINISHED AU FOR LONG FILES #
            BEGIN
            AST$AULF[FCTX] = TOTAU;
            IF FCT$FAULF[0] EQ 0
            THEN
              BEGIN
              AST$AULF[FCTX] = 0;
              END
 
            TEST THISAU;
            END
 
          ELSE                       # FINISHED AU FOR SHORT FILES #
            BEGIN
            AST$AUSF[FCTX] = TOTAU;
            TOTAU = 0;
            PREVVOL = 0;
            NXTFREE = FCT$FAULF[0];
            END
 
          END  # STEP 3 #
 
#
*     STEP 4 - PROCESS AU BUSY.
#
 
        SETFCTX(THISAU);
        IF FCT$FBF(FWD,FPS) EQ 1
        THEN                         # AU IS BUSY, PROTECT ALL AU
                                       COVERED BY LENGTH FIELD #
          BEGIN
          TEMP = THISAU + FCT$LEN(FWD,FPS);
          IF TEMP GR LASTBUSY
          THEN
            BEGIN
            LASTBUSY = TEMP;
            END
 
          TEST THISAU;
          END
 
#
*     STEP 5 - SKIP ANY AU THAT ARE PROTECTED OR FLAGGED.
#
 
        FCT$CAUF(FWD,FPS) = 0;       # CLEAR CONTINUATION AU FLAG #
 
        IF FCT$FAUF(FWD,FPS) NQ 0
        THEN                         # COUNT FLAWED AU #
          BEGIN
          FCT$FLAWS[0] = FCT$FLAWS[0] + 1;
          END
 
        IF THISAU LQ LASTBUSY        ##
          OR (FCT$FLGS1(FWD,FPS) NQ 0)
        THEN
          BEGIN
          TEST THISAU;
          END
 
#
*     STEP 6 - ENSURE THE VOLUME HEADED BY THIS AU IS IN THE
*              FREE SPACE CHAIN.
*              - IF THE NEXT EXPECTED FREE VOLUME (*NXTFREE*)
*                IS BEYOND THIS AU, INSERT THIS AU IN THE MIDDLE
*                OF THE CHAIN.
*              - IF THE NEXT EXPECTED FREE VOLUME IS PRIOR TO THIS
*                AU, CORRECT THE LINK FIELD OF THE PREVIOUS VOLUME
*                BY LINKING TO THIS AU.
*              - USE THE VOLUME LENGTH AND LINK FIELDS AS SPECIFIED
*                BY THIS AU-S *FCT* ENTRY.  IF THEY ARE NOT CORRECT,
*                STEP 2 WILL REDUCE THE LENGTH, AND STEP 3 OR THIS
*                STEP WILL CORRECT THE LINK FIELD.
#
 
        IF THISAU NQ NXTFREE
        THEN                         # NEED TO CORRECT LINKAGE #
          BEGIN  # CORRECT LINKAGE #
          IF THISAU LS NXTFREE
          THEN                       # ADD THIS AU (VOLUME) TO CURRENT
                                       CHAIN #
            BEGIN
            FCT$LINK(FWD,FPS) = NXTFREE;
            END
 
#
*     ADJUST LINK FIELD OF PREVIOUS ENTRY TO POINT TO THIS VOLUME.
#
 
          IF PREVVOL EQ 0
          THEN                       # UPDATE FREE SPACE POINTERS #
            BEGIN
            IF THISAU LS FCT$CDP[0]
            THEN                     # UPDATE SHORT FILE POINTER #
              BEGIN
              FCT$FAUSF[0] = THISAU;
              END
 
            ELSE                     # UPDATE LONG FILE POINTER #
              BEGIN
              FCT$FAULF[0] = THISAU;
              END
 
            END
 
          ELSE                       # UPDATE PREVIOUS LINK #
            BEGIN
            SETFCTX(PREVVOL);
            FCT$LINK(FWD,FPS) = THISAU;
            END
 
          END  # CORRECT LINKAGE #
 
        SETFCTX(THISAU);
        TOTAU = TOTAU + 1;
        PREVVOL = THISAU;
        NXTFREE = FCT$LINK(FWD,FPS);
        VOLLN = FCT$LEN(FWD,FPS);
        TEST THISAU;
        END  # THISAU LOOP #
 
      FCT$CLFG(0,0) = 0;
      RETURN;
      END  # CRAST #
 
    TERM
PROC GETRTP;
# TITLE GETRTP - GETS AND PROCESSES RUN TIME PARAMETERS.              #
 
      BEGIN  # GETRTP #
 
#
**    GETRTP - GETS AND PROCESSES RUN TIME PARAMETERS.
*
*     THIS ROUTINE WILL GET AND PROCESS THE TUNING PARAMETER
*     AND THE TRACE MODE PARAMETER.
*
*     PROC      GETRTP
*
*     EXIT      THE RUN TIME PARAMETERS HAVE BEEN PROCESSED.
*
*     MESSAGE   1) EXEC ABORT - SYNTAX ERROR.
*
*               2) *Q* PARAMETER TOO LARGE -
*                   MAXIMUM ALLOWABLE VALUE SUBSTITUTED.
*
*               3) *Q* PARAMETER TOO SMALL -
*                   MINIMUM ALLOWABLE VALUE SUBSTITUTED.
#
 
#
****  PROC GETRTP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC EXTAB;                  # SETS UP PARAMETER LIST #
        PROC MESSAGE;                # ISSUES MESSAGE TO DAYFILE #
        PROC XARG;                   # CRACK PARAMETER LIST #
        PROC XDXB;                   # CONVERT DECIMAL TO BINARY #
        END
 
#
****  PROC GETRTP - XREF LIST END.
#
 
 
 
      DEF DEC$TYPE   #1#;            # DECIMAL TYPE CONVERSION #
      DEF QAVERAGE   #10#;           # AVERAGE TUNING PARAMETER VALUE #
      DEF QMAXIMUM   #50#;           # MAXIMUM TUNING PARAMETER VALUE #
      DEF QMINIMUM   #6#;            # MINIMUM TUNING PARAMETER VALUE #
      DEF SYNTAXOK   #0#;            # NO SYNTAX ERRORS #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMXCTF
*CALL COMXEXP
*CALL COMXINT
*CALL,COMXJCA
 
      ITEM ARGLIST    U;             # ADDRESS OF ARGUMENT LIST #
      ITEM ARG$Q      I;             # INTEGER TUNING PARAMETER #
      ITEM DFLT       B;             # DEFAULT *Q* FLAG #
      ITEM FLAG       U;             # STATUS FLAG FOR ASARG #
      ITEM OPTION     U;             # OPTION TO SKIP PROGRAM NAME #
 
#
*     MESSAGE BUFFER.
#
 
      ARRAY MSGBUF[0:0] P(5);
        BEGIN  # ARRAY MSGBUF #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$RZRO   C(04,00,12);  # ZERO BYE TERMINATOR #
        END  # ARRAY MSGBUF #
 
                                               CONTROL EJECT;
 
#
*     GET THE RUN TIME PARAMETERS.
#
 
      EXTAB(ARGLIST);                # SET UP ARGUMENT LIST #
      OPTION = 0;                    # SKIP OVER PROGRAM NAME #
      XARG(ARGLIST,OPTION,FLAG);     # GET PARAMETERS #
 
      IF FLAG NQ SYNTAXOK
      THEN
        BEGIN  # IF SYNTAX ERRORS DETECTED BY ASARG #
        MSG$LINE[0] = " EXEC ABORT - SYNTAX ERRORS. ";
        MESSAGE(MSGBUF[0],UDFL1);    # ERROR MESSAGE TO DAYFILE #
        FATALERR = TRUE;
        RETURN;
        END  # IF SYNTAX ERRORS DETECTED BY ASARG #
 
#
*     CHANGE DISPLAY CODE *S* PARAMETER TO DECIMAL INTEGER.  IF
*     *S* PARAMETER IS NOT FOUND ON CONTROL COMMAND, *ARG$S*
*     WILL BE SET TO -1.
#
 
      XDXB(ARG$SC[0],DEC$TYPE,ARG$S);
 
#
*     SET THE SMALLEST *HLRQ* COUNT.
#
 
      Q = MAXSMUNIT * 2;        # SET MAXIMUN AND DEFAULT *HLRQ* COUNT #
      IF MIMHLRQ LS Q
      THEN
        BEGIN     # FORCE THE SMALLEST *HLRQ* COUNT #
        Q = MIMHLRQ;
        END
 
 
#
*     SET *RA$TRACE* TO *TRUE* IF *TM* PARAMETER SPECIFIED.
#
 
      RA$TRACE = (ARG$T NQ -1);
 
      RETURN;
      END  # GETRTP #
 
    TERM
PROC GETUDT;
# TITLE GETUDT - DETERMINES THE PROPERTIES OF THE CONFIGURATION.      #
 
      BEGIN  # GETUDT #
 
#
**    GETUDT - DETERMINES THE PROPERTIES OF THE CONFIGURATION.
*
*     THIS ROUTINE WILL INITIALIZE VARIABLES DEFINING THE
*     CONFIGURATION OF THE CONTROLLERS AND STORAGE MODULES.
*
*     PROC      GETUDT.
*
*     ENTRY     M860 HARDWARE CONFIGURATION EXISTS.
*
*     EXIT      CONFIGURATION INFORMATION HAS BEEN PROCESSED.
*
*     MESSAGES  1) ATTACH ERROR - BUDT FILE BUSY.
*
*               2) ATTACH ERROR - BUDT FILE NOT FOUND.
*
*               3) BUDT CONTROLLER ENTRY COUNT EXCEEDED.
*
*               4) BUDT CONTROLLER TABLE READ ERROR.
*
*               5) BUDT READ ERROR.
*
*               6) BUDT SM ENTRY COUNT EXCEEDED.
*
*               7) BUDT SM TABLE READ ERROR.
*
*               8) EST ORDINAL XX - NO UDT ENTRY.
*
*               9) EST READ ERROR.
*
*               10) EST/UDT CHANNEL MISMATCH.
*
*               11) MORE CHANNELS THAN MSG FETS.
*
*               12) VERIFY ERROR ON EST ENTRY XX.
*
*     NOTES     *INITTAB* MUST BE CALLED BEFORE *GETUDT* SO THAT AN
*               I/O BUFFER IS AVAILABLE TO READ THE BUDT INTO
*               *SSEXEC*.
*
*               *KINIT* MUST BE CALLED BEFORE *GETUDT* SO THAT A
*               K-DISPLAY MESSAGE CAN BE ISSUED ALLOWING THE OPERATOR
*               TO RUN *SSALTER* TO MODIFY THE UDT.
*
*               THE *UCP* INTERFACE MUST BE INITIALIZED BEFORE
*               *GETUDT* IS CALLED SO THAT *SSALTER* MAY BE RUN.
#
 
#
****  PROC GETUDT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ATTACH;                 # ATTACH FILE #
        PROC BZFILL;                 # BLANK OR ZERO FILLS #
        PROC PFD;                    # PFM ENTRY #
        PROC SETPFP;                 # SETS USER INDEX AND FAMILY #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC RDEST;                  # READ EST ENTRIES #
        PROC READ;                   # READS FILE TO I/O BUFFER #
        PROC READW;                  # READS FILE TO WORKING BUFFER #
        PROC RETERN;                 # RETURNS FILE #
        PROC RTIME;                  # GET REAL TIME #
        FUNC XCOD C(10);             # CONVERT OCTAL TO DISPLAY #
        PROC ZSETFET;                # SETS UP *FET* #
        END
 
#
****  PROC GETUDT - XREF LIST END.
#
 
      DEF CNTYPE     #"SS"#;         # CONTROLLER TYPE #
      DEF DOWNSTATUS #3#;            # CONTROLLER EST *DOWN* STATUS #
      DEF ESTCHAN(CUO,UCHO) #B<13+(UCHO*6),5>EST$WORD[0]#;
                                     # EST CHANNEL #
      DEF ESTON(UCHO) # B<12+(UCHO*6),1>EST$WORD[0]#;
                                     # EST CHANNEL STATUS #
      DEF FILLSIZE   #7#;            # FILL SIZE FOR *BZFILL* #
      DEF FIRSTCHAN  #1#;            # PRIMARY EST CHANNEL INDEX #
      DEF IDLESTATUS #1#;            # CONTROLLER EST *IDLE* STATUS #
      DEF OFFSTATUS  #2#;            # CONTROLLER EST *OFF* STATUS #
      DEF ONSTATUS   #0#;            # CONTROLLER EST *ON* STATUS #
      DEF READMODE   #1#;            # READ MODE FOR ATTACH #
      DEF UDTEX(CUO,CIFO) #B<CIFO,1>UD$CHEX[CUO]#;
                                     # SET IF CHANNEL EXISTS #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCPR
*CALL,COMBFET
*CALL COMBKDD
*CALL COMBMAT
*CALL,COMBPFP
*CALL COMBPFS
*CALL COMBUCR
*CALL COMBUDT
*CALL COMSPFM
*CALL COMXBST
*CALL COMXCTF
*CALL COMXINT
*CALL COMXJCA
 
 
      ITEM BITMAPPOS  U;             # BIT POSITION IN EST ORD BIT MAP #
      ITEM BITMAPWORD U;             # EST ORDINAL BIT MAP WORD #
      ITEM BUFL       U;             # I/O BUFFER LENGTH #
      ITEM DESIREDORD I;             # EST ORD TO CHECK IN BIT MAP #
      ITEM ESTNUM     U;             # COUNT OF EST ENTRIES READ #
      ITEM ESTORD     C(10);         # DISPLAY CODE EST ORDINAL #
        ITEM NUM        I;       # NUMBER OF EST ENTRIES #
      ITEM FETL       U;             # TEMP BUFFER FET LENGTH #
      ITEM FOUND      B;             # SET IF EST/UDT MATCH FOUND #
      ITEM I          U;             # INDEX #
      ITEM J          U;             # INDEX #
      ITEM K          I;             # INDEX #
      ITEM LFN        C(7);          # BUDT LOCAL FILENAME #
      ITEM PASSWORD   C(7);          # BUDT FILE PASSWORD #
      ITEM STAT       U;             # FUNCTION RETURN STATUS #
      ITEM TMPCCNT    U;             # TEMP CHANNEL COUNT #
 
#
*     ARRAY TO MARK SS-TYPE EQUIPMENT.
#
 
      ARRAY EQBITS [0:8] S(9);
        BEGIN
        ITEM EQUSED     U(00,00,60);  # BIT MAP WORD #
        END
 
 
#
*     EST BUFFER.
#
 
      ARRAY ESTB [0:0] S(2);
        BEGIN  # EST #
        ITEM EST$WORD   U(00,00,60);  # EST WORD #
        ITEM EST$STAT   U(00,10,02);  # CONTROLLER STATUS #
        ITEM EST$CHBDWN B(00,12,01);  # CHANNEL *B* DOWN #
        ITEM EST$CHB    U(00,13,05);  # CHANNEL *B* #
        ITEM EST$CHADWN B(00,18,01);  # CHANNEL *A* DOWN #
        ITEM EST$CHA    U(00,19,05);  # CHANNEL *A* #
        ITEM EST$CHDDWN B(00,24,01);  # CHANNEL *D* DOWN #
        ITEM EST$CHD    U(00,25,05);  # CHANNEL *D* #
        ITEM EST$CHCDWN B(00,30,01);  # CHANNEL *C* DOWN #
        ITEM EST$CHC    U(00,31,05);  # CHANNEL *C* #
        ITEM EST$CONT   U(00,37,11);  # CONTROLLER TYPE #
        ITEM EST$CNCT   U(00,48,03);  # CONNECT CODE #
        END  # EST #
 
 
#
*     UDT CHANNEL ARRAY.
#
 
      ARRAY UDTCH [0:MAX$CH] S(1);
        BEGIN
        ITEM UDTCWORD   U(00,00,06);  # CHANNEL WORD #
        ITEM UDTBSTAT   B(00,00,01); # CHANNEL STATUS (BOOLEAN) #
        ITEM UDTSTAT    U(00,00,01); # CHANNEL STATUS #
        ITEM UDTCHAN    U(00,01,05); # CHANNEL NUMBER #
        END
 
 
#
*     *MISSING UDT ENTRY* ERROR MESSAGE BUFFER.
#
 
      ARRAY MISMB [0:0] S(4);
        BEGIN  # MESSAGE BUFFER #
        ITEM MIS$1      C(00,00,13) = [" EST ORDINAL "];
        ITEM MIS$NUM    U(01,18,24); # EST ORDINAL #
        ITEM MIS$2      C(01,42,16) = [" - NO UDT ENTRY."];
        ITEM MIS$ZRO    U(03,18,42) = [0];  # ZERO-BYTE TERMINATOR #
        END  # MESSAGE BUFFER #
 
 
#
*     GENERAL ERROR MESSAGE BUFFER.
#
 
      ARRAY MSGMB [0:0] S(5);
        BEGIN  # MESSAGE BUFFER #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$ZRO    U(04,00,12) = [0];  # ZERO-BYTE TERMINATOR #
        END  # MESSAGE BUFFER #
 
 
#
*     *VERIFY* ERROR MESSAGE BUFFER.
#
 
      ARRAY VERMB [0:0] S(4);
        BEGIN  # MESSAGE BUFFER #
        ITEM VER$1      C(00,00,27) = [" VERIFY ERROR ON EST ENTRY "];
        ITEM VER$NUM    C(02,42,24); # EST ORDINAL #
        ITEM VER$2      C(03,06,06) = ["."];
        ITEM VER$ZRO    U(03,12,48) = [0];  # ZERO-BYTE TERMINATOR #
        END  # MESSAGE BUFFER #
 
 
                                               CONTROL EJECT;
 
#
*     READ BUDT INTO TEMPORARY BUFFER.
#
 
      LFN = BUDT;
      PASSWORD = BUDTPW;
      BZFILL(LFN,TYPFILL"ZFILL",FILLSIZE);  # CLEAR FILENAME #
      BZFILL(PASSWORD,TYPFILL"ZFILL",FILLSIZE);  # CLEAR PASSWORD #
      PFP$UI = DEF$UI;               # SET *SETPFP* PARAMETERS #
      PFP$FAM = FAM$NAME[DEFAULTORD];
      PFP$FG1 = TRUE;
      PFP$FG4 = TRUE;
      SETPFP(PFP[0]);         # SET USER INDEX AND FAMILY #
 
#
*     TRY ATTACHING BUDT FILE 10 TIMES BEFORE TERMINATING.
#
      SLOWFOR I = 0 STEP 1 UNTIL 10
      DO
        BEGIN
        PFD("ATTACH",LFN,0,"PW",PASSWORD,"RC",PFSTAT,"NA",0,"UP",0,0);
 
        IF PFSTAT EQ OK
        THEN
          BEGIN      # BUDT ATTACHED #
          GOTO ENDCON;
          END
        END               # ATTACH BUDT LOOP #
 
ENDCON:
 
      IF PFSTAT NQ OK
      THEN                           # PROCESS ATTACH ERROR #
        BEGIN  # ABORT #
        MSG$LINE[0] = " ATTACH ERROR - BUDT FILE BUSY.";
        IF PFP$STAT[0] NQ FBS
        THEN                         # BUDT FILE NOT FOUND #
          BEGIN  # NOT FOUND #
          MSG$LINE[0] = " ATTACH ERROR - BUDT FILE NOT FOUND.";
          END  # NOT FOUND #
 
        GOTO GETUDT1;
        END  # ABORT #
 
      BUFL = MAT$SPACE[MAT$ENTRY"TEMP$BUF"];
      FETL = MAT$SPACE[MAT$ENTRY"TEMP$FET"];
      ZSETFET(TFETADR,LFN,TBUFADR,BUFL,FETL);
      READ(TFET,RCL);                # READ BUDT WITH AUTO-RECALL #
 
#
*     READ BUDT FROM TEMPORARY BUFFER INTO UDT SPACE.
#
 
      P<UDT$WORD> = UDTCADR;
      READW(TFET,UDT$WORD,1,STAT);
      IF STAT NQ OK
      THEN                           # READ COMPLETED WITH ERRORS #
        BEGIN  # ABORT #
        MSG$LINE[0] = " BUDT READ ERROR.";
        GOTO GETUDT1;
        END  # ABORT #
 
      IF UDT$LINE$CUN[0] GR MAXCTN
      THEN                           # CONTROLLER TABLE TOO LARGE #
        BEGIN  # ABORT #
        MSG$LINE[0] = " BUDT CONTROLLER ENTRY COUNT EXCEEDED.";
        GOTO GETUDT1;
        END  # ABORT #
 
      IF UDT$LINE$SMN[0] GR MAXSM
      THEN                           # SM TABLE TOO LARGE #
        BEGIN  # ABORT #
        MSG$LINE[0] = " BUDT SM ENTRY COUNT EXCEEDED.";
        GOTO GETUDT1;
        END  # ABORT #
 
      UDT$WORDCNT[0] = MAT$SPACE[MAT$ENTRY"UDT$CONT"]
                             + MAT$SPACE[MAT$ENTRY"UDT$SM"];
 
      READW(TFET,UDT$CN,UDTCUL,STAT);   # STORE CU TABLE #
      IF STAT NQ OK
      THEN                           # READ COMPLETED WITH ERRORS #
        BEGIN  # ABORT #
        MSG$LINE[0] = " BUDT CONTROLLER TABLE READ ERROR.";
        GOTO GETUDT1;
        END  # ABORT #
 
      READW(TFET,UDT$SMA,UDTSML,STAT);  # STORE *SM* TABLE #
      IF STAT NQ OK
      THEN                           # READ COMPLETED WITH ERRORS #
        BEGIN  # ABORT #
        MSG$LINE[0] = " BUDT SM TABLE READ ERROR.";
        GOTO GETUDT1;
        END  # ABORT #
 
      RETERN(TFET,RCL);              # RETURN BUDT WITH AUTO-RECALL #
      RETERN(TFET,RCL);
 
#
*     INITIALIZE UDT CONTROLLER AND SM ENTRIES.
#
 
      SLOWFOR I = 1 STEP 1 UNTIL 9
      DO                             # PRESET EST ORDINAL BIT MAP #
        BEGIN  # PRESET #
        EQUSED[I] = 0;
        END  # PRESET #
 
      MAX$ACHN = 0;                  # PRESET ACTIVE CHANNEL COUNT #
      SLOWFOR I = 1 STEP 1 WHILE UD$EXIST[I] AND I LQ MAXCTN
      DO                             # PRESET CONTROLLER ENTRIES #
        BEGIN  # PRESET #
        NUM = 1;
        ESTNUM = UD$ESTO[I];
        RDEST(ESTB,NUM,ESTNUM);   # READ EST ENTRY #
        IF NUM NQ 1
        THEN                      # ABORT ON READ ERROR #
          BEGIN
          MSG$LINE[0] = "EST READ ERROR.";
          GOTO GETUDT1;
          END
 
      IF EST$CONT[0] NQ CNTYPE    # CONTROLLER TYPE MISMATCH #
        OR EST$CNCT[0] NQ UD$CUDA[I]  # CONNECT MISMATCH #
        THEN                         # CONTROLLER ENTRY IS INCORRECT #
          BEGIN  # ABORT #
          ESTORD = XCOD(UD$ESTO[I]);  # SET EST ORDINAL IN MESSAGE #
          VER$NUM[0] = C<6,4>ESTORD;
          MESSAGE(VERMB,SYSUDF1);
          FATALERR = TRUE;
          RETURN;
          END  # ABORT #
 
        UD$CUON[I] = EST$STAT[0] EQ ONSTATUS # MOVE CU STATUS #
                     OR EST$STAT[0] EQ IDLESTATUS;
        UDTCWORD[0] = UD$CHANA[I];   # COPY UDT CHANNEL INFO #
        UDTCWORD[1] = UD$CHANB[I];
        UDTCWORD[2] = UD$CHANC[I];
        UDTCWORD[3] = UD$CHAND[I];
        TMPCCNT = 0;                 # PRESET TEMP CHANNEL COUNT #
        SLOWFOR J = 0 STEP 1 UNTIL MAX$CH
        DO                           # SCAN EST ENTRY FOR CHANNELS #
          BEGIN  # SCAN EST #
          IF J EQ FIRSTCHAN          # IN CASE CHANNEL 0 #
            OR ESTCHAN(I,J) NQ 0
          THEN                       # EST CHANNEL FOUND #
            BEGIN  # FOUND #
            FOUND = FALSE;
            SLOWFOR K = 0 STEP 1 UNTIL MAX$CH
            DO                       # SCAN ARRAY FOR CHANNEL MATCH #
              BEGIN  # SCAN UDT #
              IF UDTEX(I,K) NQ 0     # UDT CHANNEL FOUND #
                AND ESTCHAN(I,J) EQ UDTCHAN[K]  # CHANNELS MATCH #
              THEN                   # MOVE CHANNEL STATUS TO UDT #
                BEGIN  # STATUS #
                FOUND = TRUE;
                MAX$ACHN = MAX$ACHN + UDTSTAT[K];  # COUNT CHANNELS #
                TMPCCNT = TMPCCNT + 1;
                IF ESTON(J) EQ 1
                THEN                 # CHANNEL OFF IN EST #
                  BEGIN  # OFF #
                  UDTBSTAT[K] = FALSE;  # TURN OFF CHANNEL IN UDT #
                  END  # OFF #
 
                END  # STATUS #
 
              END  # SCAN UDT #
 
            IF NOT FOUND
            THEN                     # CHANNEL MISMATCH #
              BEGIN  # ABORT #
              GOTO GETUDT2;
              END  # ABORT #
 
            END  # FOUND #
 
          END  # SCAN EST #
 
        IF TMPCCNT NQ (UDTEX(I,0) + UDTEX(I,1) +
                        UDTEX(I,2) + UDTEX(I,3))
        THEN                         # CHANNEL MISMATCH #
          BEGIN  # ABORT #
          GOTO GETUDT2;
          END  # ABORT #
 
        UD$CHANA$O[I] = UDTBSTAT[0]; # COPY CHANNEL STATUSES TO UDT #
        UD$CHANB$O[I] = UDTBSTAT[1];
        UD$CHANC$O[I] = UDTBSTAT[2];
        UD$CHAND$O[I] = UDTBSTAT[3];
        P<UDT$MSG> = LOC(UD$MSG[I]);
        MS$MSQN$CN[0] = I;           # STORE CONTROLLER ORDINAL #
        BITMAPWORD = UD$ESTO[I]/60;
        BITMAPPOS = UD$ESTO[I] - (BITMAPWORD * 60);
        B<BITMAPPOS,1>EQUSED[BITMAPWORD] = 1;  # NOTE ORD PROCESSED #
        END  # PRESET #
 
      SLOWFOR I= 1 STEP 1 UNTIL MAX$ACHN
      DO
        BEGIN
        BST$AUTH[I] = TRUE;
        END
 
 
      SLOWFOR BITMAPWORD = 0 STEP 1 WHILE NUM EQ 1
      DO                             # FIND UNUSED M860 EST ENTRIES #
        BEGIN  # FIND #
        SLOWFOR BITMAPPOS = 0 STEP 1 UNTIL 59
        DO                           # SCAN EST ORDINAL BIT MAP WORD #
          BEGIN  # WORD #
          DESIREDORD = BITMAPPOS + (BITMAPWORD * 60);
          IF DESIREDORD EQ 0
          THEN                       # AVOID READING ENTIRE EST #
            BEGIN  # SKIP #
            TEST BITMAPPOS;          # ONLY READ INDIVIDUAL ENTRIES #
            END  # SKIP #
 
          NUM = 1;
          RDEST(ESTB,NUM,DESIREDORD);
          IF NUM NQ 1
          THEN                       # EST ORDINAL NON-EXISTENT #
            BEGIN  # END #
            TEST BITMAPWORD;         # REACHED END OF EST #
            END  # END #
 
        IF EST$CONT[0] EQ CNTYPE
            AND B<BITMAPPOS,1>EQUSED[BITMAPWORD] EQ 0
        THEN                         # UNPROCESSED ENTRY FOUND #
          BEGIN  # MESSAGE #
            ESTORD = XCOD(DESIREDORD);  # SET EST ORDINAL IN MESSAGE #
          MIS$NUM[0] = C<6,4>ESTORD;
          MESSAGE(MISMB,SYSUDF1);
          END  # MESSAGE #
 
          END  # WORD #
 
        END  # FIND #
 
      SLOWFOR I = 1 STEP 1 WHILE SM$EXIST[I] AND I LQ MAXSMUNIT
      DO                             # PRESET SM ENTRIES #
        BEGIN  # PRESET #
        P<UDT$MSG> = LOC(D0$MSG[I]);
        MS$MSQN$CN[0] = I;           # STORE SM ORDINAL #
        MS$MSQN$D0[0] = TRUE;        # SET DRD 0 FLAG #
        P<UDT$MSG> = LOC(D1$MSG[I]);
        MS$MSQN$CN[0] = I;           # STORE SM ORDINAL #
        MS$MSQN$D1[0] = TRUE;        # SET DRD 1 FLAG #
        END  # PRESET #
 
#
*     INITIALIZE MESSAGE READ AND WRITE BUFFER FETS.
#
 
      P<FETMWB> = MWRBADR + 1;       # ALLOW FOR READ BUFFER PTR #
      P<FETMRB> = MRDBADR;
      SLOWFOR I = 1 STEP 1 WHILE UD$EXIST[I] AND (I LQ MAXCTN)
      DO                             # CHECK UDT CHANNELS #
        BEGIN  # CHECK #
        CHT$WORD[0] = UD$CHANA[I];   # PRESET TEMPORARY CHANNEL ARRAY #
        CHT$WORD[1] = UD$CHANB[I];
        CHT$WORD[2] = UD$CHANC[I];
        CHT$WORD[3] = UD$CHAND[I];
        SLOWFOR J = 0 STEP 1 WHILE J LQ MAX$CIF
        DO                           # FIND ON CHANNELS #
          BEGIN  # FIND #
          IF CHT$ON[J]
            AND (CHT$CHAN[J] NQ 0 OR J EQ 0)
          THEN                       # INITIALIZE ASSOCIATED MSG FETS #
            BEGIN  # INITIALIZE #
            IF P<FETMWB> GQ (MWRBADR + MAT$SPACE[MAT$ENTRY"MW$BUFS"])
            THEN                     # MORE CHANNELS THAN MSG FETS #
              BEGIN  # ABORT #
              MSG$LINE[0] = " MORE CHANNELS THAN MSG FETS.";
              GOTO GETUDT1;
              END  # ABORT #
 
            P<FETMRA> = P<FETMWB> - 1;
            FRA$MRBADR[0] = P<FETMRB>;  # MESSAGE READ BUFFER ADDRESS #
 
            FMW$FIRST[0] = P<FETMWB> + SFMWL;  # PRESET WRITE BUFFER #
            FMW$IN[0] = FMW$FIRST[0];
            FMW$OUT[0] = FMW$FIRST[0];
            FMW$CHAN[0] = CHT$CHAN[J];
            FMW$CHON[0] = TRUE;
            FMW$LIMIT[0] = FMW$FIRST[0] + MWBUFL;
 
            FMR$CU[0] = I;           # PRESET READ BUFFER #
            FMR$FIRST[0] = P<FETMRB> + SFMRL;
            FMR$IN[0] = FMR$FIRST[0];
            FMR$OUT[0] = FMR$FIRST[0];
            FMR$CHAN[0] = CHT$CHAN[J];
            FMR$CIF[0] = J;
            FMR$LIMIT[0] = FMR$FIRST[0] + MRBUFL;
            P<KWORD> = LOC(FMR$KWORDS[0]);  # PRESET K-DISPLAY WORDS #
            KW$COMP[0] = TRUE;
 
            P<MWBTMP> = LOC(UD$CAMF[I]);
            MWB$ADDR[J] = P<FETMWB>; # SET FET ADDRESS IN CU ORDINAL #
            P<FETMWB> = P<FETMWB> + SFMWL + MWBUFL + 1;  # NEXT FETS #
            P<FETMRB> = P<FETMRB> + SFMRL + MRBUFL;
            END  # INITIALIZE #
 
          END  # FIND #
 
        END  # CHECK #
 
      RETURN;
 
GETUDT2:
      MSG$LINE[0] = " EST/UDT CHANNEL MISMATCH.";
 
GETUDT1:
      MESSAGE(MSGMB,SYSUDF1);        # ABORT PROCESSING #
      FATALERR = TRUE;
      RETURN;
      END  # GETUDT #
 
    TERM
PROC INITDAM;
# TITLE INITDAM - INITIALIZE *TDAM* INTERFACE.                        #
      BEGIN  # INITDAM #
 
#
***   INITDAM - INITAILIZE *TDAM* INTERFACE.
*
*     THIS ROUTINE WILL INITIALIZE THE *TDAM* INTERFACE
*     AND ISSUE AN EVENT TO SWAP IN THE JOBS WAITING FOR *MSAS*.
 
*     PROC INITDAM.
*
*     ENTRY      *SSEXEC* HAS BEEN INITIALIZED AND READY TO BE
*                CALLED BY WAITING JOBS.
*
*     EXIT       *TDAM* INTERFACE HAS BEEN INITIALIZED AND
*                EVENT TO SWAP IN WAITING JOBS HAS BEEN ISSUED.
#
 
#
****  PROC INITDAM - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC EESET;                  # ENTERS EVENT IN EVENT TABLE #
        PROC SYSTEM;                 # CALLS *SYSTEM* MACRO #
        PROC ZFILL;                  # ZERO FILLS BUFFER #
        END
 
#
****  PROC INITDAM - XREF LIST END.
#
 
      DEF NO$EQUIP   #0#;            # NO EQUIPMENT VALUE #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL,COMBCDD
*CALL COMBTDM
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXINT
*CALL,COMXJCA
 
      ITEM I          U;             # INDEX #
 
 
 
 
 
#
*     INITIALIZE *TDAM* INTERFACE AND ISSUE EVENT TO SWAP IN JOBS
*     WAITING FOR *MSAS*.
#
 
      P<TDAM> = LOC(RA$TDAM);
      ZFILL(TDAM,TDAMLEN);
 
      EESET$EQ[0] = NO$EQUIP;        # USE NO EQUIPMENT VALUE #
      EESET(EVENT);                  # SET EVENT INTO EVENT TABLE #
 
 
#
*     PRESET ALL PP CALL BLOCK ENTRIES.
#
 
      SLOWFOR I = 1 STEP 1 UNTIL PPCBTSIZE
      DO                           # SET PARAMETER WORD ADDRESS #
        BEGIN    # SET ADDRESS #
        PPU$1SS[I] = "1SS";
        PPU$PADDR[I] = LOC(PPU$WORD1[I]);
        PPU$DRCL[I] = LOC(DRVRRECALL);
        END      # SET ADDRESS #
 
      PPU$FC[1] = IRTDAM;
      PPCBENCNT = PPCBENCNT+1;       # INCREMENT PPCALL COUNT #
      SPC$SPC[0] = "SPC";
      SPC$ADDR[0] = LOC(PPTMP);
      PPT$WORD0[0] = PPU$WORD0[1];
      SLOWFOR I = 0 WHILE PPT$WORD0[0] NQ 0
      DO
        BEGIN
        SYSTEM(SPC,RCL);
        END
 
      END  # INITDAM #
 
    TERM
PROC INITFAM;
# TITLE INITFAM - INITIALIZES SUBFAMILY PARAMETERS.                   #
 
      BEGIN  # INITFAM #
 
#
**    INITFAM - INITIALIZES SUBFAMILY PARAMETERS.
*
*     PROC      INITFAM.
#
 
#
****  PROC INITFAM - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC BZFILL;                 # BLANK OR ZERO FILLS #
        PROC GETFAM;                 # GETS TABLE OF FAMILIES #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC PFD;                    # PERMANENT FILE REQUEST DELAYS #
        PROC RETERN;                 # RETURNS FILE #
        PROC RMVBLNK;                # REMOVE MULTIPLE BLANKS #
        PROC SETPFP;                 # SETS USER INDEX AND FAMILY #
        FUNC XCOD I;                 # CHANGES INTEGER TO DISPLAY #
        PROC XWOD;                   # CHANGES INTEGER TO OCTAL #
        PROC ZSETFET;                # SETS UP *FET* #
        END
 
#
****  PROC INITFAM - XREF LIST END.
#
 
      DEF FILLSIZE   #7#;            # FILL SIZE FOR *BZFILL* #
      DEF NUM$MST    #4#;            # NUMBER OF *MSA-S* #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBPFP
*CALL COMBPFS
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXINT
*CALL COMXMSC
*CALL COMSPFM
 
 
      ITEM ATLEASTONE B;             # AT LEAST ONE FOUND FLAG #
      ITEM BADNUM     U;             # BAD FILE INDEX #
      ITEM BLKFILL    S:TYPFILL = S"BFILL";  # BLANK FILL #
      ITEM BLKFOUND   B;             # BLANK FOUND FLAG #
      ITEM FOUND      B;             # ITEM FOUND FLAG #
      ITEM I          U;             # INDEX #
      ITEM J          U;             # INDEX #
      ITEM K          U;             # INDEX #
      ITEM MSGTEMP    C(8);          # ITEM FOR *BZFILL* #
      ITEM NUM$FAM    U;             # NUMBER OF *GETFAM* ENTRIES #
      ITEM UI         U;             # USER INDEX #
 
 
#
*     ARRAY TO DISPLAY BAD FILE INFORMATION.
#
 
      ARRAY BADFILE[0:MAXSF] P(3);
        BEGIN
        ITEM BAD$PFN    C(00,00,07);  # FILE NAME #
        ITEM BAD$FAM    C(00,42,08);  # FAMILY NAME #
        ITEM BAD$INDEX  C(01,30,06);  # USER INDEX #
        END
 
#
*     ARRAY TO USER INDEX DISPLAY CODE.
#
 
      ARRAY DIS[0:0] P(2);
        BEGIN
        ITEM DIS$UI     C(01,24,06);  # USER INDEX IN DISPLAY CODE #
        END
 
#
*     ARRAY TO HOLD *SFMCAT* FILE NAME.
#
 
      ARRAY CAT[0:0];
        BEGIN  # CAT #
        ITEM CAT$PFN    C(00,00,07) = ["SFMCAT "];  # FILE NAME #
        ITEM CAT$UNID   C(00,36,01);  # UNIQUE IDENTIFIER #
        END  # CAT #
 
 
#
*     MESSAGE BUFFER.
#
 
      ARRAY MSGBUF[0:0] P(5);
        BEGIN  # ARRAY MSGBUF #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$RZRO   C(04,00,12);  # ZERO BYE TERMINATOR #
        END  # ARRAY MSGBUF #
 
      ARRAY SC$FET [0:0] P(SFETL);
      ;
                                               CONTROL EJECT;
 
#
*     FUNCTION 2 - ANALYZE FAMILIES.
*
*       FIND NUMBER AND NAMES OF FAMILIES WITH ALL SUBFAMILY CATALOGS.
#
 
      NFAM = 1;
 
      SSID = ATAS;
      GETFAM(FAMT,NUM$FAM,LINK[0],DEFAULTORD,SSID);
      DEF$FAM = FAM$NAME[DEFAULTORD];
 
 
#
*     ATTEMPT TO ATTACH EACH *SFMCAT* FILE FOR EACH FAMILY.
*     THE FOLLOWING ACTIONS WILL BE TAKEN DEPENDING ON THE NUMBER
*     OF FILES ATTACHED
*
*       1) IF NONE, DO NOTHING,
*       2) IF EIGHT, SAVE THE FAMILY NAME,
*       3) IF SOME BUT NOT EIGHT, ISSUE ERROR MESSAGE.
#
 
      SLOWFOR I = 1 STEP 1 UNTIL NUM$FAM
      DO
        BEGIN  # CHECK ALL FAMILIES FOR EIGHT CATALOGS #
 
        ATLEASTONE = FALSE;          # AT LEAST ONE FOUND FLAG #
        FOUND = TRUE;                # CATALOG FOUND FLAG #
        BADNUM = 0;                  # BAD FILE INDEX #
 
        SLOWFOR J = 0 STEP 1 UNTIL MAXSF
        DO
          BEGIN  # CHECK CATALOG FOR EACH SUBFAMILY #
 
          PFP$UI = DEF$UI + J;       # SET USER INDEX FOR *SETPFP* #
          PFP$FAM = FAM$NAME[I];     # SET FAMILY NAME FOR *SETPFP* #
          PFP$FG1 = TRUE;            # SET FAMILY BIT FOR *SETPFP* #
          PFP$FG4 = TRUE;            # SET INDEX BIT FOR *SETPFP* #
          SETPFP(PFP);               # SET USER INDEX AND FAMILY #
 
#
*     IF UNABLE TO DO A *SETPFP* ON A FAMILY, IGNORE CATALOG VALIDATION
*     AND CONTINUE WITH THE NEXT FAMILY.
#
 
          IF PFP$STAT NQ 0
          THEN
            BEGIN
            TEST I;                  # NEXT FAMILY #
            END
 
          CAT$UNID[0] = XCOD(J);     # CHANGE INDEX TO DISPLAY CODE #
          PFD("ATTACH",CAT$PFN,0,"RC",  ##
            PFSTAT,"NA",0,"UP",0,0);
          IF PFSTAT EQ 0 OR PFSTAT EQ FBS
          THEN
            BEGIN  # IF ATTACH SUCCESSFUL #
            ATLEASTONE = TRUE;
            END  # IF ATTACH SUCCESSFUL #
 
          ELSE
            BEGIN  # ERROR OTHER THAN FILE BUSY OR UTILITY ACTIVE #
            UI = DEF$UI + J;
            XWOD(UI,DIS);
 
            BAD$PFN[BADNUM] = CAT$PFN[0];  # SAVE FILE NAME #
            MSGTEMP = FAM$NAME[I];
            BZFILL(MSGTEMP,BLKFILL,FILLSIZE);
            BAD$FAM[BADNUM] = MSGTEMP;  # SAVE FAMILY NAME #
            BAD$INDEX[BADNUM] = DIS$UI;  # SAVE USER INDEX #
 
            BADNUM = BADNUM + 1;     # INCREMENT COUNT #
            FOUND = FALSE;           # CATALOG NOT ATTACHED #
            END  # ERROR OTHER THAN FILE BUSY OR UTILITY ACTIVE #
 
          ZSETFET(LOC(SC$FET[0]),CAT$PFN,0,0,SFETL);
          RETERN(SC$FET[0],RCL);
 
          END  # CHECK CATALOG FOR EACH SUBFAMILY #
 
        IF FOUND
        THEN
          BEGIN  # IF EIGHT CATALOGS EXIST #
          NAMEFAM[NFAM] = FAM$NAME[I];  # SAVE FAMILY NAME #
          NFAM = NFAM + 1;           # INCREMENT FAMILY COUNT #
          END  # IF EIGHT CATALOGS EXIST #
 
        ELSE
          BEGIN  # CHECK FOR AT LEAST ONE SUCCESSFUL ATTACH #
          IF ATLEASTONE
          THEN
            BEGIN  # OUTPUT MESSAGE FOR EACH BAD FILE #
            SLOWFOR J = 0 STEP 1 WHILE J LS BADNUM
            DO
              BEGIN  # FOR EACH BAD FILE #
              MSG$LINE[0] = " ATTACH ERROR ON SFM SUBFAMILY CATALOG.";
              MESSAGE(MSGBUF,UDFL1);
 
              MSGPFN[0] = BAD$PFN[J];
              MSGFAM[0] = BAD$FAM[J];
              MSGUI[0] = BAD$INDEX[J];
 
              MSG$LINE[0] = MSG$TEXT[0];
              RMVBLNK(MSGBUF[0],40);
              MESSAGE(MSGBUF,UDFL1);
              END  # FOR EACH BAD FILE #
 
            END  # OUTPUT MESSAGE FOR EACH BAD FILE #
 
          END  # CHECK FOR AT LEAST ONE SUCCESSFUL ATTACH #
 
        END  # CHECK ALL FAMILIES FOR EIGHT CATALOGS #
 
      NFAM = NFAM - 1;               # SET FAMILY COUNT #
 
#
*     SET THE FATAL ERROR FLAG IF THERE ARE NO FAMILIES WITH
*     EIGHT *SFM* CATALOGS.
#
 
      IF NFAM EQ 0
      THEN
        BEGIN  # NO FAMILY WITH 8 CATALOGS FOUND #
        FATALERR = TRUE;
 
        MSG$LINE[0] = " INITIALIZATION PROBLEMS -";
        MESSAGE(MSGBUF[0],UDFL1);
 
        MSG$LINE[0] = " NO FAMILY WITH 8 CATALOGS FOUND.";
        MESSAGE(MSGBUF[0],UDFL1);
        END  # NO FAMILY WITH 8 CATALOGS FOUND #
 
      END  # INITFAM #
 
    TERM
PROC INITFLG;
# TITLE INITFLG - INITIALIZES ASSORTED FLAGS AND COUNTERS.            #
 
      BEGIN  # INITFLG #
 
#
**    INITFLG - INITIALIZES ASSORTED FLAGS AND COUNTERS.
*
*     THIS PROCEDURE WILL INITIALIZE ASSORTED FLAGS AND COUNTERS.
*
*     PROC      INITFLG.
*
*     EXIT      FLAGS HAVE BEEN INITIALIZED.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBLBL
*CALL COMBMAT
*CALL COMBUCR
*CALL COMBUDT
*CALL COMXBST
*CALL COMXCTF
*CALL COMXINT
                                               CONTROL EJECT;
 
#
*     INITIALIZE FLAGS.
#
 
      CURESERVED = FALSE;            # CONTROLLER RESERVED FLAG #
      DRVRRECALL = FALSE;            # DRIVER RECALL FLAG #
      DRYUP = FALSE;                 # DRY-UP FLAG #
      EXEC = TRUE;                   # MSAS EXECUTIVE FLAG #
      GLBINTLK = FALSE;              # GLOBAL CATALOG INTERLOCK FLAG #
      GLBSTFL = TRUE;                # GLOBAL STAGE FLAG #
      GLBDSFL = TRUE;                # GLOBAL DESTAGE FLAG #
      GLBUCPSW = FALSE;              # GLOBAL *UCP* SWAPPED FLAG #
      LABELBUSY = FALSE;             # LABEL BUFFER BUSY FLAG #
      TERMINATE = FALSE;             # TERMINATE FLAG #
 
#
*     INITIALIZE COUNTS.
#
 
      SMCNT = NSM;                   # NUMBER OF *SM-S* #
      FAMCNT = NFAM;                 # NUMBER OF FAMILIES #
      PPCBENCNT = 0;                 # CALL BLOCK ACTIVE ENTRY COUNT #
 
#
*     INITIALIZE THRESHOLDS.
#
 
 
#
*     INITIALIZE DELAY EXPIRATION TIMES.
#
 
      ITLK$EXPIR = 0;                # RECLAIM CATALOG INTERLOCKS #
      MINQ$EXPIR = 0;                # MINIMUM QUEUE DELAY EXPIRATION #
      KDIS$EXPIR = 0;                # K-DISPLAY REFRESH #
 
#
*     INITIALIZE ASSORTED POINTERS.
#
 
      SFBLKPTR = LOC(SFPARMBLK);
      END  # INITFLG #
 
    TERM
PROC INITLZR;
# TITLE INITLZR - SEQUENCES *SSEXEC-S* INITIALIZATION STEPS.          #
      BEGIN  # INITLZR #
 
#
***   INITLZR - SEQUENCES *SSEXEC-S* INITIALIZATION STEPS.
*
*     THIS ROUTINE WILL MAKE CALLS TO SUBROUTINES AND MACROES TO
*     PERFORM ALL NON-HARDWARE INITIALIZATION STEPS FOR *SSEXEC*.
*
*     PROC      INITLZR.
*
*     ENTRY     CALLED FROM *SSEXEC*.
*
*     EXIT      PARAMETERS HAVE BEEN PROCESSED AND ALL NON-HARDWARE
*               INITIALIZATION STEPS HAVE BEEN EXECUTED OR THE FATAL
*               ERROR FLAG HAS BEEN SET.
*
*     NOTES     THIS INITIALIZATION ROUTINE MAKES PROCEDURE CALLS TO
*               DO THE FOLLOWING:
*
*                 1) GET THE RUN TIME PARAMETERS,
*                 2) INITIALIZE SUBFAMILY PARAMETERS,
*                 3) INITIALIZE ASSORTED FLAGS,
*                 4) INITIALIZE ASSORTED TABLES,
*                 5) INITIALIZE FOR MULTI-MAINFRAMES,
*                 6) ADVISE SYSTEM OF KEYBOARD BUFFER,
*                 7) REQUEST ACTIVE SUBSYSTEM STATUS,
*                 8) INITIALIZE UDT INTERFACE,
*                 9) INITIALIZE *TDAM* INTERFACE.
#
 
#
****  PROC INITLZR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CALLSS;                 # ISSUES REQUEST TO SUBSYSTEM #
        PROC GETMI;                  # GETS MACHINE INFORMATION #
        PROC GETRTP;                 # GETS RUN TIME PARAMETERS #
         PROC GETSPS;              # GET SYSTEM ORIGIN PRIVILEDGES #
        PROC GETUDT;                 # GETS UNIT DEVICE TABLE #
        PROC INITDAM;                # INITIALIZES *TDAM* INTERFACE #
        PROC INITFAM;                # INITIALIZE SUBFAMILY PARAMETERS
                                     #
        PROC INITFLG;                # INITIALIZES FLAGS #
      PROC OPENCAT;   # OPEN CATALOGS AND MAPS #
        PROC INITSRP;                # INITIALIZES FOR *MMF* MODE #
        PROC INITTAB;                # INITIALIZES ASSORTED TABLES #
        PROC KINIT;                  # INITIALIZES *K* DISPLAY #
        PROC RTIME;                  # INTERFACE TO *RTIME* MACRO #
        END
 
#
****  PROC INITLZR - XREF LIST END.
#
 
      DEF NOPARAM    #-1#;           # NO PARAMETER SPECIFIED #
      DEF SECOND     #1#;            # SWITCH FOR SECOND BUFFER #
      DEF SS$SYS     #0#;            # REQUEST SUBSYSTEM STATUS CODE #
      DEF RSLEN    #1#;              # RETURN USER STATUS #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBUCR
*CALL COMXCTF
*CALL COMXEXP
*CALL COMXINT
*CALL,COMXJCA
      ITEM FAMSRP     C(7);          # FAMILY FOR *INITSRP* #
      ITEM MFINDEX    U;             # MACHINE INDEX FOR *INITSRP* #
      ITEM PBLOCK     U = 0;         # PARAMETER BLOCK #
      ITEM SS         U;             # SUBSYSTEM QUEUE PRIORITY #
 
 
       ARRAY SPSSTAT  [0:0] S(RSLEN);
        BEGIN
        ITEM SPS$STATUS   U(00,48,12);   # RETURN STATUS #
        END
 
                                               CONTROL EJECT;
 
#
*     READ AND SAVE RTIME.
#
 
      RTIME(RTIMESTAT);
      FIRSTRTIME = RTIMSECS[0];
 
#
*     CHECK SYSTEM ORIGIN PRIVILEDGES.
#
 
 
      GETSPS(SPSSTAT);
      IF SPS$STATUS NQ 0
      THEN
        BEGIN
        FATALERR = TRUE;
        END
 
#
*     SET UP *RA* POINTER.
#
 
      P<RA$AREA> = 0;
 
#
*     CALL *GETRTP* TO PROCESS RUN TIME PARAMETERS.
#
 
      GETRTP;
 
      IF FATALERR
      THEN
        BEGIN  # IF FATAL ERROR #
        RETURN;
        END  # IF FATAL ERROR #
 
#
*     CALL *INITFAM* TO INITIALIZE SUBFAMILY PARAMETERS.
#
 
      INITFAM;
 
      IF FATALERR
      THEN
        BEGIN  # IF FATAL ERROR #
        RETURN;
        END  # IF FATAL ERROR #
 
#
*     CALL *INITFLG* TO INITIALIZE ASSORTED FLAGS.
#
 
      INITFLG;
 
#
*     CALL *INITTAB* TO INITIALIZE ASSORTED TABLES.
#
 
      INITTAB;
 
      IF FATALERR
      THEN
        BEGIN
        RETURN;
        END
 
#
*     CALL *INITSRP* TO INITIALIZE FOR MULTI-MAINFRAMES.
#
 
      GETMI(CMRINFO,EVENT);
 
      EESET$EVT = EESET$ASXE;            # MSAS SET UP #
      EESET$ASXE = 0;
 
      IF ARG$SC EQ NOPARAM
      THEN
        BEGIN  # *S* NOT SPECIFIED #
        FAMSRP = FAM$NAME[LINK$ORD[0]];
        MFINDEX = CMR$MFID[0];
        END  # *S* NOT SPECIFIED #
 
      ELSE
        BEGIN  # *S* PARAMETER SPECIFIED #
        FAMSRP = DEF$FAM;
        MFINDEX = ARG$S;
        END  # *S* PARAMTER SPECIFIED #
 
      INITSRP(CMR$MID[0],MFINDEX,FAMSRP);
 
#
*     CALL *KINIT* TO INITIALIZE *K* DISPLAY.
#
 
      KINIT;
 
#
*     CALL *CALLSS* MACRO TO REQUEST ACTIVE SUBSYSTEM STATUS AND
*     INITIALIZE RA.SSC AND *UCPPARMSW* FOR INCOMING *UCP* REQUESTS.
*     *UPCPARMSW* INDICATES WHICH BUFFER THE NEXT *UCP* REQUEST
*     WILL USE.
#
 
      SS = SS$SYS;                   # REQUEST ACTIVE STATUS CODE #
      CALLSS(SS,PBLOCK,NRCL);        # REQUEST ACTIVE STATUS #
 
      RA$SSWWRD[0] = 0;
      RA$SSCINLK = FALSE;
      RA$SSCPP = TRUE;
      RA$SSCXP = 0;
      RA$SSCVF = TRUE;
      RA$SSCLP = CPRLEN + 2;
      RA$SSCAP = LOC(PRAMUCP);       # SET *UCP* PARAMETER ADDRESS #
      RA$SSPN = "SSEXEC";
      RA$SSCODE = SSID;
      UCPPARMSW = SECOND;            # SET NEXT BUFFER SWITCH #
 
#
*     CALL *GETUDT* TO INITIALIZE UDT INTERFACE.
#
 
      GETUDT;
 
      IF FATALERR
      THEN
        BEGIN  # IF FATAL ERROR #
        RETURN;
        END  # IF FATAL ERROR #
 
#
*     CALL OPENCAT TO INITIALIZE THE OCT AND OMT TABLES AND
*     TO FIND ANY DESCREPENCIES IN THE AST.
#
      OPENCAT;
 
#
*     INITIALIZE *TDAM* INTERFACE AND ISSUE EVENT TO SWAP IN JOBS
*     WAITING FOR *MSAS*.
#
 
      INITDAM;
 
      END  # INITLZR #
 
    TERM
PROC INITSRP((MID),(MIDX),(LINKFAM));
# TITLE INITSRP - INITIALIZE SLAVE REQUEST PROCESSOR.                 #
 
      BEGIN  # INITSRP #
 
#
**    INITSRP  - INITIALIZE THE SLAVE REQUEST PROCESSOR.
*
*     *INITSRP* INITIALIZES THE *SSEXEC* FOR MULTIMAINFRAME
*     PROCESSING.  IT WILL INITIALIZE THE *MTOS* FILE WHICH IS USED TO
*     COMMUNICATE WITH EACH *SLVEXEC*.  IT WILL ALSO ATTACH IN
*     READ-ALLOW-MODIFY MODE THE *STOM* FILES FROM ALL POSSIBLE SLAVE
*     MAINFRAMES SO STAGING REQUESTS FROM *SLVEXEC* PROGRAMS CAN BE
*     ACCEPTED AND PROCESSED.
*
*     PROC INITSRP((MID),(MIDX),(LINKFAM))
*
*     ENTRY      (MID) =  2 CHARACTER ID OF THE MASTER MAINFRAME.
*                (MIDX) = MACHINE INDEX (1-4) OF THE MASTER MAINFRAME.
*                (LINKFAM) = NAME OF THE FAMILY ON WHICH THE
*                            COMMUNICATION FILES RESIDE, OR ARE TO
*                            RESIDE.
*
*     EXIT       THE VARIABLES *STOM$EXPIR* AND *MTOS$EXPIR* (IN
*                *COMXCTF*) ARE INITIALIZED TO INDICATE THE TIMES WHEN
*                THE *STOM* FILES SHOULD BE MONITORED AND THE *MTOS*
*                FILE SHOULD BE UPDATED, RESPECTIVELY.  IF THE
*                *SSEXEC* IS TO RUN IN SINGLE MAINFRAME MODE, THESE
*                TIMES ARE SET TO THE LARGEST POSSIBLE VALUE.
*
*     NOTES      THE *SSEXEC* WILL RUN IN SINGLE MAINFRAME MODE IF ANY
*                OF THE FOLLOWING CONDITIONS ARE MET.
*                            1) THE MAINFRAME IS NOT IN MULTIMAINFRAME
*                               MODE.
*                            2) THE *SETPFP* REQUEST FAILS.
*                            3) THE *MTOS* FILE EXISTS, BUT CANNOT BE
*                               ATTACHED IN MODIFY MODE.
*                            4) THE *MTOS* FILE DOES NOT EXIST, BUT
*                               CANNOT BE DEFINED.
*                            5) NO VALID SLAVE MAINFRAMES CAN BE
*                               IDENTIFIED.
*
*                ANOTHER MAINFRAME WILL NOT BE RECOGNIZED AS A VALID
*                SLAVE MAINFRAME IF ANY OF THE FOLLOWING IS TRUE.
*                            1) THE *STOM* FILE CANNOT BE ATTACHED IN
*                               READ-ALLOW-MODIFY MODE.
*
*                            2) THE LENGTH OF THE *STOM* FILE INDICATES
*                               THAT THE *SLVEXEC* IS WORKING WITH A
*                               DIFFERENT SET OF INSTALLATION
*                               PARAMETERS.
*
*     MESSAGES
*                * EXEC MMF INITIALIZATION OK.*
*                      AN INFORMATIVE MESSAGE NOTING THAT *SSEXEC*
*                      IS READY TO RUN IN MULTIMAINFRAME MODE.
*
*                * EXEC MMF INITIALIZATION FAILED -*
*                *     - ALL SLAVES OMITTED.*      -OR-
*                *     - ATTACH MTOS FAILED.*      -OR-
*                *     - DEFINE MTOS FAILED.*      -OR-
*                *     - MTOS FILE BUSY.*          -OR-
*                *     - SETPFP PROBLEM.*
*                      A MESSAGE INDICATING THAT THE *SSEXEC* PROGRAM
*                      WILL NOT RUN IN MULTIFRAME MODE FOR THE REASON
*                      NOTED ON THE SECOND LINE.
*
*                * EXEC IN SINGLE MAINFRAME MODE.*
*                      AN INFORMATIVE MESSAGE INDICATING THAT THE
*                      *SSEXEC* PROGRAM IS RUNNING IN A SINGLE
*                      MAINFRAME CONFIGURATION.
*
*                * EXEC - SLAVE N XXXX.*
*                                 XXXX = ACTIVE/IDLE.
*                      AN INFORMATIVE MESSAGE INDICATING THAT *SSEXEC*
*                      IS READY TO COMMUNICATE WITH THE *SSSLV*
*                      PROGRAM WHICH IS RUNNING ON MAINFRAME *N*.
*
*                * EXEC - SLAVE N OMITTED -*
*                *     - NO STOM FILE.*      -OR-
*                *     - STOM FILE LENGTH PROBLEM.*
*                      A MESSAGE INDICATING THAT *SSEXEC* WILL NOT
*                      COMMUNICATE WITH AN *SSSLV* PROGRAM, IF ANY, ON
*                      MAINFRAME *N* FOR THE REASON NOTED IN THE
*                      SECOND LINE.
*
#
 
 
      ITEM MID        C(2);          # MACHINE ID OF MASTER MF #
      ITEM MIDX       U;             # INDEX (1-4) OF MASTER MF #
      ITEM LINKFAM    C(7);          # NAME OF LINK FAMILY #
 
#
****  PROC INITSRP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC MESSAGE;                # ISSUES MESSAGE MACRO #
        PROC PDATE;                  # ISSUE PDATE MACRO #
        PROC PFD;                    # PERMANENT FILE REQUEST DELAYS #
        PROC READ;                   # READ FILE #
        PROC READW;                  # READ LINE #
        PROC REWIND;                 # REWIND FILE #
        PROC RETERN;                 # RETURN FILE #
        PROC RTIME;                  # ISSUE RTIME MACRO #
        PROC SETPFP;                 # ISSUE SETPFP MACRO #
        PROC WRITER;                 # WRITE FILE #
        FUNC XCOD C(10);             # INTEGER TO DISPLAY #
        PROC ZFILL;                  # ZERO FILL AN ARRAY #
        PROC ZSETFET;                # INITIALIZE *FET* #
        END
 
#
****  PROC INITSRP - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
 
 
*CALL,COMBFAS
*CALL,COMBFET
*CALL,COMBPFP
*CALL COMBPFS
*CALL,COMXCTF
*CALL COMXINT
*CALL,COMXIPR
*CALL,COMXMMF
*CALL,COMSPFM
 
 
 
      ARRAY MMFSTAT [0:0] S(4);
        BEGIN
        ITEM MMF$TEXT   C(00,00,38)  # INITIALIZATION STATUS #
          =[" EXEC MMF INITIALIZATION STATUS"];
        ITEM MMF$STAT   C(02,30,09);  # OK/FAILED - #
        ITEM MMF$END    U(03,48,12) =[0];  # END OF LINE #
        END
 
 
      ARRAY RBBUF [0:0] S(RBSIZE);;  # SCRATCH BUFFER #
 
 
 
      ITEM PFNAME     C(7);          # PERMANENT FILE NAME #
      ITEM RB         U;             # INDEX TO A REQUEST BLOCK #
      ITEM STAT       U;             # SCRATCH STATUS WORD #
      ITEM STATM      S:EXECSTAT;    # STATUS OF MMF INITIALIZATION #
      ITEM STATS      S:EXECSTAT;    # STATUS OF A SLAVE #
      ITEM THISSLV    U;             # SCRATCH WORD #
 
                                               CONTROL EJECT;
 
#
*     INITIALIZE VARIOUS ITEMS AND POINTERS.
#
 
      STATM = S"INITPROB";
      L$STOM = (NUMRB + 1) * RBSIZE;
      L$MTOSH = (MAXSLV + 1) * 3;
      L$MTOS = L$MTOSH + NUMRB * NUMSLV;
      P<MTOSHEAD> = LOC(MTOS$BUF);
      P<MTOSM> = LOC(MTOB$FET);
      P<STOMMBUF> = LOC(STOM$BUF);
      STOMBUFL = STOM$BFL;
 
      ZSETFET(LOC(MTOSM),MTOSMLFN,LOC(MTOSHEAD),L$MTOS + 1,SFETL);
 
      IF MIDX EQ 0
      THEN                           # SINGLE MAINFRAME MODE #
        BEGIN
        STATM = S"SMF";
        GOTO INITMASTER;
        END
 
#
*     ISSUE A *SETPFP* SO THE COMMUNICATION FILES
*     CAN BE ATTACHED.
#
 
      PFP$WRD0[0] = 0;
      PFP$FAM[0] = LINKFAM;
      PFP$FG1[0] = TRUE;             # CHANGE FAMILY #
      PFP$FG4[0] = TRUE;             # CHANGE USER INDEX #
      PFP$UI[0] = DEF$UI;
      SETPFP(PFP);
      IF PFP$STAT[0] NQ 0
      THEN
        BEGIN
        MMFD$PROB[0] = "SETPFP PROBLEM.";
        GOTO INITMASTER;
        END
 
#
*     ATTACH THE *MTOS* FILE IN MODIFY MODE,
*     AND READ IT TO THE *MTOS* BUFFER.
*     USE THE *STOM* FILE BUFFER AND *FET* TO READ THE *MTOS* FILE.
#
 
      ZSETFET(LOC(STOMM),MTOSMLFN,LOC(STOMMBUF),STOMBUFL,SFETL);
      PFD("ATTACH",MTOSMLFN,MTBSPFN,"PW",MTOSPW,
         "M","M", "RC",PFSTAT,"NA",0,"UP",0,0);
      IF PFSTAT EQ FBS
      THEN                           # FILE BUSY #
        BEGIN
        MMFD$PROB[0] = "MTOS FILE BUSY.";
        GOTO INITMASTER;
        END
 
 
      IF PFSTAT EQ OK
      THEN                           # READ *MTOS* #
        BEGIN
        READ(STOMM,RCL);
        READW(STOMM,MTOSHEAD,L$MTOS,STAT);
        END
 
 
 
      IF PFSTAT NQ OK                ##
        OR MSH$NUMSLV[0] NQ NUMSLV   ##
        OR MSH$NUMRB[0] NQ NUMRB
      THEN                           # INITIALIZE THE *MTOS* FILE #
        BEGIN
        PFSTAT = 1;
        MSH$NUMSLV[0] = NUMSLV;
        MSH$NUMRB[0] = NUMRB;
        STAT = 1;
        END
 
#
*     INITIALIZE THE MASTER STATUS INFORMATION.
#
 
      MSH$PFNM[0] = MTBSPFN;
      MSH$MIDM[0] = MID;
      MSH$MIDX[0] = MIDX;
 
 
      IF PFSTAT NQ OK
      THEN
        BEGIN  # CREATE *MTOS* #
 
#
*     CREATE A NEW *MTOS* PERMANENT FILE WHICH
*     HAS THE MASTER HEADER INFORMATION.
*     REATTACH THE *MTOS* FILE IN MODIFY MODE
*     SO THE *SSSLV* PROGRAMS CAN READ IT.
#
 
        RETERN(STOMM,RCL);
        PFD("PURGE",MTBSPFN,"PW",MTOSPW,"RC",PFSTAT,"UP",0,0);
        PFD("DEFINE",MTOSMLFN,MTBSPFN,"PW",MTOSPW,"BR","N", "R",
          LINK$DT[0],"RC",PFSTAT,"UP",0,0);
        IF PFSTAT NQ OK
        THEN                         # CAN NOT DEFINE #
          BEGIN
          MMFD$PROB[0] = "DEFINE MTOS FAILED.";
          GOTO INITMASTER;
          END
 
        P<FETSET> = LOC(MTOSM);
        FET$IN[0] = FET$FRST[0] + L$MTOS;
        WRITER(MTOSM,RCL);
        PFD("ATTACH",MTOSMLFN,MTBSPFN,"PW",MTOSPW,"M","M", "RC",PFSTAT
          ,"NA",0,"UP",0,0);
        IF PFSTAT NQ OK
        THEN                         # ABNORMAL ERROR #
          BEGIN
          MMFD$PROB[0] = "ATTACH MTOS FAILED.";
          GOTO INITMASTER;
          END
 
        END  # CREATE *MTOS* #
 
      STATM = S"ACTIVE";
 
 
 
 
#
*     ATTACH AND READ THE *STOM* COMMUNICATION FILE
*     FROM EACH POSSIBLE SLAVE AND INITIALIZE THE
*     HEADER AND EACH REPLY BLOCK STATUS FOR EACH SLAVE.
#
 
      SINDX = 1;
      P<STOMFILE> = LOC(RBBUF);
      FASTFOR DUMMY = 1 STEP 1 UNTIL MAXSLV + 1
      DO
        BEGIN  # INITIALIZE EACH SLAVE #
        IF DUMMY EQ MIDX OR          ##
          SINDX GR NUMSLV
        THEN                         # BYPASS THIS *MF* #
          BEGIN
          TEST DUMMY;
          END
 
        P<MTOSREPBLK> = LOC(MTOSHEAD) + L$MTOSH + (SINDX-1)*NUMRB;
        PFNAME = STOMPFN;
        CHAR10 = XCOD(DUMMY);
        CHAR1 = C<9,1>CHAR10;
        B<36,6>PFNAME = CHAR1;
        SLVN$INDX[0] = CHAR1;
        MSH$PFNS[SINDX] = PFNAME;
 
#
*     ATTACH AND READ THE *STOM* FILE FOR THIS SLAVE
#
 
        PFD("ATTACH",PFNAME,0,"PW",STOMPW,"M","RM","RC",PFSTAT, "NA",0
          ,"UP",0,0);
        IF PFSTAT NQ OK
        THEN                         # REJECT SLAVE #
          BEGIN
          STATS = S"OMIT";
          MMFD$PROB[0] = "NO *STOM* FILE.";
          GOTO INITSLAVE;
          END
 
        ZSETFET(LOC(STOMM),PFNAME,LOC(STOMMBUF),STOMBUFL,SFETL);
        READ(STOMM,NRCL);
        READW(STOMM,RBBUF,RBSIZE,STAT);
        MMFD$PROB[0] = "STOM FILE LENGTH PROB.";
        IF STAT NQ OK
        THEN                         # REJECT SLAVE #
          BEGIN
          STATS = S"OMIT";
          GOTO INITSLAVE;
          END
 
        PDATE(PDATESTAT[0]);
        RTIME(RTIMESTAT[0]);
 
#
*     INITIALIZE THE *MTOS* FILE HEADER
*     TO INDICATE THE SLAVE EXEC STATUS.
#
 
        MSH$SSW[SINDX] = SM$SSW[0];
        MSH$MIDS[SINDX] = SM$MIDS[0];
 
        IF SM$IDLE[0]
        THEN
          BEGIN
          STATS = S"IDLE";
          SLVN$STAT[0] = "IDLE.";
          MSH$TIMOUT[SINDX] = MAXSECS;
          END
 
        ELSE
          BEGIN
          STATS = S"ACTIVE";
          SLVN$STAT[0] = "ACTIVE.";
          MSH$TIMOUT[SINDX] = RTIMSECS[0] + SLAV$INTV;
          END
 
#
*     CHECK THE LENGTH OF THE *STOM* FILE AND
*     INITIALIZE THE MASTER REPLY CODE FIELDS.
#
 
        FASTFOR RB = 1 STEP 1 UNTIL NUMRB
        DO
          BEGIN  # CHECK LENGTH OF THE *STOM* FILE #
          READW(STOMM,RBBUF,RBSIZE,STAT);
          IF STAT NQ OK
          THEN
            BEGIN
            STATS = S"OMIT";
            GOTO INITSLAVE;
            END
 
          IF MSR$MRC[RB] EQ S"ACCEPTED"
          THEN                       # INITIALIZE REPLY CODE AND STATUS
                                       FIELDS #
            BEGIN
            MSR$MRC[RB] = S"FINISHED";
            MSR$REPLY[RB] = S"ABANDONED";
            MSR$PDATE[RB] = PDATEV[0];
            END
 
          END  # CHECK LENGTH OF THE *STOM* FILE #
 
INITSLAVE:
 
        MSH$STATS[SINDX] = STATS;
        IF STATS EQ S"ACTIVE" OR STATS EQ S"IDLE"
        THEN                         # SLAVE IS DEFINED #
          BEGIN
          MSH$DEFD[SINDX] = TRUE;
          SLAVECTR = SLAVECTR + 1;
          MESSAGE(SLVNSTAT,SYSUDF1);
          SINDX = SINDX + 1;
          END
 
        ELSE                         # SLAVE IS NOT DEFINED #
          BEGIN
          MSH$DEFD[SINDX] = FALSE;
          SLVN$STAT[0] = "OMITTED - ";
          MESSAGE(SLVNSTAT,SYSUDF1);
          MESSAGE(MMFDETAIL,SYSUDF1);
          END
 
        END  # INITIALIZE EACH SLAVE #
 
 
 
INITMASTER:
 
#
*     ESTABLISH THE NEXT TIME TO CALL THE SLAVE
*     REQUEST PROCESSOR AND TO FLUSH THE *MTOS* BUFFERS.
*     ISSUE A MESSAGE WITH THE FINAL INITIALIZATION STATUS.
#
 
      MTOS$EXPIR = MAXSECS;
      STOM$EXPIR = MAXSECS;
      IF STATM EQ S"SMF"
      THEN
        BEGIN
        MMF$TEXT[0] = " EXEC IN SINGLE MAINFRAME MODE.";
        MESSAGE(MMFSTAT,SYSUDF1);
        RETURN;
        END
 
      IF STATM EQ S"ACTIVE"
      THEN                           # TEST IF ALL SLAVES OMITTED #
        BEGIN  # CHECK SLAVE STATUS #
        IF SLAVECTR NQ 0
        THEN
          BEGIN
          MTOS$EXPIR = 0;
          STOM$EXPIR = 0;
          MMF$STAT[0] = "OK.";
          MESSAGE(MMFSTAT,SYSUDF1);
          RETURN;
          END
 
        ELSE
          BEGIN
          MMFD$PROB[0] = "ALL SLAVES OMITTED.";
          END
 
        END  # CHECK SLAVE STATUS #
 
      MMF$STAT[0] = "FAILED - ";
      MESSAGE(MMFSTAT,SYSUDF1);
      MESSAGE(MMFDETAIL,SYSUDF1);
      RETERN(MTOSM,RCL);
      RETURN;
      END  # INITSRP #
 
    TERM
PROC INITTAB;
# TITLE INITTAB - INITIALIZES ASSORTED TABLES.                        #
      BEGIN  # INITTAB #
 
#
**    INITTAB - INITIALIZES ASSORTED TABLES.
*
*     THIS ROUTINE WILL INITIALIZE TABLES USED BY *SSEXEC* AND CREATE
*     THE MEMORY ALLOCATION TABLE (*MAT*) WHICH DESCRIBES THE *FWA* OF
*     EACH TABLE, THE ENTRY COUNT AND THE SPACE ALLOCATED FOR EACH
*     TABLE.
*
*     EXIT      TABLES DEFINED IN THE *MAT* HAVE BEEN INITIALIZED.
*
*     MESSAGES  SSEXEC SEEKING FL INCREASE.
*               SSEXEC ACTIVE.
*               EXEC ABNORMAL - INITTAB.
#
 
#
****  PROC INITTAB - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # CALLS ABORT MACRO #
        PROC CALCTS;                 # CALCULATES TABLE SPACE #
        PROC INITTS;                 # INITIALIZES TABLES #
        PROC MEMORY;                 # CALLS MESSAGE MACRO #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC MNGMEM;                 # CHANGES FIELD LENGTH #
        PROC MSG;                    # CALLS *MESSAGE* MACRO #
        PROC RECALL;                 # CALLS RECALL MACRO #
        FUNC XCDD C(10);             # INTEGER TO DECIMAL DISPLAY #
        PROC ZFILL;                  # ZEROES BUFFER SPACE #
        END
 
#
****  PROC INITTAB - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBMAT
*CALL COMXACM
*CALL COMXCTF
*CALL COMXMSC
*CALL COMXINT
*CALL,COMXJCA
 
      ITEM DC$FL      C(10);         # CHARACTER FIELD FOR *XCDD* #
      ITEM FLCHNG     I;             # FIELD LENGTH CHANGE AMOUNT #
      ITEM I          U;             # INDEX #
      ITEM RCLFLAG    B;             # *FL* ACCESS DELAY FLAG #
      ITEM RESP       U;             # RESPONSE FROM *MNGMEM* #
      ITEM TLAST      U;             # LAST TABLE WORD #
      ITEM TLEN       U;             # TABLE LENGTH #
      ITEM TSTART     U;             # FIRST TABLE WORD #
 
#
*     ARRAY FOR *ZFILL* PROCEDURE.
#
 
      BASED
      ARRAY DUMAR[0:0] P(1);
      ;
 
 
#
*     MESSAGE BUFFER.
#
 
      ARRAY MSGBUF[0:0] P(5);
        BEGIN  # ARRAY MSGBUF #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$RZRO   C(04,00,12);  # ZERO BYE TERMINATOR #
        END  # ARRAY MSGBUF #
 
      ARRAY STATARY[0:0] P(1);       # STATUS FOR MEMORY MACRO #
        BEGIN  # STATARY #
        ITEM STAT       U(00,00,30);  # STATUS #
        ITEM ZEROFL     U(00,30,30);  # ZERO FILL REST OF WORD #
        END  # STATARY #
 
                                               CONTROL EJECT;
 
#
*     CALL *CALCTS* TO CALCULATE THE ENTRY COUNTS AND THE TABLE SPACE
*     REQUIRED.
#
 
      CALCTS;
 
      P<RA$AREA> = 0;                # POINTER TO *RA* AREA #
 
#
*     CYCLE THROUGH ARRAY *MAT* CALCULATING THE *FWA* OF EACH ENTRY
*     BASED ON THE *FWA* AND SPACE REQUIRED OF THE PREVIOUS ENTRY.
#
 
      NEXTADR = RA$HHA;              # FOR *MNGMEM* OPERATIONS #
      MAT$FWA[0] = RA$HHA;           # USE NEXT AVAILABLE FOR FIRST #
 
      SLOWFOR I = 1 STEP 1           ##
        WHILE I LS MAT$ENTRY"MAT$LAST"
      DO
        BEGIN
        MAT$FWA[I] = MAT$FWA[I-1] + MAT$SPACE[I-1];
        END
 
#
*     GET THE MEMORY REQUIRED FOR THE VARIABLE TABLES.
#
 
      STAT = 0;                      # REQUEST CURRENT *FL* #
      MEMORY("CM",STATARY,RCL,NA);
 
      IF STAT EQ 0
      THEN
        BEGIN  # IF CURRENT *FL* NOT RETURNED #
        FE$RTN[0] = "INITTAB.";      # SET ROUTINE INTO ERROR MESSAGE #
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END  # IF CURRENT *FL* NOT RETURNED #
 
      CUR$FL = STAT;                 # USED BY *MNGMEM* #
      MAX$FL = CUR$FL;               # SET MAXIMUM *FL* #
      UNU$FL = CUR$FL - NEXTADR;
      FLCHNG = MAT$FWA[MAT$ENTRY"MAT$LAST" - 1] +  ##
        MAT$SPACE[MAT$ENTRY"MAT$LAST" - 1] - NEXTADR;
      RCLFLAG = FALSE;               # DELAY FLAG #
 
      SLOWFOR I = 0 WHILE RESP EQ 0
      DO
        BEGIN  # LOOP UNTIL *FL* INCREASE SATISFIED #
        MNGMEM(FLCHNG,RESP);         # REQUEST *FL* INCREASE #
        IF RESP EQ 0
        THEN
          BEGIN  # IF ATTEMPT UNSUCCESSFUL #
          MSG$LINE[0] = "$SSEXEC SEEKING FL INCREASE.";
          MESSAGE(MSGBUF[0],LINE1);
          RECALL;
          RCLFLAG = TRUE;
          END  # IF ATTEMPT UNSUCCESSFUL #
 
        END  # LOOP UNTIL *FL* INCREASE SATISFIED #
 
      IF RCLFLAG
      THEN
        BEGIN  # IF *FL* ACCESS DELAYED #
        MSG$LINE[0] = " FL OBTAINED.";
        MESSAGE(MSG$LINE[0],LINE1);
        END  # IF *FL* ACCESS DELAYED #
 
        MSG("       ",SYSUDF1);
 
#
*     CALL *INITTS* TO PRESET INITIAL VALUES IN THE VARIABLE AND FIXED
*     TABLES.
#
 
 
      TSTART = MAT$FWA[MAT$ENTRY"HLRQ"];
      TLAST = MAT$FWA[MAT$ENTRY"MAT$LAST" -1] +  ##
        MAT$SPACE[MAT$ENTRY"MAT$LAST" -1];
      TLEN = TLAST - TSTART;
      P<DUMAR> = TSTART;
      ZFILL(DUMAR,TLEN);
 
      INITTS;
      END  # INITTAB #
 
    TERM
PROC INITTS;
# TITLE INITTS - PRESET ASSORTED TABLES.                              #
 
      BEGIN  # INITTS #
 
#
**    INITTS - PRESET ASSORTED TABLES.
*
*     THIS PROCEDURE WILL LINK TOGETHER ENTRIES TO FORM FREE SPACE
*     CHAINS AND PRESET VALUES IN TABLES USED BY *SSEXEC*.
*
*     EXIT      TABLE VALUES HAVE BEEN PRESET.
#
 
#
****  PROC INITTS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # ZERO FILLS WORD #
        PROC MESSAGE;                # ISSUE MESSAGE #
        FUNC XCOD C(10);             # CHANGES INTEGER TO DISPLAY #
        PROC ZFILL;                  # ZERO FILL BUFFER #
        END
 
#
****  PROC INITTS - XREF LIST END.
#
 
      DEF FILLSIZE   #7#;            # FILL SIZE FOR *BZFILL* #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCHN
*CALL COMBCMD
*CALL COMBFET
*CALL,COMBLBL
*CALL COMBLRQ
*CALL COMBMAT
*CALL COMBMCT
*CALL COMBTDM
*CALL COMBUDT
*CALL COMXBST
*CALL COMXCTF
*CALL COMXFCQ
*CALL COMXHLR
*CALL COMXINT
*CALL COMXLTC
*CALL COMXMSC
 
      ITEM FIRST      U;             # POINTER TO FIRST BUFFER WORD #
      ITEM I          U;             # INDEX #
      ITEM J          U;             # INDEX #
      ITEM MSGTEMP    C(7);          # TEMPORARY CHARACTER ITEM #
      ITEM ZEROFILL   S:TYPFILL = S"ZFILL";  # ZERO BUFFER FILL #
 
 
#
*     SMALL BUFFERS AND *FETS*.
#
 
      ARRAY CHARARY[0:0] P(1);
        BEGIN
        ITEM CHARTEMP   C(00,00,10);  # CHARACTER BUFFER #
        ITEM CHARID     C(00,42,03);  # CHARACTER *ID* #
        END
 
      ARRAY NAMEFILE[0:0] P(1);
        BEGIN  # NAMFILE #
        ITEM NAME$HDR   C(00,00,07) = ["FILE"];  # NAME HEADER #
        ITEM NAME$UNID  C(00,24,03);  # UNIQUE ID #
        END  # NAMFILE #
 
                                               CONTROL EJECT;
 
#
*     CHAIN ALL *HLRQ* ENTRIES TOGETHER AND PLACE A UNIQUE FILE NAME
*     INTO EACH ENTRY.  ALSO SET THE *CHN$BOC* AND *CHN$EOC* FIELDS
*     IN *COMBCHN* TO POINT TO THE BEGINNING AND END OF THE *HLRQ* FREE
*     SPACE CHAIN.
*
*     THE UNIQUE FILE NAMES ARE OBTAINED BY PLACING A NUMERIC
*     IDENTIFIER AT THE END OF THE WORD "FILE".  THE NUMERIC IDENTIFIER
*     IS INCREMENTED BY ONE FOR EACH NEW FILE NAME.
#
 
      P<HLRQ> = MAT$FWA[MAT$ENTRY"HLRQ"];  # POINT TO FIRST ENTRY #
      CHN$BOC[LCHN"HL$FRSPC"] = P<HLRQ>;  # BEGINNING OF CHAIN #
 
      SLOWFOR I = 1 STEP 1           ##
        WHILE I LQ MAT$COUNT[MAT$ENTRY"HLRQ"]
      DO
        BEGIN  # FOR ALL *HLRQ* ENTRIES #
        CHN$EOC[LCHN"HL$FRSPC"] = P<HLRQ>;  # END OF CHAIN POINTER #
 
        J = I + 100;
        CHARTEMP[0] = XCOD(J);       # CHANGE INDEX TO DISPLAY CODE #
        NAME$UNID[0] = CHARID[0];
        HLR$FLNM[0] = NAME$HDR[0];   # PLACE FILE NAME INTO ENTRY #
 
        HLR$LNK1[0] = P<HLRQ> + HLRQLEN;  # LINK TO NEXT ENTRY #
        P<HLRQ> = HLR$LNK1[0];       # POINT TO THE NEXT ENTRY #
        END  # FOR ALL *HLRQ* ENTRIES #
 
      P<HLRQ> = P<HLRQ> - HLRQLEN;   # POINT TO LAST ENTRY OF CHAIN #
      HLR$LNK1[0] = 0;               # CLEAR LAST POINTER #
 
 
#
*     CHAIN ALL *LLRQ* ENTRIES TOGETHER INTO A FREE SPACE CHAIN.
#
 
      P<LLRQ> = MAT$FWA[MAT$ENTRY"LLRQ"];  # POINT TO FIRST ENTRY #
      CHN$BOC[LCHN"LL$FRSPC"] = P<LLRQ>;  # BEGINNING OF CHAIN #
 
      SLOWFOR I = 1 STEP 1           ##
        WHILE I LQ MAT$COUNT[MAT$ENTRY"LLRQ"]
      DO
        BEGIN  # FOR ALL *LLRQ* ENTRIES #
        CHN$EOC[LCHN"LL$FRSPC"] = P<LLRQ>;  # END OF CHAIN POINTER #
        LLR$LINK1[0] = P<LLRQ> + LLRQENTL;  # LINK TO NEXT ENTRY #
        P<LLRQ> = LLR$LINK1[0];      # POINT TO NEXT ENTRY #
        END  # FOR ALL *LLRQ* ENTRIES #
 
      P<LLRQ> = P<LLRQ> - LLRQENTL;  # POINT TO LAST ENTRY OF CHAIN #
      LLR$LINK1[0] = 0;              # CLEAR LAST POINTER #
 
 
#
*     CHAIN ALL *RTRQ* ENTRIES TOGETHER INTO A FREE SPACE CHAIN.
#
 
      P<LINKWRD> = MAT$FWA[MAT$ENTRY"RTRQ"];  # POINT TO FIRST ENTRY #
      CHN$BOC[LCHN"RTD$FRSPC"] = P<LINKWRD>;  # BEGINNING OF CHAIN #
 
      SLOWFOR I = 1 STEP 1           ##
        WHILE I LQ MAT$COUNT[MAT$ENTRY"RTRQ"]
      DO
        BEGIN  # FOR ALL *RTRQ* ENTRIES #
        CHN$EOC[LCHN"RTD$FRSPC"] = P<LINKWRD>;  # END OF CHAIN #
        LINK$ADR[0] = P<LINKWRD> + TDAMLEN + 1;  # LINK TO NEXT ENTRY #
        P<LINKWRD> = LINK$ADR[0];    # POINT TO NEXT ENTRY #
        END  # FOR ALL *RTRQ* ENTRIES #
 
      P<LINKWRD> = P<LINKWRD> - TDAMLEN - 1;  # POINT TO LAST ENTRY #
      LINK$ADR[0] = 0;               # CLEAR LAST POINTER #
 
 
#
*     CHAIN ALL *FCTQ* ENTRIES TOGETHER INTO A FREE SPACE CHAIN.
#
 
      P<FCTQ> = MAT$FWA[MAT$ENTRY"FCTQ"];  # POINT TO FIRST ENTRY #
      CHN$BOC[LCHN"FCT$FRSPC"] = P<FCTQ>;  # BEGINNING OF CHAIN #
 
      SLOWFOR I = 1 STEP 1           ##
        WHILE I LQ MAT$COUNT[MAT$ENTRY"FCTQ"]
      DO
        BEGIN  # FOR ALL *FCTQ* ENTRIES #
        CHN$EOC[LCHN"FCT$FRSPC"] = P<FCTQ>;  # END OF CHAIN POINTER #
        FCTQLINK1[0] = P<FCTQ> + FCTQHL + FCTENTL;  # LINK TO NEXT #
        P<FCTQ> = FCTQLINK1[0];      # POINT TO NEXT ENTRY #
        END  # FOR ALL *FCTQ* ENTRIES #
 
      P<FCTQ> = P<FCTQ> - FCTQHL - FCTENTL;  # POINT TO LAST ENTRY #
      FCTQLINK1[0] = 0;              # CLEAR LAST POINTER #
 
 
#
*     SET THE AUTHORIZED FLAG IN THE FIRST *BST* ENTRY.
#
 
      P<BST> = MAT$FWA[MAT$ENTRY"BST"];  # POINT TO FIRST ENTRY #
      BST$AUTH[1] = TRUE;            # SET AUTHORIZED FLAG #
 
 
#
*     INITIALIZE THE CATALOG *FET*.
#
 
      P<FETSET> = MAT$FWA[MAT$ENTRY"CAT$FET"];  # POINT TO *FCT* FET #
 
      FIRST = MAT$FWA[MAT$ENTRY"CAT$BUF"];  # FIRST LOCATION POINTER #
      FET$IN[0] = FIRST;             # IN POINTER #
      FET$OUT[0] = FIRST;            # OUT POINTER #
      FET$LIM[0] = FIRST + SEQBL;    # LIMIT #
 
      FCTFADR = MAT$FWA[MAT$ENTRY"CAT$FET"];
      P<FCTFET> = FCTFADR;
 
 
#
*     INITIALIZE THE MAP *FET*.
#
 
      P<FETSET> = MAT$FWA[MAT$ENTRY"MAP$FET"];  # POINT TO *MAP* FET #
 
      FIRST = MAT$FWA[MAT$ENTRY"MAP$BUF"];  # FIRST LOCATION POINTER #
      FET$IN[0] = FIRST;             # IN POINTER #
      FET$OUT[0] = FIRST;            # OUT POINTER #
      FET$LIM[0] = FIRST + MAPBUFL;  # LIMIT #
 
      MAPFADR = MAT$FWA[MAT$ENTRY"MAP$FET"];
      P<MAPFET> = MAPFADR;
 
#
*     INITIALIZE THE TEMPORARY *FET*.
#
 
      P<FETSET> = MAT$FWA[MAT$ENTRY"TEMP$FET"];
 
      FIRST = MAT$FWA[MAT$ENTRY"TEMP$BUF"];  # FIRST LOCATION POINTER #
      FET$IN[0] = FIRST;             # IN POINTER #
      FET$OUT[0] = FIRST;            # OUT POINTER #
      FET$LIM[0] = FIRST + TBUFL;    # LIMIT #
 
      TFETADR = MAT$FWA[MAT$ENTRY"TEMP$FET"];
      P<TFET> = TFETADR;
 
#
*     INITIALIZE THE POINTERS TO THE BASED ARRAYS.
#
 
      ASTBADR = MAT$FWA[MAT$ENTRY"AST$BUF"];
 
      FCTBADR = MAT$FWA[MAT$ENTRY"CAT$BUF"];
      P<FCTBUF> = FCTBADR;
 
      MAPBADR = MAT$FWA[MAT$ENTRY"MAP$BUF"];
      P<MAPBUF> = MAPBADR;
 
      TBUFADR = MAT$FWA[MAT$ENTRY"TEMP$BUF"];
      P<TBUF> = TBUFADR;
 
      WBUFADR = MAT$FWA[MAT$ENTRY"TEMP$WB"];
      P<WBUF> = WBUFADR;
 
      OCTLEN = MAT$COUNT[MAT$ENTRY"OCT"];
      OCTADR = MAT$FWA[MAT$ENTRY"OCT"];
      P<OCT> = OCTADR;
 
      OMTADR = MAT$FWA[MAT$ENTRY"OMT"];
      P<OMT> = OMTADR;
 
      PRMBADR = MAT$FWA[MAT$ENTRY"PREAMBLE"];
      P<PRMBUF> = PRMBADR;
 
      LTCTPTR = MAT$FWA[MAT$ENTRY"LTCT"];
      P<LTCT> = LTCTPTR;
 
      UDTCADR = MAT$FWA[MAT$ENTRY"UDT$CONT"];
      P<UDT$CN> = UDTCADR + 1;       # HEADER NOT INCLUDED #
 
      UDTSADR = MAT$FWA[MAT$ENTRY"UDT$SM"];
      P<UDT$SMA> = UDTSADR;
 
      P<LABEL$CART> = MAT$FWA[MAT$ENTRY"LABBUF"];
 
      MWRBADR = MAT$FWA[MAT$ENTRY"MW$BUFS"];
 
      MRDBADR = MAT$FWA[MAT$ENTRY"MR$BUFS"];
 
      SBTADR = MAT$FWA[MAT$ENTRY"SBT"];
 
#
*     PUT THE FAMILY NAMES INTO THE *MRFT* TABLE.
#
 
      P<MRFT> = MAT$FWA[MAT$ENTRY"MRFT"];  # POINT TO FIRST ENTRY #
 
      SLOWFOR I = 1 STEP 1 WHILE I LQ FAMCNT
      DO
        BEGIN  # FOR ALL *MRFT* ENTRIES #
        MSGTEMP = NAMEFAM[I];
        BZFILL(MSGTEMP,ZEROFILL,FILLSIZE);
        MRFTFAM[(I-1)] = MSGTEMP;    # MOVE FAMILY NAME #
        END  # FOR ALL *MRFT* ENTRIES #
 
 
      END  # INITTS #
 
    TERM
PROC OPENCAT;
 
# TITLE OPENCAT - OPENS THE MAP AND CATALOG FILES.                    #
 
      BEGIN  # OPENCAT #
 
#
**    OPENCAT - OPENS MAP AND CATALOG FILES.
*
*     THIS ROUTINE CALLS *MOPEN* AND *COPEN* TO OPEN THE *SM* MAPS
*     AND THE *SFM* CATALOGS.  IT ALSO REBUILDS THE FREE AU
*     COUNTS IN THE *AST* TABLES AND UPDATES THE PREAMBLES.
*
*     PROC      OPENCAT.
*
*     ENTRY     USES THE LIST OF LOGICAL *SM* NUMBERS, THE LIST
*               OF FAMILIES WITH 8 *SFM* CATALOGS, AND THE CATALOGS
*               OF THE FAMILIES WITH 8 *SFM* CATALOGS.
*
*     EXIT      MAP AND CATALOG FILES HAVE BEEN OPENED AND ALL *AST*
*               TABLES HAVE BEEN UPDATED.
*
*     MESSAGES  1) AST UPDATED.
*                  PFN=PFN, FAMILY=FAMILY, UI=UI.
*                  SUBCATALOG SM ID=ID.
*
*               2) ATTACH ERROR ON SFM SMMAP.
*                  PFN=PFN, FAMILY=FAMILY, UI=UI.
*
*               3) ATTACH ERROR ON SFM SUBFAMILY CATALOG.
*                  PFN=PFN, FAMILY=FAMILY, UI=UI.
*
*               4) CIO ERROR ON SFM SMMAP.
*                  PFN=PFN, FAMILY=FAMILY, UI=UI.
*
*               5) CIO ERROR ON SFM SUBFAMILY CATALOG.
*                  PFN=PFN, FAMILY=FAMILY, UI=UI.
*
*               6) EXEC ABNORMAL, OPENCAT.
*
*               7) INITIALIZATION PROBLEMS -
*                  NO SMMAP FOUND.
#
 
#
****  PROC OPENCAT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC ACQ$FCT;                # ACQUIRES AN *FCTQ* ENTRY #
        PROC BZFILL;                 # BLANKS OR ZERO FILLS WORD #
        PROC COPEN;                  # OPENS AN *MSG* CATALOG #
        PROC CRAST;                  # CREATES AN *AST* ENTRY #
        PROC CRDAST;                 # READS THE *AST* TABLE #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC MOPEN;                  # OPEN A *SM* MAP #
        PROC RMVBLNK;                # REMOVE MULTIPLE BLANKS #
        PROC RLS$FCT;                # RELEASE AN *FCTQ* ENTRY #
        PROC SETPFP;                 # SETS USER INDEX AND FAMILY #
        PROC UASTPRM;                # UPDATE *AST* AND PREAMBLE #
        FUNC XCDD C(3);              # INTEGER TO DECIMAL DISPLAY #
        FUNC XCOD;                   # CHANGE OCTAL TO DISPLAY CODE #
        PROC XWOD;                   # CHANGE INTEGER TO OCTAL #
        END
 
#
****  PROC OPENCAT - XREF LIST END.
#
 
      DEF QRADDR     #0#;            # ADDRESS OF *HLRQ* ENTRY #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
 
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMS
*CALL COMBCMD
*CALL COMBMCT
*CALL COMBPFP
*CALL COMBUDT
*CALL COMXCTF
*CALL COMXINT
*CALL COMXMSC
*CALL COMSPFM
 
      ITEM ACCM       B;             # FILE ACCESS MODE FLAG #
      ITEM CER        U;             # *ACQ$FCT* RETURN CODE #
      ITEM CR         U;             # *CRDAST* RETURN STATUS #
      ITEM CSNOTFD    B;             # *SMMAP* NOT FOUND FLAG #
      ITEM FCTX       U;             # LOOP INDEX - FCT ORDINAL #
      ITEM FMX        U;             # LOOP INDEX - FAMILY #
      ITEM FOUND      B;             # ITEM FOUND FLAG #
      ITEM MMM        U;             # INDEX #
      ITEM MOPENCALL  B;             # *MOPEN* CALL FLAG #
      ITEM MSGTEMP    C(8);          # ITEM FOR *BZFILL* #
      ITEM QADDR      U;             # ADDRESS OF *FCTQ* ENTRY #
      ITEM RSTATUS    U;             # ERROR STATUS FROM *MOPEN* #
      ITEM SFX        U;             # LOOP INDEX - SUBFAMILY #
      ITEM SMX        U;             # LOOP INDEX - STORAGE MODULE #
      ITEM STAT       U;             # RETURN STATUS #
      ITEM UI         U;             # USER INDEX #
 
#
*     ARRAY TO HOLD DATA FROM *XCDD*.
#
 
      ARRAY ARTEMP[0:0] S(1);
        BEGIN
        ITEM TEMPCHAR   C(00,00,10);  # TEMPORARY CHARACTER ITEM #
        ITEM CHARSUB    C(00,00,01);  # SUBCATALOG *SM* *ID* #
        END
 
      ARRAY BADDR[0:0] P(FCTENTL);   # *FCT* BUFFER ADDRESS #
      ;
 
      ARRAY BADSUB[0:0] P(3);
        BEGIN
        ITEM BAD$ID     C(00,00,20) = [" SUBCATALOG SM ID="];  # ID #
        ITEM BAD$SUB    C(02,00,01);  # BAD *SM* NUMBER #
        ITEM BAD$ZRO    U(02,18,12) = [0];  # ZERO TERMINATOR #
        END
 
      ARRAY CAT[0:0] P(1);           # CATALOG FILE NAME #
        BEGIN  # CAT #
        ITEM CAT$PFN    C(00,00,07) = ["SFMCAT "];  # SFMCAT #
        ITEM CAT$UNID   C(00,36,01);  # UNIQUE IDENTIFIER #
        END  # CAT #
 
      ARRAY DIS[0:0] P(2);
        BEGIN
        ITEM DIS$UI     C(01,24,06);  # USER INDEX IN DISPLAY CODE #
        END
 
      ARRAY MAP[0:0] P(1);
        BEGIN  # MAP #
        ITEM MAP$PFN    C(00,00,06) = ["SMMAP "];  # SMMAP #
        ITEM MAP$UNID   C(00,30,01);  # UNIQUE IDENTIFIER #
        END  # MAP #
 
 
#
*     MESSAGE BUFFER.
#
 
      ARRAY MSGBUF[0:0] P(5);
        BEGIN  # ARRAY MSGBUF #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$RZRO   C(04,00,12);  # ZERO BYE TERMINATOR #
        END  # ARRAY MSGBUF #
 
      ARRAY REAL$AST[1:ASTENTL] S(ASTENTW);;  # BUFFER FOR *AST* TABLE
                                              #
 
      SWITCH CERJMP:CMASTAT
            CNOERRJ:NOERR,           # NO ERRORS #
            CINTLKJ:INTLK,           # CATALOG/MAP FILE INTERLOCKED #
            CFOPENJ:FOPEN,           # CATALOG/MAP FILE ALREADY OPEN #
           CCIOERRJ:CIOERR,          # CIO ERROR #
           CATTERRJ:ATTERR,          # CATALOG/MAP ATTACH ERROR #
          COCTFULLJ:OCTFULL;         # OPEN CATALOG TABLE FULL #
 
      SWITCH CGERJMP:CMASTAT
            CGNOERRJ:NOERR,          # NO ERRORS #
            CGINTLKJ:INTLK,          # CATALOG/MAP FILE INTERLOCKED #
          CGNOTOPENJ:NOTOPEN,        # CATALOG/MAP FILE NOT OPEN #
         CGNOSUBCATJ:NOSUBCAT,       # NO SUCH SUBCATALOG #
           CGCIOERRJ:CIOERR,         # *CIO* ERROR #
           CGORDERRJ:ORDERR;         # ORDINAL OUT OF RANGE #
 
      SWITCH CRERJMP:CMASTAT
            CRNOERRJ:NOERR,          # NO ERRORS #
            CRINTLKJ:INTLK,          # CATALOG/MAP FILE INTERLOCKED #
          CRNOTOPENJ:NOTOPEN,        # CATALOG/MAP FILE NOT OPEN #
         CRNOSUBCATJ:NOSUBCAT,       # NO SUCH SUBCATALOG #
           CRCIOERRJ:CIOERR;         # *CIO* ERROR #
 
      SWITCH MERJMP:CMASTAT
            MNOERRJ:NOERR,           # NO ERRORS #
            MINTLKJ:INTLK,           # CATALOG/MAP FILE INTERLOCKED #
            MFOPENJ:FOPEN,           # CATALOG/MAP FILE ALREADY OPEN #
           MCIOERRJ:CIOERR,          # *CIO* ERROR #
           MATTERRJ:ATTERR,          # CATALOG/MAP ATTACH ERROR #
          MOCTFULLJ:OCTFULL;         # OPEN CATALOG TABLE FULL #
                                               CONTROL EJECT;
 
#
*     CONSTRUCT THE MAP FILE NAME AND CALL *MOPEN* TO OPEN EACH *SM*
*     MAP.
#
 
 
      MSGTEMP = FAM$NAME[DEFAULTORD];
      BZFILL(MSGTEMP,TYPFILL"BFILL",7);
      MSGFAM[0] = MSGTEMP;           # FAMILY NAME TO MESSAGE #
 
#
*     ISSUE A *SETPFP* SO THE MAP FILE CAN BE ATTACHED.
#
 
      PFP$UI = DEF$UI;               # SET USER INDEX FOR *SETPFP* #
      PFP$FAM = FAM$NAME[DEFAULTORD];  # SET FAMILY NAME FOR *SETPFP* #
      PFP$FG1 = TRUE;                # SET FAMILY BIT FOR *SETPFP* #
      PFP$FG4 = TRUE;                # SET INDEX BIT FOR *SETPFP* #
      SETPFP(PFP);                   # SET USER INDEX AND FAMILY #
 
      XWOD(DEF$UI,DIS);              # CHANGE OCTAL TO DISPLAY CODE #
      MSGUI[0] = DIS$UI[0];          # SET USER INDEX AND FAMILY #
 
      P<UDT$SMA> = UDTSADR;
      SLOWFOR SMX = 1 STEP 1 UNTIL UDT$LINE$SMN[0]
      DO
        BEGIN  # PROCESS FOR EACH LOGICAL *SM* NUMBER #
        MMM = SM$ID[1];
        MAP$UNID[0] = SM$ID[1];
        MSGTEMP = MAP$PFN[0];
        BZFILL(MSGTEMP,TYPFILL"BFILL",7);
        MSGPFN[0] = MSGTEMP;         # PLACE FILE NAME INTO MESSAGE #
        BZFILL(MAP,TYPFILL"ZFILL",7);  # TYPFILL"ZFILL" FILE NAME #
 
        RSTATUS = 0;
        MOPEN(MMM,MAP$PFN[0],"M",RSTATUS);
 
#
*     SIMULATED CASE STATEMENT FOR *MOPEN* PROCESSING.
#
 
        GOTO MERJMP[RSTATUS];
 
MCIOERRJ:
        MSG$LINE[0] = " CIO ERROR ON SFM SMMAP.";
        MESSAGE(MSGBUF,UDFL1);       # MESSAGE TO DAYFILE #
        MSG$LINE[0] = MSG$TEXT[0];
        RMVBLNK(MSGBUF[0],40);
        MESSAGE(MSGBUF,UDFL1);       # MESSAGE TO DAYFILE #
        CSNOTFD = TRUE;
        GOTO ENDCASE0;               # COMMON EXIT #
 
MATTERRJ:
        MSG$LINE[0] = " ATTACH ERROR ON SFM SMMAP.";
        MESSAGE(MSGBUF,UDFL1);
 
        MSG$LINE[0] = MSG$TEXT[0];
        RMVBLNK(MSGBUF[0],40);
        MESSAGE(MSGBUF,UDFL1);
        CSNOTFD = TRUE;
        GOTO ENDCASE0;               # COMMON EXIT #
 
MNOERRJ:
MINTLKJ:
ENDCASE0:
      P<UDT$SMA> = P<UDT$SMA> + SMALT;
 
#
*     END OF CASE STATEMENT FOR *MOPEN* ERROR RESPONSE.
#
 
        END  # PROCESS FOR EACH LOGICAL *SM* NUMBER #
 
      P<UDT$SMA> = UDTSADR;          # RESET SMA ADDRESS #
 
      IF CSNOTFD
      THEN
        BEGIN  # NO SMMAP FOUND #
        FATALERR = TRUE;
 
        MSG$LINE[0] = " INITIALIZATION PROBLEMS -";
        MESSAGE(MSGBUF[0],UDFL1);
 
        MSG$LINE[0] = " NO SMMAP FOUND ";
        MESSAGE(MSGBUF[0],UDFL1);
        END  # NO SMMAP FOUND #
 
                                               CONTROL EJECT;
 
#
*     CONSTRUCT THE *SFM* CATALOG FILE NAME FROM THE FAMILY NAME LIST.
*     CALL *COPEN* TO OPEN THE *SFM* CATALOG.  SCAN THE *FCT* TO
*     RECONSTRUCT THE FREE VOLUME CHAIN AND COUNT THE
*     AU AVAIABLE FOR ALLOCATION.
#
 
      SLOWFOR FMX = 1 STEP 1 UNTIL FAMCNT
      DO
        BEGIN  # FOR EACH FAMILY WITH EIGHT SUBFAMILY CATALOGS #
 
        MSGTEMP = NAMEFAM[FMX];
        BZFILL(MSGTEMP,TYPFILL"BFILL",7);
        MSGFAM[0] = MSGTEMP;
 
        SLOWFOR SFX = 0 STEP 1 UNTIL MAXSF
        DO
          BEGIN  # FOR EACH SUBFAMILY #
 
          UI = DEF$UI + SFX;         # CALCULATE USER INDEX #
          XWOD(UI,DIS);
          MSGUI[0] = DIS$UI[0];
 
#
*     ISSUE A *SETPFP* SO THE SFMCAT FILE CAN BE ATTACHED.
#
 
          PFP$UI = DEF$UI + SFX;     # SET USER INDEX FOR *SETPFP* #
          PFP$FAM = NAMEFAM[FMX];    # SET FAMILY NAME FOR *SETPFP* #
          PFP$FG1 = TRUE;            # SET FAMILY BIT FOR *SETPFP* #
          PFP$FG4 = TRUE;            # SET INDEX BIT FOR *SETPFP* #
          SETPFP(PFP);               # SET USER INDEX AND FAMILY #
 
          CAT$UNID[0] = XCOD(SFX);   # CHANGE INDEX TO DISPLAY CODE #
 
          MSGPFN[0] = CAT$PFN[0];    # PLACE FILE NAME INTO MESSAGE #
 
          ACCM = FALSE;              # RANDOM ACCESS MODE #
          STAT = 0;
          COPEN(NAMEFAM[FMX],SFX,CAT,"M",ACCM,STAT);
 
#
*     SIMULATED CASE STATEMENT FOR *COPEN* ERROR RESPONSE.
#
 
          GOTO CERJMP[STAT];
 
CCIOERRJ:
CINTLKJ:
 
          TEST SFX;                  # NEXT CATALOG #
 
CATTERRJ:
          MSG$LINE[0] = "ATTACH ERROR ON SFM SUBFAMILY CATALOG.";
          MESSAGE(MSGBUF[0],UDFL1);
 
          MSG$LINE[0] = MSG$TEXT[0];
          RMVBLNK(MSGBUF[0],40);
          MESSAGE(MSGBUF[0],UDFL1);
          TEST SFX;                  # NEXT CATALOG #
 
CNOERRJ:
 
#
*     END OF CASE STATEMENT FOR *COPEN* ERROR RESPONSE.
#
 
#
*     THE FIRST WORD OF THE SUBCATALOG PREAMBLES
*     ARE SCANNED TO DETERMINE WHICH SUBCATALOGS EXIST.
*     FOR EACH EXISTING SUBCATALOG, THE NUMBER OF *FCT* ENTRIES
*     TO SCAN IS OBTAINED FROM THE FIRST WORD OF THE SUBCATALOG
*     PREAMBLE.
#
 
          SLOWFOR SMX = 1 STEP 1 UNTIL MAXSM
          DO
            BEGIN  # FOR EACH SUBCATALOG #
            IF PRM$SCW1[SMX] EQ 0
            THEN
              BEGIN
              TEST SMX;
              END
 
#
*     READ THE CATALOG *AST* AND UPDATE IT BASED ON THE
*     ANALYSIS OF EACH *FCT* ENTRY IN THE SUBCATALOG.
#
 
            CRDAST(NAMEFAM[FMX],SFX,PRM$SMID[SMX],  ##
              ASTBADR,QRADDR,CR);
 
#
*     SIMULATED CASE STATEMENT FOR *CRDAST* ERROR PROCESSING.
#
 
            GOTO CRERJMP[CR];
 
CRINTLKJ:
CRCIOERRJ:
            TEST SFX;
 
CRNOERRJ:
 
#
*     END OF SIMULATED CASE STATEMENT FOR *CRDAST* ERROR PROCESSING.
#
 
            SLOWFOR FCTX = MAXGRT STEP 1               ##
              WHILE FCTX LQ (PRM$ENTRC[SMX] + 15)      ##
                AND PRM$ENTRC[SMX] GR 0
            DO
              BEGIN  # FOR ALL *FCT* ENTRIES FOR THIS SUBCATALOG #
 
              ACQ$FCT(NAMEFAM[FMX],SFX,PRM$SMID[SMX],FCTX,  ##
                QADDR,QRADDR,CER );
 
#
*     SIMULATED CASE STATEMENT FOR *ACQ$FCT* ERROR PROCESSING.
#
 
              GOTO CGERJMP[CER];
 
CGCIOERRJ:
CGINTLKJ:
              TEST SFX;
 
CGNOERRJ:
 
              CRAST(FCTX,QADDR,ASTBADR);
              UASTPRM(NAMEFAM[FMX],SFX,SMX,QADDR,STAT);
              RLS$FCT(QADDR,0,CER);
              IF CER NQ CMASTAT"NOERR"
              THEN
                BEGIN
                GOTO RLSERR;
                END
 
              END  # FOR ALL *FCT* ENTRIES FOR THIS SUBCATALOG #
 
#
*     END OF SIMULATED CASE STATEMENT FOR *ACQ$FCT* PROCESSING.
#
 
            TEMPCHAR[0] = PRM$SMID[SMX];
            BAD$SUB[0] = CHARSUB[0];
 
            MSG$LINE[0] = " AST UPDATED.";
            MESSAGE(MSGBUF[0],UDFL1);
 
            MSG$LINE[0] = MSG$TEXT[0];
            RMVBLNK(MSGBUF[0],40);
            MESSAGE(MSGBUF[0],UDFL1);
 
            MESSAGE(BADSUB[0],UDFL1);
 
            END  # FOR EACH SUBCATALOG #
 
          END  # FOR EACH SUBFAMILY #
 
        END  # FOR EACH FAMILY WITH EIGHT SUBFAMILY CATALOGS #
 
      RETURN;
 
MOCTFULLJ:
MFOPENJ:
COCTFULLJ:
CFOPENJ:
CRNOTOPENJ:
CRNOSUBCATJ:
CGNOTOPENJ:
CGNOSUBCATJ:
CGORDERRJ:
RLSERR:
      FE$RTN[0] = "OPENCAT.";
      MESSAGE(FEMSG,UDFL1);          # EXEC ABNORMAL, OPENCAT #
      ABORT;
 
 
      END  # OPENCAT #
 
    TERM
PROC SET0100;
# TITLE SET0100 - PRESETS COMMON AREA(S) USED BY (1,0).               #
 
      BEGIN  # SET0100 #
 
#
**    SET0100 - PRESETS COMMON AREA USED BY (1,0).
*
*     *SET0100* IS A NON-EXECUTABLE ROUTINE WHICH PRESETS
*     ANY COMMON AREA(S) USED EXCLUSIVELY BY THE (1,0) OVERLAY.
*     THIS IS DONE VIA A *CONTROL PRESET* DIRECTIVE.
*
#
 
      DEF LISTCON   #0#;
*CALL COMBFAS
 
                                               CONTROL PRESET;
 
*CALL COMXINT
      END  # SET0100 #
 
    TERM
PROC TERMCAT;
# TITLE TERMCAT - CLOSES THE CATALOGS AND SMMAPS.                     #
      BEGIN  # TERMCAT #
 
#
**    *TERMCAT* - CLOSES THE CATALOGS AND SMAMAPS.
*
*     THIS PROCEDURE CLOSES THE SFM CATALOGS AND SMAMAPS.
*
*     PROC TERMCAT
*
*     EXIT      EACH SFM CATALOG AND SMMAP IS CLOSED.
#
 
 
#
****  PROC TERMCAT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CCLOSE;                 # CLOSES THE CATALOGS #
        PROC MCLOSE;                 # CLOSES THE SMAMAPS #
        END
 
#
****  PROC TERMCAT - XREF LIST END.
#
 
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
 
 
      ITEM CSTAT      U;             # STATUS RETURNED FROM CCLOSE #
      ITEM I          U;             # LOOP COUNTER #
 
 
 
 
 
#
*     CLOSE THE CATALOGS FOR EACH FAMILY AND SUB-FAMILY
#
 
      FASTFOR I = 1 STEP 1 UNTIL OCTLEN
      DO
        BEGIN
        IF OCT$W1[I] NQ 0
        THEN
          BEGIN
          CCLOSE(OCT$FAM[I],OCT$SUBF[I],0,CSTAT);
          END
 
        END
 
#
*     CLOSE ALL THE SMAMAPS
#
 
      FASTFOR I = 1 STEP 1 UNTIL MAXSM
      DO
        BEGIN
        IF OMT$OPEN[I]
        THEN
          BEGIN
          MCLOSE(I,CSTAT);
          END
 
        END
 
      END  # TERMCAT #
 
    TERM                             # TERMCAT #
PROC TERMSCP;
 
# TITLE TERMSCP - RELINQUISHES SCP STATUS.                            #
      BEGIN  # TERMSCP #
 
#
**    TERMSCP - RELINQUISHES SCP STATUS.
*
*     THIS PROCEDURE ISSUES AN SF.EXIT.
*
*     PROC TERMSCP
*
#
 
 
#
****  PROC TERMSCP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC SFCALL;
        END
 
#
****  PROC TERMSCP - XREF LIST END.
#
 
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBUCR
 
 
 
 
#
*     ISSUE AN SF.EXIT.
#
 
      SFFC = SFEXIT;
      SFCALL(SFBLKPTR,RCL);
      END  # TERMSCP #
 
    TERM
PROC WRAPUP;
 
# TITLE WRAPUP - WRAP-UP PROCESSING PRIOR TO NORMAL TERMINATION.      #
 
      BEGIN  # WRAPUP #
 
#
**    WRAPUP - WRAPUP PROCESSING PRIOR TO NORMAL TERMINATION.
*
*     THIS PROCEDURE DOES THE WRAP-UP PROCESSING PRIOR TO NORMAL
*     TERMINATION.
*
*     PROC WRAPUP
*
*     MESSAGES  CPU SECONDS = XXX.
*               CPU PERCENT = XX.X.
*               FL CHANGES = XXX.
*               MAXIMUM FL = XXX.
*               OVERLAY LOADS = XXX.
*               FILES STAGED = XXX.
*                FILES DESTAGED = XXX.
*
#
 
      XREF
        BEGIN
        PROC MESSAGE;                # INTERFACE TO *MESSAGE* MACRO #
        PROC RTIME;                  # INTERFACE TO *RTIME* MACRO #
        PROC TERMCAT;                # CLOSES THE CATALOGS AND SMAMAPS
                                     #
        PROC TERMSCP;                # RELINQUISHES SCP STATUS #
        PROC TIME;                   # INTERFACE TO *TIME* MACRO #
        FUNC XCDD C(6);              # CONVERT TO DECIMAL DISPLAY #
        END
 
#
****  PROC WRAPUP - XREF LIST END.
#
 
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMXMSC
*CALL COMXOVL
 
      ARRAY WRAPMESS [0:0] S(3);
        BEGIN
        ITEM WRAPFILL1  C(00,00,01) = [" "];  # LEADING BLANK #
        ITEM WRAPDESC   C(00,06,14);  # MSG HEADER #
        ITEM WRAPEQ     C(01,30,02) = ["= "];  # EQUAL SIGN #
        ITEM WRAPQTY    C(01,42,06);  # QUANTITY #
        ITEM WRAPPRD    C(02,18,01) = ["."];  # PERIOD #
        ITEM WRAPTERM   U(02,24,12) = [0];  # MSG TERMINATOR #
        END
 
      ARRAY CTIMESTAT [0:0] S(1);    # ACCUMULATED JOB TIME #
        BEGIN
        ITEM CTIMSECS   U(00,24,24);  # JOB SECONDS #
        ITEM CTIMMILS   U(00,48,12);  # JOB MILLESECONDS #
        END
 
      ITEM PERCENT    I;             # PERCENT OF MACHINE TIME #
      ITEM RESULT     C(10);         # DISPLAY CODE RESULT #
 
 
 
 
 
      TERMCAT;
 
      TERMSCP;
 
#
*     WRITE SYSTEM DAYFILE MESSAGES.
#
 
      WRAPDESC[0] = "CPU SECONDS";
      TIME(CTIMESTAT);
      RESULT = XCDD(CTIMSECS[0]);
      WRAPQTY[0] = C<4,6>RESULT;
      MESSAGE(WRAPMESS,SYSUDF1);
 
      WRAPDESC[0] = "CPU PERCENT";
      RTIME(RTIMESTAT);
      PERCENT = (CTIMSECS[0] * 10000) / (RTIMSECS[0] - FIRSTRTIME) + 5
        ;
      RESULT = XCDD(PERCENT);
      C<0,4>WRAPQTY[0] = C<4,4>RESULT;
      C<4,1>WRAPQTY[0] = ".";
      C<5,1>WRAPQTY[0] = C<8,1>RESULT;
      MESSAGE(WRAPMESS,SYSUDF1);
 
      WRAPDESC[0] = "FL CHANGES";
      RESULT = XCDD(NFLCHNG);
      WRAPQTY[0] = C<4,6>RESULT;
      MESSAGE(WRAPMESS,SYSUDF1);
 
      WRAPDESC[0] = "MAXIMUM FL";
      RESULT = XCDD(MAX$FL);
      WRAPQTY[0] = C<4,6>RESULT;
      MESSAGE(WRAPMESS,SYSUDF1);
 
      WRAPDESC[0] = "OVERLAY LOADS";
      RESULT = XCDD(OVLDCNT);
      WRAPQTY[0] = C<4,6>RESULT;
      MESSAGE(WRAPMESS,SYSUDF1);
 
      WRAPDESC[0] = "FILES STAGED";
      RESULT = XCDD(STGCNT);
      WRAPQTY[0] = C<4,6>RESULT;
      MESSAGE(WRAPMESS,SYSUDF1);
 
 
      WRAPDESC[0] = "FILES DESTAGED";
        RESULT = XCDD(DSTCNT);
        WRAPQTY[0] = C<4,6>RESULT;
        MESSAGE(WRAPMESS,SYSUDF1);
      END  # WRAPUP #
 
    TERM