Retro1.org codex

*DECK DLDIRP
USETEXT DLFPDEF 
USETEXT ARGTBL
USETEXT DIERR 
USETEXT DIRTBL
USETEXT ICIOBB
USETEXT IFETB 
USETEXT OCIOBB
USETEXT OFETB 
USETEXT VDDIR 
PROC DLDIRP(FIRST$DIR,ERRCODE);# SCAN DIRECTIVE LINE                   #
*IF DEF,IMS 
 #
*1DC  DLDIRP
* 
*     1. PROC NAME           AUTHOR              DATE.
*        DLDIRP              P.C.TAM             78/09/21 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        DIRECTIVE FILE SCANNER.
* 
*     3. METHOD USED. 
*        READ DIRECIVES INTO ARRAY DIRSY
*        LOOK FOR VALID KEYWORDS
*        IF FOUND, SET CORRESPONDING VALUE IN DIRTBL COMMON BLOCK 
*        IF FOUND INVALID KEYWORD OR INVALID DIRECTIVE VALUE
*        CALL INVDIR TO PROCESS ERROR.
* 
*     4. ENTRY PARAMETERS.
*        DIRECTIVE FILE.
* 
*     5. EXIT PARAMETERS. 
*        FIRST$DIR           INPUT DIRECTIVE FLAG 
*        ERRCODE             ERROR RETURN CODE
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ARGTBL    DIERR     DIRTBL    DLFPDEF
*        ICIOBB    IFETB     OCIOBB    OFETB
*        VDDIR
* 
*     7. ROUTINES CALLED. 
*        DLABEND             ABORT
*        DLDIRC1             INDIVIDUAL DIRECTIVE PROCESSOR 
*        DLRDO               READ A WORD FROM FILE
*        DLWRT               WRITE WORDS INTO FILE
* 
*     8. DAYFILE MESSAGES.
*        NONE.
 #
*ENDIF
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC DLABEND;        # ABORT MAIN LINE                         #
        PROC DLDIRC1;        # INDIVIDUAL DIRECTIVE POCESSOR           #
        PROC DLRDO;          # READ A WORD FROM FILE                   #
        PROC DLWRT;          # WRITE WORDS INTO FILE                   #
        END 
# 
      LOCAL VARIABLES 
# 
 
 
 
 
      BASED ARRAY DUMMY;
        ; 
      ARRAY DIRMSG1 S(3); 
        BEGIN 
        ITEM DIRM1   C(0,0,18)=["1 DIRECTIVE INPUT-"];
        ITEM DIRM2   U(1,48,12)=[0];
        ITEM DIRM3   C(2,0,WC)=[" "]; 
        END 
 
      ARRAY DERRMS2 [1:20]; 
        BEGIN 
        ITEM DERRCOD I(0);
        END 
 
      ITEM
      DERRIND    I,          # INDEX FOR TABLE DERRMS2                 #
      COMAF      B,          # COMMA ALREADY EXISTS FLAG               #
      ENDLF      B,          # TRUE WHEN A BUILD OF LONG DIR IS FIN    #
      EQUF       B,          # TRUE IF A = SIGN HAS BEEN ENCOUNTERED   #
      ERRCODE    I,          # ERROR CODE FOR DIFFERENT ERROR CONDITION#
      IEOR       B,          # END OF RECORD ON FILE                   #
      UNPWD      U,          # TEMPORARY SAVE AREA FOR UNPACKED CHARS  #
      UNPTR      I,          # POINTER TO CHAR IN UNPWD                #
      CHART      U,          # TEMPORARY SAVE AREA                     #
      CHARPTR    I,          # POINTER TO CHAR WORD                    #
      CHAR       U,          # CHARACTER SAVE AREA                     #
      FIRST$DIR  B,          # FIRST DIRECTIVE IN RECORD FLAG          #
      I          I;          # LOOP VARIABLE                           #
 
#**********************************************************************#
 
      BEGIN 
# 
      MODULE ONE  READ DIRECTIVES 
# 
#     PRESET LOCAL VARIABLES                                           #
 
      FOR I = 1 STEP 1 UNTIL DIRNO
      DO
        BEGIN 
        DIRWD0[I] = 0;       # ZERO DIRECTIVE VALUES                   #
        END 
 
      DERRIND = 0;
      COMAF = FALSE;
      FIRST$DIR = TRUE; 
      EQUF = FALSE; 
      ENDLF = FALSE;
      ERRCODE = 0;
      IEOR = FALSE; 
      UNPWD = 0;
      UNPTR = 0;
      CHART = 0;
      CHARPTR = 0;
      CHAR = 0; 
 
#     WRITE HEADER FOR DIRECTIVE INPUT 80X80 LIST                      #
 
      DLWRT(OFET, DIRMSG1, 3);
 
      FOR CHARPTR = CHARPTR WHILE NOT IEOR
      DO
        BEGIN 
        DLRDO(IFET, CHAR);   # READ A WORD FROM DIRECTIVE FILE         #
        DLWRT(OFET, CHAR, 1);# LIST DIRECTIVE INPUT                    #
 
#       LOOP TO PROCESS EACH CHARACTER IN WORD                         #
        FOR CHARPTR = 0 STEP CL WHILE CHARPTR LQ WL-CL
        DO
          BEGIN 
          CHART = B<CHARPTR, CL> CHAR;
          IF (O"01" LQ CHART AND CHART LQ O"44") OR # CHAR ALPHANUMERIC#
             CHART EQ O"54"  # CHAR IS =                               #
          THEN
            BEGIN 
            IF UNPTR GR WL-CL 
            THEN
              BEGIN          # DIRECTIVE EXPRESSION HAS MORE THAN 10 CH#
              ERRCODE = D$ERR1; 
              END 
            ELSE
              BEGIN          # SAVE CHARACTER IN ASSEMBLY              #
              B<UNPTR, CL>UNPWD = CHART;
              UNPTR = UNPTR + CL; 
              IF EQUF 
              THEN
                ENDLF = TRUE; 
              IF CHART EQ O"54" # CHAR IS =                            #
              THEN
                EQUF = TRUE;
              END 
            END 
          ELSE
            IF CHART EQ O"55" OR   # CHARACTER IS A SPACE              #
               CHART EQ O"56"      # CHARACTER IS A COMMA              #
            THEN
              BEGIN 
              IF UNPTR EQ 0        # NO WORD ASSEMBLED                 #
              THEN
                BEGIN 
                IF CHART EQ O"56" 
                THEN
                  BEGIN      # CHARACTER IS A COMMA                    #
                  IF COMAF
                  THEN
                    ERRCODE = D$ERR2;# IT APPEARED MORE THAN ONCE      #
                  ELSE
                    IF FIRST$DIR
                    THEN
                      ERRCODE = D$ERR3;# CANNOT HAVE LEADING COMMAS    #
                  END 
                END 
              ELSE
                BEGIN              # SEPARATOR WITH WORD ASSEMBLED     #
                IF UNPTR EQ CL OR # SHORT DIRECTIVE                    #
                   ENDLF          # LONG DIRECTIVE                     #
                THEN
                  BEGIN 
                  DLDIRC1(UNPWD, ERRCODE);# PROCESS ASSEMBLED WORD     #
                  FIRST$DIR = FALSE;
                  UNPWD = 0;
                  UNPTR = 0;
                  EQUF = FALSE; 
                  ENDLF = FALSE;
                  COMAF = FALSE;
                  END 
                END 
              IF CHART EQ O"56"    # CHARACTER IS A COMMA              #
              THEN
                COMAF = TRUE;      # SET COMMA FOUND FLAG              #
              END 
            ELSE
              IF CHART NQ 0  # NOT END OF LINE MARKER                  #
              THEN
                BEGIN 
                ERRCODE = D$ICHER;
                END 
          IF ERRCODE NQ 0 
          THEN
            BEGIN 
            IF DERRIND NQ 20
            THEN
              BEGIN          # ONLY LOG 1ST 20 ERR MSG                 #
              DERRIND = DERRIND + 1;
              DERRCOD[DERRIND] = ERRCODE; 
              END 
            ERRCODE = 0;
            END 
          END 
          IF B<48,12>CHAR EQ 0# END OF LINE CHECK                      #
          THEN
            BEGIN 
            IEOR = TRUE;     # NO MORE WORDS TO READ                   #
            IF UNPTR NQ 0 
            THEN
              BEGIN          # ONE MORE TO SAVE                        #
              DLDIRC1(UNPWD, ERRCODE); # PROCESS ASSEMBLED DIRECTIVE   #
              FIRST$DIR = FALSE;
              IF ERRCODE NQ 0 
              THEN
                BEGIN 
                IF DERRIND NQ 20
                THEN
                  BEGIN      # ONLY LOG 1ST 20 ERR MSG                 #
                  DERRIND = DERRIND + 1;
                  DERRCOD[DERRIND] = ERRCODE; 
                  END 
                ERRCODE = 0;
                END 
              END 
            END 
        END 
 
#     CHECK IF DLDIRP FOUND ANY ERROR CONDTION                         #
 
      IF DERRIND NQ 0 
      THEN
        BEGIN 
 
        FOR I = 1 STEP 1 WHILE I LQ DERRIND 
        DO
          BEGIN              # OUTPUT ERROR MSG                        #
          P<DUMMY> = LOC(D$EM0[DERRCOD[I]]);
          DLWRT(OFET, DUMMY, 5);
          END 
        IF ARGENTR[DOPTION] EQ 0
        THEN                 # DO NOT IGNORE ERROR                     #
          DLABEND;           # ABORT                                   #
        ERRCODE = DERRIND;
        END 
 
      END 
TERM