SXINIT
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
