Retro1.org codex

*DECK DLDIRC1 
USETEXT DLFPDEF 
USETEXT DIERR 
USETEXT DIRTBL
USETEXT VDDIR 
PROC DLDIRC1(LEFTSYM, ERRCODE);# INDIVIDUAL DIRECTIVE PROCESSOR        #
*IF DEF,IMS 
 #
*1DC  DLDIRC1 
* 
*     1.PROC NAME            AUTHOR              DATE.
*       DLDIRC1              P.C.TAM             78/11/10 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        INDIVIDUAL DIRECTIVE PROCESSOR 
* 
*     3. METHOD USED. 
*        MATCH INPUT AGAINST VALID DIRECTIVE LIST,
*        GET ITS MATCH AND PROCEED TO PROCESS INPUT 
* 
*     4. ENTRY PARAMETER. 
*        LEFTSYM             DIRECTIVE ITEM ASSEMBLED 
* 
*     5. EXIT PARAMETER.
*        ERRCODE             RETURN IF ERROR ENCOUNTERED
*                            DURING PROCESSING
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        DIERR     DIRTBL    DLFPDEF   VDDIR
* 
*     7. ROUTINES CALLED. 
*        DLCKDA              CHECK DATE FOR ERROR 
*        DLCKTI              CHECK TIME FOR ERROR 
*        DLCONVH             CONVERT HEX TO BINARY
*        DLCONVT             CONVERT DECIMAL TO BINARY
* 
*     8. DAYFILE MESSAGES.
*        NONE.
* 
 #
*ENDIF
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC DLCKDA;         # CHECK DATE FOR ERROR                    #
        PROC DLCKTI;         # CHECK CLOCK TIME FOR ERROR              #
        PROC DLCONVH;        # CONVERT DISPLAY HEXADECIMAL TO BINARY   #
        PROC DLCONVT;        # CONVERT DISPLAY DECIMAL TO BINARY       #
        END 
# 
      LOCAL VARIABLES 
# 
      SWITCH DIRTYPE
              , L$BD, L$BT, L$CN, L$DN, L$ED, L$ET, L$LE, 
             L$NM, L$PS, L$PF, L$SM, L$SN,
             L$B, L$C, L$E, L$F, L$N, 
             L$P, L$R, L$T, L$U, L$X; 
      ITEM
      LEFTSYM    I,          # INPUT ASSEMBLED DIRECTIVE ITEM          #
      ERRCODE    I,          # OUTPUT ERROR CODE IF ANY                #
      CHART      I,          # TEMPORARY VARIABLE                      #
      LENGTH     I,          # TEMPORARY VARIABLE.                     #
      MATCH      B,          # TEMPORARY VARIABLE                      #
      I          I,          # TEMPORARY LOOP VARIABLE                 #
      K          I,          # TEMPORARY VARIABLE                      #
      UNPWD      I,          # TEMPORARY VARIABLE                      #
      UNPTR      I;          # TEPORARY VARIABLE                       #
 
# ******************************************************************** #
      BEGIN 
 
#     PRESET LOCAL VARIABLES                                           #
 
      ERRCODE = 0;
      MATCH = FALSE;
 
#     LOOP TO MATCH INPUT WITH VALID DIRECTIVES                        #
 
      FOR I = 1 STEP 1 WHILE I LQ DIRNO AND NOT MATCH 
      DO
        BEGIN                # LOOP TO FIND A MATCH                    #
        K = VDLEN[I];        # LENGTH OF DIRECTIVE KEYWORD             #
        IF C<0, K>LEFTSYM EQ C<0, K>VDENTR[I] 
        THEN
          BEGIN 
          MATCH = TRUE; 
          K = I;
          END 
        END 
      IF NOT MATCH
      THEN
        BEGIN                # ILLEGAL DIRECTIVE                       #
        ERRCODE = D$ERR3; 
        END 
      ELSE
        BEGIN                # MATCH FOUND                             #
 
#       GET VALUE OF DIRECTIVE EXPRESSION IF ANY                       #
 
        I = VDLEN[K];        # LENGTH OF DIRECTIVE                     #
        UNPWD = 0;
        UNPTR = 10 - I; 
        C<0, UNPTR>UNPWD = C<I, UNPTR>LEFTSYM;
 
#       SWITCH TO PROCESS DIFFERENT DIRECTIVES                         #
 
        GOTO DIRTYPE[K];
 
L$BD:                        # BD= DIRECTIVE                           #
        DLCKDA(UNPWD, K);    # CHECK DATE STRING                       #
        IF K EQ 0 
        THEN
          BEGIN              # SET SELECTION VALUE                     #
          DIRVALU[ID$BD] = LEFTSYM; 
          DIRID[ID$BD] = ID$BD; 
          END 
        ELSE                 # ERROR IN BD= DIRECTIVE                  #
          ERRCODE = D$BDER; 
        GOTO ENDP;
 
L$BT:                        # BT= DIRECTIVE                           #
        DLCKTI(UNPWD, K);    # CHECK TIME FOR ERROR                    #
        IF K EQ 0 
        THEN
          BEGIN              # SET SELECTION VALUE                     #
          DIRVALU[ID$BT] = LEFTSYM; 
          DIRID[ID$BT] = ID$BT; 
          END 
        ELSE                 # ERROR IN BT= DIRECTIVE                  #
          ERRCODE = D$BTER; 
        GOTO ENDP;
 
L$CN:                        # CN= DIRECTIVE                           #
        DLCONVT(UNPWD, K, MATCH);# CONVERT DECIMAL DC TO BIN           #
        IF MATCH AND         # NUMERIC FIELD                           #
           MINCN LQ K AND K LQ MAXCN AND# CN WITH RANGE                #
           C<I, 1> LEFTSYM NQ 0# CONNECTION NUMBER PRESENTS            #
        THEN
          BEGIN 
          DIRVALU[ID$CN] = K;    # SET CONNECTION NUMBER SELECTED      #
          DIRID[ID$CN] = ID$CN;  # SET ID FIELD                        #
          END 
        ELSE                 # ERROR IN CN= DIRECTIVE                  #
          BEGIN 
          ERRCODE = D$CNER; 
          END 
        GOTO ENDP;
 
L$DN:                        # DN= DIRECTIVE                           #
      DLCONVT(UNPWD, K, MATCH);# CONVERT DECIMAL DC TO BINARY          #
      IF MATCH AND           # FIELD NUMERIC                           #
         C<I, 1> LEFTSYM NQ 0# DESTINATION NUMBER PRESENT              #
      THEN
        BEGIN                # SET DIRECTIVE VALUE                     #
        DIRVALU[ID$DN] = K; 
        DIRID[ID$DN] = ID$DN; 
        END 
      ELSE                   # ERROR IN DN= DIRECTIVE                  #
        ERRCODE = D$DNER; # ERROR IN DN= DIRECTIVE                     #
      GOTO ENDP;
 
L$ED:                        # ED= DIRECTIVE                           #
      DLCKDA(UNPWD, K);      # CHECK DATE STRING                       #
      IF K EQ 0 
      THEN
        BEGIN                # SET SELECTION VALUE                     #
        DIRVALU[ID$ED] = LEFTSYM; 
        DIRID[ID$ED] = ID$ED; 
        END 
      ELSE                   # ERROR IN ED= DIRECTIVE                  #
       ERRCODE = D$EDER;
      GOTO ENDP;
 
L$ET:                        # ET= DIRECTIVE                           #
      DLCKTI(UNPWD, K);      # CHECK TIME FOR ERROR                    #
      IF K EQ 0 
      THEN
        BEGIN                # SET SELECTION VALUE                     #
        DIRVALU[ID$ET] = LEFTSYM; 
        DIRID[ID$ET] = ID$ET; 
        END 
      ELSE                   # ERROR IN ET= DIRECTIVE                  #
        ERRCODE = D$ETER; 
      GOTO ENDP;
 
L$LE:                        # LE= DIRECTIVE                           #
      DLCONVT(UNPWD, K, MATCH);# CONVERT DECIMAL DC TO BINARY          #
      IF MATCH AND           # NUMERIC VALUE                           #
         C<I, 1> LEFTSYM NQ 0 AND# VALUE PRESENT                       #
         1 LQ K AND K LQ TLWMAX  # LENGTH WITHIN RANGE                 #
      THEN
        BEGIN                # SET SELECTION VALUE                     #
        DIRVALU[ID$LE] = K; 
        DIRID[ID$LE] = ID$LE; 
        END 
      ELSE                   # ERROR IN LE= DIRECTIVE                  #
        BEGIN 
        ERRCODE = D$LEER; 
        END 
      GOTO ENDP;
 
L$NM:                        # NM= DIRECTIVE                           #
      DLCONVT(UNPWD, K, MATCH);# CONVERT DECIMAL DC TO BINARY          #
      IF MATCH AND           # NUMERIC FIELD                           #
         C<I, 1> LEFTSYM NQ 0 AND  # VALUE PRESENT                     #
         (0 LQ K AND K LQ 1000000) # RANGE 0 TO 1000000                #
      THEN
        BEGIN                # SET SELECTION VALUE                     #
        DIRVALU[ID$NM] = K; 
        DIRID[ID$NM] = ID$NM; 
        END 
      ELSE                   # ERROR IN NM= DIRECTIVE                  #
        BEGIN 
        ERRCODE = D$NMER; 
        END 
      GOTO ENDP;
 
L$PS:                        # PS= DIRECTIVE                           #
      DLCONVH(UNPWD,K,CHART,LENGTH);   # CONVERT HEX DC TO BINARY.     #
      IF CHART EQ 0 AND LENGTH EQ 4    # CONVERSION OK.                #
      THEN
        BEGIN 
        DIRVALU[ID$PS] = K; 
        DIRID[ID$PS] = ID$PS; 
        DIRWD0[ID$PF] = 0;
        END 
      ELSE                   # ERROR IN PS= DIRECTIVE                  #
        ERRCODE = D$PSER; 
      GOTO ENDP;
 
L$PF:                        # PF= DIRECTIVE                           #
      DLCONVH(UNPWD,K,CHART,LENGTH);   # CONVERT HEX DC TO BINARY.     #
      IF CHART EQ 0 AND LENGTH EQ 2    # CONVERSION OK.                #
      THEN
        BEGIN 
        DIRVALU[ID$PF] = K; 
        DIRID[ID$PF] = ID$PF; 
        DIRWD0[ID$PS] = 0;
        END 
      ELSE                   # ERROR IN PF= DIRECTIVE                  #
        ERRCODE = D$PFER; 
      GOTO ENDP;
 
L$SM:                        # SM= DIRECTIVE                           #
      DLCONVT(UNPWD, K, MATCH);# CONVERT DECIMAL DC TO BINARY          #
      IF MATCH AND           # SUPPRESS MESSAGE NUMBER NUMERIC         #
         C<I, 1> LEFTSYM NQ 0 AND  # VALUE PRESENT                     #
         (0 LQ K AND K LQ 1000000) # RANGE 0 TO 1000000                #
      THEN
        BEGIN 
        DIRVALU[ID$SM] = K; 
        DIRID[ID$SM] = ID$SM; 
        END 
      ELSE                   # ERROR IN SM= DIRECTIVE                  #
        BEGIN 
        ERRCODE = D$SMER; 
        END 
      GOTO ENDP;
 
L$SN:                        # SN= DIRECTIVE                           #
      DLCONVT(UNPWD, K, MATCH);# CONVERT DECIMAL DC TO BINARY          #
      IF MATCH AND           # SOURCE NUMBER NUMERIC                   #
         C<I,1>LEFTSYM NQ 0  # NUMBER PRESENT                          #
      THEN
        BEGIN                # SET DIRECTIVE VALUE                     #
        DIRVALU[ID$SN] = K; 
        DIRID[ID$SN] = ID$SN; 
        END 
      ELSE                   # ERROR IN SN= DIRECTIVE                  #
        ERRCODE = D$SNER; 
      GOTO ENDP;
 
L$B:                         # B DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID B DIRECTIVE                       #
      THEN
        BEGIN                # SET B DIRECTIVE SELECTED                #
        DIRVALU[ID$B] = 1;
        DIRID[ID$B] = ID$B; 
        END 
      ELSE                   # ERROR IN B DIRECTIVE                    #
        ERRCODE = D$BERR; 
      GOTO ENDP;
 
L$C:                         # C DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID C DIRECTIVE                       #
        THEN
          BEGIN              # SET C DIRECTIVE SELECTED                #
          DIRVALU[ID$C] = 1;
          DIRID[ID$C] = ID$C; 
          END 
        ELSE                 # ERROR IN C DIRECTIVE                    #
          ERRCODE = D$CERR; 
        GOTO ENDP;
 
L$E:                         # E DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID E DIRECTIVE                       #
        THEN
          BEGIN              # SET E DIRECTIVE SELECTED                #
          DIRVALU[ID$E] = 1;
          DIRID[ID$E] = ID$E; 
          END 
        ELSE                 # ERROR IN E DIRECTIVE                    #
          ERRCODE = D$EERR; 
        GOTO ENDP;
 
L$F:                         # F DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID F DIRECTIVE                       #
      THEN
        BEGIN                # SET F DIRECTIVE SELECTED                #
        DIRVALU[ID$F] = 1;
        DIRID[ID$F] = ID$F; 
        END 
      ELSE                   # ERROR IN F DIRECTIVE                    #
        ERRCODE = D$FERR; 
      GOTO ENDP;
 
L$N:                         # N DIRECTIVE                             #
      IF C<I>LEFTSYM EQ 0    # VALID N DIRECTIVE                       #
      THEN
        BEGIN                # SET N DIRECTIVE SELECTED                #
        DIRVALU[ID$N] = 1;
        DIRID[ID$N] = ID$N; 
        END 
      ELSE
        ERRCODE = D$NERR;    # ERROR IN N DIRECTIVE                    #
      GOTO ENDP;
 
L$P:                         # P DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID P DIRECTIVE                       #
      THEN
        BEGIN                # SET P DIRECTIVE SELECTED                #
        DIRVALU[ID$P] = 1;
        DIRID[ID$P] = ID$P; 
        END 
      ELSE                   # ERROR IN P DIRECTIVE                    #
        ERRCODE = D$PERR; 
      GOTO ENDP;
 
L$R:                         # R DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID R DIRECTIVE                       #
      THEN
        BEGIN                # SET R DIRECTIVE SELECTED                #
        DIRVALU[ID$R] = 1;
        DIRID[ID$R] = ID$R; 
        END 
      ELSE
        ERRCODE = D$RERR; 
      GOTO ENDP;
 
L$T:                         # T DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID T DIRECTIVE                       #
      THEN
        BEGIN                # SET T DIRECTIVE SELECTED                #
        DIRVALU[ID$T] = 1;
        DIRID[ID$T] = ID$T; 
        END 
      ELSE                   # ERROR IN E DIRECTIVE                    #
        ERRCODE = D$TERR; 
      GOTO ENDP;
 
L$U:                         # U DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID U DIRECTIVE                       #
      THEN
        BEGIN                # SET U DIRECTIVE SELECTED                #
        DIRVALU[ID$U] = 1;
        DIRID[ID$U] = ID$U; 
        END 
      ELSE                   # ERROR IN U DIRECTIVE                    #
        ERRCODE = D$UERR; 
      GOTO ENDP;
 
L$X:                         # X DIRECTIVE                             #
      IF C<I,1>LEFTSYM EQ 0  # VALID X DIRECTIVE                       #
      THEN
        BEGIN                # SET X DIRECTIVE SELECTED                #
        DIRVALU[ID$X] = 1;
        DIRID[ID$X] = ID$X; 
        END 
      ELSE                   # ERROR IN R DIRECTIVE                    #
        ERRCODE = D$XERR; 
 
ENDP: 
        END 
      END 
TERM