SXMAIN
PROC DOZER((EXPIRTIME));
  
# TITLE DOZER - PUT *SSEXEC* INTO RECALL.                             # 
  
      BEGIN  # DOZER #
  
# 
**    DOZER - PUT *SSEXEC* INTO RECALL. 
* 
*     *DOZER* ISSUES REPEATED *RECALL* REQUESTS UNTIL 
*     THE EXPIRATION TIME HAS BEEN REACHED, OR UNTIL
*     ONE OF SEVERAL REACTIVATION CONDITIONS OCCURS.
* 
*     PROC DOZER((EXPIRTIME)) 
* 
*     ENTRY   (EXPIRTIME) = DELAY EXPIRATION TIME.
* 
*     EXIT    ONE OF THE FOLLOWING CONDITIONS IS MET -
*             1.  EXPIRATION TIME HAS BEEN REACHED. 
*             2.  THE *TDAM* BUFFER IS NOT EMPTY. 
*             3.  THE *UCP* BUFFER IS NOT EMPTY.
*             4.  THE *K* DISPLAY BUFFER IS NOT EMPTY.
*             5.  THE CPU DRIVER COMPLETE FLAG (*DRVRRECALL*) IS SET. 
*             6.  THE *IDLE* BIT IS SET.
*             7.  THE STOM FILE IS NOT EMPTY. 
# 
  
  
# 
****  PROC DOZER - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC KCG;                    # KEEP COPIES GOING #
        PROC RECALL;                 # SUSPEND PROCESSING # 
        PROC RTIME;                  # GET TIME SINCE LAST DEADSTART #
        PROC SLAVERP;                # CHECK SLAVE FILE # 
        END 
  
# 
****  PROC DOZER - XREF LIST END. 
# 
  
      ITEM EXPIRTIME  U;             # EXPIRATION TIME #
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBFET 
*CALL,COMBKDD 
*CALL,COMBUCR 
*CALL,COMBUDT 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMMF 
*CALL,COMXMSC 
  
      ITEM I          U;             # INDUCTION VARIABLE # 
                                               CONTROL EJECT; 
  
# 
*     ISSUE *RECALL* REQUESTS UNTIL EXPIRATION TIME, OR UNTIL 
*     ANOTHER CRITERIA FOR RESUMPTION OF PROCESSING IS MET. 
# 
  
      FASTFOR I = 0 WHILE RTIMSECS[0] LS EXPIRTIME
      DO
        BEGIN  # ISSUE *RECALL* REQUESTS #
  
        RECALL(0);
  
        IF CHN$BOC[LCHN"KC$GOING"] NQ 0 
        THEN
          BEGIN 
          KCG;
          END 
  
        IF (RA$TDAM[0] NQ 0 AND CHN$BOC[LCHN"RTD$FRSPC"] NQ 0)  ##
          OR RA$SSCINLK[0]           ## 
          OR KB$CLEAR[0] NQ 0        ## 
          OR DRVRRECALL              ## 
          OR CHN$BOC[LCHN"HL$PFMWAIT"] NQ 0   ##
          OR CHN$BOC[LCHN"HL$DELAY"] NQ 0     ##
          OR CHN$BOC[LCHN"LL$DELAY"] NQ 0     ##
          OR RA$IDLEDWN[0]
        THEN                         # RESUME *SSEXEC* ACTIVITY # 
          BEGIN 
          RETURN; 
          END 
  
        RTIME(RTIMESTAT[0]);
  
# 
*       PROCESS *SLAVE* REQUESTS. 
# 
  
        IF RTIMSECS[0] GQ STOM$EXPIR
  
        THEN
          BEGIN 
          SLAVERP(EXPIRTIME); 
          END 
  
        END  # ISSUE *RECALL* REQUESTS #
  
      END  # DOZER #
  
    TERM
PROC ENTDAM((TDAMIN),(NEWOK),TDAMOUT);
  
# TITLE ENTDAM - ENTER NEW *TDAM* REQUEST FOR PROCESSING.             # 
  
      BEGIN  # ENTDAM # 
  
# 
**    ENTDAM - ENTER NEW *TDAM* REQUEST FOR PROCESSING. 
* 
*     *ENTDAM* ENTERS A NEW *TDAM* REQUEST FOR PROCESSING AS FOLLOWS: 
*     1) FOR A STAGE REQUEST, IT SEARCHES THE *HLRQ* AND *RTRQ* CHAINS
*        TO SEE IF THIS REQUEST HAS ALREADY BEEN ENTERED. 
*     2) IF IT IS NOT A DUPLICATE OF A STAGE REQUEST, IF THE *NEWOK*
*        PARAMETER ALLOWS IT, AND IF SPACE EXISTS IN THE *RTRQ* FREE
*        SPACE CHAIN, THE *TDAM* ENTRY IS ADDED TO THE *RTRQ* CHAIN.
* 
*     ENTRY      (TDAMIN)  = LOCATION OF THE INCOMING *TDAM* REQUEST. 
*                (NEWOK)   = 0, IT IS OK TO CREATE A NEW *RTRQ* ENTRY.
* 
*     EXIT       (TDAMOUT) = LOCATION OF THE NEW OR DUPLICATE 
*                            *TDAM* ENTRY.  =0, IF NOT A DUPLICATE, AND 
*                            A NEW *RTRQ* ENTRY WAS NOT CREATED.
* 
# 
  
      ITEM TDAMIN     U;             # LOCATION OF INCOMING *TDAM*
                                       REQUEST #
      ITEM NEWOK      U;             # CONTROLS CREATION OF NEW *RTRQ*
                                       ENTRY #
      ITEM TDAMOUT    U;             # LOCATION OF ACCEPTED *TDAM*
                                       REQUEST #
  
# 
****  PROC ENTDAM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ADD$LNK;                # ADD ENTRY TO CHAIN # 
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        END 
  
# 
****  PROC ENTDAM - XREF LIST END.
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBTDM 
*CALL,COMXHLR 
*CALL,COMXJCA 
*CALL,COMXMSC 
  
  
      ITEM ASAX       U;             # *ASA* VALUE FROM *TDAMIN* #
      ITEM EVENTID    U;             # EVENT ID # 
      ITEM FAM        C(7);          # FAMILY FROM *TDAMIN* # 
      ITEM I          I;             # LOOP INDEX # 
      ITEM LINK       U;             # ADDRESS OF NEW CHAIN ENTRY # 
      ITEM OFFSET     U;             # INCREMENT TO GET TO *TDAM* ENTRY 
                                       FROM THE LINK ADDRESS #
      ITEM SFX        U;             # SUBFAMILY INDEX FROM *TDAMIN* #
  
      BASED 
      ARRAY TDAMBUF [0:0] S(6); 
        BEGIN 
        ITEM TDAMBUF60  C(00,00,60);  # *TDAM* REQUEST #
        END 
  
                                               CONTROL EJECT; 
      P<TDAM> = TDAMIN; 
      FAM = TDAMFAM[0]; 
      SFX = TDAMSBF[0]; 
  
      P<ASA> = LOC(TDAMASA[0]); 
      ASAX = TDAMASA[0];
  
      EVENTID = TDAMEVENT[0]; 
  
# 
*     SEARCH FOR DUPLICATE STAGE REQUEST IN *HLRQ* OR *RTRQ*. 
# 
  
      IF TDAMFC[0] EQ TDAMFCODE"STAGE"
      THEN
        BEGIN  # SEARCH FOR DUPLICATE # 
        LINK = CHN$BOC[LCHN"HL$ACTV"];
  
        REPEAT WHILE LINK NQ 0
        DO
          BEGIN              # SEARCH HLRQ CHAIN #
          P<HLRQ> = LINK; 
          P<TDAM> = LOC(HLR$TDAM[0]); 
          LINK = HLR$LNK2;
  
          IF FAM EQ TDAMFAM[0]     ## 
            AND SFX EQ TDAMSBF[0]    ## 
            AND ASAX EQ TDAMASA[0]
          THEN                       # MATCH FOUND #
            BEGIN 
            TDAMOUT = LOC(TDAM[0]); 
  
            IF TDAMEVENT[0] EQ 0
            THEN
              BEGIN 
              TDAMEVENT[0] = EVENTID; 
              END 
  
            RETURN; 
            END              # MATCH MADE # 
  
          END                # SEARCH OF HLRQ CHAIN COMPLITE #
  
        LINK = CHN$BOC[LCHN"RTD$ACT"];
  
          REPEAT WHILE LINK NQ 0
          DO
            BEGIN  # SEARCH CHAIN # 
            P<TDAM> = LINK + 1; 
            P<LINKWRD> = LINK;
            LINK = LINK$ADR[0]; 
  
            IF FAM EQ TDAMFAM[0]     ## 
              AND SFX EQ TDAMSBF[0]  ## 
              AND ASAX EQ TDAMASA[0]
            THEN                     # MATCH FOUND #
              BEGIN 
              TDAMOUT = LOC(TDAM[0]); 
              IF TDAMEVENT[0] EQ 0
              THEN
                BEGIN 
                TDAMEVENT[0] = EVENTID; 
                END 
  
              RETURN; 
              END 
  
            END  # SEARCH CHAIN # 
  
        END  # SEARCH FOR DUPLICATE # 
  
# 
*     IF OK, PLACE REQUEST IN A NEW *RTRQ* ENTRY. 
# 
  
      LINK = CHN$BOC[LCHN"RTD$FRSPC"];
  
      IF (NEWOK EQ 0)                ## 
        AND (LINK NQ 0) 
      THEN                           # ADD TO *RTRQ* #
        BEGIN 
        TDAMOUT = LINK+1; 
        P<TDAM> = LINK+1; 
        DEL$LNK(LINK,LCHN"RTD$FRSPC",0);
        ADD$LNK(LINK,LCHN"RTD$ACT",0);
        P<TDAMBUF> = TDAMIN;
        TDAMREQST[0] = TDAMBUF60[0];
        IF (TDAMFC[0] EQ TDAMFCODE"STAGE"     ##
          AND CHN$BOC[LCHN"HL$FRSPC"] NQ 0)     ##
          OR (TDAMFC[0] NQ TDAMFCODE"STAGE")
        THEN
          BEGIN 
          STG$MSK = 0;
          END 
  
        END 
  
      ELSE
        BEGIN 
        TDAMOUT = 0;
        END 
  
      RETURN; 
      END  # ENTDAM # 
  
    TERM
PROC FLUSHMS; 
  
# TITLE FLUSHMS - FLUSH THE *MTOS* BUFFERS.                           # 
  
      BEGIN  # FLUSHMS #
  
# 
**    FLUSHMS - FLUSH THE *MTOS* BUFFERS. 
* 
*     *FLUSHMS* IS CALLED TO UPDATE THE MASTER-TO-SLAVE 
*     (*MTOS*) COMMUNICATION FILE BY REWRITING THE *MTOS* 
*     FILE BUFFER TO THE LINK DEVICE. 
* 
*     PROC FLUSHMS. 
* 
*     ENTRY      THE *FET* AND BUFFER FOR THE *MTOS* FILE 
*                ARE INITIALIZED. 
* 
*     EXIT       THE VARIABLE *MTOS$EXPIR* IS UPDATED TO
*                INDICATE THE NEXT TIME THIS PROCEDURE SHOULD 
*                BE CALLED.  IF THE *DRYUP* FLAG IS SET, OR 
*                IF NO SLAVE MAINFRAMES REMAIN DEFINED, *MTOS$EXPIR*
*                IS SET TO A LARGE VALUE. 
* 
*     MESSAGES
                 * EXEC SMF MODE - ALL SLAVES OMITTED.* 
*                      A MESSAGE INDICATING THAT THE *SSEXEC* 
*                      IS UNABLE TO COMMUNICATE WITH ANY *SSSLV*
*                      PROGRAM AND IS NOW RUNNING IN SINGLE 
*                      MAINFRAME MODE.
* 
# 
  
  
# 
****  PROC FLUSHMS - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC PDATE;                  # GET PACKED DATE AND TIME # 
        PROC REWIND;                 # REWIND FILE #
        PROC REWRITR;                # REWRITE FILE # 
        PROC RTIME;                  # GET TIME SINCE DEADSTART # 
        END 
  
# 
****  PROC FLUSHMS - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBFET 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXMMF 
  
  
      ARRAY MSGOMITALL [0:0] S(4);   # SLAVE OMITTED MESSAGE #
        BEGIN 
        ITEM MSGO$TEXT  C(00,00,38)  # MESSAGE TEXT # 
          = [" EXEC SMF MODE - ALL SLAVES OMITTED."]; 
        ITEM MSGO$EOL   U(03,48,12) = [0];  # END OF LINE # 
        END 
  
  
                                               CONTROL EJECT; 
  
# 
*     UPDATE THE HEADER INFORMATION OF THE *MTOS* FILE. 
# 
  
      MSH$MWC[0] = MSH$MWC[0] + 1;
      PDATE(PDATESTAT[0]);
      MSH$PDATE[0] = PDATEV[0]; 
  
# 
*     SET UP THE TIME TO NEXT FLUSH THE *MTOS* BUFFERS. 
# 
  
      RTIME(RTIMESTAT[0]);
      IF SLVACTIVE
      THEN                           # USE SMALL DELAY #
        BEGIN 
        MTOS$EXPIR = RTIMSECS[0] + SLRP$INTV; 
        END 
  
      ELSE                           # USE LARGE DELAY #
        BEGIN 
        MTOS$EXPIR = RTIMSECS[0] + SLAV$INTV; 
        END 
  
      IF DRYUP OR SLAVECTR EQ 0 
      THEN
        BEGIN 
        MTOS$EXPIR = MAXSECS; 
        MSH$IDLE[0] = TRUE; 
        END 
  
      IF SLAVECTR EQ 0
      THEN
        BEGIN 
        MESSAGE(MSGOMITALL,SYSUDF1);
        END 
  
# 
*     WRITE THE *MTOS* BUFFER TO THE *MTOS* FILE. 
# 
  
      REWIND(MTOSM,RCL);
      P<FETSET> = LOC(MTOSM); 
      FET$OUT[0] = FET$FRST[0]; 
      FET$IN[0] = FET$FRST[0] + L$MTOS; 
      REWRITR(MTOSM,RCL); 
      RETURN; 
      END  # FLUSHMS #
  
    TERM
PROC MAINLP;
  
# TITLE MAINLP - MAIN LOOP OF *SSEXEC*.                               # 
  
      BEGIN  # MAINLP # 
  
# 
**    MAINLP - MAIN LOOP OF *SSEXEC*. 
* 
*     *MAINLP* IS THE MAIN PROCESSING LOOP WHICH IS CALLED
*     BY *MSASDIR*. 
* 
*     PROC MAINLP 
* 
*     ENTRY   INITIALIZATION HAS BEEN PERFORMED.
* 
*     EXIT    PROCESSING HAS BEEN TERMINATED IN RESPONSE
*             TO THE *N.IDLE* COMMAND FROM THE CONSOLE
*             OR BY A FATAL ERROR CONDITION.
# 
  
# 
****  PROC MAINLP - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC CKPFETC;                # CHECK *UGET* COMPLETE #
        PROC FLUSHMS;                # FLUSH M-TO-S FILE #
        PROC GETACT;                 # GET ACTIVITY COUNT # 
        PROC KCG;                    # KEEP COPIES GOING #
        PROC KPROC;                  # *K* DISPLAY PROCESSOR #
        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS # 
        PROC RCLTEST;                # PERFORM RECALL TEST #
        PROC RTIME;                  # GET TIME SINCE LAST DEADSTART #
        PROC RTRNBUF;                # RETURN BUFFER SPACE #
        PROC SCAN$LTCT;              # SCAN THE *LTCT* #
        PROC SLAVERP;                # SLAVE REQUEST PROCESSOR #
        PROC TERMTST;                # PERFORM TEMINATION TEST #
        PROC TRYTDAM;                # SERVICE THE *TDAM* BUFFER #
        PROC WAKE$UP;                # REACTIVATE DELAYED PROCESSES # 
        END 
  
# 
****  PROC MAINLP - XREF LIST END.
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBCPR 
*CALL,COMBOVL 
*CALL,COMBTDM 
*CALL,COMXCTF 
*CALL,COMXJCA 
*CALL,COMXMFD 
*CALL,COMXMSC 
  
      ITEM STAT       I;             # STATUS RETURN VALUE #
  
                                               CONTROL EJECT; 
  
# 
*     REPEAT MAIN LOOP UNTIL *TERMINATE* FLAG IS SET. 
# 
  
      TERMINATE = FALSE;
  
      REPEAT WHILE NOT TERMINATE
      DO
        BEGIN  # MAIN PROCESSING LOOP # 
  
# 
*     SET *DRYUP* FLAG IF *IDLEDOWN* IS SET.
# 
  
        DRYUP = RA$IDLEDWN[0];
  
# 
*     SERVICE THE *K* DISPLAY BUFFER. 
# 
  
        KPROC;
  
# 
*     SERVICE THE *TDAM* BUFFER.
# 
  
        IF RA$TDAM[0] NQ 0           ## 
          AND CHN$BOC[LCHN"RTD$FRSPC"] NQ 0 
        THEN
          BEGIN 
          TRYTDAM;
          END 
  
# 
*     PERIODICALLY SCAN *LTCT* FOR SWAPPED *UCP*-S. 
# 
  
        RTIME(RTIMESTAT[0]);
        IF RTIMSECS[0] GQ UCP$EXPIR 
        THEN
          BEGIN 
          SCAN$LTCT;
          END 
  
  
         IF GLPFMFL 
         THEN 
           BEGIN
           GOTO NEXTCHK;
           END
  
# 
*     TEST FOR REASON TO LOAD NEW WORK OVERLAY. 
# 
  
# 
*     PERIODICALLY RECLAIM CATALOG AND SMA MAP INTERLOCKS.
# 
  
        RTIME(RTIMESTAT[0]);
        IF GLBINTLK AND RTIMSECS[0] GQ ITLK$EXPIR 
        THEN                         # RECLAIM CATALOG INTERLOCKS # 
          BEGIN 
          RCLMCAT = TRUE; 
          END 
  
        IF MAPINTLK AND RTIMSECS[0] GQ MAP$EXPIR
        THEN                         # RECLAIM SMA MAP INTERLOCKS # 
          BEGIN 
          RCLMMAP = TRUE; 
          END 
  
        IF RCLMCAT OR RCLMMAP 
        THEN
          BEGIN 
          SSOVL(LNEWWORK,0);         # LOAD *NEWWORK* OVERLAY # 
          GOTO NEXTCHK; 
          END 
  
# 
*     CHECK FOR REQUEST IN *UCP* BUFFER WHICH CAN BE PROCESSED. 
*     IF THE REQUEST IS TYPE 4 OR AN UPDATE-UDT TYPE 5, THERE 
*     MUST BE AN AVAILABLE *LLRQ* ENTRY AND FULL INITIALIZATION 
*     MUST NOT BE IN PROGRESS.
# 
  
        IF RA$SSCINLK[0]
        THEN                         # *UCP* BUFFER CONTAINS REQUEST #
          BEGIN  # CHECK *UCP* REQUEST #
          P<CPR> = RA$SSCAP[0] + 2; 
  
          IF ((CPR$RQT[0] EQ TYP"TYP4"  ##
            OR (CPR$RQT[0] EQ TYP"TYP5"  ## 
            AND CPR$RQC[0] EQ REQTYP5"SSA$UUDT"))  ## 
            AND (CHN$BOC[LCHN"LL$FRSPC"] NQ 0  ## 
            AND NOT INITIALIZE))     ## 
            OR (CPR$RQT[0] NQ TYP"TYP4"  ## 
            AND NOT (CPR$RQT[0] EQ TYP"TYP5"  ##
            AND CPR$RQC[0] EQ REQTYP5"SSA$UUDT")) 
          THEN                       # REQUEST CAN BE PROCESSED # 
            BEGIN 
            SSOVL(LNEWWORK,0);       # LOAD *NEWWORK* OVERLAY # 
            GOTO NEXTCHK; 
            END 
  
          END  # CHECK *UCP* REQUEST #
  
# 
*     CHECK IF DESTAGING IS TO BE INITIATED.
# 
  
        IF (DSC$INIT NQ 0)           ## 
          AND (NOT INITIALIZE)        ##
          AND (CHN$BOC[LCHN"HL$FRSPC"] NQ 0)
        THEN
          BEGIN 
          SSOVL(LNEWWORK,0);         # LOAD *NEWWORK* OVERLAY # 
          GOTO NEXTCHK; 
          END 
  
  
# 
*     CHECK *RTRQ* FOR *TDAM* REQUEST WHICH CAN BE PROCESSED. 
# 
  
        IF CHN$BOC[LCHN"RTD$ACT"] NQ 0  ##
          AND (NOT INITIALIZE)        ##
          AND (STG$MSK EQ 0)
        THEN                         # CAN PROCESS *TDAM* REQUESTS #
          BEGIN 
          SSOVL(LNEWWORK,0);         # LOAD *NEWWORK* OVERLAY # 
          GOTO NEXTCHK; 
          END 
  
# 
*     CHECK EXPIRATION TIME FOR PROCESSING *SLAVE* REQUESTS.
# 
  
  
NEXTCHK:  
        RTIME(RTIMESTAT[0]);
        IF RTIMSECS[0] GQ STOM$EXPIR      ##
          AND GLBDSFL 
        THEN                         # CAN ACCEPT SLAVE REQUESTS #
          BEGIN 
          SLAVERP(0); 
          END 
  
# 
*     PERIODICALLY FLUSH MASTER-TO-SLAVE FILE.
# 
  
        IF RTIMSECS[0] GQ MTOS$EXPIR
        THEN
          BEGIN 
          FLUSHMS;
          END 
  
# 
*     CHECK FOR PFM REQUEST COMPLETE BEFORE PROCESSING
*     MORE HLRQ REQUESTS. 
# 
  
  
        IF GLPFMFL
        THEN
          BEGIN 
          CKPFETC(NAME[0],PFMSTAT); 
          GLPFMFL = PFMSTAT LS 0;    # SET IF PFM REQUEST NOT COMPLETE #
          END         # PFM REQUEST COMPLETE #
  
  
# 
*     SERVICE HIGH LEVEL PROCESSES. 
# 
  
        IF CHN$BOC[LCHN"HL$DELAY"] NQ 0 
        THEN                         # *HLRQ* DELAY CHAIN POPULATED # 
          BEGIN 
          WAKE$UP;                   # REACTIVATE DELAYED PROCESSES # 
          END 
  
        IF (NOT GLPFMFL)        # PFM UGET/UREPLACE ACTIVE #
          AND (NOT INITIALIZE)  #DELAY DURING FULL INITIALIZATION # 
          AND ((CHN$BOC[LCHN"HL$READY"] NQ 0)     ##
          OR (CHN$BOC[LCHN"HL$PFMWAIT"] NQ 0))
        THEN                         # ADVANCE HIGH LEVEL REQUESTS #
          BEGIN 
          SSOVL(LHLRQMTR,0);         # LOAD *HLRQMTR* OVERLAY # 
          END 
  
# 
*     RETURN BUFFER SPACE IF POSSIBLE.
# 
  
        IF GLBRTRNB 
        THEN
          BEGIN  # GLOBAL FLAG SET #
          GETACT(STAT); 
          P<ACTSTAT> = LOC(STAT); 
          IF ACT$STCNT[0] EQ 0
          THEN                       # NO CURRENT ACTIVITY #
            BEGIN 
            RTRNBUF;
            END 
  
          END  # GLOBAL FLAG SET #
  
# 
*     SERVICE LOW LEVEL PROCESSES.
# 
  
        IF CHN$BOC[LCHN"LL$DELAY"] NQ 0 
        THEN                         # *LLRQ* DELAY CHAIN POPULATED # 
          BEGIN 
          WAKE$UP;                   # REACTIVATE DELAYED PROCESSES # 
          END 
  
        RTIME(RTIMESTAT[0]);
        IF DRVRRECALL               ##
          OR (CHN$BOC[LCHN"LL$READY"] NQ 0)  ## 
        THEN                         # LOW LEVEL REQUESTS TO ADVANCE #
          BEGIN 
          SSOVL(LLLRQMTR,0);         # LOAD *LLRQMTR* OVERLAY # 
          END 
  
# 
*     KEEP COPY OPERATIONS GOING. 
# 
  
        IF CHN$BOC[LCHN"KC$GOING"] NQ 0 
        THEN
          BEGIN 
          KCG;
          END 
  
# 
*     DETERMINE IF *SSEXEC* CAN GO INTO RECALL. 
# 
  
        RCLTEST;
  
# 
*     CHECK *DRYUP* FLAG. 
# 
  
        IF DRYUP
        THEN                         # DO TERMINATION TEST #
          BEGIN 
          TERMTST;
          END 
  
        END  # MAIN PROCESSING LOOP # 
  
# 
*     EXIT FROM MAIN LOOP.
# 
  
      RETURN; 
  
      END  # MAINLP # 
  
    TERM
PROC MNGMEM((MEMCHNG),RESP);
  
# TITLE MNGMEM - MANAGE MEMORY.                                       # 
  
      BEGIN  # MNGMEM # 
  
# 
**    MNGMEM - MANAGE MEMORY. 
* 
*     *MNGMEM* PROCESSES REQUESTS FOR AN INCREASE OR DECREASE 
*     IN USABLE MEMORY.  BASED ON THE CURRENT UNUSED MEMORY AND 
*     THE AMOUNT OF CHANGE REQUESTED, A *MEMORY* CALL IS MADE 
*     AND FIELD LENGTH VALUES ARE UPDATED.
* 
*     MNGMEM((MEMCHNG),RESP). 
* 
*     ENTRY     (MEMCHNG) = CHANGE IN MEMORY REQUESTED. 
* 
*     EXIT      (RESP)    - RESPONSE TO MEMORY REQUEST. 
*                           = 0, REQUEST DENIED.
*                           = OTHER, *  FWA* OF NEW MEMORY BLOCK IF AN
*                           INCREASE IN MEMORY WAS REQUESTED. 
# 
  
      ITEM MEMCHNG    I;             # CHANGE IN MEMORY REQUESTED # 
      ITEM RESP       U;             # RESPONSE TO MEMORY REQUEST # 
  
# 
****  PROC MNGMEM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC MEMORY;                 # REQUEST MEMORY CHANGE #
        END 
  
# 
****  PROC MNGMEM - XREF LIST END.
# 
  
      DEF MEMAU #O"100"#;            # MEMORY ALLOCATION UNIT # 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMXMSC 
  
      ITEM AMTMEM     I;             # AMOUNT OF MEMORY NEEDED #
      ITEM BLKMEM     I;             # MEMORY BLOCK SIZE #
  
      ARRAY MEMSTAT [0:0] P(1);      # MEMORY REQUEST # 
        BEGIN 
        ITEM MEMVAL     U(00,00,30);  # NEW FIELD LENGTH VALUE #
        END 
  
                                               CONTROL EJECT; 
  
# 
*     CALCULATE SIZE OF FIELD LENGTH TO REQUEST.
# 
  
      IF (MEMCHNG GQ 0               ## 
        AND MEMCHNG GR UNU$FL)       ## 
        OR ((UNU$FL - MEMCHNG) GQ MEMAU)
      THEN
        BEGIN  # MEMORY REQUEST NEEDED #
        AMTMEM = MEMCHNG - UNU$FL;
        IF AMTMEM GQ 0
        THEN                         # IF *FL* TO BE INCREASED #
          BEGIN 
          BLKMEM = (((AMTMEM - 1)/MEMAU) + 1) * MEMAU;
          END 
  
        ELSE                         # IF *FL* TO BE DECREASED #
          BEGIN 
          BLKMEM = ((AMTMEM / MEMAU) * MEMAU);
          END 
  
        MEMVAL[0] = CUR$FL + BLKMEM;
  
# 
*     REQUEST FIELD LENGTH CHANGE AND UPDATE RELEVANT VALUES. 
# 
  
        MEMORY("CM",MEMSTAT,RCL,NA);
        IF MEMVAL[0] NQ (CUR$FL + BLKMEM) 
        THEN                         # IF MEMORY REQUEST DENIED # 
          BEGIN 
          RESP = 0; 
          RETURN; 
          END 
  
        CUR$FL = MEMVAL[0];          # UPDATE *FL* VALUES # 
        NFLCHNG = NFLCHNG + 1;
        IF CUR$FL GR MAX$FL 
        THEN                         # UPDATE MAXIMUM *FL* REACHED #
          BEGIN 
          MAX$FL = CUR$FL;
          END 
  
        END  # MEMORY REQUEST NEEDED #
  
      RESP = NEXTADR;                # RETURN *FWA* OF MEMORY AREA TO 
                                       CALLER # 
      NEXTADR = NEXTADR + MEMCHNG;
      UNU$FL = CUR$FL - NEXTADR;
      RETURN; 
      END  # MNGMEM # 
  
    TERM
PROC MSASDIR; 
  
# TITLE MSASDIR - *SSEXEC* DIRECTOR.                                  # 
  
      BEGIN  # MSASDIR #
  
# 
**    MSASDIR - *SSEXEC* DIRECTOR.
* 
*     *MSASDIR* IS THE OVERALL DIRECTOR WHICH INITIATES 
*     THE MAJOR PHASES OF *SSEXEC* ACTIVITY.  IF THE
*     *MASTER/*SLAVE* FLAG IN *CMR* INDICATES *SLAVE* 
*     MODE, A JOB ADVANCE OCCURS AND *SSSLV* IS LOADED. 
*     *MSASDIR* CALLS *STARTUP* TO DO ALL INITIALIZATION, 
*     AND THEN CALLS *MAINLP* FROM WHICH ALL MAJOR PROCESSING 
*     ROUTINES ARE CALLED.  WHEN TERMINATION CONDITIONS 
*     OCCUR, CONTROL RETURNS TO *MSASDIR*, WHICH THEN CALLS 
*     *WRAPUP* TO DO ALL NORMAL TERMINATION PROCESSING. 
* 
*     PROC MSASDIR
* 
*     ENTRY    CONTROL COMMAND PARAMETERS HAVE BEEN PLACED IN JOB 
*              COMMUNICATION AREA AND CONTROL REGISTER R1 IS SET
*              TO 0 (INITIAL LOAD OF EXEC) OR *RESTART* (DEFINED
*              IN *COMXMSC*). 
* 
*     EXIT     TERMINATION IS DUE TO ONE OF THE FOLLOWING 
*              1.  *MSAS* HAS BEEN TERMINATED NORMALLY VIA
*                  AN *N.IDLE* CONSOLE COMMAND.  R1 IS UNCHANGED. 
* 
*     MESSAGES
*              * SSEXEC TERMINATING.*.
*              * SLAVE MODE - LOADING SSSLV.*.
*              * FATAL INITIALIZATION ERROR.*.
*              * OPERATOR IDLE OF EXEC.*. 
# 
  
  
# 
****  PROC MSASDIR - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC GETMI;                  # GET MACHINE INFORMATION #
        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS # 
        PROC MAINLP;                 # MAIN PROCESSING LOOP # 
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC STARTUP;                # *SSEXEC* INITIALIZER # 
        END 
  
# 
****  PROC MSASDIR - XREF LIST END. 
# 
  
      STATUS MSGTYPE                 # TYPE OF MESSAGE TO ISSUE # 
        HEADER,                      # MESSAGE HEADER # 
        SLAVE,                       # SLAVE MODE # 
        FATAL,                       # FATAL ERROR #
        IDLE;                        # EXEC IDLED # 
  
                                               CONTROL PRESET;
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCMD 
*CALL,COMBKDA 
*CALL,COMBMCT 
*CALL,COMBOVL 
*CALL,COMBTDM 
*CALL,COMBUCR 
*CALL,COMBUDT 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXMFD 
*CALL,COMXMMF 
*CALL,COMXMSC 
  
      ITEM TERMTYPE   S:MSGTYPE;     # TERMINATION TYPE # 
  
      ARRAY MSGLINE [0:3] S(4);      # CONTAINS DAYFILE MESSAGES #
        BEGIN 
        ITEM MSGITEM    C(00,00,38)=[  # CHARACTER STRINGS #
        "$SSEXEC TERMINATING.", 
        "$MSAS MASTER DISABLED - ABORT.", 
        "$FATAL INITIALIZATION ERROR.", 
        "$OPERATOR IDLE OF EXEC."]; 
        ITEM MSGZERO    U(03,48,12)=[0];  # ZERO BYTE TERMINATOR #
        END 
  
                                               CONTROL EJECT; 
  
# 
*     CHECK FOR *MASTER* OR *SLAVE* MAINFRAME STATUS. 
# 
  
      GETMI(CMRINFO[0],EVENT);
      IF CMR$SLAVE[0] 
      THEN                           # *SLAVE* MODE INDICATED # 
        BEGIN 
        FATALERR = TRUE;
        TERMTYPE = S"SLAVE";
        GOTO ENDJOB;                 # CAUSE JOB ADVANCE #
        END 
  
# 
*     PERFORM *SSEXEC* INITIALIZATION.
# 
  
      STARTUP;
  
      IF FATALERR 
      THEN                           # FATAL ERROR IN INITIALIZATION #
        BEGIN 
        TERMTYPE = S"FATAL";
        GOTO ENDJOB;
        END 
  
# 
*     ENTER MAIN PROCESSING LOOP. 
# 
  
      MAINLP; 
  
# 
*     PERFORM TERMINATION PROCESSING. 
# 
  
      SSOVL(LWRAPUP,0); 
      TERMTYPE = S"IDLE"; 
  
# 
*     ISSUE TERMINATION MESSAGES AND ADVANCE TO NEXT JOB STEP.
# 
  
ENDJOB: 
      MESSAGE(MSGLINE[MSGTYPE"HEADER"],SYSUDF1);
      MESSAGE(MSGLINE[TERMTYPE],SYSUDF1); 
      IF FATALERR 
      THEN
        BEGIN 
        ABORT;
        END 
  
      RETURN; 
      END  # MSASDIR #
  
    TERM
PROC NEWWORK; 
  
# TITLE NEWWORK - ACQUIRES NEW WORK FOR *SSEXEC* TO PROCESS.          # 
  
      BEGIN  # NEWWORK #
  
# 
**    NEWWORK - ACQUIRES NEW WORK FOR *SSEXEC* TO PROCESS.
* 
*     *NEWWORK* DETERMINES IF ANY NEW WORK EXISTS WHICH 
*     CAN BE ACCEPTED AT THIS TIME.  FOR ANY ACCEPTABLE 
*     NEW WORK, THE APPROPRIATE REQUEST PROCESSOR IS CALLED 
*     (*UCP*, *TDAM*, *SLAVE*, *SCAN$LTCT*, AND/OR *SSMOVE* 
*     REQUEST PROCESSOR).  IF EITHER  *RCLMCAT* OR *RCLMMAP*
*     (DEFINED IN *ECTFCOM*) IS TRUE, THEN THE *RCLMLK* OVERLAY 
*     IS LOADED TO RECLAIM CATALOG OR MAP INTERLOCKS. 
* 
*     PROC NEWWORK
* 
*     ENTRY   TEST FOR NEW WORK IN *MAINLP* IS SUCCESSFUL.
* 
*     EXIT    NEW REQUESTS PROCESSED AS FAR AS POSSIBLE.
# 
  
# 
****  PROC NEWWORK - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC CRELSLK;                # RELEASE CATALOG INTERLOCKS # 
        PROC DSNTDAM;                # GET NEXT DESTAGE REQUEST # 
        PROC HLRQENQ;                # BUILD *HLRQ* ENTRY # 
        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS # 
        PROC MOVERP;                 # *SSMOVE* REQUEST PROCESSOR # 
        PROC SCAN$LTCT;              # SCAN LONG TERM CONNECT TABLE # 
        PROC SLAVERP;                # *SSSLV* REQUEST PROCESSOR #
        PROC TDAM$RP;                # *TDAM* REQUEST PROCESSOR # 
        PROC UCP$RES;                # REPLY TO A *UCP* # 
        PROC UCP$RP;                 # *UCP* REQUEST PROCESSOR #
        END 
  
# 
****  PROC NEWWORK - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBCPR 
*CALL,COMBOVL 
*CALL,COMBTDM 
*CALL COMBUDT 
*CALL COMBUCR 
*CALL,COMXCTF 
*CALL,COMXHLR 
*CALL,COMXJCA 
*CALL,COMXLTC 
*CALL,COMXMFD 
*CALL,COMXMSC 
  
  
  
      ITEM ACTIVEHLRQ I;             # *HLRQ* COUNT # 
      ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS # 
      ITEM I          I;             # INDEX COUNTER #
      ITEM LINK       I;             # LINK TO NEXT *HLRQ* #
      ITEM STAT       U;             # STATUS # 
                                               CONTROL EJECT; 
  
# 
*     PROCESS *UCP* REQUESTS.  ALL TYPE 4 REQUESTS AND ALL UPDATE-UDT 
*     TYPE 5 REQUESTS REQUIRE AN AVAILABLE *LLRQ* ENTRY.
# 
  
      IF RA$SSCINLK[0]
      THEN                           # *UCP* BUFFER CONTAINS REQUEST #
        BEGIN  # CHECK *UCP* REQUEST #
        P<CPR> = RA$SSCAP[0] + 2; 
  
        IF ((CPR$RQT[0] EQ TYP"TYP4")  ## 
          OR ((CPR$RQT[0] EQ TYP"TYP5")  ## 
          AND (CPR$RQC[0] EQ REQTYP5"SSA$UUDT"))  ##
          AND (CHN$BOC[LCHN"LL$FRSPC"] NQ 0))  ## 
          OR ((CPR$RQT[0] NQ TYP"TYP4")  ## 
          AND ((CPR$RQT[0] NQ TYP"TYP5")  ##
          OR (CPR$RQC[0] NQ REQTYP5"SSA$UUDT")))
        THEN                         # REQUEST CAN BE PROCESSED # 
          BEGIN 
          UCP$RP; 
          END 
  
        END  # CHECK *UCP* REQUEST #
  
# 
*     PROCESS ONLY UCP REQUESTS IF IN FULL INITIALIZATION.
# 
  
      IF INITIALIZE 
      THEN                           # STOP REQUEST PROCESSING #
        BEGIN  # EXIT # 
        RETURN; 
        END  # EXIT # 
  
# 
*     RECLAIM CATALOG OR MAP INTERLOCKS IF NECESSARY. 
# 
  
      IF RCLMCAT OR RCLMMAP 
      THEN                           # INTERLOCKS TO BE RECLAIMED # 
        BEGIN 
        SSOVL(LRCLMLK,0); 
        END 
  
# 
*     PROCESS *TDAM* REQUESTS.
# 
  
      IF CHN$BOC[LCHN"RTD$ACT"] NQ 0  ##
        AND (STG$MSK EQ 0)
      THEN                           # REQUEST CAN BE PROCESSED # 
        BEGIN 
        TDAM$RP;
        END 
  
# 
*     CHECK IF DESTAGING IS TO BE INITIATED.
# 
  
      IF DSC$INIT EQ 0
      THEN
        BEGIN 
        RETURN; 
        END 
  
      ACTIVEHLRQ = 0; 
      LINK = CHN$BOC[LCHN"HL$ACTV"];
  
      REPEAT WHILE LINK NQ 0
      DO
        BEGIN       # SEARCH *HLRQ* CHAIN # 
        P<HLRQ> = LINK; 
        LINK = HLR$LNK2;
        ACTIVEHLRQ = ACTIVEHLRQ + 1;
        END         # COUNT THE ACTIVE NUMBER OF *HLRQ-S* # 
  
      IF ACTIVEHLRQ NQ 0
      THEN
        BEGIN     # LET ONE OVER BUFFER COUNT START # 
        ACTIVEHLRQ = ACTIVEHLRQ - 1;
        END 
  
      IF ACTIVEHLRQ EQ MAX$ACHN 
      THEN
        BEGIN 
        DSC$INIT = 0; 
        DSC$WRESRS = 1; 
        END 
  
      IF (DSC$INIT NQ 0)             ## 
        AND (CHN$BOC[LCHN"HL$FRSPC"] NQ 0)      ##
      THEN
        BEGIN 
  
        IF DSC$LKMSK NQ 0 
        THEN
          BEGIN 
          CRELSLK(DSC$FAM,DSC$LKMSK,0,STAT);
          DSC$LKMSK = 0;
          END 
  
        HLRQENQ(HLRQADR); 
        P<HLRQ> = HLRQADR;
        HLR$HPN[0] = HLRPN"DESTAGE";
        HLR$RESP[0] = ERRST"NXTSUBF"; 
  
        DSNTDAM(HLRQADR); 
  
        P<TDAM> = LOC(HLR$TDAM[0]); 
        IF TDAMFC[0] EQ TDAMFCODE"NOREQ"
        THEN                         # DONE WITH DESTAGING #
          BEGIN 
        LTCENTRY = DSC$LTCT;
        IF DSC$LTCT NQ 0 AND LTC$RQI[LTCENTRY] EQ REQNAME"RQIMOVE"
          THEN                       # REPLY TO *SSMOVE* #
            BEGIN 
            LTC$RQR[LTCENTRY] = RESPTYP2"OK2";
            UCP$RES;                 # NOTIFY *SSMOVE* #
            DSC$LTCT = 0; 
            END 
  
          STG$MSK = 0;
          DSC$FAM = 0;
          DSC$INIT = 0; 
          DSC$WRESRS = 0; 
          HLR$HPS[0] = PROCST"COMPLETE";
          END 
  
        END 
  
  
      RETURN; 
      END  # NEWWORK #
  
    TERM
PROC RCLTEST; 
  
# TITLE RCLTEST - TESTS RECALL CRITERIA FOR *SSEXEC*.                 # 
  
      BEGIN  # RCLTEST #
  
# 
**    RCLTEST - TESTS RECALL CRITERIA FOR *SSEXEC*. 
* 
*     *RCLTEST* CHECKS WHETHER THE CRITERIA FOR 
*     PUTTING *SSEXEC* INTO RECALL ARE MET.  IF THE 
*     EARLIEST EXPIRATION TIME EXCEEDS A DEFINED
*     THRESHOLD (*SWAPTHRESH*), *SSEXEC* ALSO REDUCES 
*     ITS FIELD LENGTH BEFORE GOING INTO RECALL.
* 
*     PROC RCLTEST
* 
*     ENTRY   CALLED UNCONDITIONALLY BY *MAINLP* EACH 
*             TIME THROUGH THE LOOP.
* 
*     EXIT    CRITERIA FOR RECALL ARE NOT MET, EXPIRATION 
*             TIME HAS BEEN REACHED, OR A CONDITION FOR 
*             RESUMING ACTIVITY HAS BEEN SATISFIED. 
# 
  
# 
****  PROC RCLTEST - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC DOZER;                  # PUT *SSEXEC* INTO RECALL # 
        PROC GETACT;                 # GET ACTIVITY COUNT # 
        PROC RTIME;                  # GET TIME SINCE LAST DEADSTART #
        PROC SWAPPER;                # REDUCE FIELD LENGTH OF *SSEXEC*
                                     #
        END 
  
# 
****  PROC RCLTEST - XREF LIST END. 
# 
  
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBKDA 
*CALL,COMBKDD 
*CALL,COMBTDM 
*CALL,COMBUDT 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMFD 
*CALL,COMXMSC 
  
      ITEM I          U;             # COUNTER #
      ITEM J          U;             # COUNTER #
      ITEM EXPIRTIME  U;             # EXPIRATION TIME #
      ITEM PPUSTAT    U;             # STATUS FROM *GETACT* # 
  
                                               CONTROL EJECT; 
  
# 
*     RETURN IF THERE IS WORK TO BE DONE. 
# 
  
      IF (RA$TDAM[0] NQ 0 AND CHN$BOC[LCHN"RTD$FRSPC"] NQ 0) ## 
        OR RA$SSCINLK                ## 
        OR KB$CLEAR[0] NQ 0          ## 
        OR DRVRRECALL 
      THEN
        BEGIN 
        RETURN; 
        END 
  
      IF (CHN$BOC[LCHN"RTD$ACT"] NQ 0 AND STG$MSK EQ 0      ##
        AND NOT INITIALIZE)    ## 
        OR (DSC$INIT NQ 0 AND CHN$BOC[LCHN"HL$FRSPC"] NQ 0    ##
        AND NOT INITIALIZE)         ##
        OR CHN$BOC[LCHN"HL$READY"] NQ 0  ## 
        OR CHN$BOC[LCHN"LL$READY"] NQ 0 
      THEN                           # ACTIVE CHAINS NOT ALL EMPTY #
        BEGIN 
        RETURN; 
        END 
  
# 
*     CALCULATE RECALL EXPIRATION AS THE MINIMUM OF VARIOUS 
*     OTHER EXPIRATION TIMES. 
# 
  
      EXPIRTIME = MAXTIME;
      IF MINQ$EXPIR GR 0
      THEN
        BEGIN 
        EXPIRTIME = MINQ$EXPIR; 
        END 
  
      IF ITLK$EXPIR GR 0             ## 
        AND ITLK$EXPIR LS EXPIRTIME 
      THEN
        BEGIN 
        EXPIRTIME = ITLK$EXPIR; 
        END 
  
      IF MAP$EXPIR GR 0 AND MAP$EXPIR LS EXPIRTIME
      THEN
        BEGIN 
        EXPIRTIME = MAP$EXPIR;
        END 
  
      IF UCP$EXPIR GR 0              ## 
        AND UCP$EXPIR LS EXPIRTIME
      THEN
        BEGIN 
        EXPIRTIME = UCP$EXPIR;
        END 
  
      IF KDIS$EXPIR GR 0             ## 
        AND KDIS$EXPIR LS EXPIRTIME 
      THEN
        BEGIN 
        EXPIRTIME = KDIS$EXPIR; 
        END 
  
      IF KSM$EXPIR GR 0              ## 
        AND KSM$EXPIR LS EXPIRTIME
      THEN                           # SM DISPLAY UP #
        BEGIN  # PRESERVE # 
        EXPIRTIME = KSM$EXPIR;
        END  # PRESERVE # 
  
# 
*     PUT *SSEXEC* INTO RECALL.  IF THE EXPIRATION TIME EXCEEDS A 
*     THRESHOLD, NO PP IS ACTIVE, THE * REQUEST K-DISPLAY* MESSAGE
*     IS NOT ON THE *B-DISPLAY* AND NO CONNECTED *UCP*-S ARE SWAPPED
*     OUT, REDUCE FIELD LENGTH FIRST. 
# 
  
      RTIME(RTIMESTAT[0]);
  
      IF (EXPIRTIME - RTIMSECS[0] GR SWAPTHRESH)  ##
        AND (NOT DRVRRECALL)         ## 
        AND KREQCLEAR                ## 
        AND (NOT GLBUCPSW)           ## 
        AND CHN$BOC[LCHN"HL$ACTV"] EQ 0 
  
      THEN
        BEGIN 
        IF (DSC$INIT EQ 0)
          AND (DSC$WRESRS EQ 1) 
        THEN
          BEGIN 
          DSC$INIT = 1; 
          DSC$WRESRS = 0; 
          SLOWFOR I = 1STEP 1 UNTIL MAXSMUNIT 
          DO
            BEGIN 
            SM$DSRFW[I] = 0;
            END 
          SLOWFOR J = 0 STEP 1 UNTIL MAXSF
          DO
            BEGIN 
            SCR$WTDRD[J] = FALSE; 
            END 
          END 
        GETACT(PPUSTAT);             # CHECK FOR ACTIVE PPU # 
        P<ACTSTAT> = LOC(PPUSTAT);
        IF (ACT$STCNT[0] EQ 0)
          AND (DSC$INIT EQ 0) 
        THEN                         # NO ACTIVE PPU #
          BEGIN 
          SWAPPER(EXPIRTIME);        # REDUCE FIELD LENGTH AND RECALL # 
          RETURN; 
          END 
  
        ELSE                         # PPU STILL ACTIVE # 
          BEGIN 
          EXPIRTIME = RTIMSECS[0] + SWAPTHRESH; 
          END 
  
        END 
  
      DOZER(EXPIRTIME);              # ISSUE RECALL REQUEST # 
  
      RETURN; 
      END  # RCLTEST #
  
    TERM
PROC RCLMLK;
  
# TITLE RCLMLK - RECLAIM INTERLOCKED CATALOGS AND MAPS.               # 
  
      BEGIN  # RCLMLK # 
  
# 
**    RCLMLK - RECLAIM INTERLOCKED CATALOGS AND MAPS. 
* 
*     *RCLMLK* RECLAIMS INTERLOCKED CATALOGS AND/OR SMA MAPS. 
* 
*     PROC RCLMLK 
* 
*     ENTRY     (RCLMCAT) - RECLAIM CATALOG INTERLOCKS FLAG 
*                           (DEFINED IN *ECTFCOM*). 
*                         = TRUE, RECLAIM CATALOGS. 
*                         = FALSE, DO NOT RECLAIM CATALOGS. 
*               (RCLMMAP) - RECLAIM SMA MAP INTERLOCKS FLAG 
*                           (DEFINED IN *ECTFCOM*). 
*                         = TRUE, RECLAIM MAPS. 
*                         = FALSE, DO NOT RECLAIM MAPS. 
* 
*     EXIT      CATALOG AND/OR MAP INTERLOCKS HAVE BEEN RECLAIMED, AND
*               EXPIRATION TIMES HAVE BEEN ADJUSTED IF NECESSARY. 
* 
*     MESSAGES  * EXEC ABNORMAL, RCLMLK.*.
# 
  
# 
****  PROC RCLMLK - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORT PROCESSING # 
        PROC CRCLMLK;                # RECLAIM CATALOG INTERLOCKS # 
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC MRCLMLK;                # RECLAIM SMA MAP INTERLOCKS # 
        PROC RTIME;                  # GET CURRENT TIME # 
        PROC SETPFP;                 # SET FAMILY AND USER INDEX #
        END 
  
# 
****  PROC RCLMLK - XREF LIST END.
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCMS 
*CALL,COMBPFP 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXMSC 
  
      ITEM I          I;             # INDUCTION VARIABLE # 
      ITEM STAT       I;             # ERROR STATUS # 
  
                                               CONTROL EJECT; 
  
# 
*     RECLAIM CATALOG INTERLOCKS. 
# 
  
      IF RCLMCAT
      THEN
        BEGIN  # RECLAIM CATALOGS # 
        RCLMCAT = FALSE;
        CRCLMLK(STAT);
        END  # RECLAIM CATALOGS # 
  
# 
*     RECLAIM SMA MAP INTERLOCKS. 
# 
  
      IF RCLMMAP
      THEN
        BEGIN  # RECLAIM SMA MAPS # 
        PFP$WRD0[0] = 0;
        PFP$FG1[0] = TRUE;
        PFP$FG4[0] = TRUE;
        PFP$FAM[0] = DEF$FAM; 
        PFP$UI[0] = DEF$UI; 
        SETPFP(PFP[0]); 
        IF PFP$STAT NQ OK 
        THEN
          BEGIN 
          FE$RTN[0] = "RCLMLK.";
          MESSAGE(FEMSG[0],UDFL1);
          ABORT;
          END 
  
        RCLMMAP = FALSE;
        MAPINTLK = FALSE; 
        MAP$EXPIR = 0;
        FASTFOR I = 1 STEP 1 UNTIL MAXSM
        DO
          BEGIN 
          MRCLMLK(I,STAT);
          IF STAT EQ CMASTAT"INTLK" 
          THEN
            BEGIN 
            MAPINTLK = TRUE;
            END 
  
          END 
  
        IF MAPINTLK 
        THEN
          BEGIN 
          RTIME(RTIMESTAT[0]);
          MAP$EXPIR = RTIMSECS[0] + MAP$INTV; 
          END 
  
        END  # RECLAIM SMA MAPS # 
  
      END  # RCLMLK # 
  
    TERM
PROC SCAN$LTCT; 
  
# TITLE SCAN$LTCT - PROCESS SWAPPED OUT *UCP*-S.                      # 
  
      BEGIN  # SCAN$LTCT #
  
# 
**    SCAN$LTCT - PROCESS SWAPPED OUT *UCP*-S.
* 
*     *SCAN$LTCT* SCANS THE *LTCT* TO REISSUE *UCP* RESPONSE CALLS
*     FOR ENTRIES WHICH HAVE THE SWAPPED-UCP FLAG SET.  IT IS CALLED
*     PERIODICALLY FROM *MAINLP*. 
* 
*     PROC SCAN$LTCT
* 
*     ENTRY   IF THE GLOBAL SWAPPED *UCP* FLAG (*GLBUCPSW*) 
*             IS SET, AN ATTEMPT IS MADE TO RESPOND TO ANY
*             PREVIOUSLY SWAPPED OUT *UCP*-S.  IF *GLBUCPSW*
*             IS NOT SET, NO PROCESSING IS DONE.
* 
*     EXIT    ANY SWAPPED-OUT *UCP*-S HAVE BEEN PROCESSED.
# 
  
# 
****  PROC SCAN$LTCT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC RTIME;                  # GET TIME SINCE LAST DEADSTART #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC UCP$RES;                # NOTIFY *UCP* OF COMPLETION # 
        END 
  
# 
****  PROC SCAN$LTCT - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBUCR 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXLTC 
*CALL,COMXMSC 
  
                                               CONTROL EJECT; 
  
# 
*     ONLY PROCESS SWAPPED OUT *UCP*-S. 
# 
  
      IF NOT GLBUCPSW 
      THEN
        BEGIN 
        RETURN; 
        END 
  
      UCP$EXPIR = 0;
  
      GLBUCPSW = FALSE; 
      FASTFOR LTCENTRY = 1 STEP 1 UNTIL LTCTCNT 
      DO
        BEGIN  # CHECK FOR *UCP* SWAPPED #
        IF LTC$UCPSW[LTCENTRY]
        THEN
          BEGIN  # CHECK SWAP IN STATUS # 
          IF LTC$SFFCC[LTCENTRY]
          THEN
            BEGIN 
            UCP$RES;
            END 
  
          ELSE
            BEGIN 
            GLBUCPSW = TRUE;
            RTIME(RTIMESTAT[0]);
            UCP$EXPIR = RTIMSECS[0] + UCP$INTV; 
            END 
  
          END  # CHECK SWAP IN STATUS # 
  
        END  # CHECK FOR *UCP* SWAPPED #
  
      RETURN; 
      END  # SCAN$LTCT #
  
    TERM
PROC SLAVERP(CALLERCTL);
  
# TITLE SLAVERP - SLAVE REQUEST PROCESSOR.                            # 
  
      BEGIN  # SLAVERP #
  
# 
**    SLAVERP  - SLAVE REQUEST PROCESSOR. 
* 
*     *SLAVERP* IS PERIODICALLY CALLED TO READ AND PROCESS THE
*     COMMUNICATION FILE FROM EACH DEFINED *SSSLV*.  AN INFORMATIVE 
*     OPERATOR MESSAGE WILL BE DISPLAYED FOR ANY *SSSLV* WHOSE
*     ACTIVE/INACTIVE STATUS HAS CHANGED SINCE THE PREVIOUS TIME ITS
*     COMMUNICATION FILE WAS READ.  ALSO, THE STATUS OF EACH REQUEST
*     BLOCK FOR EACH ACTIVE *SSSLV* IS EXAMINED TO DETERMINE IF ANY 
*     PROCESSING BY THE *SSEXEC* IS REQUIRED.  IF STAGE REQUESTS ARE
*     DETECTED, THEY ARE ADDED TO THE *HLRQ*. 
* 
*     PROC SLAVERP(CALLERCTL) 
* 
*     ENTRY      (CALLERCTL) =0, IF CALLED BY *MAINLP*. 
*                            .NQ. 0, IF CALLED BY *DOZER*.
* 
*                 THE IDENTITY AND PREVIOUS STATUS OF EACH DEFINED SLAVE
*                EXEC IS CONTAINED IN THE BUFFER FOR THE HEADER PORTION 
*                OF THE *MTOS* FILE.
*                (NXTRB) = THE NEXT REQUEST BLOCK FROM WHICH A STAGE
*                REQUEST WILL BE ACCEPTED.
* 
*     EXIT       (CALLERCTL)  =0, IF CALLED BY *DOZER* AND SLAVE
*                                REQUESTS NEED TO BE PROCESSED. 
*                                UNCHANGED OTHERWISE. 
* 
*                 THE VARIABLE *STOM$EXPIR* IS UPDATED
*                TO REFLECT THE NEXT TIME THIS PROCEDURE SHOULD BE
*                CALLED.
* 
*                THE HEADER PORTION OF THE *MTOS* FILE BUFFER IS
*                UPDATED TO REFLECT ANY NEW STATUS INFORMATION FOR EACH 
*                *SSSLV*.  THE REPLY BLOCK PORTION OF THE *MTOS* FILE 
*                IS UPDATED TO REFLECT ANY RESPONSE TO REQUESTS IN THE
*                REQUEST BLOCKS (SEE THE COMPOSITE REQUEST/REPLY BLOCK
*                STATUS DESCRIPTION IN *COMXMMF*).
* 
*     NOTES      IF THE *STOM* FILE FOR A GIVEN *SSSLV* ENCOUNTERS A
*                READ ERROR OR IF THE FILE LENGTH IS DIFFERENT FROM 
*                WHAT IS EXPECTED, THE STATUS OF THAT *SSSLV* 
*                WILL BE SET TO UNDEFINED.  IF THIS RESULTS IN NO 
*                DEFINED *SSSLV*, THEN THE *STOM$EXPIR* WORD WILL BE
*                SET TO A VERY LARGE VALUE SO THE *SSSLV* REQUEST 
*                PROCESSOR IS NEVER CALLED. 
* 
*     MESSAGES   * EXEC - SLAVE N XXXX.*
*                      AN INFORMATIVE MESSAGE INDICATING THAT 
*                      A CHANGE IN THE STATUS OF THE INDICATED
*                      *SSSLV* PROGRAM HAS BEEN DETECTED.  THE
*                      NEW *SSSLV* STATUS IS INDICATED BY *XXXX*, 
*                      WHICH CAN BE *ACTIVE* OR *INACTIVE*. 
* 
*                * EXEC - SLAVE N OMITTED -*
*                     - STOM FILE ERROR.* 
*                      THIS MESSAGE INDICATES THAT AN ERROR CONDITION 
*                      WAS DETECTED WHILE READING THE COMMUNICATION 
*                      FILE FROM THE SPECIFIED *SSSLV* PROGRAM. 
*                      THE *SSEXEC* WILL CONTINUE TO OPERATE, BUT WILL
*                      NOT ATTEMPT TO RECEIVE REQUESTS FROM THE 
*                      SPECIFIED *SSSLV* PROGRAM. 
* 
# 
  
      ITEM CALLERCTL  U;             # CALLER IDENTIFICATION #
  
# 
****  PROC SLAVERP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC MESSAGE;                # ISSUE MESSAGE MACRO #
        PROC PDATE;                  # ISSUE PDATE MACRO #
        PROC READ;                   # READ FILE #
        PROC REWIND;                 # REWIND FILE #
        PROC RTIME;                  # ISSUE RTIME MACRO #
        PROC SLVRBP;                 # SLAVE REQUEST BLOCK PROCESSOR #
        FUNC XCOD C(10);             # INTEGER TO DISPLAY # 
        PROC ZSETFET;                # INITIALIZE *FET* # 
        END 
  
# 
****  PROC SLAVERP - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBFET 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMMF 
*CALL,COMXMSC 
  
  
      ITEM DELAY      U;             # NUMBER OF SECONDS UNTIL NEXT 
                                       READ OF *STOM* # 
      ITEM DELTART    I;             # CHANGE IN THRESHOLD #
      ITEM PASSCTR    U;             # DUMMY INDUCION VARIABLE #
                                               CONTROL EJECT; 
  
      SLVACTIVE = FALSE;             # ASSUME NO SLAVES ACTIVE #
      DELAY = SLRP$INTV;
      RELOOP = FALSE; 
      SLOWFOR PASSCTR = 1 STEP 1 UNTIL 2
      DO
        BEGIN  # *STOM* SCAN #
        IF (NOT RELOOP OR NXTRB NQ 0)  ## 
          AND PASSCTR EQ 2
        THEN                         # EXIT IF SECOND PASS NOT NEEDED 
                                       OR NOT USEFUL #
          BEGIN 
          TEST PASSCTR; 
          END 
  
        SLOWFOR SINDX = 1 STEP 1 UNTIL NUMSLV 
        DO
          BEGIN  # PROCESS NEXT SLAVE # 
          P<MTOSREPBLK> = LOC(MTOSHEAD) + L$MTOSH + (SINDX-1)*NUMRB;
          IF NOT MSH$DEFD[SINDX]
          THEN                       # SLAVE NOT DEFINED #
            BEGIN 
            TEST SINDX; 
            END 
  
# 
*     READ *STOM* FILE. 
# 
  
          ZSETFET(LOC(STOMM),MSH$PFNS[SINDX],LOC(STOMMBUF),  ## 
            STOMBUFL,SFETL);
          P<STOMFILE> = LOC(STOMMBUF);
          REWIND(STOMM,RCL);
          READ(STOMM,RCL);
          PDATE(PDATESTAT[0]);
          RTIME(RTIMESTAT[0]);
  
# 
*     CHECK FOR FILE LENGTH OK AND NO *CIO* ERRORS. 
# 
  
          IF (FET$AT[0] NQ 0)        ## 
            OR (FET$IN[0]-FET$OUT[0] LS L$STOM) 
          THEN                       # *STOM* READ ERROR OR TOO SHORT # 
            BEGIN  # ISSUE ERROR MESSAGE #
            MSH$DEFD[SINDX] = FALSE;
            SLAVECTR = SLAVECTR - 1;
            CHAR10 = XCOD(SINDX); 
            SLVN$INDX[0] = C<9,1>CHAR10;
            SLVN$STAT[0] = "OMITTED - ";
            MESSAGE(SLVNSTAT,SYSUDF1);
            MMFD$PROB[0] = "STOM FILE ERROR.";
            MESSAGE(MMFDETAIL,SYSUDF1); 
            NXTRB = 0;
            TEST SINDX; 
            END  # ISSUE ERROR MESSAGE #
  
          IF DELAY GR SM$DELAY[0]    ## 
            AND SM$DELAY[0] NQ 0
          THEN
            BEGIN 
            DELAY = SM$DELAY[0];
            END 
  
# 
*     CHECK FOR CHANGE IN STATUS OF SLAVE EXEC. 
# 
  
          SLVN$INDX[0] = C<6,1>MSH$PFNS[SINDX]; 
          IF SM$SWC[0] NQ MSH$SWC[SINDX]
          THEN                       # SLAVE IS ACTIVE #
            BEGIN  # ACTIVE STATUS #
            SLVACTIVE = TRUE; 
            IF MSH$STATS[SINDX] NQ S"ACTIVE"
            THEN
              BEGIN 
              SLVN$STAT[0] = "ACTIVE."; 
              MSH$STATS[SINDX] = S"ACTIVE"; 
              MESSAGE(SLVNSTAT,SYSUDF1);
              END 
  
            MSH$SSW[SINDX] = SM$SSW[0]; 
            MSH$TIMOUT[SINDX] = RTIMSECS[0] + SLAV$INTV;
            END  # ACTIVE STATUS #
  
          ELSE                       # CHECK FOR TIMEOUT #
            BEGIN  # CHECK STATUS # 
            IF MSH$TIMOUT[SINDX] LS RTIMSECS[0] 
            THEN
              BEGIN 
              SLVN$STAT[0] = "INACTIVE."; 
              MESSAGE(SLVNSTAT,SYSUDF1);
              NXTRB = 0;
              MSH$TIMOUT[SINDX] = MAXSECS;
              MSH$STATS[SINDX] = S"DEAD"; 
              TEST SINDX; 
              END 
  
            ELSE
              BEGIN 
              SLVACTIVE = TRUE; 
              END 
  
            END  # CHECK STATUS # 
  
# 
*     EXAMINE EACH REQUEST BLOCK ON THE *STOM* FILE 
*     AND PROCESS ACCORDING TO ITS COMPOSITE STATUS.
# 
  
          IF SM$REQCTL[0] NQ MSH$REQCTL[SINDX]
          THEN
            BEGIN 
            IF (CALLERCTL EQ 0) 
            THEN                     # OK TO CALL *SLVRBP* #
              BEGIN 
              SLVRBP; 
              END 
  
            ELSE                     # RETURN TO CALLER # 
              BEGIN 
              CALLERCTL = 0;
              RETURN; 
              END 
  
            END 
  
          END  # PROCESS NEXT SLAVE # 
  
        END  # *STOM* SCAN #
  
# 
*     ESTABLISH THE NEXT TIME THE SLAVE REQUEST PROCESSOR 
*     IS TO BE CALLED.
# 
  
      IF NOT SLVACTIVE
      THEN                           # USE LARGER DELAY INTERVAL #
        BEGIN 
        DELAY = SLAV$INTV;
        END 
  
      RTIME(RTIMESTAT[0]);
      STOM$EXPIR = RTIMSECS[0] + DELAY; 
      IF SLAVECTR EQ 0 OR DRYUP 
      THEN
        BEGIN 
        SLVACTIVE = FALSE;
        STOM$EXPIR = MAXSECS; 
        END 
  
      RETURN; 
      END  # SLAVERP #
  
    TERM
PROC SLVRBP;
  
# TITLE SLVRBP - SLAVE REQUEST BLOCK PROCESSOR.                       # 
  
      BEGIN  # SLVRBP # 
  
# 
**    SLVRBP - SLAVE REQUEST BLOCK PROCESSOR. 
* 
*     *SLVRBP* CHECKS THE STATUS OF EACH REQUEST BLOCK FOR THE
*     CURRENT *SSSLV* AND DETERMINES IF ANY PROCESSING BY *SSEXEC*
*     IS REQUIRED.
* 
*     PROC SLVRBP 
* 
*     ENTRY      (PDATEV[0]) = CURRENT PACKED DATE AND TIME.
*                P<MTOSREPBLK> = REPLY BLOCK PORTION OF THE *MTOS*
*                  FILE.
*                P<STOMFILE> = *STOM* FILE REQUEST BLOCKS.
* 
*     EXIT       THE REPLY BLOCK PORTION OF THE *MTOS* FILE IS
*                UPDATED TO REFLECT ANY RESPONSE TO REQUESTS IN THE 
*                REQUEST BLOCKS (SEE THE COMPOSITE REQUEST/REPLY
*                BLOCK STATUS DESCRIPTION IN *COMXMMF*. 
# 
  
# 
****  PROC SLVRBP - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC SLVTDAM;                # SLAVE *TDAM* REQUEST PROCESSOR # 
        END 
  
# 
****  PROC SLVRBP - XREF LIST END.
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMXIPR 
*CALL,COMXMMF 
  
      ITEM I          I;             # LOOP COUNTER # 
      ITEM REJCNT     I;             # REJECT COUNTER # 
                                               CONTROL EJECT; 
  
      REJCNT = 0; 
      FASTFOR I = 1 STEP 1 UNTIL NUMRB
      DO
        BEGIN  # PROCESS REQUEST BLOCKS # 
  
        IF SM$SRC[I] EQ S"AVAIL"     ## 
          AND MSR$MRC[I] EQ S"FINISHED" 
        THEN
  
# 
*     MASTER REPLY CODE PROCCESSED BY SLAVE - MAKE REQUEST BLOCK
*     AVAILABLE FOR NEW REQUESTS. 
# 
  
          BEGIN 
          MSR$MRC[I] = S"AVAIL";
          MSR$PDATE[I] = PDATEV[0]; 
          TEST I;                    # PROCESS NEXT REQUEST # 
          END 
  
        IF SM$SRC[I] EQ S"CANCEL"    ## 
          AND MSR$MRC[I] NQ S"FINISHED" 
        THEN
  
# 
*     SLAVE CANCELLED THIS REQUEST - ACKNOWLEDGE CANCELLATION.
# 
  
          BEGIN 
          MSR$MRC[I] = S"FINISHED"; 
          MSR$REPLY[I] = S"CANCELLED";
          MSR$PDATE[I] = PDATEV[0]; 
          TEST I;                    # PROCESS NEXT REQUEST # 
          END 
  
        IF SM$SRC[I] EQ S"SUBMITTED"  ##
          AND MSR$MRC[I] EQ S"AVAIL"
        THEN
  
# 
*     SLAVE ISSUED A NEW *TDAM* REQUEST - PROCESS THIS REQUEST. 
# 
  
          BEGIN 
          SLVTDAM(I,REJCNT);
          END 
  
        END  # PROCESS REQUEST BLOCKS # 
  
      IF REJCNT EQ 0
      THEN
        BEGIN 
        MSH$REQCTL[SINDX] = SM$REQCTL[0]; 
        END 
  
      END  # SLVPRB # 
  
    TERM
PROC SLVTDAM((RB),REJCNT);
  
# TITLE SLVTDAM - SLAVE *TDAM* REQUEST PROCESSOR.                     # 
  
      BEGIN  # SLVTDAM #
  
# 
**    SLVTDAM - SLAVE *TDAM* REQUEST PROCESSOR. 
* 
*     *SLVTDAM* DOES THE PRELIMINARY PROCESSING OF A REQUEST FROM AN
*     *STOM* FILE REQUEST BLOCK.  STAGE REQUESTS WHICH DUPLICATE
*     THOSE ALREADY IN PROCESS (*HLRQ*) OR QUEUED (*RTRQ*) ARE
*     UPDATED TO INDICATE SLAVE ORIGIN.  NON-DUPLICATE STAGE
*     AND OTHER REQUESTS ARE QUEUED IN THE *RTRQ* ACTIVE CHAIN. 
* 
*     PROC SLVTDAM((RB),REJCNT) 
* 
*     ENTRY      (NXTRB) = THE NEXT REQUEST BLOCK FROM WHICH A STAGE
*                  REQUEST WILL BE ACCEPTED.
*                (PDATEV[0]) = PACKED DATE AND TIME.
*                P<MTOSREPBLK> = REPLY BLOCK PORTION OF THE *MTOS*
*                  FILE.
*                P<STOMFILE> = *STOM* FILE REQUEST BLOCKS.
*                (RB) = REQUEST BLOCK INDEX.
*                (REJCNT) = REJECT COUNTER. 
*                (SINDX) = SLAVE INDEX. 
* 
*     MESSAGES   * INCORRECT TDAM REQUEST.* 
* 
*     NOTES      IF A STAGE REQUEST FROM REQUEST BLOCK *J* OF *SSSLV* 
*                *I* CANNOT BE ENTERED INTO THE *HLRQ* FOR PROCESSING 
*                BECAUSE EITHER THE THRESHOLD FOR *SSSLV* STAGE 
*                REQUESTS HAS BEEN REACHED OR BECAUSE THE *HLRQ* IS 
*                FULL, *NXTRB* WILL BE SET TO REFLECT THE VALUES OF 
*                *I* AND *J*.  WHEN THIS OCCURS, ALL NORMAL PROCESSING
*                OF THE *STOM* FILES CONTINUES, EXCEPT THAT ALL 
*                NONDUPLICATE STAGE REQUESTS ARE IGNORED UNTIL THE ONE
*                FROM *SSSLV* *I*, REQUEST BLOCK *J*, CAN BE ACCEPTED.
*                WHEN THIS STAGE REQUEST IS FINALLY ACCEPTED, A SECOND
*                SCAN OF ALL *STOM* FILES IS MADE TO SEE IF A 
*                PREVIOUSLY IGNORED STAGE REQUEST CAN NOW BE ACCEPTED.
# 
  
      ITEM RB         U;             # REQUEST BLOCK INDEX #
      ITEM REJCNT     I;             # REJECT COUNTER # 
  
# 
****  PROC SLVTDAM - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ENTDAM;                 # ENTER *TDAM* REQUEST FOR 
                                       PROCESSING # 
        PROC MSG;                    # ISSUE MESSAGE #
        PROC SRCHDS;                 # SEARCH FOR DUPLICATE STAGE # 
        END 
  
# 
****  PROC SLVTDAM - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBTDM 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXMMF 
  
      ITEM I          U;             # INDEX #
      ITEM NEWTDAM    U;             # ADDRESS OF ACCEPTED *TDAM* 
                                       REQUEST #
      ITEM STAT       I;
      ITEM THISRB     U;
  
                                               CONTROL EJECT; 
  
      P<TDAM> = LOC(SM$TDAM[RB]); 
      IF TDAMFC[0] LQ TDAMFCODE"NOREQ"  ##
        OR TDAMFC[0] EQ TDAMFCODE"DESTRLS"  ##
        OR TDAMFC[0] EQ TDAMFCODE"DESTAGE"  ##
        OR TDAMFC[0] GQ TDAMFCODE"FCEND"
      THEN                           # ABANDON INCORRECT REQUESTS # 
        BEGIN 
        MSG(INVRQC,UDFL1);
        MSR$MRC[RB] = S"FINISHED";
        MSR$REPLY[RB] = S"ABANDONED"; 
        MSR$PDATE[RB] = PDATEV[0];
        MTOS$EXPIR = 0; 
        END 
  
# 
*     PROCESS SLAVE *TDAM* REQUESTS.
# 
  
      THISRB = SINDX * NUMRB + RB;
      IF THISRB EQ NXTRB
      THEN
        BEGIN 
        NXTRB = 0;
        END 
  
      ENTDAM(P<TDAM>,NXTRB,NEWTDAM);
  
      IF NEWTDAM NQ 0 
      THEN                           # REQUEST ACCEPTED # 
        BEGIN  # PROCESS REQUEST ACCEPTED # 
        P<TDAM> = NEWTDAM;
        IF TDAMFC[0] NQ TDAMFCODE"STAGE"
        THEN                         # REPLY TO INTERLOCK REQUEST # 
          BEGIN 
          MSR$MRC[RB] = S"FINISHED";
          MSR$REPLY[RB] = REPLY"OK";
          MTOS$EXPIR = 0; 
          MSR$PDATE[RB] = PDATEV[0];
          RETURN; 
          END 
  
        TDAMOSLV[0] = TRUE; 
  
# 
*     REPLY TO STAGE REQUEST. 
# 
  
        IF TDAMSSN[0] EQ 0
        THEN                         # ESTABLISH A STAGING SEQUENCE 
                                       NUMBER # 
          BEGIN 
          TDAMSSN[0] = NEXTSSN; 
          NEXTSSN = NEXTSSN + 1;
          IF NEXTSSN GQ MAXSSN
          THEN
            BEGIN 
            NEXTSSN = 1;
            END 
  
          END 
  
        MSR$SSN[RB] = TDAMSSN[0]; 
        MSR$MRC[RB] = S"ACCEPTED";
        END  # PROCESS REQUEST ACCEPTED # 
  
      ELSE                           # REQUEST NOT ACCEPTED # 
        BEGIN 
        REJCNT = REJCNT + 1;
  
        IF NXTRB NQ 0 
        THEN
          BEGIN 
          RELOOP = RELOOP OR (THISRB LS NXTRB); 
          END 
  
        ELSE
          BEGIN 
          NXTRB = THISRB; 
          END 
  
        RETURN; 
        END 
  
      END  # SLVTDAM #
  
    TERM
PROC STARTUP; 
  
# TITLE STARTUP - HANDLES ALL *SSEXEC* INITIALIZATION.                # 
      BEGIN  # STARTUP #
  
# 
**    STARTUP - HANDLES ALL *SSEXEC* INITIALIZATION.
* 
*     THIS ROUTINE PERFORMS ALL HARDWARE AND NON-HARDWARE INITIALIZING
*     OF *SSEXEC*.
* 
*     PROC          STARTUP.
* 
*     EXIT          ALL INITIALIZATION HAS BEEN PERFORMED.
* 
*     NOTES         THIS ROUTINE CALLS THE OVERLAY *INITLZR* TO 
*                   PERFORM *SSEXEC* INITIALIZATION, AND
*                   THEN ISSUES AN *INITHW* *LLRQ* REQUEST TO 
*                   TO INITIALIZE THE *M860* HARDWARE.
# 
  
# 
****  PROC STARTUP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC KPROC;                  # *K* DISPLAY PROCESSOR #
        PROC KREQ;                   # ISSUE K-DISPLAY REQUEST #
        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS # 
        PROC LLRQENQ;                # *LLRQ* ENQUEUER #
        PROC MSG;                    # ISSUE DAYFILE MESSAGE #
        PROC RECALL;                 # SUSPEND PROCESSING # 
        END 
  
# 
****  PROC STARTUP - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCMD 
*CALL,COMBCPR 
*CALL,COMBKDD 
*CALL,COMBLRQ 
*CALL,COMBOVL 
*CALL,COMBUCR 
*CALL,COMBUDT 
*CALL,COMXCTF 
*CALL,COMXJCA 
*CALL,COMXMSC 
  
  
      ITEM I          U;             # INDEX #
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS # 
      ITEM NOCUON     B;             # SET IF ALL CU-S OFF #
  
  
# 
*     BUFFER FOR K-DISPLAY WORDS. 
# 
  
      ARRAY  KDISB  [0:0]  S(2);
        BEGIN  # K-DISPLAY WORDS #
        ITEM KDIS$1     U(00,00,60);  # K-DISPLAY WORD 1 #
        ITEM KDIS$2     U(01,00,60);  # K-DISPLAY WORD 2 #
        END  # K-DISPLAY WORDS #
  
# 
*     GENERAL MESSAGE BUFFER. 
# 
  
      ARRAY MSGMB [0:0] S(5); 
        BEGIN  # GENERAL #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$ZERO   U(04,00,12) = [0];  # ZERO-BYTE TERMINATOR #
        END  # GENERAL #
  
                                               CONTROL EJECT; 
  
      SSOVL(LINITLZR,0);             # LOAD INITIZLIZATION OVERLAY #
  
      IF FATALERR 
      THEN                           # FATAL ERROR WHILE INITIALIZING # 
        BEGIN  # ABORT #
        RETURN; 
        END  # ABORT #
  
# 
*     SET THE INITIALIZATION FLAG TO TELL THE *UCP* REQUEST PROCESSORS
*     THAT ALL M860 HARDWARE IS BEING INITIALIZED.  WHEN THIS FLAG IS 
*     SET, *SSALTER* REQUESTS TO MODIFY THE UDT ARE NOT CONVERTED INTO
*     INDIVIDUAL DRIVER HARDWARE REQUESTS.
# 
  
      INITIALIZE = TRUE;             # INDICATE FULL INITIALIZATION # 
  
# 
*     ALLOW *SSALTER* TO MODIFY THE UDT UNTIL A K-DISPLAY 
*     *GO* REPLY IS RECEIVED FROM THE OPERATOR. 
# 
  
      P<KWORD> = LOC(KDIS$1[0]);
      KW$WORD[0] = 0; 
      KW$RPGO[0] = TRUE;             # ALLOW GO RESPONSE #
      KW$DF[0] = TRUE;               # ISSUE MESSAGE TO JOB DAYFILE # 
      KW$LINE1[0] = KM"KM12";        # ISSUE UDT ALTERATION MESSAGE # 
      KW$LINE3[0] = 0;
      KREQ(P<KWORD>,KLINK);          # ISSUE K-DISPLAY MESSAGE #
      REPEAT WHILE NOT KW$COMP[0] 
      DO                             # PROCESS *SSALTER* REQUESTS # 
        BEGIN  # PROCESS #
        KPROC;                       # *K* DISPLAY MESSAGE #
  
        RECALL(0);
  
        IF RA$SSCINLK[0]
        THEN                         # *UCP* BUFFER CONTAINS REQUEST #
          BEGIN  # CHECK REQUEST #
          P<CPR> = RA$SSCAP[0] + 2; 
          IF CPR$RQT[0] NQ TYP"TYP4"
          THEN                       # *LLRQ* ENTRY NOT NEEDED #
            BEGIN  # LOAD # 
            SSOVL(LNEWWORK,0);       # CALL *UCP* PROCESSOR IN
                                       *NEWWORK* OVERLAY #
            END  # LOAD # 
  
          END  # CHECK REQUEST #
  
        P<KWORD> = LOC(KDIS$1[0]);   # RESET TO CHECK IF COMPLETE # 
        END  # PROCESS #
  
      MSG("  ACTIVE.",LINE1);        # DISPLAY *ACTIVE* LINE #
  
# 
*     CLEAN UP ALL M860 HARDWARE STATUSES IN THE UDT. 
# 
  
      NOCUON = TRUE;                 # ASSUME ALL CU-S OFF #
      SLOWFOR I = 1 STEP 1 UNTIL MAXCTN 
      DO                             # PRESET CONTROLLER ENTRIES #
        BEGIN  # PRESET # 
        IF UD$EXIST[I]
        THEN                         # CLEAN UP THIS CONTROLLER # 
          BEGIN  # CLEANUP #
          IF UD$CUON[I] 
          THEN                       # AT LEAST ONE CU ON # 
            BEGIN  # RESET #
            NOCUON = FALSE; 
            END  # RESET #
  
          UD$CNUP[I] = TRUE;         # SET CLEANUP #
          LLRQENQ(LLRADR);           # SET UP *LLRQ* ENTRY #
          P<LLRQ> = LLRADR; 
          LLR$PRCNME[0] = REQTYP4"INITHW";  # INITIALIZE HARDWARE # 
          LLR$CU[0] = I;             # SET CONTROLLER ORDINAL # 
          LLR$RQI[0] = REQNAME"RQIINT"; 
          END  # CLEANUP #
  
        END  # PRESET # 
  
      IF NOCUON                      # NO CU ON # 
      THEN                           # ALL CU-S OFF # 
        BEGIN  # OFF #
        MSG$LINE[0] = " ALL CONTROLLERS OFF.";
        MSG(MSGMB,SYSUDF1); 
        MSG$LINE[0] = "$ALL CONTROLLERS OFF.";
        MSG(MSGMB,LINE2); 
        END  # OFF #
  
      RETURN; 
      END  # STARTUP #
  
    TERM
PROC SWAPPER((EXPIRTIME));
  
# TITLE SWAPPER - REDUCE FIELD LENGTH AND GO INTO RECALL.             # 
  
      BEGIN  # SWAPPER #
  
# 
**    SWAPPER - REDUCE FIELD LENGTH AND GO INTO RECALL. 
* 
*     *SWAPPER* WRITES PART OF *SSEXEC*-S FIELD LENGTH
*     TO DISK, REDUCES THE FIELD LENGTH, AND GOES INTO
*     RECALL.  *SSEXEC* IS REACTIVATED WHEN THE EXPIRATION
*     TIME IS REACHED OR WHEN ANOTHER CRITERIA FOR SWAPIN 
*     IS MET.  FIELD LENGTH IS THEN EXPANDED AND MEMORY IS
*     RESTORED. 
* 
*     PROC SWAPPER((EXPIRTIME)) 
* 
*     ENTRY   (EXPIRTIME) = DELAY EXPIRATION TIME CALCULATED
*                           IN *RCLTEST*. 
* 
*     EXIT    PSEUDO-SWAPOUT/SWAPIN COMPLETE WITH *SSEXEC*
*             REACTIVATED.  IF A *READ* ERROR OCCURS AND
*             MEMORY CANNOT BE RESTORED, THE *TERMINATE* FLAG 
*             IS SET AND CONTROL REGISTER R1 IS SET TO *RESTART*
*             (DEFINED IN *COMXMSC).  AN ENDRUN IS THEN DONE, 
*             CAUSING EXEC TO BE RELOADED FOR A NEW EXECUTION.
# 
  
      ITEM EXPIRTIME  U;             # DELAY EXPIRATION TIME #
  
# 
****  PROC SWAPPER - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORT PROCESSING # 
        PROC DOZER;                  # PUT *SSEXEC* INTO RECALL # 
        PROC MESSAGE;                # INTERFACE TO *MESSAGE* MACRO # 
        PROC MSG;                    # ISSUE DAYFILE MESSAGE #
        PROC MNGMEM;                 # CHANGE FIELD LENGTH #
        PROC SSOVL;                  # LOAD *MSAS* OVERLAYS # 
        PROC READ;                   # READ A FILE #
        PROC RECALL;                 # SUSPEND PROCESSING # 
        PROC REWIND;                 # REWIND FILE #
        PROC WRITEF;                 # WRITE END-OF-FILE #
        FUNC XCDD C(10);             # CONVERT INTEGER TO DISPLAY # 
        PROC ZSETFET;                # INITIALIZE A *FET* # 
        END 
  
# 
****  PROC SWAPPER - XREF LIST END. 
# 
  
      DEF SWAPLFN   #"MSSROLL"#;     # SWAP-OUT FILE NAME # 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBFET 
*CALL,COMXACM 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMSC 
  
      ITEM DC$FL      C(10);         # FIELD LENGTH IN DISPLAY CODE # 
      ITEM FIRST      B = TRUE;      # FIRST TIME FLAG #
      ITEM FL$CHANGE  U;             # AMOUNT OF FIELD LENGTH CHANGE #
      ITEM I          U;             # INDUCTION VARIABLE # 
      ITEM MNG$REQ    U;             # REQUEST FOR *MNGMEM* # 
      ITEM RCLFLAG    B;             # SET IF RECOVERY WAS DELAYED #
      ITEM STAT       U;             # STATUS RETUSRNED BY *MNGMEM* # 
      ITEM SWAPFWA    U;             # FIRST WORD OF MEMORY TO BE # 
                                     # WRITTEN TO DISK #
  
      ARRAY MSGLINE [0:0] S(4);      # CONTAINS DAYFILE MESSAGE # 
        BEGIN 
        ITEM MSGITEM    C(00,00,38);  # CHARACTER STRING #
        ITEM MSGZERO    U(03,48,12)=[0];  # ZERO BYTE TERMINATOR #
        END 
  
      ARRAY SWPFET [0:0] S(RFETL);;  # *FET* FOR SWAP-OUT FILE #
  
                                               CONTROL EJECT; 
  
# 
*     COPY PART OF *SSEXEC* FIELD LENGTH TO DISK. 
# 
  
      P<FETSET> = LOC(SWPFET[0]); 
      FE$RTN[0] = "SWAPPER."; 
      IF FIRST
      THEN                           # INITIALIZE *FET* # 
        BEGIN 
        SWAPFWA = ((LOC(SSOVL) + PRULEN - 1)/PRULEN)*PRULEN;
        FL$CHANGE = CUR$FL - SWAPFWA;  # FIELD LENGTH CHANGE #
        MNG$REQ = FL$CHANGE - UNU$FL; 
        ZSETFET(LOC(SWPFET[0]),SWAPLFN,SWAPFWA-1,FL$CHANGE+1,RFETL);
        FET$OUT[0] = SWAPFWA; 
        FIRST = FALSE;
        END 
  
      ELSE                           # UPDATE TO CURRENT FIELD LENGTH # 
        BEGIN 
        FET$LIM[0] = CUR$FL;
        REWIND(SWPFET[0],RCL);
        FET$OUT[0] = SWAPFWA; 
        FL$CHANGE = CUR$FL - SWAPFWA; 
        MNG$REQ = FL$CHANGE - UNU$FL; 
        END 
  
      MSGITEM[0] = "   IDLE.";
      MESSAGE(MSGLINE[0],LINE1);
  
# 
*     NOTE 1 - BEGINNING OF REDUCED FL CONDITION. 
* 
*     ANY CHANGES TO CODE BETWEEN HERE AND NOTE 2 WILL
*     AFFECT SSEXECS IDLE FIELD LENGTH.  IF THIS CODE 
*     IS CHANGED SUCH THAT ADDITIONAL ROUTINES ARE
*     REFERENCED WHILE SSEXEC IS IDLE, THE LIST OF
*     LDSET STATEMENTS IN SSEXEC MUST BE AUGMENTED TO 
*     INCLUDE THE ADDITIONAL ROUTINES, AND THE BUILD
*     PROCEDURE FOR SSEXEC MUST ALSO BE CHANGED TO
*     INSURE THAT THE ADDITIONAL ROUTINES GET LOADED IN 
*     LOW CORE BELOW ROUTINE *ZSETFET*. 
# 
  
      WRITEF(SWPFET[0],RCL);         # COPY PART OF FIELD LENGTH #
  
# 
*     REDUCE FIELD LENGTH AND GO INTO RECALL. 
# 
  
      MNGMEM(-MNG$REQ,STAT);
      IF STAT EQ 0
      THEN                           # FATAL ERROR CONDITION #
        BEGIN 
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END 
  
      EXPIRTIME = EXPIRTIME - READFLTIME; 
      DOZER(EXPIRTIME); 
  
# 
*     EXPAND FIELD LENGTH TO PREVIOUS SIZE. 
# 
  
      RCLFLAG = FALSE;
      FASTFOR I = 0 WHILE STAT EQ 0 
      DO
        BEGIN  # INCREASE FIELD LENGTH #
  
        MNGMEM(MNG$REQ,STAT);        # REQUEST INCREASE # 
  
        IF STAT EQ 0
        THEN                         # INCREASE UNSUCCESSFUL #
          BEGIN 
          MSGITEM[0] = "$SSEXEC SEEKING FL INCREASE.";
          MESSAGE(  MSGLINE[0],LINE1);
          RECALL(0);
          RCLFLAG = TRUE; 
          END 
  
        END  # INCREASE FIELD LENGTH #
  
      IF RCLFLAG
      THEN                           # RECOVERY DELAYED BUT COMPLETE #
        BEGIN 
        MSGITEM[0] = " SSEXEC ACTIVE."; 
        MESSAGE(MSGLINE[0],LINE1);
        END 
  
# 
*     RESTORE MEMORY. 
# 
  
      P<FETSET> = LOC(SWPFET[0]); 
      REWIND(SWPFET[0],RCL);
      FET$OUT[0] = SWAPFWA; 
      FET$IN[0] = SWAPFWA;
      FET$EP[0] = TRUE; 
      READ(SWPFET[0],RCL);
  
# 
*     NOTE 2 - END OF REDUCED FL CONDITION. 
# 
  
      IF FET$AT[0] NQ OK
      THEN                           # UNABLE TO RESTORE MEMORY # 
        BEGIN 
        MSGITEM[0] = "$ERROR ON ROLLFILE - EXEC ABORTING."; 
        MESSAGE(MSGLINE[0],SYSUDF1);
        ABORT;
        END 
  
      MSGITEM[0] = "  ACTIVE."; 
      MESSAGE(MSGLINE[0],LINE1);
  
      RETURN; 
      END  # SWAPPER #
  
    TERM
PROC TELLSLV((SSN),(STAT)); 
  
# TITLE TELLSLV - TELL *SSSLV* A STAGE REQUEST HAS COMPLETED.         # 
  
      BEGIN  # TELLSLV #
  
# 
**    TELLSLV - TELL *SSSLV* A STAGE REQUEST HAS COMPLETED. 
* 
*     *TELLSLV* IS CALLED WHEN A STAGE REQUEST FROM AN *SSSLV*
*     HAS COMPLETED.  IT WILL FIND THE REQUEST BLOCKS, IF ANY,
*     FOR THIS STAGE REQUEST AND ENTER THE COMPLETION STATUS
*     INTO THE CORRESPONDING REPLY BLOCKS.  THE *MTOS$EXPIR*
*     FLAG IS CLEARED TO CAUSE THE *MTOS* FILE TO BE FLUSHED. 
* 
*     PROC TELLSLV((SSN),(STAT))
* 
*     ENTRY      (SSN) = THE STAGING SEQUENCE NUMBER OF THE COMPLETED 
*                         STAGE REQUEST.  THIS NUMBER WAS ENTERED 
*                         INTO THE REQUEST BLOCK WHEN THE STAGE 
*                         REQUEST WAS ACCEPTED FOR PROCESSING.
*                (STAT) = STATUS OF THE COMPLETED STAGE REQUEST.
* 
*     EXIT       THE APPROPRIATE REPLY BLOCKS IN THE
*                *MTOS* FILE ARE UPDATED, AND THE 
*                *MTOS$EXPIR* FLAG IS CLEARED.
# 
  
      ITEM SSN        U;             # STAGING SEQUENCE NUMBER #
      ITEM STAT       U;             # =0 IF *PFC* UPDATED #
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMMF 
  
  
      ITEM RB         U;             # INDEX TO A REQUEST BLOCK # 
      ITEM STATS      S:REPLY;       # STATUS OF STAGE REQUEST #
                                               CONTROL EJECT; 
      STATS = REPLY"OK";
      IF STAT NQ 0
      THEN
        BEGIN 
        STATS = REPLY"ABANDONED"; 
        END 
  
# 
*     SEARCH THE REPLY BLOCKS OF EACH SLAVE 
*     TO FIND A MATCHING *SSN* VALUE. 
*     A MATCH INDICATES THAT THE STAGE WAS
*     DONE FOR THE CORRESPONDING SLAVE AND
*     REQUEST BLOCK.  PUT THE STAGING STATUS
*     INTO THE REPLY BLOCK AND CAUSE THE
*     *MTOS* FILE TO BE WRITTEN.
# 
  
      SLOWFOR SINDX = 1 STEP 1 UNTIL SLAVECTR 
      DO
        BEGIN  # CHECK ALL SLAVES # 
        P<MTOSREPBLK> = LOC(MTOSHEAD) + L$MTOSH + (SINDX-1)*NUMRB;
  
        SLOWFOR RB = 1 STEP 1 UNTIL NUMRB 
        DO
          BEGIN  # CHECK REPLY BLOCKS FOR THIS SLAVE #
          IF MSR$SSN[RB] EQ SSN 
          THEN                       # STAGE SEQUENCE NUMBER MATCH
                                       FOUND #
            BEGIN 
            MSR$MRC[RB] = S"FINISHED";
            MSR$REPLY[RB] = STATS;
            MSR$PDATE[RB] = PDATEV[0];
            MSR$SSN[RB] = 0;
            MTOS$EXPIR = 0;          # FORCE THE *MTOS* BUFFERS TO BE 
                                       FLUSHED #
            TEST SINDX; 
            END 
  
          END  # CHECK REPLY BLOCKS FOR THIS SLAVE #
  
        END  # CHECK ALL SLAVES # 
  
      END  # TELLSLV #
  
    TERM
PROC TERMTST; 
  
# TITLE TERMTST - TESTS THE TERMINATION CRITERIA.                     # 
  
      BEGIN  # TERMTST #
  
# 
**    TERMTST - TESTS THE TERMINATION CRITERIA. 
* 
*     THIS PROCEDURE IS CALLED BY *MAINLP* IF THE *DRYUP* 
*     FLAG IS SET.  IT DETERMINES WHETHER TERMINATION 
*     CRITERIA FOR *SSEXEC* HAVE BEEN MET.
* 
*     PROC TERMTST
* 
*     ENTRY   *DRYUP* FLAG HAS BEEN SET.
* 
*     EXIT    *TERMINATE* FLAG IS SET IF ALL THE REQUIRED 
*             CONDITIONS FOR TERMINATION EXIST. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBMAT 
*CALL,COMXCTF 
*CALL,COMXLTC 
  
      ITEM COUNT      U;             # CHAIN ENTRY COUNT #
      ITEM I          U;             # INDUCTION VARIABLE # 
  
                                               CONTROL EJECT; 
  
# 
*     CHECK FOR ANY CONNECTED *UCP*S. 
# 
  
      FASTFOR I = 1 STEP 1 UNTIL LTCTCNT
      DO                             # CHECK LONG TERM CONNECT TABLE #
        BEGIN 
        IF LTC$WORD1[I] NQ 0 AND NOT INITIALIZE 
        THEN                         # CONNECTED *UCP* FOUND #
          BEGIN 
          RETURN; 
          END 
  
        END 
  
# 
*     CHECK REQUEST QUEUES FOR OUTSTANDING REQUESTS.
# 
  
      IF CHN$BOC[LCHN"RTD$ACT"] NQ 0 AND NOT INITIALIZE 
      THEN                           # *RTRQ* NOT EMPTY # 
        BEGIN 
        RETURN; 
        END 
  
  
      IF CHN$BOC[LCHN"HL$ACTV"] NQ 0
      THEN                           # *HLRQ* ACTIVE CHAIN NOT EMPTY #
        BEGIN 
        RETURN; 
        END 
  
      COUNT = 0;
      P<LINKWRD> = LOC(CHNPTRS[LCHN"LL$FRSPC"]);
  
      SLOWFOR I = 0 WHILE LINK$ADR[0] NQ 0
      DO                             # COUNT FREE *LLRQ* ENTRIES #
        BEGIN 
        COUNT = COUNT + 1;
        P<LINKWRD> = LINK$ADR[0]; 
        END 
  
      IF COUNT NQ MAT$COUNT[MAT$ENTRY"LLRQ"]  ##
        AND NOT INITIALIZE           # NO *LLRQ* CLEANUP NEEDED # 
      THEN                           # ACTIVE *LLRQ* ENTRIES EXIST #
        BEGIN 
        RETURN; 
        END 
  
      IF DRVRRECALL 
      THEN                           # ACTIVE CPU DRIVER #
        BEGIN 
        RETURN; 
        END 
  
      TERMINATE = TRUE;              # TERMINATION CRITERIA MET # 
      RETURN; 
      END  # TERMTST #
  
    TERM
PROC TRYTDAM; 
  
# TITLE TRYTDAM - SERVICES THE *TDAM* BUFFER.                         # 
  
      BEGIN  # TRYTDAM #
  
# 
**    TRYTDAM - SERVICES THE *TDAM* BUFFER. 
* 
*     THIS PROCEDURE TRANSFERS *TDAM* REQUESTS FROM THE 
*     *TDAM* BUFFER INTO THE *RTRQ* ACTIVE CHAIN.  NO 
*     TRANSFER OCCURS IF THE *TDAM* BUFFER IS EMPTY, IF 
*     THE *RTRQ* FREE SPACE CHAIN IS EMPTY, OR IF THE 
*     *DRYUP* FLAG IS SET AND THE REQUEST IS A STAGE. 
* 
*     PROC TRYTDAM
* 
*     ENTRY   THERE IS A REQUEST IN THE *TDAM* BUFFER.
* 
*     EXIT    *TDAM* REQUEST TRANSFERRED TO *RTRQ*, 
*             IF POSSIBLE.
# 
  
# 
****  PROC TRYTDAM - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ENTDAM;                 # ENTER *TDAM* REQUEST FOR 
                                       PROCESSING # 
        END 
  
# 
****  PROC TRYTDAM - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBTDM 
*CALL,COMXCTF 
*CALL,COMXJCA 
*CALL,COMXMSC 
  
  
      ITEM TDAMIN     U;             # LOCATION OF ORIGINAL *TDAM*
                                       REQUEST #
      ITEM TDAMOUT    U;             # LOCATION OF ACCEPTED *TDAM*
                                       REQUEST #
                                               CONTROL EJECT; 
  
# 
*     SERVICE THE *TDAM* BUFFER IF POSSIBLE.
# 
  
      TDAMIN = LOC(RA$TDAM[0]); 
      IF ((NOT DRYUP) AND (GLBSTFL))          ##
        OR (TDAMFC[0] NQ TDAMFCODE"STAGE")
      THEN
        BEGIN  # PROCESS REQUEST #
  
        ENTDAM(TDAMIN,0,TDAMOUT);    # SUBMIT *TDAM* REQUEST #
  
        P<TDAM> = TDAMOUT;
        IF TDAMOUT NQ 0              ## 
          AND TDAMFC[0] EQ TDAMFCODE"STAGE" 
        THEN
          BEGIN 
          TDAMOMAST[0] = TRUE;
          END 
  
        END  # PROCESS REQUEST #
  
      P<TDAM> = TDAMIN; 
  
# 
*     INSURE CLEARING IS COMPLETE BEFORE NEW TDAM IS ENTRIED. 
# 
  
      TDAMWORD[0] = 0;
      RETURN; 
      END  # TRYTDAM #
  
    TERM
PROC WAKE$UP; 
  
# TITLE WAKE$UP - WAKE UP DELAYED PROCESSES.                          # 
  
      BEGIN  # WAKE$UP #
  
# 
**    WAKE$UP - WAKE UP DELAYED PROCESSES.
* 
*     *WAKE$UP* REACTIVATES ANY DELAYED PROCESSES WHOSE WAKE-UP TIME
*     HAS COME. 
* 
*     PROC WAKE$UP
* 
*     ENTRY      CALLED BY *MAINLP* WHEN *HLRQ* OR *LLRQ* DELAY CHAINS
*                ARE POPULATED. 
* 
*     EXIT       ALL ENTRIES WHOSE WAKE-UP TIME HAS COME ARE ON THE 
*                APPROPRIATE (*HLRQ* OR *LLRQ*) READY CHAIN.
# 
  
# 
****  PROC WAKE$UP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC RTIME;                  # GET SYSTEM CLOCK READING # 
        END 
  
# 
****  PROC WAKE$UP - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBLRQ 
*CALL,COMXCTF 
*CALL,COMXHLR 
*CALL,COMXIPR 
*CALL,COMXMSC 
  
      ITEM ENTADR     U;             # CURRENT ENTRY ADDRESS #
      ITEM NEXTADDR   U;             # NEXT ENTRY ADDRESS # 
  
                                               CONTROL EJECT; 
  
# 
*     INITIALIZE MINIMUM QUEUE DELAY INTERVAL.
# 
  
      RTIME(RTIMESTAT[0]);
      MINQ$EXPIR = RTIMSECS[0] + MINQ$INTV; 
  
# 
*     REACTIVATE ALL *HLRQ* ENTRIES WHOSE WAKE-UP TIME HAS COME.
# 
  
      ENTADR = CHN$BOC[LCHN"HL$DELAY"]; 
      REPEAT WHILE ENTADR NQ 0
      DO
        BEGIN  # SEARCH DELAY CHAIN # 
        P<HLRQ> = ENTADR; 
        NEXTADDR = HLR$LNK1[0]; 
        IF RTIMSECS[0] GQ HLR$RTIME[0]
        THEN                         # IF WAKE-UP TIME HAS COME # 
          BEGIN 
          DEL$LNK(ENTADR,LCHN"HL$DELAY",0); 
          ADD$LNK(ENTADR,LCHN"HL$READY",0); 
          END 
  
        ELSE
          BEGIN 
          IF HLR$RTIME[0] LS MINQ$EXPIR 
          THEN                       # IF EARLIEST NON-EXPIRED WAKE-UP
                                       TIME # 
            BEGIN 
            MINQ$EXPIR = HLR$RTIME[0];
            END 
  
          END 
  
        ENTADR = NEXTADDR;
        END  # SEARCH DELAY CHAIN # 
  
# 
*     REACTIVATE ALL *LLRQ* ENTRIES WHOSE WAKE-UP TIME HAS COME.
# 
  
      ENTADR = CHN$BOC[LCHN"LL$DELAY"]; 
      REPEAT WHILE ENTADR NQ 0
      DO
        BEGIN  # SEARCH DELAY CHAIN # 
        P<LLRQ> = ENTADR; 
        NEXTADDR = LLR$LINK1[0];
        IF RTIMSECS[0] GQ LLR$RTIME[0]
        THEN                         # IF WAKE-UP TIME HAS COME # 
          BEGIN 
          DEL$LNK(ENTADR,LCHN"LL$DELAY",0); 
          ADD$LNK(ENTADR,LCHN"LL$READY",0); 
          END 
  
        ELSE
          BEGIN 
          IF LLR$RTIME[0] LS MINQ$EXPIR 
          THEN                       # IF EARLIEST NON-EXPIRED WAKE-UP
                                       TIME # 
            BEGIN 
            MINQ$EXPIR = LLR$RTIME[0];
            END 
  
          END 
  
        ENTADR = NEXTADDR;
        END  # SEARCH DELAY CHAIN # 
  
# 
*     IF BOTH DELAY CHAINS ARE NOW EMPTY, SET *MINQ$EXPIR* TO ZERO. 
# 
  
      IF CHN$BOC[LCHN"HL$DELAY"] EQ 0 AND CHN$BOC[LCHN"LL$DELAY"] EQ 0
        THEN
        BEGIN 
        MINQ$EXPIR = 0; 
        END 
  
      RETURN; 
  
      END  # WAKE$UP #
  
    TERM
