*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