Retro1.org codex

*DECK XCHKCET 
USETEXT NIPDEF
USETEXT CET 
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT MEM 
USETEXT MSGIDX
USETEXT NBT 
USETEXT INPARUT 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PIT 
USETEXT PT
USETEXT KDIS
USETEXT KSTTAB
USETEXT STATTAB 
USETEXT SYSTIME 
      PRGM XCHKCET;          # CALL PIP AND PROCESS CET CHANGES        #
 
 STARTIMS;
 #
*1DC  XCHKCET 
*     1. PROC NAME                AUTHOR             DATE 
*        XCHKCET                 L.T. NGUYEN        81/07/31
* 
*     2. FUNCTIONAL DESCRIPTION 
*        - PROCESS EST CHANGES
*        - UPDATE STATUS PIT AND NBT. 
* 
*     3. METHOD 
*        CHECK THE CHANGE FLAG ( CETC1 ) IN EST : 
*        - IF ON
*          . INDEX THROUGH PIT TABLE TO FIND PIT ENTRY CORRESPONDING TO 
*            PIP NUMBER.  IF NEW ENTRY, SET UP PIT TABLE. 
*          . LOOK FOR FREE NBTE ENTRY, SET UP THE NEW NBTE AND
*            POINTER IN PITE. IF NEW PIP, DO PIP CALL. IF NO NBTE 
*            ENTRY FOUND, ERROR EXIT. SET CHANGE FLAG CETC1 IN
*            EST TO FALSE BEFORE LEAVING THE ROUTINE. 
* 
*        - IF NOT ON
*          . XEXEC CALLS THE ROUTINE PERIODICALLY ( 10 SECS ). UPDATE 
*            STATUS OF PIT TABLE BY SCANNING IT 
*           . IF PIP DROPPED AND ALL NBTE ENTRIES ARE ZERO, RELEASE 
*              PIP BUFFER AREAS.
*           . IF DROPPING PIP COMPLETED AND THERE IS A NON-ZERO NBTE, 
*             CALL PIP AGAIN ( EST WAS TURNED ON BEFORE PIP DROPPED OUT 
*             COMPLETELY. 
*             . IF AN ACTIVE PIP HAS REQUESTED A DUMP BUFFER ALLOCATE IT. 
*             REQUEST MORE BUFFER FOR DUMP. 
* 
*     4. ENTRY PARAMETERS 
*        - NONE.
* 
*     5. EXIT PARAMETERS
*        -
* 
*     6. COMDECKS CALLED
*        - CET
*        - DRHDR
*        - MEM
*        - MSGIDX 
*        - NBT
*        - OVERLAY
*        - PARAMS 
*        - PIT
*        - PT 
*        - KDIS 
*        - NIPDEF 
*        - STATTAB
*        - OPSIZE 
*        - SYSTIME           CURRENT RTIME VALUE
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        ABORT - ABORT NIP
*        MCLRIL - CLEAR NIP/PIP INTERLOCK 
*        MGETS - ALLOCATE BUFFER
*        MSETIL - SET NIP/PIP INTERLOCK 
*        OVLCALL - LOAD AND EXECUTE OVERLAY 
*        XTRACE - TRACE PROCEDURE CALL
*        KADD - ADD ENTRY INTO K-DISPLAY
*        KPUT - UPDATE K-DISPLAY STATUS 
*        OSREQ - CALL PIP 
*        OMSG - ISSUE DAYFILE MESSAGE 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
* 
*        * BAD PIP NUMBER IN EST ENTRY *
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE PRIMARY 
*CALL OPSIZE
*           THIS ROUTINE IS CALLED WHEN INFORMATION IN EST CHANGED, 
*           OR XEXEC WILL CALL PERIODICALLY ( 10 SECS ) TO UPDATE 
*           PIT TABLE.
* 
 #
 STOPIMS; 
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC ABORT;          # ABORT NIP                               #
        PROC MCLRIL;         # CLEAR NIP/PIP INTERLOCK                 #
        PROC MGETS; 
        PROC MRELS; 
        PROC MSETIL;         # SET NIP/PIP INTERLOCK                   #
        PROC OVLCALL; 
        PROC XTRACE;
        PROC BLDKWL;         # FORMAT KWL TO ADD EST TO ST             #
        PROC OSREQ;          # CALL PIP                                #
        PROC OMSG ; 
        LABEL RJMAIN; 
        END 
# 
      INTERNAL VARIABLES
# 
      ARRAY ABTMSG S(4);     # ABORT NIP DAYFILE MESSAGE               #
        BEGIN 
        ITEM ABTMSG1 C(0,00,35)=[" XCHKCET - BAD PIP NO IN EST ENTRY."];
        ITEM ABTMSGE U(3,30,30)=[0];
        END 
 
      BASED ARRAY PITNBTW S(1);  # TEMPLATE FOR NBT ENTRY WD IN PIT    #
        BEGIN 
        ITEM PITNBTWH  B(00,00,01);  # HALT NPU FLAG                   #
        ITEM PITNBTWE  U(00,30,06);  # NBT TABLE ENTRY INDEX           #
        ITEM PITNBTWA  I(00,42,18);  # NBT ENTRY ADDRESS               #
        END 
 
      ARRAY ITPIP S(1);      # PIP CALL WORD                           #
        BEGIN 
        ITEM ITNAME   C(0,0,3) = ["PIP"];  # PIP NAME                  #
        ITEM ITFILL1  U(0,18,1) = [0];
        ITEM ITRCALL  B(0,19,1) = [FALSE];  # NO RECALL                #
        ITEM ITFILL2  U(0,20,4) = [0];
        ITEM ITFUNC   U(0,24,12);  # PIP CALL TYPE                     #
        ITEM ITFILL3  U(0,36,6) = [0];
        ITEM ITADDR   U(0,42,AL);    # PARAMETER WORD ADDRESS          #
        END 
 
      ITEM J U ;
      ITEM INDEX; 
      ITEM PIPCALL B; 
      ITEM FOUND B; 
      ITEM NBTIX; 
      ITEM PIPNR; 
      ITEM TEMP;
      ITEM NBTENR;
      ITEM NBTEADDR;
      ITEM PNAME C(10) = "CCET";  # PROC NAME PASSED TO ERROR MSG      #
      ARRAY ALRT S(3) ; 
        BEGIN 
        ITEM ALRT1  C(0,0,20)=["$REQUEST *K* DISPLAY"] ;
        ITEM ALRT2  U(2,0,60)=[0] ; 
        END 
 
#**********************************************************************#
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("XCHCE") ; 
      CONTROL FI; 
 
# 
      CHECK IF WE HAVE ANY ALERT TO INFORM
# 
      IF NOT KDVW[0]         # K DISPLAY NOT BEING VIEWED              #
        AND (KDNAL[0] NQ 0   # ALERT(S) PENDING                        #
        OR KDALERT[0]        # K DISPLAY ALERT OUTSTANDING             #
        OR HRL EQ 0)         # MAX FL REACHED , ALERT OPERATOR         #
      THEN
        OMSG(ALRT,2) ;
 
      PIPCALL = FALSE ;                         # ASSUMMING NO PIP CALL#
      IF CETC1[1] 
      THEN                   # PROCESS CET CHANGES                     #
        BEGIN 
        FOR INDEX = CETHSIZE STEP 1 UNTIL CETBS[0]-1
        DO
          IF CETC2[INDEX] 
          THEN
            BEGIN 
            CETOFF[INDEX] = FALSE;
            CETNON[0] = CETNON[0] + 1;
            CETNOFF[0] = CETNOFF[0] - 1;
 
# 
            CHECK PIP NUMBER FROM EST ENTRY 
# 
            PIPNR = CETPIP[INDEX];  # PIP NUMBER FROM CET ENTRY        #
            IF PIPNR LS 1 OR # PIP NUMBER IS TOO SMALL                 #
               PIPNR GR 4    # PIP NUMBER IS TOO LARGE                 #
            THEN             # ABORT NIP FOR BAD EST ENTRY             #
              BEGIN 
              OMSG(ABTMSG,0);  # ISSUE DAYFILE MESSAGE                 #
              ABORT(0,0);    # ABORT NIP                               #
              END 
            FOUND = FALSE;                 # RESET TO SEARCH EMPTY NBTE#
            FOR NBTIX = 0 WHILE NOT FOUND 
                                AND NBTIX LQ NBTMAXID 
            DO
              BEGIN 
              IF NOT NBTIUF[NBTIX]
              THEN                         # FREE NBTE FOUND           #
                FOUND = TRUE; 
              ELSE
                NBTIX = NBTIX + NBTFETNO; 
              END 
            IF FOUND
            THEN
              BEGIN 
# 
              SET UP PIT ENTRY
# 
              IF NOT PITPUF[PIPNR]
              THEN           # NEW PIT ENTRY USED                      #
                BEGIN 
                PIPCALL = TRUE;  # NEED TO CALL PIP INTO PP            #
                PITC[PIPNR] = FALSE;
                PITACK[PIPNR] = FALSE;
                PITPF[PIPNR] = FALSE; 
                PITESF[PIPNR] = FALSE;
                PITAF[PIPNR] = FALSE; 
                FOUND = FALSE;
                FOR TEMP = 1 STEP 1 UNTIL MAXPIP
                DO           # CHECK IF ANY OTHER PIPS                 #
                  BEGIN 
                  IF PITPUF[TEMP] 
                  THEN       # THERE IS ANOTHER PIP RUNNING            #
                    BEGIN 
                    FOUND = TRUE; 
                    END 
                  END 
                IF NOT FOUND
                THEN         # THIS PIP WILL DO EST SCAN               #
                  BEGIN 
                  PITESF[PIPNR] = TRUE;  # SET EST SCAN FLAG           #
                  END 
                PITPUF[PIPNR] = TRUE;  # SET PIT ENTRY IN USE FLAG     #
                END 
              NBTENR = NBTIX/NBTFETNO;  # NBTE NUMBER                  #
              NBTEADDR = LOC(NBTIUF[NBTIX]); # NBTE ADDRESS            #
              FOR TEMP = NBTEADDR STEP 1 UNTIL NBTEADDR+NBTESIZE-1
              DO
                MEMORY[TEMP] = 0;          # CLEAR NBTE AREA           #
              FOUND = FALSE;        # RESET TO PLACE NBTE ADDR IN PITE #
# 
              LOOK FOR FREE NBT ENTRY IN PIT TABLE ENTRY
# 
              P<PITNBTW> = LOC(PITNBTE1[PIPNR]);  # ADDR OF 1ST NBT ENT#
              TEMP = 0; 
              FOR PIPNR=PIPNR WHILE NOT FOUND AND 
                              TEMP LQ MAXNPU-1
              DO             # CHECK EACH NBT ENTRY WORD IN PIT ENTRY  #
                BEGIN 
                IF PITNBTWA[TEMP] EQ 0
                THEN         # FOUND EMPTY NBT ENTRY IN PIT TABLE      #
                  BEGIN 
                  FOUND = TRUE; 
                  END 
                ELSE         # CHECK NEXT SLOT IN PIT TABLE ENTRY      #
                  BEGIN 
                  TEMP = TEMP + 1;
                  END 
                END 
              IF FOUND
              THEN
                BEGIN 
                NBTNAE[0] = NBTNAE[0] + 1; # INCREMENT ACTIVE NBTE CNT #
                NBTNFE[0] = NBTNFE[0] - 1; # DECREMENT FREE NBTE COUNT #
                NBTIUF[NBTIX] = TRUE;    # SET NBTE USE FLAG           #
                NBTINDX[NBTIX] = NBTENR; # SET NBTE NUMBER             #
                NBTPIP[NBTIX] = PIPNR;   # PLACE PIP NUMBER            #
                NBTEST[NBTIX] = CETEST[INDEX];
                NBTCH[NBTIX] = CETCH[INDEX];
                NBTEQ[NBTIX] = CETEQ[INDEX];
                NBTET[NBTIX] = CETET[INDEX] ; 
                NBTHN[NBTIX] = CETHN[INDEX];
                NBTSAM[NBTIX] = CETSAM[INDEX];
                IF KDST[0]
                THEN # ADD EST ENTRY TO STATUS DISPLAY                 #
                  BLDKWL(KST"EST",CETHN[INDEX],0,KADDIDVALUE);
                MGETS(NINBMIN,P<DRHDRWD>,FALSE); # GET INBOUND BUFFER  #
                NBTFIRST[NBTIX] = P<DRHDRWD>;# SET FIRST POINTER       #
                NBTIN[NBTIX] = P<DRHDRWD>;   # SET IN POINTER          #
                NBTTA[NBTIX] = P<DRHDRWD> + NINBMIN/2;
                NBTOUT[NBTIX] = P<DRHDRWD>;  # SET OUT POINTER         #
                NBTLIMIT[NBTIX] = P<DRHDRWD> + NINBMIN; # SET LIMIT PTR#
                NBTBAF[NBTIX] = TRUE; 
                NBTOF[NBTIX+4] = FALSE;  # CLEAR OFF FLAG              #
                NBTTN[NBTIX+1] = CETTN[INDEX];  # CDCNET FE TERM NODE  #
                NBTCII[NBTIX+1] = NBTIX;     # INITIAL INPUT FET INDEX #
                NBTRJCNT[NBTIX+1] = 0;  # INIT REJECT COUNT            #
                NBTCOFF[NBTIX+1] = NINBMIN/2;  # INIT THRESHOLD OFFSET #
                NBTCSIZE[NBTIX+1] = NINBMIN;  # INIT SIZE OF BUFFER    #
                NBTRTIME[NBTIX+1] = RTSECS[0] + NINBRJTO; #INIT TIMEOUT#
                BLKID[0] = PIBIDVALUE;
 
                CONTROL IFEQ STAT,1;
                ST$NIB = ST$NIB + 1;
                CONTROL FI; 
 
                NBTAF[NBTIX+4] = TRUE;     # SET NPU ACTIVE            #
                NBTMF[NBTIX+4] = TRUE;     # SET NPU INITIAL           #
 
                PITNBTWE[TEMP] = NBTENR + 1;  # NBT ENTRY INDEX        #
                PITNBTWA[TEMP] = NBTEADDR;  # NBT ENTRY ADDRESS        #
                IF PITC[PIPNR]
                THEN         # PIP FOR THIS PIT ENTRY HAS DROPPED OUT  #
                  BEGIN 
                  PIPCALL = TRUE;  # CALL IT BACK INTO PP AGAIN        #
                  PITC[PIPNR] = FALSE;
                  END 
                END 
              ELSE
                # 
                  PIT IS FULL (WINDOW WHEN THIS CAN HAPPEN- 
                  WHERE NAM HAS NOT CLEARED A FREE ENTRY YET )
                # 
                GOTO EXIT;
              END 
            ELSE
              # 
                NBTE IS FULL ( WINDOW WHEN THIS CAN HAPPEN- 
                WHERE NAM HAS NOT CLEARED A FREE ENTRY YET) 
              # 
              GOTO EXIT;
 
            IF PIPCALL
            THEN
              BEGIN 
              ITFUNC = FCDRIVE;    # PIP CALL TYPE                     #
              ITADDR[0] = LOC(PITW0[PIPNR]);  # ADDR OF PIT ENTRY      #
              OSREQ(ITPIP);    # CALL DEDICATED PIP                    #
              PIPCALL = FALSE;
              END 
            CETC2[INDEX] = FALSE; 
            END 
        CETC1[1] = FALSE; 
 
        END 
      ELSE                   # CALL PIP FOR CET CHANGES                #
        BEGIN 
        FOUND = FALSE;                     # FLAG PIP FOR SCAN EST DROP#
        TEMP = 0;                          # ACTIVE PIP ENTRY INDEX    #
# 
        CHECK FOR NEW PIP TO SCAN EST IF OLD PIP DROPPED OUT
        ALSO CLEAR IN USE FLAG FOR PIPS WHICH DROPPED OUT AND RELEASE 
        ANY PRU BUFFERS THEY MAY STILL BE HOLDING.
# 
        FOR INDEX = 1 STEP 1 UNTIL MAXPIP 
        DO
          BEGIN 
          IF PITPUF[INDEX]
          THEN
            BEGIN 
            IF PITC[INDEX]
            THEN             # THIS PIP HAS DROPPED OUT                #
              BEGIN 
              PITPUF[INDEX] = FALSE;  # CLEAR PIT ENTRY IN USE FLAG    #
              PARAMS1 = 1;   # 1 PRU BUFFER SIZE                       #
              PARAMS2 = INDEX;  # PIT ENTRY INDEX                      #
              OVLNAME = NPRLBP;  # NAME OF OVERLAY TO LOAD             #
              OVLCALL;       # LOAD AND EXECUTE OVERLAY                #
              END 
            ELSE             # THIS PIT ENTRY IS STILL IN USE          #
              BEGIN 
              TEMP = INDEX;  # REMEMBER THIS PIP NUMBER                #
              IF PITESF[INDEX]
              THEN
                BEGIN 
                FOUND = TRUE;  # FOUND PIP WHICH IS SCANNING EST       #
                END 
              END 
            END 
          END 
        IF NOT FOUND AND
           TEMP NQ 0
        THEN                 # FOUND NEW PIP TO DO EST SCAN            #
          BEGIN 
          PITESF[TEMP] = TRUE;  # SET SCAN EST FLAG                    #
          END 
        IF CETC[1]
        THEN
          BEGIN 
          CETC[1] = FALSE;
          IF TEMP EQ 0                     # IF NO ACTIVE PIT ENTRY    #
          THEN
            BEGIN 
            ITFUNC[0] = FCSCAN; 
            ITADDR[0] = P<CET> ;
            OSREQ(ITPIP);                  # CALL PIP FOR SCAN EST     #
            END 
          END 
        END 
 
EXIT: 
      GOTO RJMAIN;           # RETURN                                  #
ERRXIT: 
      PARAMS1 = DFMSG01;     # NIP FATAL ERROR PROC = XXXX.            #
      PARAMS6 = PNAME;       # PROC = CCET                             #
      OVLNAME = XERRMSGP; 
      OVLCALL;
      END 
TERM