home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol039 / ll1prc.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  12.3 KB  |  470 lines
  1. LL1PRC: PROC;
  2. /****************************************************************
  3. *              LL(1) GRAMMAR ANALYZER - COMMON PROCEDURES    *
  4. *PURPOSE:                                                       *
  5. *    THIS PROGRAM CONTAINS THE COMMON PROCEDURES USES BY        *
  6. *    MOST OF THE OTHER PHASES.                    *
  7. *INPUT:                                                         *
  8. *OUTPUT:                                                        *
  9. *OUTLINE:                                                       *
  10. *REMARKS:                                                       *
  11. ****************************************************************/
  12.  
  13. /****************************************************************
  14. * * * * * * * * * * * COMMON DATA DEFINITIONS * * * * * * * * * *
  15. ****************************************************************/
  16.  
  17. /*    * * *  COMMON REPLACEMENTS  * * *    */
  18. %REPLACE TRUE BY '1'B;
  19. %REPLACE FALSE BY '0'B;
  20.  
  21. %INCLUDE 'LL1CMN.DCL';    /* GET COMMON AREAS. */
  22.  
  23. /****************************************************************
  24. * * * * * * * * * * * COMMON PROCUDURES * * * * * * * * * * * * *
  25. ****************************************************************/
  26.  
  27. /********************* CHR_TO_NUM ******************************/
  28. CHRNUM: PROC (L) RETURNS(BIN(15)) EXTERNAL;
  29. /* THIS ROUTINE IS RESPONSIBLE FOR CONVERTING A CHARACTER */
  30. /* TO A BINARY NUMBER. */
  31.  
  32.      DCL  J BIN(15);               /* LOOP INDEX */
  33.      DCL  K BIT(16);               /* INTERMEDIATE BIT VALUE */
  34.      DCL  L CHAR;                  /* INTERMEDIATE CHAR VALUE */
  35.      DCL  M BIT(8);
  36.  
  37.      M=UNSPEC(L);
  38.      K='0000'B4;
  39.      SUBSTR(K,9,8)=M;
  40.      UNSPEC(J)=K;
  41.  
  42. /*   RETURN TO CALLER WITH CHARACTER. */
  43.      RETURN(J);
  44.      END  CHRNUM;
  45.  
  46.  
  47. /********************* CLOSURE ******************************/
  48. CLOSUR: PROC(ARRAY_PTR) EXTERNAL;
  49. /*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE REFLEXIVE */
  50. /*TRANSITIVE CLOSURE OF THE ARRAY SPECIFIED. */
  51.     DCL I FIXED;        /* INDICES */
  52.     DCL J FIXED;
  53.     DCL K FIXED;
  54.     DCL LIMIT FIXED;
  55.     DCL ARRAY_PTR PTR;
  56.  
  57. /* PUT IN THE IDENTITY MATRIX. */
  58.     LIMIT=LENGTH(NTRM)+LENGTH(TRM);
  59.     DO I=1 TO LIMIT;
  60.        CALL SETBIT(I,I,ARRAY_PTR);
  61.     END;
  62.  
  63. /* COMPUTE THE REFLEXIVE TRANSITIVE CLOSURE. */
  64.     DO I=1 TO LIMIT;
  65.        DO J=1 TO LIMIT;
  66.           IF TSTBIT(J,I,ARRAY_PTR) THEN
  67.          DO K=1 TO LIMIT;
  68.             IF TSTBIT(J,K,ARRAY_PTR) | TSTBIT(I,K,ARRAY_PTR) THEN
  69.                CALL SETBIT(J,K,ARRAY_PTR);
  70.          END;
  71.        END;
  72.     END;
  73.  
  74. /* RETURN TO CALLER. */
  75.         END  CLOSUR;
  76.  
  77.  
  78. /********************* IS_NTRM ******************************/
  79. ISNTRM: PROC (X) RETURNS(BIT(1)) EXTERNAL;
  80. /* THIS ROUTINE INDICATES IF A VOCABULARY ELEMENT IS */
  81. /* A NON-TERMINAL. */
  82.     DCL X CHAR;        /* INPUT INDEX */
  83.     DCL I FIXED;        /* INTERNAL INDEX */
  84.  
  85.     IF LENGTH(NTRM)=0 THEN
  86.        RETURN(FALSE);
  87.  
  88.     DO I=1 TO LENGTH(NTRM);
  89.        IF X=SUBSTR(NTRM,I,1) THEN
  90.           RETURN(TRUE);
  91.     END;
  92.  
  93.     RETURN(FALSE);
  94.     END ISNTRM;
  95.     
  96.  
  97. /********************* IS_NLNTRM ******************************/
  98. ISNLNT: PROC (X) RETURNS(BIT(1)) EXTERNAL;
  99. /* THIS ROUTINE INDICATES IF A VOCABULARY ELEMENT IS */
  100. /* A NULLABLE NON-TERMINAL. */
  101.     DCL X CHAR;        /* INPUT INDEX */
  102.     DCL I FIXED;        /* INTERNAL INDEX */
  103.  
  104.     IF LENGTH(NLNTRM)=0 THEN
  105.        RETURN(FALSE);
  106.  
  107.     IF ISNTRM(X)=FALSE THEN /*NOT A NON-TERMINAL*/
  108.        RETURN(FALSE);
  109.  
  110.     DO I=1 TO LENGTH(NLNTRM);
  111.        IF X=SUBSTR(NLNTRM,I,1) THEN
  112.           RETURN(TRUE);
  113.     END;
  114.  
  115.     RETURN(FALSE);
  116.     END ISNLNT;
  117.     
  118.  
  119. /********************* IS_TRM ******************************/
  120. ISTRM: PROC (X) RETURNS(BIT(1)) EXTERNAL;
  121. /* THIS ROUTINE INDICATES IF A VOCABULARY ELEMENT IS TERMINAL. */
  122.     DCL X CHAR;        /* INPUT INDEX */
  123.     DCL I FIXED;        /* INTERNAL INDEX */
  124.  
  125.     IF LENGTH(TRM)=0 THEN
  126.        RETURN(FALSE);
  127.  
  128.     DO I=1 TO LENGTH(TRM);
  129.        IF X=SUBSTR(TRM,I,1) THEN
  130.           RETURN(TRUE);
  131.     END;
  132.  
  133.     RETURN(FALSE);
  134.     END ISTRM;
  135.     
  136.  
  137. /********************* MULTREL ******************************/
  138. MULREL: PROC EXTERNAL;
  139. /*THIS ROUTINE IS RESPONSIBLE FOR MULTIPLYING TWO RELATION- */
  140. /*SHIPS TOGETHER. */
  141.     DCL I FIXED;        /* INDICES */
  142.     DCL J FIXED;
  143.     DCL K FIXED;
  144.     DCL LIMIT FIXED;
  145.     DCL ARRAY_PTR PTR;
  146.     DCL ARRAY3(256,32) BIT(8) BASED(ARRAY_PTR);
  147.  
  148. /* DO INITIALIZATION. */
  149.     LIMIT=LENGTH(NTRM)+LENGTH(TRM); /*GET ARRAY SIZE.*/
  150.     ALLOCATE ARRAY3 SET(ARRAY_PTR);
  151.     CALL ZEROAR(ARRAY_PTR);
  152.  
  153. /* MULTIPLY ARRAY1 BY ARRAY2. */
  154.     DO J=1 TO LIMIT;
  155.        DO I=1 TO LIMIT;
  156.           IF TSTBIT(I,J,ADDR(ARRAY1)) THEN
  157.          DO K=1 TO LIMIT;
  158.             IF TSTBIT(J,K,ADDR(ARRAY2)) THEN
  159.                CALL SETBIT(I,K,ARRAY_PTR);
  160.          END;
  161.        END;
  162.     END;
  163.  
  164. /* PUT THE PRODUCT BACK IN ARRAY1. */
  165.     DO I=1 TO LIMIT;
  166.        DO J=1 TO 32;
  167.           ARRAY1(I,J)=ARRAY3(I,J);
  168.        END;
  169.     END;
  170.     FREE ARRAY3;
  171.  
  172. /* RETURN TO CALLER. */
  173.         END  MULREL;
  174.  
  175.  
  176. /********************* NUM_TO_CHR ******************************/
  177. NUMCHR: PROC (J) RETURNS(CHAR) EXTERNAL;
  178. /* THIS ROUTINE IS RESPONSIBLE FOR CONVERTING A BINARY*/
  179. /* NUMBER TO A CHARACTER.*/
  180.  
  181.      DCL  J BIN(15);               /* LOOP INDEX */
  182.      DCL  K BIT(16);               /* INTERMEDIATE BIT VALUE */
  183.      DCL  L CHAR;                  /* INTERMEDIATE CHAR VALUE */
  184.  
  185.      UNSPEC(K)=J;
  186.      UNSPEC(L)=SUBSTR(K,8,8);
  187.  
  188. /*   RETURN TO CALLER WITH CHARACTER. */
  189.      RETURN(L);
  190.      END  NUMCHR;
  191.  
  192.  
  193. /********************* PRINT_ARRAY ******************************/
  194. PRTARY: PROC(HEADING,PHS,HORNUM,VERNUM,ARRAY_PTR) EXTERNAL;
  195. /*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE RELATION */
  196. /*DEFINED BY ARRAY1. */
  197.     DCL I BIN(15);        /* INDEXES */
  198.     DCL J BIN(15);
  199.     DCL COL_FROM FIXED;
  200.     DCL COL_TO FIXED;
  201.     DCL LIN_FROM FIXED;
  202.     DCL LIN_TO FIXED;
  203.     DCL HEADING CHAR(40) VARYING;
  204.     DCL PHS BIT(1);        /* PRINT HORIZONTAL SYMBOL FLAG */
  205.     DCL HORNUM FIXED;    /* NUMBER OF HORIZONTAL LINES */
  206.     DCL VERNUM FIXED;    /* NUMBER OF VERTICAL LINES */
  207.     DCL ARRAY_PTR PTR;
  208.  
  209. /* PRINT HEADING. */
  210. PRINT_HDNG: PROC(COL_FROM,COL_TO);
  211.     DCL I FIXED;
  212.     DCL J FIXED;
  213.     DCL COL_FROM FIXED;
  214.     DCL COL_TO FIXED;
  215.     DCL LINE_OUT CHAR(130) VARYING;
  216.  
  217. /* PRINT STANDARD HEADER. */
  218.     PUT FILE(LSTFIL) PAGE;
  219.     PUT FILE(LSTFIL) SKIP(3) 
  220.         EDIT(HEADING,'PAGE',PAGENO(LSTFIL)-1)
  221.           (X(15),A(37),X(10),A(4),F(4));
  222.     PUT FILE(LSTFIL) SKIP(1);
  223.     
  224. /* PRINT LINES OF SYMBOL NUMBERS FOR HORIZONTAL. */
  225.     I=100;
  226.     DO WHILE(I>0);
  227.        LINE_OUT='';
  228.        DO J=COL_FROM TO COL_TO;
  229.           IF J<I THEN
  230.          LINE_OUT=LINE_OUT || ' ';
  231.           ELSE
  232.          LINE_OUT=LINE_OUT || ASCII(48+MOD(J/I,10));
  233.        END;
  234.        PUT FILE(LSTFIL) SKIP EDIT(LINE_OUT) (X(20),A);
  235.        I=I/10;
  236.     END;
  237.  
  238. /* PRINT TOP SEPERATOR LINE. */
  239.     CALL PRINT_SEP(COL_FROM,COL_TO);
  240.  
  241. /* RETURN TO CALLER. */
  242.        END PRINT_HDNG;
  243.  
  244. /* PRINT THE CURRENT LINE. */
  245. PRINT_LINE: PROC(COL_CUR,COL_FROM,COL_TO);
  246.     DCL I FIXED;
  247.     DCL COL_CUR FIXED;
  248.     DCL COL_FROM FIXED;
  249.     DCL COL_TO FIXED;
  250.     DCL LINE_OUT CHAR(130) VARYING;
  251.     DCL SYMBOL CHAR(10) VARYING;
  252.  
  253. /* BUILD MATRIX PART OF LINE. */
  254.     LINE_OUT='';
  255.     DO I=COL_FROM TO COL_TO;
  256.        IF TSTBIT(COL_CUR,I,ARRAY_PTR) THEN
  257.           LINE_OUT=LINE_OUT || '1';
  258.        ELSE
  259.           LINE_OUT=LINE_OUT || '0';
  260.     END;
  261.  
  262. /* PRINT THE LINE. */
  263.     IF PHS THEN
  264.        SYMBOL=VOC(COL_CUR);
  265.     ELSE
  266.        SYMBOL='';
  267.     PUT FILE(LSTFIL) SKIP EDIT(COL_CUR,SYMBOL,'|',LINE_OUT,'|')
  268.                  (X(04),F(4),X(01),A(10),A(1),A,A(1));
  269.  
  270. /* RETURN TO CALLER. */
  271.        END PRINT_LINE;
  272.  
  273. PRINT_SEP: PROC(COL_FROM,COL_TO);
  274.     DCL I FIXED;
  275.     DCL J FIXED;
  276.     DCL COL_FROM FIXED;
  277.     DCL COL_TO FIXED;
  278.     DCL LINE_OUT CHAR(130) VARYING;
  279.  
  280. /* PRINT SEPERATOR LINE. */
  281.     LINE_OUT='+';
  282.     DO I=COL_FROM TO COL_TO;
  283.        LINE_OUT=LINE_OUT || '-';
  284.     END;
  285.     LINE_OUT=LINE_OUT || '+';
  286.     PUT FILE(LSTFIL) SKIP EDIT(LINE_OUT) (X(19),A);
  287.  
  288. /* RETURN TO CALLER. */
  289.        END PRINT_SEP;
  290.  
  291. /* OUTPUT THE HEADING. */
  292.     ON ENDPAGE(LSTFIL)
  293.        BEGIN;
  294.           CALL PRINT_HDNG(COL_FROM,COL_TO);
  295.        END;
  296.  
  297. /* PRINT THE REPORT PAGE. */
  298.     LIN_FROM=1;        /* SET MARGINS. */
  299.     DO WHILE(LIN_FROM<HORNUM);  /* PRINT HORIZONTAL LINES. */
  300.        LIN_TO=MIN(HORNUM,55+LIN_FROM);
  301.        COL_FROM=1;
  302.        DO WHILE(COL_FROM<VERNUM); /* PRINT VERTICAL LINES. */
  303.           COL_TO=MIN(VERNUM,55+COL_FROM);
  304.           SIGNAL ENDPAGE(LSTFIL);
  305.           DO I=LIN_FROM TO LIN_TO;    /* PRINT THE PAGE. */
  306.              CALL PRINT_LINE(I,COL_FROM,COL_TO);
  307.           END;
  308.           CALL PRINT_SEP(COL_FROM,COL_TO);
  309.           COL_FROM=COL_FROM+56;
  310.        END;
  311.        LIN_FROM=LIN_FROM+56;
  312.     END;
  313.  
  314. /* RETURN TO CALLER. */
  315.         END  PRTARY;
  316.  
  317.  
  318. /********************* RESET_BIT ******************************/
  319. RSTBIT: PROC(X,Y,ARRAY_PTR) EXTERNAL;
  320. /*THIS ROUTINE IS RESPONSIBLE FOR RESETING ON THE BIT DENOTED */
  321. /*BY THE X,Y COORDINATES IN THE ARRAY SPECIFIED. */
  322.     DCL I FIXED;        /* INDICES */
  323.     DCL J FIXED;
  324.     DCL K FIXED;
  325.     DCL X BIN(15);        /* INDICES */
  326.     DCL Y BIN(15);
  327.     DCL ARRAY_PTR PTR;
  328.     DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
  329.  
  330. /* DEVELOP ACTUAL ARRAY ELEMENT USING X,Y COORDINATES. */
  331.     I=X;            /* VERTICAL */
  332.     J=(Y/8)+1;        /* HORIZONTAL - BYTE */
  333.     K=MOD(Y,8)+1;        /* HORIZONTAL - BIT */
  334.  
  335. /* SET THE BIT IN THE ARRAY. */
  336.     SUBSTR(ARRAY(I,J),K,1)=FALSE;
  337.  
  338. /* RETURN TO CALLER. */
  339.         END  RSTBIT;
  340.  
  341.  
  342. /********************* RESTORE_ARRAY ******************************/
  343. RSTARY: PROC(ARRAY_PTR,FILE_TYPE) EXTERNAL;
  344. /* THIS ROUTINE IS RESPONSIBLE FOR RESTORING AN ARRAY. */
  345.     DCL I FIXED;        /* INDICES */
  346.     DCL J FIXED;
  347.     DCL BW_FILE FILE;
  348.     DCL FILE_TYPE CHAR(3);
  349.     DCL FILE_NAME CHAR(20) VARYING;
  350.     DCL ARRAY_PTR PTR;
  351.     DCL ARRAY(64) CHAR(128) BASED(ARRAY_PTR);
  352.  
  353. /* OPEN THE FILE. */
  354.     FILE_NAME='$1.'||FILE_TYPE;
  355.         OPEN FILE(BW_FILE) DIRECT INPUT TITLE(FILE_NAME)
  356.          ENV(F(128));
  357.  
  358. /* WRITE THE ARRAY TO IT. */
  359.     DO I=0 TO 63;
  360.        READ FILE(BW_FILE) INTO(ARRAY(I+1)) KEY(I);
  361.     END;
  362.  
  363. /* SAVE THE FILE. */
  364.     CLOSE FILE(BW_FILE);
  365.  
  366. /* RETURN TO CALLER. */
  367.         END  RSTARY;
  368.  
  369.  
  370. /********************* SAVE_ARRAY ******************************/
  371. SAVARY: PROC(ARRAY_PTR,FILE_TYPE) EXTERNAL;
  372. /* THIS ROUTINE IS RESPONSIBLE FOR SAVING AN ARRAY. */
  373.     DCL I FIXED;        /* INDICES */
  374.     DCL J FIXED;
  375.     DCL BW_FILE FILE;
  376.     DCL FILE_TYPE CHAR(3);
  377.     DCL FILE_NAME CHAR(20) VARYING;
  378.     DCL ARRAY_PTR PTR;
  379.     DCL ARRAY(64) CHAR(128) BASED(ARRAY_PTR);
  380.  
  381. /* OPEN THE FILE. */
  382.     FILE_NAME='$1.'||FILE_TYPE;
  383.         OPEN FILE(BW_FILE) DIRECT OUTPUT TITLE(FILE_NAME)
  384.          ENV(F(128));
  385.  
  386. /* WRITE THE ARRAY TO IT. */
  387.     DO I=0 TO 63;
  388.        WRITE FILE(BW_FILE) FROM(ARRAY(I+1)) KEYFROM(I);
  389.     END;
  390.  
  391. /* SAVE THE FILE. */
  392.     CLOSE FILE(BW_FILE);
  393.  
  394. /* RETURN TO CALLER. */
  395.         END  SAVARY;
  396.  
  397.  
  398. /********************* SET_BIT ***************************/
  399. SETBIT: PROC(X,Y,ARRAY_PTR) EXTERNAL;
  400. /*THIS ROUTINE IS RESPONSIBLE FOR SETING ON THE BIT DENOTED */
  401. /*BY THE X,Y COORDINATES IN THE ARRAY SPECIFIED. */
  402.     DCL I FIXED;        /* INDICES */
  403.     DCL J FIXED;
  404.     DCL K FIXED;
  405.     DCL X BIN(15);        /* INDICES */
  406.     DCL Y BIN(15);
  407.     DCL ARRAY_PTR PTR;
  408.     DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
  409.  
  410. /* DEVELOP ACTUAL ARRAY ELEMENT USING X,Y COORDINATES. */
  411.     I=X;            /* VERTICAL */
  412.     J=(Y/8)+1;        /* HORIZONTAL - BYTE */
  413.     K=MOD(Y,8)+1;        /* HORIZONTAL - BIT */
  414.  
  415. /* SET THE BIT IN THE ARRAY. */
  416.     SUBSTR(ARRAY(I,J),K,1)=TRUE;
  417.  
  418. /* RETURN TO CALLER. */
  419.         END  SETBIT;
  420.  
  421.  
  422. /********************* TEST_BIT ***************************/
  423. TSTBIT: PROC(X,Y,ARRAY_PTR) RETURNS(BIT(1)) EXTERNAL;
  424. /*THIS ROUTINE IS RESPONSIBLE FOR TESTING THE BIT DENOTED */
  425. /*BY THE X,Y COORDINATES IN THE ARRAY SPECIFIED. */
  426.     DCL I FIXED;        /* INDICES */
  427.     DCL J FIXED;
  428.     DCL K FIXED;
  429.     DCL X BIN(15);        /* INDICES */
  430.     DCL Y BIN(15);
  431.     DCL ARRAY_PTR PTR;
  432.     DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
  433.  
  434. /* DEVELOP ACTUAL ARRAY ELEMENT USING X,Y COORDINATES. */
  435.     I=X;            /* VERTICAL */
  436.     J=(Y/8)+1;        /* HORIZONTAL - BYTE */
  437.     K=MOD(Y,8)+1;        /* HORIZONTAL - BIT */
  438.  
  439. /* RETURN THE BIT IN THE ARRAY. */
  440.     RETURN(SUBSTR(ARRAY(I,J),K,1));
  441.  
  442. /* RETURN TO CALLER. */
  443.         END  TSTBIT;
  444.  
  445.  
  446. /********************* ZERO_ARRAY ***************************/
  447. ZEROAR: PROC(ARRAY_PTR) EXTERNAL;
  448. /*THIS ROUTINE IS RESPONSIBLE FOR ZEROING THE ARRAY SPECIFIED. */
  449.     DCL I FIXED;        /* INDICES */
  450.     DCL J FIXED;
  451.     DCL ARRAY_PTR PTR;
  452.     DCL ARRAY(256,32) BIT(8) BASED(ARRAY_PTR);
  453.  
  454. /* ZERO THE ARRAY. */
  455.     DO I=1 TO 256;
  456.        DO J=1 TO 32;
  457.           ARRAY(I,J)='00000000'B;
  458.        END;
  459.     END;
  460.  
  461. /* RETURN TO CALLER. */
  462.         END  ZEROAR;
  463.  
  464.  
  465. /****************************************************************
  466. * * * * * * * * * * * MAIN ROUTINE  * * * * * * * * * * * * * * *
  467. ****************************************************************/
  468.  
  469.     END LL1PRC;
  470.