SXSLV 
PROC FLUSHSM; 
# TITLE FLUSHSM - FLUSH THE *STOM* BUFFERS.                           # 
  
      BEGIN  # FLUSH *STOM* BUFFERS # 
  
# 
**    FLUSHSM  - FLUSH THE *STOM* BUFFERS.
* 
*     *FLUSHSM* WILL UPDATE THE SLAVE WRITE COUNTER AND PACKED
*     DATE/TIME FIELDS IN THE SLAVE STATUS WORD OF THE *STOM* FILE
*     BUFFER AND UPDATE THE DISK IMAGE OF THE *STOM* FILE BY
*     WRITING THE BUFFER TO THE LINK DEVICE.
* 
*     PROC FLUSHSM. 
* 
*     ENTRY      ARRAY *STOMS* IS THE *FET* FOR THE *STOM* FILE 
*                BUFFER.
* 
*     EXIT       THE NEXT TIME *FLUSHSM* IS TO BE CALLED IS ESTABLISHED 
*                BY UPDATING THE VARIABLE *STOM$TIME*.
# 
  
# 
****  PROC FLUSHSM - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC PDATE;                  # ISSUE PDATE MACRO #
        PROC REWIND;                 # REWIND FILE #
        PROC REWRITR;                # REWRITE FILE # 
        PROC RTIME;                  # ISSUE RTIME MACRO #
        END 
  
  
# 
****  PROC FLUSHSM - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBFET 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXMMF 
*CALL,COMXSEB 
  
  
  
  
  
# 
*     UPDATE THE HEADER INFORMATION OF THE *STOM* FILE. 
# 
  
      SM$SWC[0] = SM$SWC[0] + 1;
      PDATE(PDATESTAT[0]);
      RTIME(RTIMESTAT[0]);
      SM$PDATE[0] = PDATEV[0];
  
# 
*     SET UP THE TIME TO NEXT FLUSH THE *STOM* BUFFERS. 
# 
  
      STOM$TIME = RTIMSECS[0] + SM$DELAY[0];
  
# 
*     WRITE THE *STOM* BUFFER TO THE *STOM* FILE. 
# 
  
      REWIND(STOMS,RCL);
      P<FETSET> = LOC(STOMS); 
      FET$OUT[0] = FET$FRST[0]; 
      FET$IN[0] = FET$FRST[0] + L$STOM; 
      REWRITR(STOMS,RCL); 
      RETURN; 
      END  # FLUSHSM #
  
    TERM
PROC INITSLV((MID),(MIDX),(SLVDELAY));
# TITLE INITSLV - INITIALIZE SLAVE EXEC.                              # 
  
      BEGIN  # INITSLV #
  
# 
**    INITSLV  - INITIALIZATION ROUTINE FOR THE *SSSLV*.
* 
*     *INITSLV* INITIALIZES THE *STOM* AND *MTOS* FILES FOR PROCESSING
*     BY THE REST OF THE *SSSLV* ROUTINES.
* 
*     PROC INITSLV((MID),(MIDX),(SLVDELAY)) 
* 
*     ENTRY      (MID)   - MACHINE ID OF THE *SSSLV*. 
*                (MIDX)  - MACHINE INDEX OF THE *SSSLV*.
*                (SLVDELAY)  - THE INTERVAL IN SECONDS THAT THE 
*                              *SSEXEC* IS TO POLL THE *SSSLV*-S
*                              COMMUNICATION FILE (*STOM*). 
* 
*                THE CALLING ROUTINE HAS DONE A *SETPFP* TO THE CORRECT 
*                FAMILY AND USER INDEX. 
* 
*     EXIT       THE *STOM* AND *MTOS* FILES ARE ATTACHED WITH FET-S
*                AND BUFFERS ESTABLISHED SO THEY CAN BE WRITTEN AND 
*                READ, RESPECTIVELY.
* 
*                THE ITEM *SLVEND* IS SET TO A STATUS VALUE OF IDLE IF
*                THE IDLE FLAG WAS SET.  THIS WILL PERMIT THE OPERATOR
*                TO TERMINATE THE *SSSLV* BEFORE INITIALIZATION IS
*                COMPLETE.
* 
*     MESSAGES
*                * SLVI ACTIVE, EXEC XXXX.* 
*                      AN INFORMATIVE MESSAGE INDICATING THE INITIAL
*                      STATUS OF THE *SSEXEC*. *XXXX* = *ACTIVE*
*                      OR *IDLE*. 
* 
* 
*                * SLVI, STBMNOI FILE PROBLEM. *
*                      A MESSAGE INDICATING THE STATUS OF THE ATTEMPT 
*                      TO ESTABLISH ACCESS TO THE COMMUNICATION FILE
*                      USED TO SEND MESSAGES TO THE *SSEXEC*. 
# 
  
      ITEM MID        C(2);          # MACHINE ID OF THE SLAVE EXEC # 
      ITEM MIDX       U;             # MACHINE INDEX OF THE *SSSLV* # 
      ITEM SLVDELAY   U;             # TIME IN SECONDS FOR MASTER TO
                                       POLL *STOM* #
  
# 
****  PROC INITSLV - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ISSUE ABORT MACRO #
        PROC MEMORY;                 # ISSUE MEMORY MACRO # 
        PROC MESSAGE;                # ISSUES MESSAGE MACRO # 
        PROC PFD;                    # PERMANENT FILE REQUEST DELAYS #
        PROC READ;                   # READ FILE #
        PROC READW;                  # READ LINE #
        PROC RECALL;                 # ISSUE RECALL MACRO # 
        PROC RETERN;                 # RETURN FILE #
        PROC REWIND;                 # REWIND FILE #
        PROC WRITER;                 # WRITE FILE # 
        FUNC XCOD C(10);             # INTEGER TO DISPLAY # 
        PROC ZFILL;                  # ZERO FILL AN ARRAY # 
        PROC ZSETFET;                # INITIALIZE *FET* # 
        END 
  
# 
****  PROC INITSLV - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBFET 
*CALL,COMBPFS 
*CALL,COMXCTF 
*CALL,COMXINT 
*CALL,COMSPFM 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMMF 
*CALL,COMXSEB 
  
      ITEM I          U;             # INDUCTION VARIABLE # 
      ITEM INITMTOS   U;             # INDUCTION VARIABLE # 
      ITEM INITSTOM   U;             # INDUCTION VARIABLE # 
      ITEM MTOSOK     B;             # CONTROLS LOOP TO ATTACH *MTOS* # 
      ITEM RB         U;             # INDEX TO A REQUEST BLOCK # 
      ITEM ONEMSG     B;             # CONTROLS DAYFILE MESSAGES #
      ITEM STAT       U;             # SCRATCH VARIABLE # 
      ITEM STOMOK     B;             # CONTROLS REDEFINING *STOM* # 
  
                                               CONTROL EJECT; 
  
# 
*     INITIALIZE *MTOS*/*STOM* FILE LENGTH VARIABLES. 
# 
  
      L$STOM = (NUMRB + 1) * RBSIZE;
      L$MTOSH = (MAXSLV + 1) * 3; 
      L$MTOS = L$MTOSH + NUMRB * NUMSLV;
  
# 
*     CALCULATE THE SPACE NEEDED FOR THE *MTOS* BUFFER. 
*     OBTAIN THE SPACE VIA THE *MEMORY* REQUEST.
# 
  
      P<MTOSHEAD> = RA$NWA[0];
      I = (L$MTOS + PRULEN) / PRULEN; 
      MTOSBUFL = I * PRULEN + 1;
      MEM$AMT[0] = RA$NWA[0] + MTOSBUFL;
      MEMORY("CM",MEMREQ,RCL,NA); 
  
  
# 
*     INITIALIZE THE *STOM* FILE. 
# 
  
      P<STOMFILE> = LOC(STOMSBUF);
      PFNSTOM = STOMPFN;
      CHAR10 = XCOD(MIDX);
      CHAR1 = C<9,1>CHAR10; 
      B<36,6>PFNSTOM = CHAR1; 
      MSG$SINDX[0] = CHAR1; 
      ABT$SINDX[0] = CHAR1; 
      ERR$SINDX[0] = CHAR1; 
      IDLE$SINDX[0] = CHAR1;
      MSGE$SINDX[0] = CHAR1;
  
      MSG$NAME[0] = PFNSTOM;
  
      IF MIDX EQ 0
      THEN                           # SINGLE MAINFRAME MODE #
        BEGIN 
        MSG$STAT[0] = "ONE MAINFRAME."; 
        GOTO MODERROR;
        END 
  
  
        STOMOK = TRUE;
        ZSETFET(LOC(STOMS),STOMSLFN,LOC(MTOSHEAD),PRULEN + 1,SFETL);
        RETERN(STOMS,RCL);
        PFD("ATTACH",STOMSLFN,PFNSTOM,"PW",STOMPW,"M","M",
          "RC",PFSTAT,"NA",0,"UP",0,0); 
        IF PFSTAT EQ FBS
        THEN                         # *STOM* BUSY #
          BEGIN 
          GOTO WAITSTOM;
          END 
  
  
# 
*     READ THE *STOM* FILE AND INITIALIZE MISSING FIELDS. 
*     IF THE ATTACH FAILED, THE ENTIRE PERMANENT
*     FILE WILL BE INITIALIZED. 
# 
  
        ZFILL(STOMSBUF[0],L$STOM);
        IF PFSTAT EQ OK 
        THEN                         # INITIALIZE THE *STOM* HEADER # 
          BEGIN 
          READ(STOMS,NRCL); 
          READW(STOMS,STOMSBUF[0],RBSIZE,STAT); 
          END 
  
        STOMOK = STAT EQ OK AND PFSTAT EQ OK; 
        SM$MIDS[0] = MID; 
        SM$IDLE[0] = FALSE; 
        IF SLVDELAY LQ 0
        THEN
          BEGIN 
          SM$DELAY[0] = SLRP$INTV;
          END 
  
        ELSE
          BEGIN 
          SM$DELAY[0] = SLVDELAY; 
          END 
  
        SLOWFOR RB = 1 STEP 1 WHILE STOMOK AND RB LQ NUMRB
        DO
          BEGIN  # INITIALIZE EACH REQUEST BLOCK #
  
          READW(STOMS,STOMSBUF[RB],RBSIZE,STAT);
  
          IF STAT EQ OK 
          THEN                       # INITIALIZE OLD FIELDS #
            BEGIN 
            IF SM$SRC[RB] EQ S"SUBMITTED" 
            THEN                     # CANCEL PREVIOUS REQUEST #
              BEGIN 
              SM$SRC[RB] = S"CANCEL"; 
              END 
  
            END 
  
          ELSE                       # ENTIRE REQUEST BLOCK # 
            BEGIN 
            STOMOK = FALSE; 
            ZFILL(STOMSBUF[RB],RBSIZE); 
            END 
  
          END  # INITIALIZE EACH REQUEST BLOCK #
  
# 
*     INITIALIZE THE FET TO BE USED FOR DOING 
*     I/O ON THE *STOM* FILE. 
# 
  
  
        ZSETFET(LOC(STOMS),STOMSLFN,LOC(STOMSBUF),L$STOM + 1,SFETL);
  
# 
*     IF THE ATTACH OR READ HAD A PROBLEM, PURGE
*     THE OLD *STOM* FILE AND DEFINE A NEW ONE.  THEN 
*     WRITE OUT THE INITIALIZED *STOM* FILE AND 
*     REATTACH *STOM* IN MODIFY MODE. 
# 
  
        IF NOT STOMOK 
        THEN
          BEGIN  # CREATE A NEW *STOM* FILE # 
  
          RETERN(STOMS,RCL);
          PFD("PURGE",PFNSTOM,"PW",STOMPW,"RC",PFSTAT,"UP",0,0);
          PFD("DEFINE",STOMSLFN,PFNSTOM,"PW",STOMPW,"BR","N", 
            "R",LINK$DT[0],"RC",PFSTAT,"UP",0,0); 
          IF PFSTAT NQ OK 
          THEN
            BEGIN 
            GOTO WAITSTOM;
            END 
  
          FET$OUT[0] = FET$FRST[0]; 
          FET$IN[0] = FET$FRST[0] + L$STOM; 
          WRITER(STOMS,RCL);
          PFD("ATTACH",STOMSLFN,PFNSTOM,"PW",STOMPW,"M","M",
            "RC",PFSTAT,"NA",0,"UP",0,0); 
          IF PFSTAT NQ OK 
          THEN                       # REATTACH FAILED #
            BEGIN 
            GOTO WAITSTOM;
            END 
  
          END  # CREATE A NEW *STOM* FILE # 
  
  
  
  
  
  
# 
*     ATTACH THE *MTOS* FILE AND COMPLETE INITIALIZATION. 
# 
  
      ZSETFET(LOC(MTOSS),MTOSSLFN,LOC(MTOSHEAD),MTOSBUFL,SFETL);
      MTOSOK = FALSE; 
      MSG$NAME[0] = MTBSPFN;
  
      FASTFOR INITMTOS = 1 STEP 1 WHILE NOT MTOSOK
      DO
        BEGIN  # INITIALIZE *MTOS* FILE # 
  
        PFD("ATTACH",MTOSSLFN,MTBSPFN,"PW",MTOSPW,"M","RM", 
          "RC",PFSTAT,"NA",0,"UP",0,0); 
        IF PFSTAT NQ OK 
        THEN
          BEGIN 
          GOTO WAITMTOS;
          END 
  
        REWIND(MTOSS[0],RCL); 
        READ(MTOSS,RCL);
  
# 
*     VERIFY LENGTH OF THE *MTOS* FILE IS PER EXPECTATIONS. 
# 
  
        IF FET$IN[0]-FET$OUT[0] NQ L$MTOS OR  ##
          MSH$NUMRB[0] NQ NUMRB OR   ## 
          MSH$NUMSLV[0] NQ NUMSLV 
        THEN                         # *MTOS* FILE IS WRONG LENGTH #
          BEGIN 
          GOTO WAITMTOS;
          END 
  
# 
*     LOCATE INDEX OF THIS SLAVE IN THE *MTOS* FILE.
# 
  
        SINDX = 0;
        FASTFOR I = 1 STEP 1 WHILE I LQ MAXSLV AND SINDX EQ 0 
        DO
          BEGIN  # SEARCH FOR THE INDEX OF THIS SLAVE # 
          IF MSH$PFNS[I] EQ PFNSTOM 
          THEN                       # FOUND MATCH #
            BEGIN 
            SINDX = I;
            END 
  
          END  # SEARCH FOR THE INDEX OF THIS SLAVE # 
  
        IF SINDX EQ 0 
        THEN
          BEGIN 
          GOTO WAITMTOS;
          END 
  
        MTOSOK = TRUE;
        P<MTOSREPBLK> = LOC(MTOSHEAD) + L$MTOSH + (SINDX-1)*NUMRB;
        SM$MSW[0] = MSH$MSW[0]; 
        IF MSH$IDLE[0]
        THEN                         # MASTER WAS IDLED DOWN #
          BEGIN 
          SM$STATM[0] = S"IDLE";
          SM$TIMOUT[0] = MAXSECS; 
          MSGE$STAT[0] = "IDLE";
          END 
  
        ELSE                         # MASTER IS ACTIVE # 
          BEGIN 
          SM$STATM[0] = S"ACTIVE";
          SM$TIMOUT[0] = RTIMSECS[0] + SLAV$INTV; 
          MSGE$STAT[0] = "ACTIVE";
          END 
  
        MESSAGE(MSGEXSTAT,SYSUDF1); 
        SM$REQCTL[0] = MSH$REQCTL[0] + 1;  # FORCE A RESPONSE # 
        TEST INITMTOS;
  
WAITMTOS: 
  
        MSGE$FLASH[0] = FLASH;
        MSGE$STAT[0] = "IDLE";
        IF ONEMSG 
        THEN
          BEGIN        # MESSAGE TO B-DISPLAY ONLY #
          MESSAGE(MSGEXSTAT,LINE1); 
          END 
  
        ELSE
          BEGIN        # FIRST MESSAGE TO DAYFILE AND B-DISPLAY # 
          MESSAGE(MSGEXSTAT,SYSUDF1); 
          ONEMSG = TRUE;
          END 
  
        MSGE$FLASH[0] = NOFLASH;
  
        FASTFOR DUMMY = 1 STEP 1 UNTIL DELAYCT
        DO
          BEGIN 
          RECALL(0);
          END 
  
        IF RA$IDLEDWN[0]
        THEN
          BEGIN 
          SLVEND = S"IDLEMTOS"; 
          RETURN; 
          END 
  
        END  # INITIALIZE *MTOS* FILE # 
  
      RETURN; 
  
  
WAITSTOM: 
      MSG$STAT[0] = "FILE PROBLEM.";
MODERROR: 
      MESSAGE(MSGSLV[0],SYSUDF1); 
      ABORT;
  
      END  # INITSLV #
  
    TERM
PROC SLVEXEC; 
# TITLE SLVEXEC - SLAVE EXEC.                                         # 
  
      BEGIN  # SLVEXEC #
  
# 
***   SLVEXEC - MULTIMAINFRAME *MSS* EXECUTIVE PROGRAM. 
* 
*     ON THE MASTER MAINFRAME OF A MULTIMAINFRAME CONFIGURATION, OR IN
*     A SINGLE MAINFRAME CONFIGURATION, THE *NOS* PERMANENT FILE
*     MANAGER (*PFM*) ISSUES *TDAM* REQUESTS DIRECTLY TO THE *SSEXEC* 
*     TO CAUSE A PERMANENT FILE TO BE STAGED FROM *MSS* TO DISK.  ON
*     ALL OTHER MAINFRAMES IN A MULTIMAINFRAME CONFIGURATION, *PFM* 
*     ISSUES *TDAM* REQUESTS TO THIS *SSSLV* PROGRAM WHICH APPEARS AS 
*     A SURROGATE *SSEXEC* TO *PFM*.  THE *SSSLV* FORWARDS THE
*     *TDAM* REQUEST TO THE *SSEXEC* BY WRITING IT ON A PERMANENT 
*     FILE KNOWN AS THE SLAVE-TO-MASTER (*STOM*) COMMUNICATION FILE.
*     WHEN THE *SSEXEC* HAS COMPLETED THE STAGE REQUEST, IT SENDS A 
*     REPLY STATUS TO THE *SSSLV* VIA ANOTHER COMMUNICATION FILE
*     KNOWN AS THE MASTER-TO-SLAVE (*MTOS*) FILE.  THE *SSSLV*
*     NOTIFIES *PFM* OF THE COMPLETED REQUEST IN THE SAME MANNER AS 
*     DOES *SSEXEC*.  THE FORMAT OF THE *MTOS* AND *STOM* FILES IS
*     DESCRIBED IN COMMON DECK *COMXMMF*. 
* 
*     PROC SLVEXEC. 
* 
*     MESSAGES
*                * SLVI - IDLED DOWN.*
*                      AN INFORMATIVE MESSAGE INDICATING THAT THE 
*                      OPERATOR USED THE *IDLE* COMMAND TO TERMINATE
*                      *SSSLV* PROCESSING.
* 
*                * SLVI - ERROR TERMINATION (N).* 
*                      AN INFORMATIVE MESSAGE INDICATING THAT AN
*                      ERROR CONDITION OCCURRED WHILE READING THE 
*                      *MTOS* FILE WHICH PREVENTED FURTHER *SSSLV*
*                      PROCESSING.
# 
  
  
# 
****  PROC SLVEXEC - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ISSUE ABORT MACRO #
        PROC FLUSHSM;                # REWRITE THE *STOM* FILE #
        PROC SSOVL;                  # OVERLAY LOADER # 
        FUNC XCOD C(10);             # INTEGER TO DISPLAY # 
        PROC MESSAGE;                # ISSUER MESSAGE MACRO # 
        END 
  
# 
****  PROC SLVEXEC - XREF LIST END. 
# 
  
                                               CONTROL PRESET;
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBOVL 
*CALL,COMXIPR 
*CALL,COMXMMF 
*CALL,COMXSEB 
                                               CONTROL EJECT; 
      SLVEND = S"OK"; 
  
      SSOVL(LSLVINIT,0);             # INITIALIZE THE SLAVE EXEC #
      IF SLVEND EQ S"OK"
      THEN
        BEGIN 
        SSOVL(LSLVLOOP,0);           # EXECUTE THE MAIN LOOP #
        END 
  
      SM$IDLE[0] = TRUE;
  
      FLUSHSM;                       # WRITE IDLE STATUS TO THE *STOM*
                                       FILE # 
  
      IF SLVEND LS S"LASTIDLE"
      THEN                           # NORMAL TERMINATION # 
        BEGIN 
        MESSAGE(IDLETERM,RCL);
        STOP; 
        END 
  
      ELSE                           # ABNORMAL TERMINATION # 
        BEGIN 
        CHAR10 = XCOD(SLVEND - SLVESTAT"LASTIDLE"); 
        ERR$NUM[0] = C<9,1>CHAR10;
        MESSAGE(ERRTERM,RCL); 
        ABORT;
        END 
  
      END  # SLVEXEC #
  
    TERM
PROC SLVINIT; 
# TITLE SLVINIT  - *SSSLV* INITIALIZER SETUP ROUTINE.                 # 
  
      BEGIN  # SLVINIT #
  
# 
**  SLVINIT  - *SSSLV* INITIALIZER SETUP ROUTINE. 
* 
*     *SLVINIT* DOES THE INITIALIZATION PROCESSING BY DIRECTLY
*     PERFORMING SOME SETUP AND THEN CALLING *INITSLV* TO 
*     COMPLETE THE INITIALIZATION.
* 
*     PROC SLVINIT. 
* 
*     ENTRY      THE CONTROL COMMAND IMAGE OF THE *SSSLV* CALL IS IN
*                *RA* + 70.  THE CONTROL COMMAND PARAMETERS ARE BELOW.
* 
*                SSSLV,Q=NN,S.
* 
*                Q=NN  NN IS THE FREQUENCY IN SECONDS THAT THE *SSSLV*
*                      AND *SSEXEC* PROGRAMS SHOULD READ THE *STOM* 
*                      AND *MTOS* COMMUNICATION FILES.  IF *NN* IS
*                      GREATER THEN *SLRP$INTV*, THE LATTER IS USED.
* 
*                S     SIMULATED MULTIMAINFRAME MODE. 
*                      IF *S* IS SPECIFIED ON BOTH THE *SSEXEC* AND 
*                      *SSSLV* PROGRAM CALLS, THEN BOTH PROGRAMS MAY
*                      EXECUTE ON THE SAME MAINFRAME.  THIS PERMITS 
*                      PROGRAM AND OPERATIONAL PROCEDURE CHECKOUT USING 
*                      ONLY A SINGLE MAINFRAME. 
* 
*     EXIT       THE *MTOS* AND *STOM* FILES ARE ATTACHED AND READY TO
*                BE PROCESSED BY THE *SLVLOOP* PROCEDURE WHICH IS THE 
*                MAINLOOP OF THE *SSSLV*. 
* 
*     MESSAGES
*                * SLVI ABNORMAL, SLVINIT.* 
*                      THIS MESSAGE INDICATES THAT A FATAL SYSTEM 
*                      ERROR HAS OCCURRED.
* 
*                * MSAS MASTER ENABLED - ABORT. * 
* 
*     NOTES      IF THE *S* PARAMETER IS SPECIFIED, THE *SSSLV* WILL
*                USE COMMUNICATION FILES LOCATED ON THE DEFAULT FAMILY, 
*                INSTEAD OF ON THE FAMILY CONTAINING THE LINK DEVICE. 
# 
  
  
  
# 
****  PROC SLVINIT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ISSUE ABORT MACRO #
        PROC CALLSS;                 # ISSUE REQUEST TO SUBSYSTEMS #
        PROC EXTAB;                  # SET UP PARAMETER LIST #
        PROC GETFAM;                 # GET TABLE OF FAMILIES #
        PROC GETMI;                  # GET MACHINE INDEX #
        PROC INITDAM;                # INITIALIZE *TDAM* INTERFACE #
        PROC INITSLV;                # INITIALIZE *SSSLV* # 
        PROC MESSAGE;                # ISSUE MESSAGE MACRO #
        PROC SETPFP;                 # ISSUE SETPFP MACRO # 
        PROC XARG;                   # CRACK PARAMETER LIST # 
        FUNC XDXB U;                 # CONVERT DECIMAL TO BINARY #
        END 
  
# 
****  PROC SLVINIT - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBPFP 
*CALL,COMXCTF 
*CALL,COMXEXP 
*CALL,COMXINT 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMMF 
*CALL,COMXSEB 
  
  
      ITEM ARGLIST    U;             # ARGUMENT LIST #
      ITEM DELAYV     U;             # DELAY VALUE #
      ITEM FAMILY     C(7);          # FAMILY FOR COMMUNICATION FILES # 
      ITEM FLAG       U;             # TEMPORARY #
      ITEM MID        C(2);          # MACHINE ID # 
      ITEM MIDX       U;             # MACHINE INDEX #
      ITEM PBLOCK     U = 0;         # PARAMETER BLOCK #
  
  
        ARRAY MSGLINE  [0:3]  S(4); 
          BEGIN 
          ITEM MSGITEM  C(00,00,38) = ["$MSAS MASTER ENABLED - ABORT."];
          ITEM MSGZERO  U(03,48,12) = [0];  # ZERO BYTE TERMINATOR #
          END 
                                               CONTROL EJECT; 
  
      GETFAM(FAMT,DUMMY,LINK[0],DEFAULTORD,DUMMY);
      DEF$FAM = FAM$NAME[DEFAULTORD]; 
  
      EXTAB(ARGLIST); 
      XARG(ARGLIST,0,FLAG); 
      DELAYV = SLRP$INTV; 
      GETMI(CMRINFO,EVENT); 
      IF NOT CMR$SLAVE[0] 
      THEN      # *SLAVE* MODE NOT INDICATED #
        BEGIN 
        MESSAGE(MSGLINE,SYSUDF1); 
        ABORT;
        END 
  
      EESET$EVT = EESET$ASXE;        # MSAS SET UP #
      EESET$ASXE = 0; 
      FAMILY = FAM$NAME[LINK$ORD[0]]; 
      MIDX = CMR$MFID[0]; 
      MID = CMR$MID[0]; 
  
      P<RA$AREA> = 0; 
      RA$SSCAP[0] = 0;
      INITDAM;                       # INITIALIZE *TDAM* INTERFACE #
      CALLSS(0,PBLOCK,NRCL);         # REQUEST ACTIVE STATUS #
  
      IF FLAG EQ 0
      THEN
        BEGIN  # CONVERT PARAMETERS # 
  
        IF ARG$QC[0] NQ  - 1
        THEN                         # CONVERT Q = DELAY VALUE #
          BEGIN 
          FLAG = XDXB(ARG$QC[0],1,DELAYV);
          IF DELAYV GR SLRP$INTV
          THEN                       # DELAY IS TOO LONG #
            BEGIN 
            DELAYV = SLRP$INTV; 
            END 
  
          END 
  
        IF ARG$SC[0] NQ  - 1
        THEN
          BEGIN 
          FAMILY = DEF$FAM; 
          MIDX = 4; 
          MID = "SA"; 
          END 
  
        END  # CONVERT PARAMETERS # 
  
  
# 
*     ISSUE A *SETPFP* SO THE COMMUNICATION FILES CAN BE ACCESSED.
# 
  
      PFP$WRD0[0] = 0;
      PFP$FAM[0] = FAMILY;
      PFP$FG1[0] = TRUE;             # CHANGE TO LINK FAMILY #
      PFP$FG4[0] = TRUE;             # CHANGE TO *MSS* USER INDEX # 
      PFP$UI[0] = DEF$UI; 
      SETPFP(PFP);
      IF PFP$STAT[0] NQ 0 
      THEN                           # SETPFP FAILED #
        BEGIN 
        ABT$PROC[0] = "SLVINIT";
        MESSAGE(ABTMSG,SYSUDF1);
        ABORT;
        END 
  
  
# 
*     CALL *INITSLV* TO INITIALIZE COMMUNICATION FILES. 
# 
  
      INITSLV(MID,MIDX,DELAYV); 
  
      END  # SLVINIT #
  
    TERM
PROC SLVLOOP; 
# TITLE SLVLOOP - SLAVE MAIN LOOP.                                    # 
  
      BEGIN  # SLVLOOP #
  
# 
**    SLVLOOP  - SLVEXEC MAIN LOOP. 
* 
*     PROC SLVLOOP. 
* 
*     ENTRY      INITIALIZATION WAS SUCCESSFUL. 
* 
*     EXIT       THE ITEM *SLVEND* (IN *COMXSEB*) IS UPDATED TO 
*                INDICATE THE REASON FOR TERMINATION OF *SSSLV* 
*                PROCESSING.
* 
*     NOTES      WHILE THE VARIABLE *SLVEND* HAS THE VALUE *OK*, THE
*                MAIN LOOP WILL DO THE FOLLOWING. 
* 
*                            1) TEST THE IDLE FLAG. 
* 
*                            2) LOOK FOR A *TDAM* REQUEST AND ADD IT TO 
*                               THE *STOM* FILE.
* 
*                            3) CALL *SLVMTOS* TO CHECK THE STATUS OF 
*                               THE *SSEXEC* AND ALSO, TO CHECK IF A
*                               REPLY STATUS IS AVAILABLE FOR ANY 
*                               PREVIOUSLY SUBMITTED *TDAM* REQUESTS. 
* 
*                            4) CALL *FLUSHSM* TO UPDATE THE SLAVE
*                               STATUS WORD IN THE *STOM* FILE AND
*                               REWRITE THE CURRENT *STOM* FILE.
*                               THIS IS DONE PERIODICALLY OR
*                               WHENEVER A *TDAM* REQUEST IS ADDED TO 
*                               THE *STOM* FILE BUFFER. 
* 
*                            5) DELAY VIA *RECALL* IF NO WORK IS TO BE
*                               DONE. 
# 
  
# 
****  PROC SLVLOOP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC FLUSHSM;                # REWRITE THE *STOM* FILE #
        PROC MEMORY;                 # ISSUE MEMORY MACRO # 
        PROC PDATE;                  # ISSUE PDATE MACRO #
        PROC RECALL;                 # ISSUE RECALL MACRO # 
        PROC RTIME;                  # ISSUE RTIME MACRO #
        PROC SLVMTOS;                # PROCESS *MTOS* FILE #
        PROC ZFILL;                  # ZERO FILL AN ARRAY # 
        PROC ZSETFET;                # INITIALIZE *FET* # 
        END 
  
# 
****  PROC SLVLOOP - XREF LIST END. 
# 
  
      DEF RCLFACTOR  #2#;            # NUMBER OF RECALLS TO DELAY ONE 
                                       SECOND # 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBTDM 
*CALL,COMXCTF 
*CALL,COMXIPR 
*CALL,COMXJCA 
*CALL,COMXMMF 
*CALL,COMXSEB 
  
  
  
      ITEM I          I;             # LOOP COUNTER # 
      ITEM MAINLOOP   U;             # MAIN LOOP INDUCTION VARIABLE # 
      ITEM RB         U;             # INDEX TO A REQUEST BLOCK # 
      ITEM RCLCT      U;             # NUMBER OF RECALLS TO MAKE #
      ITEM REQPROC    B;             # REQUEST PROCESSED FLAG # 
      ITEM TDASA      U;             # ASA FROM A *TDAM* REQUEST #
      ITEM TDFAM      C(7);          # FAMILY FROM A *TDAM* REQUEST # 
      ITEM TDUI       U;             # USER INDEX FROM *TDAM* REQUEST # 
  
                                               CONTROL EJECT; 
  
# 
*     REDUCE FIELD LENGTH SO ONLY ENOUGH *CM* SPACE FOR THE 
*     *MTOS* BUFFER IS ABOVE THE END OF THIS OVERLAY. 
# 
  
      P<MTOSHEAD> = RA$NWA[0];       # = END OF THIS OVERLAY #
      MEM$AMT[0] = RA$NWA[0] + MTOSBUFL;
      MEMORY("CM",MEMREQ,RCL,NA); 
      ZSETFET(LOC(MTOSS),MTOSSLFN,LOC(MTOSHEAD),MTOSBUFL,SFETL);
      SLVMTOS;
  
# 
*     EXECUTE THE MAINLOOP UNTIL ONE OF THE *SSSLV* 
*     TERMINATION CONDITIONS OCCURS.
*         1). IDLE FLAG BECOMXS SET, OR 
*         2). AN I/O ERROR OCCURS ON EITHER THE *MTOS*
*             OR *STOM* FILES.
# 
  
      SLOWFOR MAINLOOP = 1 STEP 1 WHILE SLVEND EQ S"OK" 
      DO
        BEGIN  # MAINLOOP # 
  
        RTIME(RTIMESTAT[0]);
        PDATE(PDATESTAT[0]);
  
        IF RA$IDLEDWN[0]
        THEN
          BEGIN 
          SLVEND = S"IDLE"; 
          END 
  
        IF RA$TDAM[0] NQ 0
        THEN                         # FOUND A *TDAM* REQUEST # 
  
          BEGIN  # PROCESS THE *TDAM* REQUEST # 
  
          REQPROC = FALSE;
          P<TDAM> = LOC(RA$TDAM[0]);
          IF TDAMFC[0] EQ TDAMFCODE"STAGE"
          THEN
            BEGIN  # CHECK STAGE REQUEST #
            TDASA = TDAMASA[0]; 
            TDUI = TDAMUI[0]; 
            TDFAM = TDAMFAM[0]; 
  
            FASTFOR RB = 1 STEP 1 WHILE RB LQ NUMRB AND NOT REQPROC 
            DO
  
              BEGIN  # SEARCH FOR A DUPLICATE *TDAM* #
  
              P<TDAM> = LOC(SM$TDAM[RB]); 
              IF TDASA EQ TDAMASA[0]  ##
                AND TDUI EQ TDAMUI[0]  ## 
                AND TDFAM EQ TDAMFAM[0]  ## 
                AND SM$SRC[RB] EQ S"SUBMITTED"
              THEN                   # FOUND A DUPLICATE #
                BEGIN 
                REQPROC = TRUE; 
                END 
  
              END  # SEARCH FOR A DUPLICATE *TDAM* #
  
            END  # CHECK STAGE REQUEST #
  
          FASTFOR RB = 1 STEP 1 WHILE RB LQ NUMRB AND NOT REQPROC 
          DO
            BEGIN  # SEARCH FOR A FREE REQUEST BLOCK #
  
            IF SM$SRC[RB] EQ S"AVAIL" AND  ## 
              MSR$MRC[RB] EQ S"AVAIL" 
            THEN                     # AVAILABLE REQUEST BLOCK FOUND #
              BEGIN  # ADD *TDAM* TO *STOM* BUFFER #
  
              P<TDAM> = LOC(SM$TDAM[RB]); 
              TDAMREQST[0] = RA$TDAMRB[0];
              SM$SRC[RB] = S"SUBMITTED";
              SM$PDATERB[RB] = PDATEV[0]; 
              STOM$TIME = 0;         # FORCE WRITE OF *STOM* FILE # 
              SM$REQCTL[0] = SM$REQCTL[0] + 1;
              REQPROC = TRUE; 
              END  # ADD *TDAM* TO *STOM* BUFFER #
  
            END  # SEARCH FOR A FREE REQUEST BLOCK #
  
          IF REQPROC
          THEN                       # REQUEST PROCESSED #
            BEGIN 
            P<TDAM> = LOC(RA$TDAM[0]);
            TDAMWORD[0] = 0;         # CLEAR FIRST WORD OF *TDAM* # 
            TEST MAINLOOP;
            END 
  
# 
*     IF NO SPACE IS AVAILABLE IN THE REQUEST BLOCKS, 
*     GO THROUGH REST OF THE MAINLOOP AS IF THERE WERE
*     NO *TDAM* REQUEST.
# 
  
          END  # PROCESS THE *TDAM* REQUEST # 
  
        IF RTIMSECS[0] GR MTOS$TIME 
        THEN                         # PROCESS *MTOS* FILE #
          BEGIN 
          SLVMTOS;
          END 
  
        IF RTIMSECS[0] GR STOM$TIME 
        THEN                         # WRITE THE *STOM* FILE #
          BEGIN 
          FLUSHSM;
          TEST MAINLOOP;
          END 
  
        IF SM$STATM[0] EQ S"ACTIVE" 
        THEN
          BEGIN 
          RCLCT = SM$DELAY[0] * RCLFACTOR;
          END 
  
        ELSE
          BEGIN 
          RCLCT = SLRP$INTV * RCLFACTOR;
          END 
  
        FASTFOR DUMMY = 1 STEP 1 UNTIL RCLCT
        DO
          BEGIN 
          RECALL(0);
          END 
  
        END  # MAINLOOP # 
  
      END  # SLVLOOP #
  
    TERM
PROC SLVMTOS; 
# TITLE SLVMTOS - PROCESS *MTOS* COMMUNICATION FILE.                  # 
  
      BEGIN  # SLVMTOS #
  
# 
**    SLVMTOS  - PROCESS THE *MTOS* COMMUNICATION FILE. 
* 
*     *SLVMTOS* WILL READ THE *MTOS* FILE TO A BUFFER, CHECK TO SEE IF
*     THE *SSEXEC* HAS CHANGED STATUS, AND IF SO, ISSUE A MESSAGE TO
*     THE DAYFILE AND CONSOLE.  IF THE *SSEXEC* IS ACTIVE, EACH REPLY 
*     BLOCK IS EXAMINED TO SEE IF A PREVIOUSLY SUBMITTED STAGE REQUEST
*     HAS BEEN COMPLETED. 
* 
*     PROC SLVMTOS. 
* 
*     ENTRY      *MTOSS* (IN *COMXSEB*) CONTAINS THE *FET* FOR THE
*                *MTOS* COMMUNICATION FILE. 
* 
*     EXIT       THE VARIABLE *MTOS$TIME* (IN *COMXSEB*) IS UPDATED TO
*                INDICATE THE NEXT TIME THIS ROUTINE IS TO BE CALLED. 
*                IF AN ERROR CONDITION WAS DETECTED WHILE READING 
*                THE *MTOS* FILE, *SLVEND* IS SET TO *S"MTOSERR"*.
* 
*     MESSAGES
*                * SLVI ACTIVE, EXEC XXXX.* 
*                      AN INFORMATIVE MESSAGE INDICATING THAT A CHANGE
*                      IN THE STATUS OF THE *SSEXEC* HAS BEEN NOTICED.
*                      THE NEW STATUS *XXXX* CAN BE EITHER *ACTIVE*,
*                      *IDLE*, OR *INACTIVE*. 
* 
# 
  
# 
****  PROC SLVMTOS - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC EESET;                  # ISSUE EESET (SET EVENT) MACRO #
        PROC MESSAGE;                # ISSUES MESSAGE MACRO # 
        PROC PDATE;                  # ISSUE PDATE MACRO #
        PROC READ;                   # READ FILE #
        PROC REWIND;                 # REWIND FILE #
        PROC RTIME;                  # ISSUE RTIME MACRO #
        END 
  
# 
****  PROC SLVMTOS - XREF LIST END. 
# 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBFET 
*CALL,COMBTDM 
*CALL,COMXIPR 
*CALL,COMXMMF 
*CALL,COMXSEB 
  
  
      ITEM I          U;             # INDUCTION VARIABLE # 
      ITEM RB         U;             # INDEX TO A REQUEST BLOCK # 
                                               CONTROL EJECT; 
  
# 
*     READ THE *MTOS* FILE. 
# 
  
      REWIND(MTOSS,RCL);
      P<FETSET> = LOC(MTOSS); 
      FET$IN[0] = FET$FRST[0];
      FET$OUT[0] = FET$FRST[0]; 
      READ(MTOSS,RCL);
      RTIME(RTIMESTAT[0]);
      PDATE(PDATESTAT[0]);
      MTOS$TIME = RTIMSECS[0] + SM$DELAY[0];
  
# 
*     CHECK THAT THE READ OF *MTOS* IS OK.
# 
  
      IF FET$AT[0] NQ OK             # CIO ERROR #
        OR FET$IN[0] - FET$OUT[0] NQ L$MTOS  # WRONG LENGTH # 
      THEN
        BEGIN 
        SLVEND = S"MTOSERR";
        RETURN; 
        END 
  
# 
*     LOCATE INDEX OF THIS SLAVE IN THE *MTOS* FILE.
# 
  
      SINDX = 0;
      FASTFOR I = 1 STEP 1 WHILE I LQ MAXSLV AND SINDX EQ 0 
      DO
        BEGIN 
        IF MSH$PFNS[I] EQ PFNSTOM 
        THEN                         # FOUND MATCH #
          BEGIN 
          SINDX = I;
          END 
  
        END 
  
      IF SINDX EQ 0 
      THEN
        BEGIN 
        SLVEND = S"MTOSERR";
        RETURN; 
        END 
  
      P<MTOSREPBLK> = LOC(MTOSHEAD) + L$MTOSH + (SINDX-1)*NUMRB;
                                               CONTROL EJECT; 
  
# 
*     CHECK FOR A CHANGE IN MASTER EXEC STATUS. 
# 
  
      IF MSH$MWC[0] NQ SM$MWC[0]
      THEN                           # MASTER IS ACTIVE # 
        BEGIN  # RESET STATUS AND TIME OUT VALUES IN *STOM* # 
        IF SM$STATM[0] NQ S"ACTIVE" 
        THEN                         # MASTER RESUMED RUNNING # 
          BEGIN 
          MSGE$STAT[0] = "ACTIVE."; 
          MESSAGE(MSGEXSTAT[0],SYSUDF1);
          END 
  
        SM$MSW[0] = MSH$MSW[0]; 
        SM$STATM[0] = S"ACTIVE";
        SM$TIMOUT[0] = RTIMSECS[0] + SLAV$INTV; 
        END  # RESET STATUS AND TIME OUT VALUES IN *STOM* # 
  
      ELSE                           # MASTER DID NOT UPDATE ITS WRITE
                                       COUNTER #
        BEGIN  # CHECK FOR TIMEOUT #
        IF SM$TIMOUT[0] LS RTIMSECS[0]
        THEN                         # MASTER IDLE OR TIMED OUT # 
          BEGIN 
          IF MSH$IDLE[0]
          THEN
            BEGIN 
            MSGE$STAT[0] = "IDLE."; 
            END 
  
          ELSE
            BEGIN 
            MSGE$STAT[0] = "INACTIVE."; 
            END 
  
          MESSAGE(MSGEXSTAT[0],SYSUDF1);
          SM$TIMOUT[0] = MAXSECS; 
          SM$STATM[0] = S"DEAD";
          END 
  
        RETURN; 
        END  # CHECK FOR TIMEOUT #
  
                                               CONTROL EJECT; 
  
# 
*     PROCESS REQUEST BLOCKS WHICH HAVE BEEN
*     FINISHED BY MASTER EXEC BY MAKING THEM AVAILABLE. 
# 
  
      FASTFOR RB = 1 STEP 1 UNTIL NUMRB 
      DO
        BEGIN  # CHECK EACH REQUEST BLOCK # 
        IF SM$SRC[RB] NQ S"AVAIL" AND  ## 
          MSR$MRC[RB] EQ S"FINISHED"
        THEN
          BEGIN  # PROCESS FINISHED REQUEST # 
          SM$SRC[RB] = S"AVAIL";
          SM$REQCTL[0] = SM$REQCTL[0] + 1;
          SM$PDATE[RB] = PDATEV[0]; 
          P<TDAM> = LOC(SM$TDAM[RB]); 
          IF MSR$REPLY[0] EQ S"OK" AND  ##
            TDAMEVENT[0] NQ 0 
          THEN                       # ISSUE THE EVENT #
            BEGIN 
            EESET(TDAMEVENT[0]);
            END 
  
          END  # PROCESS FINISHED REQUESTS #
  
        END  # CHECK EACH REQUEST BLOCK # 
  
      END  # SLVMTOS #
  
    TERM
