Retro1.org codex

*DECK     XEXEC 
USETEXT NIPDEF
USETEXT AT
USETEXT PARAMP
USETEXT BACKBUF 
USETEXT CET 
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT KDIS
USETEXT OVERLAY 
USETEXT PIT 
USETEXT PT
USETEXT LLCB
USETEXT NCNT
USETEXT PCNB
USETEXT NBT 
USETEXT NHEADER 
USETEXT STATTAB 
USETEXT SYSCOMD 
USETEXT SYSTIME 
USETEXT TNT 
USETEXT DBGBUF
 PROC XEXEC;                 # NIP MAIN EXECUTION CONTROL              #
 
 STARTIMS;
 #
 #
 STOPIMS; 
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC HHIR;           # MAIN HOST INTERFACE PROCESSOR           #
        PROC MGETS;          # GET ONE FREE BUFFER                     #
        PROC MRELS;          # FREE ONE BUFFER INTO THE FREE CHAIN     #
        PROC NEIB;           # UPLINE MESSAGE PROCESSOR                #
        PROC NEIB1;          # CONTINUE PROCESSING OF UPLINE MESSAGES  #
        PROC NNETREL;        # RELEASE ZZZZZDN FILE                    #
        PROC OMSG;           # SEND MESSAGE                            #
        PROC OTIME;          # GET SYSTEM TIME                         #
        PROC OVLCALL;        # OVERLAY LOADER                          #
        PROC XRECALL;        # RECALL                                  #
        PROC XSACB;          # PROCESS ACB STATUS CHANGES              #
        PROC XTRACE;         # TRACE CALLS                             #
        END 
 
# 
      LOCAL DEFINITIONS 
# 
      DEF TCET       # 2000 #;  # CHECK CET STATUS CHANGE TIMER IN MS  #
      DEF TPCR       #  5000 #; # XCHKPCR CALL TIMER IN MILLISECONDS   #
      DEF TACBS      #   500 #; # CHECK ACB STATUS CHANGE TIMER IN MS  #
      DEF TRASIZE    # 274   #; # TRACE BUFFER SIZE                    #
      DEF PBTID      # 63    #; # PIP TRACE BUFFER ID                  #
# 
      LOCAL VARIABLES 
# 
      ITEM BUF         ;     # BUFFER FOR INTRAHOST A-A QUEUE          #
      ITEM I          I;     # INDUCTION VARIABLE                      #
      ITEM NBTADR     U;
      ITEM FINISH     B;     # FLAG TO INDICATE FINISHED RELEASING BUF #
      ITEM NEWMS      U=0;   # NEW MILLESECOND TIME                 # 
      ITEM RECALL     B;     # RECALL FLAG                          # 
      ITEM MS         U;     # MILLISECOND CLOCK                       #
      ITEM TIMER$CET  U=0;   # CHECK CET TIMER IN MS                   #
      ITEM TIMER$PCR  U=0;   # XCHKPCR CALL TIMER IN MS                #
      ITEM TIMER$BUF  U=0;   # GARBAGE COLLECTION CALL TIMER IN MS     #
      ITEM TIMER$ACBS U=0;   # CHECK ACB STATUS TIMER IN MS            #
      ITEM TEMP       U;     # TEMPORARY                               #
      ITEM TEMP1      U;     # TEMPORARY                               #
      ITEM TMP        U;     # TEMPORARY                               #
      ITEM TMPFET     U;     # TEMPORARY                               #
 
 
      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; 
 
      ARRAY KZEROS S(1);
        BEGIN                # LINE OF BINARY ZEROES                   #
        ITEM KZEROLINE  U(00,00,60) = [0];
        END 
      ARRAY CNX ; 
        BEGIN 
        ITEM CNE    U(00,00,60) ; 
        ITEM CN1    U(00,52,04) ; 
        ITEM CN2    U(00,56,04) ; 
        END 
 
      CONTROL EJECT;
 
      BEGIN # XEXEC # 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("XEXEC");       # TRACE CALL                              #
      CONTROL FI; 
 
      KDIS$STAT = 0;         # NO STATUS DISPLAY TO FORMAT             #
      OTIME(THETIME);        # GET CURRENT TIME                        #
      MS = MSECS[0];         # SET MILLISECOND CLOCK                   #
      P<DRHDRWD> = 0; 
# 
      PERFORM PERIODIC SERVICES 
# 
      IF TIMER$ACBS LQ MS  OR MSG$AN GR 0 
      THEN
        BEGIN 
 
        CONTROL IFEQ STAT,1;
          OTIME(STIME);      # GET SYSTEM TIME BEFORE XSACB CALL       #
        CONTROL FI; 
 
        IF TIMER$ACBS LQ MS  # SHOULD LOOK AT ALL AN                   #
        THEN
          BEGIN 
          MSG$AN = 0;        # CLEAR MSG$AN SUCH THAT ALL AN ARE CHECK #
          END 
        XSACB;               # PROCESS ACB(S) STATUS CHANGES           #
 
        CONTROL IFEQ STAT,1;
          OTIME(ETIME);      # GET SYSTEM TIME AFTER XSACB CALL        #
          STTEMP = EMILS[0] - SMILS[0]; 
          IF STTEMP GR ST$LXS 
          THEN               # FOUND LARGER TIME INTERVAL              #
            BEGIN 
            ST$LXS = STTEMP; # LARGEST TIME INTERVAL                   #
            END 
          IF STTEMP GR 200
          THEN               # SPENT MORE THAN .2 SECONDS IN INTERVAL  #
            BEGIN 
            ST$MXS = ST$MXS + 1; # INCREMENT NO OF TIMES GREATER .2 SEC#
            END 
          ST$TXS = ST$TXS + STTEMP;  # INCREMENT TOTAL TIME IN INTERVAL#
        CONTROL FI; 
 
        IF MSG$AN EQ 0       # IF ALL TIMER$ACBS HAVE TO BE CHECKED    #
        THEN
          BEGIN 
          TIMER$ACBS = MS + TACBS; # UPDATE TIMER                      #
          END 
        ELSE
          BEGIN 
          MSG$AN = 0;        # CLEAR MESSAGE FOR APPLICATION FLAG      #
          END                # DO NOT UPDATE TIMER$ACBS SO THAT        #
                             # OTHER APPLICATIONS CAN BE CHECKED       #
        IF TIMER$PCR LQ MS
        THEN
          BEGIN              # CHECK CONNECTION INACTIVITY/ K DISPLAY  #
          OVLNAME = XCHKPCRP;# AND RELEASE UNUSED DATA STRUCTURES      #
          OVLCALL;
          TIMER$PCR = MS + TPCR;
          END 
 
        IF (ATENTRYW[NVFAN] NQ 0                ) AND 
           ( ( (TIMER$BUF LQ MS        ) AND
               ( (FRENOFB GR NFBUFF) OR 
                 (FRESFB GR NFSIZE ) OR 
                 (REDUCEFL NQ 0    )   )    ) OR
             (HRL LQ HRLV1                  )   ) 
        THEN # CALL GARBAGE COLLECTION TO PACK FL                      #
          BEGIN 
          COUNTER = COUNTER + 1 ;      # COUNTING FOR PRU BUFFER MOVING#
          PARAMP1 = 0 ;                # ASSUMING NO PRU TO BE MOVED   #
          PRUMOVE = FALSE;             # NOT MOVING FREE PRU BUFFERS   #
          IF COUNTER EQ MGBCLPB 
          THEN
            BEGIN                      # REACH THE LIMIT               #
                                       # SET FROM LIST TO CIRCULAR CHN #
            PRUMOVE = TRUE;            # OKAY TO MOVE FREE PRU BUFFERS #
 
            OVLNAME = MSETPTRP ;
            OVLCALL ; 
            COUNTER = 0 ; 
            END                        # REACH THE LIMIT               #
 
          FLGBGCLT[0] = TRUE;          # GARBAGE COLLECTION IN PROGRESS#
          OVLNAME = MGBGCLTP; 
          OVLCALL;
          FLGBGCLT[0] = FALSE;         # GARBAGE COLLECTION COMPLETED  #
          TIMER$BUF = MS + TBUF;
          END 
 
        IF TIMER$CET LQ MS
          OR CETC[0]         # CET ENTRY(S) STATUS CHANGED             #
        THEN
          BEGIN              # PROCESS CET CHANGE                      #
          OVLNAME = XCHKCETP; 
          OVLCALL;
          TIMER$CET = MS + TCET;
          END 
        END 
 
# 
      CHECK IF PIP NEEDS ADDITIONAL PRU BUFFERS 
# 
      IF PITRPA[0]
      THEN                             # PIP NEEDS ADDITIONAL PRU BUFS #
        BEGIN 
        PITRPA[0] = FALSE;             # CLEAR REQUEST PRU ACTIVITY FLG#
        OVLNAME = XCHKABCP;            # NAME OF OVERLAY TO LOAD       #
        OVLCALL;                       # LOAD AND EXECUTE OVERLAY      #
        END 
 
# 
      RELEASE PIP PROCESSED BUFFERS 
# 
      IF OUTREL 
      THEN                   # OUTBOUND BUFFER(S) TO RELEASE           #
        BEGIN 
        OUTREL = FALSE; 
 
        FOR TMPFET=0 STEP NBTFETNO UNTIL NBTMAXID 
        DO # SCAN THROUGH ALL THE ACTIVE NBT ENTRIES                   #
          BEGIN # TO RELEASE ALL PROCESSED OUTBOUND BUFFERS            #
          IF NBTIUF[TMPFET] 
          THEN # NBT ENTRY IN USE                                      #
            BEGIN 
 
            FOR TMP=TMPFET+2 STEP 1 UNTIL TMPFET+4
            DO # GO THROUGH ALL OUTBOUND FETS                          #
              BEGIN 
              IF NBTOUT[TMP] NQ 0 
              THEN # OUTBOUND BUFFER PROCEESED BY PIP                  #
                BEGIN # CHECK IF BUFFER(S) CAN BE RELEASED             #
                P<DRHDRWD> = NBTFIRST[TMP]; # FIRST BUFFER IN CHAIN    #
 
                FINISH = FALSE; 
                FOR TEMP=TEMP WHILE NOT FINISH
                DO                     # RELEASE BUFS IN OUTBOUND CHAIN#
                  BEGIN 
# 
                  CHECK AND PROCESS SPECIAL BLOCK ID FIRST
# 
                  IF BLKID[0] EQ PRUSPECID
                  THEN
                    BEGIN              # SPECIAL OUTBOUND BLK FOR PCNB #
                    P<NHEADER> = P<DRHDRWD> + BLKHSIZE ;
                    P<PCNB> = NHWORD[0] ; #CAN NOW CONVERT NCNB TO PCNB#
                    CNE[0] = PCNBCN[0] ;
                    # SET BATCH STREAM STATE AND BLOCK HANDLER STATE   #
                    P<NCNT> = PCNBCTAD[0] ; 
                    NCNTBSS[CN2+NCNTHSIZE] = BSSI ; 
                    IF PCNBDT[0] EQ DT$CR 
                       OR ( PCNBXFR[0] # FILE TRANSFER CONN            #
                            AND PCNBREC[0] )           # RECEIVING     #
                    THEN
                      BEGIN 
                      NCNTBHS[CN2+NCNTHSIZE] = BHSPRUI ;  # INPUT PRU  #
                      END 
                    ELSE
                      BEGIN 
                      NCNTBHS[CN2+NCNTHSIZE] = BHSPRUO ; # PRU OUTPUT  #
                      END 
                    PCNBID[0] = PCNBIDVALUE ;   # ID NOW IS PCNB       #
                    BLKID[0] = POBIDVALUE;  # CONVERT TO REGULAR ID    #
                    END 
 
                  TEMP = NEXTPTR[0];   # NEXT BUFFER IN CHIAN          #
                  IF P<DRHDRWD> EQ NBTOUT[TMP]
                  THEN                 # NOT LAST BUFFER IN CHAIN      #
                    BEGIN 
                    FINISH = TRUE;     # COMPLETED RELEASING BUFFERS   #
                    END 
                  ELSE                 # THIS BUFFER CAN BE RELEASED   #
                    BEGIN 
# 
                    CHECK AND PROCESS BACKS BLOCKS FROM BACK TABLE
# 
                    IF (P<DRHDRWD> LS BACKBLWA) AND 
                       (P<DRHDRWD> GQ BACKBFWA) 
                    THEN     # THIS IS BACK ENTRY IN BACK BUF          #
                      BEGIN 
                      P<DRHDRWD> = P<DRHDRWD> - 1;  # HEAD WRD OF ENTRY#
                      CMWORD[0] = BACKFFREE;  # PTR TO NEXT FREE ENTRY #
                      BACKFFREE = P<DRHDRWD>;  # NEW FIRST FREE ENTRY  #
                      END 
                    ELSE     # THIS IS REGULAR DYNAMIC BUFFER          #
                      BEGIN 
                      MRELS(P<DRHDRWD>); # RELEASE BUFFER              #
                      END 
                    P<DRHDRWD> = TEMP; # RESET POINTER                 #
                    END 
                  END 
                NBTFIRST[TMP] = P<DRHDRWD>;  # NEW FIRST BUF IN CHAIN  #
                OUTREL = OUTREL OR (NBTIN[TMP] NQ P<DRHDRWD>);
                              # FLAG MORE OUTSTANDING OUTBOUND BUFFERS #
                END 
              END 
            END 
          END 
        END 
 
      FOR NBTIDX = 0 STEP NBTFETNO WHILE NBTIDX LQ NBTMAXID 
      DO
        BEGIN 
        IF NBTREQ[NBTIDX + 5]  # REQUEST FLAG SET                      #
        THEN
          BEGIN 
          IF NOT NBTACT[NBTIDX + 5]  # ACTIVE FLAG NOT SET             #
          THEN
            BEGIN 
            IF NOT NBTREL[NBTIDX + 5] # RELEASE FLAG NOT SET           #
            THEN
              BEGIN 
              MGETS(TRASIZE,NBTADR,0);  # ALLOCATES BUFFER             #
              P<DRHDRWD> = NBTADR;
              BLKID[0] = PBTID; 
              NBTFIRST[NBTIDX + 5] = NBTADR + BLKHSIZE; 
              NBTWD4[NBTIDX + 5] = NBTADR + TRASIZE;
              NBTACT[NBTIDX + 5] = TRUE;
              END 
            END 
          END 
        END 
 
      IF HRL NQ 0 
      THEN                   # NAM NOT AT MAX FIELD LENGTH             #
        BEGIN 
# 
        PROCESS UPLINE NETWORK MESSAGES 
# 
 
        CONTROL IFEQ STAT,1;
          OTIME(STIME);      # GET SYSTEM TIME BEFORE NEIB CALL        #
        CONTROL FI; 
 
        NEIB;                # PROCESS INCOMING NETWORK TRAFFIC        #
 
        CONTROL IFEQ STAT,1;
          OTIME(ETIME);      # GET SYSTEM TIME AFTER NEIB CALL         #
          STTEMP = EMILS[0] - SMILS[0]; 
          IF STTEMP GR ST$LNI 
          THEN               # FOUND LARGER TIME INTERVAL              #
            BEGIN 
            ST$LNI = STTEMP; # LARGEST TIME INTERVAL                   #
            END 
          IF STTEMP GR 200
          THEN               # SPENT MORE THAN .2 SECONDS IN INTERVAL  #
            BEGIN 
            ST$MNI = ST$MNI + 1; # INCREMENT NO OF TIMES GREATER .2 SEC#
            END 
          ST$TNI = ST$TNI + STTEMP;  # INCREMENT TOTAL TIME IN NEIB    #
        CONTROL FI; 
 
# 
        PROCESS WORKLIST FROM APPLICATION 
# 
        HHIR;                # PROCESS INCOMING APPLICATION WORKLISTS  #
# 
        CHECK IF ANY MESSAGES HAVE BEEN ADDED TO THE INTRAHOST QUEUE
# 
        P<LLCB> = TNTLLAD[0]; 
        IF P<LLCB> NQ 0 
        THEN                 # HOST TO HOST LOGICAL LINK EXISTS        #
          BEGIN 
          P<DRHDRWD> = 0; 
          BUF = LLCBSHFP[0]; # FIRST MSG IN LIST                       #
          FOR I=I WHILE BUF NQ 0
          DO
            BEGIN 
            LLCBSHFP[0] = NEXTPTR[BUF]; # UPDATE FORWARD POINTER       #
            NBTIDX = NBTMAXID + 1;  # NBT INDEX FOR INTRAHOST MSG      #
            NEIB1(BUF,0);    # PROCESS INTRAHOST MESSAGE               #
            BUF = LLCBSHFP[0];
            END 
          END 
 
        END 
# 
      PROCESS NAM BUFFER REGULATION LEVEL CHANGES 
# 
 
      CONTROL IFEQ STAT,1;
        OTIME(STIME);        # GET SYSTEM TIME AT THIS POINT IN PROC   #
      CONTROL FI; 
 
      IF HRL NQ LASTHRL 
      THEN
        BEGIN 
        OVLNAME = XNBRLCP;
        OVLCALL;
        END 
 
# 
      CHECK NAM K DISPLAY ACTIVITY
# 
      IF NOT KDVW[0]
      THEN                   # K DISPLAY NOT BEING VIEWED              #
        BEGIN 
        IF KDLCOMP[0] OR KDRCOMP[0] 
        THEN                 # K DISPLAY ASSIGNED TO NAM               #
          BEGIN 
          OMSG(KZEROS,2); # CLEAR FLASHING REQUEST ON B-DISPLAY        #
          KDALERT[0] = FALSE; # CLEAR OUTSTANDING ALERT FLAG           #
          KDVW[0] = TRUE; # K DISPLAY NOW BEING VIEWED                 #
          KDTIMER[0] = RTSECS[0] + TKDVW; # SET VIEW TIMEOUT TIMER     #
          KDLCOMP[0] = FALSE; 
          KDRCOMP[0] = FALSE; 
          END 
        END 
 
      ELSE                   # K DISPLAY IS BEING VIEWED               #
        BEGIN 
 
        IF KWLPTR[0] NQ 0 
        THEN                 # KWL TO ADD/DELETE ST ENTRY(S)           #
          BEGIN 
          OVLNAME = KCHANGEP; 
          OVLCALL;
          END 
 
        IF KBUF1[0] NQ 0
        THEN                 # K DISPLAY INPUT AVAILABLE               #
          BEGIN 
          OVLNAME = KPTYPINP; # PROCESS K DISPLAY TYPE INS             #
          OVLCALL;
          END 
 
        IF KSHOW[0] THEN
          BEGIN 
          IF KDETAIL[0] THEN
              OVLNAME=KRIGHTDP; 
           ELSE 
              OVLNAME=KRIGHTP;
           OVLCALL; 
           END
 
        IF KDIS$STAT NQ 0 
        THEN                 # STATUS DISPLAY FORMATTING REQUIRED      #
          BEGIN 
          OVLNAME = KDSTINP; # FORMAT STATUS DISPLAY                   #
          OVLCALL;
          END 
        END 
# 
      RELEASE NETWORK TRACE FILE ZZZZZDN IF MC PARAMETER IS 
      SPECIFIED IN NIP-S CONTROL STATEMENT AND MC NUMBER OF 
      TRACE MESSAGES HAS REACHED
# 
      CONTROL IFEQ ZZDN,1;
      IF MC NQ 0
        AND MSGCNT GQ MC
      THEN
        NNETREL(ZNRF1,0); 
      CONTROL FI; 
 
      CONTROL IFEQ STAT,1;             # STATISTICS ON                 #
      ST$LOOP = ST$LOOP + 1;           # INCR NO OF TIMES THROUGH      #
 
        OTIME(ETIME);        # GET SYSTEM TIME AT THIS POINT IN PROC   #
        STTEMP = EMILS[0] - SMILS[0]; 
        IF STTEMP GR ST$LT2 
        THEN                 # FOUND LARGER TIME INTERVAL              #
          BEGIN 
          ST$LT2 = STTEMP;   # NEW LARGEST TIME INTERVAL               #
          END 
        IF STTEMP GR 200
        THEN                 # SPENT MORE THAN .2 SECONDS IN INTERVAL  #
          BEGIN 
          ST$MT2 = ST$MT2 + 1;  # INCREMENT NO OF TIMES GREATER .2 SEC #
          END 
        ST$TT2 = ST$TT2 + STTEMP;  # TOTAL TIME SPEND IN THIS INTERVAL #
        SMILS[0] = EMILS[0]; # BEGINNING TIME FOR NEXT PART OF PROC    #
      CONTROL FI;                      # XEXEC LOOP                    #
 
      IF MSG$AN EQ 0
      THEN                   # NO DATA QUEUED FOR APP TO PROCESS       #
        BEGIN 
# 
        GIVE UP CPU UNTIL SOMETHING TO DO 
# 
        RECALL = TRUE;       # INITIALIZE RECALL FLAG                  #
        FOR MS=MS WHILE RECALL
        DO                   # LOOP UNTIL SOMETHING TO DO              #
          BEGIN 
          IF SSCLK[0] 
          THEN               # SSC WORKLIST HAS BEEN RECEIVED          #
            BEGIN 
            RECALL = FALSE;  # DO NOT WANT TO GO INTO RECALL           #
            END 
          ELSE               # NO SSC WORKLIST HAS BEEN RECEIVED       #
            BEGIN 
            IF PITWORK[0] 
            THEN             # PIP HAS WORK FOR NIP TO DO              #
              BEGIN 
              PITWORK[0] = FALSE;  # CLEAR WORK-FOR-NIP FLAG           #
              RECALL = FALSE;  # DO NOT WANT TO GO INTO RECALL         #
              END 
            ELSE             # GO INTO RECALL FOR SMALLEST TIMEOUT     #
              BEGIN 
              OTIME(THETIME);  # CALL RTIME NOS MACRO                  #
              NEWMS = MSECS[0]; # CURRENT MILLISECOND TIME             #
              IF (NEWMS - TIMER$ACBS) GQ 0
              THEN           # SMALLEST TIMEOUT INVERVAL HAS ELAPSED   #
                BEGIN 
                RECALL = FALSE; # TERMINATE WHILE LOOP                 #
                END 
              ELSE           # OKAY TO GO INTO RECALL                  #
                BEGIN 
                XRECALL(0);  # CALL RECALL NOS MACRO                   #
                END 
              END 
            END 
          END 
        END 
 
      CONTROL IFEQ STAT,1;
        OTIME(ETIME);        # GET SYSTEM TIME AT END OF PROC          #
        STTEMP = EMILS[0] - SMILS[0]; 
        IF STTEMP GR ST$LT3 
        THEN                 # FOUND LARGER TIME INTERVAL              #
          BEGIN 
          ST$LT3 = STTEMP;   # NEW LARGEST TIME INTERVAL               #
          END 
        IF STTEMP GR 500
        THEN                 # SPENT MORE THAN .5 SECONDS IN INTERVAL  #
          BEGIN 
          ST$MT3 = ST$MT3 + 1;  # INCREMENT NO OF TIMES GREATER .5 SEC #
          END 
        ST$TT3 = ST$TT3 + STTEMP;  # INCREMENT TOTAL TIME IN THIS PART #
      CONTROL FI; 
      RETURN; 
      END 
      TERM