Retro1.org codex

*DECK KPTRACE 
USETEXT NIPDEF
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT NBT 
USETEXT PARAMS
 
 PRGM KPTRACE;               # PROCESS PIP TRACE K DISPLAY COMMANDS    #
 
 STARTIMS;
 STOPIMS; 
 
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        PROC MGETS;          # GET A BUFFER                            #
        PROC XTRACE;         # TRACE CALL                              #
        LABEL RJMAIN; 
        END 
# 
      LOCAL DEFINITIONS 
# 
      DEF PTBSIZE   #1001#;  # PIP TRACE BUFFER SIZE                   #
      DEF PTBID     #63#;    # PIP TRACE BUFFER ID                     #
      DEF PTBFETI   #5#;     # PIP TRACE BUFFER NBT FET INDEX          #
# 
      LOCAL VARIABLES 
# 
      ITEM FOUND B;          # NBT ENTRY FOUND INDICATOR               #
      ITEM I I;              # FOR LOOP INDEX                          #
      ITEM KRC U;            # ERROR RETURN CODE                       #
      ITEM HNODE U;          # HOST NODE NUMBER                        #
      ITEM TEMP U;           # TEMPORARY                               #
 
      CONTROL EJECT;
 
      BEGIN # KPTRACE # 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("KPIPT");       # TRACE CALL                              #
      CONTROL FI; 
 
      KRC = 0;               # INITIALIZE RETURN CODE                  #
      HNODE = 0;             # INITIALIZE HOST NODE NUMBER             #
 
      FOR I=0 STEP 1 WHILE I LS WC
                       AND KRC EQ 0 
                       AND C<I>PARAMS6 NQ " " 
      DO                     # CONVERT HOST NODE TO BINARY             #
        BEGIN 
        TEMP = C<I>PARAMS6;  # ONE DIGIT                               #
        IF TEMP GQ "0"
          AND TEMP LQ "9" 
        THEN                 # ALLOW ONLY DECIMAL VALUE                #
          HNODE = HNODE*10 + (TEMP-O"33");
        ELSE                 # ERROR, MUST BE IN DECIMAL               #
          KRC = 12;          # UNKNOWN HOST NODE                       #
        END 
 
      IF KRC EQ 0 
      THEN                   # GOOD HOST NODE ENTERED                  #
        BEGIN                # LOCATE NBT FOR INDICATED HOST NODE      #
        FOUND = FALSE;
 
        FOR I=0 STEP NBTFETNO WHILE NOT FOUND 
                                    AND I LQ NBTMAXID 
        DO                   # SEARCH NBT FOR MATCHING HOST NODE       #
          BEGIN 
          IF NBTIUF[I]
            AND NBTHN[I] EQ HNODE 
          THEN               # FOUND MATCH                             #
            BEGIN 
            FOUND = TRUE; 
 
            IF PARAMS8 # TRACE OPTION IS TURNED ON                     #
              AND NBTFIRST[I+PTBFETI] EQ 0 # NO TRACE BUFFER           #
            THEN
              BEGIN # ALLOCATE A PIP TRACE BUFFER                      #
              IF HRL LS HRLV3 
              THEN # NAM IN BUFFER REGULATION, NO PIP TRACE ALLOWED    #
                KRC = 11; # DAYFILE PIP TRACE OPTION NOT AVAILABLE     #
 
              ELSE # BUFFER OK, ALLOCATE PIP TRACE BUFFER              #
                BEGIN 
                MGETS(PTBSIZE,P<DRHDRWD>,FALSE);
                BLKID[0] = PTBID; # SET PTB BUFFER ID                  #
                BLKBS[0] = PTBSIZE; # SET PTB BUFFER SIZE              #
                NEXTPTR[0] = I+PTBFETI; # NBT PTB FET INDEX            #
                NBTFIRST[I+PTBFETI] = P<DRHDRWD>+BLKHSIZE;
                NBTIN[I+PTBFETI] = P<DRHDRWD>+BLKHSIZE; 
                NBTOUT[I+PTBFETI] = P<DRHDRWD>+BLKHSIZE;
                NBTLIMIT[I+PTBFETI] = P<DRHDRWD>+PTBSIZE; 
                END 
              END 
 
            NBTPIPTF[I+PTBFETI] = PARAMS8; # SET SELECTED TRACE OPTION #
            END 
          END # END FOR LOOP #
 
        IF NOT FOUND
        THEN                 # INDICATED HOST NODE NOT FOUND           #
          KRC = 12; 
        END 
 
      PARAMS7 = KRC;         # SET RETURN CODE                         #
      GOTO RJMAIN;
      END # KPTRACE # 
      TERM