Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50271/syntax.alg
There are 2 other files named syntax.alg in the archive. Click here to see a list.
00100	BEGIN
00200	 INTEGER ARRAY F(1::180); INTEGER ARRAY G(1::180); INTEGER TIME;
00300	 BITS (2) ARRAY MATRIX(1::180,1::180); STRING (12) ARRAY NAMES(1::180);
00400	 BITS (1) ARRAY TERMINAL(1::180); BITS (1) ARRAY DEFINED(1::180);
00500	 INTEGER ARRAY SYNTAX(1::1000); INTEGER ARRAY POINTER(1::180);
00600	 INTEGER MAXSYNTAX; INTEGER MAXNAMES; STRING (2) CRLF; STRING (4) REL;
00700	 STRING (1) FORMFEED; INTEGER ARRAY ACTION(1::180); INTEGER ERRORS;
00800	 PROCEDURE GETMATRIX;
00900	 BEGIN
01000	  BITS (1) ARRAY LEFT(1::180,1::180);
01100	  BITS (1) ARRAY RIGHT(1::180,1::180);
01200	  INTEGER Q; INTEGER M; INTEGER N;
01300	  PROCEDURE LOOKUP(INTEGER POINT; STRING (12) NAME);
01400	  BEGIN
01500	   INTEGER INDEX; INTEGER MSWITCH;
01600	   INDEX:=1; MSWITCH:=0;
01700	   WHILE MSWITCH EQL 0 AND INDEX LEQ MAXNAMES DO
01800	    IF NAMES(INDEX) EQL NAME THEN MSWITCH:=1 ELSE INDEX:=INDEX+1;
01900	   IF MSWITCH EQL 0 THEN BEGIN
02000	    INDEX:=MAXNAMES+1; MAXNAMES:=INDEX;
02100	    IF MAXNAMES GTR 180 THEN ERROR("TOO MANY NAMES");
02200	    NAMES(INDEX):=NAME;
02300	   END;
02400	   POINT:=INDEX;
02500	  END;
02600	  PROCEDURE SETREL(INTEGER L; INTEGER R; BITS (2) S);
02700	  BEGIN
02800	   IF MATRIX(L,R) NEQ #00 AND MATRIX(L,R) NEQ S THEN BEGIN
02900	    IF ERRORS EQL 0 THEN BEGIN
03000	     OUTSTRING(2,FORMFEED); OUTSTRING(2,"PRECEDENCE VIOLATIONS");
03100	     OUTSTRING(2,CRLF); OUTSTRING(2,CRLF);
03200	    END;
03300	    OUTSTRING(2,NAMES(L)); OUTSTRING(2," ");
03400	    OUTSTRING(2,REL(BITINT(S)+1,1));
03500	    OUTSTRING(2,REL(BITINT(MATRIX(L,R))+1,1));
03600	    OUTSTRING(2," "); OUTSTRING(2,NAMES(R));
03700	    OUTSTRING(2,CRLF); ERRORS:=ERRORS+1;
03800	   END ELSE MATRIX(L,R):=S;
03900	  END;
04000	  PROCEDURE READSYNTAX;
04100	  BEGIN
04200	   STRING (80) TEXT;
04300	   INTEGER SAVE; INTEGER COUNT; INTEGER LINE;
04400	   STRING (80) INPUT; STRING (12) WORD; INTEGER INDEX;
04500	   PROCEDURE CHKMAXSYNTAX;
04600	   BEGIN
04700	    MAXSYNTAX:=MAXSYNTAX+1;
04800	    IF MAXSYNTAX GTR 1000 THEN
04900	     ERROR("TOO MANY PRODUCTIONS OR TOO COMPLEX");
05000	   END;
05100	   PROCEDURE UNPACK;
05200	   BEGIN
05300	    INTEGER I; INTEGER J; INTEGER K; INTEGER L;
05400	    I:=1; J:=12; K:=0; L:=0; INPUT:=" ";
05500	    IF TEXT(1,1) EQL " " THEN BEGIN
05600	     I:=13; J:=24
05700	    END;
05800	    FOR A:=1 STEP 1 UNTIL 80 DO BEGIN
05900	     IF K NEQ 0 AND TEXT(A,1) EQL " " THEN BEGIN
06000	      IF L EQL 1 AND TEXT(A-1,1) EQL ">" THEN BEGIN
06100	       I:=J+1; J:=J+12; K:=0
06200	      END ELSE IF L EQL 0 THEN BEGIN
06300	       I:=J+1; J:=J+12; K:=0
06400	      END ELSE IF I LEQ J THEN BEGIN
06500	       INPUT(I,1):=TEXT(A,1); I:=I+1
06600	      END
06700	     END ELSE BEGIN
06800	      IF K EQL 0 AND TEXT(A,1) NEQ " " THEN BEGIN
06900	       IF I LSS 73 THEN K:=1 ELSE BEGIN
07000	        OUTSTRING(2,"WARNING - TOO MANY SYMBOLS ON LINE");
07100	        OUTSTRING(2,CRLF);
07200	        OUTSTRING(2,"          PRODUCTION IGNORED");
07300	        OUTSTRING(2,CRLF);
07400	       END;
07500	       IF TEXT(A,1) EQL "<" THEN L:=1 ELSE L:=0
07600	      END;
07700	      IF I LEQ J AND K NEQ 0 THEN BEGIN
07800	       INPUT(I,1):=TEXT(A,1); I:=I+1
07900	      END
08000	     END
08100	    END;
08200	    IF K EQL 0 THEN COUNT:=J-12 ELSE COUNT:=I
08300	   END;
08400	   FOR I:=1 STEP 1 UNTIL 180 DO TERMINAL(I):=#1;
08500	   LINE:=0; MAXNAMES:=0; MAXSYNTAX:=0;
08600	   OUTSTRING(2,"        PRODUCTIONS");
08700	   OUTSTRING(2,CRLF); OUTSTRING(2,CRLF);
08800	NEXTCARD:
08900	   LINE:=LINE+1; IF ENDFILE(1) THEN GO TO ENDINPUT;
09000	   TEXT:=INSTRING(1,80); UNPACK;
09100	   IF INPUT(1,12) EQL " " AND INPUT(13,12) EQL " " THEN GO TO ENDINPUT;
09200	   IF INPUT(1,12) NEQ " " AND INPUT(13,12) EQL " " THEN BEGIN
09300	    LINE:=LINE-1; WORD:=INPUT(1,12); LOOKUP(COUNT,WORD); GO TO NEXTCARD;
09400	   END;
09500	   OUTSTRING(2,INTSTR(LINE,5)); OUTSTRING(2,".  ");
09600	   OUTSTRING(2,INPUT(1,12)); OUTSTRING(2," ::= ");
09700	   FOR I:=13 STEP 12 UNTIL 61 DO
09800	    IF I LEQ COUNT THEN BEGIN
09900	     OUTSTRING(2,INPUT(I,12)); OUTSTRING(2," ");
10000	    END;
10100	   OUTSTRING(2,CRLF); WORD:=INPUT(1,12);
10200	   IF WORD NEQ " " THEN BEGIN LOOKUP(INDEX,WORD);
10300	    IF TERMINAL(INDEX) EQL #0 THEN BEGIN
10400	     OUTSTRING(2,"WARNING - MULTIPLE OCCURRANCE OF PRODUCTION");
10500	     OUTSTRING(2,CRLF);
10600	     OUTSTRING(2,"          PREVIOUS OCCURRANCES IGNORED");
10700	     OUTSTRING(2,CRLF);
10800	    END;
10900	    DEFINED(INDEX):=#1; TERMINAL(INDEX):=#0; ACTION(INDEX):=LINE;
11000	    IF MAXSYNTAX GTR 0 THEN BEGIN
11100	     CHKMAXSYNTAX; SYNTAX(MAXSYNTAX):=0;
11200	    END;
11300	    POINTER(INDEX):=MAXSYNTAX+1;
11400	   END;
11500	   IF MAXSYNTAX EQL 0 AND INPUT(1,12) EQL " " THEN BEGIN
11600	    OUTSTRING(2,"WARNING - FIRST PRODUCTION NOT NAMED");
11700	    OUTSTRING(2,CRLF);
11800	    OUTSTRING(2,"          PRODUCTION IGNORED");
11900	    OUTSTRING(2,CRLF); GO TO NEXTCARD;
12000	   END;
12100	   CHKMAXSYNTAX; SYNTAX(MAXSYNTAX):=1; SAVE:=MAXSYNTAX; COUNT:=13;
12200	   WHILE COUNT LEQ 61 DO IF INPUT(COUNT,12) EQL " " THEN
12300	    COUNT:=73 ELSE BEGIN
12400	    WORD:=INPUT(COUNT,12); LOOKUP(INDEX,WORD);
12500	    DEFINED(INDEX):=#1; CHKMAXSYNTAX; SYNTAX(MAXSYNTAX):=INDEX;
12600	    SYNTAX(SAVE):=SYNTAX(SAVE)+1; COUNT:=COUNT+12;
12700	   END;
12800	   GO TO NEXTCARD;
12900	ENDINPUT: CHKMAXSYNTAX; SYNTAX(MAXSYNTAX):=0;
13000	   IF MAXSYNTAX EQL 1 THEN ERROR("NO PRODUCTIONS READ");
13100	   OUTSTRING(2,FORMFEED); OUTSTRING(2,"TERMINAL SYMBOLS");
13200	   OUTSTRING(2,CRLF); OUTSTRING(2,CRLF); COUNT:=0;
13300	   FOR I:=1 STEP 1 UNTIL MAXNAMES DO
13400	    IF DEFINED(I) EQL #1 AND TERMINAL(I) EQL #1 THEN BEGIN
13500	     OUTSTRING(2,INTSTR(I,6)); OUTSTRING(2,"  ");
13600	     OUTSTRING(2,NAMES(I)); COUNT:=COUNT+1;
13700	     IF COUNT EQL 6 THEN BEGIN
13800	      OUTSTRING(2,CRLF); COUNT:=0;
13900	     END;
14000	    END;
14100	   IF COUNT GTR 0 THEN OUTSTRING(2,CRLF);
14200	   OUTSTRING(2,CRLF); OUTSTRING(2,CRLF); OUTSTRING(2,"NONTERMINAL SYMBOLS");
14300	   OUTSTRING(2,CRLF); OUTSTRING(2,CRLF); COUNT:=0;
14400	   FOR I:=1 STEP 1 UNTIL MAXNAMES DO
14500	    IF DEFINED(I) EQL #1 AND TERMINAL(I) EQL #0 THEN BEGIN
14600	     OUTSTRING(2,INTSTR(I,6)); OUTSTRING(2,"  ");
14700	     OUTSTRING(2,NAMES(I)); COUNT:=COUNT+1;
14800	     IF COUNT EQL 6 THEN BEGIN
14900	      OUTSTRING(2,CRLF); COUNT:=0;
15000	     END;
15100	    END;
15200	   IF COUNT GTR 0 THEN OUTSTRING(2,CRLF);
15300	   OUTSTRING(2,CRLF); OUTSTRING(2,CRLF);
15400	   FOR I:=1 STEP 1 UNTIL MAXNAMES DO
15500	    IF DEFINED(I) EQL #0 THEN BEGIN
15600	     OUTSTRING(2,"WARNING - UNUSED SYMBOL ");
15700	     OUTSTRING(2,NAMES(I)); OUTSTRING(2,CRLF);
15800	    END;
15900	   FOR I:=1 STEP 1 UNTIL MAXNAMES DO
16000	    IF TERMINAL(I) EQL #0 THEN BEGIN
16100	     INDEX:=POINTER(I);
16200	     WHILE SYNTAX(INDEX) NEQ 0 DO BEGIN
16300	      FOR J:=1 STEP 1 UNTIL MAXNAMES DO
16400	       IF TERMINAL(J) EQL #0 THEN BEGIN
16500	        COUNT:=POINTER(J);
16600	        WHILE SYNTAX(COUNT) NEQ 0 DO BEGIN
16700	         IF INDEX NEQ COUNT AND SYNTAX(INDEX) EQL SYNTAX(COUNT) THEN BEGIN
16800	          FOR K:=1 STEP 1 UNTIL SYNTAX(INDEX)-1 DO
16900	           IF SYNTAX(COUNT+K) NEQ SYNTAX(INDEX+K) THEN GO TO L1;
17000	           OUTSTRING(2,"WARNING - IDENTICAL RIGHT PARTS IN ");
17100	           OUTSTRING(2,NAMES(I)); OUTSTRING(2," AND ");
17200	           OUTSTRING(2,NAMES(J)); OUTSTRING(2,CRLF);
17300	      L1:END;
17400	         COUNT:=COUNT+SYNTAX(COUNT);
17500	        END;
17600	       END;
17700	      INDEX:=INDEX+SYNTAX(INDEX);
17800	     END;
17900	    END;
18000	  END;
18100	 CRLF:=BITSTR(#00011010001010); FORMFEED:=BITSTR(#0001100);
18200	 OUTSTRING(0,"IN FILE: "); OPENIN(1,INSTRING(0,80));
18300	 OUTSTRING(0,"OUT FILE: "); OPENOUT(2,INSTRING(0,80));
18400	 READSYNTAX; CLOSE(1); ERRORS:=0;
18500	 FOR I:=1 STEP 1 UNTIL MAXNAMES DO
18600	  IF TERMINAL(I) EQL #0 THEN BEGIN
18700	   Q:=POINTER(I);
18800	   WHILE SYNTAX(Q) NEQ 0 DO BEGIN
18900	    LEFT(I,SYNTAX(Q+1)):=#1;
19000	    RIGHT(I,SYNTAX(Q+SYNTAX(Q)-1)):=#1;
19100	    Q:=Q+SYNTAX(Q)
19200	   END
19300	  END;
19400	 FOR I:=1 STEP 1 UNTIL MAXNAMES DO
19500	  FOR J:=1 STEP 1 UNTIL MAXNAMES DO BEGIN
19600	   IF LEFT(J,I) EQL #1 THEN
19700	    FOR K:=1 STEP 1 UNTIL MAXNAMES DO
19800	     IF LEFT(I,K) EQL #1 THEN LEFT(J,K):=#1;
19900	   IF RIGHT(J,I) EQL #1 THEN
20000	    FOR K:=1 STEP 1 UNTIL MAXNAMES DO
20100	     IF RIGHT(I,K) EQL #1 THEN RIGHT(J,K):=#1
20200	  END;
20300	 FOR I:=1 STEP 1 UNTIL MAXNAMES DO
20400	  IF TERMINAL(I) EQL #0 THEN BEGIN
20500	   Q:=POINTER(I);
20600	   WHILE SYNTAX(Q) NEQ 0 DO BEGIN
20700	    IF SYNTAX(Q) GTR 2 THEN
20800	     FOR K:=Q+1 STEP 1 UNTIL Q+SYNTAX(Q)-2 DO BEGIN
20900	      M:=SYNTAX(K); N:=SYNTAX(K+1); SETREL(M,N,#11);
21000	      FOR L:=1 STEP 1 UNTIL MAXNAMES DO BEGIN 
21100	       IF LEFT(N,L) NEQ #0 THEN SETREL(M,L,#01);
21200	       FOR P:=1 STEP 1 UNTIL MAXNAMES DO
21300	        IF TERMINAL(P) EQL #1 AND RIGHT(M,L) EQL #1 THEN
21400	         IF LEFT(N,P) EQL #1 OR N EQL P THEN SETREL(L,P,#10)
21500	      END;
21600	     END;
21700	    Q:=Q+SYNTAX(Q);
21800	   END;
21900	  END;
22000	  OUTSTRING(0,INTSTR(ERRORS,5));
22100	  OUTSTRING(0," PRECEDENCE VIOLATION(S)"); OUTSTRING(0,CRLF);
22200	 END;
22300	 PROCEDURE PRINTMATRIX;
22400	 BEGIN
22500	  INTEGER ARRAY POWER(0::2); STRING(10) DIGITS;
22600	  INTEGER N; INTEGER M;
22700	  POWER(0):=1; POWER(1):=10; POWER(2):=100; DIGITS:="0123456789";
22800	  FOR J:=1 STEP 50 UNTIL MAXNAMES DO
22900	   FOR I:=1 STEP 25 UNTIL MAXNAMES DO BEGIN
23000	    OUTSTRING(2,FORMFEED); OUTSTRING(2,"PRECEDENCE RELATIONS");
23100	    OUTSTRING(2,CRLF); OUTSTRING(2,CRLF);
23200	    FOR L:=2 STEP -1 UNTIL 0 DO BEGIN
23300	     OUTSTRING(2,"      ");
23400	     FOR K:=J STEP 1 UNTIL J+49 DO BEGIN
23500	      IF K LSS POWER(L) THEN OUTSTRING(2,"  ") ELSE
23600	      IF K LEQ MAXNAMES THEN BEGIN
23700	       OUTSTRING(2,DIGITS((K DIV POWER(L)) REM 10+1,1));
23800	       OUTSTRING(2," ");
23900	      END;
24000	     END;
24100	     OUTSTRING(2,CRLF);
24200	    END;
24300	   IF MAXNAMES GTR I+24 THEN M:=I+24 ELSE M:=MAXNAMES;
24400	    FOR K:=I STEP 1 UNTIL M DO BEGIN
24500	     OUTSTRING(2,CRLF); OUTSTRING(2,INTSTR(K,5));
24600	     IF MAXNAMES GTR J+49 THEN N:=J+49 ELSE N:=MAXNAMES;
24700	     FOR L:=J STEP 1 UNTIL N DO BEGIN
24800	      OUTSTRING(2," ");
24900	      OUTSTRING(2,REL(BITINT(MATRIX(K,L))+1,1));
25000	     END;
25100	     OUTSTRING(2,CRLF);
25200	    END;
25300	   END;
25400	 END;
25500	 PROCEDURE GETFUNCTIONS;
25600	 BEGIN
25700	  BITS(1) ARRAY B(1::360,1::360);
25800	  FOR I:=1 STEP 1 UNTIL MAXNAMES DO
25900	   FOR J:=1 STEP 1 UNTIL MAXNAMES DO BEGIN
26000	    IF MATRIX(I,J) EQL #10 OR MATRIX(I,J) EQL #11 THEN
26100	     B(I,J+MAXNAMES):=#1;
26200	    IF MATRIX(J,I) EQL #01 OR MATRIX(J,I) EQL #11 THEN
26300	     B(I+MAXNAMES,J):=#1
26400	   END;
26500	  FOR I:=1 STEP 1 UNTIL 2*MAXNAMES DO
26600	   FOR J:=1 STEP 1 UNTIL 2*MAXNAMES DO
26700	    IF B(J,I) EQL #1 THEN
26800	     FOR L:=1 STEP 1 UNTIL 2*MAXNAMES DO
26900	      IF B(I,L) EQL #1 THEN B(J,L):=#1;
27000	  FOR I:=1 STEP 1 UNTIL 2*MAXNAMES DO
27100	   B(I,I):=#1;
27200	  FOR I:=1 STEP 1 UNTIL MAXNAMES DO
27300	   FOR J:=1 STEP 1 UNTIL 2*MAXNAMES DO BEGIN
27400	    IF B(I,J) EQL #1 THEN F(I):=F(I)+1;
27500	    IF B(I+MAXNAMES,J) EQL #1 THEN G(I):=G(I)+1
27600	   END;
27700	  ERRORS:=0;
27800	  FOR I:=1 STEP 1 UNTIL MAXNAMES DO
27900	   FOR J:=1 STEP 1 UNTIL MAXNAMES DO
28000	    IF MATRIX(I,J) EQL #01 AND F(I) GEQ G(J) OR
28100	       MATRIX(I,J) EQL #10 AND F(I) LEQ G(J) OR
28200	       MATRIX(I,J) EQL #11 AND F(I) NEQ G(J) THEN BEGIN
28300	     IF ERRORS EQL 0 THEN BEGIN
28400	      OUTSTRING(2,FORMFEED); OUTSTRING(2,"FUNCTION CONFLICTS");
28500	      OUTSTRING(2,CRLF); OUTSTRING(2,CRLF);
28600	     END;
28700	     ERRORS:=ERRORS+1; OUTSTRING(2,INTSTR(F(I),4));
28800	     OUTSTRING(2,"   "); OUTSTRING(2,INTSTR(G(J),4));
28900	     OUTSTRING(2,"   "); OUTSTRING(2,NAMES(I));
29000	     OUTSTRING(2," ");
29100	     OUTSTRING(2,REL(BITINT(MATRIX(I,J))+1,1));
29200	     OUTSTRING(2," "); OUTSTRING(2,NAMES(J));
29300	     OUTSTRING(2,CRLF);
29400	    END;
29500	  OUTSTRING(0,INTSTR(ERRORS,5));
29600	  OUTSTRING(0," FUNCTION CONFLICT(S)");
29700	  OUTSTRING(0,CRLF); OUTSTRING(2,FORMFEED);
29800	  OUTSTRING(2,"PRECEDENCE FUNCTIONS");
29900	  OUTSTRING(2,CRLF); OUTSTRING(2,CRLF);
30000	  FOR I:=1 STEP 1 UNTIL MAXNAMES DO BEGIN
30100	   OUTSTRING(2,NAMES(I)); OUTSTRING(2,"   ");
30200	   OUTSTRING(2,INTSTR(F(I),4)); OUTSTRING(2,"   ");
30300	   OUTSTRING(2,INTSTR(G(I),4)); OUTSTRING(2,CRLF);
30400	  END;
30500	 END;
30600	 REL:=" <>="; GETMATRIX; PRINTMATRIX; GETFUNCTIONS;
30700	 CLOSE(2);
30800	 TIME:=(MSTIME-STATUS(20)) DIV 1000;
30900	 OUTSTRING(0,"ELAPSED TIME WAS" CAT INTSTR(TIME DIV 60,4) CAT
31000	  " MINUTE(S) AND" CAT INTSTR(TIME REM 60,3) CAT " SECOND(S)"
31100	  CAT CRLF);
31200	 TIME:=(RUNTIME-STATUS(21)) DIV 1000;
31300	 OUTSTRING(0,"EXECUTION TIME WAS" CAT INTSTR(TIME DIV 60,4) CAT
31400	  " MINUTE(S) AND" CAT INTSTR(TIME REM 60,3) CAT " SECOND(S)"
31500	  CAT CRLF);
31600	END.