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