Retro1.org codex

*DECK KCHANGE 
USETEXT NIPDEF
USETEXT AT
USETEXT KDIS
USETEXT KSTTAB
USETEXT NBT 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
 
 PRGM KCHANGE;               # PROCESS K DISPLAY CHANGE                #
 
 STARTIMS;
 STOPIMS; 
 
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        PROC LOCLLCB;        # LOCATE LOGICAL LINK CONTROL BLOCK       #
        PROC MRELS;          # RELEASE BUFFER                          #
        PROC OVLCALL; 
        PROC XTRACE;         # TRACE CALL                              #
        LABEL RJMAIN; 
        END 
# 
      LOCAL VARIABLES 
# 
      ITEM TYPE;             # STATUS DISPLAY BUFFER TYPE              #
      ITEM INDEX;            # INDUCTION VARIABLE, TABLE INDEX         #
      ITEM J;                # INDUCTION VARIABLE                      #
      ITEM NEXTKWL;          # FWA OF NEXT KWL                         #
 
      SWITCH ST$TYPE:KST     # SWITCH FOR VALID STATUS DISPLAY BUFFER  #
        LB$APP:APP,          # APPLICATION ACB                         #
        LB$EST:EST,          # EST                                     #
        LB$LLK:LLK;          # LOGICAL LINK LLCB                       #
 
      CONTROL EJECT;
 
      BEGIN # KCHANGE # 
 
      P<KWL> = LOC(KWLPTR[0]);
      NEXTKWL = KWL$NEXT[0]; # FWA OF FIRST KWL IN LIST                #
 
      IF KDST[0]
      THEN # IF STATUS DISPLAY IS STILL ON                             #
        BEGIN 
        FOR J=J WHILE KWL$NEXT[0] NQ 0
        DO    # PROCESS ALL KWL ENTRY(S) IN LIST                       #
          BEGIN 
          P<KWL> = KWL$NEXT[0]; # CURRENT KWL ENTRY                    #
          TYPE = KWL$TYPE[0]; # BUFFER TYPE TO ADD/DELETE              #
 
          PARAMS5=FALSE;
          IF KWL$ID[0] EQ KADDIDVALUE 
          THEN # ADD ENTRY TO STATUS DISPLAY                           #
            BEGIN 
            GOTO ST$TYPE[TYPE]; # CASE ON STATUS DISPLAY BUFFER TYPE   #
 
LB$APP:     # COMPUTE ACB ADDRESS                                      #
            INDEX = ATACBA[KWL$AN[0]];
            GOTO LB$CHANGE; 
 
LB$EST:     # COMPUTE NBT ENTRY INDEX                                  #
            FOR INDEX=0 STEP NBTFETNO WHILE NBTHN[INDEX] NQ KWL$HN[0] 
                                            AND INDEX LQ NBTMAXID 
            DO # SEARCH NBT FOR MATCHING COUPLER NODE NUMBER           #
              BEGIN 
              END # INDEX = NBT ENTRY INDEX                            #
            GOTO LB$CHANGE1;
 
LB$LLK:     # COMPUTE LLCB ADDRESS                                     #
            LOCLLCB(KWL$HN[0],KWL$TN[0],INDEX); 
            GOTO LB$CHANGE; 
 
LB$CHANGE:  
            IF INDEX EQ 0 
            THEN # ACB OR LLCB NOT EXISTS                              #
              GOTO LB$END;
LB$CHANGE1: 
            PARAMS1=TYPE; 
            PARAMS2=INDEX;
            OVLNAME=KADDP;
            OVLCALL;
LB$END: 
            END 
 
          ELSE # DELETE ENTRY FROM STATUS DISPLAY                      #
            BEGIN 
            INDEX = KWL$KNDX[0]; # STATUS DISPLAY LINE INDEX           #
            IF INDEX NQ 0 
            THEN # STATUS DISPLAY LINE EXISTS                          #
              BEGIN 
              PARAMS1=TYPE; 
              PARAMS2=INDEX;
              OVLNAME=KDELP;
              OVLCALL;
              END 
            END 
          IF PARAMS5 THEN 
             BEGIN
             OVLNAME=KOVDISP; 
             OVLCALL; 
             END
          END 
        END 
 
      FOR INDEX=INDEX WHILE NEXTKWL NQ 0
      DO # RELEASE ALL KWL ON LIST                                     #
        BEGIN 
        P<KWL> = NEXTKWL; 
        NEXTKWL = KWL$NEXT[0]; # NEXT KWL ENTRY                        #
        MRELS(P<KWL>); # RELEASE KWL                                   #
        END 
      KWLPTR[0] = 0;         # CLEAR KWL POINTER, ALL KWL(S) PROCESSED #
 
      GOTO RJMAIN;
      END # KCHANGE # 
      TERM