Retro1.org codex

*DECK XCHKPCR 
USETEXT NIPDEF
USETEXT ACNB
USETEXT ACNT
USETEXT AT
USETEXT DRHDR 
USETEXT ACB 
USETEXT PRUBUFF 
USETEXT FREETAB 
USETEXT KDIS
USETEXT PT
USETEXT MSGIDX
USETEXT RELFILE 
USETEXT STATTAB 
USETEXT SYSTIME 
USETEXT LLCB
USETEXT NBT 
USETEXT TNT 
USETEXT PARAMS
USETEXT PIT 
USETEXT OVERLAY 
 PRGM XCHKPCR;               # CHECK FOR TIME-OUT ON A CONNECTION      #
 
 STARTIMS;
 #
*1DC  XCHKPCR 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        XCHKPCR             PETER TAM           18/03/25 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        LOOK FOR ACNT TABLE TO SHRINK, 
*        CHECK EVERY NETWORK CONNECTION FOR LACK OF ACTIVITY. 
* 
*     3. METHOD USED. 
*          IF PP-CALL-RING EXISTS AND COMPLETION BIT IS SET IN THE
*          CIO OR DSP REQUEST PARAMETER BLOCK, DELINK BLOCK FROM THE PCR
*          AND RELEASE IT.
*          FOR EVERY ACNT TABLE, CHECK IF THERE IS POSSIBILITY
*          OF SHRINKING. CALL SDELQTB TO SHRINK THE TABLE.
*          FOR EACH ACNB
*          CHECK TIMER FOR INACTIVITY 
*          SEND *INACT* MSG TO APPLICATION
*          CALL PIP 
* 
*     4. ENTRY PARAMETERS.  NONE
* 
*     5. EXIT  PARAMETERS.  NONE
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB                 APPLICATION CONTROL BLOCK TEMPLATE 
*        ACNB                APPLICATION CONNECTION CONTROL BLK TEMPLATE
*        ACNT                APPLICATION CONNECTION TABLE TEMPLATE
*        AT                  APPLICATION TABLE TEMPLATE 
*        DRHDR               DATA RING HEADER WORD TEMPLATE 
*        FREETAB             FREE CHAIN TABLE 
*        LLCB                LOGICAL LINK CONTROL BLOCK TEMPLATE
*        MSGIDX              DAYFILE MESSAGE TABLE
*        NIPDEF              CONSTANT DEFINITIONS 
*        OVERLAY             OVERLAY TABLE
*        PARAMS              PARAMETERS FOR PASSING TO SECONDARY OVERLAY
*        PIT                 PIP INTERFACE TABLE
*        PRUBUFF             PRU BUFFER TEMPLATE
*        PT                  POINTER TABLE
*        RELFILE             FET FOR RETURNING FILES TEMPLATE 
*        STATTAB             STATISTICS TABLE 
*        SYSTIME             SYSTEM TIME TABLE
*        TNT                 TERMINAL NODE TABLE TEMPLATE 
* 
*     7. ROUTINES CALLED. 
*          ABORT             ABORT NIP
*          BLINK             LINK DATA BLOCK INTO DATA RING 
*          MGETS             ALLOCATE BUFFER SPACE
*          OSCHAPP           SCHEDULE AN APPLICATION
*        OTIME               GET SYSTEM RTIME 
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
* 
*        WHEN EXECUTION HAS COMPLETED, A JUMP TO LABEL
*        RJMAIN IS MADE TO RETURN TO CALLING PROGRAM. 
* 
*        W A R N I N G - THE SUM OF PROGRAM LENGTH OF XCHKPCR,
*                        MREDUCE SHOULD NOT EXCEED THE PRIMARY
*CALL OPSIZE
* 
*        THIS OVERLAY IS CALLED BY XEXEC. 
* 
 #
 STOPIMS; 
# 
 PARAMETERS.  NONE
  
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC ABORT;               # ABORT NIP                               #
   PROC BLINK;               # LINK DATA BLOCK INTO DATA RING          #
   PROC HCSTTP ;                   # HOST SIDE CONNECTION STATE TABLE  #
   PROC LOCLLCB;             # LOCATE LLCB                             #
   PROC OTIME;               # GET SYSTEM RTIME                        #
   PROC OVLCALL;             # LOAD AND EXECUTE OVERLAY                #
   PROC MGETS;               # ALLOCATE BUFFER SPACE                   #
   PROC MREDUCE ; 
   PROC OSCHAPP;             # SCHEDULE THE APPLICATION                #
   PROC MRELS;               # RELEASE BUFFER SPACE                    #
   PROC OMSG;                # DAYFILE MESSAGE                         #
   PROC XTRACE;              # TRACE CALLS                             #
   LABEL RJMAIN;             # RETURN ADDRESS                          #
   END
# 
                    INTERNAL VARIABLES
# 
 ARRAY QFERRMSG    S(4);
   BEGIN
   ITEM QFERRTEXT  C(0,0,30) = [" XXX ERROR NNB, LFN = XXXXXXX."];
   ITEM QFPPNAME   U(0,6,18);          # DSP OR CIO                    #
   ITEM QFERRNN    U(1,6,12);          # OCTAL ERROR CODE              #
   ITEM QFERRLFN   C(2,12,NC);         # QUEUE FILE LFN                #
   ITEM QFENDTEXT  U(3,0,60) = [0]; 
   END
 ITEM NXTACNB, LASTAN, TMP; 
 ITEM NEXTBLK;               # NEXT PP-CALL-RING BLOCK                 #
 ITEM LASTBLK;               # LAST PP-CALL-RING BLOCK                 #
 ITEM INDEX;                 # FOR LOOP INDEX                          #
 ITEM TMP1;                  # TEMPORARY VARIABLE                      #
 ITEM TN;                    # TERMINAL NODE                           #
 ITEM HN;                    # HOST NODE                               #
 ITEM CURR;                  # CURRENT BUFFER TO RELEASE               #
  ITEM NEXT;                 # SCRATCH VARIABLE                        #
 
 BASED ARRAY PRUNIPWD  S(1);           # TEMPLATE FOR NIP WORD IN PIT  #
   BEGIN
   ITEM PRUNIPMFB   U(0,00,06);        # MINIMUM NO OF PRU BUFS        #
   ITEM PRUNIPMAB   U(0,06,06);        # MAXIMUM NO OF PRU BUFS        #
   ITEM PRUNIPNCA   U(0,12,12);        # CURRENT NO OF BUFFERS ASSIGNED#
   ITEM PRUNIPNC    U(0,24,12);        # CURRENT NO OF PRU CONNECTIONS #
   ITEM PRUNIPFPB   U(0,42,18);        # ADR OF FIRST BUF IN FREE CHAIN#
   END
 
 BASED ARRAY PRUPIPWD  S(1);           # TEMPLATE FOR PIP WORD IN PIT  #
   BEGIN
   ITEM PRUPIPNFB   U(0,00,12);        # NO OF BUFS IN FREE CHAIN      #
   ITEM PRUPIPNRA   U(0,12,12);        # NO OF BUS NEEDED BY PIP       #
   ITEM PRUPIPRPB   U(0,42,18);        # ADDR OF BUF TO RELEASE        #
   END
 
 CONTROL IFEQ STAT,1; 
   ARRAY STIME P(1);         # RTIME BUFFER FOR STARTING TIME          #
     BEGIN
     ITEM SMILS U(0,24,36);  # STARTING TIME IN MILLESECONDS           #
     END
   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           #
 CONTROL FI;
 
 
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("XCHPC") ; 
      CONTROL FI; 
 
 
      IF HRL EQ HRLV0 
      THEN                   # NAM IN MAX FL REACHED CONDITION         #
        GOTO RJMAIN;
 
      CONTROL IFEQ STAT,1;
        OTIME(STIME);        # GET SYSTEM TIME AT BEGINNING OF PROC    #
      CONTROL FI; 
 
# 
      CHECK NAM K DISPLAY ACTIVITY
# 
      FOR NBTIDX = 0 STEP NBTFETNO WHILE NBTIDX LQ NBTMAXID 
      DO
        BEGIN 
        IF NBTREL[NBTIDX + 5]  # BUFFER RELEASE FLAG SET               #
        THEN
          BEGIN 
            IF NBTFIRST[NBTIDX + 5] NQ 0
            THEN
              BEGIN 
              MRELS(NBTFIRST[NBTIDX + 5]- BLKHSIZE);# RELEASE BUFFER   #
              END 
            NBTWD1[NBTIDX + 5] = 0; # CLEAR ALL FOUR WORDS IN TRACE FET#
            NBTWD2[NBTIDX + 5] = 0; 
            NBTWD3[NBTIDX + 5] = 0; 
            NBTWD4[NBTIDX + 5] = 0; 
          END 
        END 
 
      TMP1 = RTSECS[0]; 
      IF KDVW[0]
      THEN                   # K DISPLAY BEING VIEWED                  #
        BEGIN 
        IF KDTIMER[0] LQ TMP1 
        THEN                 # K DISPLAY VIEW TIMER TIMEOUT            #
          BEGIN 
          IF KDLCOMP[0] OR KDRCOMP[0] 
          THEN               # K DISPLAY IS ON                         #
            BEGIN 
            KDTIMER[0] = TMP1 + TKDVW; # RESTART TIMER                 #
            KDLCOMP[0] = FALSE; 
            KDRCOMP[0] = FALSE; 
            END 
          ELSE               # K DISPLAY IS NOT ON                     #
            BEGIN 
            KDVW[0] = FALSE;
            OVLNAME = KPCLNUPP; # CLEAN UP K DISPLAY DATA              #
            OVLCALL;
            END 
          END 
        END 
 
      IF KDST[0]
      THEN                   # STATUS DISPLAY IS ON                    #
        BEGIN 
        IF NOT KFAST[0] 
          AND KSLOWTM[0] LQ TMP1
        THEN                 # SLOW MODE AND TIMER EXPIRED             #
          BEGIN 
          KDIS$STAT = STM"STM$UPDATE"; # UPDATE STATUS DISPLAY         #
          KSLOWTM[0] = TMP1 + TSLOW; # RESTART TIMER                   #
          END 
 
        CONTROL IFEQ STAT,1;
        IF KSTATIM[0] LQ TMP1 
        THEN                 # UPDATE STATISTICS IN K DISPLAY          #
          BEGIN 
          OVLNAME = KSTTUPDP; 
          OVLCALL;
          KSTATIM[0] = TMP1 + TSTAT; # RESTART TIMER                   #
          END 
        CONTROL FI; 
 
        END 
 
      P<FREEBUF> = 0; 
      IF (FREFBBP+FRBBS[FREFBBP]) EQ CTLSLWA
        AND FRBBS[FREFBBP] GQ 2*RSBUF 
      THEN
        REDUCEFL = 1; # CALL MGBGCLT TO REDUCE FL                      #
# 
      IF PP-CALL-RING EXISTS AND COMPLETION BIT IS SET IN A REQUEST 
      PARAMETER BLOCK, DELINK BLOCK FROM THE PCR AND RELEASE IT.
# 
      NEXTBLK = PCRHEAD[0];            # INITIALIZE NEXT PCR BLOCK     #
      FOR INDEX=INDEX WHILE NEXTBLK NQ 0
                        AND NEXTBLK NQ LOC(PCRHEAD[0])
      DO
        BEGIN                          # SCAN PP-CALL-RING             #
        P<PARAMB> = NEXTBLK + BLKHSIZE;# PARAMETER BLOCK ADDRESS       #
        P<DRHDRWD> = NEXTBLK;          # CURRENT PCR BLOCK             #
        NEXTBLK = NEXTPTR[0];          # NEXT BLOCK IN PCR             #
        LASTBLK = BACKPTR[0];          # PREVIOUS BLOCK IN PCR         #
 
        IF FET$CB[0]
        THEN                           # IF COMPLETION BIT IS SET      #
          BEGIN 
 
          IF BLKID[0] EQ DPCRIDVALUE
          THEN                         # A DSP CALL                    #
            BEGIN 
            TMP = FET$DSPERR[0];       # DSP ERROR CODE                #
            TMP1 = PP$DSP;
            END 
          ELSE                         # A CIO CALL                    #
            BEGIN 
            TMP = FET$CIOERR[0];       # CIO ERROR CODE                #
            TMP1 = PP$CIO;
            END 
 
          IF TMP NQ 0 
          THEN                         # DSP OR CIO CALL ERROR         #
            BEGIN 
            QFPPNAME[0] = TMP1; 
            TMP1 = TMP/8; 
            QFERRNN[0] = TMP1*O"100" + TMP - TMP1*8 + O"3333";
            QFERRLFN[0] = FET$LFN[0]; 
            OMSG(QFERRMSG,0);            # DAYFILE MESSAGE             #
            END 
 
          MRELS(P<DRHDRWD>);           # RELEASE PCR BLOCK             #
 
          IF PCRHEAD[0] EQ PCRTAIL[0] 
          THEN
            BEGIN                      # ONLY PCR BLOCK REMAINS        #
            PCRHEAD[0] = 0;            # ZERO PCR POINTERS             #
            PCRTAIL[0] = 0; 
            END 
 
          ELSE                         # MORE THAN ONE PCR BLOCK EXIST #
            BEGIN                      # UPDATE RING POINTERS          #
            P<DRHDRWD> = 0; 
            NEXTPTR[LASTBLK] = NEXTBLK; 
            BACKPTR[NEXTBLK] = LASTBLK; 
            END 
          END 
        END 
# 
      CHECK EVERY CONNECTION OF EVERY APPLICATION FOR ELIGIBLE CAND 
      TO SEND FC/INACT TO 
# 
      IF INACTVAL NQ 0
         OR SETTIMER               # APP SET INACTIVITY TIMER          #
      THEN
        BEGIN                      # CHECK FOR INACTIVE TERMINALS      #
        SETTIMER = FALSE;          # REINITIALIZE APP SET TIMER FLAG   #
 
        FOR LASTAN = 1 STEP 1 UNTIL ATHAN[0]
        DO
          BEGIN 
          P<ACB> = ATACBA[LASTAN];# NEXT ACB IN AT                     #
          IF P<ACB> NQ 0 AND NOT ATNVFN[LASTAN] AND NOT ATNVFF[LASTAN]
          THEN
            BEGIN              # APP CONTROL BLOCK EXISTS              #
 
  #         TIME TO LOOK FOR ACNT TO SHRINK                            #
 
            P<ACNT> = ACBACNT[0];# APP CONNECTION TABLE ADDRESS        #
 
  #         CHECK CONNECTIONS ACTIVITIES                               #
 
            IF ACBNCN[0] NQ 0 
            THEN
              BEGIN            # CONNECTIONS EXIST                     #
              FOR NXTACNB = ACNTHSIZE STEP 1 # ENTRY SIZE OF ACNT # 
                            UNTIL ACNTHCN[0]-ACNTMINACN[0]+ACNTHSIZE
              DO
                BEGIN 
                P<ACNB> = ACNTACNB[NXTACNB];
                IF P<ACNB> NQ 0 
                THEN
                  BEGIN      # THERE IS A CONNECTION                   #
                  IF ( ACNBINACT[0] LQ RTSECS[0]    ) AND 
                     ( ( (NOT ACNBTIMERF[0]) AND
                         (INACTVAL NQ 0    )    ) OR
                       ( (ACNBTIMERF[0]    ) AND
                         (ACNBTIMER[0] NQ 0)    )   ) 
                  THEN
                    BEGIN 
                    RCBRK = RCCB"I" ;      # REASON CODE 9 TO BREAK THE#
                                     # CONNECTION IF IT NEEDS TO BE TER#
                                     # ONLY WHEN CONNECTION STILL IN NV#
                    HCSTTP(P<ACB>,ACNBACN[0],HCTMOUT,0) ; # SEND FC/INA#
                    ACNBTIMERF[0] = ACNBTIMERP[0]; # RESET APP TIMER FL#
                    IF ACNBTIMERF[0]
                    THEN           # APP TIMER STILL IN EFFECT         #
                      BEGIN 
                      ACNBINACT[0] = RTSECS[0] + ACNBTIMER[0]; # NEW TI#
                      END 
                    ELSE           # NAM INACTIVITY TIMER IN EFFECT    #
                      BEGIN 
                      ACNBINACT[0] = RTSECS[0] + INACTVAL;
                      END 
                    END 
                  IF ACNBTIMERF[0]
                  THEN             # APP TIMER STILL IN EFFECT         #
                    BEGIN 
                    SETTIMER = TRUE;  # APP SET INACTIVITY TIMER       #
                    END 
                  END 
                END 
              END 
            END 
          END 
        END                              # CHECK FOR INACTIVE TERMINAL #
 
 
      P<LLCB> = TNTLLAD[0]; 
      IF P<LLCB>  NQ 0 AND LLCBNC[0] EQ 0 
      THEN
        BEGIN                # NO CONNECTIONS ON INTRA HOST LLK        #
        FOR TN=0 STEP 1 WHILE (TN LQ 1) 
        DO
          BEGIN 
          IF TN EQ 0
          THEN
            HN = 1; 
          ELSE
            HN = 0; 
          LOCLLCB(HN,TN,P<LLCB>);  # FIND LLCB                         #
          IF LLCBNC[0] EQ 0 
          THEN
            BEGIN            # RELEASE DATA QUEUED ON FAKE LLK         #
            P<DRHDRWD> = 0; 
            CURR = LLCBSHFP[0]; 
            FOR CURR = CURR WHILE CURR NQ 0 
            DO
              BEGIN 
              NEXT = NEXTPTR[CURR]; 
              MRELS(CURR);
              CURR = NEXT;
              END 
            END 
          #  RELEASE INTRA HOST LOGICAL LINKS                          #
          PARAMS2 = P<LLCB>;
          OVLNAME = RELLLCBP;  # OVERLAY NAME                          #
          OVLCALL;
          END 
        END 
# 
      SCAN THROUGH PIT TABLE LOOKING FOR PRU BUFFERS THAT ARE TO BE 
      RELEASED. 
# 
      FOR INDEX = 1 STEP 1 UNTIL MAXPIP 
      DO                               # CHECK ALL PIT ENTRIES         #
        BEGIN 
        IF PITPUF[INDEX]
        THEN                           # THIS PIT ENTRY IS IN USE      #
          BEGIN 
          P<PRUNIPWD> = LOC(PITW5[INDEX]);  # ADDR OF 1ST NIP WORD     #
          P<PRUPIPWD> = LOC(PITW8[INDEX]);  # ADDR OF 1ST PIP WORD     #
          FOR NEXT = 0 STEP 1 UNTIL MAXPRU-1
          DO                           # CHECK EACH PRU BUFFER SIZE    #
            BEGIN 
            TMP = PRUNIPNCA[NEXT] - PRUPIPNRA[NEXT]; # NO OF BUF TO REL#
            IF TMP GR 0 
            THEN                       # PIP HAS PRU BUFS FOR RELEASE  #
              BEGIN 
              P<PRUBUFF> = PRUPIPRPB[NEXT];  # ADDR OF BUF TO RELEASE  #
              IF (TMP EQ 1       ) AND  # PIP ONLY RELEASES 1 AT A TIME#
                 (P<PRUBUFF> NQ 0)     # ADDR OF BUF TO RELEASE EXISTS #
              THEN                     # RELEASE PRU BUFFER            #
                BEGIN 
                MRELS(P<PRUBUFF>);     # RELEASE BUFFER                #
                PRUNIPNCA[NEXT] = PRUNIPNCA[NEXT] - 1;
                IF PRUNIPNCA[NEXT] EQ 0 
                THEN                   # RELEASED LAST PRU BUFFER      #
                  BEGIN 
                  PRUNIPFPB[NEXT] = 0; # ZERO 1ST BUFFER POINTER       #
                  END 
                END 
              ELSE                     # PIP MAY HAVE RELEASED ALL BUFS#
                BEGIN 
                IF P<PRUBUFF> NQ 0
                THEN                   # PIP HAS NOT DROPPED OUT       #
                  BEGIN 
                  D27M2[0] = "XCHKPCR"; 
                  OMSG(DFMSG27,0);     # NIP INTERNAL ERROR            #
                  ABORT(0,0);          # ABORT NIP                     #
                  END 
                END 
              END 
            END 
          END 
        END 
 
      CONTROL IFEQ STAT,1;
        OTIME(ETIME);        # GET SYSTEM TIME AT END OF PROC          #
        ST$NXP = ST$NXP + 1; # INCREMENT NUMBER OF TIMES XCHKPCR CALLED#
        STTEMP = EMILS[0] - SMILS[0];  # TIME SPENT IN THIS ROUTINE    #
        ST$TXP = ST$TXP + STTEMP;  # TOTAL TIME SPENT IN THIS ROUTINE  #
        IF ST$LXP LS STTEMP 
        THEN                 # FOUND LARGER TIME INTERVAL IN ROUTINE   #
          BEGIN 
          ST$LXP = STTEMP;   # NEW LARGEST TIME INTERVAL               #
          END 
      CONTROL FI; 
 
 
      GOTO RJMAIN;
      END 
TERM