Retro1.org codex

*DECK MSETIL
USETEXT NIPDEF
USETEXT LLCB
USETEXT MSGIDX
USETEXT NBT 
USETEXT PIT 
USETEXT PT
USETEXT SYSTIME 
USETEXT STATTAB 
PROC MSETIL((CBADDR));  # REQUEST NIP/PIP INTERLOCK                    #
 STARTIMS;
 #
*1DC  MSETIL
*     1. PROC NAME           AUTHOR              DATE 
*        MSETIL              J.C. LEE            80/04/01 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          REQUEST NIP/PIP INTERLOCK
* 
*     3. METHOD USED. 
*          SET REQUEST INTERLOCK FLAG IN PIT ENTRY REQUEST WORD,
*          WAIT FOR ALL RUNNING PIP-S TO ACKNOWLEDGE THE INTERLOCK REQ. 
* 
*     4. ENTRY PARAMETERS.
*          CBADDR            ZERO IF ALL PIP(S) ARE TO BE INTERLOCKED,
*                            LLCB ADDRESS IF ONLY A SPECIFIC
*                            PIP IS TO BE INTERLOCKED 
* 
*     5.  EXIT PARAMETERS.
*        NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        NIPDEF    LLCB      NBT       PIT       PT        OSIZE
*        SYSTIME     MSGIDX 
*        STATTAB             STATISTICS TABLE 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          MCLRIL            CLEAR INTERLOCK REQUEST
*          OTIME             GET (DEADSTART) REAL TIME CLOCK VALUE
*          XRECALL           RECALL 
*          XTRACE            TRACE CALL 
*          OMSG              ISSUE DAYFILE MESSAGE
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        "NO INTERLOCK" 
* 
*        W A R N I N G - THIS PROCEDURE IS LOADED WITH PRIMARY OVERLAY
*                        MGBGCLT, MDRPTR, MCHKPTR, MAJPTR 
*                        AND XCHKPCR. THEREFORE WHENEVER THIS ROUTINE 
*                        IS MODIFIED, CHECK MUST BE MADE TO MAKE SURE 
*                        THE OVERLAYS MGBGCLT, MDRPTR, MCHKPTR, 
*                        MAJPTR AND XCHKPCR WILL NOT EXCEED THE 
*CALL OSIZE 
* 
*        THIS PROCEDURE IS CALLED BY MGBGCLT, NPHECP, 
*        AND NPPCT. 
* 
 #
 STOPIMS; 
# 
      EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC ABORT;                         # ABORT PROCEDURE               #
   PROC MCLRIL;                        # CLEAR INTERLOCK REQUEST       #
   PROC OMSG;                # ISSUE DAYFILE MESSAGE                   #
   PROC OTIME;                         # GET REAL TIME CLOCK VALUE     #
   PROC XRECALL;                       # RECALL                        #
   PROC XTRACE;                        # TRACE CALL                    #
   END
# 
      INTERNAL VARIABLES
# 
 ARRAY CURTIME P(1);         # WORD TO STORE CURRENT TIME              #
  BEGIN 
   ITEM CURSECS U(0,0,24);   # SYSTIME IN SECONDS                      #
   ITEM SMILS U(0,24,36);              # STARTING TIME IN MILLESECONDS #
   END
 
      DEF ACKTIME  #25#;
 ITEM 
   CBADDR,                             # PCB ADDRESS                   #
   INDEX,                              # INDEX FOR PIT ENTRY           #
   IDXMIN,                             # MINIMUM INDEX                 #
   IDXMAX,                             # MAXIMUM INDEX                 #
   NOTACK B,                           # FLAG FOR INTRLK NOT ACKED #
   TIMEC = 0,                          # SAVE INITIAL TIME             #
   FLAG B;                             # TEMPORARY FLAG                #
 
 CONTROL IFEQ STAT,1; 
   ARRAY ETIME P(1);                   # RTIME BUFFER FOR ENDING TIME  #
     BEGIN
     ITEM EMILS U(0,24,36);            # ENDING TIME IN MILLESECONDS   #
     END
 
   ITEM STTEMP;                        # TEMPORARY STATISTICS VARIABLE #
   ITEM TIMESC = 0;                    # SAVE INITIAL TIME IN MILLESEC #
 CONTROL FI;
 
 
# ******************************************************************** #
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("MSETI") ; 
      CONTROL FI; 
 
      OTIME(CURTIME); 
      TIMEC = CURSECS[0];  # SAVE CURRENT TIME IN SECS                 #
 
      CONTROL IFEQ STAT,1;
        TIMESC = SMILS[0];
      CONTROL FI; 
 
      NOTACK = FALSE; 
      IF CBADDR NQ 0
      THEN                             # INTERLOCK A SPECIFIC PIP ONLY #
        BEGIN 
        P<LLCB> = CBADDR;              # LLCB ADDRESS                  #
 
        IF LLCBID[0] NQ LLCBIDVALUE 
        THEN                           # IF NOT LLCB                   #
          GOTO EXIT;                   # NO INTERLOCK IS REQUIRED      #
 
        IDXMIN = LLCBPITIDX[0];        # PIT ENTRY INDEX               #
        IDXMAX = IDXMIN;
        END 
      ELSE                             # NEED TO INTERLOCK ALL PIPS    #
        BEGIN 
        IDXMIN = 1;                    # INDEX FOR FIRST PIT ENTRY     #
        IDXMAX = MAXPIP;               # INDEX FOR LAST PIT ENTRY      #
        END 
      FOR INDEX = IDXMIN STEP 1 UNTIL IDXMAX
      DO                               # INTERLOCK ALL PIPS            #
        BEGIN 
        IF PITPUF[INDEX] AND           # PIT ENTRY IS IN USE           #
           NOT PITC[INDEX]             # PIP HAS NOT DROPPED OUT       #
        THEN                           # NEED TO INTERLOCK THIS PIP    #
          BEGIN 
          IF PITACK[INDEX]
          THEN                         # PREVIOUS ACK WAS NOT CLEARED  #
            BEGIN 
            GOTO EXIT;                 # DO NOT NEED INTERLOCK         #
 
            END 
          IF PITAF[INDEX] 
          THEN                         # INTERLOCK ABANDONED LAST TIME #
            BEGIN 
            CONTROL SLOWLOOP; 
            FOR INDEX = INDEX WHILE PITACK[INDEX] 
            DO                         # WAIT FOR ACK TO BE CLEARED    #
              BEGIN 
              XRECALL(0); 
              END 
            PITAF[INDEX] = FALSE;      # CLEAR ABANDON FLAG            #
            END 
          PITPF[INDEX] = TRUE;         # SET INTERLOCK REQUEST         #
          END 
        END 
# 
      CHECK FOR ACKNOWLEDGEMENT OF INTERLOCK
# 
      FOR INDEX = IDXMIN STEP 1 UNTIL IDXMAX
      DO                               # CHECK ALL PIPS                #
        BEGIN 
        FLAG = TRUE;
        CONTROL SLOWLOOP; 
        FOR INDEX = INDEX WHILE FLAG AND NOT NOTACK 
        DO  # UNTIL INTERLOCK ACKNOWLEDGED OR ABANDONED                #
          BEGIN 
          IF PITPF[INDEX] AND NOT PITACK[INDEX] 
          THEN                         # PIP HAS ACKNOWLEDGED INTERLOCK#
            BEGIN 
            XRECALL(0); 
            OTIME(CURTIME);            # GET CURRENT TIME              #
            IF CURSECS[0] - TIMEC GR ACKTIME
            THEN                       # AT LEAST 2 SECONDS HAVE PASSED#
              BEGIN                    # DO NOT WAIT ANY LONGER        #
              NOTACK = TRUE;           # SET PIP NOT INTERLOCKED FLAG  #
              END                      # TERMINATE EXECUTION OF LOOP   #
            END 
          ELSE                         # INTLCK NOT REQ-ED OR ACK-ED   #
            FLAG = FALSE; 
          END 
        END 
      IF NOTACK                        # IF INTLCK NOT ACK-ED          #
      THEN
        BEGIN 
        MCLRIL;                        # CLEAR INTERLOCK REQUEST       #
        OMSG(DFMSG19);  # " NO INTERLOCK"                              #
        ABORT(0,0); 
        END 
EXIT: 
 
      CONTROL IFEQ STAT,1;
        OTIME(ETIME);        # GET SYSTEM TIME AT END OF PROCEDURE     #
        ST$NMS = ST$NMS + 1; # INCREMENT NUMBER OF TIMES MSETIL CALLED #
        STTEMP = EMILS[0] - TIMESC;  # TIME SPENT WAITINT FOR INTERLOCK#
        ST$TMS = ST$TMS + STTEMP;  # TOTAL TIME SPENT IN MSETIL        #
        IF ST$LMS LS STTEMP 
        THEN                 # FOUND LARGER TIME INTERVAL IN ROUTINE   #
          BEGIN 
          ST$LMS = STTEMP;   # NEW LARGEST TIME INTERVAL               #
          END 
      CONTROL FI; 
 
      RETURN; 
      END 
TERM