Retro1.org codex

*DECK KPTYPIN 
USETEXT NIPDEF
USETEXT PARAMP
USETEXT PARAMS
USETEXT DRHDR 
USETEXT FREETAB 
USETEXT OVERLAY 
USETEXT KDIS
USETEXT DISTAIL 
USETEXT KINITBF 
USETEXT SUPMSG
 PRGM KPTYPIN;               # PROCESS K DISPLAY TYPE INS              #
 STARTIMS;
 #
*1DC  KPTYPIN 
* 
*     1. PROC NAME      AUTHOR            DATE
*        KPTYPIN        A. BEN-ARTZI      81/11/09
* 
*     2. FUNCTIONAL DESCRIPTION.
* 
*        PROCESS ALL OPERATOR TYP-INS TO NAM-S K-DISPLAY
* 
*     3. METHOD USED. 
* 
*        GET THE INPUT KEY-WORD FROM THE TYPE-IN BUFFER. TEST IT AND
*        BRANCH TO THE APPROPRIATE SECTION TO EXECUTE THE COMMAND.
*        WHEN EVER NECESSARY BUILD A DATA BLOCK AND USE BLINK TO SEND IT
*        TO THE APPLICATION.
* 
*        SPECIAL MODULES ARE FOR STATUS DISPLAY AND FOR FL CHANGES. 
* 
*     4. ENTRY PARAMETERS.
*        NONE 
* 
* 
*     5. EXIT PARAMETERS. 
*        PARAMP1 - FLAG TO CALL KDSTIN
* 
* 
*     6. COMDECKS CALLED AND SYMPL TEXT USED. 
* 
*        NIPDEF     OVERLAY    KDIS     DISTAIL 
*        KINITBF     PARAMP     PARAMS
* 
*     7. ROUTINES AND OVERLAYS CALLED.
* 
*        OVLCALL         LOAD AND EXECUTE OVERLAY 
*        OMSG            ISSUE DAYFILE MESSAGE
*        KPCLNUP         OVL K-DISPLAY CLEAN-UP 
*        KAPPMOD         OVL PROCESS K-DISPLAY APPLICATION MODE COMMANDS
*        KAPIGP          OVL PROCESS "AP" AND "IG" COMMANDS 
*        KSTPAGE         OVL PROCESS STATUS DISPLAY PAGING
*        KNAMMOD         OVL PROCESS K-DISPLAY NAM MODE COMMANDS
*        KNAMDFL         OVL PROCESS FIELD LENGTH K-DISPLAY COMMANDS
*        XTRACE          RECORD PROCESSOR CALLS 
* 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS PRIMARY OVERLAY IS CALLED BY XEXEC. 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE PRIMARY 
*CALL OPSIZE
* 
* 
* 
 #
 STOPIMS; 
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC OMSG;           # DAYFILE MESSAGE                         #
        PROC OVLCALL;        # LOAD OVERLAY                            #
        PROC XTRACE;         # TRACE ROUTINE CALL                      #
        LABEL RJMAIN; 
        END 
# 
      LOCAL DEFINITIONS 
# 
      DEF CHAR$COMMA  # "," #;
      DEF CHAR$EQUAL  # "=" #;
      DEF CHAR$PERIOD # "." #;
      DEF CHAR$BLANK  # " " #;
      DEF CHAR$STAR   # "*" #;
      DEF MAX$KDIS    #40 #; # MAX CHARACTERS TO DISPLAY TYPE IN       #
# 
      INTERNAL VARIABLES
# 
      ITEM CHRR;             # SINGLE CHARACTER                        #
      ITEM CNT;              # TOKEN TABLE INDEX                       #
      ITEM COUNT;            # TOKEN CHARACTER COUNT                   #
      ITEM I;                # INDUCTION VARIABLE                      #
      ITEM INDEX;            # INDEX VALUE                             #
      ITEM J;                # INDUCTION VARIABLE                      #
      ITEM KCHARS;           # CHARACTER COUNT OF TYPE-INS             #
      ITEM KRC;              # ERROR REASON CODE FOR TYPE-IN           #
      ITEM TC;               # TOKEN COUNT                             #
 
      DEF L$TOKENTAB # 25#;  # SIZE OF TOKEN TABLE                     #
      ARRAY TOKENTAB [1:L$TOKENTAB] S(1); 
        BEGIN # TABLE OF NAM K DISPLAY COMMAND TOKENS/SEPARATOR        #
        ITEM TT$WORD    C(00,00,10); # WHOLE WORD                      #
        ITEM TT$TOKEN   C(00,00,08); # TOKEN SEPARATOR                 #
        ITEM TT$ATOKEN  C(00,00,07); # TOKEN ONLY                      #
        ITEM TT$SEP     C(00,42,01); # SEPARATOR                       #
        END 
 
      DEF MAX$KINPUT # 4 #; # MAX WORD COUNT - 1 FOR TYPE-IN           #
      BASED ARRAY KDIS$INPUT [0:MAX$KINPUT] S(1); 
        BEGIN 
        ITEM KI$WORD    C(00,00,10); # TYPE-IN WORD                    #
        END 
 
      BASED ARRAY KARRAY [0:0] S(1);
        BEGIN 
        ITEM KAWRD      C(00,00,10);
        END 
 
      DEF MAX$NAMCMDS # 24 #; # MAXIMUM NAM COMMANDS ALLOWED           #
      ARRAY NAMCMDVERB [0:MAX$NAMCMDS] S(1);
        BEGIN                # VALID NAM COMMAND VERB TABLE            #
        ITEM NC$WORD    C(00,00,10); # WHOLE WORD                      #
        ITEM NC$KEYWORD C(00,00,08) = [ # VALID COMMAND KEYWORDS       #
            "ST      ", 
            "AP     =", 
            "AP      ", 
            "END     ", 
            "IG     =", 
            "IG      ", 
            "+       ", 
            "-       ", 
            "*       ", 
            "/       ", 
            "DB     =", 
            "DE     =", 
            "DU     =", 
            "FL     =", 
            "LE     =", 
            "RS     =", 
            "LB     =", 
            "LR     =", 
            "MO     =", 
            "SEND    ", 
            "TB     =", 
            "TE     =", 
            "(       ", 
            "HELP    ", 
            0,
                                      ];
        ITEM NC$TOKENCT U(00,48,06) = [ # TOKEN COUNT ALLOWED FOR CMD  #
            1,2,1,1,2,1,1,1,1,1,2,2,2,2,2,2,2,2,2,3,2,2,1,1,0 
                                      ];
        ITEM NC$CMDORD  S:NCT(00,54,06) = [ # CORR COMMAND ORDINAL     #
            S"CMD$ST",
            S"CMD$AP",
            S"CMD$AP",
            S"CMD$END", 
            S"CMD$IG",
            S"CMD$IG",
            S"CMD$PFORWD",
            S"CMD$PBACK", 
            S"CMD$IGNORE",
            S"CMD$IGNORE",
            S"CMD$DB",
            S"CMD$DE",
            S"CMD$DU",
            S"CMD$FL",
            S"CMD$LE",
            S"CMD$RS",
            S"CMD$LB",
            S"CMD$LR",
            S"CMD$MO",
            S"CMD$SEND",
            S"CMD$TB",
            S"CMD$TE",
            S"CMD$RFORWD",
            S"CMD$HELP",
            S"CMD$ERROR", 
                                           ]; 
        END 
 
      SWITCH NAMCMDCASE:NCT  # SWITCH FOR VALID NAM COMMANDS           #
        LB$ST:CMD$ST, 
        LB$AP:CMD$AP, 
        LB$END:CMD$END, 
        LB$IG:CMD$IG, 
        LB$EXIT:CMD$IGNORE, 
        LB$PF:CMD$PFORWD, 
        LB$PB:CMD$PBACK,
        LB$DB:CMD$DB, 
        LB$DE:CMD$DE, 
        LB$DU:CMD$DU, 
        LB$LE:CMD$LE, 
        LB$RS:CMD$RS, 
        LB$LB:CMD$LB, 
        LB$LR:CMD$LR, 
        LB$FL:CMD$FL, 
        LB$MO:CMD$MO, 
        LB$SEND:CMD$SEND, 
        LB$TB:CMD$TB, 
        LB$TE:CMD$TE, 
        LB$RPF:CMD$RFORWD,
        LB$HELP:CMD$HELP, 
        LB$ERR:CMD$ERROR; 
 
      CONTROL EJECT;
 
      BEGIN # KPTYPIN # 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("KPTYP");       # TRACE CALL                              #
      CONTROL FI; 
 
      PARAMP1 = 0;
      KREPEAT[0] = CHAR$BLANK;
      KRC = 0;
# 
      COMPUTE CHARACTER COUNT OF K DISPLAY TYPE-IN
# 
      P<KDIS$INPUT> = LOC(KBUF1[0]); # FWA OF TYPE-IN                  #
      FOR I=MAX$KINPUT STEP -1 WHILE I GQ 0 
                               AND KI$WORD[I] EQ 0
      DO                     # GET LAST WORD OF TYPE-IN                #
        BEGIN 
        END 
      FOR J=0 STEP 1 WHILE J LS WC
                     AND B<J*CL,CL>KI$WORD[I] NQ 0
      DO                     # GET LAST CHARACTER OF TYPE-IN           #
        BEGIN 
        END 
      KCHARS = I*10 + J; # CHARACTER COUNT OF TYPE-IN                  #
# 
      DISPLAY K DISPLAY TYPE INS
# 
      P<KARRAY> = LOC(KBFD1[0]); # FWA OF DISPLAY                      #
      FOR I=0 STEP 1 UNTIL 3
      DO                      # BLANK-FILL DISPLAY BUFFER              #
         KAWRD[I] = CHAR$BLANK; 
      FOR I=0 STEP 1 WHILE I LS KCHARS
                     AND I LS MAX$KDIS
      DO # DISPLAY UP TO 40 CHARACTERS OF TYPE-INS                     #
        BEGIN 
        INDEX = I/10;        # WORD INDEX                              #
        J = I-INDEX*10; 
        C<J>KAWRD[INDEX] = C<J>KI$WORD[INDEX];
        END 
# 
      APPLCATION MODE PROCESSING
# 
      IF KDAM[0]
      THEN
        BEGIN 
        IF C<0>KBUF[0] EQ CHAR$STAR 
          AND (KCHARS EQ 1
          OR (KCHARS EQ 2 
          AND C<1>KBUF[0] EQ CHAR$PERIOD))
        THEN # TERMINATE APPLCATION MODE                               #
          OVLNAME = KPCLNUPP; 
        ELSE # PROCESS APPLICATION K DISPLAY COMMAND                   #
          BEGIN 
          PARAMS1 = KCHARS; # CHARACTER COUNT OF COMMAND               #
          OVLNAME = KAPPMODP; 
          END 
        OVLCALL;
        END 
# 
      NAM MODE PROCESSING 
# 
      ELSE
        BEGIN 
        IF KDORIG[0] THEN  # FIND THE ORIGINAL BUFFER (HAS ERROR LINE) #
           P<KINITBF> = KDBP[0];
        ELSE
           P<KINITBF> = KORIGFP[0]; 
        P<KINITBF>=P<KINITBF>+BLKHSIZE+KHDRSIZE;
        CNT = KLSIZE-KERRL-2; 
        KERROR1[CNT] = CHAR$BLANK;
        KERROR1[CNT+1] = CHAR$BLANK;
        KERROR1[CNT+2] = CHAR$BLANK;
        KERROR1[CNT+3] = CHAR$BLANK;
        KERROR2[CNT+4] = CHAR$BLANK;
        KREADY[KLSIZE-2] = CHAR$BLANK; # CLEAR READY.. PROMPT         # 
        P<KARRAY> = LOC(KDMES); # FWA OF TYPE IN COMMAND               #
        OMSG(KARRAY,0); # LOG IN NETWORK LOG FILE - NIP DAYFILE        #
# 
        TOKENIZE K DISPLAY TYPE INS 
# 
        TC = 0;              # INITIALIZE TOKEN COUNT                  #
        CNT = 1;             # INITIALIZE TOKEN TABLE INDEX            #
        COUNT = 0;           # INITIALIZE CHARACTER COUNT OF TOKEN     #
 
        FOR I=1 STEP 1 UNTIL L$TOKENTAB 
        DO                   # INITIALIZE TOKEN TABLE                  #
          TT$WORD[I] = CHAR$BLANK; # BLANK-FILLED                      #
 
        FOR I=0 STEP 1 WHILE I LS KCHARS
                       AND KRC EQ 0 # NO ERROR OCCURRED                #
        DO # UNPACK COMMAND TEXT INTO TOKENS/SEPARATOR                 #
          BEGIN 
          INDEX = I/10; # WORD INDEX OF COMMAND TEXT                   #
          J = I - INDEX*10; # CHARACTER POSITION                       #
          CHRR = C<J>KI$WORD[INDEX]; # CURRENT CHARACTER               #
 
          IF CHRR EQ CHAR$COMMA 
            OR CHRR EQ CHAR$EQUAL 
          THEN # LEGAL SEPARATOR                                       #
            BEGIN 
            IF TT$WORD[CNT] NQ CHAR$BLANK 
            THEN # TOKEN EXISTS                                        #
              BEGIN 
              IF CHRR EQ CHAR$EQUAL 
              THEN # STORE EQUAL ONLY IN TOKEN TABLE                   #
                TT$SEP[CNT] = CHAR$EQUAL; 
              COUNT = 0; # RESET TOKEN CHARACTER COUNT                 #
              CNT = CNT + 1; # INCREMENT TOKEN TABLE INDEX             #
              TC = TC + 1; # INCREMENT TOKEN COUNT                     #
              END 
            ELSE # TWO SEPARATORS IN A ROW, ERROR                      #
              KRC = 4;  # SYNTAX ERROR, UNRECOGNIZED COMMAND           #
            END 
 
          ELSE
            BEGIN 
            IF CHRR EQ CHAR$PERIOD
            THEN # ITS A PERIOD - TERMINATOR                           #
              I = KCHARS; # TERMINATE UNPACKING COMMAND                #
            ELSE # ASSEMBLE CHARACTER INTO TOKEN                       #
              BEGIN 
              IF CNT LQ L$TOKENTAB
              THEN # COMMAND WITHIN TOKEN TABLE SIZE                   #
                BEGIN 
                C<COUNT>TT$WORD[CNT] = CHRR;
                COUNT = COUNT + 1; # INCREMENT TOKEN CHARACTER COUNT   #
                IF COUNT GQ 10
                THEN # RESUME TOKEN ASSEMBLY IN NEXT WORD              #
                  BEGIN 
                  COUNT = 0;
                  CNT = CNT + 1;
                  END 
                END 
              END 
            END 
          END # END FOR LOOP #
 
        IF KRC EQ 0 
        THEN                 # NO ERROR OCCURRED                       #
# 
        RECOGNIZE NAM K DISPLAY COMMAND 
# 
          BEGIN 
          TC = TC + 1; # TOKEN COUNT                                   #
          NC$TOKENCT[MAX$NAMCMDS] = TC; # FORCE TOKEN COUNT MATCH      #
          NC$KEYWORD[MAX$NAMCMDS] = TT$TOKEN[1]; # FORCE KEYWORD MATCH #
          FOR I=0 STEP 1 WHILE NC$KEYWORD[I] NQ TT$TOKEN[1] 
          DO                 # NO KEYWORD MATCH                        #
            BEGIN 
            END 
          INDEX = NC$CMDORD[I]; # COMMAND ORDINAL                      #
          IF TC NQ NC$TOKENCT[I]
          THEN # TOKEN COUNT MISMATCH                                  #
            KRC = 4;  # SYNTAX ERROR, UNRECOGNIZED COMMAND             #
          ELSE # SYNTAX CHECK OK                                       #
            BEGIN 
            IF HRL EQ 0 
              AND INDEX NQ NCT"CMD$FL"
              AND INDEX NQ NCT"CMD$DU"
            THEN # ONLY FL COMMAND IS ALLOWED IN MAX FL                #
              KRC = 6;
            END 
          END 
# 
        SWITCH ON COMMAND ORDINAL TO PROCESS COMMAND
# 
        IF KRC EQ 0 
        THEN
          BEGIN 
 
          GOTO NAMCMDCASE[INDEX]; 
      CONTROL EJECT;
 
LB$ST:                       # PROCESS ST - NAM STATUS COMMAND         #
      IF NOT KDST[0]
      THEN # STATUS DISPLAY CURRENTLY NOT ON                           #
        KDIS$STAT = STM"STM$CREATE"; # BUILD STATUS DISPLAY            #
      GOTO LB$EXIT; 
 
LB$AP:                       # PROCESS AP COMMAND                      #
      PARAMS2 = 0;
      PARAMS6 = TT$WORD[2]; # APPLICATIONS NAME                        #
      OVLNAME = KAPIGPP;
      OVLCALL;
      KRC = PARAMS7;        # COMMAND ERROR CODE                       #
      IF KRC EQ 0 
      THEN
        BEGIN 
        OVLNAME = KPCLNUPP; 
        OVLCALL;
        KDAPNM[0] = PARAMS6;
        KDAN[0] = PARAMS4;
        KSHOW[0]=FALSE; 
        KDAM[0] = TRUE; 
        KDNI[0] = TRUE; 
        KDBK[0] = FALSE;
        END 
      GOTO LB$EXIT; 
 
LB$END:                      # PROCESS END COMMAND                     #
      OVLNAME = KPCLNUPP; 
      OVLCALL;
      GOTO LB$EXIT; 
 
LB$IG:                       # PROCESS IG COMMAND                      #
      PARAMS2 = 1;
      PARAMS6 = TT$WORD[2]; 
      OVLNAME = KAPIGPP;
      OVLCALL;
      KRC = PARAMS7;
      GOTO LB$EXIT; 
 
LB$DB:                       # PROCESS DB COMMAND                      #
LB$DE:                       # PROCESS DE COMMAND                      #
LB$DU:                       # PROCESS DU COMMAND                      #
LB$LE:                       # PROCESS LE COMMAND                      #
LB$RS:                       # PROCESS RS COMMAND                      #
LB$LB:                       # PROCESS LB COMMAND                      #
LB$LR:                       # PROCESS LR COMMAND                      #
      PARAMS3 = INDEX; # COMMAND ORDINAL                               #
      PARAMS6 = TT$WORD[2];  # APPLICATION NAME/ALL/NAM                #
      IF PARAMS6 EQ "NAM" OR PARAMS6 EQ "ALL" 
      THEN
        BEGIN 
        OVLNAME = KNAMCOMP;  # PROCESS NAM K-DISPLAY COMMAND           #
        OVLCALL;
        END 
      IF PARAMS6 NQ "NAM" 
      THEN
        BEGIN 
        OVLNAME = KNAMMODP;  # PROCESS APPL K-DISPLAY COMMAND          #
        OVLCALL;
        END 
      KRC = PARAMS7;
      GOTO LB$EXIT; 
 
LB$FL:                       # PROCESS FL COMMAND                      #
      PARAMS6 = TT$WORD[2];  # FL VALUE                                #
      OVLNAME = KNAMDFLP; 
      OVLCALL;
      KRC = PARAMS7;
      GOTO LB$EXIT; 
 
LB$MO:                       # PROCESS MO COMMAND                      #
      IF TT$WORD[2] EQ "FAST" 
      THEN
        BEGIN 
        KFAST[0] = TRUE; # SET STATUS DISPLAY TO REAL TIME UPDATE      #
        IF KDST[0]
        THEN # STATUS DISPLAY IS ON, UPDATE DISPLAY FIRST              #
          KDIS$STAT = STM"STM$UPDATE";
        END 
      ELSE
        BEGIN 
        IF TT$WORD[2] EQ "SLOW" 
        THEN
          KFAST[0] = FALSE; 
        ELSE
          KRC = 4;
        END 
      KDIS$RT = KDST[0] AND KFAST[0]; 
      GOTO LB$EXIT; 
 
LB$SEND:                     # PROCESS SEND COMMAND                    #
      PARAMS6 = TT$WORD[2]; # DETERMINE DESTINATION NODE NUMBER        #
      PARAMS2 = LOC(TT$WORD[3]); # FWA OF HOP MESSAGE TEXT             #
      OVLNAME = KSENDHMP; 
      OVLCALL;
      KRC = PARAMS7; # RETURN CODE                                     #
      GOTO LB$EXIT; 
 
LB$TB:                       # PROCESS PIP TRACING ON COMMAND          #
LB$TE:                       # PROCESS PIP TRACING OFF COMMAND         #
      KRC = 4;               # PIP TRACE OPTION NOT AVAILABLE          #
      GOTO LB$EXIT; 
 
LB$PF:                      # PROCESS STATUS PAGE FORWARD              #
      IF KDST[0]THEN        # PERFORM FORWARD PAGE OPERATION           #
         BEGIN
         PARAMS1 = 1;       # SET PARAMETER FOR PAGE FORWARD           #
         OVLNAME = KSTPAGEP;
         OVLCALL; 
         END
 
      GOTO LB$EXIT; 
 
 
LB$PB:                      # PROCESS STATUS PAGE BACKWARD             #
      IF KDST[0] THEN       # PERFORM BACKWARD PAGE OPERATION          #
         BEGIN
         PARAMS1 = 2;       # SET PARAMETER FOR PAGE BACKWARD          #
         OVLNAME = KSTPAGEP;
         OVLCALL; 
         END
 
      GOTO LB$EXIT; 
 
LB$RPF: 
      KSHOW[0]=TRUE;
      GOTO LB$EXIT; 
 
LB$HELP:  
      IF NOT KDETAIL[0] THEN
         BEGIN
         KDETAIL[0]=TRUE; 
         KDRNXT[0]=1; 
         KSHOW[0]=TRUE; 
         END
      GOTO LB$EXIT; 
 
LB$ERR:                      # PROCESS TYPE IN ERROR                   #
      KRC = 4;
      GOTO LB$EXIT; 
 
LB$IGNORE:                   # IGNORE TYPE IN                          #
LB$EXIT:  
          END # END NAM K DISPLAY COMMAND SWITCH                       #
 
        IF KRC NQ 0 
        THEN
          BEGIN # ISSUE DIAGNOSTIC TO K DISPLAY                        #
          IF KDST[0] # RELEASE STATUS DISPLAY TO ISSUE ERROR MSG       #
          THEN
             BEGIN
             OVLNAME = KPCLNUPP;
             OVLCALL; 
             END
          PARAMS1 = KRC;
          OVLNAME = KDISRCP;
          OVLCALL;
          END 
        END # END NAM MODE PROCESSING                                  #
 
      KBUF1[0] = 0; 
      GOTO RJMAIN;
 
      END # KPTYPIN # 
 
      TERM