home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol039 / ll1p1o.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  19.0 KB  |  625 lines
  1. LL1P10: PROC;
  2. /****************************************************************
  3. *              LL(1) GRAMMAR ANALYZER - PHASE 1            *
  4. *PURPOSE:                                                       *
  5. *    THIS PROGRAM ANALYZES A LL(1) GRAMMAR GIVEN IN MODIFIED    *
  6. *    BNF FORMAT AND GENERATES THE INTERNAL FORM OF THE LAN-     *
  7. *    GUAGE FOR FURTHER PROCESSING.                              *
  8. *INPUT:                                                         *
  9. *OUTPUT:                                                        *
  10. *OUTLINE:                                                       *
  11. *REMARKS:                                                       *
  12. ****************************************************************/
  13.  
  14. /****************************************************************
  15. * * * * * * * * * * * COMMON DATA DEFINITIONS * * * * * * * * * *
  16. ****************************************************************/
  17.  
  18. /*    * * *  COMMON REPLACEMENTS  * * *    */
  19. %REPLACE TRUE BY '1'B;
  20. %REPLACE FALSE BY '0'B;
  21.  
  22. %INCLUDE 'LL1CMN.DCL';    /* GET COMMON AREAS. */
  23.  
  24. /*    * * * SOURCE INPUT PARAMETERS * * *    */
  25.           DCL  BGNCOL BIN(7)         /* BEGINNING COLUMN NUMBER */
  26.                STATIC INITIAL(1);
  27.           DCL  ENDCOL BIN(7)         /* ENDING COLUMN NUMBER */
  28.                STATIC INITIAL(80);
  29.           DCL  COLNUM BIN(7);        /* CURRENT COLUMN NUMBER */
  30.           DCL  LINNUM BIN(15);        /* CURRENT LINE NUMBER */
  31.           DCL  CURLIN CHAR(80) VARYING; /* CURRENT LINE */
  32.           DCL  NXTCOL BIN(7);           /* NEXT COLUMN NUMBER */
  33.       DCL  ERRNUM BIN(15)        /* NUMBER OF ERRORS */
  34.            STATIC INITIAL(0);
  35.  
  36. /*    * * * TOKEN VARIABLES * * *        */
  37.       DCL  1 TOKEN_POSITION,    /* TOKEN POSITION IN TEXT */
  38.              2 COL BIN(7),
  39.              2 LIN BIN(15);
  40.       DCL TOKEN_TYPE BIN(7);    /* TYPE OF TOKEN */
  41.                     /* 01 - IDENTIFIER        */
  42.                     /* 02 - STRING          */
  43.                     /* 03 - ';'             */
  44.                     /* 04 - '->'              */
  45.                     /* 05 - EOF               */
  46.       DCL TOKEN_STRING CHAR(10)    /* TOKEN STRING */
  47.             VARYING;
  48.       DCL TOKEN_VOC BIN(15);    /* VOCABULARY PTR */
  49.       DCL TOKEN_RHS BIT(1);        /* RIGHT HAND SIDE OF EQUATION */
  50.  
  51. /*    * * * FILES * * *        */
  52.       DCL  SRC_FILE FILE;           /* OUTPUT LIST FILE       */
  53.           DCL  SRC_END BIT(1) STATIC    /*   "     "    "   INDICATOR */
  54.                INITIAL(FALSE);
  55.           DCL  SRC_OPEN BIT(1) STATIC   /*   "     "    "   INDICATOR */
  56.                INITIAL(FALSE);
  57.  
  58. /****************************************************************
  59. * * * * * * * * * * * COMMON PROCUDURES * * * * * * * * * * * * *
  60. ****************************************************************/
  61.  
  62. %INCLUDE 'LL1PRC.DCL';
  63.  
  64. CLOSE_SRC:   PROC ;
  65. /*THIS ROUTINE IS RESPONSIBLE FOR CLOSING THE INPUT FILE.    */
  66.  
  67. /* CLOSE THE FILE. */
  68.           IF SRC_OPEN=TRUE THEN        /*OPEN FILE IF NECESSARY*/
  69.                DO;
  70.                     CLOSE FILE(SRC_FILE);
  71.                     SRC_OPEN=FALSE;
  72.                END;
  73.  
  74. /* RETURN TO CALLER. */
  75.           END CLOSE_SRC;
  76.  
  77.  
  78. ENTER_VOC: PROC RETURNS(BIN(15));
  79. /* THIS ROUTINE IS RESPONSIBLE FOR ADDING THE CURRENT */
  80. /* TOKEN TO THE VOCABULARY IF IT ISN'T THERE ALREADY. */
  81.  
  82.      DCL  I BIN(15);               /* LOOP INDEX */
  83.      DCL  J BIN(15);               /* LOOP INDEX */
  84.  
  85. /*   SEARCH THE CURRENT VOCABULARY FOR THE TOKEN. */
  86.      J=0;            /* DEFAULT TO NOT FOUND. */
  87.      IF NUMVOC~=0 THEN        /**VOCABULARY EXISTS.**/
  88.           DO I=1 TO NUMVOC;
  89.              IF TOKEN_STRING=VOC(I) THEN
  90.                   DO;
  91.                      J=I;
  92.              I=NUMVOC;
  93.                   END;
  94.           END;
  95.  
  96. /*   ADD THE TOKEN IF IT WASN'T FOUND. */
  97.      IF J=0 THEN        /**DIDN'T EXIST**/
  98.           DO;
  99.          NUMVOC=NUMVOC+1;
  100.          VOC(NUMVOC)=TOKEN_STRING;
  101.              IF TOKEN_TYPE=1 THEN    /**IDENTIFIER**/
  102.                   DO;
  103.                      NTRM=NTRM || NUMCHR(NUMVOC);
  104.                   END;
  105.              IF TOKEN_TYPE=2 THEN    /**STRING**/
  106.                   DO;
  107.              TRM=TRM || NUMCHR(NUMVOC);
  108.                   END;
  109.          J=NUMVOC;        /*SET PTR TO IT.*/
  110.              IF TRACE1(2)=TRUE THEN
  111.                   DO;
  112.                      CALL PUTLST(0,'ADDED VOC:'||NUMVOC||' '||TOKEN_STRING);
  113.                   END;
  114.           END;
  115.  
  116. /*   RETURN TO CALLER WITH ENTRY NUMBER. */
  117.      IF TRACE1(2)=TRUE THEN
  118.         DO;
  119.            CALL PUTLST(0,'ENTER_VOC:'||J);
  120.         END;
  121.      RETURN(J);
  122.      END  ENTER_VOC;
  123.  
  124.  
  125. ERROR:    PROC (ERROR_NUM,LINE_NUMBER,COL_NUMBER);
  126. /* THIS ROUTINE IS RESPONSIBLE FOR PUTTING ERRORS TO THE */
  127. /* SOURCE LISTING FILE AS THEY ARE FOUND.                */
  128.  
  129.      DCL  ERROR_NUM BIN(15),       /* ERROR NUMBER */
  130.           LINE_NUMBER BIN(15),     /* LINE NUMBER FOR ERROR */
  131.           COL_NUMBER BIN(15);      /* COLUMN NUMBER FOR ERROR */
  132.      DCL  LINE_OUT CHAR(80) VARYING;
  133.      DCL  I FIXED;                 /* LOOP INDEX */
  134.  
  135. /*   SET UP LINE SHOWING ERROR. */
  136.      LINE_OUT='';                  /* ZERO OUTPUT LINE. */
  137.      IF LINE_NUMBER=LINNUM THEN    /* INDICATE COLUMN NO. */
  138.           DO;
  139.                IF COL_NUMBER>1 THEN
  140.                   DO I=1 TO COL_NUMBER;
  141.                      LINE_OUT=LINE_OUT || ' ';
  142.                   END;
  143.                LINE_OUT=LINE_OUT || '!ERROR' || CHAR(ERROR_NUM);
  144.           END;
  145.      ELSE                          /* ERROR NOT ON CURRENT LINE */
  146.           DO;
  147.                LINE_OUT='ERROR' || CHAR(ERROR_NUM) || ' AT COL' ||
  148.                     CHAR(COL_NUMBER) || 'ON LINE' || CHAR(LINE_NUMBER);
  149.           END;
  150.  
  151. /*   PUT THE LINE AND RETURN. */
  152.      CALL PUTLST(0,LINE_OUT);
  153.  
  154. /*   BUMP ERROR COUNT AND QUIT IF TOO MANY. */
  155.      ERRNUM = ERRNUM +1;
  156.      IF ERRNUM>50 THEN
  157.           STOP;
  158.  
  159.      END  ERROR;
  160.  
  161.  
  162. GETGMR:   PROC;
  163. /*THIS ROUTINE IS RESPONSIBLE FOR READING IN THE GRAMMAR.  */
  164.  
  165. /* PROCESS THE GRAMMAR ACCORDING THE PRODUCTION RULES. */
  166.       CALL PROD_GRMR;
  167.  
  168.           END  GETGMR;
  169.  
  170.  
  171. GETLIN:   PROC;
  172. /*THIS ROUTINE IS RESPONSIBLE FOR GETTING THE NEXT LINE FROM   */
  173. /*THE SOURCE FILE.  LINES ARE PRINTED IF THE FLAG IS SET.      */
  174. /*COMMENTS ARE HANDLES AS WELL AS DOLLAR FLAGS.  BLANK LINES   */
  175. /*ARE MERELY PRINTED AND OTHERWISE DISREGARDED.                */
  176.  
  177. /* RETURN IF EOF ALREADY. */
  178.           IF SRC_END=TRUE THEN
  179.              RETURN;
  180.  
  181. /* HANDLE END OF FILE CONDITION. */
  182.           ON ENDFILE(SRC_FILE)
  183.                BEGIN;
  184.                     SRC_END=TRUE;
  185.                END;
  186.  
  187. /* GET THE NEXT LINE OF INPUT. */
  188. READ_NEXT:
  189.           READ FILE(SRC_FILE) INTO (CURLIN);
  190.           IF SRC_END=FALSE THEN           /*REMOVE CP/M CR,LF. */
  191.                DO;
  192.                     CURLIN=SUBSTR(CURLIN,1,LENGTH(CURLIN)-2);
  193.                END;
  194.           ELSE
  195.                DO;
  196.                   CURLIN='';
  197.                   RETURN;
  198.                END;
  199.  
  200. /* RESET PTRS. */
  201.           COLNUM=1;
  202.           LINNUM=LINNUM+1;
  203.  
  204. /* PRINT THE LINE IF NECESSARY. */
  205.           IF FLAGS1(1)=TRUE THEN
  206.              CALL PUTLST(LINNUM,CURLIN);
  207.           IF CURLIN='' | SUBSTR(CURLIN,BGNCOL,1)='$' THEN
  208.              GOTO READ_NEXT;
  209.  
  210. /* RETURN TO CALLER. */
  211.           END  GETLIN;
  212.  
  213.  
  214. GETTOK:   PROC;
  215. /*THIS ROUTINE IS RESPONSIBLE FOR GETTING THE NEXT TOKEN FROM  */
  216. /*THE SOURCE FILE.                                             */
  217.           DCL  I BIN(7);      /* INDEX */
  218.  
  219. /* GET THE NEXT LINE IF NECESSARY. */
  220.           COLNUM=NXTCOL;
  221. GETTOK_NEWLINE:
  222.           IF COLNUM>LENGTH(CURLIN) THEN
  223.              CALL GETLIN;
  224.       
  225. /* IF END-OF-FILE, THEN RETURN. */
  226.           IF SRC_END=TRUE THEN
  227.              DO;
  228.                 TOKEN_TYPE=5;
  229.         TOKEN_STRING='';
  230.                 RETURN;
  231.              END;
  232.  
  233. /* BYPASS LEADING BLANKS. */
  234.     DO WHILE(COLNUM<=LENGTH(CURLIN) & 
  235.          SUBSTR(CURLIN,COLNUM,1)=' ');
  236.        COLNUM=COLNUM+1;
  237.     END;
  238.         IF COLNUM>LENGTH(CURLIN) THEN
  239.            GOTO GETTOK_NEWLINE;
  240.  
  241. /* SAVE TEXT POSITION. */
  242.       TOKEN_POSITION.COL=COLNUM;
  243.       TOKEN_POSITION.LIN=LINNUM;
  244.           IF TRACE1(1)=TRUE THEN
  245.              DO;
  246.                 CALL PUTLST(0,'GETTOK:NEXT CHAR='||SUBSTR(CURLIN,COLNUM,1));
  247.                 CALL PUTLST(0,'GETTOK:COLNUM='||COLNUM);
  248.              END;
  249.  
  250. /*** CHECK FOR VARIOUS TYPES ***/
  251. /** COMMENTS OR FLAG LINES **/
  252.           IF SUBSTR(CURLIN,COLNUM,1)='$' THEN
  253.              DO;
  254.                IF LENGTH(CURLIN)>COLNUM+2 &
  255.           SUBSTR(CURLIN,COLNUM+1,1)~=' ' THEN
  256.                   IF SUBSTR(CURLIN,COLNUM+1,1)='1' THEN
  257.                      FLAGS1(SUBSTR(CURLIN,COLNUM+2,1)-RANK('A')+1)=
  258.                          ~FLAGS1(SUBSTR(CURLIN,COLNUM+2,1)-RANK('A')+1);
  259.                   ELSE IF SUBSTR(CURLIN,COLNUM+1,1)='2' THEN
  260.                      FLAGS2(SUBSTR(CURLIN,COLNUM+2,1)-RANK('A')+1)=
  261.                          ~FLAGS2(SUBSTR(CURLIN,COLNUM+2,1)-RANK('A')+1);
  262.                 COLNUM=LENGTH(CURLIN);   /* FORCE SCAN TO A NEW LINE. */
  263.         GOTO GETTOK_NEWLINE;
  264.              END;
  265.  
  266. /** IDENTIFIER **/
  267.       ELSE IF SUBSTR(CURLIN,COLNUM,1)='<' THEN
  268.          DO;
  269.         I=INDEX(SUBSTR(CURLIN,COLNUM+1),'>');
  270.         IF I=0 THEN
  271.                    DO;
  272.                       CALL ERROR(21,LINNUM,TOKEN_POSITION.COL);
  273.                       CALL GETLIN;
  274.                       NXTCOL=1;
  275.                    END;
  276.                 ELSE
  277.                    DO;
  278.                       I=I+COLNUM-1;
  279.                       IF TRACE1(1)=TRUE THEN
  280.                          CALL PUTLST(0,'GETTOK:IDENTIFIER_I='||I);
  281.                       TOKEN_STRING=SUBSTR(CURLIN,COLNUM,I-COLNUM+2);
  282.                       TOKEN_TYPE=01;
  283.                       NXTCOL=I+2;
  284.                    END;
  285.          END;
  286.  
  287. /** STRING **/
  288.       ELSE IF SUBSTR(CURLIN,COLNUM,1)='''' THEN
  289.          DO;
  290.                 I=INDEX(SUBSTR(CURLIN,COLNUM+1),'''');
  291.         IF I=0 THEN
  292.                    DO;
  293.                       CALL ERROR(22,LINNUM,TOKEN_POSITION.COL);
  294.                       CALL GETLIN;
  295.                       NXTCOL=1;
  296.                    END;
  297.                 ELSE
  298.                    DO;
  299.                       I=I+COLNUM-1;
  300.                       IF TRACE1(1)=TRUE THEN
  301.                          CALL PUTLST(0,'GETTOK:STRING_I='||I);
  302.                       TOKEN_STRING=SUBSTR(CURLIN,COLNUM,I-COLNUM+2);
  303.                       TOKEN_TYPE=02;
  304.                       NXTCOL=I+2;
  305.                    END;
  306.          END;
  307.  
  308. /** RULE SEPERATOR **/
  309.       ELSE IF SUBSTR(CURLIN,COLNUM,1)=';' THEN
  310.          DO;
  311.                 TOKEN_STRING=';';
  312.                 TOKEN_TYPE=03;
  313.                 NXTCOL=COLNUM+1;
  314.          END;
  315.  
  316. /** ALTERNATIVE SEPERATOR **/
  317.       ELSE IF SUBSTR(CURLIN,COLNUM,2)='->' THEN
  318.          DO;
  319.                 TOKEN_STRING='->';
  320.                 TOKEN_TYPE=04;
  321.                 NXTCOL=COLNUM+2;
  322.          END;
  323.  
  324. /** ERROR **/
  325.       ELSE
  326.          DO;
  327.                 CALL ERROR(25,LINNUM,TOKEN_POSITION.COL);
  328.                 CALL GETLIN;
  329.                 NXTCOL=1;
  330.          END;
  331.  
  332. /* TRACE CALL IF NECESSARY. */
  333.           IF TRACE1(1)=TRUE THEN
  334.              DO;
  335.                 CALL PUTLST(0,'GETTOK:TOKEN: '||TOKEN_STRING);
  336.                 CALL PUTLST(0,'GETTOK:TOKEN TYPE: '||TOKEN_TYPE);
  337.              END;
  338.  
  339. /* RETURN TO CALLER. */
  340.           END  GETTOK;
  341.  
  342.  
  343. OPEN_SRC:   PROC ;
  344. /*THIS ROUTINE IS RESPONSIBLE FOR OPENING THE OUTPUT LISTING */
  345. /* FILE.                                                     */
  346.  
  347. /* OPEN THE FILE. */
  348.      OPEN FILE(SRC_FILE) INPUT TITLE('$1.GMR');
  349.      SRC_OPEN=TRUE;
  350.      SRC_END=FALSE;
  351.      LINNUM=0;
  352.  
  353. /* RETURN TO CALLER. */
  354.           END OPEN_SRC;
  355.  
  356.  
  357. PRINT_TABLES: PROC;
  358. /*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE INTERNAL TABLES. */
  359.     DCL I BIN(15);
  360.     DCL J BIN(15);
  361.  
  362. /* LIST THE VOCABULARY. */
  363.     CALL PUTLST(0,'*** VOCABULARY ***');
  364.     DO I=1 TO NUMVOC;
  365.        CALL PUTLST(0,I||' '||VOC(I));
  366.     END;
  367.  
  368. /* LIST THE TERMINAL TABLE. */
  369.     CALL PUTLST(0,'*** TERMINAL INDEX ***');
  370.     DO I=1 TO LENGTH(TRM);
  371.        CALL PUTLST(0,I||' '||CHRNUM(SUBSTR(TRM,I,1)));
  372.     END;
  373.  
  374. /* LIST THE NON-TERMINAL TABLE. */
  375.     CALL PUTLST(0,'*** NON-TERMINAL INDEX ***');
  376.     DO I=1 TO LENGTH(NTRM);
  377.        CALL PUTLST(0,I||' '||CHRNUM(SUBSTR(NTRM,I,1)));
  378.     END;
  379.  
  380. /* LIST THE PRODUCTION TABLE. */
  381.     CALL PUTLST(0,'*** PRODUCTION INDEX ***');
  382.     DO I=1 TO NUMPRD;
  383.        CALL PUTLST(0,I||' '||CHRNUM(SUBSTR(LHS(I),1,1)));
  384.        IF LENGTH(RHS(I))=0 THEN
  385.           ;
  386.        ELSE
  387.           DO J=1 TO LENGTH(RHS(I));
  388.              CALL PUTLST(0,'           '||CHRNUM(SUBSTR(RHS(I),J,1)));
  389.           END;
  390.     END;
  391.  
  392.           END  PRINT_TABLES;
  393.  
  394.  
  395. PUTLST:   PROC (CURRENT_LINE_NUMBER,LINE_OUT);
  396. /*THIS ROUTINE IS RESPONSIBLE FOR PUTTING A LINE TO THE SOURCE */
  397. /*LISTING FILE.                                                */
  398.           DCL  CURRENT_LINE_NUMBER BIN(15);
  399.           DCL  LINE_OUT CHAR(80) VARYING;
  400.  
  401.           IF FLAGS1(1)=FALSE THEN         /*NO LISTING DESIRED*/
  402.                RETURN;
  403.  
  404.           ON ENDPAGE(LSTFIL)         /*PRINT HEADING*/
  405.                BEGIN;
  406.                     PUT FILE(LSTFIL) PAGE;
  407.                END;
  408.  
  409.           IF CURRENT_LINE_NUMBER=0 THEN
  410.                PUT FILE(LSTFIL) SKIP EDIT ('*****',LINE_OUT)
  411.                     (A(5),X(1),A);
  412.           ELSE
  413.                PUT FILE(LSTFIL) SKIP EDIT (CURRENT_LINE_NUMBER,LINE_OUT)
  414.                     (F(5),X(1),A);
  415.  
  416.           END  PUTLST;
  417.  
  418.  
  419. /****************************************************************
  420. * * * * * * * * * * * GRAMMAR ANALYSIS PROCUDURES * * * * * * * *
  421. ****************************************************************/
  422.  
  423. PROD_GRMR:   PROC ;
  424. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  425. /* RULE: <GRAMMAR> -> <RULES> '<EOF>';                       */
  426.  
  427. /* HANDLE THE RULES. */
  428.           CALL PROD_RULES;
  429.  
  430. /* HANDLE THE <EOF>. */
  431.           IF TOKEN_TYPE~=5 THEN
  432.              CALL ERROR(05,TOKEN_POSITION.LIN,TOKEN_POSITION.COL);
  433.  
  434. /* RETURN TO CALLER. */
  435.           END PROD_GRMR;
  436.  
  437.  
  438. PROD_RULES:  PROC ;
  439. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  440. /* RULE: <RULES> -> <RULE> <RULES> | <RULE> ;                */
  441.  
  442. /* HANDLE THE RULE. */
  443.       NUMPRD=0;
  444.           DO WHILE(TOKEN_TYPE=1);
  445.          NUMPRD=NUMPRD+1;
  446.              CALL PROD_RULE;
  447.           END;
  448.  
  449. /* RETURN TO CALLER. */
  450.           END PROD_RULES;
  451.  
  452.  
  453. PROD_RULE:  PROC ;
  454. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  455. /* RULE: <RULE> -> <LP> <ALTS> ';' ;                         */
  456.  
  457. /* HANDLE THE LP. */
  458.       TOKEN_RHS=FALSE;    /*INDICATE GETTING LEFT PART.*/
  459.           CALL PROD_LP;
  460.  
  461. /* HANDLE THE ALTS. */
  462.       TOKEN_RHS=TRUE;    /*INDICATE GETTING RIGHT PART.*/
  463.           CALL PROD_ALTS;
  464.  
  465. /* HANDLE THE ';'. */
  466.           IF TOKEN_TYPE=3 THEN  /**';'**/
  467.              DO;
  468.                 CALL GETTOK;  /* READ IN THE NEXT TOKEN. */
  469.              END;
  470.           ELSE
  471.              CALL ERROR(03,TOKEN_POSITION.LIN,TOKEN_POSITION.COL);
  472.  
  473. /* RETURN TO CALLER. */
  474.           END PROD_RULE;
  475.  
  476.  
  477. PROD_LP:  PROC ;
  478. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  479. /* RULE: <LP> -> <NT> ;                                      */
  480.  
  481. /* HANDLE THE NT. */
  482.           CALL PROD_NT;
  483.  
  484. /* RETURN TO CALLER. */
  485.           END PROD_LP;
  486.  
  487.  
  488. PROD_ALTS:  PROC ;
  489. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  490. /* RULE: <ALTS> -> <ALT> <ALTS> | <ALT>;                     */
  491.  
  492. /* HANDLE THE ALT. */
  493.           DO WHILE(TOKEN_TYPE=4); /**'->'**/
  494.              CALL PROD_ALT;
  495.           END;
  496.  
  497. /* RETURN TO CALLER. */
  498.           END PROD_ALTS;
  499.  
  500.  
  501. PROD_ALT:  PROC ;
  502. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  503. /* RULE: <ALT> -> '->' <RP> ;                                */
  504.  
  505. /* HANDLE THE '->'. */
  506.           IF TOKEN_TYPE=4 THEN  /**'->'**/
  507.              DO;
  508.                 CALL GETTOK;  /* READ IN THE NEXT TOKEN. */
  509.              END;
  510.           ELSE
  511.              CALL ERROR(04,TOKEN_POSITION.LIN,TOKEN_POSITION.COL);
  512.  
  513. /* HANDLE THE <RP>. */
  514.           CALL PROD_RP;
  515.  
  516. /* RETURN TO CALLER. */
  517.           END PROD_ALT;
  518.  
  519.  
  520. PROD_RP:  PROC ;
  521. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  522. /* RULE: <RP> -> <NT> <RP> | <NT> | <T> <RP> | <T> | ;       */
  523.  
  524. /* HANDLE THE <NT> OR <T>. */
  525.           DO WHILE(TOKEN_TYPE=1 | TOKEN_TYPE=2);
  526.              IF TOKEN_TYPE=1 THEN
  527.                 CALL PROD_NT;
  528.              ELSE IF TOKEN_TYPE=2 THEN
  529.                 CALL PROD_T;
  530.           END;
  531.  
  532. /* RETURN TO CALLER. */
  533.           END PROD_RP;
  534.  
  535.  
  536. PROD_NT:  PROC ;
  537. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  538. /* RULE: <NT> -> '<IDENTIFIER>';                             */
  539.  
  540. /* HANDLE THE '<IDENTIFIER>'. */
  541.           IF TOKEN_TYPE=1 THEN  /**'<IDENTIFIER>'**/
  542.              DO;
  543.         TOKEN_VOC=ENTER_VOC();  /*GET VOC INDEX FOR TOKEN.*/
  544.         IF TOKEN_RHS=TRUE THEN /**RIGHT PART**/
  545.            DO;
  546.               RHS(NUMPRD)=RHS(NUMPRD) || NUMCHR(TOKEN_VOC);
  547.            END;
  548.         ELSE            /**LEFT PART**/
  549.            DO;
  550.               LHS(NUMPRD)=NUMCHR(TOKEN_VOC);
  551.            END;
  552.                 CALL GETTOK;  /* READ IN THE NEXT TOKEN. */
  553.              END;
  554.           ELSE
  555.              CALL ERROR(01,TOKEN_POSITION.LIN,TOKEN_POSITION.COL);
  556.  
  557. /* RETURN TO CALLER. */
  558.           END PROD_NT;
  559.  
  560.  
  561. PROD_T:  PROC ;
  562. /*THIS ROUTINE IS RESPONSIBLE FOR HANDLING THE PRODUCTION    */
  563. /* RULE: <T> -> '<STRING>';                                  */
  564.     DCL K BIT(16);
  565.     DCL L CHAR;
  566.  
  567. /* HANDLE THE '<STRING>'. */
  568.           IF TOKEN_TYPE=2 THEN  /**'<STRING>'**/
  569.              DO;
  570.         TOKEN_VOC=ENTER_VOC();  /*GET VOC INDEX FOR TOKEN.*/
  571.         K=UNSPEC(TOKEN_VOC);
  572.         UNSPEC(L)=SUBSTR(K,9,8);
  573.         IF TOKEN_RHS=TRUE THEN /**RIGHT PART**/
  574.            DO;
  575.               RHS(NUMPRD)=RHS(NUMPRD) ||L;
  576.            END;
  577.         ELSE            /**LEFT PART**/
  578.            DO;
  579.               CALL ERROR(02,TOKEN_POSITION.LIN,TOKEN_POSITION.COL);
  580.            END;
  581.                 CALL GETTOK;  /* READ IN THE NEXT TOKEN. */
  582.              END;
  583.           ELSE
  584.              CALL ERROR(02,TOKEN_POSITION.LIN,TOKEN_POSITION.COL);
  585.  
  586. /* RETURN TO CALLER. */
  587.           END PROD_T;
  588.  
  589.  
  590. /****************************************************************
  591. * * * * * * * * * * * MAIN LINE PROCEDURE * * * * * * * * * * * *
  592. ****************************************************************/
  593.  
  594. /* DO INITIALIZATION. */
  595.       PUT SKIP LIST('BEGINNING PHASE 1 PROCESSING.');
  596.       CALL OPEN_SRC;           /* OPEN GRAMMAR INPUT FILE. */
  597.       CALL GETLIN;             /* GET THE FIRST LINE. */
  598.       NXTCOL=01;               /* SET NEXT COLUMN FIRST TIME THRU. */
  599.  
  600. /* PROCESS ALL INPUT LINES. */
  601.      CALL GETTOK;              /* GET THE FIRST TOKEN. */
  602.      CALL GETGMR;              /* READ IN THE GRAMMAR. */
  603.  
  604. /* RETURN TO CALLER. */
  605.      CALL PUTLST(0,'NUMBER OF PRODUCTIONS:'||NUMPRD);
  606.      CALL PUTLST(0,'NUMBER OF TERMINALS:'||LENGTH(TRM));
  607.      CALL PUTLST(0,'NUMBER OF NON-TERMINALS:'||LENGTH(NTRM));
  608.      CALL PUTLST(0,'NUMBER OF ERRORS:'||ERRNUM);
  609.      CALL PUTLST(0,'INPUT OF GRAMMAR COMPLETE.');
  610.      IF FLAGS1(2)=TRUE THEN
  611.     CALL PRINT_TABLES;
  612.      CALL CLOSE_SRC;           /* CLOSE FILES. */
  613.     PUT SKIP LIST('NUMBER OF PRODUCTIONS:',NUMPRD);
  614.     PUT SKIP LIST('NUMBER OF TERMINALS:',LENGTH(TRM));
  615.     PUT SKIP LIST('NUMBER OF NON-TERMINALS:',LENGTH(NTRM));
  616.      IF ERRNUM>0 THEN          /* TERMINATE IF ERRORS. */
  617.         DO;
  618.        PUT SKIP LIST(ERRNUM||' ERRORS ENCOUNTERED.');
  619.        STOP;
  620.     END;
  621.      PUT SKIP LIST('PHASE 1 PROCESSING COMPLETE - NO ERRORS.');
  622.      END LL1P10;
  623.  
  624.  
  625.