Retro1.org codex

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