home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / crt.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  28KB  |  873 lines
  1. Syntax10.Scn.Fnt
  2. MODULE CRT; (* H.Moessenboeck 17.11.93, Cocol-R Tables *)
  3. IMPORT Texts, Oberon, Sets;
  4. CONST
  5.     maxSymbols* = 300;    (*max nr of t, nt, and pragmas*)
  6.     maxTerminals* = 256;    (*max nr of terminals*)
  7.     maxNt* = 128;    (*max nr of nonterminals*)
  8.     maxNodes* = 1500;    (*max nr of graph nodes*)
  9.     normTrans* = 0; contextTrans* = 1;    (*transition codes*)
  10.     maxSetNr = 128;    (* max. number of symbol sets *)
  11.     maxClasses = 50;    (* max. number of character classes *)
  12.     (* node types *)
  13.     t* = 1; pr* = 2; nt* = 3; class* = 4; char* = 5; wt* =  6; any* = 7; eps* = 8; sync* = 9; sem* = 10; 
  14.     alt* = 11; iter* = 12; opt* = 13;
  15.     noSym* = -1;
  16.     eofSy* = 0;
  17.     (* token kinds *)
  18.     classToken* = 0;    (*token class*)
  19.     litToken* = 1;    (*literal (e.g. keyword) not recognized by DFA*)
  20.     classLitToken* = 2;    (*token class that can also match a literal*)
  21.     Name* = ARRAY 16 OF CHAR;  (*symbol name*)
  22.     Position*   = RECORD     (*position of stretch of source text*)
  23.         beg*: LONGINT;  (*start relative to beginning of file*)
  24.         len*: INTEGER;  (*length*)
  25.         col*: INTEGER;  (*column number of start position*)
  26.     END;
  27.     SymbolNode* = RECORD
  28.         typ*: INTEGER;                (*nt, t, pr, unknown*)
  29.         name*: Name;                  (*symbol name*)
  30.         struct*: INTEGER;            (*typ = nt: index of 1st node of syntax graph*)
  31.                                                 (*typ = t: token kind: literal, class, ...*)
  32.         deletable*: BOOLEAN;  (*typ = nt: TRUE, if nonterminal is deletable*)
  33.         attrPos*: Position;         (*position of attributes in source text*)
  34.         semPos*: Position;        (*typ = pr: pos of sem action in source text*)
  35.                                                 (*typ = nt: pos of local decls in source text *)
  36.         line*: INTEGER;             (*source text line number of item in this node*)
  37.     END;
  38.     Set* = ARRAY maxTerminals DIV Sets.size OF SET;
  39.     GraphNode* = RECORD
  40.         typ* : INTEGER;        (* nt,sts,wts,char,class,any,eps,sem,sync,alt,iter,opt*)
  41.         next*: INTEGER;        (* index of successor node                        *)
  42.                                         (* next < 0: to successor in enclosing structure  *)
  43.         p1*: INTEGER;         (* typ IN {nt, t, wt}: index to symbol list       *)
  44.                                         (* typ = any: index to anyset                     *) 
  45.                                         (* typ = sync: index to syncset                   *)
  46.                                         (* typ = alt: index of 1st node of 1st alternative*)
  47.                                         (* typ IN {iter, opt}: 1st node in subexpression  *)
  48.                                         (* typ = char: ordinal character value            *)
  49.                                         (* typ = class: index of character class          *)
  50.         p2*: INTEGER;            (* typ = alt: index of 1st node of 2nd alternative*)
  51.                                         (* typ IN {char, class}: transition code          *)
  52.         pos*: Position;        (* typ IN {nt, t, wt}: pos of actual attribs      *)
  53.                                         (* typ = sem: pos of sem action in source text.   *)
  54.         line*: INTEGER;      (* source text line number of item in this node   *)
  55.     END;
  56.     MarkList* = ARRAY maxNodes DIV Sets.size OF SET;
  57.     FirstSets = ARRAY maxNt OF RECORD
  58.         ts: Set; (*terminal symbols*)
  59.         ready: BOOLEAN; (*TRUE = ts is complete*)
  60.     END;
  61.     FollowSets = ARRAY maxNt OF RECORD
  62.         ts: Set; (*terminal symbols*)
  63.         nts: Set; (*nts whose start set is to be included*)
  64.     END;
  65.     CharClass = RECORD
  66.         name: Name; (*class name*)
  67.         set:  INTEGER (* ptr to set representing the class*)
  68.     END;
  69.     SymbolTable = ARRAY maxSymbols OF SymbolNode;
  70.     ClassTable = ARRAY maxClasses OF CharClass;
  71.     GraphList = ARRAY maxNodes OF GraphNode;
  72.     maxSet*:  INTEGER; (* index of last set                                  *)
  73.     maxT*:    INTEGER; (* terminals stored from 0 .. maxT                    *)
  74.     maxP*:    INTEGER; (* pragmas stored from maxT+1 .. maxP                 *)
  75.     firstNt*: INTEGER; (* index of first nt: available after CompSymbolSets  *)
  76.     lastNt*:  INTEGER; (* index of last nt: available after CompSymbolSets   *)
  77.     maxC*:    INTEGER; (* index of last character class                      *)
  78.     semDeclPos*:  Position;  (*position of global semantic declarations*)
  79.     importPos*: Position; (*position of imported identifiers*)
  80.     ignored*: Set;       (* characters ignored by the scanner            *)
  81.     ignoreCase*:  BOOLEAN;   (* TRUE: scanner treats lower case as upper case*)
  82.     ddt*: ARRAY 10 OF BOOLEAN; (* debug and test switches    *)
  83.     nNodes*: INTEGER;   (* index of last graph node          *)
  84.     root*: INTEGER;   (* index of root node, filled by ATG *)
  85.     w: Texts.Writer;
  86.     st: SymbolTable;
  87.     gn: GraphList;
  88.     first: FirstSets;  (*first[i]  = first symbols of st[i+firstNt]*)
  89.     follow: FollowSets; (*follow[i] = followers of st[i+firstNt]*)
  90.     chClass: ClassTable; (*character classes*)
  91.     set: ARRAY 128 OF Set;    (*set[0] reserved for union of all synchronisation sets*)
  92.     dummyName: INTEGER; (*for unnamed character classes*)
  93. PROCEDURE ^MovePragmas;
  94. PROCEDURE ^DelNode*(gn: GraphNode): BOOLEAN;
  95. PROCEDURE Str(s: ARRAY OF CHAR);
  96. BEGIN Texts.WriteString(w, s)
  97. END Str;
  98. PROCEDURE NL;
  99. BEGIN Texts.WriteLn(w)
  100. END NL;
  101. PROCEDURE Length(s: ARRAY OF CHAR): INTEGER;
  102.     VAR i: INTEGER;
  103. BEGIN
  104.     i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
  105.     RETURN i
  106. END Length;
  107. PROCEDURE Restriction(n: INTEGER);
  108. BEGIN
  109.     NL; Str("Restriction "); Texts.WriteInt(w, n, 0); NL; Texts.Append(Oberon.Log, w.buf);
  110.     HALT(99)
  111. END Restriction;
  112. PROCEDURE ClearMarkList(VAR m: MarkList);
  113.     VAR i: INTEGER;
  114. BEGIN
  115.     i := 0; WHILE i < maxNodes DIV Sets.size DO m[i] := {}; INC(i) END;
  116. END ClearMarkList;
  117. PROCEDURE GetNode*(gp: INTEGER; VAR n: GraphNode);
  118. BEGIN
  119.     n := gn[gp]
  120. END GetNode;
  121. PROCEDURE PutNode*(gp: INTEGER; n: GraphNode);
  122. BEGIN gn[gp] := n
  123. END PutNode;
  124. PROCEDURE DelGraph*(gp: INTEGER): BOOLEAN;
  125.     VAR gn: GraphNode;
  126. BEGIN
  127.     IF gp = 0 THEN RETURN TRUE END; (*end of graph found*)
  128.     GetNode(gp, gn);
  129.     RETURN DelNode(gn) & DelGraph(ABS(gn.next));
  130. END DelGraph;
  131. PROCEDURE NewSym*(typ: INTEGER; name: Name; line: INTEGER): INTEGER;
  132.     VAR i: INTEGER;
  133. BEGIN
  134.     IF maxT + 1 = firstNt THEN Restriction(6)
  135.     ELSE
  136.         CASE typ OF
  137.         | t:  INC(maxT); i := maxT
  138.         | pr: DEC(maxP); DEC(firstNt); DEC(lastNt); i := maxP
  139.         | nt: DEC(firstNt); i := firstNt
  140.         END;
  141.         IF maxT >= maxTerminals THEN Restriction(6) END;
  142.         st[i].typ := typ; st[i].name := name;
  143.         st[i].struct := 0;  st[i].deletable := FALSE;
  144.         st[i].attrPos.beg := -1;
  145.         st[i].semPos.beg  := -1;
  146.         st[i].line := line
  147.     END;
  148.     RETURN i
  149. END NewSym;
  150. PROCEDURE GetSym*(sp: INTEGER; VAR sn: SymbolNode);
  151. BEGIN sn := st[sp]
  152. END GetSym;
  153. PROCEDURE PutSym*(sp: INTEGER; sn: SymbolNode);
  154. BEGIN st[sp] := sn
  155. END PutSym;
  156. PROCEDURE FindSym*(name: Name): INTEGER;
  157.     VAR i: INTEGER;
  158. BEGIN
  159.     i := 0;  (*search in terminal list*)
  160.     WHILE (i <= maxT) & (st[i].name # name) DO INC(i) END;
  161.     IF i <= maxT THEN RETURN i END;
  162.     i := firstNt;  (*search in nonterminal/pragma list*)
  163.     WHILE (i < maxSymbols) & (st[i].name # name) DO INC(i) END;
  164.     IF i < maxSymbols THEN RETURN i ELSE RETURN noSym END
  165. END FindSym;
  166. PROCEDURE NewSet*(s: Set): INTEGER;
  167. BEGIN
  168.     INC(maxSet); IF maxSet > maxSetNr THEN Restriction(4) END;
  169.     set[maxSet] := s;
  170.     RETURN maxSet
  171. END NewSet;
  172. PROCEDURE PrintSet(s: ARRAY OF SET; indent: INTEGER);
  173.     CONST maxLineLen = 80;
  174.     VAR     col, i, len: INTEGER; empty: BOOLEAN; sn: SymbolNode;
  175. BEGIN
  176.     i := 0; col := indent; empty := TRUE;
  177.     WHILE i <= maxT DO
  178.         IF Sets.In(s, i) THEN
  179.             empty := FALSE; GetSym(i, sn); len := Length(sn.name);
  180.             IF col + len + 2 > maxLineLen THEN
  181.                 NL; col := 1;
  182.                 WHILE col < indent DO Texts.Write(w, " "); INC(col) END
  183.             END;
  184.             Str(sn.name); Str("  ");
  185.             INC(col, len + 2)
  186.         END;
  187.         INC(i)
  188.     END;
  189.     IF empty THEN Str("-- empty set --") END;
  190.     NL; Texts.Append(Oberon.Log, w.buf)
  191. END PrintSet;
  192. PROCEDURE CompFirstSet*(gp: INTEGER; VAR fs: Set);
  193.     VAR visited: MarkList;
  194.     PROCEDURE CompFirst(gp: INTEGER; VAR fs: Set);
  195.         VAR s: Set; gn: GraphNode; sn: SymbolNode;
  196.     BEGIN
  197.         Sets.Clear(fs);
  198.         WHILE (gp # 0) & ~ Sets.In(visited, gp) DO
  199.             GetNode(gp, gn); Sets.Incl(visited, gp);
  200.             CASE gn.typ OF
  201.             | nt:
  202.                     IF first[gn.p1 - firstNt].ready THEN 
  203.                         Sets.Unite(fs, first[gn.p1 - firstNt].ts);
  204.                     ELSE
  205.                         GetSym(gn.p1, sn); CompFirst(sn.struct, s); Sets.Unite(fs, s);
  206.                     END;
  207.             | t, wt: Sets.Incl(fs, gn.p1);
  208.             | any: Sets.Unite(fs, set[gn.p1])
  209.             | alt, iter, opt:
  210.                     CompFirst(gn.p1, s); Sets.Unite(fs, s);
  211.                     IF gn.typ = alt THEN CompFirst(gn.p2, s); Sets.Unite(fs, s) END
  212.             ELSE (* eps, sem, sync: nothing *)
  213.             END;
  214.             IF ~ DelNode(gn) THEN RETURN END;
  215.             gp := ABS(gn.next)
  216.          END
  217.     END CompFirst;
  218. BEGIN (* ComputeFirstSet *)
  219.     ClearMarkList(visited);
  220.     CompFirst(gp, fs);
  221.     IF ddt[3] THEN
  222.         NL; Str("ComputeFirstSet: gp = "); Texts.WriteInt(w, gp, 0); NL;
  223.         PrintSet(fs, 0);
  224.     END;
  225. END CompFirstSet;
  226. PROCEDURE CompFirstSets;
  227.     VAR i: INTEGER; sn: SymbolNode;
  228. BEGIN
  229.     i := firstNt; WHILE i <= lastNt DO first[i-firstNt].ready := FALSE; INC(i) END;
  230.     i := firstNt;
  231.     WHILE i <= lastNt DO (* for all nonterminals *)
  232.         GetSym(i, sn); CompFirstSet(sn.struct, first[i - firstNt].ts);
  233.         first[i - firstNt].ready := TRUE; 
  234.         INC(i)
  235.     END;
  236. END CompFirstSets;
  237. PROCEDURE CompExpected*(gp, sp: INTEGER; VAR exp: Set);
  238. BEGIN
  239.     CompFirstSet(gp, exp);
  240.     IF DelGraph(gp) THEN Sets.Unite(exp, follow[sp - firstNt].ts) END
  241. END CompExpected;
  242. PROCEDURE CompFollowSets;
  243.     VAR sn: SymbolNode; gn: GraphNode; curSy, i, size: INTEGER; visited: MarkList;
  244.     PROCEDURE CompFol(gp: INTEGER);
  245.         VAR s: Set; gn: GraphNode;
  246.     BEGIN
  247.         WHILE (gp > 0) & ~ Sets.In(visited, gp) DO
  248.             GetNode(gp, gn); Sets.Incl(visited, gp);
  249.             IF gn.typ = nt THEN
  250.                 CompFirstSet(ABS(gn.next), s); Sets.Unite(follow[gn.p1 - firstNt].ts, s);
  251.                 IF DelGraph(ABS(gn.next)) THEN 
  252.                     Sets.Incl(follow[gn.p1 - firstNt].nts, curSy - firstNt) 
  253.                 END
  254.             ELSIF gn.typ IN {opt, iter} THEN CompFol(gn.p1)
  255.             ELSIF gn.typ = alt THEN CompFol(gn.p1); CompFol(gn.p2)
  256.             END;
  257.             gp := gn.next
  258.         END
  259.     END CompFol;
  260.     PROCEDURE Complete(i: INTEGER);
  261.         VAR j: INTEGER;
  262.     BEGIN
  263.         IF Sets.In(visited, i) THEN RETURN END;
  264.         Sets.Incl(visited, i);
  265.         j := 0;
  266.         WHILE j <= lastNt - firstNt DO (* for all nonterminals *)
  267.             IF Sets.In(follow[i].nts, j) THEN
  268.                 Complete(j); Sets.Unite(follow[i].ts, follow[j].ts);
  269.                 Sets.Excl(follow[i].nts, j)
  270.             END;
  271.             INC(j)
  272.         END;
  273.     END Complete;
  274. BEGIN (* CompFollowSets *)
  275.     curSy := firstNt; size := (lastNt - firstNt + 2) DIV Sets.size;
  276.     WHILE curSy <= lastNt + 1 DO    (* also for dummy root nt*)
  277.         Sets.Clear(follow[curSy - firstNt].ts);
  278.         i := 0; WHILE i <= size DO follow[curSy - firstNt].nts[i] := {}; INC(i) END;
  279.         INC(curSy)
  280.     END;
  281.     curSy := firstNt;                                (*get direct successors of nonterminals*)
  282.     WHILE curSy <= lastNt DO
  283.         GetSym(curSy, sn); ClearMarkList(visited); CompFol(sn.struct);
  284.         INC(curSy)
  285.     END;
  286.     CompFol(root); (*curSy=lastNt+1*)
  287.     curSy := 0;                                    (*add indirect successors to follow.ts*)
  288.     WHILE curSy <= lastNt - firstNt DO
  289.         ClearMarkList(visited); Complete(curSy);
  290.         INC(curSy);
  291.     END;
  292. END CompFollowSets;
  293. PROCEDURE CompAnySets;
  294.     VAR curSy, i: INTEGER; sn: SymbolNode;
  295.     PROCEDURE LeadingAny(gp: INTEGER; VAR a: GraphNode): BOOLEAN;
  296.         VAR gn: GraphNode;
  297.     BEGIN
  298.         IF gp <= 0 THEN RETURN FALSE END;
  299.         GetNode(gp, gn);
  300.         IF (gn.typ = any) THEN a := gn; RETURN TRUE
  301.         ELSE RETURN (gn.typ = alt) & (LeadingAny(gn.p1, a) OR LeadingAny(gn.p2, a))
  302.                          OR (gn.typ IN {opt, iter}) & LeadingAny(gn.p1, a)
  303.                          OR DelNode(gn) & LeadingAny(gn.next, a)
  304.         END
  305.     END LeadingAny;
  306.     PROCEDURE FindAS(gp: INTEGER);
  307.         VAR gn, gn2, a: GraphNode; s1, s2: Set; p: INTEGER;
  308.     BEGIN
  309.         WHILE gp > 0 DO
  310.             GetNode(gp, gn);
  311.             IF gn.typ IN {opt, iter} THEN
  312.                 FindAS(gn.p1);
  313.                 IF LeadingAny(gn.p1, a) THEN
  314.                     CompFirstSet(ABS(gn.next), s1); Sets.Differ(set[a.p1], s1)
  315.                 END
  316.             ELSIF gn.typ = alt THEN
  317.                 p := gp; Sets.Clear(s1);
  318.                 WHILE p # 0 DO
  319.                     GetNode(p, gn2); FindAS(gn2.p1);
  320.                     IF LeadingAny(gn2.p1, a) THEN
  321.                         CompFirstSet(gn2.p2, s2); Sets.Unite(s2, s1); Sets.Differ(set[a.p1], s2)
  322.                     ELSE
  323.                         CompFirstSet(gn2.p1, s2); Sets.Unite(s1, s2)
  324.                     END;
  325.                     p := gn2.p2
  326.                 END
  327.             END;
  328.             gp := gn.next
  329.         END
  330.     END FindAS;
  331. BEGIN
  332.     curSy := firstNt;
  333.     WHILE curSy <= lastNt DO (* for all nonterminals *)
  334.         GetSym(curSy, sn); FindAS(sn.struct);
  335.         INC(curSy)
  336. END CompAnySets;
  337. PROCEDURE CompSyncSets;
  338.     VAR curSy, i: INTEGER; sn: SymbolNode; visited: MarkList;
  339.     PROCEDURE CompSync(gp: INTEGER);
  340.         VAR s: Set; gn: GraphNode; 
  341.     BEGIN
  342.         WHILE (gp > 0) & ~ Sets.In(visited, gp) DO
  343.             GetNode(gp, gn); Sets.Incl(visited, gp);
  344.             IF gn.typ = sync THEN
  345.                 CompExpected(ABS(gn.next), curSy, s); 
  346.                 Sets.Incl(s, eofSy); Sets.Unite(set[0], s);
  347.                 gn.p1 := NewSet(s); PutNode(gp, gn)
  348.             ELSIF gn.typ = alt THEN CompSync(gn.p1); CompSync(gn.p2)
  349.             ELSIF gn.typ IN {iter, opt} THEN CompSync(gn.p1)
  350.             END;
  351.             gp := gn.next
  352.         END
  353.     END CompSync;
  354. BEGIN
  355.     curSy := firstNt; ClearMarkList(visited);
  356.     WHILE curSy <= lastNt DO
  357.         GetSym(curSy, sn); CompSync(sn.struct);
  358.         INC(curSy);
  359. END CompSyncSets;
  360. PROCEDURE CompDeletableSymbols*;
  361.     VAR changed, del: BOOLEAN; i: INTEGER; sn: SymbolNode;
  362. BEGIN
  363.     del := FALSE;
  364.     REPEAT
  365.         changed := FALSE;
  366.         i := firstNt;
  367.         WHILE i <= lastNt DO    (*for all nonterminals*)
  368.             GetSym(i, sn);
  369.             IF ~sn.deletable & DelGraph(sn.struct) THEN
  370.                 sn.deletable := TRUE; PutSym(i, sn); changed := TRUE; del := TRUE
  371.             END;
  372.             INC(i)
  373.         END;
  374.     UNTIL ~changed;
  375.     i := firstNt; IF del THEN NL END;
  376.     WHILE i <= lastNt DO
  377.         GetSym(i, sn);
  378.         IF sn.deletable THEN Str("  "); Str(sn.name); Str(" deletable"); NL END;
  379.         INC(i);
  380.     END;
  381.     Texts.Append(Oberon.Log, w.buf)
  382. END CompDeletableSymbols;
  383. PROCEDURE CompSymbolSets*;
  384.     VAR i: INTEGER; sn: SymbolNode;
  385. BEGIN
  386.     i := NewSym(t, "???", 0); (*unknown symbols get code maxT*)
  387.     MovePragmas;
  388.     CompDeletableSymbols;
  389.     CompFirstSets;
  390.     CompFollowSets;
  391.     CompAnySets;
  392.     CompSyncSets;
  393.     IF ddt[1] THEN
  394.         i := firstNt; Str("First & follow symbols:"); NL;
  395.         WHILE i <= lastNt DO (* for all nonterminals *)
  396.             GetSym(i, sn); Str(sn.name); NL;
  397.             Str("first:   "); PrintSet(first[i - firstNt].ts, 10);
  398.             Str("follow:  "); PrintSet(follow[i - firstNt].ts, 10); 
  399.             NL;
  400.             INC(i);
  401.         END;
  402.         IF maxSet >= 0 THEN NL; NL; Str("List of sets (ANY, SYNC): "); NL END;
  403.         i := 0; 
  404.         WHILE i <= maxSet DO
  405.             Str("     set["); Texts.WriteInt (w, i, 2); Str("] = "); PrintSet(set[i], 16);
  406.             INC (i)
  407.         END;
  408.         NL; NL; Texts.Append(Oberon.Log, w.buf)
  409.     END;
  410. END CompSymbolSets;
  411. PROCEDURE GetFirstSet(sp: INTEGER; VAR s: Set);
  412. BEGIN s := first[sp - firstNt].ts
  413. END GetFirstSet;
  414. PROCEDURE GetFollowSet(sp: INTEGER; VAR s: Set);
  415. BEGIN s := follow[sp - firstNt].ts
  416. END GetFollowSet;
  417. PROCEDURE GetSet*(nr: INTEGER; VAR s: Set);
  418. BEGIN s := set[nr]
  419. END GetSet;
  420. PROCEDURE MovePragmas;
  421.     VAR i: INTEGER;
  422. BEGIN
  423.     IF maxP > firstNt THEN
  424.         i := maxSymbols - 1; maxP := maxT;
  425.         WHILE i > lastNt DO 
  426.             INC(maxP); IF maxP >= firstNt THEN Restriction(6) END;
  427.             st[maxP] := st[i]; DEC(i) 
  428.         END;
  429. END MovePragmas;
  430. PROCEDURE PrintSymbolTable*;
  431.     VAR i, j: INTEGER;
  432.     PROCEDURE WriteTyp(typ: INTEGER);
  433.     BEGIN
  434.         CASE typ OF
  435.         | t        : Str(" t      ");
  436.         | pr     : Str(" pr     ");
  437.         | nt     : Str(" nt     ");
  438.         END;
  439.     END WriteTyp;
  440. BEGIN (* PrintSymbolTable *)
  441.     Str("Symbol Table:"); NL; NL;
  442.     Str("nr    name     typ      hasAttribs struct  del  line"); NL; NL;
  443.     i := 0;
  444.     WHILE i < maxSymbols DO
  445.         Texts.WriteInt(w, i, 3); Str("   ");
  446.         j := 0; WHILE (j < 8) & (st[i].name[j] # 0X) DO Texts.Write(w, st[i].name[j]); INC(j) END;
  447.         WHILE j < 8 DO Texts.Write(w, " "); INC(j) END;
  448.         WriteTyp(st[i].typ); 
  449.         IF st[i].attrPos.beg >= 0 THEN Str("  TRUE ") ELSE Str(" FALSE") END; 
  450.         Texts.WriteInt(w, st[i].struct, 10); 
  451.         IF st[i].deletable THEN Str("  TRUE ") ELSE Str(" FALSE") END;
  452.         Texts.WriteInt(w, st[i].line, 6); NL;
  453.         IF i = maxT THEN i := firstNt ELSE INC(i) END
  454.     END;
  455.     NL; NL; Texts.Append(Oberon.Log, w.buf)
  456. END PrintSymbolTable;
  457. PROCEDURE NewClass*(name: Name; set: Set): INTEGER;
  458. BEGIN
  459.     INC(maxC); IF maxC >= maxClasses THEN Restriction(7) END;
  460.     IF name[0] = "#" THEN name[1] := CHR(ORD("A") + dummyName); INC(dummyName) END;
  461.     chClass[maxC].name := name; chClass[maxC].set := NewSet(set);
  462.     RETURN maxC
  463. END NewClass;
  464. PROCEDURE ClassWithName*(name: Name): INTEGER;
  465.     VAR i: INTEGER;
  466. BEGIN
  467.     i := maxC; WHILE (i >= 0) & (chClass[i].name # name) DO DEC(i) END;
  468.     RETURN i
  469. END ClassWithName;
  470. PROCEDURE ClassWithSet*(s: Set): INTEGER;
  471.     VAR i: INTEGER;
  472. BEGIN
  473.     i := maxC; WHILE (i >= 0) & ~ Sets.Equal(set[chClass[i].set], s) DO DEC(i) END;
  474.     RETURN i
  475. END ClassWithSet;
  476. PROCEDURE GetClass*(n: INTEGER; VAR s: Set);
  477. BEGIN
  478.     GetSet(chClass[n].set, s)
  479. END GetClass;
  480. PROCEDURE GetClassName*(n: INTEGER; VAR name: Name);
  481. BEGIN
  482.     name := chClass[n].name
  483. END GetClassName;
  484. PROCEDURE XRef*;
  485.     CONST maxLineLen = 80;
  486.     TYPE    ListPtr    = POINTER TO ListNode;
  487.                 ListNode = RECORD 
  488.                     next: ListPtr;
  489.                     line: INTEGER;
  490.                 END;
  491.                 ListHdr    = RECORD
  492.                     name: Name;
  493.                     lptr: ListPtr;
  494.                 END;
  495.     VAR     gn: GraphNode; col, i, j: INTEGER; l, p, q: ListPtr; 
  496.                 sn: SymbolNode;  
  497.                 xList: ARRAY maxSymbols OF ListHdr;
  498. BEGIN (* XRef *)
  499.     IF maxT <= 0 THEN RETURN END;
  500.     MovePragmas;
  501.     (* initialise cross reference list *)
  502.     i := 0;
  503.     WHILE i <= lastNt DO (* for all symbols *)
  504.         GetSym(i, sn); xList[i].name := sn.name; xList[i].lptr := NIL; 
  505.         IF i = maxP THEN i := firstNt ELSE INC(i) END
  506.     END;
  507.     (* search lines where symbol has been referenced *)
  508.     i := 1;
  509.     WHILE i <= nNodes DO (* for all graph nodes *)
  510.         GetNode(i, gn);
  511.         IF gn.typ IN {t, wt, nt} THEN
  512.             NEW(l); l^.next := xList[gn.p1].lptr; l^.line := gn.line; 
  513.             xList[gn.p1].lptr := l
  514.         END;
  515.         INC(i);
  516.     END;
  517.     (* search lines where symbol has been defined and insert in order *)
  518.     i := 1;
  519.     WHILE i <= lastNt DO    (*for all symbols*)
  520.         GetSym(i, sn); p := xList[i].lptr; q := NIL; 
  521.         WHILE (p # NIL) & (p^.line > sn.line) DO q := p; p := p^.next END;
  522.         NEW(l); l^.next := p; 
  523.         l^.line := -sn.line;
  524.         IF q # NIL THEN q^.next := l ELSE xList[i].lptr := l END;
  525.         IF i = maxP THEN i := firstNt ELSE INC(i) END
  526.     END;
  527.     (* print cross reference listing *)
  528.     NL; Str("Cross reference list:"); NL; NL; Str("Terminals:"); NL; Str("  0  EOF"); NL;
  529.     i := 1;
  530.     WHILE i <= lastNt DO    (*for all symbols*)
  531.         Texts.WriteInt(w, i, 3); Str("  ");
  532.         j := 0; WHILE (j < 15) & (xList[i].name[j] # 0X) DO Texts.Write(w, xList[i].name[j]); INC(j) END;
  533.         l := xList[i].lptr; col := 25;
  534.         WHILE l # NIL DO
  535.             IF col + 5 > maxLineLen THEN
  536.                 NL; col := 0; WHILE col < 25 DO Texts.Write(w, " "); INC(col) END
  537.             END;
  538.             IF l^.line = 0 THEN Str("undef") ELSE Texts.WriteInt(w, l^.line, 5) END;
  539.             INC(col, 5);
  540.             l := l^.next
  541.         END;
  542.         NL;
  543.         IF i = maxT THEN NL; Str("Pragmas:"); NL END;
  544.         IF i = maxP THEN NL; Str("Nonterminals:"); NL; i := firstNt ELSE INC(i) END
  545.     END;
  546.     NL; NL; Texts.Append(Oberon.Log, w.buf)
  547. END XRef;
  548. PROCEDURE NewNode*(typ, p1, line: INTEGER): INTEGER;
  549. BEGIN
  550.     INC(nNodes); IF nNodes > maxNodes THEN Restriction(3) END;
  551.     gn[nNodes].typ := typ; gn[nNodes].next := 0; 
  552.     gn[nNodes].p1 := p1; gn[nNodes].p2 := 0;
  553.     gn[nNodes].pos.beg := -1; gn[nNodes].line := line;
  554.     RETURN nNodes;
  555. END NewNode;
  556. PROCEDURE CompleteGraph*(gp: INTEGER);
  557.     VAR p: INTEGER;
  558. BEGIN
  559.     WHILE gp # 0 DO
  560.         p := gn[gp].next; gn[gp].next := 0; gp := p
  561. END CompleteGraph;
  562. PROCEDURE ConcatAlt*(VAR gL1, gR1: INTEGER; gL2, gR2: INTEGER);
  563.     VAR p: INTEGER;
  564. BEGIN
  565.     gL2 := NewNode(alt, gL2, 0);
  566.     p := gL1; WHILE gn[p].p2 # 0 DO p := gn[p].p2 END; gn[p].p2 := gL2;
  567.     p := gR1; WHILE gn[p].next # 0 DO p := gn[p].next END; gn[p].next := gR2
  568. END ConcatAlt;
  569. PROCEDURE ConcatSeq*(VAR gL1, gR1: INTEGER; gL2, gR2: INTEGER);
  570.     VAR p, q: INTEGER;
  571. BEGIN
  572.     p := gn[gR1].next; gn[gR1].next := gL2; (*head node*)
  573.     WHILE p # 0 DO (*substructure*)
  574.         q := gn[p].next; gn[p].next := -gL2; p := q
  575.     END;
  576.     gR1 := gR2
  577. END ConcatSeq;
  578. PROCEDURE MakeFirstAlt*(VAR gL, gR: INTEGER);
  579. BEGIN
  580.     gL := NewNode(alt, gL, 0); gn[gL].next := gR; gR := gL
  581. END MakeFirstAlt;
  582. PROCEDURE MakeIteration*(VAR gL, gR: INTEGER);
  583.     VAR p, q: INTEGER;
  584. BEGIN
  585.     gL := NewNode(iter, gL, 0); p := gR; gR := gL;
  586.     WHILE p # 0 DO
  587.         q := gn[p].next; gn[p].next := - gL; p := q
  588. END MakeIteration;
  589. PROCEDURE MakeOption*(VAR gL, gR: INTEGER);
  590. BEGIN
  591.     gL := NewNode(opt, gL, 0); gn[gL].next := gR; gR := gL
  592. END MakeOption;
  593. PROCEDURE StrToGraph*(str: ARRAY OF CHAR; VAR gL, gR: INTEGER);
  594.     VAR len, i: INTEGER;
  595. BEGIN
  596.     gR := 0; i := 1; len := Length(str) - 1;
  597.     WHILE i < len DO
  598.         gn[gR].next := NewNode(char, ORD(str[i]), 0); gR := gn[gR].next;
  599.         INC(i)
  600.     END;
  601.     gL := gn[0].next; gn[0].next := 0
  602. END StrToGraph;
  603. PROCEDURE DelNode*(gn: GraphNode): BOOLEAN;
  604.     VAR sn: SymbolNode;
  605.     PROCEDURE DelAlt(gp: INTEGER): BOOLEAN;
  606.         VAR gn: GraphNode;
  607.     BEGIN
  608.         IF gp <= 0 THEN RETURN TRUE END; (*end of graph found*)
  609.         GetNode(gp, gn);
  610.         RETURN DelNode(gn) & DelAlt(gn.next);
  611.     END DelAlt;
  612. BEGIN
  613.     IF gn.typ = nt THEN GetSym(gn.p1, sn); RETURN sn.deletable
  614.     ELSIF gn.typ = alt THEN RETURN DelAlt(gn.p1) OR (gn.p2 # 0) & DelAlt(gn.p2)
  615.     ELSE RETURN gn.typ IN {eps, iter, opt, sem, sync}
  616. END DelNode;
  617. PROCEDURE PrintGraph*;
  618.     VAR i: INTEGER;
  619.     PROCEDURE WriteTyp(typ: INTEGER);
  620.     BEGIN
  621.         CASE typ OF
  622.         | nt    : Str("nt  ")
  623.         | t     : Str("t   ")
  624.         | wt    : Str("wt  ")
  625.         | any : Str("any ")
  626.         | eps : Str("eps ")
  627.         | sem : Str("sem ")
  628.         | sync: Str("sync")
  629.         | alt : Str("alt ")
  630.         | iter: Str("iter")
  631.         | opt : Str("opt ")
  632.         ELSE Str("--- ")
  633.         END;
  634.     END WriteTyp;
  635. BEGIN (* PrintGraph *)
  636.     Str("GraphList:"); NL; NL;
  637.     Str(" nr   typ    next     p1     p2   line"); NL; NL;
  638.     i := 0;
  639.     WHILE i <= nNodes DO
  640.         Texts.WriteInt(w, i, 3); Str("   ");
  641.         WriteTyp(gn[i].typ); Texts.WriteInt(w, gn[i].next, 7);
  642.         Texts.WriteInt(w, gn[i].p1, 7);
  643.         Texts.WriteInt(w, gn[i].p2, 7);
  644.         Texts.WriteInt(w, gn[i].line, 7);
  645.         NL;
  646.         INC(i);
  647.     END;
  648.     NL; NL; Texts.Append(Oberon.Log, w.buf)
  649. END PrintGraph;
  650. PROCEDURE FindCircularProductions* (VAR ok: BOOLEAN);
  651.     CONST maxList = 150;
  652.     TYPE  ListEntry = RECORD
  653.                     left   : INTEGER;
  654.                     right  : INTEGER;
  655.                     deleted: BOOLEAN;
  656.                 END;
  657.     VAR   changed, onLeftSide, onRightSide: BOOLEAN; i, j, listLength: INTEGER; 
  658.                 list: ARRAY maxList OF ListEntry;
  659.                 singles: MarkList;
  660.                 sn: SymbolNode;
  661.     PROCEDURE GetSingles (gp: INTEGER; VAR singles: MarkList);
  662.         VAR gn: GraphNode;
  663.     BEGIN
  664.         IF gp <= 0 THEN RETURN END; (* end of graph found *)
  665.         GetNode (gp, gn);
  666.         IF gn.typ = nt THEN
  667.             IF DelGraph(ABS(gn.next)) THEN Sets.Incl(singles, gn.p1) END
  668.         ELSIF gn.typ IN {alt, iter, opt} THEN
  669.             IF DelGraph(ABS(gn.next)) THEN
  670.                 GetSingles(gn.p1, singles);
  671.                 IF gn.typ = alt THEN GetSingles(gn.p2, singles) END
  672.             END
  673.         END;
  674.         IF DelNode(gn) THEN GetSingles(gn.next, singles) END
  675.     END GetSingles;
  676. BEGIN (* FindCircularProductions *)
  677.     i := firstNt; listLength := 0;
  678.     WHILE i <= lastNt DO (* for all nonterminals i *)
  679.         ClearMarkList (singles); GetSym (i, sn);
  680.         GetSingles (sn.struct, singles); (* get nt's j such that i-->j *)
  681.         j := firstNt;
  682.         WHILE j <= lastNt DO (* for all nonterminals j *)
  683.             IF Sets.In(singles, j) THEN
  684.                 list[listLength].left := i; list[listLength].right := j; 
  685.                 list[listLength].deleted := FALSE;
  686.                 INC (listLength)
  687.             END;
  688.             INC(j)
  689.         END;
  690.         INC(i)
  691.     END;
  692.     REPEAT
  693.         i := 0; changed := FALSE;
  694.         WHILE i < listLength DO
  695.             IF ~ list[i].deleted THEN
  696.                 j := 0; onLeftSide := FALSE; onRightSide := FALSE;
  697.                 WHILE j < listLength DO
  698.                     IF ~ list[j].deleted THEN
  699.                         IF list[i].left = list[j].right THEN onRightSide := TRUE END;
  700.                         IF list[j].left = list[i].right THEN onLeftSide := TRUE END 
  701.                     END;
  702.                     INC(j)
  703.                 END;
  704.                 IF ~ onRightSide OR ~ onLeftSide THEN 
  705.                     list[i].deleted := TRUE; changed := TRUE 
  706.                 END
  707.             END;
  708.             INC(i)
  709.         END
  710.     UNTIL ~ changed;
  711.     i := 0; ok := TRUE;
  712.     WHILE i < listLength DO
  713.         IF ~ list[i].deleted THEN
  714.             ok := FALSE;
  715.             GetSym(list[i].left, sn); NL; Str("  "); Str(sn.name); Str(" --> ");
  716.             GetSym(list[i].right, sn); Str(sn.name)
  717.         END;
  718.         INC(i)
  719.     END;
  720.     Texts.Append(Oberon.Log, w.buf)
  721. END FindCircularProductions;
  722. PROCEDURE LL1Test* (VAR ll1: BOOLEAN);
  723.     VAR sn: SymbolNode; curSy: INTEGER;
  724.     PROCEDURE LL1Error (cond, ts: INTEGER);
  725.         VAR sn: SymbolNode;
  726.     BEGIN
  727.         ll1 := FALSE;
  728.         GetSym (curSy, sn); Str("  LL1 error in "); Str(sn.name); Str(": ");
  729.         IF ts > 0 THEN GetSym (ts, sn); Str(sn.name); Str(" is ") END;
  730.         CASE cond OF
  731.             1: Str(" start of several alternatives.")
  732.         | 2: Str(" start & successor of deletable structure")
  733.         | 3: Str(" an ANY node that matchs no symbol")
  734.         END;
  735.         NL; Texts.Append(Oberon.Log, w.buf)
  736.     END LL1Error;
  737.     PROCEDURE Check (cond: INTEGER; VAR s1, s2: Set);
  738.         VAR i: INTEGER;
  739.     BEGIN
  740.         i := 0;
  741.         WHILE i <= maxT DO
  742.             IF Sets.In(s1, i) & Sets.In(s2, i) THEN LL1Error(cond, i) END;
  743.             INC(i)
  744.         END
  745.     END Check;
  746.     PROCEDURE CheckAlternatives (gp: INTEGER);
  747.         VAR gn, gn1: GraphNode; s1, s2: Set; p: INTEGER;
  748.     BEGIN
  749.         WHILE gp > 0 DO
  750.             GetNode(gp, gn);
  751.             IF gn.typ = alt THEN
  752.                 p := gp; Sets.Clear(s1);
  753.                 WHILE p # 0 DO  (*for all alternatives*)
  754.                     GetNode(p, gn1); CompExpected(gn1.p1, curSy, s2);
  755.                     Check(1, s1, s2); Sets.Unite(s1, s2);
  756.                     CheckAlternatives(gn1.p1);
  757.                     p := gn1.p2
  758.                 END
  759.             ELSIF gn.typ IN {opt, iter} THEN
  760.                 CompExpected(gn.p1, curSy, s1); 
  761.                 CompExpected(ABS(gn.next), curSy, s2);
  762.                 Check(2, s1, s2);
  763.                 CheckAlternatives(gn.p1)
  764.             ELSIF gn.typ = any THEN
  765.                 GetSet(gn.p1, s1);
  766.                 IF Sets.Empty(s1) THEN LL1Error(3, 0) END  (*e.g. {ANY} ANY or [ANY] ANY*)
  767.             END;
  768.             gp := gn.next
  769.         END
  770.     END CheckAlternatives;
  771. BEGIN (* LL1Test *)
  772.     curSy := firstNt; ll1 := TRUE;
  773.     WHILE curSy <= lastNt DO  (*for all nonterminals*)
  774.         GetSym(curSy, sn); CheckAlternatives (sn.struct);
  775.         INC (curSy)
  776.     END;
  777. END LL1Test;
  778. PROCEDURE TestCompleteness* (VAR ok: BOOLEAN);
  779.     VAR sp: INTEGER; sn: SymbolNode; 
  780. BEGIN
  781.     sp := firstNt; ok := TRUE;
  782.     WHILE sp <= lastNt DO  (*for all nonterminals*)
  783.         GetSym (sp, sn);
  784.         IF sn.struct = 0 THEN
  785.             ok := FALSE; NL; Str("  No production for "); Str(sn.name); Texts.Append(Oberon.Log, w.buf)
  786.         END;
  787.         INC(sp)
  788. END TestCompleteness;
  789. PROCEDURE TestIfAllNtReached* (VAR ok: BOOLEAN);
  790.     VAR gn: GraphNode; sp: INTEGER; reached: MarkList; sn: SymbolNode;
  791.     PROCEDURE MarkReachedNts (gp: INTEGER);
  792.         VAR gn: GraphNode; sn: SymbolNode;
  793.     BEGIN
  794.         WHILE gp > 0 DO
  795.             GetNode(gp, gn);
  796.             IF gn.typ = nt THEN
  797.                 IF ~ Sets.In(reached, gn.p1) THEN  (*new nt reached*)
  798.                     Sets.Incl(reached, gn.p1); 
  799.                     GetSym(gn.p1, sn); MarkReachedNts(sn.struct)
  800.                 END
  801.             ELSIF gn.typ IN {alt, iter, opt} THEN
  802.                 MarkReachedNts(gn.p1);
  803.                 IF gn.typ = alt THEN MarkReachedNts(gn.p2) END
  804.             END;
  805.             gp := gn.next
  806.         END
  807.     END MarkReachedNts;
  808. BEGIN (* TestIfAllNtReached *)
  809.     ClearMarkList(reached);
  810.     GetNode(root, gn); Sets.Incl(reached, gn.p1);
  811.     GetSym(gn.p1, sn); MarkReachedNts(sn.struct);
  812.     sp := firstNt; ok := TRUE;
  813.     WHILE sp <= lastNt DO  (*for all nonterminals*)
  814.         IF ~ Sets.In(reached, sp) THEN
  815.             ok := FALSE; GetSym(sp, sn); NL; Str("  "); Str(sn.name); Str(" cannot be reached")
  816.         END;
  817.         INC(sp)
  818.     END;
  819.     Texts.Append(Oberon.Log, w.buf)
  820. END TestIfAllNtReached;
  821. PROCEDURE TestIfNtToTerm* (VAR ok: BOOLEAN);
  822.     VAR changed: BOOLEAN; gn: GraphNode; sp: INTEGER; 
  823.             sn: SymbolNode; 
  824.             termList: MarkList;
  825.     PROCEDURE IsTerm (gp: INTEGER): BOOLEAN;
  826.         VAR gn: GraphNode;
  827.     BEGIN
  828.         WHILE gp > 0 DO
  829.             GetNode(gp, gn);
  830.             IF (gn.typ = nt) & ~ Sets.In(termList, gn.p1)
  831.             OR (gn.typ = alt) & ~ IsTerm(gn.p1) & ~ IsTerm(gn.p2) THEN RETURN FALSE
  832.             END;
  833.             gp := gn.next
  834.         END;
  835.         RETURN TRUE
  836.     END IsTerm;
  837. BEGIN (* TestIfNtToTerm *)
  838.     ClearMarkList(termList);
  839.     REPEAT
  840.         sp := firstNt; changed := FALSE;
  841.         WHILE sp <= lastNt DO
  842.             IF ~ Sets.In(termList, sp) THEN
  843.                 GetSym(sp, sn);
  844.                 IF IsTerm(sn.struct) THEN Sets.Incl(termList, sp); changed := TRUE END
  845.             END;
  846.             INC(sp)
  847.         END
  848.     UNTIL ~changed; 
  849.     sp := firstNt; ok := TRUE;
  850.     WHILE sp <= lastNt DO
  851.         IF ~ Sets.In(termList, sp) THEN
  852.             ok := FALSE; GetSym(sp, sn); NL; Str("  "); Str(sn.name); Str(" cannot be derived to terminals")
  853.         END;
  854.         INC(sp)
  855.     END;
  856.     Texts.Append(Oberon.Log, w.buf)
  857. END TestIfNtToTerm;
  858. PROCEDURE Init*;
  859. BEGIN
  860.     maxSet := 0; Sets.Clear(set[0]); Sets.Incl(set[0], eofSy);
  861.     firstNt := maxSymbols; maxP := maxSymbols; maxT := -1; maxC := -1;
  862.     lastNt := maxP - 1;
  863.     dummyName := 0;
  864.     nNodes := 0 
  865. END Init;
  866. BEGIN (* CRT *)
  867.     (* The dummy node gn[0] ensures that none of the procedures
  868.          above have to check for 0 indices. *)
  869.     nNodes := 0; 
  870.     gn[0].typ := -1; gn[0].p1 := 0; gn[0].p2 := 0; gn[0].next := 0; gn[0].line := 0;
  871.     Texts.OpenWriter(w)
  872. END CRT.
  873.