Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0061/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.