Retro1.org codex

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