*DECK INITFDLT
USETEXT CCTTEXT 
          PROC INITFDLT;
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC - INITFDLT 
* 
*         DOES - INITIALIZES THE FDLT.  *READS IN THE FDLT FILE AND SETS
*                 UP THE FDLT TABLE.  DIAGNOSES VARIOUS ERRORS. 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
  
*CALL FDLT
*CALL TABLETYP
  
#      GLOBAL DECLARATIONS   #
          ITEM PRINTCARD     C(10) = "          ";  # SPACES FOR LIST # 
          ITEM CARDIN        C(100);    # INPUT CARD IMAGE #
          ITEM DELIMCHAR     C(1);     # DELIMITER CHAR FROM GETSTRING #
          ITEM ENDCARDFLAG   B=FALSE;   # SET IF END OF CARD REACHED #
          ITEM ERRORFLAG     B=FALSE;   # SET IF AN ERROR ON THIS CD #
          ITEM EOFFLAG       B=FALSE;   # SET IF EOF ON INPUT FILE   #
          ITEM FDLTPTR       I;         # VIRTUAL POINTER TO FDLT # 
          ITEM FIRSTCHPTR    I;         # POINTS TO FIRST CH IN STRING #
          ITEM HYPHENFLAG    B=FALSE;   # SET IF HYPHEN IN STRING # 
          ITEM I             I;         # TEMPORARY INDEX # 
          ITEM INPADDR       I;         # ADDRESS OF CARD INPUT # 
          ITEM READCDFLAG    B=TRUE;    # SET IF TO READ NEXT CARD #
          ITEM SOMEDATA      B=FALSE;   # SET IF SOME DATA READ        #
          ITEM STARTCOL      I;         # STARTING COL OF CURR STRING # 
          ITEM STRINGLENGTH  I;         # LENGTH OF CURRENT STRING #
          ITEM TEMP          I;         # TEMPORARY FOR ANY USE # 
  
          ARRAY CS [0:0] S(4);    #CHARACTER STRING ARRAY # 
              BEGIN 
              ITEM CHARSTRING  C(0,0,30);    #ENTIRE STRING#
              ITEM F10CHARS    C(0,0,10);    # FIRST TEN CHARACTERS # 
              ITEM F20CHARS    C(0,0,20);    # FIRST 20 CHARS # 
              END 
          XREF BEGIN
              PROC CBLIST;    # LISTING ROUTINE # 
              ITEM NOSHIFT B;  # CBLIST PARAM FOR NO SHIFT OF PRT LINE #
              PROC RETRN;   # RETURN A FILE # 
              FUNC VIRTUAL; 
              PROC OUTPUT;
              PROC GETSQ; 
              PROC PRINTOCT;  # PRINTS OCTAL NBR FOR DEBUG #
              PROC PRINTVAL;  # PRINTS VALUE FOR DEBUGGING #
              ITEM FDLFET;    # ADDRESS OF FDL FILE FET # 
              PROC INTERCEPTOR ;  # DIAGNOSTIC ROUTINE #
              END 
  
 #     ERRORS GENERATED IN INITFDLT (REGULAR COMPILER ERRORS           #
          DEF D094 #094#; 
  
 #     ERRORS GENERATED LOCALLY # 
          STATUS ERR      # STATUS LIST OF ERROR NUMBERS #
                  NULL       # NOT USED # 
              ,   ERROR1     # FIRST CHARACTER OF STRING IS HYPHEN #
              ,   ERROR2     # ILLEGAL CHARACTER IN STRING #
              ,   ERROR3     # "USAGE" EXPECTED AFTER "DATABASE" #
              ,   ERROR4     # INVALID AREA NAME #
              ,   ERROR5     # UNRECOGNIZED DATABASE CARD # 
              ,   ERROR6     # INVALID RELATION NAME #
              ,   ERROR7     # INVALID SUBSCHEMA NAME # 
              ,   ERROR8     # "USES" NOT AFTER SUBSCHEMA NAME #
              ,   ERROR9     # INVALID USES OPTION #
              ,   ERROR10    # "EQUIVALENCE" MUST FOLLOW "PROGRAM" #
              ,   ERROR11    # = SIGN MISSING # 
              ,   ERROR12    # INVALID INTERNAL PROGRAM NAME #
              ,   ERROR13    # INVALID LIBRARY NAME # 
              ,   ERROR14    # UNRECOGNIZED SECTION HEADER #
              ,   ERROR15    # PROG NAME LARGER THAN 30 CHARS # 
              ,   ERROR16    #DUPLICATE PROGRAM NAME# 
              ,   ERROR17    #DUPLICATE INTERNAL NAME#
              ,   ENDERRS    # END OF LIST #
              ; 
          CONTROL EJECT;
          PROC GETSTRING; 
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC - GETSTRING
* 
*         DOES - GETS A STRING OF CHARACTERS FROM THE INPUT FILE. 
*                 ALSO READS  THE CARDS FROM THE FILE.
* 
*         INPUTS
*                 READCDFLAG IS TRUE IF NEW CARD TO BE READ.
* 
*         OUTPUTS 
*                 ENDCARDFLAG IS TRUE IF END OF CARD FOUND
*                 CHARSTRING CONTAINS THE STRING OF CHARACTERS SPACE FIL
*                 EOFFLAG IS SET IF END OF FILE REACHED 
*                DELIMITER CONTAINS THE DELIMITER - . IF END OF CARD
*                 STARTCOL IS SET TO THE STARTING COLUMN OF THIS STRING 
*                 HYPHENFLAG IS SET IF A HYPHEN IS IN THE STRING
*                 STRINGLENGTH IS SET TO THE LENGTH OF THE STRING 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          ITEM CURRPOS        I=0;   #CURRENT POSITION IN CARD# 
          ITEM CURRCHAR       C(1);  # CURRENT CHARACTER #
          ITEM DELIMITER      B;     # SET IF DELIMITER FOUND # 
          ITEM RL             I;     # RECORD LENGTH LAST READ #
  
          HYPHENFLAG = FALSE; 
          CHARSTRING = "                              ";
          DELIMCHAR = ".";
          STRINGLENGTH = 0; 
          IF READCDFLAG 
          THEN
              BEGIN   # READ NEW CARD IMAGE # 
              CURRPOS = 0;
              READCDFLAG = FALSE; 
              GETSQ (FDLFET, INPADDR, 100, EOD, RL);  #READ A CARD# 
              SOMEDATA = TRUE;
              IF CCTSOURCLIST 
              THEN
                  IF CCTPSQ 
                  THEN
                      CBLIST(1, CARDIN, 100);  # PRINT CARD IMAGE # 
                  ELSE
                      CBLIST(1, PRINTCARD, 110); # PRINT CARD IMAGE # 
              ENDCARDFLAG = FALSE;
              GOTO RDEX;
 EOD:         #EOD (OR EOF) READ ON FILE #
              RETRN (FDLFET);   # RETURN THE FILE # 
              EOFFLAG = TRUE; 
              ENDCARDFLAG = TRUE; 
 RDEX:  
              END 
          IF ENDCARDFLAG
          THEN
              BEGIN   # END OF CARD - NOTHING RETURNED #
              RETURN; 
              END 
          IF CURRPOS GQ RL
          OR CURRPOS GQ 72
          THEN
              BEGIN    # CARD PROCESSED # 
              ENDCARDFLAG = TRUE; 
              RETURN; 
              END 
 #     SKIP OVER LEADING SPACES # 
          FOR CURRPOS = CURRPOS 
          WHILE (CURRPOS LS 72 AND CURRPOS LS RL) 
          AND C<CURRPOS, 1>CARDIN EQ " "
          DO
              CURRPOS = CURRPOS + 1;
          IF CURRPOS GQ RL
          OR CURRPOS GQ 72
          OR C<CURRPOS,1>CARDIN EQ "."
          THEN
              BEGIN    # END OF CARD FOUND - EXIT # 
              ENDCARDFLAG = TRUE; 
              RETURN; 
              END 
  
 #     PICK UP STRING  #
          DELIMITER = FALSE;
          FOR STARTCOL = CURRPOS
          WHILE STRINGLENGTH LS 32
          AND (CURRPOS LS 72 AND CURRPOS LS RL) 
          AND NOT DELIMITER 
          DO
              BEGIN 
              CURRCHAR = C<CURRPOS, 1>CARDIN; 
              IF CURRCHAR EQ " "
              OR CURRCHAR EQ ","
              OR CURRCHAR EQ "."
              OR CURRCHAR EQ "="
              THEN
                  BEGIN    # DELIMITER FOUND  # 
                  DELIMITER = TRUE; 
                  DELIMCHAR = CURRCHAR; 
                  CURRPOS = CURRPOS + 1;  # SKIP OVER DELIMITER # 
                  END 
              ELSE
                  BEGIN    # NON-DELIMITER PROCESSING # 
                  C<STRINGLENGTH,1>CHARSTRING = CURRCHAR; 
                  IF STRINGLENGTH EQ 0
                  AND CURRCHAR EQ "-" 
                  THEN
                      PRINTERROR (ERR"ERROR1", CURRPOS);  # FST CHAR - #
                  IF CURRCHAR EQ "-"
                  THEN
                      HYPHENFLAG = TRUE;
                  STRINGLENGTH = STRINGLENGTH + 1;
                  IF CURRCHAR EQ ":" OR 
                     CURRCHAR GR "9"
                  AND CURRCHAR NQ "-" 
                  AND CURRCHAR NQ "=" 
                  THEN
                      PRINTERROR (ERR"ERROR2", CURRPOS);  # ILLEGAL CH #
                  CURRPOS = CURRPOS + 1;
                  END 
              END  # END STRING GATHERING LOOP #
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PRINTERROR (ERRNBR, COLUMNNBR);
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC - PRINTERROR 
* 
*         DOES - PRINTS ERROR MESSAGE WITH A POINTER TO BAD WORD
* 
*         INPUTS
*                ERRNBR - NUMBER OF ERROR (FROM STATUS LIST ERR)
*                COLUMNNBR - NUMBER OF COLUMN -1 OF FIRST CHAR OF BAD WD
* 
*         OUTPUTS - ERROR MESSAGE AND POINTER LINE
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          BEGIN 
          ITEM ERRNBR I;
          ITEM COLUMNNBR I; 
          ITEM POINTERPRINT  C(10) = "          ";  # FOR PRINTING #
          ITEM POINTER C(80); 
          ITEM MSLEN I; 
          ITEM MSGPRINT C(10) = "          ";  # FOR MSG PRINTING # 
          ITEM MSGAR C(80) = "**ERROR** ";
  
          ARRAY ERMSAR [1:ERR"ENDERRS"] S(8); 
              BEGIN 
              ITEM ERMSLEN  U(0,0,12) 
                  =[
                  30, 
                  48, 
                  35,        #03# 
                  43,        #04# 
                  50,        #05# 
                  40,        #06# 
                  41,        #07# 
                  39,        #08# 
                  45,        #09# 
                  40,        #10# 
                  47,        #11# 
                  49,        #12# 
                  47,        #13# 
                  43,        #14# 
                  44,        #15# 
                  22,        #16# 
                  23,        #17# 
                  ];
              ITEM ERMS  C(0,12,68) 
                  =[
                  "FIRST CHARACTER OF STRING IS -",               #01#
                  "ILLEGAL CHARACTER IN STRING NOT AN, -, = ,, OR .", 
                  "THE WORD USAGE MUST FOLLOW DATABASE",           #03# 
                  "AREA NAME MORE THAN 30 CHARACTERS IN LENGTH",   #04# 
                  "NEITHER A RELATION NOR AREA CARD IN DATABASE CARDS", 
                  "RELATION NAME GREATER THAN 30 CHARACTERS",      #06# 
                  "SUBSCHEMA NAME GREATER THAN 30 CHARACTERS",     #07# 
                  "THE WORD USES DOES NOT FOLLOW AREA NAME",       #08# 
                  "ONE OF THE USES OPTIONS IS NOT A VALID OPTION", #09# 
                  "THE WORD EQUIVALENCE MUST FOLLOW PROGRAM",      #10# 
                  "THE EQUAL SIGN IS MISSING BETWEEN PROGRAM NAMES",
                  "INTERNAL PROGRAM NAME IS LARGER THAN 7 CHARACTERS",
                  "THE LIBRARY NAME IS MORE THAN 7 CHARACTERS LONG",
                  "A SECTION HEADER WAS EXPECTED AND NOT FOUND",   #14# 
                  "COBOL PROGRAM NAME LARGER THAN 30 CHARACTERS",  #15# 
                  "DUPLICATE PROGRAM NAME",  #16# 
                  "DUPLICATE INTERNAL NAME",  #17#
                  ];
              END 
          ERRORFLAG = TRUE; 
          POINTER = " ";   #BLANK OUT POINTER AREA# 
          C<COLUMNNBR,1>POINTER = "'";    #PUT UP ARROW IN PROPER PLACE#
          IF NOT CCTSOURCLIST 
          THEN
                  IF CCTPSQ 
                  THEN
                      CBLIST (1, CARDIN, 100);  # PRINT CARD IMAGE #
                  ELSE
                      CBLIST (1, PRINTCARD, 110); 
          IF CCTPSQ 
          THEN
              CBLIST (1, POINTER, COLUMNNBR + 1); # PRINT POINTER # 
          ELSE
              CBLIST (1, POINTERPRINT, COLUMNNBR + 11); 
          MSLEN = ERMSLEN [ERRNBR]; 
          C<10,MSLEN>MSGAR = ERMS[ERRNBR];
          IF CCTPSQ 
          THEN
              CBLIST (1, MSGAR, MSLEN + 10);
          ELSE
              CBLIST (1, MSGPRINT, MSLEN + 20); 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PROCDATABASE;
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC - PROCDATABASE 
* 
*         DOES - PROCESSES DATABASE USAGE SYNTAX
* 
*         OUTPUTS 
*             FDLT FIELDS CORRESPONDING TO DATABASE SET 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          ITEM AREAFLAG  B=FALSE;   # SET IF AREA PROC #
          ITEM ENDPDFLAG B=FALSE;   # SET IF END OF PROC DATABASE # 
          ITEM OPTIONIND I;  # OPTION INDEX # 
  
          ARRAY USEOPTIONS [1:NBRUSEOPS] P(2);
              BEGIN 
              ITEM USEOPTION C(0,0,10)
                  =[
                  "CLOSE",
                  "DELETE", 
                  "OPEN", 
                  "READ", 
                  "REWRITE",
                  "START",
                  "WRITE",
                  ];
              ITEM USEOPTIONVAL S:FDLTAOVAL (1,0,5) 
                  =[
                  S"CLOSE", 
                  S"DELETE",
                  S"OPEN",
                  S"READ",
                  S"REWRITE", 
                  S"START", 
                  S"WRITE", 
                  ];
              END 
  
          CCTFDLCDCS = TRUE;
          GETSTRING;  #GET NEXT STRING# 
          IF NOT F10CHARS EQ "USAGE"
          THEN
              PRINTERROR (ERR"ERROR3", STARTCOL);  # ERR - USAGE XPTED# 
          ERRORFLAG = FALSE;   # IGNORE ANY ERRORS TO HERE #
          READCDFLAG = TRUE;   # READ NEXT CARD # 
          FOR I = I 
          WHILE NOT EOFFLAG 
          AND NOT ENDPDFLAG 
          DO
              BEGIN   # MAIN PROCESS #
              READCDFLAG = TRUE;   #SET TO READ NEW CARD #
              ERRORFLAG = FALSE;     #CLEAR PREVIOUS ERROR CONDS# 
              GETSTRING;
              IF EOFFLAG
              OR F10CHARS EQ "PROGRAM"
              THEN
                  BEGIN   # END OF DATABASE PROCESSING #
                  ENDPDFLAG = TRUE; 
                  TEST I;     # EXIT FROM PROCESSING #
                  END 
              IF F10CHARS EQ "AREA" 
              THEN
                  BEGIN   # AREA DECLARATION #
                  AREAFLAG = TRUE;
                  FDLTENTTYPE [FDLTPTR] = S"AREADECL";
                  GETSTRING;
                  IF STRINGLENGTH GR 30 
                  THEN
                      PRINTERROR (ERR"ERROR4", STARTCOL); 
                  ELSE
                      ZRFILLNAME; 
                      FDLTAREANAME [FDLTPTR] = CHARSTRING;
                  END 
              ELSE
                  BEGIN   # RELATION PROCESSING # 
                  IF F10CHARS NQ "RELATION" 
                  THEN
                      PRINTERROR (ERR"ERROR5", STARTCOL); 
#      ERROR - RELATION MUST BE FIRST IF AREA IS NOT #
                  ELSE
                      BEGIN 
                      FDLTENTTYPE [FDLTPTR] = S"RELDECL"; 
                      AREAFLAG = FALSE; 
                      GETSTRING;
                      IF STRINGLENGTH GR 30 
                      THEN
                          PRINTERROR (ERR"ERROR6", STARTCOL); 
                      ELSE
                          BEGIN 
                          ZRFILLNAME; 
                          FDLTRELNAME [FDLTPTR] = CHARSTRING; 
                          END 
                      END 
                  END 
              IF ERRORFLAG
              THEN
                  TEST I;   # EXIT LOOP - ERROR IN CARD SO FAR #
              ELSE
                  BEGIN 
                  GETSTRING;
                  IF AREAFLAG 
                  THEN
                      BEGIN  # MORE AREA PROCESSING - PROCESS USES #
                      IF F10CHARS NQ "USES" 
                      THEN
 #     ERROR - USES MUST FOLLOW SS-NAME IN AREA CARD #
                      PRINTERROR (ERR"ERROR8", STARTCOL); 
                      ELSE
                      BEGIN 
                      GETSTRING;
                      FOR OPTIONIND = 0 
                      WHILE NOT ENDCARDFLAG DO
                          BEGIN 
                          FOR I = 1 
                          WHILE I LS NBRUSEOPS + 1
                          AND USEOPTION [I] NQ F10CHARS 
                          DO
                              I = I + 1;
                          IF I EQ NBRUSEOPS + 1 
                          THEN
                              PRINTERROR (ERR"ERROR9", STARTCOL); 
                          TEMP = USEOPTIONVAL [I];
                          B<TEMP,1>FDLTAREAOP[FDLTPTR] = 1; 
                          GETSTRING;
                          END 
                      END 
                  END 
              END 
              IF NOT ERRORFLAG
              THEN
                  BEGIN  # NO ERRORS - TABLE ENTRY IS OK - GET NEXT#
                  CCTFDLTLEN = CCTFDLTLEN + 1;
                  FDLTPTR = VIRTUAL (TABLETYPE "FDLT$", CCTFDLTLEN +
                    1); 
                  END 
              ELSE
                  FDLTWORD0 [FDLTPTR] = 0;   # ZERO OUT ANY ACCUM FLGS# 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC PROCPROGRAM; 
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC - PROCPROGRAM
* 
*         DOES - PROCESSES PROGRAM DECLARATION CARDS. 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          ITEM ENDPPFLAG  B = FALSE;
          ITEM  INTERNALNAME  C(7); 
          ITEM  J;
          ITEM  PROGRAMNAME  C(30); 
  
          GETSTRING;
          IF F20CHARS NQ "EQUIVALENCE"
          THEN
              PRINTERROR (ERR"ERROR10", STARTCOL);
          FOR I = I 
          WHILE NOT EOFFLAG 
          AND NOT ENDPPFLAG 
          DO
              BEGIN 
              READCDFLAG = TRUE;   # SET TO READ NEXT CARD #
              ERRORFLAG = FALSE;  #CLEAR ANY ERRORS # 
              GETSTRING;
              IF EOFFLAG
              OR F10CHARS EQ "DATABASE" 
              THEN
                  BEGIN  # END OF PROG DECL PROC #
                  ENDPPFLAG = TRUE; 
                  TEST I;  # EXIT FROM PROCESSING # 
                  END 
              IF STRINGLENGTH GR 30 
              THEN
                  PRINTERROR (ERR"ERROR15", STARTCOL);
              ELSE
                  BEGIN 
                  FDLTENTTYPE [FDLTPTR] = S"PROGEQUIV"; 
                  FDLTPROGNAME [FDLTPTR] = CHARSTRING;
                  IF DELIMCHAR EQ " " 
                  THEN
                      GETSTRING;   # LOOK FOR = SIGN NEXT # 
                  IF DELIMCHAR NQ "=" 
                  THEN
 #     ERROR - = MUST BE AFTER COBOL PROG NAME #
                      PRINTERROR (ERR"ERROR11", STARTCOL);
                  ELSE
                      BEGIN 
                      GETSTRING;
                      IF STRINGLENGTH GR 7
                      THEN
 #     ERROR - INVALID SYSTEM PROGRAM NAME #
                          PRINTERROR (ERR"ERROR12", STARTCOL);
                      ELSE
                          BEGIN 
                          ZRFILLNAME; 
                          FDLTINTNAME [FDLTPTR] = CHARSTRING; 
                          GETSTRING;
                          IF F10CHARS EQ "STATIC" 
                          THEN
                              BEGIN  #STATIC OPTION#
                              FDLTSTATICF [FDLTPTR] = TRUE; 
                              GETSTRING;
                              END 
                          END 
                      END 
                  END 
              IF  NOT ERRORFLAG 
              THEN
                  BEGIN 
                  PROGRAMNAME = FDLTPROGNAME[FDLTPTR];
                  INTERNALNAME = FDLTINTNAME[FDLTPTR];
                  FOR  J = 1 STEP 1 WHILE J LQ CCTFDLTLEN 
                                        AND NOT ERRORFLAG DO
                      BEGIN 
                      FDLTPTR = VIRTUAL(TABLETYPE"FDLT$",J);
                      IF  PROGRAMNAME EQ FDLTPROGNAME[FDLTPTR]
                      THEN  PRINTERROR(ERR"ERROR16",1); 
                      IF INTERNALNAME EQ FDLTINTNAME[FDLTPTR] 
                      THEN  PRINTERROR(ERR"ERROR17",1); 
                      END 
                  FDLTPTR = VIRTUAL(TABLETYPE"FDLT$", CCTFDLTLEN + 1);
              END 
              IF NOT ERRORFLAG
              THEN
                  BEGIN 
                  CCTFDLTLEN = CCTFDLTLEN + 1;
                  FDLTPTR = VIRTUAL (TABLETYPE "FDLT$", CCTFDLTLEN + 1);
                  END 
              ELSE
                  FDLTWORD0 [FDLTPTR] = 0;   # ZERO OUT ANY ACCUM FLGS# 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC ZRFILLNAME;
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC - ZRFILLNAME 
* 
*         DOES - FILLS THE NAME IN CHARSTRING WITH BINARY ZEROS TO RIGHT
* 
*         INPUTS - CHARSTRING 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          ITEM ZRFILLIND I; 
  
          FOR ZRFILLIND = 29 STEP -1
          WHILE C<ZRFILLIND,1>CHARSTRING EQ " " 
          DO
              BEGIN 
              C<ZRFILLIND,1>CHARSTRING = C<0,1>ZRFILLIND; 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
 #    START MAIN PROCEDURE  # 
  
          IF NOT CCTPSQ 
          THEN
              NOSHIFT = TRUE;   # SET TO NOT SHIFT PRINT LINES RIGHT #
          INPADDR = LOC (CARDIN);   #SET UP FOR CARD READING #
          FDLTPTR = VIRTUAL (TABLETYPE "FDLT$", 1);  #SET UP POINTER# 
          FOR I = I WHILE NOT EOFFLAG DO
              BEGIN 
              READCDFLAG = TRUE;
              GETSTRING;
              IF F10CHARS EQ "PROGRAM"
              THEN
                  PROCPROGRAM;
              IF F10CHARS EQ "DATABASE" 
              THEN
                  PROCDATABASE; 
              IF NOT EOFFLAG
              THEN
                  PRINTERROR (ERR"ERROR14", STARTCOL);
              ELSE
                  IF NOT SOMEDATA 
                  THEN
                      INTERCEPTOR(0,0,D094,0);   # EMPTY FILE - ERROR  #
              END 
          NOSHIFT = FALSE;   # CLEAR NO SHIFT OF PRINT LINES #
          RETURN; 
          END 
          TERM; 
