summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 82dcffa)
raw | patch | inline | side by side (parent: 82dcffa)
| author | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sat, 16 Sep 2017 16:41:30 +0000 (19:41 +0300) | ||
| committer | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sat, 16 Sep 2017 16:41:30 +0000 (19:41 +0300) |
30 files changed:
diff --git a/TextV4/make.sh b/TextV4/make.sh
--- a/TextV4/make.sh
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/sh
-
-set -e
-
-PATH="..:$PATH"
-
-obn-compile.sh -I TextV4 TextV4
diff --git a/TextV4/voc/.gitignore b/TextV4/voc/.gitignore
--- a/TextV4/voc/.gitignore
+++ /dev/null
@@ -1,7 +0,0 @@
-TextV4Print
-TextV4ToAscii
-TextV4ToText
-*.o
-*.sym
-*.h
-*.c
diff --git a/src/oberon.c b/src/oberon.c
index 1d9e670e82fcc1c2e197b7bcbeea9b91cc935782..cd7e97a18f3cb5531e77bd28d1253a62cdc92b85 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
char * name;
int export;
int read_only;
+
+ if(ctx -> token == STAR)
+ {
+ oberon_assert_token(ctx, STAR);
+ }
+
name = oberon_assert_ident(ctx);
oberon_def(ctx, &export, &read_only);
diff --git a/TextV4/.gitignore b/tools/Coco/.gitignore
diff --git a/tools/Coco/CR.atg b/tools/Coco/CR.atg
--- /dev/null
+++ b/tools/Coco/CR.atg
@@ -0,0 +1,376 @@
+COMPILER CR (*H.Moessenboeck 17.11.93, Coco/R*)
+
+(*---------------------- semantic declarations ----------------------------*)
+
+IMPORT CRT, CRA, CRX, Sets, Texts, Oberon;
+
+CONST
+ ident = 0; string = 1; (*symbol kind*)
+
+VAR
+ str: ARRAY 32 OF CHAR;
+ w: Texts.Writer;
+ genScanner: BOOLEAN;
+
+
+PROCEDURE SemErr(nr: INTEGER);
+BEGIN
+ CRS.Error(200+nr, CRS.pos);
+END SemErr;
+
+PROCEDURE MatchLiteral(sp: INTEGER); (*store string either as token or as literal*)
+ VAR sn, sn1: CRT.SymbolNode; matchedSp: INTEGER;
+BEGIN
+ CRT.GetSym(sp, sn);
+ CRA.MatchDFA(sn.name, sp, matchedSp);
+ IF matchedSp # CRT.noSym THEN
+ CRT.GetSym(matchedSp, sn1); sn1.struct := CRT.classLitToken; CRT.PutSym(matchedSp, sn1);
+ sn.struct := CRT.litToken
+ ELSE sn.struct := CRT.classToken;
+ END;
+ CRT.PutSym(sp, sn)
+END MatchLiteral;
+
+PROCEDURE SetCtx(gp: INTEGER); (*set transition code to CRT.contextTrans*)
+ VAR gn: CRT.GraphNode;
+BEGIN
+ WHILE gp > 0 DO
+ CRT.GetNode(gp, gn);
+ IF gn.typ IN {CRT.char, CRT.class} THEN
+ gn.p2 := CRT.contextTrans; CRT.PutNode(gp, gn)
+ ELSIF gn.typ IN {CRT.opt, CRT.iter} THEN SetCtx(gn.p1)
+ ELSIF gn.typ = CRT.alt THEN SetCtx(gn.p1); SetCtx(gn.p2)
+ END;
+ gp := gn.next
+ END
+END SetCtx;
+
+PROCEDURE SetDDT(s: ARRAY OF CHAR);
+ VAR name: ARRAY 64 OF CHAR; i: INTEGER; ch: CHAR;
+BEGIN
+ i := 1;
+ WHILE s[i] # 0X DO
+ ch := s[i]; INC(i);
+ IF (ch >= "0") & (ch <= "9") THEN CRT.ddt[ORD(ch)-ORD("0")] := TRUE END
+ END
+END SetDDT;
+
+PROCEDURE FixString (VAR s: ARRAY OF CHAR; len: INTEGER);
+ VAR double: BOOLEAN; i: INTEGER;
+BEGIN
+ double := FALSE;
+ FOR i := 0 TO len-2 DO
+ IF s[i] = '"' THEN double := TRUE END
+ END;
+ IF ~ double THEN s[0] := '"'; s[len-1] := '"' END
+END FixString;
+
+(*-------------------------------------------------------------------------*)
+CHARACTERS
+ letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".
+ digit = "0123456789".
+ eol = CHR(13).
+ tab = CHR(9).
+ noQuote1 = ANY - '"' - eol.
+ noQuote2 = ANY - "'" - eol.
+
+IGNORE eol + tab + CHR(28)
+
+
+TOKENS
+ ident = letter {letter | digit}.
+ string = '"' {noQuote1} '"' | "'" {noQuote2} "'".
+ number = digit {digit}.
+
+
+PRAGMAS
+ ddtSym = "$" {digit}. (. CRS.GetName(CRS.nextPos, CRS.nextLen, str); SetDDT(str) .)
+
+
+COMMENTS FROM "(*" TO "*)" NESTED
+
+(*-------------------------------------------------------------------------*)
+PRODUCTIONS
+
+CR (. VAR undef, hasAttrs, ok, ok1: BOOLEAN; eofSy, gR: INTEGER;
+ gramLine, sp: INTEGER;
+ gn: CRT.GraphNode; sn: CRT.SymbolNode;
+ name, gramName: CRT.Name; .)
+=
+ "COMPILER" (. Texts.OpenWriter(w);
+ CRT.Init; CRX.Init; CRA.Init;
+ gramLine := CRS.line;
+ eofSy := CRT.NewSym(CRT.t, "EOF", 0);
+ genScanner := TRUE;
+ CRT.ignoreCase := FALSE;
+ ok := TRUE;
+ Sets.Clear(CRT.ignored) .)
+ ident (. CRS.GetName(CRS.pos, CRS.len, gramName);
+ CRT.semDeclPos.beg := CRS.nextPos; CRT.importPos.beg := -1; .)
+ { "IMPORT" (. CRT.importPos.beg := CRS.nextPos .)
+ {ANY} ";" (. CRT.importPos.len := SHORT(CRS.pos - CRT.importPos.beg);
+ CRT.importPos.col := 0;
+ CRT.semDeclPos.beg := CRS.nextPos .)
+ | ANY
+ } (. CRT.semDeclPos.len := SHORT(CRS.nextPos - CRT.semDeclPos.beg);
+ CRT.semDeclPos.col := 0 .)
+ { Declaration }
+ SYNC
+ "PRODUCTIONS" (. IF genScanner THEN CRA.MakeDeterministic(ok) END;
+ CRT.nNodes := 0 .)
+ { ident (. CRS.GetName(CRS.pos, CRS.len, name);
+ sp := CRT.FindSym(name); undef := sp = CRT.noSym;
+ IF undef THEN
+ sp := CRT.NewSym(CRT.nt, name, CRS.line);
+ CRT.GetSym(sp, sn);
+ ELSE
+ CRT.GetSym(sp, sn);
+ IF sn.typ = CRT.nt THEN
+ IF sn.struct > 0 THEN SemErr(7) END
+ ELSE SemErr(8)
+ END;
+ sn.line := CRS.line
+ END;
+ hasAttrs := sn.attrPos.beg >= 0 .)
+ ( Attribs <sn.attrPos> (. IF ~undef & ~hasAttrs THEN SemErr(9) END;
+ CRT.PutSym(sp, sn) .)
+ | (. IF ~undef & hasAttrs THEN SemErr(10) END .)
+ )
+ [ SemText <sn.semPos>]
+ WEAK "="
+ Expression <sn.struct, gR> (. CRT.CompleteGraph(gR); CRT.PutSym(sp, sn);
+ IF CRT.ddt[2] THEN CRT.PrintGraph END .)
+ WEAK "."
+ } (. sp := CRT.FindSym(gramName);
+ IF sp = CRT.noSym THEN SemErr(11);
+ ELSE
+ CRT.GetSym(sp, sn);
+ IF sn.attrPos.beg >= 0 THEN SemErr(12) END;
+ CRT.root := CRT.NewNode(CRT.nt, sp, gramLine);
+ END .)
+ "END" ident (. CRS.GetName(CRS.pos, CRS.len, name);
+ IF name # gramName THEN SemErr(17) END;
+ IF CRS.errors = 0 THEN
+ Texts.WriteString(w, " checking"); Texts.Append(Oberon.Log, w.buf);
+ CRT.CompSymbolSets;
+ IF ok THEN CRT.TestCompleteness(ok) END;
+ IF ok THEN
+ CRT.TestIfAllNtReached(ok1); CRT.FindCircularProductions(ok)
+ END;
+ IF ok THEN CRT.TestIfNtToTerm(ok) END;
+ IF ok THEN CRT.LL1Test(ok1) END;
+ IF CRT.ddt[0] THEN CRA.PrintStates END;
+ IF CRT.ddt[7] THEN CRT.XRef END;
+ IF ok THEN
+ Texts.WriteString(w, " +parser");
+ Texts.Append(Oberon.Log, w.buf);
+ CRX.GenCompiler;
+ IF genScanner THEN
+ Texts.WriteString(w, " +scanner");
+ Texts.Append(Oberon.Log, w.buf);
+ CRA.WriteScanner
+ END;
+ IF CRT.ddt[8] THEN CRX.WriteStatistics END
+ END
+ ELSE ok := FALSE
+ END;
+ IF CRT.ddt[6] THEN CRT.PrintSymbolTable END;
+ IF ok THEN Texts.WriteString(w, " done") END;
+ Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) .)
+ ".".
+(*------------------------------------------------------------------------------------*)
+Declaration (. VAR gL1, gR1, gL2, gR2: INTEGER; nested: BOOLEAN; .)
+=
+ "CHARACTERS" { SetDecl }
+| "TOKENS" { TokenDecl <CRT.t> }
+| "PRAGMAS" { TokenDecl <CRT.pr> }
+| "COMMENTS"
+ "FROM" TokenExpr <gL1, gR1>
+ "TO" TokenExpr <gL2, gR2>
+ ( "NESTED" (. nested := TRUE .)
+ | (. nested := FALSE .)
+ ) (. CRA.NewComment(gL1, gL2, nested) .)
+| "IGNORE"
+ ( "CASE" (. CRT.ignoreCase := TRUE .)
+ | Set <CRT.ignored>
+ )
+.
+
+(*------------------------------------------------------------------------------------*)
+SetDecl (. VAR c: INTEGER; set: CRT.Set; name: CRT.Name; .)
+=
+ ident (. CRS.GetName(CRS.pos, CRS.len, name);
+ c := CRT.ClassWithName(name); IF c >= 0 THEN SemErr(7) END .)
+ "=" Set <set> (. c := CRT.NewClass(name, set) .)
+ ".".
+(*------------------------------------------------------------------------------------*)
+Set <VAR set: CRT.Set> (. VAR set2: CRT.Set; .)
+=
+ SimSet <set>
+ { "+" SimSet <set2> (. Sets.Unite(set, set2) .)
+ | "-" SimSet <set2> (. Sets.Differ(set, set2) .)
+ }.
+(*------------------------------------------------------------------------------------*)
+SimSet <VAR set: CRT.Set> (. VAR c, n, i: INTEGER; name: CRT.Name; s: ARRAY 128 OF CHAR; .)
+=
+ ident (. CRS.GetName(CRS.pos, CRS.len, name);
+ c := CRT.ClassWithName(name);
+ IF c < 0 THEN SemErr(15); Sets.Clear(set)
+ ELSE CRT.GetClass(c, set)
+ END .)
+| string (. CRS.GetName(CRS.pos, CRS.len, s);
+ Sets.Clear(set); i := 1;
+ WHILE s[i] # s[0] DO
+ Sets.Incl(set, ORD(s[i])); INC(i)
+ END .)
+| "CHR" "(" number (. CRS.GetName(CRS.pos, CRS.len, name);
+ n := 0; i := 0;
+ WHILE name[i] # 0X DO
+ n := 10 * n + (ORD(name[i]) - ORD("0"));
+ INC(i)
+ END;
+ Sets.Clear(set); Sets.Incl(set, n) .)
+ ")"
+| "ANY" (. Sets.Fill(set) .)
+.
+(*------------------------------------------------------------------------------------*)
+TokenDecl <typ: INTEGER> (. VAR sp, kind, gL, gR: INTEGER; sn: CRT.SymbolNode;
+ pos: CRT.Position; name: CRT.Name; .)
+=
+ Symbol <name, kind> (. IF CRT.FindSym(name) # CRT.noSym THEN SemErr(7)
+ ELSE
+ sp := CRT.NewSym(typ, name, CRS.line);
+ CRT.GetSym(sp, sn); sn.struct := CRT.classToken;
+ CRT.PutSym(sp, sn)
+ END .)
+ SYNC
+ ( "=" TokenExpr <gL, gR> "." (. IF kind # ident THEN SemErr(13) END;
+ CRT.CompleteGraph(gR);
+ CRA.ConvertToStates(gL, sp) .)
+ | (. IF kind = ident THEN genScanner := FALSE
+ ELSE MatchLiteral(sp)
+ END .)
+ )
+ [ SemText <pos> (. IF typ = CRT.t THEN SemErr(14) END;
+ CRT.GetSym(sp, sn); sn.semPos := pos; CRT.PutSym(sp, sn) .)
+ ].
+(*------------------------------------------------------------------------------------*)
+Expression <VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; first: BOOLEAN; .)
+=
+ Term <gL, gR> (. first := TRUE .)
+ { WEAK "|"
+ Term <gL2, gR2> (. IF first THEN
+ CRT.MakeFirstAlt(gL, gR); first := FALSE
+ END;
+ CRT.ConcatAlt(gL, gR, gL2, gR2) .)
+ }.
+(*------------------------------------------------------------------------------------*)
+Term<VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; .)
+= (. gL := 0; gR := 0 .)
+ ( Factor <gL, gR>
+ { Factor <gL2, gR2> (. CRT.ConcatSeq(gL, gR, gL2, gR2) .)
+ }
+ | (. gL := CRT.NewNode(CRT.eps, 0, 0); gR := gL .)
+ ).
+(*------------------------------------------------------------------------------------*)
+Factor <VAR gL, gR: INTEGER> (. VAR sp, kind, c: INTEGER; name: CRT.Name;
+ gn: CRT.GraphNode; sn: CRT.SymbolNode;
+ set: CRT.Set;
+ undef, weak: BOOLEAN;
+ pos: CRT.Position; .)
+=
+ (. gL :=0; gR := 0; weak := FALSE .)
+( [ "WEAK" (. weak := TRUE .)
+ ]
+ Symbol <name, kind> (. sp := CRT.FindSym(name); undef := sp = CRT.noSym;
+ IF undef THEN
+ IF kind = ident THEN (*forward nt*)
+ sp := CRT.NewSym(CRT.nt, name, 0)
+ ELSE (*undefined string in production*)
+ sp := CRT.NewSym(CRT.t, name, CRS.line);
+ MatchLiteral(sp)
+ END
+ END;
+ CRT.GetSym(sp, sn);
+ IF ~(sn.typ IN {CRT.t,CRT.nt}) THEN SemErr(4) END;
+ IF weak THEN
+ IF sn.typ = CRT.t THEN sn.typ := CRT.wt ELSE SemErr(23) END
+ END;
+ gL := CRT.NewNode(sn.typ, sp, CRS.line); gR := gL .)
+
+ ( Attribs <pos> (. CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn);
+ CRT.GetSym(sp, sn);
+ IF undef THEN
+ sn.attrPos := pos; CRT.PutSym(sp, sn)
+ ELSIF sn.attrPos.beg < 0 THEN SemErr(5)
+ END;
+ IF kind # ident THEN SemErr(3) END .)
+ | (. CRT.GetSym(sp, sn);
+ IF sn.attrPos.beg >= 0 THEN SemErr(6) END .)
+ )
+| "(" Expression <gL, gR> ")"
+| "[" Expression <gL, gR> "]" (. CRT.MakeOption(gL, gR) .)
+| "{" Expression <gL, gR> "}" (. CRT.MakeIteration(gL, gR) .)
+| SemText <pos> (. gL := CRT.NewNode(CRT.sem, 0, 0);
+ gR := gL;
+ CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn) .)
+| "ANY" (. Sets.Fill(set); Sets.Excl(set, CRT.eofSy);
+ gL := CRT.NewNode(CRT.any, CRT.NewSet(set), 0); gR := gL .)
+| "SYNC" (. gL := CRT.NewNode(CRT.sync, 0, 0); gR := gL .)
+).
+(*------------------------------------------------------------------------------------*)
+TokenExpr <VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; first: BOOLEAN; .)
+=
+ TokenTerm <gL, gR> (. first := TRUE .)
+ { WEAK "|"
+ TokenTerm <gL2, gR2> (. IF first THEN
+ CRT.MakeFirstAlt(gL, gR); first := FALSE
+ END;
+ CRT.ConcatAlt(gL, gR, gL2, gR2) .)
+ }.
+(*------------------------------------------------------------------------------------*)
+TokenTerm <VAR gL, gR: INTEGER> (. VAR gL2, gR2: INTEGER; .)
+=
+ TokenFactor <gL, gR>
+ { TokenFactor <gL2, gR2> (. CRT.ConcatSeq(gL, gR, gL2, gR2) .)
+ }
+ [ "CONTEXT"
+ "(" TokenExpr <gL2, gR2> (. SetCtx(gL2); CRT.ConcatSeq(gL, gR, gL2, gR2) .)
+ ")"
+ ].
+(*------------------------------------------------------------------------------------*)
+TokenFactor <VAR gL, gR: INTEGER> (. VAR kind, c: INTEGER; set: CRT.Set; name: CRT.Name; .)
+=
+ (. gL :=0; gR := 0 .)
+( Symbol <name, kind> (. IF kind = ident THEN
+ c := CRT.ClassWithName(name);
+ IF c < 0 THEN
+ SemErr(15);
+ Sets.Clear(set); c := CRT.NewClass(name, set)
+ END;
+ gL := CRT.NewNode(CRT.class, c, 0); gR := gL
+ ELSE (*string*)
+ CRT.StrToGraph(name, gL, gR)
+ END .)
+| "(" TokenExpr <gL, gR> ")"
+| "[" TokenExpr <gL, gR> "]" (. CRT.MakeOption(gL, gR) .)
+| "{" TokenExpr <gL, gR> "}" (. CRT.MakeIteration(gL, gR) .)
+).
+(*------------------------------------------------------------------------------------*)
+Symbol <VAR name: CRT.Name; VAR kind: INTEGER> =
+ ( ident (. kind := ident .)
+ | string (. kind := string .)
+ ) (. CRS.GetName(CRS.pos, CRS.len, name);
+ IF kind = string THEN FixString(name, CRS.len) END .) .
+(*------------------------------------------------------------------------------------*)
+Attribs <VAR attrPos: CRT.Position> =
+ "<" (. attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol .)
+ { ANY }
+ ">" (. attrPos.len := SHORT(CRS.pos - attrPos.beg) .).
+(*------------------------------------------------------------------------------------*)
+SemText <VAR semPos: CRT.Position> =
+ "(." (. semPos.beg := CRS.nextPos; semPos.col := CRS.nextCol .)
+ { ANY }
+ ".)" (. semPos.len := SHORT(CRS.pos - semPos.beg) .).
+
+END CR.
diff --git a/tools/Coco/CRA.obn b/tools/Coco/CRA.obn
--- /dev/null
+++ b/tools/Coco/CRA.obn
@@ -0,0 +1,930 @@
+MODULE CRA; (* handles the DFA *)
+
+IMPORT Oberon, Texts, Sets, CRS, CRT;
+
+CONST
+ maxStates = 300;
+ EOL = 0DX;
+
+TYPE
+ State = POINTER TO StateNode;
+ Action = POINTER TO ActionNode;
+ Target = POINTER TO TargetNode;
+
+ StateNode = RECORD (*state of finite automaton*)
+ nr: INTEGER; (*state number*)
+ firstAction: Action; (*to first action of this state*)
+ endOf: INTEGER; (*nr. of recognized token if state is final*)
+ ctx: BOOLEAN; (*TRUE: state reached by contextTrans*)
+ next: State
+ END;
+ ActionNode = RECORD (*action of finite automaton*)
+ typ: INTEGER; (*type of action symbol: char, class*)
+ sym: INTEGER; (*action symbol*)
+ tc: INTEGER; (*transition code: normTrans, contextTrans*)
+ target: Target; (*states after transition with input symbol*)
+ next: Action;
+ END;
+ TargetNode = RECORD (*state after transition with input symbol*)
+ state: State; (*target state*)
+ next: Target;
+ END;
+
+ Comment = POINTER TO CommentNode;
+ CommentNode = RECORD (* info about a comment syntax *)
+ start,stop: ARRAY 2 OF CHAR;
+ nested: BOOLEAN;
+ next: Comment;
+ END;
+
+ Melted = POINTER TO MeltedNode;
+ MeltedNode = RECORD (* info about melted states *)
+ set: CRT.Set; (* set of old states *)
+ state: State; (* new state *)
+ next: Melted;
+ END;
+
+
+VAR
+ firstState: State;
+ lastState: State; (* last allocated state *)
+ rootState: State; (* start state of DFA *)
+ lastSimState: INTEGER; (* last non melted state *)
+ stateNr: INTEGER; (*number of last allocated state*)
+ firstMelted: Melted; (* list of melted states *)
+ firstComment: Comment; (* list of comments *)
+ out: Texts.Writer; (* current output *)
+ fram: Texts.Reader; (* scanner frame input *)
+
+
+PROCEDURE SemErr(nr: INTEGER);
+BEGIN CRS.Error(200+nr, CRS.pos)
+END SemErr;
+
+PROCEDURE Put(ch: CHAR);
+BEGIN Texts.Write(out, ch) END Put;
+
+PROCEDURE PutS(s: ARRAY OF CHAR);
+ VAR i: INTEGER;
+BEGIN i := 0;
+ WHILE (i < LEN(s)) & (s[i] # 0X) DO
+ IF s[i] = "$" THEN Texts.WriteLn(out) ELSE Texts.Write(out, s[i]) END;
+ INC(i)
+ END
+END PutS;
+
+PROCEDURE PutI(i: INTEGER);
+BEGIN Texts.WriteInt(out, i, 0) END PutI;
+
+PROCEDURE PutI2(i, n: INTEGER);
+BEGIN Texts.WriteInt(out, i, n) END PutI2;
+
+PROCEDURE PutC(ch: CHAR);
+BEGIN
+ IF (ch < " ") OR (ORD(ch) = 34) THEN PutS("CHR("); PutI(ORD(ch)); Put(")")
+ ELSE Put(CHR(34)); Put(ch); Put(CHR(34))
+ END
+END PutC;
+
+PROCEDURE PutRange(s: CRT.Set);
+ VAR lo, hi: ARRAY 32 OF CHAR; top, i: INTEGER; s1: CRT.Set;
+BEGIN
+ (*----- fill lo and hi *)
+ top := -1; i := 0;
+ WHILE i < 128 DO
+ IF Sets.In(s, i) THEN
+ INC(top); lo[top] := CHR(i); INC(i);
+ WHILE (i < 128) & Sets.In(s, i) DO INC(i) END;
+ hi[top] := CHR(i - 1)
+ ELSE INC(i)
+ END
+ END;
+ (*----- print ranges *)
+ IF (top = 1) & (lo[0] = 0X) & (hi[1] = 7FX) & (CHR(ORD(hi[0]) + 2) = lo[1]) THEN
+ Sets.Fill(s1); Sets.Differ(s1, s); PutS("~ ("); PutRange(s1); Put(")")
+ ELSE
+ i := 0;
+ WHILE i <= top DO
+ IF hi[i] = lo[i] THEN PutS("(ch="); PutC(lo[i])
+ ELSIF lo[i] = 0X THEN PutS("(ch<="); PutC(hi[i])
+ ELSIF hi[i] = 7FX THEN PutS("(ch>="); PutC(lo[i])
+ ELSE PutS("(ch>="); PutC(lo[i]); PutS(") & (ch<="); PutC(hi[i])
+ END;
+ Put(")");
+ IF i < top THEN PutS(" OR ") END;
+ INC(i)
+ END
+ END
+END PutRange;
+
+PROCEDURE PutChCond(ch: CHAR);
+BEGIN
+ PutS("(ch ="); PutC(ch); Put(")")
+END PutChCond;
+
+PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
+ RETURN i
+END Length;
+
+
+PROCEDURE AddAction(act:Action; VAR head:Action);
+VAR a,lasta: Action;
+BEGIN
+ a := head; lasta := NIL;
+ LOOP
+ IF (a = NIL) (*collecting classes at the front gives better*)
+ OR (act^.typ < a^.typ) THEN (*performance*)
+ act^.next := a;
+ IF lasta = NIL THEN head := act ELSE lasta^.next := act END;
+ EXIT;
+ END;
+ lasta := a; a := a^.next;
+ END;
+END AddAction;
+
+
+PROCEDURE DetachAction(a:Action; VAR L:Action);
+BEGIN
+ IF L = a THEN L := a^.next ELSIF L # NIL THEN DetachAction(a, L^.next) END
+END DetachAction;
+
+
+PROCEDURE TheAction (state: State; ch: CHAR): Action;
+ VAR a: Action; set: CRT.Set;
+BEGIN
+ a := state.firstAction;
+ WHILE a # NIL DO
+ IF a.typ = CRT.char THEN
+ IF ORD(ch) = a.sym THEN RETURN a END
+ ELSIF a.typ = CRT.class THEN
+ CRT.GetClass(a^.sym, set);
+ IF Sets.In(set, ORD(ch)) THEN RETURN a END
+ END;
+ a := a.next
+ END;
+ RETURN NIL
+END TheAction;
+
+
+PROCEDURE AddTargetList(VAR lista, listb: Target);
+VAR p,t: Target;
+
+ PROCEDURE AddTarget(t: Target; VAR list:Target);
+ VAR p,lastp: Target;
+ BEGIN
+ p:=list; lastp:=NIL;
+ LOOP
+ IF (p = NIL) OR (t^.state.nr < p^.state.nr) THEN EXIT END;
+ IF p^.state = t^.state THEN RETURN END;
+ lastp := p; p := p^.next
+ END;
+ t^.next:=p;
+ IF lastp=NIL THEN list:=t ELSE lastp^.next:=t END
+ END AddTarget;
+
+BEGIN
+ p := lista;
+ WHILE p # NIL DO
+ NEW(t); t^.state:=p^.state; AddTarget(t, listb);
+ p := p^.next
+ END
+END AddTargetList;
+
+
+PROCEDURE NewMelted(set: CRT.Set; state: State): Melted;
+VAR melt: Melted;
+BEGIN
+ NEW(melt); melt^.set := set; melt^.state := state;
+ melt^.next := firstMelted; firstMelted := melt;
+ RETURN melt
+END NewMelted;
+
+
+PROCEDURE NewState(): State;
+ VAR state: State;
+BEGIN
+ NEW(state); INC(stateNr); state.nr := stateNr;
+ state.firstAction := NIL; state.endOf := CRT.noSym; state.ctx := FALSE; state.next := NIL;
+ IF firstState = NIL THEN firstState := state ELSE lastState.next := state END;
+ lastState := state;
+ RETURN state
+END NewState;
+
+
+PROCEDURE NewTransition(from, to: State; typ, sym, tc: INTEGER);
+ VAR a: Action; t: Target;
+BEGIN
+ NEW(t); t^.state := to; t^.next := NIL;
+ NEW(a); a^.typ := typ; a^.sym := sym; a^.tc := tc; a^.target := t;
+ AddAction(a, from.firstAction)
+END NewTransition;
+
+
+PROCEDURE NewComment*(from, to: INTEGER; nested: BOOLEAN);
+ VAR com: Comment;
+
+ PROCEDURE MakeStr(gp: INTEGER; VAR s: ARRAY OF CHAR);
+ VAR i, n: INTEGER; gn: CRT.GraphNode; set: CRT.Set;
+ BEGIN
+ i := 0;
+ WHILE gp # 0 DO
+ CRT.GetNode(gp, gn);
+ IF gn.typ = CRT.char THEN
+ IF i < 2 THEN s[i] := CHR(gn.p1) END; INC(i)
+ ELSIF gn.typ = CRT.class THEN
+ CRT.GetClass(gn.p1, set);
+ IF Sets.Elements(set, n) # 1 THEN SemErr(26) END;
+ IF i < 2 THEN s[i] := CHR(n) END; INC(i)
+ ELSE SemErr(22)
+ END;
+ gp := gn.next
+ END;
+ IF i > 2 THEN SemErr(25) ELSIF i < 2 THEN s[i] := 0X END
+ END MakeStr;
+
+BEGIN
+ NEW(com);
+ MakeStr(from, com^.start); MakeStr(to, com^.stop);
+ com^.nested := nested;
+ com^.next := firstComment; firstComment := com
+END NewComment;
+
+
+PROCEDURE MakeSet(p: Action; VAR set: CRT.Set);
+BEGIN
+ IF p^.typ = CRT.class THEN CRT.GetClass(p^.sym, set)
+ ELSE Sets.Clear(set); Sets.Incl(set, p^.sym)
+ END
+END MakeSet;
+
+
+PROCEDURE ChangeAction(a: Action; set: CRT.Set);
+VAR nr: INTEGER;
+BEGIN
+ IF Sets.Elements(set, nr) = 1 THEN a^.typ := CRT.char; a^.sym := nr
+ ELSE
+ nr := CRT.ClassWithSet(set);
+ IF nr < 0 THEN nr := CRT.NewClass("#0", set) END; (*class with dummy name*)
+ a^.typ := CRT.class; a^.sym := nr
+ END
+END ChangeAction;
+
+
+PROCEDURE CombineShifts;
+ VAR state: State; n: INTEGER; a, b, c: Action; seta, setb: CRT.Set;
+BEGIN
+ state := firstState;
+ WHILE state # NIL DO
+ a := state.firstAction;
+ WHILE a # NIL DO
+ b := a^.next;
+ WHILE b # NIL DO
+ IF (a^.target^.state = b^.target^.state) & (a^.tc = b^.tc) THEN
+ MakeSet(a, seta); MakeSet(b, setb); Sets.Unite(seta, setb);
+ ChangeAction(a, seta);
+ c := b; b := b^.next; DetachAction(c, a)
+ ELSE b := b^.next
+ END
+ END;
+ a := a^.next
+ END;
+ state := state.next
+ END
+END CombineShifts;
+
+
+PROCEDURE DeleteRedundantStates;
+VAR
+ action: Action;
+ state, s1, s2: State;
+ used: CRT.Set;
+ newState: ARRAY maxStates OF State;
+
+ PROCEDURE FindUsedStates(state: State);
+ VAR action: Action;
+ BEGIN
+ IF Sets.In(used, state.nr) THEN RETURN END;
+ Sets.Incl(used, state.nr);
+ action := state.firstAction;
+ WHILE action # NIL DO
+ FindUsedStates(action^.target^.state);
+ action:=action^.next
+ END
+ END FindUsedStates;
+
+ PROCEDURE DelUnused;
+ VAR state: State;
+ BEGIN
+ state := firstState.next; lastState := firstState; stateNr := 0; (*firstState has number 0*)
+ WHILE state # NIL DO
+ IF Sets.In(used, state.nr) THEN INC(stateNr); state.nr := stateNr; lastState := state
+ ELSE lastState.next := state.next
+ END;
+ state := state.next
+ END
+ END DelUnused;
+
+BEGIN
+ Sets.Clear(used); FindUsedStates(firstState);
+ (*---------- combine equal final states ------------*)
+ s1 := firstState.next; (*first state cannot be final*)
+ WHILE s1 # NIL DO
+ IF Sets.In(used, s1.nr) & (s1.endOf # CRT.noSym) & (s1.firstAction = NIL) & ~ s1.ctx THEN
+ s2 := s1.next;
+ WHILE s2 # NIL DO
+ IF Sets.In(used, s2.nr) & (s1.endOf = s2.endOf) & (s2.firstAction = NIL) & ~ s2.ctx THEN
+ Sets.Excl(used, s2.nr); newState[s2.nr] := s1
+ END;
+ s2 := s2.next
+ END
+ END;
+ s1 := s1.next
+ END;
+ state := firstState; (*> state := firstState.next*)
+ WHILE state # NIL DO
+ IF Sets.In(used, state.nr) THEN
+ action := state.firstAction;
+ WHILE action # NIL DO
+ IF ~ Sets.In(used, action.target.state.nr) THEN
+ action^.target^.state := newState[action.target.state.nr]
+ END;
+ action := action^.next
+ END
+ END;
+ state := state.next
+ END;
+ DelUnused
+END DeleteRedundantStates;
+
+
+PROCEDURE ConvertToStates*(gp0, sp: INTEGER);
+(*note: gn.line is abused as a state number!*)
+ VAR n: INTEGER; S: ARRAY maxStates OF State; gn: CRT.GraphNode;
+
+ PROCEDURE TheState(gp: INTEGER): State;
+ VAR state: State; gn: CRT.GraphNode;
+ BEGIN
+ IF gp = 0 THEN state := NewState(); state.endOf := sp; RETURN state
+ ELSE CRT.GetNode(gp, gn); RETURN S[gn.line]
+ END
+ END TheState;
+
+ PROCEDURE Step(from: State; gp: INTEGER);
+ VAR gn: CRT.GraphNode;
+ BEGIN
+ IF gp = 0 THEN RETURN END;
+ CRT.GetNode(gp, gn);
+ CASE gn.typ OF
+ CRT.class, CRT.char: NewTransition(from, TheState(ABS(gn.next)), gn.typ, gn.p1, gn.p2)
+ | CRT.alt: Step(from, gn.p1); Step(from, gn.p2)
+ | CRT.opt, CRT.iter: Step(from, ABS(gn.next)); Step(from, gn.p1)
+ END
+ END Step;
+
+ PROCEDURE FindTrans(gp: INTEGER; state: State);
+ VAR gn: CRT.GraphNode; new: BOOLEAN;
+ BEGIN
+ IF gp = 0 THEN RETURN END; (*end of graph*)
+ CRT.GetNode(gp, gn);
+ IF gn.line # 0 THEN RETURN END; (*already visited*)
+ new := state = NIL;
+ IF new THEN state := NewState() END;
+ INC(n); S[n] := state; gn.line := n; CRT.PutNode(gp, gn);
+ IF CRT.DelGraph(gp) THEN state.endOf := sp END; (*state is end state*)
+ CASE gn.typ OF
+ CRT.class, CRT.char: FindTrans(ABS(gn.next), NIL);
+ | CRT.opt: FindTrans(ABS(gn.next), NIL); FindTrans(gn.p1, state)
+ | CRT.iter: FindTrans(ABS(gn.next), state); FindTrans(gn.p1, state)
+ | CRT.alt: FindTrans(gn.p1, state); FindTrans(gn.p2, state)
+ END;
+ IF new OR (state = firstState) & (gp = gp0) THEN (*start of a group of equally numbered nodes*)
+ Step(state, gp)
+ END
+ END FindTrans;
+
+BEGIN
+ IF CRT.DelGraph(gp0) THEN SemErr(20) END;
+ CRT.GetNode(gp0, gn);
+ IF gn.typ = CRT.iter THEN SemErr(21) END;
+ n := 0; FindTrans(gp0, firstState)
+END ConvertToStates;
+
+
+PROCEDURE MatchDFA* (s: ARRAY OF CHAR; sp: INTEGER; VAR matchedSp: INTEGER);
+ VAR state, to: State; a: Action; i, len: INTEGER;
+BEGIN (*s with quotes*)
+ state := firstState; i := 1; len := Length(s) - 1;
+ LOOP (*try to match s against existing DFA*)
+ IF i = len THEN EXIT END;
+ a := TheAction(state, s[i]);
+ IF a = NIL THEN EXIT END;
+ state := a.target.state; INC(i)
+ END;
+ WHILE i < len DO (*make new DFA for s[i..len-1]*)
+ to := NewState();
+ NewTransition(state, to, CRT.char, ORD(s[i]), CRT.normTrans);
+ state := to; INC(i)
+ END;
+ matchedSp := state.endOf;
+ IF state.endOf = CRT.noSym THEN state.endOf := sp END
+END MatchDFA;
+
+
+PROCEDURE SplitActions(a, b: Action);
+VAR c: Action; seta, setb, setc: CRT.Set;
+
+ PROCEDURE CombineTransCodes(t1, t2: INTEGER; VAR result:INTEGER);
+ BEGIN
+ IF t1 = CRT.contextTrans THEN result := t1 ELSE result := t2 END
+ END CombineTransCodes;
+
+BEGIN
+ MakeSet(a, seta); MakeSet(b, setb);
+ IF Sets.Equal(seta, setb) THEN
+ AddTargetList(b^.target, a^.target);
+ CombineTransCodes(a^.tc, b^.tc, a^.tc);
+ DetachAction(b, a)
+ ELSIF Sets.Includes(seta, setb) THEN
+ setc := seta; Sets.Differ(setc, setb);
+ AddTargetList(a^.target, b^.target);
+ CombineTransCodes(a^.tc, b^.tc, b^.tc);
+ ChangeAction(a, setc)
+ ELSIF Sets.Includes(setb, seta) THEN
+ setc := setb; Sets.Differ(setc, seta);
+ AddTargetList(b^.target, a^.target);
+ CombineTransCodes(a^.tc, b^.tc, a^.tc);
+ ChangeAction(b, setc)
+ ELSE
+ Sets.Intersect(seta, setb, setc);
+ Sets.Differ(seta, setc);
+ Sets.Differ(setb, setc);
+ ChangeAction(a, seta);
+ ChangeAction(b, setb);
+ NEW(c); c^.target:=NIL;
+ CombineTransCodes(a^.tc, b^.tc, c^.tc);
+ AddTargetList(a^.target, c^.target);
+ AddTargetList(b^.target, c^.target);
+ ChangeAction(c, setc);
+ AddAction(c, a)
+ END
+END SplitActions;
+
+
+PROCEDURE MakeUnique(state: State; VAR changed:BOOLEAN);
+VAR a, b: Action;
+
+ PROCEDURE Overlap(a, b: Action): BOOLEAN;
+ VAR seta, setb: CRT.Set;
+ BEGIN
+ IF a^.typ = CRT.char THEN
+ IF b^.typ = CRT.char THEN RETURN a^.sym = b^.sym
+ ELSE CRT.GetClass(b^.sym, setb); RETURN Sets.In(setb, a^.sym)
+ END
+ ELSE
+ CRT.GetClass(a^.sym, seta);
+ IF b^.typ = CRT.char THEN RETURN Sets.In(seta, b^.sym)
+ ELSE CRT.GetClass(b^.sym, setb); RETURN ~ Sets.Different(seta, setb)
+ END
+ END
+ END Overlap;
+
+BEGIN
+ a := state.firstAction; changed := FALSE;
+ WHILE a # NIL DO
+ b := a^.next;
+ WHILE b # NIL DO
+ IF Overlap(a, b) THEN SplitActions(a, b); changed:=TRUE END;
+ b := b^.next;
+ END;
+ a:=a^.next
+ END
+END MakeUnique;
+
+
+PROCEDURE MeltStates(state: State; VAR correct:BOOLEAN);
+VAR
+ action: Action;
+ ctx: BOOLEAN;
+ endOf: INTEGER;
+ melt: Melted;
+ set: CRT.Set;
+ s: State;
+ changed: BOOLEAN;
+
+ PROCEDURE AddMeltedSet(nr: INTEGER; VAR set: CRT.Set);
+ VAR m: Melted;
+ BEGIN
+ m := firstMelted;
+ WHILE (m # NIL) & (m^.state.nr # nr) DO m := m^.next END;
+ IF m = NIL THEN HALT(98) END;
+ Sets.Unite(set, m^.set);
+ END AddMeltedSet;
+
+ PROCEDURE GetStateSet(t: Target; VAR set: CRT.Set; VAR endOf: INTEGER; VAR ctx:BOOLEAN);
+ VAR statenr: INTEGER; (*lastS: State;*)
+ BEGIN
+ Sets.Clear(set); endOf := CRT.noSym; ctx := FALSE; (*lastS := NIL;*)
+ WHILE t # NIL DO
+ statenr := t.state.nr;
+ IF statenr <= lastSimState THEN Sets.Incl(set, statenr)
+ ELSE AddMeltedSet(statenr, set)
+ END;
+ IF t^.state^.endOf # CRT.noSym THEN
+ IF (endOf = CRT.noSym) OR (endOf = t^.state^.endOf)
+ (*OR (lastS^.firstAction # NIL) & (t^.state^.firstAction = NIL)*) THEN
+ endOf := t^.state.endOf; (*lastS := t^.state*)
+ ELSE
+ PutS("$Tokens "); PutI(endOf); PutS(" and "); PutI(t^.state.endOf);
+ PutS(" cannot be distinguished.$");
+ correct:=FALSE
+ END
+ END;
+ IF t^.state.ctx THEN ctx := TRUE;
+ IF t.state.endOf # CRT.noSym THEN
+ PutS("$Ambiguous CONTEXT clause.$"); correct := FALSE
+ END
+ END;
+ t := t^.next
+ END
+ END GetStateSet;
+
+ PROCEDURE FillWithActions(state: State; targ: Target);
+ VAR action,a: Action;
+ BEGIN
+ WHILE targ # NIL DO
+ action := targ^.state.firstAction;
+ WHILE action # NIL DO
+ NEW(a); a^ := action^; a^.target := NIL;
+ AddTargetList(action^.target, a^.target);
+ AddAction(a, state.firstAction);
+ action:=action^.next
+ END;
+ targ:=targ^.next
+ END;
+ END FillWithActions;
+
+ PROCEDURE KnownMelted(set:CRT.Set; VAR melt: Melted): BOOLEAN;
+ BEGIN
+ melt := firstMelted;
+ WHILE melt # NIL DO
+ IF Sets.Equal(set, melt^.set) THEN RETURN TRUE END;
+ melt := melt^.next
+ END;
+ RETURN FALSE
+ END KnownMelted;
+
+BEGIN
+ action := state.firstAction;
+ WHILE action # NIL DO
+ IF action^.target^.next # NIL THEN (*more than one target state*)
+ GetStateSet(action^.target, set, endOf, ctx);
+ IF ~ KnownMelted(set, melt) THEN
+ s := NewState(); s.endOf := endOf; s.ctx := ctx;
+ FillWithActions(s, action^.target);
+ REPEAT MakeUnique(s, changed) UNTIL ~ changed;
+ melt := NewMelted(set, s);
+ END;
+ action^.target^.next:=NIL;
+ action^.target^.state := melt^.state
+ END;
+ action := action^.next
+ END;
+ Texts.Append(Oberon.Log, out.buf)
+END MeltStates;
+
+
+PROCEDURE MakeDeterministic*(VAR correct: BOOLEAN);
+ VAR state: State; changed: BOOLEAN;
+
+ PROCEDURE FindCtxStates; (*find states reached by a context transition*)
+ VAR a: Action; state: State;
+ BEGIN
+ state := firstState;
+ WHILE state # NIL DO
+ a := state.firstAction;
+ WHILE a # NIL DO
+ IF a^.tc = CRT.contextTrans THEN a^.target^.state.ctx := TRUE END;
+ a := a^.next
+ END;
+ state := state.next
+ END;
+ END FindCtxStates;
+
+BEGIN
+ IF lastState = NIL THEN lastSimState := 0 ELSE lastSimState := lastState.nr END;
+ FindCtxStates;
+ state := firstState;
+ WHILE state # NIL DO
+ REPEAT MakeUnique(state, changed) UNTIL ~ changed;
+ state := state.next
+ END;
+ correct := TRUE;
+ state := firstState;
+ WHILE state # NIL DO MeltStates(state, correct); state := state.next END;
+ DeleteRedundantStates;
+ CombineShifts
+END MakeDeterministic;
+
+
+PROCEDURE PrintSymbol(typ, val, width: INTEGER);
+VAR name: CRT.Name; len: INTEGER;
+BEGIN
+ IF typ = CRT.class THEN
+ CRT.GetClassName(val, name); PutS(name); len := Length(name)
+ ELSIF (val >= ORD(" ")) & (val < 127) & (val # 34) THEN
+ Put(CHR(34)); Put(CHR(val)); Put(CHR(34)); len:=3
+ ELSE
+ PutS("CHR("); PutI2(val, 2); Put(")"); len:=7
+ END;
+ WHILE len < width DO Put(" "); INC(len) END
+END PrintSymbol;
+
+
+PROCEDURE PrintStates*;
+VAR action: Action; first: BOOLEAN; state: State; i: INTEGER; targ: Target; set: CRT.Set; name: CRT.Name;
+BEGIN
+ PutS("$-------- states ---------$");
+ state := firstState;
+ WHILE state # NIL DO
+ action := state.firstAction; first:=TRUE;
+ IF state.endOf = CRT.noSym THEN PutS(" ")
+ ELSE PutS("E("); PutI2(state.endOf, 2); Put(")")
+ END;
+ PutI2(state.nr, 3); Put(":"); IF action = NIL THEN PutS(" $") END;
+ WHILE action # NIL DO
+ IF first THEN Put(" "); first:=FALSE ELSE PutS(" ") END;
+ PrintSymbol(action^.typ, action^.sym, 0); Put(" ");
+ targ := action^.target;
+ WHILE targ # NIL DO
+ PutI(targ^.state.nr); Put(" "); targ := targ^.next;
+ END;
+ IF action^.tc = CRT.contextTrans THEN PutS(" context$") ELSE PutS(" $") END;
+ action := action^.next
+ END;
+ state := state.next
+ END;
+ PutS("$-------- character classes ---------$");
+ i := 0;
+ WHILE i <= CRT.maxC DO
+ CRT.GetClass(i, set); CRT.GetClassName(i, name); PutS(name); PutS(": ");
+ Sets.Print(out, set, 80, 13); Texts.WriteLn(out);
+ INC(i)
+ END;
+ Texts.Append(Oberon.Log, out.buf)
+END PrintStates;
+
+
+PROCEDURE GenComment(com:Comment);
+
+ PROCEDURE GenBody;
+ BEGIN
+ PutS(" LOOP$");
+ PutS(" IF "); PutChCond(com^.stop[0]); PutS(" THEN$");
+ IF Length(com^.stop) = 1 THEN
+ PutS(" DEC(level); oldEols := chLine - startLine; NextCh;$");
+ PutS(" IF level = 0 THEN RETURN TRUE END;$");
+ ELSE
+ PutS(" NextCh;$");
+ PutS(" IF "); PutChCond(com^.stop[1]); PutS(" THEN$");
+ PutS(" DEC(level); oldEols := chLine - startLine; NextCh;$");
+ PutS(" IF level=0 THEN RETURN TRUE END$");
+ PutS(" END;$");
+ END;
+ IF com^.nested THEN
+ PutS(" ELSIF "); PutChCond(com^.start[0]); PutS(" THEN$");
+ IF Length(com^.start) = 1 THEN
+ PutS(" INC(level); NextCh;$");
+ ELSE
+ PutS(" NextCh;$");
+ PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$");
+ PutS(" INC(level); NextCh;$");
+ PutS(" END;$");
+ END;
+ END;
+ PutS(" ELSIF ch = EOF THEN RETURN FALSE$");
+ PutS(" ELSE NextCh END;$");
+ PutS(" END;$");
+ END GenBody;
+
+BEGIN
+ PutS(" IF "); PutChCond(com^.start[0]); PutS(" THEN$");
+ IF Length(com^.start) = 1 THEN
+ PutS(" NextCh;$");
+ GenBody;
+ PutS(" END;");
+ ELSE
+ PutS(" NextCh;$");
+ PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$");
+ PutS(" NextCh;$");
+ GenBody;
+ PutS(" ELSE$");
+ PutS(" IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;$");
+ PutS(" DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE$");
+ PutS(" END$");
+ PutS(" END;");
+ END;
+ END GenComment;
+
+
+PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file <fram> to file <out> until <stopStr>*)
+ VAR ch, startCh: CHAR; i, j, high: INTEGER;
+BEGIN
+ startCh := stopStr[0]; high := Length(stopStr) - 1; Texts.Read (fram, ch);
+ WHILE ch # 0X DO
+ IF ch = startCh THEN (* check if stopString occurs *)
+ i := 0;
+ REPEAT
+ IF i = high THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*)
+ Texts.Read (fram, ch); INC(i);
+ UNTIL ch # stopStr[i];
+ (*stopStr[0..i-1] found; 1 unrecognized character*)
+ j := 0; WHILE j < i DO Texts.Write(out, stopStr[j]); INC(j) END
+ ELSE Texts.Write (out, ch); Texts.Read(fram, ch)
+ END
+ END
+END CopyFramePart;
+
+PROCEDURE GenLiterals;
+ VAR
+ i, j, k, l: INTEGER;
+ key: ARRAY 128 OF CRT.Name;
+ knr: ARRAY 128 OF INTEGER;
+ ch: CHAR;
+ sn: CRT.SymbolNode;
+BEGIN
+ (*-- sort literal list*)
+ i := 0; k := 0;
+ WHILE i <= CRT.maxT DO
+ CRT.GetSym(i, sn);
+ IF sn.struct = CRT.litToken THEN
+ j := k-1; WHILE (j >= 0) & (sn.name < key[j]) DO key[j+1] := key[j]; knr[j+1] := knr[j]; DEC(j) END;
+ key[j+1] := sn.name; knr[j+1] := i; INC(k)
+ END;
+ INC(i)
+ END;
+ (*-- print case statement*)
+ IF k > 0 THEN
+ PutS(" IF (lexeme[0] >= "); PutC(key[0, 1]); PutS(") & (lexeme[0] <= "); PutC(key[k-1, 1]); PutS(") THEN$");
+ PutS(" CASE lexeme[0] OF$");
+ i := 0;
+ WHILE i < k DO
+ ch := key[i, 1]; (*key[i, 0] = quote*)
+ PutS(" | "); PutC(ch); j := i;
+ REPEAT
+ IF i = j THEN PutS(": IF lexeme = ") ELSE PutS(" ELSIF lexeme = ") END;
+ PutS(key[i]); PutS(" THEN sym := "); PutI(knr[i]); Put(CHR(13));
+ INC(i)
+ UNTIL (i = k) OR (key[i, 1] # ch);
+ PutS(" END$");
+ END;
+ PutS(" ELSE$ END$ END;$")
+ END
+END GenLiterals;
+
+
+PROCEDURE WriteState(state: State);
+ VAR action: Action; first, ctxEnd: BOOLEAN; sn: CRT.SymbolNode; endOf: INTEGER;
+ set: CRT.Set;
+BEGIN
+ endOf := state.endOf;
+ IF (endOf > CRT.maxT) & (endOf # CRT.noSym) THEN (*pragmas have been moved*)
+ endOf := CRT.maxT + CRT.maxSymbols - endOf
+ END;
+ PutS(" | "); PutI2(state.nr, 2); PutS(": ");
+ first:=TRUE; ctxEnd := state.ctx;
+ action := state.firstAction;
+ WHILE action # NIL DO
+ IF first THEN PutS("IF "); first:=FALSE ELSE PutS(" ELSIF ") END;
+ IF action^.typ = CRT.char THEN PutChCond(CHR(action^.sym))
+ ELSE CRT.GetClass(action^.sym, set); PutRange(set)
+ END;
+ PutS(" THEN");
+ IF action.target.state.nr # state.nr THEN
+ PutS(" state := "); PutI(action.target.state.nr); Put(";")
+ END;
+ IF action^.tc = CRT.contextTrans THEN PutS(" INC(apx)"); ctxEnd := FALSE
+ ELSIF state.ctx THEN PutS(" apx := 0")
+ END;
+ PutS(" $");
+ action := action^.next
+ END;
+ IF state.firstAction # NIL THEN PutS(" ELSE ") END;
+ IF endOf = CRT.noSym THEN PutS("sym := noSym; ")
+ ELSE (*final state*)
+ CRT.GetSym(endOf, sn);
+ IF ctxEnd THEN (*final context state: cut appendix*)
+ PutS("chPos := chPos - apx - 1; Texts.OpenReader(r, src, chPos+1); NextCh; ")
+ END;
+ PutS("sym := "); PutI(endOf); PutS("; ");
+ IF sn.struct = CRT.classLitToken THEN PutS("CheckLiteral; ") END
+ END;
+ PutS("RETURN$");
+ IF state.firstAction # NIL THEN PutS(" END;$") END
+END WriteState;
+
+PROCEDURE *Show (t: Texts.Text; op: INTEGER; beg, end: LONGINT);
+END Show;
+
+
+PROCEDURE WriteScanner*;
+VAR
+ scanner: ARRAY 32 OF CHAR;
+ name: ARRAY 64 OF CHAR;
+ startTab: ARRAY 128 OF INTEGER;
+ com: Comment;
+ i, j, l: INTEGER;
+ gn: CRT.GraphNode;
+ sn: CRT.SymbolNode;
+ state: State;
+ t: Texts.Text;
+
+ PROCEDURE FillStartTab;
+ VAR action: Action; i, targetState: INTEGER; class: CRT.Set;
+ BEGIN
+ startTab[0] := stateNr + 1; (*eof*)
+ i := 1; WHILE i < 128 DO startTab[i] := 0; INC(i) END;
+ action := firstState.firstAction;
+ WHILE action # NIL DO
+ targetState := action.target.state.nr;
+ IF action^.typ = CRT.char THEN
+ startTab[action^.sym] := targetState
+ ELSE
+ CRT.GetClass(action^.sym, class); i := 0;
+ WHILE i < 128 DO
+ IF Sets.In(class, i) THEN startTab[i] := targetState END;
+ INC(i)
+ END
+ END;
+ action := action^.next
+ END
+ END FillStartTab;
+
+BEGIN
+ FillStartTab;
+ CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
+ COPY(sn.name, scanner); l := Length(scanner); scanner[l] := "S"; scanner[l+1] := 0X;
+ NEW(t); Texts.Open(t, "Scanner.FRM"); Texts.OpenReader(fram, t, 0);
+ IF t.len = 0 THEN
+ Texts.WriteString(out, "Scanner.FRM not found"); Texts.WriteLn(out);
+ Texts.Append(Oberon.Log, out.buf); HALT(99)
+ END;
+ Texts.Append(Oberon.Log, out.buf);
+
+ (*------- *S.MOD -------*)
+ CopyFramePart("-->modulename"); PutS(scanner);
+ CopyFramePart("-->declarations"); PutS(" noSym = "); PutI(CRT.maxT); Put(";");
+ CopyFramePart("-->comment");
+ com := firstComment;
+ WHILE com # NIL DO GenComment(com); com := com^.next END;
+ CopyFramePart("-->literals"); GenLiterals;
+
+ CopyFramePart("-->GetSy1");
+ IF ~ Sets.In(CRT.ignored, ORD(EOL)) THEN PutS(" IF oldEols > 0 THEN DEC(oldEols); ch := EOL END;$") END;
+ PutS(" WHILE (ch=20X)"); IF ~ Sets.Empty(CRT.ignored) THEN PutS(" OR ") END;
+ PutRange(CRT.ignored); PutS(" DO NextCh END;");
+ IF firstComment # NIL THEN
+ PutS("$ IF ("); com := firstComment;
+ WHILE com # NIL DO
+ PutChCond(com^.start[0]);
+ IF com^.next # NIL THEN PutS(" OR ") END;
+ com := com^.next
+ END;
+ PutS(") & Comment() THEN Get(sym); RETURN END;")
+ END;
+ CopyFramePart("-->GetSy2");
+ state := firstState.next;
+ WHILE state # NIL DO WriteState(state); state := state.next END;
+ PutS(" | "); PutI2(stateNr + 1, 2); PutS(": sym := 0; ch := 0X; RETURN$");
+
+ CopyFramePart("-->initialization");
+ i := 0;
+ WHILE i < 32 DO
+ j := 0; PutS(" ");
+ WHILE j < 4 DO
+ PutS("start["); PutI(4*i+j); PutS("]:="); PutI(startTab[4*i+j]); PutS("; ");
+ INC(j)
+ END;
+ Texts.WriteLn(out);
+ INC(i)
+ END;
+
+ CopyFramePart("-->modulename"); PutS(scanner); Put(".");
+ NEW(t); t.notify := Show; Texts.Open(t, ""); Texts.Append(t, out.buf);
+ l := Length(scanner); scanner[l] := "."; scanner[l+1] := "M"; scanner[l+2] := "o"; scanner[l+3] := "d"; scanner[l+4] := 0X;
+ Texts.Close(t, scanner)
+END WriteScanner;
+
+
+PROCEDURE Init*;
+BEGIN
+ firstState := NIL; lastState := NIL; stateNr := -1;
+ rootState := NewState();
+ firstMelted := NIL; firstComment := NIL
+END Init;
+
+BEGIN
+ Texts.OpenWriter(out)
+END CRA.
diff --git a/tools/Coco/CRP.obn b/tools/Coco/CRP.obn
--- /dev/null
+++ b/tools/Coco/CRP.obn
@@ -0,0 +1,703 @@
+(* parser module generated by Coco-R *)
+MODULE CRP;
+
+IMPORT CRS, CRT, CRA, CRX, Sets, Texts, Oberon;
+
+CONST
+ maxP = 39;
+ maxT = 38;
+ nrSets = 18;
+
+ setSize = 32; nSets = (maxT DIV setSize) + 1;
+
+TYPE
+ SymbolSet = ARRAY nSets OF SET;
+
+VAR
+ sym: INTEGER; (* current input symbol *)
+ symSet: ARRAY nrSets OF SymbolSet;
+
+CONST
+ ident = 0; string = 1; (*symbol kind*)
+
+VAR
+ str: ARRAY 32 OF CHAR;
+ w: Texts.Writer;
+ genScanner: BOOLEAN;
+
+
+PROCEDURE SemErr(nr: INTEGER);
+BEGIN
+ CRS.Error(200+nr, CRS.pos);
+END SemErr;
+
+PROCEDURE MatchLiteral(sp: INTEGER); (*store string either as token or as literal*)
+ VAR sn, sn1: CRT.SymbolNode; matchedSp: INTEGER;
+BEGIN
+ CRT.GetSym(sp, sn);
+ CRA.MatchDFA(sn.name, sp, matchedSp);
+ IF matchedSp # CRT.noSym THEN
+ CRT.GetSym(matchedSp, sn1); sn1.struct := CRT.classLitToken; CRT.PutSym(matchedSp, sn1);
+ sn.struct := CRT.litToken
+ ELSE sn.struct := CRT.classToken;
+ END;
+ CRT.PutSym(sp, sn)
+END MatchLiteral;
+
+PROCEDURE SetCtx(gp: INTEGER); (*set transition code to CRT.contextTrans*)
+ VAR gn: CRT.GraphNode;
+BEGIN
+ WHILE gp > 0 DO
+ CRT.GetNode(gp, gn);
+ IF gn.typ IN {CRT.char, CRT.class} THEN
+ gn.p2 := CRT.contextTrans; CRT.PutNode(gp, gn)
+ ELSIF gn.typ IN {CRT.opt, CRT.iter} THEN SetCtx(gn.p1)
+ ELSIF gn.typ = CRT.alt THEN SetCtx(gn.p1); SetCtx(gn.p2)
+ END;
+ gp := gn.next
+ END
+END SetCtx;
+
+PROCEDURE SetDDT(s: ARRAY OF CHAR);
+ VAR name: ARRAY 64 OF CHAR; i: INTEGER; ch: CHAR;
+BEGIN
+ i := 1;
+ WHILE s[i] # 0X DO
+ ch := s[i]; INC(i);
+ IF (ch >= "0") & (ch <= "9") THEN CRT.ddt[ORD(ch)-ORD("0")] := TRUE END
+ END
+END SetDDT;
+
+PROCEDURE FixString (VAR s: ARRAY OF CHAR; len: INTEGER);
+ VAR double: BOOLEAN; i: INTEGER;
+BEGIN
+ double := FALSE;
+ FOR i := 0 TO len-2 DO
+ IF s[i] = '"' THEN double := TRUE END
+ END;
+ IF ~ double THEN s[0] := '"'; s[len-1] := '"' END
+END FixString;
+
+(*-------------------------------------------------------------------------*)
+
+
+PROCEDURE Error (n: INTEGER);
+BEGIN CRS.Error(n, CRS.nextPos)
+END Error;
+
+PROCEDURE Get;
+BEGIN
+ LOOP CRS.Get(sym);
+ IF sym > maxT THEN
+ IF sym = 39 THEN
+ CRS.GetName(CRS.nextPos, CRS.nextLen, str); SetDDT(str)
+ END;
+ CRS.nextPos := CRS.pos;
+ CRS.nextCol := CRS.col;
+ CRS.nextLine := CRS.line;
+ CRS.nextLen := CRS.len;
+ ELSE EXIT
+ END
+END
+
+END Get;
+
+PROCEDURE Expect(n: INTEGER);
+BEGIN IF sym = n THEN Get ELSE Error(n) END
+END Expect;
+
+PROCEDURE StartOf(s: INTEGER): BOOLEAN;
+BEGIN RETURN (sym MOD setSize) IN symSet[s, sym DIV setSize]
+END StartOf;
+
+PROCEDURE ExpectWeak(n, follow: INTEGER);
+BEGIN
+ IF sym = n THEN Get
+ ELSE Error(n); WHILE ~ StartOf(follow) DO Get END
+ END
+END ExpectWeak;
+
+PROCEDURE WeakSeparator(n, syFol, repFol: INTEGER): BOOLEAN;
+ VAR s: SymbolSet; i: INTEGER;
+BEGIN
+ IF sym = n THEN Get; RETURN TRUE
+ ELSIF StartOf(repFol) THEN RETURN FALSE
+ ELSE
+ i := 0; WHILE i < nSets DO s[i] := symSet[syFol, i] + symSet[repFol, i] + symSet[0, i]; INC(i) END;
+ Error(n); WHILE ~ ((sym MOD setSize) IN s[sym DIV setSize]) DO Get END;
+ RETURN StartOf(syFol)
+ END
+END WeakSeparator;
+
+PROCEDURE ^TokenFactor(VAR gL, gR: INTEGER);
+PROCEDURE ^TokenTerm(VAR gL, gR: INTEGER);
+PROCEDURE ^Factor(VAR gL, gR: INTEGER);
+PROCEDURE ^Term(VAR gL, gR: INTEGER);
+PROCEDURE ^Symbol(VAR name: CRT.Name; VAR kind: INTEGER);
+PROCEDURE ^SimSet(VAR set: CRT.Set);
+PROCEDURE ^Set(VAR set: CRT.Set);
+PROCEDURE ^TokenExpr(VAR gL, gR: INTEGER);
+PROCEDURE ^TokenDecl(typ: INTEGER);
+PROCEDURE ^SetDecl;
+PROCEDURE ^Expression(VAR gL, gR: INTEGER);
+PROCEDURE ^SemText(VAR semPos: CRT.Position);
+PROCEDURE ^Attribs(VAR attrPos: CRT.Position);
+PROCEDURE ^Declaration;
+PROCEDURE ^CR;
+
+PROCEDURE TokenFactor(VAR gL, gR: INTEGER);
+ VAR kind, c: INTEGER; set: CRT.Set; name: CRT.Name;
+BEGIN
+ gL :=0; gR := 0 ;
+ IF (sym = 1) OR (sym = 2) THEN
+ Symbol(name, kind);
+ IF kind = ident THEN
+ c := CRT.ClassWithName(name);
+ IF c < 0 THEN
+ SemErr(15);
+ Sets.Clear(set); c := CRT.NewClass(name, set)
+ END;
+ gL := CRT.NewNode(CRT.class, c, 0); gR := gL
+ ELSE (*string*)
+ CRT.StrToGraph(name, gL, gR)
+ END ;
+ ELSIF (sym = 23) THEN
+ Get;
+ TokenExpr(gL, gR);
+ Expect(24);
+ ELSIF (sym = 28) THEN
+ Get;
+ TokenExpr(gL, gR);
+ Expect(29);
+ CRT.MakeOption(gL, gR) ;
+ ELSIF (sym = 30) THEN
+ Get;
+ TokenExpr(gL, gR);
+ Expect(31);
+ CRT.MakeIteration(gL, gR) ;
+ ELSE Error(39)
+ END;
+END TokenFactor;
+
+PROCEDURE TokenTerm(VAR gL, gR: INTEGER);
+ VAR gL2, gR2: INTEGER;
+BEGIN
+ TokenFactor(gL, gR);
+ WHILE StartOf(1) DO
+ TokenFactor(gL2, gR2);
+ CRT.ConcatSeq(gL, gR, gL2, gR2) ;
+ END;
+ IF (sym = 33) THEN
+ Get;
+ Expect(23);
+ TokenExpr(gL2, gR2);
+ SetCtx(gL2); CRT.ConcatSeq(gL, gR, gL2, gR2) ;
+ Expect(24);
+ END;
+END TokenTerm;
+
+PROCEDURE Factor(VAR gL, gR: INTEGER);
+ VAR sp, kind, c: INTEGER; name: CRT.Name;
+ gn: CRT.GraphNode; sn: CRT.SymbolNode;
+ set: CRT.Set;
+ undef, weak: BOOLEAN;
+ pos: CRT.Position;
+BEGIN
+ gL :=0; gR := 0; weak := FALSE ;
+ CASE sym OF
+ | 1,2,27: IF (sym = 27) THEN
+ Get;
+ weak := TRUE ;
+ END;
+ Symbol(name, kind);
+ sp := CRT.FindSym(name); undef := sp = CRT.noSym;
+ IF undef THEN
+ IF kind = ident THEN (*forward nt*)
+ sp := CRT.NewSym(CRT.nt, name, 0)
+ ELSE (*undefined string in production*)
+ sp := CRT.NewSym(CRT.t, name, CRS.line);
+ MatchLiteral(sp)
+ END
+ END;
+ CRT.GetSym(sp, sn);
+ IF ~(sn.typ IN {CRT.t,CRT.nt}) THEN SemErr(4) END;
+ IF weak THEN
+ IF sn.typ = CRT.t THEN sn.typ := CRT.wt ELSE SemErr(23) END
+ END;
+ gL := CRT.NewNode(sn.typ, sp, CRS.line); gR := gL ;
+ IF (sym = 34) THEN
+ Attribs(pos);
+ CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn);
+ CRT.GetSym(sp, sn);
+ IF undef THEN
+ sn.attrPos := pos; CRT.PutSym(sp, sn)
+ ELSIF sn.attrPos.beg < 0 THEN SemErr(5)
+ END;
+ IF kind # ident THEN SemErr(3) END ;
+ ELSIF StartOf(2) THEN
+ CRT.GetSym(sp, sn);
+ IF sn.attrPos.beg >= 0 THEN SemErr(6) END ;
+ ELSE Error(40)
+ END;
+ | 23: Get;
+ Expression(gL, gR);
+ Expect(24);
+ | 28: Get;
+ Expression(gL, gR);
+ Expect(29);
+ CRT.MakeOption(gL, gR) ;
+ | 30: Get;
+ Expression(gL, gR);
+ Expect(31);
+ CRT.MakeIteration(gL, gR) ;
+ | 36: SemText(pos);
+ gL := CRT.NewNode(CRT.sem, 0, 0);
+ gR := gL;
+ CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn) ;
+ | 25: Get;
+ Sets.Fill(set); Sets.Excl(set, CRT.eofSy);
+ gL := CRT.NewNode(CRT.any, CRT.NewSet(set), 0); gR := gL ;
+ | 32: Get;
+ gL := CRT.NewNode(CRT.sync, 0, 0); gR := gL ;
+ ELSE Error(41)
+ END;
+END Factor;
+
+PROCEDURE Term(VAR gL, gR: INTEGER);
+ VAR gL2, gR2: INTEGER;
+BEGIN
+ gL := 0; gR := 0 ;
+ IF StartOf(3) THEN
+ Factor(gL, gR);
+ WHILE StartOf(3) DO
+ Factor(gL2, gR2);
+ CRT.ConcatSeq(gL, gR, gL2, gR2) ;
+ END;
+ ELSIF StartOf(4) THEN
+ gL := CRT.NewNode(CRT.eps, 0, 0); gR := gL ;
+ ELSE Error(42)
+ END;
+END Term;
+
+PROCEDURE Symbol(VAR name: CRT.Name; VAR kind: INTEGER);
+BEGIN
+ IF (sym = 1) THEN
+ Get;
+ kind := ident ;
+ ELSIF (sym = 2) THEN
+ Get;
+ kind := string ;
+ ELSE Error(43)
+ END;
+ CRS.GetName(CRS.pos, CRS.len, name);
+ IF kind = string THEN FixString(name, CRS.len) END ;
+END Symbol;
+
+PROCEDURE SimSet(VAR set: CRT.Set);
+ VAR c, n, i: INTEGER; name: CRT.Name; s: ARRAY 128 OF CHAR;
+BEGIN
+ IF (sym = 1) THEN
+ Get;
+ CRS.GetName(CRS.pos, CRS.len, name);
+ c := CRT.ClassWithName(name);
+ IF c < 0 THEN SemErr(15); Sets.Clear(set)
+ ELSE CRT.GetClass(c, set)
+ END ;
+ ELSIF (sym = 2) THEN
+ Get;
+ CRS.GetName(CRS.pos, CRS.len, s);
+ Sets.Clear(set); i := 1;
+ WHILE s[i] # s[0] DO
+ Sets.Incl(set, ORD(s[i])); INC(i)
+ END ;
+ ELSIF (sym = 22) THEN
+ Get;
+ Expect(23);
+ Expect(3);
+ CRS.GetName(CRS.pos, CRS.len, name);
+ n := 0; i := 0;
+ WHILE name[i] # 0X DO
+ n := 10 * n + (ORD(name[i]) - ORD("0"));
+ INC(i)
+ END;
+ Sets.Clear(set); Sets.Incl(set, n) ;
+ Expect(24);
+ ELSIF (sym = 25) THEN
+ Get;
+ Sets.Fill(set) ;
+ ELSE Error(44)
+ END;
+END SimSet;
+
+PROCEDURE Set(VAR set: CRT.Set);
+ VAR set2: CRT.Set;
+BEGIN
+ SimSet(set);
+ WHILE (sym = 20) OR (sym = 21) DO
+ IF (sym = 20) THEN
+ Get;
+ SimSet(set2);
+ Sets.Unite(set, set2) ;
+ ELSE
+ Get;
+ SimSet(set2);
+ Sets.Differ(set, set2) ;
+ END;
+ END;
+END Set;
+
+PROCEDURE TokenExpr(VAR gL, gR: INTEGER);
+ VAR gL2, gR2: INTEGER; first: BOOLEAN;
+BEGIN
+ TokenTerm(gL, gR);
+ first := TRUE ;
+ WHILE WeakSeparator(26, 1, 5) DO
+ TokenTerm(gL2, gR2);
+ IF first THEN
+ CRT.MakeFirstAlt(gL, gR); first := FALSE
+ END;
+ CRT.ConcatAlt(gL, gR, gL2, gR2) ;
+ END;
+END TokenExpr;
+
+PROCEDURE TokenDecl(typ: INTEGER);
+ VAR sp, kind, gL, gR: INTEGER; sn: CRT.SymbolNode;
+ pos: CRT.Position; name: CRT.Name;
+BEGIN
+ Symbol(name, kind);
+ IF CRT.FindSym(name) # CRT.noSym THEN SemErr(7)
+ ELSE
+ sp := CRT.NewSym(typ, name, CRS.line);
+ CRT.GetSym(sp, sn); sn.struct := CRT.classToken;
+ CRT.PutSym(sp, sn)
+ END ;
+ WHILE ~( StartOf(6) ) DO Error(45); Get END;
+ IF (sym = 8) THEN
+ Get;
+ TokenExpr(gL, gR);
+ Expect(9);
+ IF kind # ident THEN SemErr(13) END;
+ CRT.CompleteGraph(gR);
+ CRA.ConvertToStates(gL, sp) ;
+ ELSIF StartOf(7) THEN
+ IF kind = ident THEN genScanner := FALSE
+ ELSE MatchLiteral(sp)
+ END ;
+ ELSE Error(46)
+ END;
+ IF (sym = 36) THEN
+ SemText(pos);
+ IF typ = CRT.t THEN SemErr(14) END;
+ CRT.GetSym(sp, sn); sn.semPos := pos; CRT.PutSym(sp, sn) ;
+ END;
+END TokenDecl;
+
+PROCEDURE SetDecl;
+ VAR c: INTEGER; set: CRT.Set; name: CRT.Name;
+BEGIN
+ Expect(1);
+ CRS.GetName(CRS.pos, CRS.len, name);
+ c := CRT.ClassWithName(name); IF c >= 0 THEN SemErr(7) END ;
+ Expect(8);
+ Set(set);
+ c := CRT.NewClass(name, set) ;
+ Expect(9);
+END SetDecl;
+
+PROCEDURE Expression(VAR gL, gR: INTEGER);
+ VAR gL2, gR2: INTEGER; first: BOOLEAN;
+BEGIN
+ Term(gL, gR);
+ first := TRUE ;
+ WHILE WeakSeparator(26, 2, 8) DO
+ Term(gL2, gR2);
+ IF first THEN
+ CRT.MakeFirstAlt(gL, gR); first := FALSE
+ END;
+ CRT.ConcatAlt(gL, gR, gL2, gR2) ;
+ END;
+END Expression;
+
+PROCEDURE SemText(VAR semPos: CRT.Position);
+BEGIN
+ Expect(36);
+ semPos.beg := CRS.nextPos; semPos.col := CRS.nextCol ;
+ WHILE StartOf(9) DO
+ Get;
+ END;
+ Expect(37);
+ semPos.len := SHORT(CRS.pos - semPos.beg) ;
+END SemText;
+
+PROCEDURE Attribs(VAR attrPos: CRT.Position);
+BEGIN
+ Expect(34);
+ attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol ;
+ WHILE StartOf(10) DO
+ Get;
+ END;
+ Expect(35);
+ attrPos.len := SHORT(CRS.pos - attrPos.beg) ;
+END Attribs;
+
+PROCEDURE Declaration;
+ VAR gL1, gR1, gL2, gR2: INTEGER; nested: BOOLEAN;
+BEGIN
+ IF (sym = 11) THEN
+ Get;
+ WHILE (sym = 1) DO
+ SetDecl;
+ END;
+ ELSIF (sym = 12) THEN
+ Get;
+ WHILE (sym = 1) OR (sym = 2) DO
+ TokenDecl(CRT.t);
+ END;
+ ELSIF (sym = 13) THEN
+ Get;
+ WHILE (sym = 1) OR (sym = 2) DO
+ TokenDecl(CRT.pr);
+ END;
+ ELSIF (sym = 14) THEN
+ Get;
+ Expect(15);
+ TokenExpr(gL1, gR1);
+ Expect(16);
+ TokenExpr(gL2, gR2);
+ IF (sym = 17) THEN
+ Get;
+ nested := TRUE ;
+ ELSIF StartOf(11) THEN
+ nested := FALSE ;
+ ELSE Error(47)
+ END;
+ CRA.NewComment(gL1, gL2, nested) ;
+ ELSIF (sym = 18) THEN
+ Get;
+ IF (sym = 19) THEN
+ Get;
+ CRT.ignoreCase := TRUE ;
+ ELSIF StartOf(12) THEN
+ Set(CRT.ignored);
+ ELSE Error(48)
+ END;
+ ELSE Error(49)
+ END;
+END Declaration;
+
+PROCEDURE CR;
+ VAR undef, hasAttrs, ok, ok1: BOOLEAN; eofSy, gR: INTEGER;
+ gramLine, sp: INTEGER;
+ gn: CRT.GraphNode; sn: CRT.SymbolNode;
+ name, gramName: CRT.Name;
+BEGIN
+ Expect(4);
+ Texts.OpenWriter(w);
+ CRT.Init; CRX.Init; CRA.Init;
+ gramLine := CRS.line;
+ eofSy := CRT.NewSym(CRT.t, "EOF", 0);
+ genScanner := TRUE;
+ CRT.ignoreCase := FALSE;
+ ok := TRUE;
+ Sets.Clear(CRT.ignored) ;
+ Expect(1);
+ CRS.GetName(CRS.pos, CRS.len, gramName);
+ CRT.semDeclPos.beg := CRS.nextPos; CRT.importPos.beg := -1; ;
+ WHILE StartOf(13) DO
+ IF (sym = 5) THEN
+ Get;
+ CRT.importPos.beg := CRS.nextPos ;
+ WHILE StartOf(14) DO
+ Get;
+ END;
+ Expect(6);
+ CRT.importPos.len := SHORT(CRS.pos - CRT.importPos.beg);
+ CRT.importPos.col := 0;
+ CRT.semDeclPos.beg := CRS.nextPos ;
+ ELSE
+ Get;
+ END;
+ END;
+ CRT.semDeclPos.len := SHORT(CRS.nextPos - CRT.semDeclPos.beg);
+ CRT.semDeclPos.col := 0 ;
+ WHILE StartOf(15) DO
+ Declaration;
+ END;
+ WHILE ~( (sym = 0) OR (sym = 7)) DO Error(50); Get END;
+ Expect(7);
+ IF genScanner THEN CRA.MakeDeterministic(ok) END;
+ CRT.nNodes := 0 ;
+ WHILE (sym = 1) DO
+ Get;
+ CRS.GetName(CRS.pos, CRS.len, name);
+ sp := CRT.FindSym(name); undef := sp = CRT.noSym;
+ IF undef THEN
+ sp := CRT.NewSym(CRT.nt, name, CRS.line);
+ CRT.GetSym(sp, sn);
+ ELSE
+ CRT.GetSym(sp, sn);
+ IF sn.typ = CRT.nt THEN
+ IF sn.struct > 0 THEN SemErr(7) END
+ ELSE SemErr(8)
+ END;
+ sn.line := CRS.line
+ END;
+ hasAttrs := sn.attrPos.beg >= 0 ;
+ IF (sym = 34) THEN
+ Attribs(sn.attrPos);
+ IF ~undef & ~hasAttrs THEN SemErr(9) END;
+ CRT.PutSym(sp, sn) ;
+ ELSIF (sym = 8) OR (sym = 36) THEN
+ IF ~undef & hasAttrs THEN SemErr(10) END ;
+ ELSE Error(51)
+ END;
+ IF (sym = 36) THEN
+ SemText(sn.semPos);
+ END;
+ ExpectWeak(8, 16);
+ Expression(sn.struct, gR);
+ CRT.CompleteGraph(gR); CRT.PutSym(sp, sn);
+ IF CRT.ddt[2] THEN CRT.PrintGraph END ;
+ ExpectWeak(9, 17);
+ END;
+ sp := CRT.FindSym(gramName);
+ IF sp = CRT.noSym THEN SemErr(11);
+ ELSE
+ CRT.GetSym(sp, sn);
+ IF sn.attrPos.beg >= 0 THEN SemErr(12) END;
+ CRT.root := CRT.NewNode(CRT.nt, sp, gramLine);
+ END ;
+ Expect(10);
+ Expect(1);
+ CRS.GetName(CRS.pos, CRS.len, name);
+ IF name # gramName THEN SemErr(17) END;
+ IF CRS.errors = 0 THEN
+ Texts.WriteString(w, " checking"); Texts.Append(Oberon.Log, w.buf);
+ CRT.CompSymbolSets;
+ IF ok THEN CRT.TestCompleteness(ok) END;
+ IF ok THEN
+ CRT.TestIfAllNtReached(ok1); CRT.FindCircularProductions(ok)
+ END;
+ IF ok THEN CRT.TestIfNtToTerm(ok) END;
+ IF ok THEN CRT.LL1Test(ok1) END;
+ IF CRT.ddt[0] THEN CRA.PrintStates END;
+ IF CRT.ddt[7] THEN CRT.XRef END;
+ IF ok THEN
+ Texts.WriteString(w, " +parser");
+ Texts.Append(Oberon.Log, w.buf);
+ CRX.GenCompiler;
+ IF genScanner THEN
+ Texts.WriteString(w, " +scanner");
+ Texts.Append(Oberon.Log, w.buf);
+ CRA.WriteScanner
+ END;
+ IF CRT.ddt[8] THEN CRX.WriteStatistics END
+ END
+ ELSE ok := FALSE
+ END;
+ IF CRT.ddt[6] THEN CRT.PrintSymbolTable END;
+ IF ok THEN Texts.WriteString(w, " done") END;
+ Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf) ;
+ Expect(9);
+END CR;
+
+
+
+PROCEDURE Parse*;
+BEGIN
+ Get;
+ CR;
+
+END Parse;
+
+BEGIN
+ symSet[0, 0] := {0,1,2,7,8,11,12,13,14,18};
+ symSet[0, 1] := {4};
+ symSet[1, 0] := {1,2,23,28,30};
+ symSet[1, 1] := {};
+ symSet[2, 0] := {1,2,9,23,24,25,26,27,28,29,30,31};
+ symSet[2, 1] := {0,4};
+ symSet[3, 0] := {1,2,23,25,27,28,30};
+ symSet[3, 1] := {0,4};
+ symSet[4, 0] := {9,24,26,29,31};
+ symSet[4, 1] := {};
+ symSet[5, 0] := {7,9,11,12,13,14,16,17,18,24,29,31};
+ symSet[5, 1] := {};
+ symSet[6, 0] := {0,1,2,7,8,11,12,13,14,18};
+ symSet[6, 1] := {4};
+ symSet[7, 0] := {1,2,7,11,12,13,14,18};
+ symSet[7, 1] := {4};
+ symSet[8, 0] := {9,24,29,31};
+ symSet[8, 1] := {};
+ symSet[9, 0] := {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[9, 1] := {0,1,2,3,4,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[10, 0] := {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[10, 1] := {0,1,2,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[11, 0] := {7,11,12,13,14,18};
+ symSet[11, 1] := {};
+ symSet[12, 0] := {1,2,22,25};
+ symSet[12, 1] := {};
+ symSet[13, 0] := {1,2,3,4,5,6,8,9,10,15,16,17,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[13, 1] := {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[14, 0] := {1,2,3,4,5,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[14, 1] := {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31};
+ symSet[15, 0] := {11,12,13,14,18};
+ symSet[15, 1] := {};
+ symSet[16, 0] := {0,1,2,7,8,9,11,12,13,14,18,23,25,26,27,28,30};
+ symSet[16, 1] := {0,4};
+ symSet[17, 0] := {0,1,2,7,8,10,11,12,13,14,18};
+ symSet[17, 1] := {4};
+
+END CRP.
+ | 0: Msg("EOF expected")
+ | 1: Msg("ident expected")
+ | 2: Msg("string expected")
+ | 3: Msg("number expected")
+ | 4: Msg("'COMPILER' expected")
+ | 5: Msg("'IMPORT' expected")
+ | 6: Msg("';' expected")
+ | 7: Msg("'PRODUCTIONS' expected")
+ | 8: Msg("'=' expected")
+ | 9: Msg("'.' expected")
+ | 10: Msg("'END' expected")
+ | 11: Msg("'CHARACTERS' expected")
+ | 12: Msg("'TOKENS' expected")
+ | 13: Msg("'PRAGMAS' expected")
+ | 14: Msg("'COMMENTS' expected")
+ | 15: Msg("'FROM' expected")
+ | 16: Msg("'TO' expected")
+ | 17: Msg("'NESTED' expected")
+ | 18: Msg("'IGNORE' expected")
+ | 19: Msg("'CASE' expected")
+ | 20: Msg("'+' expected")
+ | 21: Msg("'-' expected")
+ | 22: Msg("'CHR' expected")
+ | 23: Msg("'(' expected")
+ | 24: Msg("')' expected")
+ | 25: Msg("'ANY' expected")
+ | 26: Msg("'|' expected")
+ | 27: Msg("'WEAK' expected")
+ | 28: Msg("'[' expected")
+ | 29: Msg("']' expected")
+ | 30: Msg("'{' expected")
+ | 31: Msg("'}' expected")
+ | 32: Msg("'SYNC' expected")
+ | 33: Msg("'CONTEXT' expected")
+ | 34: Msg("'<' expected")
+ | 35: Msg("'>' expected")
+ | 36: Msg("'(.' expected")
+ | 37: Msg("'.)' expected")
+ | 38: Msg("??? expected")
+ | 39: Msg("invalid TokenFactor")
+ | 40: Msg("invalid Factor")
+ | 41: Msg("invalid Factor")
+ | 42: Msg("invalid Term")
+ | 43: Msg("invalid Symbol")
+ | 44: Msg("invalid SimSet")
+ | 45: Msg("this symbol not expected in TokenDecl")
+ | 46: Msg("invalid TokenDecl")
+ | 47: Msg("invalid Declaration")
+ | 48: Msg("invalid Declaration")
+ | 49: Msg("invalid Declaration")
+ | 50: Msg("this symbol not expected in CR")
+ | 51: Msg("invalid CR")
diff --git a/tools/Coco/CRS.obn b/tools/Coco/CRS.obn
--- /dev/null
+++ b/tools/Coco/CRS.obn
@@ -0,0 +1,231 @@
+(* scanner module generated by Coco-R *)
+MODULE CRS;
+
+IMPORT Texts, SYSTEM;
+
+CONST
+ EOL = 0DX;
+ EOF = 0X;
+ maxLexLen = 127;
+ noSym = 38;
+
+TYPE
+ ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT);
+ StartTable = ARRAY 128 OF INTEGER;
+
+VAR
+ src*: Texts.Text; (*source text. To be set by the main pgm*)
+ pos*: LONGINT; (*position of current symbol*)
+ line*, col*, len*: INTEGER; (*line, column, length of current symbol*)
+ nextPos*: LONGINT; (*position of lookahead symbol*)
+ nextLine*, nextCol*, nextLen*: INTEGER; (*line, column, length of lookahead symbol*)
+ errors*: INTEGER; (*number of errors detected*)
+ Error*: ErrorProc;
+
+ ch: CHAR; (*current input character*)
+ r: Texts.Reader; (*global reader*)
+ chPos: LONGINT; (*position of current character*)
+ chLine: INTEGER; (*current line number*)
+ lineStart: LONGINT; (*start position of current line*)
+ apx: INTEGER; (*length of appendix*)
+ oldEols: INTEGER; (*nr. of EOLs in a comment*)
+
+ start: StartTable; (*start state for every character*)
+
+
+PROCEDURE NextCh; (*return global variable ch*)
+BEGIN
+ Texts.Read(r, ch); INC(chPos);
+ IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END
+END NextCh;
+
+
+PROCEDURE Comment(): BOOLEAN;
+ VAR level, startLine: INTEGER; oldLineStart: LONGINT;
+BEGIN (*Comment*)
+ level := 1; startLine := chLine; oldLineStart := lineStart;
+ IF (ch ="(") THEN
+ NextCh;
+ IF (ch ="*") THEN
+ NextCh;
+ LOOP
+ IF (ch ="*") THEN
+ NextCh;
+ IF (ch =")") THEN
+ DEC(level); oldEols := chLine - startLine; NextCh;
+ IF level=0 THEN RETURN TRUE END
+ END;
+ ELSIF (ch ="(") THEN
+ NextCh;
+ IF (ch ="*") THEN
+ INC(level); NextCh;
+ END;
+ ELSIF ch = EOF THEN RETURN FALSE
+ ELSE NextCh END;
+ END;
+ ELSE
+ IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;
+ DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE
+ END
+ END;
+END Comment;
+
+
+PROCEDURE Get*(VAR sym: INTEGER);
+VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR;
+
+ PROCEDURE CheckLiteral;
+ BEGIN
+ IF nextLen < maxLexLen THEN lexeme[nextLen] := 0X END;
+ IF (lexeme[0] >= "A") & (lexeme[0] <= "W") THEN
+ CASE lexeme[0] OF
+ | "A": IF lexeme = "ANY" THEN sym := 25
+ END
+ | "C": IF lexeme = "CASE" THEN sym := 19
+ ELSIF lexeme = "CHARACTERS" THEN sym := 11
+ ELSIF lexeme = "CHR" THEN sym := 22
+ ELSIF lexeme = "COMMENTS" THEN sym := 14
+ ELSIF lexeme = "COMPILER" THEN sym := 4
+ ELSIF lexeme = "CONTEXT" THEN sym := 33
+ END
+ | "E": IF lexeme = "END" THEN sym := 10
+ END
+ | "F": IF lexeme = "FROM" THEN sym := 15
+ END
+ | "I": IF lexeme = "IGNORE" THEN sym := 18
+ ELSIF lexeme = "IMPORT" THEN sym := 5
+ END
+ | "N": IF lexeme = "NESTED" THEN sym := 17
+ END
+ | "P": IF lexeme = "PRAGMAS" THEN sym := 13
+ ELSIF lexeme = "PRODUCTIONS" THEN sym := 7
+ END
+ | "S": IF lexeme = "SYNC" THEN sym := 32
+ END
+ | "T": IF lexeme = "TO" THEN sym := 16
+ ELSIF lexeme = "TOKENS" THEN sym := 12
+ END
+ | "W": IF lexeme = "WEAK" THEN sym := 27
+ END
+ ELSE
+ END
+ END;
+
+ END CheckLiteral;
+
+BEGIN
+ WHILE (ch=20X) OR (ch=CHR(9)) OR (ch=CHR(13)) OR (ch=CHR(28)) DO NextCh END;
+ IF ((ch ="(")) & Comment() THEN Get(sym); RETURN END;
+ IF ch > 7FX THEN ch := " " END;
+ pos := nextPos; col := nextCol; line := nextLine; len := nextLen;
+ nextPos := chPos; nextCol := SHORT(chPos - lineStart); nextLine := chLine; nextLen := 0;
+ state := start[ORD(ch)]; apx := 0;
+ LOOP
+ IF nextLen < maxLexLen THEN lexeme[nextLen] := ch END;
+ INC(nextLen);
+ NextCh;
+ IF state > 0 THEN
+ CASE state OF
+ | 1: IF (ch>="0") & (ch<="9") OR (ch>="A") & (ch<="Z") OR (ch>="a") & (ch<="z") THEN
+ ELSE sym := 1; CheckLiteral; RETURN
+ END;
+ | 2: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="!") OR (ch>="#") THEN
+ ELSIF (ch =CHR(34)) THEN state := 3;
+ ELSE sym := noSym; RETURN
+ END;
+ | 3: sym := 2; RETURN
+ | 4: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="&") OR (ch>="(") THEN
+ ELSIF (ch ="'") THEN state := 3;
+ ELSE sym := noSym; RETURN
+ END;
+ | 5: IF (ch>="0") & (ch<="9") THEN
+ ELSE sym := 3; RETURN
+ END;
+ | 6: IF (ch>="0") & (ch<="9") THEN
+ ELSE sym := 39; RETURN
+ END;
+ | 7: sym := 6; RETURN
+ | 8: sym := 8; RETURN
+ | 9: IF (ch =")") THEN state := 22;
+ ELSE sym := 9; RETURN
+ END;
+ | 10: sym := 20; RETURN
+ | 11: sym := 21; RETURN
+ | 12: IF (ch =".") THEN state := 21;
+ ELSE sym := 23; RETURN
+ END;
+ | 13: sym := 24; RETURN
+ | 14: sym := 26; RETURN
+ | 15: sym := 28; RETURN
+ | 16: sym := 29; RETURN
+ | 17: sym := 30; RETURN
+ | 18: sym := 31; RETURN
+ | 19: sym := 34; RETURN
+ | 20: sym := 35; RETURN
+ | 21: sym := 36; RETURN
+ | 22: sym := 37; RETURN
+ | 23: sym := 0; ch := 0X; RETURN
+
+ END (*CASE*)
+ ELSE sym := noSym; RETURN (*NextCh already done*)
+ END (*IF*)
+ END (*LOOP*)
+END Get;
+
+
+PROCEDURE GetName*(pos: LONGINT; len: INTEGER; VAR s: ARRAY OF CHAR);
+ VAR i: INTEGER; r: Texts.Reader;
+BEGIN
+ Texts.OpenReader(r, src, pos);
+ IF len >= LEN(s) THEN len := SHORT(LEN(s)) - 1 END;
+ i := 0; WHILE i < len DO Texts.Read(r, s[i]); INC(i) END;
+ s[i] := 0X
+END GetName;
+
+PROCEDURE StdErrorProc* (n: INTEGER; pos: LONGINT);
+BEGIN INC(errors) END StdErrorProc;
+
+PROCEDURE Reset* (t: Texts.Text; pos: LONGINT; errProc: ErrorProc);
+BEGIN
+ src := t; Error := errProc;
+ Texts.OpenReader(r, src, pos);
+ chPos := pos - 1; chLine := 1; lineStart := 0;
+ oldEols := 0; apx := 0; errors := 0;
+ NextCh
+END Reset;
+
+BEGIN
+ start[0]:=23; start[1]:=0; start[2]:=0; start[3]:=0;
+ start[4]:=0; start[5]:=0; start[6]:=0; start[7]:=0;
+ start[8]:=0; start[9]:=0; start[10]:=0; start[11]:=0;
+ start[12]:=0; start[13]:=0; start[14]:=0; start[15]:=0;
+ start[16]:=0; start[17]:=0; start[18]:=0; start[19]:=0;
+ start[20]:=0; start[21]:=0; start[22]:=0; start[23]:=0;
+ start[24]:=0; start[25]:=0; start[26]:=0; start[27]:=0;
+ start[28]:=0; start[29]:=0; start[30]:=0; start[31]:=0;
+ start[32]:=0; start[33]:=0; start[34]:=2; start[35]:=0;
+ start[36]:=6; start[37]:=0; start[38]:=0; start[39]:=4;
+ start[40]:=12; start[41]:=13; start[42]:=0; start[43]:=10;
+ start[44]:=0; start[45]:=11; start[46]:=9; start[47]:=0;
+ start[48]:=5; start[49]:=5; start[50]:=5; start[51]:=5;
+ start[52]:=5; start[53]:=5; start[54]:=5; start[55]:=5;
+ start[56]:=5; start[57]:=5; start[58]:=0; start[59]:=7;
+ start[60]:=19; start[61]:=8; start[62]:=20; start[63]:=0;
+ start[64]:=0; start[65]:=1; start[66]:=1; start[67]:=1;
+ start[68]:=1; start[69]:=1; start[70]:=1; start[71]:=1;
+ start[72]:=1; start[73]:=1; start[74]:=1; start[75]:=1;
+ start[76]:=1; start[77]:=1; start[78]:=1; start[79]:=1;
+ start[80]:=1; start[81]:=1; start[82]:=1; start[83]:=1;
+ start[84]:=1; start[85]:=1; start[86]:=1; start[87]:=1;
+ start[88]:=1; start[89]:=1; start[90]:=1; start[91]:=15;
+ start[92]:=0; start[93]:=16; start[94]:=0; start[95]:=0;
+ start[96]:=0; start[97]:=1; start[98]:=1; start[99]:=1;
+ start[100]:=1; start[101]:=1; start[102]:=1; start[103]:=1;
+ start[104]:=1; start[105]:=1; start[106]:=1; start[107]:=1;
+ start[108]:=1; start[109]:=1; start[110]:=1; start[111]:=1;
+ start[112]:=1; start[113]:=1; start[114]:=1; start[115]:=1;
+ start[116]:=1; start[117]:=1; start[118]:=1; start[119]:=1;
+ start[120]:=1; start[121]:=1; start[122]:=1; start[123]:=17;
+ start[124]:=14; start[125]:=18; start[126]:=0; start[127]:=0;
+
+END CRS.
\ No newline at end of file
diff --git a/tools/Coco/CRT.obn b/tools/Coco/CRT.obn
--- /dev/null
+++ b/tools/Coco/CRT.obn
@@ -0,0 +1,994 @@
+MODULE CRT; (* H.Moessenboeck 17.11.93, Cocol-R Tables *)
+
+IMPORT Texts, Oberon, Sets;
+
+CONST
+ maxSymbols* = 300; (*max nr of t, nt, and pragmas*)
+ maxTerminals* = 256; (*max nr of terminals*)
+ maxNt* = 128; (*max nr of nonterminals*)
+ maxNodes* = 1500; (*max nr of graph nodes*)
+ normTrans* = 0; contextTrans* = 1; (*transition codes*)
+ maxSetNr = 128; (* max. number of symbol sets *)
+ maxClasses = 50; (* max. number of character classes *)
+
+ (* node types *)
+ t* = 1; pr* = 2; nt* = 3; class* = 4; char* = 5; wt* = 6; any* = 7; eps* = 8; sync* = 9; sem* = 10;
+ alt* = 11; iter* = 12; opt* = 13;
+
+ noSym* = -1;
+ eofSy* = 0;
+
+ (* token kinds *)
+ classToken* = 0; (*token class*)
+ litToken* = 1; (*literal (e.g. keyword) not recognized by DFA*)
+ classLitToken* = 2; (*token class that can also match a literal*)
+
+TYPE
+ Name* = ARRAY 16 OF CHAR; (*symbol name*)
+ Position* = RECORD (*position of stretch of source text*)
+ beg*: LONGINT; (*start relative to beginning of file*)
+ len*: INTEGER; (*length*)
+ col*: INTEGER; (*column number of start position*)
+ END;
+
+ SymbolNode* = RECORD
+ typ*: INTEGER; (*nt, t, pr, unknown*)
+ name*: Name; (*symbol name*)
+ struct*: INTEGER; (*typ = nt: index of 1st node of syntax graph*)
+ (*typ = t: token kind: literal, class, ...*)
+ deletable*: BOOLEAN; (*typ = nt: TRUE, if nonterminal is deletable*)
+ attrPos*: Position; (*position of attributes in source text*)
+ semPos*: Position; (*typ = pr: pos of sem action in source text*)
+ (*typ = nt: pos of local decls in source text *)
+ line*: INTEGER; (*source text line number of item in this node*)
+ END;
+
+ Set* = ARRAY maxTerminals DIV Sets.size OF SET;
+
+ GraphNode* = RECORD
+ typ* : INTEGER; (* nt,sts,wts,char,class,any,eps,sem,sync,alt,iter,opt*)
+ next*: INTEGER; (* index of successor node *)
+ (* next < 0: to successor in enclosing structure *)
+ p1*: INTEGER; (* typ IN {nt, t, wt}: index to symbol list *)
+ (* typ = any: index to anyset *)
+ (* typ = sync: index to syncset *)
+ (* typ = alt: index of 1st node of 1st alternative*)
+ (* typ IN {iter, opt}: 1st node in subexpression *)
+ (* typ = char: ordinal character value *)
+ (* typ = class: index of character class *)
+ p2*: INTEGER; (* typ = alt: index of 1st node of 2nd alternative*)
+ (* typ IN {char, class}: transition code *)
+ pos*: Position; (* typ IN {nt, t, wt}: pos of actual attribs *)
+ (* typ = sem: pos of sem action in source text. *)
+ line*: INTEGER; (* source text line number of item in this node *)
+ END;
+
+ MarkList* = ARRAY maxNodes DIV Sets.size OF SET;
+
+ FirstSets = ARRAY maxNt OF RECORD
+ ts: Set; (*terminal symbols*)
+ ready: BOOLEAN; (*TRUE = ts is complete*)
+ END;
+ FollowSets = ARRAY maxNt OF RECORD
+ ts: Set; (*terminal symbols*)
+ nts: Set; (*nts whose start set is to be included*)
+ END;
+ CharClass = RECORD
+ name: Name; (*class name*)
+ set: INTEGER (* ptr to set representing the class*)
+ END;
+ SymbolTable = ARRAY maxSymbols OF SymbolNode;
+ ClassTable = ARRAY maxClasses OF CharClass;
+ GraphList = ARRAY maxNodes OF GraphNode;
+
+VAR
+ maxSet*: INTEGER; (* index of last set *)
+ maxT*: INTEGER; (* terminals stored from 0 .. maxT *)
+ maxP*: INTEGER; (* pragmas stored from maxT+1 .. maxP *)
+ firstNt*: INTEGER; (* index of first nt: available after CompSymbolSets *)
+ lastNt*: INTEGER; (* index of last nt: available after CompSymbolSets *)
+ maxC*: INTEGER; (* index of last character class *)
+ semDeclPos*: Position; (*position of global semantic declarations*)
+ importPos*: Position; (*position of imported identifiers*)
+ ignored*: Set; (* characters ignored by the scanner *)
+ ignoreCase*: BOOLEAN; (* TRUE: scanner treats lower case as upper case*)
+ ddt*: ARRAY 10 OF BOOLEAN; (* debug and test switches *)
+ nNodes*: INTEGER; (* index of last graph node *)
+ root*: INTEGER; (* index of root node, filled by ATG *)
+
+ w: Texts.Writer;
+ st: SymbolTable;
+ gn: GraphList;
+ first: FirstSets; (*first[i] = first symbols of st[i+firstNt]*)
+ follow: FollowSets; (*follow[i] = followers of st[i+firstNt]*)
+ chClass: ClassTable; (*character classes*)
+ set: ARRAY 128 OF Set; (*set[0] reserved for union of all synchronisation sets*)
+ dummyName: INTEGER; (*for unnamed character classes*)
+
+PROCEDURE ^MovePragmas;
+PROCEDURE ^DelNode*(gn: GraphNode): BOOLEAN;
+
+PROCEDURE Str(s: ARRAY OF CHAR);
+BEGIN Texts.WriteString(w, s)
+END Str;
+
+PROCEDURE NL;
+BEGIN Texts.WriteLn(w)
+END NL;
+
+PROCEDURE Length(s: ARRAY OF CHAR): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
+ RETURN i
+END Length;
+
+PROCEDURE Restriction(n: INTEGER);
+BEGIN
+ NL; Str("Restriction "); Texts.WriteInt(w, n, 0); NL; Texts.Append(Oberon.Log, w.buf);
+ HALT(99)
+END Restriction;
+
+PROCEDURE ClearMarkList(VAR m: MarkList);
+ VAR i: INTEGER;
+BEGIN
+ i := 0; WHILE i < maxNodes DIV Sets.size DO m[i] := {}; INC(i) END;
+END ClearMarkList;
+
+PROCEDURE GetNode*(gp: INTEGER; VAR n: GraphNode);
+BEGIN
+ n := gn[gp]
+END GetNode;
+
+PROCEDURE PutNode*(gp: INTEGER; n: GraphNode);
+BEGIN gn[gp] := n
+END PutNode;
+
+PROCEDURE DelGraph*(gp: INTEGER): BOOLEAN;
+ VAR gn: GraphNode;
+BEGIN
+ IF gp = 0 THEN RETURN TRUE END; (*end of graph found*)
+ GetNode(gp, gn);
+ RETURN DelNode(gn) & DelGraph(ABS(gn.next));
+END DelGraph;
+
+PROCEDURE NewSym*(typ: INTEGER; name: Name; line: INTEGER): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ IF maxT + 1 = firstNt THEN Restriction(6)
+ ELSE
+ CASE typ OF
+ | t: INC(maxT); i := maxT
+ | pr: DEC(maxP); DEC(firstNt); DEC(lastNt); i := maxP
+ | nt: DEC(firstNt); i := firstNt
+ END;
+ IF maxT >= maxTerminals THEN Restriction(6) END;
+ st[i].typ := typ; st[i].name := name;
+ st[i].struct := 0; st[i].deletable := FALSE;
+ st[i].attrPos.beg := -1;
+ st[i].semPos.beg := -1;
+ st[i].line := line
+ END;
+ RETURN i
+END NewSym;
+
+PROCEDURE GetSym*(sp: INTEGER; VAR sn: SymbolNode);
+BEGIN sn := st[sp]
+END GetSym;
+
+PROCEDURE PutSym*(sp: INTEGER; sn: SymbolNode);
+BEGIN st[sp] := sn
+END PutSym;
+
+PROCEDURE FindSym*(name: Name): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i := 0; (*search in terminal list*)
+ WHILE (i <= maxT) & (st[i].name # name) DO INC(i) END;
+ IF i <= maxT THEN RETURN i END;
+ i := firstNt; (*search in nonterminal/pragma list*)
+ WHILE (i < maxSymbols) & (st[i].name # name) DO INC(i) END;
+ IF i < maxSymbols THEN RETURN i ELSE RETURN noSym END
+END FindSym;
+
+PROCEDURE NewSet*(s: Set): INTEGER;
+BEGIN
+ INC(maxSet); IF maxSet > maxSetNr THEN Restriction(4) END;
+ set[maxSet] := s;
+ RETURN maxSet
+END NewSet;
+
+PROCEDURE PrintSet(s: ARRAY OF SET; indent: INTEGER);
+ CONST maxLineLen = 80;
+ VAR col, i, len: INTEGER; empty: BOOLEAN; sn: SymbolNode;
+BEGIN
+ i := 0; col := indent; empty := TRUE;
+ WHILE i <= maxT DO
+ IF Sets.In(s, i) THEN
+ empty := FALSE; GetSym(i, sn); len := Length(sn.name);
+ IF col + len + 2 > maxLineLen THEN
+ NL; col := 1;
+ WHILE col < indent DO Texts.Write(w, " "); INC(col) END
+ END;
+ Str(sn.name); Str(" ");
+ INC(col, len + 2)
+ END;
+ INC(i)
+ END;
+ IF empty THEN Str("-- empty set --") END;
+ NL; Texts.Append(Oberon.Log, w.buf)
+END PrintSet;
+
+PROCEDURE CompFirstSet*(gp: INTEGER; VAR fs: Set);
+ VAR visited: MarkList;
+
+ PROCEDURE CompFirst(gp: INTEGER; VAR fs: Set);
+ VAR s: Set; gn: GraphNode; sn: SymbolNode;
+ BEGIN
+ Sets.Clear(fs);
+ WHILE (gp # 0) & ~ Sets.In(visited, gp) DO
+ GetNode(gp, gn); Sets.Incl(visited, gp);
+ CASE gn.typ OF
+ | nt:
+ IF first[gn.p1 - firstNt].ready THEN
+ Sets.Unite(fs, first[gn.p1 - firstNt].ts);
+ ELSE
+ GetSym(gn.p1, sn); CompFirst(sn.struct, s); Sets.Unite(fs, s);
+ END;
+ | t, wt: Sets.Incl(fs, gn.p1);
+ | any: Sets.Unite(fs, set[gn.p1])
+ | alt, iter, opt:
+ CompFirst(gn.p1, s); Sets.Unite(fs, s);
+ IF gn.typ = alt THEN CompFirst(gn.p2, s); Sets.Unite(fs, s) END
+ ELSE (* eps, sem, sync: nothing *)
+ END;
+ IF ~ DelNode(gn) THEN RETURN END;
+ gp := ABS(gn.next)
+ END
+ END CompFirst;
+
+BEGIN (* ComputeFirstSet *)
+ ClearMarkList(visited);
+ CompFirst(gp, fs);
+ IF ddt[3] THEN
+ NL; Str("ComputeFirstSet: gp = "); Texts.WriteInt(w, gp, 0); NL;
+ PrintSet(fs, 0);
+ END;
+END CompFirstSet;
+
+PROCEDURE CompFirstSets;
+ VAR i: INTEGER; sn: SymbolNode;
+BEGIN
+ i := firstNt; WHILE i <= lastNt DO first[i-firstNt].ready := FALSE; INC(i) END;
+ i := firstNt;
+ WHILE i <= lastNt DO (* for all nonterminals *)
+ GetSym(i, sn); CompFirstSet(sn.struct, first[i - firstNt].ts);
+ first[i - firstNt].ready := TRUE;
+ INC(i)
+ END;
+END CompFirstSets;
+
+PROCEDURE CompExpected*(gp, sp: INTEGER; VAR exp: Set);
+BEGIN
+ CompFirstSet(gp, exp);
+ IF DelGraph(gp) THEN Sets.Unite(exp, follow[sp - firstNt].ts) END
+END CompExpected;
+
+PROCEDURE CompFollowSets;
+ VAR sn: SymbolNode; gn: GraphNode; curSy, i, size: INTEGER; visited: MarkList;
+
+ PROCEDURE CompFol(gp: INTEGER);
+ VAR s: Set; gn: GraphNode;
+ BEGIN
+ WHILE (gp > 0) & ~ Sets.In(visited, gp) DO
+ GetNode(gp, gn); Sets.Incl(visited, gp);
+ IF gn.typ = nt THEN
+ CompFirstSet(ABS(gn.next), s); Sets.Unite(follow[gn.p1 - firstNt].ts, s);
+ IF DelGraph(ABS(gn.next)) THEN
+ Sets.Incl(follow[gn.p1 - firstNt].nts, curSy - firstNt)
+ END
+ ELSIF gn.typ IN {opt, iter} THEN CompFol(gn.p1)
+ ELSIF gn.typ = alt THEN CompFol(gn.p1); CompFol(gn.p2)
+ END;
+ gp := gn.next
+ END
+ END CompFol;
+
+ PROCEDURE Complete(i: INTEGER);
+ VAR j: INTEGER;
+ BEGIN
+ IF Sets.In(visited, i) THEN RETURN END;
+ Sets.Incl(visited, i);
+ j := 0;
+ WHILE j <= lastNt - firstNt DO (* for all nonterminals *)
+ IF Sets.In(follow[i].nts, j) THEN
+ Complete(j); Sets.Unite(follow[i].ts, follow[j].ts);
+ Sets.Excl(follow[i].nts, j)
+ END;
+ INC(j)
+ END;
+ END Complete;
+
+BEGIN (* CompFollowSets *)
+ curSy := firstNt; size := (lastNt - firstNt + 2) DIV Sets.size;
+ WHILE curSy <= lastNt + 1 DO (* also for dummy root nt*)
+ Sets.Clear(follow[curSy - firstNt].ts);
+ i := 0; WHILE i <= size DO follow[curSy - firstNt].nts[i] := {}; INC(i) END;
+ INC(curSy)
+ END;
+
+ curSy := firstNt; (*get direct successors of nonterminals*)
+ WHILE curSy <= lastNt DO
+ GetSym(curSy, sn); ClearMarkList(visited); CompFol(sn.struct);
+ INC(curSy)
+ END;
+ CompFol(root); (*curSy=lastNt+1*)
+
+ curSy := 0; (*add indirect successors to follow.ts*)
+ WHILE curSy <= lastNt - firstNt DO
+ ClearMarkList(visited); Complete(curSy);
+ INC(curSy);
+ END;
+END CompFollowSets;
+
+
+PROCEDURE CompAnySets;
+ VAR curSy, i: INTEGER; sn: SymbolNode;
+
+ PROCEDURE LeadingAny(gp: INTEGER; VAR a: GraphNode): BOOLEAN;
+ VAR gn: GraphNode;
+ BEGIN
+ IF gp <= 0 THEN RETURN FALSE END;
+ GetNode(gp, gn);
+ IF (gn.typ = any) THEN a := gn; RETURN TRUE
+ ELSE RETURN (gn.typ = alt) & (LeadingAny(gn.p1, a) OR LeadingAny(gn.p2, a))
+ OR (gn.typ IN {opt, iter}) & LeadingAny(gn.p1, a)
+ OR DelNode(gn) & LeadingAny(gn.next, a)
+ END
+ END LeadingAny;
+
+ PROCEDURE FindAS(gp: INTEGER);
+ VAR gn, gn2, a: GraphNode; s1, s2: Set; p: INTEGER;
+ BEGIN
+ WHILE gp > 0 DO
+ GetNode(gp, gn);
+ IF gn.typ IN {opt, iter} THEN
+ FindAS(gn.p1);
+ IF LeadingAny(gn.p1, a) THEN
+ CompFirstSet(ABS(gn.next), s1); Sets.Differ(set[a.p1], s1)
+ END
+ ELSIF gn.typ = alt THEN
+ p := gp; Sets.Clear(s1);
+ WHILE p # 0 DO
+ GetNode(p, gn2); FindAS(gn2.p1);
+ IF LeadingAny(gn2.p1, a) THEN
+ CompFirstSet(gn2.p2, s2); Sets.Unite(s2, s1); Sets.Differ(set[a.p1], s2)
+ ELSE
+ CompFirstSet(gn2.p1, s2); Sets.Unite(s1, s2)
+ END;
+ p := gn2.p2
+ END
+ END;
+ gp := gn.next
+ END
+ END FindAS;
+
+BEGIN
+ curSy := firstNt;
+ WHILE curSy <= lastNt DO (* for all nonterminals *)
+ GetSym(curSy, sn); FindAS(sn.struct);
+ INC(curSy)
+ END
+END CompAnySets;
+
+
+PROCEDURE CompSyncSets;
+ VAR curSy, i: INTEGER; sn: SymbolNode; visited: MarkList;
+
+ PROCEDURE CompSync(gp: INTEGER);
+ VAR s: Set; gn: GraphNode;
+ BEGIN
+ WHILE (gp > 0) & ~ Sets.In(visited, gp) DO
+ GetNode(gp, gn); Sets.Incl(visited, gp);
+ IF gn.typ = sync THEN
+ CompExpected(ABS(gn.next), curSy, s);
+ Sets.Incl(s, eofSy); Sets.Unite(set[0], s);
+ gn.p1 := NewSet(s); PutNode(gp, gn)
+ ELSIF gn.typ = alt THEN CompSync(gn.p1); CompSync(gn.p2)
+ ELSIF gn.typ IN {iter, opt} THEN CompSync(gn.p1)
+ END;
+ gp := gn.next
+ END
+ END CompSync;
+
+BEGIN
+ curSy := firstNt; ClearMarkList(visited);
+ WHILE curSy <= lastNt DO
+ GetSym(curSy, sn); CompSync(sn.struct);
+ INC(curSy);
+ END
+END CompSyncSets;
+
+
+PROCEDURE CompDeletableSymbols*;
+ VAR changed, del: BOOLEAN; i: INTEGER; sn: SymbolNode;
+BEGIN
+ del := FALSE;
+ REPEAT
+ changed := FALSE;
+ i := firstNt;
+ WHILE i <= lastNt DO (*for all nonterminals*)
+ GetSym(i, sn);
+ IF ~sn.deletable & DelGraph(sn.struct) THEN
+ sn.deletable := TRUE; PutSym(i, sn); changed := TRUE; del := TRUE
+ END;
+ INC(i)
+ END;
+ UNTIL ~changed;
+
+ i := firstNt; IF del THEN NL END;
+ WHILE i <= lastNt DO
+ GetSym(i, sn);
+ IF sn.deletable THEN Str(" "); Str(sn.name); Str(" deletable"); NL END;
+ INC(i);
+ END;
+ Texts.Append(Oberon.Log, w.buf)
+END CompDeletableSymbols;
+
+
+PROCEDURE CompSymbolSets*;
+ VAR i: INTEGER; sn: SymbolNode;
+BEGIN
+ i := NewSym(t, "???", 0); (*unknown symbols get code maxT*)
+ MovePragmas;
+ CompDeletableSymbols;
+ CompFirstSets;
+ CompFollowSets;
+ CompAnySets;
+ CompSyncSets;
+ IF ddt[1] THEN
+ i := firstNt; Str("First & follow symbols:"); NL;
+ WHILE i <= lastNt DO (* for all nonterminals *)
+ GetSym(i, sn); Str(sn.name); NL;
+ Str("first: "); PrintSet(first[i - firstNt].ts, 10);
+ Str("follow: "); PrintSet(follow[i - firstNt].ts, 10);
+ NL;
+ INC(i);
+ END;
+
+ IF maxSet >= 0 THEN NL; NL; Str("List of sets (ANY, SYNC): "); NL END;
+ i := 0;
+ WHILE i <= maxSet DO
+ Str(" set["); Texts.WriteInt (w, i, 2); Str("] = "); PrintSet(set[i], 16);
+ INC (i)
+ END;
+ NL; NL; Texts.Append(Oberon.Log, w.buf)
+ END;
+END CompSymbolSets;
+
+
+PROCEDURE GetFirstSet(sp: INTEGER; VAR s: Set);
+BEGIN s := first[sp - firstNt].ts
+END GetFirstSet;
+
+PROCEDURE GetFollowSet(sp: INTEGER; VAR s: Set);
+BEGIN s := follow[sp - firstNt].ts
+END GetFollowSet;
+
+PROCEDURE GetSet*(nr: INTEGER; VAR s: Set);
+BEGIN s := set[nr]
+END GetSet;
+
+PROCEDURE MovePragmas;
+ VAR i: INTEGER;
+BEGIN
+ IF maxP > firstNt THEN
+ i := maxSymbols - 1; maxP := maxT;
+ WHILE i > lastNt DO
+ INC(maxP); IF maxP >= firstNt THEN Restriction(6) END;
+ st[maxP] := st[i]; DEC(i)
+ END;
+ END
+END MovePragmas;
+
+PROCEDURE PrintSymbolTable*;
+ VAR i, j: INTEGER;
+
+ PROCEDURE WriteTyp(typ: INTEGER);
+ BEGIN
+ CASE typ OF
+ | t : Str(" t ");
+ | pr : Str(" pr ");
+ | nt : Str(" nt ");
+ END;
+ END WriteTyp;
+
+BEGIN (* PrintSymbolTable *)
+ Str("Symbol Table:"); NL; NL;
+ Str("nr name typ hasAttribs struct del line"); NL; NL;
+
+ i := 0;
+ WHILE i < maxSymbols DO
+ Texts.WriteInt(w, i, 3); Str(" ");
+ j := 0; WHILE (j < 8) & (st[i].name[j] # 0X) DO Texts.Write(w, st[i].name[j]); INC(j) END;
+ WHILE j < 8 DO Texts.Write(w, " "); INC(j) END;
+ WriteTyp(st[i].typ);
+ IF st[i].attrPos.beg >= 0 THEN Str(" TRUE ") ELSE Str(" FALSE") END;
+ Texts.WriteInt(w, st[i].struct, 10);
+ IF st[i].deletable THEN Str(" TRUE ") ELSE Str(" FALSE") END;
+ Texts.WriteInt(w, st[i].line, 6); NL;
+ IF i = maxT THEN i := firstNt ELSE INC(i) END
+ END;
+ NL; NL; Texts.Append(Oberon.Log, w.buf)
+END PrintSymbolTable;
+
+PROCEDURE NewClass*(name: Name; set: Set): INTEGER;
+BEGIN
+ INC(maxC); IF maxC >= maxClasses THEN Restriction(7) END;
+ IF name[0] = "#" THEN name[1] := CHR(ORD("A") + dummyName); INC(dummyName) END;
+ chClass[maxC].name := name; chClass[maxC].set := NewSet(set);
+ RETURN maxC
+END NewClass;
+
+PROCEDURE ClassWithName*(name: Name): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i := maxC; WHILE (i >= 0) & (chClass[i].name # name) DO DEC(i) END;
+ RETURN i
+END ClassWithName;
+
+PROCEDURE ClassWithSet*(s: Set): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i := maxC; WHILE (i >= 0) & ~ Sets.Equal(set[chClass[i].set], s) DO DEC(i) END;
+ RETURN i
+END ClassWithSet;
+
+PROCEDURE GetClass*(n: INTEGER; VAR s: Set);
+BEGIN
+ GetSet(chClass[n].set, s)
+END GetClass;
+
+PROCEDURE GetClassName*(n: INTEGER; VAR name: Name);
+BEGIN
+ name := chClass[n].name
+END GetClassName;
+
+PROCEDURE XRef*;
+ CONST maxLineLen = 80;
+ TYPE ListPtr = POINTER TO ListNode;
+ ListNode = RECORD
+ next: ListPtr;
+ line: INTEGER;
+ END;
+ ListHdr = RECORD
+ name: Name;
+ lptr: ListPtr;
+ END;
+ VAR gn: GraphNode; col, i, j: INTEGER; l, p, q: ListPtr;
+ sn: SymbolNode;
+ xList: ARRAY maxSymbols OF ListHdr;
+
+BEGIN (* XRef *)
+ IF maxT <= 0 THEN RETURN END;
+ MovePragmas;
+ (* initialise cross reference list *)
+ i := 0;
+ WHILE i <= lastNt DO (* for all symbols *)
+ GetSym(i, sn); xList[i].name := sn.name; xList[i].lptr := NIL;
+ IF i = maxP THEN i := firstNt ELSE INC(i) END
+ END;
+
+ (* search lines where symbol has been referenced *)
+ i := 1;
+ WHILE i <= nNodes DO (* for all graph nodes *)
+ GetNode(i, gn);
+ IF gn.typ IN {t, wt, nt} THEN
+ NEW(l); l^.next := xList[gn.p1].lptr; l^.line := gn.line;
+ xList[gn.p1].lptr := l
+ END;
+ INC(i);
+ END;
+
+ (* search lines where symbol has been defined and insert in order *)
+ i := 1;
+ WHILE i <= lastNt DO (*for all symbols*)
+ GetSym(i, sn); p := xList[i].lptr; q := NIL;
+ WHILE (p # NIL) & (p^.line > sn.line) DO q := p; p := p^.next END;
+ NEW(l); l^.next := p;
+ l^.line := -sn.line;
+ IF q # NIL THEN q^.next := l ELSE xList[i].lptr := l END;
+ IF i = maxP THEN i := firstNt ELSE INC(i) END
+ END;
+
+ (* print cross reference listing *)
+ NL; Str("Cross reference list:"); NL; NL; Str("Terminals:"); NL; Str(" 0 EOF"); NL;
+ i := 1;
+ WHILE i <= lastNt DO (*for all symbols*)
+ Texts.WriteInt(w, i, 3); Str(" ");
+ j := 0; WHILE (j < 15) & (xList[i].name[j] # 0X) DO Texts.Write(w, xList[i].name[j]); INC(j) END;
+ l := xList[i].lptr; col := 25;
+ WHILE l # NIL DO
+ IF col + 5 > maxLineLen THEN
+ NL; col := 0; WHILE col < 25 DO Texts.Write(w, " "); INC(col) END
+ END;
+ IF l^.line = 0 THEN Str("undef") ELSE Texts.WriteInt(w, l^.line, 5) END;
+ INC(col, 5);
+ l := l^.next
+ END;
+ NL;
+ IF i = maxT THEN NL; Str("Pragmas:"); NL END;
+ IF i = maxP THEN NL; Str("Nonterminals:"); NL; i := firstNt ELSE INC(i) END
+ END;
+ NL; NL; Texts.Append(Oberon.Log, w.buf)
+END XRef;
+
+
+PROCEDURE NewNode*(typ, p1, line: INTEGER): INTEGER;
+BEGIN
+ INC(nNodes); IF nNodes > maxNodes THEN Restriction(3) END;
+ gn[nNodes].typ := typ; gn[nNodes].next := 0;
+ gn[nNodes].p1 := p1; gn[nNodes].p2 := 0;
+ gn[nNodes].pos.beg := -1; gn[nNodes].line := line;
+ RETURN nNodes;
+END NewNode;
+
+PROCEDURE CompleteGraph*(gp: INTEGER);
+ VAR p: INTEGER;
+BEGIN
+ WHILE gp # 0 DO
+ p := gn[gp].next; gn[gp].next := 0; gp := p
+ END
+END CompleteGraph;
+
+PROCEDURE ConcatAlt*(VAR gL1, gR1: INTEGER; gL2, gR2: INTEGER);
+ VAR p: INTEGER;
+BEGIN
+ gL2 := NewNode(alt, gL2, 0);
+ p := gL1; WHILE gn[p].p2 # 0 DO p := gn[p].p2 END; gn[p].p2 := gL2;
+ p := gR1; WHILE gn[p].next # 0 DO p := gn[p].next END; gn[p].next := gR2
+END ConcatAlt;
+
+PROCEDURE ConcatSeq*(VAR gL1, gR1: INTEGER; gL2, gR2: INTEGER);
+ VAR p, q: INTEGER;
+BEGIN
+ p := gn[gR1].next; gn[gR1].next := gL2; (*head node*)
+ WHILE p # 0 DO (*substructure*)
+ q := gn[p].next; gn[p].next := -gL2; p := q
+ END;
+ gR1 := gR2
+END ConcatSeq;
+
+PROCEDURE MakeFirstAlt*(VAR gL, gR: INTEGER);
+BEGIN
+ gL := NewNode(alt, gL, 0); gn[gL].next := gR; gR := gL
+END MakeFirstAlt;
+
+PROCEDURE MakeIteration*(VAR gL, gR: INTEGER);
+ VAR p, q: INTEGER;
+BEGIN
+ gL := NewNode(iter, gL, 0); p := gR; gR := gL;
+ WHILE p # 0 DO
+ q := gn[p].next; gn[p].next := - gL; p := q
+ END
+END MakeIteration;
+
+PROCEDURE MakeOption*(VAR gL, gR: INTEGER);
+BEGIN
+ gL := NewNode(opt, gL, 0); gn[gL].next := gR; gR := gL
+END MakeOption;
+
+PROCEDURE StrToGraph*(str: ARRAY OF CHAR; VAR gL, gR: INTEGER);
+ VAR len, i: INTEGER;
+BEGIN
+ gR := 0; i := 1; len := Length(str) - 1;
+ WHILE i < len DO
+ gn[gR].next := NewNode(char, ORD(str[i]), 0); gR := gn[gR].next;
+ INC(i)
+ END;
+ gL := gn[0].next; gn[0].next := 0
+END StrToGraph;
+
+PROCEDURE DelNode*(gn: GraphNode): BOOLEAN;
+ VAR sn: SymbolNode;
+
+ PROCEDURE DelAlt(gp: INTEGER): BOOLEAN;
+ VAR gn: GraphNode;
+ BEGIN
+ IF gp <= 0 THEN RETURN TRUE END; (*end of graph found*)
+ GetNode(gp, gn);
+ RETURN DelNode(gn) & DelAlt(gn.next);
+ END DelAlt;
+
+BEGIN
+ IF gn.typ = nt THEN GetSym(gn.p1, sn); RETURN sn.deletable
+ ELSIF gn.typ = alt THEN RETURN DelAlt(gn.p1) OR (gn.p2 # 0) & DelAlt(gn.p2)
+ ELSE RETURN gn.typ IN {eps, iter, opt, sem, sync}
+ END
+END DelNode;
+
+PROCEDURE PrintGraph*;
+ VAR i: INTEGER;
+
+ PROCEDURE WriteTyp(typ: INTEGER);
+ BEGIN
+ CASE typ OF
+ | nt : Str("nt ")
+ | t : Str("t ")
+ | wt : Str("wt ")
+ | any : Str("any ")
+ | eps : Str("eps ")
+ | sem : Str("sem ")
+ | sync: Str("sync")
+ | alt : Str("alt ")
+ | iter: Str("iter")
+ | opt : Str("opt ")
+ ELSE Str("--- ")
+ END;
+ END WriteTyp;
+
+BEGIN (* PrintGraph *)
+ Str("GraphList:"); NL; NL;
+ Str(" nr typ next p1 p2 line"); NL; NL;
+
+ i := 0;
+ WHILE i <= nNodes DO
+ Texts.WriteInt(w, i, 3); Str(" ");
+ WriteTyp(gn[i].typ); Texts.WriteInt(w, gn[i].next, 7);
+ Texts.WriteInt(w, gn[i].p1, 7);
+ Texts.WriteInt(w, gn[i].p2, 7);
+ Texts.WriteInt(w, gn[i].line, 7);
+ NL;
+ INC(i);
+ END;
+ NL; NL; Texts.Append(Oberon.Log, w.buf)
+END PrintGraph;
+
+PROCEDURE FindCircularProductions* (VAR ok: BOOLEAN);
+ CONST maxList = 150;
+ TYPE ListEntry = RECORD
+ left : INTEGER;
+ right : INTEGER;
+ deleted: BOOLEAN;
+ END;
+ VAR changed, onLeftSide, onRightSide: BOOLEAN; i, j, listLength: INTEGER;
+ list: ARRAY maxList OF ListEntry;
+ singles: MarkList;
+ sn: SymbolNode;
+
+ PROCEDURE GetSingles (gp: INTEGER; VAR singles: MarkList);
+ VAR gn: GraphNode;
+ BEGIN
+ IF gp <= 0 THEN RETURN END; (* end of graph found *)
+ GetNode (gp, gn);
+ IF gn.typ = nt THEN
+ IF DelGraph(ABS(gn.next)) THEN Sets.Incl(singles, gn.p1) END
+ ELSIF gn.typ IN {alt, iter, opt} THEN
+ IF DelGraph(ABS(gn.next)) THEN
+ GetSingles(gn.p1, singles);
+ IF gn.typ = alt THEN GetSingles(gn.p2, singles) END
+ END
+ END;
+ IF DelNode(gn) THEN GetSingles(gn.next, singles) END
+ END GetSingles;
+
+BEGIN (* FindCircularProductions *)
+ i := firstNt; listLength := 0;
+ WHILE i <= lastNt DO (* for all nonterminals i *)
+ ClearMarkList (singles); GetSym (i, sn);
+ GetSingles (sn.struct, singles); (* get nt's j such that i-->j *)
+ j := firstNt;
+ WHILE j <= lastNt DO (* for all nonterminals j *)
+ IF Sets.In(singles, j) THEN
+ list[listLength].left := i; list[listLength].right := j;
+ list[listLength].deleted := FALSE;
+ INC (listLength)
+ END;
+ INC(j)
+ END;
+ INC(i)
+ END;
+
+ REPEAT
+ i := 0; changed := FALSE;
+ WHILE i < listLength DO
+ IF ~ list[i].deleted THEN
+ j := 0; onLeftSide := FALSE; onRightSide := FALSE;
+ WHILE j < listLength DO
+ IF ~ list[j].deleted THEN
+ IF list[i].left = list[j].right THEN onRightSide := TRUE END;
+ IF list[j].left = list[i].right THEN onLeftSide := TRUE END
+ END;
+ INC(j)
+ END;
+ IF ~ onRightSide OR ~ onLeftSide THEN
+ list[i].deleted := TRUE; changed := TRUE
+ END
+ END;
+ INC(i)
+ END
+ UNTIL ~ changed;
+
+ i := 0; ok := TRUE;
+ WHILE i < listLength DO
+ IF ~ list[i].deleted THEN
+ ok := FALSE;
+ GetSym(list[i].left, sn); NL; Str(" "); Str(sn.name); Str(" --> ");
+ GetSym(list[i].right, sn); Str(sn.name)
+ END;
+ INC(i)
+ END;
+ Texts.Append(Oberon.Log, w.buf)
+END FindCircularProductions;
+
+
+PROCEDURE LL1Test* (VAR ll1: BOOLEAN);
+ VAR sn: SymbolNode; curSy: INTEGER;
+
+ PROCEDURE LL1Error (cond, ts: INTEGER);
+ VAR sn: SymbolNode;
+ BEGIN
+ ll1 := FALSE;
+ GetSym (curSy, sn); Str(" LL1 error in "); Str(sn.name); Str(": ");
+ IF ts > 0 THEN GetSym (ts, sn); Str(sn.name); Str(" is ") END;
+ CASE cond OF
+ 1: Str(" start of several alternatives.")
+ | 2: Str(" start & successor of deletable structure")
+ | 3: Str(" an ANY node that matchs no symbol")
+ END;
+ NL; Texts.Append(Oberon.Log, w.buf)
+ END LL1Error;
+
+ PROCEDURE Check (cond: INTEGER; VAR s1, s2: Set);
+ VAR i: INTEGER;
+ BEGIN
+ i := 0;
+ WHILE i <= maxT DO
+ IF Sets.In(s1, i) & Sets.In(s2, i) THEN LL1Error(cond, i) END;
+ INC(i)
+ END
+ END Check;
+
+ PROCEDURE CheckAlternatives (gp: INTEGER);
+ VAR gn, gn1: GraphNode; s1, s2: Set; p: INTEGER;
+ BEGIN
+ WHILE gp > 0 DO
+ GetNode(gp, gn);
+ IF gn.typ = alt THEN
+ p := gp; Sets.Clear(s1);
+ WHILE p # 0 DO (*for all alternatives*)
+ GetNode(p, gn1); CompExpected(gn1.p1, curSy, s2);
+ Check(1, s1, s2); Sets.Unite(s1, s2);
+ CheckAlternatives(gn1.p1);
+ p := gn1.p2
+ END
+ ELSIF gn.typ IN {opt, iter} THEN
+ CompExpected(gn.p1, curSy, s1);
+ CompExpected(ABS(gn.next), curSy, s2);
+ Check(2, s1, s2);
+ CheckAlternatives(gn.p1)
+ ELSIF gn.typ = any THEN
+ GetSet(gn.p1, s1);
+ IF Sets.Empty(s1) THEN LL1Error(3, 0) END (*e.g. {ANY} ANY or [ANY] ANY*)
+ END;
+ gp := gn.next
+ END
+ END CheckAlternatives;
+
+BEGIN (* LL1Test *)
+ curSy := firstNt; ll1 := TRUE;
+ WHILE curSy <= lastNt DO (*for all nonterminals*)
+ GetSym(curSy, sn); CheckAlternatives (sn.struct);
+ INC (curSy)
+ END;
+END LL1Test;
+
+
+PROCEDURE TestCompleteness* (VAR ok: BOOLEAN);
+ VAR sp: INTEGER; sn: SymbolNode;
+BEGIN
+ sp := firstNt; ok := TRUE;
+ WHILE sp <= lastNt DO (*for all nonterminals*)
+ GetSym (sp, sn);
+ IF sn.struct = 0 THEN
+ ok := FALSE; NL; Str(" No production for "); Str(sn.name); Texts.Append(Oberon.Log, w.buf)
+ END;
+ INC(sp)
+ END
+END TestCompleteness;
+
+
+PROCEDURE TestIfAllNtReached* (VAR ok: BOOLEAN);
+ VAR gn: GraphNode; sp: INTEGER; reached: MarkList; sn: SymbolNode;
+
+ PROCEDURE MarkReachedNts (gp: INTEGER);
+ VAR gn: GraphNode; sn: SymbolNode;
+ BEGIN
+ WHILE gp > 0 DO
+ GetNode(gp, gn);
+ IF gn.typ = nt THEN
+ IF ~ Sets.In(reached, gn.p1) THEN (*new nt reached*)
+ Sets.Incl(reached, gn.p1);
+ GetSym(gn.p1, sn); MarkReachedNts(sn.struct)
+ END
+ ELSIF gn.typ IN {alt, iter, opt} THEN
+ MarkReachedNts(gn.p1);
+ IF gn.typ = alt THEN MarkReachedNts(gn.p2) END
+ END;
+ gp := gn.next
+ END
+ END MarkReachedNts;
+
+BEGIN (* TestIfAllNtReached *)
+ ClearMarkList(reached);
+ GetNode(root, gn); Sets.Incl(reached, gn.p1);
+ GetSym(gn.p1, sn); MarkReachedNts(sn.struct);
+
+ sp := firstNt; ok := TRUE;
+ WHILE sp <= lastNt DO (*for all nonterminals*)
+ IF ~ Sets.In(reached, sp) THEN
+ ok := FALSE; GetSym(sp, sn); NL; Str(" "); Str(sn.name); Str(" cannot be reached")
+ END;
+ INC(sp)
+ END;
+ Texts.Append(Oberon.Log, w.buf)
+END TestIfAllNtReached;
+
+
+PROCEDURE TestIfNtToTerm* (VAR ok: BOOLEAN);
+ VAR changed: BOOLEAN; gn: GraphNode; sp: INTEGER;
+ sn: SymbolNode;
+ termList: MarkList;
+
+ PROCEDURE IsTerm (gp: INTEGER): BOOLEAN;
+ VAR gn: GraphNode;
+ BEGIN
+ WHILE gp > 0 DO
+ GetNode(gp, gn);
+ IF (gn.typ = nt) & ~ Sets.In(termList, gn.p1)
+ OR (gn.typ = alt) & ~ IsTerm(gn.p1) & ~ IsTerm(gn.p2) THEN RETURN FALSE
+ END;
+ gp := gn.next
+ END;
+ RETURN TRUE
+ END IsTerm;
+
+BEGIN (* TestIfNtToTerm *)
+ ClearMarkList(termList);
+ REPEAT
+ sp := firstNt; changed := FALSE;
+ WHILE sp <= lastNt DO
+ IF ~ Sets.In(termList, sp) THEN
+ GetSym(sp, sn);
+ IF IsTerm(sn.struct) THEN Sets.Incl(termList, sp); changed := TRUE END
+ END;
+ INC(sp)
+ END
+ UNTIL ~changed;
+
+ sp := firstNt; ok := TRUE;
+ WHILE sp <= lastNt DO
+ IF ~ Sets.In(termList, sp) THEN
+ ok := FALSE; GetSym(sp, sn); NL; Str(" "); Str(sn.name); Str(" cannot be derived to terminals")
+ END;
+ INC(sp)
+ END;
+ Texts.Append(Oberon.Log, w.buf)
+END TestIfNtToTerm;
+
+PROCEDURE Init*;
+BEGIN
+ maxSet := 0; Sets.Clear(set[0]); Sets.Incl(set[0], eofSy);
+ firstNt := maxSymbols; maxP := maxSymbols; maxT := -1; maxC := -1;
+ lastNt := maxP - 1;
+ dummyName := 0;
+ nNodes := 0
+END Init;
+
+BEGIN (* CRT *)
+ (* The dummy node gn[0] ensures that none of the procedures
+ above have to check for 0 indices. *)
+ nNodes := 0;
+ gn[0].typ := -1; gn[0].p1 := 0; gn[0].p2 := 0; gn[0].next := 0; gn[0].line := 0;
+ Texts.OpenWriter(w)
+END CRT.
diff --git a/tools/Coco/CRX.obn b/tools/Coco/CRX.obn
--- /dev/null
+++ b/tools/Coco/CRX.obn
@@ -0,0 +1,474 @@
+MODULE CRX; (* H.Moessenboeck 17.11.93 *)
+
+IMPORT Oberon, Texts, Sets, CRS, CRT, SYSTEM;
+
+CONST
+ symSetSize = 100;
+ maxTerm = 3; (* sets of size < maxTerm are enumerated *)
+
+ tErr = 0; altErr = 1; syncErr = 2;
+ EOL = 0DX;
+
+VAR
+ maxSS: INTEGER; (* number of symbol sets *)
+ errorNr: INTEGER; (* highest parser error number *)
+ curSy: INTEGER; (* symbol whose production is currently generated *)
+ err, w: Texts.Writer;
+ fram: Texts.Reader;
+ src: Texts.Reader;
+ syn: Texts.Writer;
+ scanner: ARRAY 32 OF CHAR;
+ symSet: ARRAY symSetSize OF CRT.Set;
+
+
+PROCEDURE Restriction(n: INTEGER);
+BEGIN
+ Texts.WriteLn(w); Texts.WriteString(w, "Restriction ");
+ Texts.WriteInt(w, n, 0); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf);
+ HALT(99)
+END Restriction;
+
+PROCEDURE PutS(s: ARRAY OF CHAR);
+ VAR i: INTEGER;
+BEGIN i := 0;
+ WHILE (i < LEN(s)) & (s[i] # 0X) DO
+ IF s[i] = "$" THEN Texts.WriteLn(syn) ELSE Texts.Write(syn, s[i]) END;
+ INC(i)
+ END
+END PutS;
+
+PROCEDURE PutI(i: INTEGER);
+BEGIN Texts.WriteInt(syn, i, 0)
+END PutI;
+
+PROCEDURE Indent(n: INTEGER);
+ VAR i: INTEGER;
+BEGIN i := 0; WHILE i < n DO Texts.Write(syn, " "); INC(i) END
+END Indent;
+
+PROCEDURE PutSet(s: SET);
+ VAR i: INTEGER; first: BOOLEAN;
+BEGIN
+ i := 0; first := TRUE;
+ WHILE i < Sets.size DO
+ IF i IN s THEN
+ IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END;
+ PutI(i)
+ END;
+ INC(i)
+ END
+END PutSet;
+
+PROCEDURE PutSet1(s: CRT.Set);
+ VAR i: INTEGER; first: BOOLEAN;
+BEGIN
+ i := 0; first := TRUE;
+ WHILE i <= CRT.maxT DO
+ IF Sets.In(s, i) THEN
+ IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END;
+ PutI(i)
+ END;
+ INC(i)
+ END
+END PutSet1;
+
+PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
+ RETURN i
+END Length;
+
+PROCEDURE Alternatives(gp: INTEGER): INTEGER;
+ VAR gn: CRT.GraphNode; n: INTEGER;
+BEGIN
+ n := 0;
+ WHILE gp > 0 DO
+ CRT.GetNode(gp, gn); gp := gn.p2; INC(n)
+ END;
+ RETURN n
+END Alternatives;
+
+PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file <fram> to file <syn> until <stopStr>*)
+ VAR ch, startCh: CHAR; i, j, high: INTEGER;
+BEGIN
+ startCh := stopStr[0]; high := Length(stopStr) - 1; Texts.Read (fram, ch);
+ WHILE ch # 0X DO
+ IF ch = startCh THEN (* check if stopString occurs *)
+ i := 0;
+ REPEAT
+ IF i = high THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*)
+ Texts.Read (fram, ch); INC(i);
+ UNTIL ch # stopStr[i];
+ (*stopStr[0..i-1] found; 1 unrecognized character*)
+ j := 0; WHILE j < i DO Texts.Write(syn, stopStr[j]); INC(j) END
+ ELSE Texts.Write (syn, ch); Texts.Read(fram, ch)
+ END
+ END
+END CopyFramePart;
+
+PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER);
+(*Copy sequence <position> from <src> to <syn>*)
+ VAR ch: CHAR; i: INTEGER; nChars: LONGINT; r: Texts.Reader;
+BEGIN
+ IF (pos.beg >= 0) & (pos.len > 0) THEN
+ Texts.OpenReader(r, CRS.src, pos.beg); Texts.Read(r, ch);
+ nChars := pos.len - 1;
+ Indent(indent);
+ LOOP
+ WHILE ch = EOL DO
+ Texts.WriteLn(syn); Indent(indent);
+ IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
+ i := pos.col;
+ WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *)
+ IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END;
+ DEC(i)
+ END
+ END;
+ Texts.Write (syn, ch);
+ IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
+ END
+ END
+
+(* IF pos.beg >= 0 THEN
+ Texts.OpenReader(r, CRS.src, pos.beg);
+ nChars := pos.len; col := pos.col - 1; ch := " ";
+ WHILE (nChars > 0) & (ch = " ") DO (*skip leading blanks*)
+ Texts.Read(r, ch); DEC(nChars); INC(col)
+ END;
+ Indent(indent);
+ LOOP
+ WHILE ch = EOL DO
+ Texts.WriteLn(syn); Indent(indent);
+ IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
+ i := col - 1;
+ WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *)
+ IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END;
+ DEC(i)
+ END
+ END;
+ Texts.Write (syn, ch);
+ IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
+ END (* LOOP *)
+ END *)
+END CopySourcePart;
+
+PROCEDURE GenErrorMsg (errTyp, errSym: INTEGER; VAR errNr: INTEGER);
+ VAR i: INTEGER; name: ARRAY 32 OF CHAR; sn: CRT.SymbolNode;
+BEGIN
+ INC (errorNr); errNr := errorNr;
+ CRT.GetSym (errSym, sn); COPY(sn.name, name);
+ i := 0; WHILE name[i] # 0X DO IF name[i] = CHR(34) THEN name[i] := "'" END; INC(i) END;
+ Texts.WriteString(err, " |");
+ Texts.WriteInt (err, errNr, 3); Texts.WriteString (err, ": Msg("); Texts.Write(err, CHR(34));
+ CASE errTyp OF
+ | tErr : Texts.WriteString (err, name); Texts.WriteString (err, " expected")
+ | altErr : Texts.WriteString (err, "invalid "); Texts.WriteString (err, name)
+ | syncErr: Texts.WriteString (err, "this symbol not expected in "); Texts.WriteString (err, name)
+ END;
+ Texts.Write(err, CHR(34)); Texts.Write(err, ")"); Texts.WriteLn(err)
+END GenErrorMsg;
+
+PROCEDURE NewCondSet (set: CRT.Set): INTEGER;
+ VAR i: INTEGER;
+BEGIN
+ i := 1; (*skip symSet[0]*)
+ WHILE i <= maxSS DO
+ IF Sets.Equal(set, symSet[i]) THEN RETURN i END;
+ INC(i)
+ END;
+ INC(maxSS); IF maxSS > symSetSize THEN Restriction (9) END;
+ symSet[maxSS] := set;
+ RETURN maxSS
+END NewCondSet;
+
+PROCEDURE GenCond (set: CRT.Set);
+ VAR sx, i, n: INTEGER;
+
+ PROCEDURE Small(s: CRT.Set): BOOLEAN;
+ BEGIN
+ i := Sets.size;
+ WHILE i <= CRT.maxT DO
+ IF Sets.In(set, i) THEN RETURN FALSE END;
+ INC(i)
+ END;
+ RETURN TRUE
+ END Small;
+
+BEGIN
+ n := Sets.Elements(set, i);
+ (*IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
+ ELSIF (n > 1) & Small(set) THEN
+ PutS(" sym IN {"); PutSet(set[0]); PutS("} ")
+ ELSIF n <= maxTerm THEN
+ i := 0;
+ WHILE i <= CRT.maxT DO
+ IF Sets.In (set, i) THEN
+ PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
+ DEC(n); IF n > 0 THEN PutS(" OR") END
+ END;
+ INC(i)
+ END
+ ELSE PutS(" sym IN symSet["); PutI(NewCondSet(set)); PutS(",0]")
+ END;*)
+ IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
+ ELSIF n <= maxTerm THEN
+ i := 0;
+ WHILE i <= CRT.maxT DO
+ IF Sets.In (set, i) THEN
+ PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
+ DEC(n); IF n > 0 THEN PutS(" OR") END
+ END;
+ INC(i)
+ END
+ ELSE PutS(" StartOf("); PutI(NewCondSet(set)); PutS(") ")
+ END;
+
+END GenCond;
+
+PROCEDURE GenCode (gp, indent: INTEGER; checked: CRT.Set);
+ VAR gn, gn2: CRT.GraphNode; sn: CRT.SymbolNode; gp2: INTEGER;
+ s1, s2: CRT.Set; errNr, alts: INTEGER; equal: BOOLEAN;
+BEGIN
+ WHILE gp > 0 DO
+ CRT.GetNode (gp, gn);
+ CASE gn.typ OF
+
+ | CRT.nt:
+ Indent(indent);
+ CRT.GetSym(gn.p1, sn); PutS(sn.name);
+ IF gn.pos.beg >= 0 THEN
+ Texts.Write(syn, "("); CopySourcePart(gn.pos, 0); Texts.Write(syn, ")")
+ END;
+ PutS(";$")
+
+ | CRT.t:
+ CRT.GetSym(gn.p1, sn); Indent(indent);
+ IF Sets.In(checked, gn.p1) THEN
+ PutS("Get;$")
+ ELSE
+ PutS("Expect("); PutI(gn.p1); PutS(");$")
+ END
+
+ | CRT.wt:
+ CRT.CompExpected(ABS(gn.next), curSy, s1);
+ CRT.GetSet(0, s2); Sets.Unite(s1, s2);
+ CRT.GetSym(gn.p1, sn); Indent(indent);
+ PutS("ExpectWeak("); PutI(gn.p1); PutS(", "); PutI(NewCondSet(s1)); PutS(");$")
+
+ | CRT.any:
+ Indent(indent); PutS("Get;$")
+
+ | CRT.eps: (* nothing *)
+
+ | CRT.sem:
+ CopySourcePart(gn.pos, indent); PutS(";$");
+
+ | CRT.sync:
+ CRT.GetSet(gn.p1, s1);
+ GenErrorMsg (syncErr, curSy, errNr);
+ Indent(indent);
+ PutS("WHILE ~("); GenCond(s1); PutS(") DO Error(");
+ PutI(errNr); PutS("); Get END;$")
+
+ | CRT.alt:
+ CRT.CompFirstSet(gp, s1); equal := Sets.Equal(s1, checked);
+ alts := Alternatives(gp);
+ IF alts > 5 THEN Indent(indent); PutS("CASE sym OF$") END;
+ gp2 := gp;
+ WHILE gp2 # 0 DO
+ CRT.GetNode(gp2, gn2);
+ CRT.CompExpected(gn2.p1, curSy, s1);
+ Indent(indent);
+ IF alts > 5 THEN PutS("| "); PutSet1(s1); PutS(": ") (*case labels*)
+ ELSIF gp2 = gp THEN PutS("IF"); GenCond(s1); PutS(" THEN$")
+ ELSIF (gn2.p2 = 0) & equal THEN PutS("ELSE$")
+ ELSE PutS("ELSIF"); GenCond(s1); PutS(" THEN$")
+ END;
+ Sets.Unite(s1, checked);
+ GenCode(gn2.p1, indent + 2, s1);
+ gp2 := gn2.p2
+ END;
+ IF ~ equal THEN
+ GenErrorMsg(altErr, curSy, errNr);
+ Indent(indent); PutS("ELSE Error("); PutI(errNr); PutS(")$")
+ END;
+ Indent(indent); PutS("END;$")
+
+ | CRT.iter:
+ CRT.GetNode(gn.p1, gn2);
+ Indent(indent); PutS("WHILE");
+ IF gn2.typ = CRT.wt THEN
+ CRT.CompExpected(ABS(gn2.next), curSy, s1);
+ CRT.CompExpected(ABS(gn.next), curSy, s2);
+ CRT.GetSym(gn2.p1, sn);
+ PutS(" WeakSeparator("); PutI(gn2.p1); PutS(", "); PutI(NewCondSet(s1));
+ PutS(", "); PutI(NewCondSet(s2)); PutS(") ");
+ Sets.Clear(s1); (*for inner structure*)
+ IF gn2.next > 0 THEN gp2 := gn2.next ELSE gp2 := 0 END
+ ELSE
+ gp2 := gn.p1; CRT.CompFirstSet(gp2, s1); GenCond(s1)
+ END;
+ PutS(" DO$");
+ GenCode(gp2, indent + 2, s1);
+ Indent(indent); PutS("END;$")
+
+ | CRT.opt:
+ CRT.CompFirstSet(gn.p1, s1);
+ IF ~ Sets.Equal(checked, s1) THEN
+ Indent(indent); PutS("IF"); GenCond(s1); PutS(" THEN$");
+ GenCode(gn.p1, indent + 2, s1);
+ Indent(indent); PutS("END;$")
+ ELSE GenCode(gn.p1, indent, checked)
+ END
+
+ END; (*CASE*)
+ IF ~ (gn.typ IN {CRT.eps, CRT.sem, CRT.sync}) THEN Sets.Clear(checked) END;
+ gp := gn.next
+ END
+END GenCode;
+
+PROCEDURE GenCodePragmas;
+ VAR i, p: INTEGER; sn: CRT.SymbolNode;
+
+ PROCEDURE P(s1, s2: ARRAY OF CHAR);
+ BEGIN
+ PutS(" "); PutS(scanner); PutS(s1); PutS(" := "); PutS(scanner); PutS(s2); PutS(";$")
+ END P;
+
+BEGIN
+ i := CRT.maxT + 1;
+ WHILE i <= CRT.maxP DO
+ CRT.GetSym(i, sn);
+ PutS(" IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$ END;$");
+ INC(i)
+ END;
+ P(".nextPos", ".pos"); P(".nextCol", ".col"); P(".nextLine", ".line"); P(".nextLen", ".len")
+END GenCodePragmas;
+
+PROCEDURE GenProcedureHeading (sn: CRT.SymbolNode; forward: BOOLEAN);
+BEGIN
+ PutS("PROCEDURE ");
+ IF forward THEN Texts.Write(syn, "^") END;
+ PutS(sn.name);
+ IF sn.attrPos.beg >= 0 THEN
+ Texts.Write(syn, "("); CopySourcePart(sn.attrPos, 0); Texts.Write(syn, ")")
+ END;
+ PutS(";$")
+END GenProcedureHeading;
+
+PROCEDURE GenForwardRefs;
+ VAR sp: INTEGER; sn: CRT.SymbolNode;
+BEGIN
+ IF ~ CRT.ddt[5] THEN
+ sp := CRT.firstNt;
+ WHILE sp <= CRT.lastNt DO (* for all nonterminals *)
+ CRT.GetSym (sp, sn); GenProcedureHeading(sn, TRUE);
+ INC(sp)
+ END;
+ Texts.WriteLn(syn)
+ END
+END GenForwardRefs;
+
+PROCEDURE GenProductions;
+ VAR sn: CRT.SymbolNode; checked: CRT.Set;
+BEGIN
+ curSy := CRT.firstNt;
+ WHILE curSy <= CRT.lastNt DO (* for all nonterminals *)
+ CRT.GetSym (curSy, sn); GenProcedureHeading (sn, FALSE);
+ IF sn.semPos.beg >= 0 THEN CopySourcePart(sn.semPos, 2); PutS(" $") END;
+ PutS("BEGIN$"); Sets.Clear(checked);
+ GenCode (sn.struct, 2, checked);
+ PutS("END "); PutS(sn.name); PutS(";$$");
+ INC (curSy);
+ END;
+END GenProductions;
+
+PROCEDURE InitSets;
+ VAR i, j: INTEGER;
+BEGIN
+ i := 0; CRT.GetSet(0, symSet[0]);
+ WHILE i <= maxSS DO
+ j := 0;
+ WHILE j <= CRT.maxT DIV Sets.size DO
+ PutS(" symSet["); PutI(i); PutS(", ");PutI(j);
+ PutS("] := {"); PutSet(symSet[i, j]); PutS("};$");
+ INC(j)
+ END;
+ INC(i)
+ END
+END InitSets;
+
+PROCEDURE *Show(t: Texts.Text; op: INTEGER; beg, end: LONGINT);
+BEGIN END Show;
+
+PROCEDURE GenCompiler*;
+ VAR errNr, i: INTEGER; checked: CRT.Set;
+ gn: CRT.GraphNode; sn: CRT.SymbolNode;
+ parser: ARRAY 32 OF CHAR;
+ t: Texts.Text; pos: LONGINT;
+ ch1, ch2: CHAR;
+BEGIN
+ CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
+ COPY(sn.name, parser); i := Length(parser); parser[i] := "P"; parser[i+1] := 0X;
+ COPY(parser, scanner); scanner[i] := "S";
+
+ NEW(t); Texts.Open(t, "Parser.FRM"); Texts.OpenReader(fram, t, 0);
+ IF t.len = 0 THEN
+ Texts.WriteString(w, "Parser.FRM not found"); Texts.WriteLn(w);
+ Texts.Append(Oberon.Log, w.buf); HALT(99)
+ END;
+
+ Texts.OpenWriter(err); Texts.WriteLn(err);
+ i := 0;
+ WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END;
+
+ (*----- write *P.Mod -----*)
+ Texts.OpenWriter(syn);
+ NEW(t); t.notify := Show; Texts.Open(t, "");
+ CopyFramePart("-->modulename"); PutS(parser);
+ CopyFramePart("-->scanner"); PutS(scanner);
+ IF CRT.importPos.beg >= 0 THEN PutS(", "); CopySourcePart(CRT.importPos, 0) END;
+ CopyFramePart("-->constants");
+ PutS("maxP = "); PutI(CRT.maxP); PutS(";$");
+ PutS(" maxT = "); PutI(CRT.maxT); PutS(";$");
+ PutS(" nrSets = ;$"); Texts.Append(t, syn.buf); pos := t.len - 2;
+ CopyFramePart("-->declarations"); CopySourcePart(CRT.semDeclPos, 0);
+ CopyFramePart("-->errors"); PutS(scanner); PutS(".Error(n, "); PutS(scanner); PutS(".nextPos)");
+ CopyFramePart("-->scanProc");
+ IF CRT.maxT = CRT.maxP THEN PutS(scanner); PutS(".Get(sym)")
+ ELSE
+ PutS("LOOP "); PutS(scanner); PutS(".Get(sym);$");
+ PutS(" IF sym > maxT THEN$");
+ GenCodePragmas;
+ PutS(" ELSE EXIT$");
+ PutS(" END$");
+ PutS("END$")
+ END;
+ CopyFramePart("-->productions"); GenForwardRefs; GenProductions;
+ CopyFramePart("-->parseRoot"); Sets.Clear(checked); GenCode (CRT.root, 2, checked);
+ CopyFramePart("-->initialization"); InitSets;
+ CopyFramePart("-->modulename"); PutS(parser); Texts.Write(syn, ".");
+ Texts.Append(t, syn.buf); Texts.Append(t, err.buf);
+ PutI(maxSS+1); (*if no set, maxSS = -1*) Texts.Insert(t, pos, syn.buf);
+ i := Length(parser); parser[i] := "."; parser[i+1] := "M"; parser[i+2] := "o"; parser[i+3] := "d"; parser[i+4] := 0X;
+ Texts.Close(t, parser)
+END GenCompiler;
+
+PROCEDURE WriteStatistics*;
+BEGIN
+ Texts.WriteInt (w, CRT.maxT + 1, 0); Texts.WriteString(w, " t, ");
+ Texts.WriteInt (w, CRT.maxSymbols - CRT.firstNt + CRT.maxT + 1, 0); Texts.WriteString(w, " syms, ");
+ Texts.WriteInt (w, CRT.nNodes, 0); Texts.WriteString(w, " nodes, ");
+ Texts.WriteInt (w, maxSS, 0); Texts.WriteString(w, "sets");
+ Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
+END WriteStatistics;
+
+PROCEDURE Init*;
+BEGIN
+ errorNr := -1; maxSS := 0 (*symSet[0] reserved for all SYNC sets*)
+END Init;
+
+BEGIN
+ Texts.OpenWriter(w)
+END CRX.
diff --git a/tools/Coco/Coco b/tools/Coco/Coco
--- /dev/null
+++ b/tools/Coco/Coco
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+set -e
+
+DIR=$(dirname "$0")
+PATH="../..:$PATH"
+
+java -ea -cp "$DIR/classes" Launcher Coco.$*
diff --git a/tools/Coco/Coco.Tool b/tools/Coco/Coco.Tool
--- /dev/null
+++ b/tools/Coco/Coco.Tool
@@ -0,0 +1,83 @@
+Coco/R - the Oberon scanner and parser generator
+
+For a complete documentation see the postscript file Coco.Report.ps.
+
+Compiler.Compile
+ Sets.Mod CRS.Mod CRT.Mod CRA.Mod CRX.Mod CRP.Mod Coco.Mod ~
+
+NOTE: the option character should be changed to "\" in Coco.Mod for Unix implementations.
+
+
+Coco.Compile *
+Coco.Compile ~
+Coco.Compile ^
+Coco.Compile @
+
+(*________________________ usage ________________________*)
+
+Coco.Compile <filename> [options]
+
+The file CR.ATG is an example of an input file to Coco. If the grammar in the input file has the name X
+the generated scanner has the name XS.Mod and the generated parser has the name XP.Mod.
+
+Options:
+
+ /X generates a cross reference list of all syntax symbols
+ /S generates a list of all terminal start symbols and successors of nonterminal symbols.
+
+Interface of the generated scanner:
+
+ DEFINITION XS;
+ IMPORT Texts;
+ TYPE
+ ErrorProc = PROCEDURE (n: INTEGER; pos: LONGINT);
+ VAR
+ Error: ErrorProc;
+ col, errors, len, line, nextCol, nextLen, nextLine: INTEGER;
+ nextPos, pos: LONGINT;
+ src: Texts.Text;
+ PROCEDURE Reset (t: Texts.Text; pos: LONGINT; errProc: ErrorProc);
+ PROCEDURE Get(VAR sym: INTEGER);
+ PROCEDURE GetName(pos: LONGINT; len: INTEGER; VAR name: ARRAY OF CHAR);
+ PROCEDURE StdErrorProc (n: INTEGER; pos: LONGINT);
+ END XS.
+
+Interface of the generated parser:
+
+ DEFINITION XP;
+ PROCEDURE Parse;
+ END XP.
+
+Example how to use the generated parts;
+
+ Texts.OpenScanner(s, Oberon.Par.Text, Oberon.Par.Pos); Texts.Scan(s);
+ IF s.class = Texts.Name THEN
+ NEW(text); Texts.Open(text, s.s);
+ XS.Reset(text, 0, MyErrorHandler);
+ XP.Parse;
+ END
+
+
+Error handling in the generated parser:
+
+The grammar has to contain hints, from which Coco can generate appropriate error handling.
+The hints can be placed arbitrarily on the right-hand side of a production:
+
+ SYNC Denotes a synchronisation point. At such points symbols are skipped until a symbol
+ is found which is a legal continuation symbol at that point (or eof). SYNC is usually
+ placed at points where particularly "safe" symbols are expected, i.e., symbols that
+ are rarely missing or misspelled.
+
+ WEAK s s is an arbitrary terminal symbol (e.g., ";") which is considered "weak", because it is
+ frequently missing or misspelled (e.g., a semicolon between statements).
+
+Example:
+
+ Statement =
+ SYNC
+ ( ident WEAK ":=" Expression
+ | "IF" Expression "THEN" StatSeq ["ELSE" StatSeq] "END"
+ | "WHILE" Expression "DO" StatSeq "END"
+ ).
+ StatSeq =
+ Statement { WEAK ";" Statement}.þ
diff --git a/tools/Coco/Coco.obn b/tools/Coco/Coco.obn
--- /dev/null
+++ b/tools/Coco/Coco.obn
@@ -0,0 +1,172 @@
+(* Implementation restrictions
+ 3 too many nodes in graph (>1500) CRG.NewNode
+ 4 too many sets (ANY-symbols or SYNC symbols) CRT.NewAnySet,
+ CRT.ComputeSyncSet
+ 6 too many symbols (>300) CRT.NewSym
+ 7 too many character classes (>50) CRT.NewClass
+ 9 too many conditions in generated code (>100) CRX.NewCondSet
+
+ Trace output (ddt settings: ${digit})
+ 0 Prints states of automaton
+ 1 Prints start symbols and followers of nonterminals (also option /s)
+ 2 Prints the internal graph
+ 3 Trace of start symbol set computation
+ 4 Trace of follow set computation
+ 5 suppresses FORWARD declarations in parser (for multipass compilers)
+ 6 Prints the symbol list
+ 7 Prints a cross reference list (also option /x)
+ 8 Write statistics
+==========================================================================*)
+MODULE Coco;
+
+IMPORT Oberon, Texts, CRS, CRP, CRT;
+
+CONST minErrDist = 8;
+
+VAR w: Texts.Writer; lastErrPos: LONGINT;
+
+
+PROCEDURE Error (n: INTEGER; pos: LONGINT);
+
+ PROCEDURE Msg (s: ARRAY OF CHAR);
+ BEGIN Texts.WriteString(w, s)
+ END Msg;
+
+BEGIN
+ INC(CRS.errors);
+ IF pos < lastErrPos + minErrDist THEN lastErrPos := pos; RETURN END;
+ lastErrPos := pos;
+ Texts.WriteInt(w, pos, 3); Texts.WriteString(w, ": ");
+ IF n < 200 THEN
+ CASE n OF
+ | 0: Msg("EOF expected")
+ | 1: Msg("ident expected")
+ | 2: Msg("string expected")
+ | 3: Msg("number expected")
+ | 4: Msg("'COMPILER' expected")
+ | 5: Msg("'IMPORT' expected")
+ | 6: Msg("';' expected")
+ | 7: Msg("'PRODUCTIONS' expected")
+ | 8: Msg("'=' expected")
+ | 9: Msg("'.' expected")
+ | 10: Msg("'END' expected")
+ | 11: Msg("'CHARACTERS' expected")
+ | 12: Msg("'TOKENS' expected")
+ | 13: Msg("'PRAGMAS' expected")
+ | 14: Msg("'COMMENTS' expected")
+ | 15: Msg("'FROM' expected")
+ | 16: Msg("'TO' expected")
+ | 17: Msg("'NESTED' expected")
+ | 18: Msg("'IGNORE' expected")
+ | 19: Msg("'CASE' expected")
+ | 20: Msg("'+' expected")
+ | 21: Msg("'-' expected")
+ | 22: Msg("'CHR' expected")
+ | 23: Msg("'(' expected")
+ | 24: Msg("')' expected")
+ | 25: Msg("'ANY' expected")
+ | 26: Msg("'|' expected")
+ | 27: Msg("'WEAK' expected")
+ | 28: Msg("'[' expected")
+ | 29: Msg("']' expected")
+ | 30: Msg("'{' expected")
+ | 31: Msg("'}' expected")
+ | 32: Msg("'SYNC' expected")
+ | 33: Msg("'CONTEXT' expected")
+ | 34: Msg("'<' expected")
+ | 35: Msg("'>' expected")
+ | 36: Msg("'(.' expected")
+ | 37: Msg("'.)' expected")
+ | 38: Msg("??? expected")
+ | 39: Msg("invalid TokenFactor")
+ | 40: Msg("invalid Factor")
+ | 41: Msg("invalid Factor")
+ | 42: Msg("invalid Term")
+ | 43: Msg("invalid Symbol")
+ | 44: Msg("invalid SimSet")
+ | 45: Msg("this symbol not expected in TokenDecl")
+ | 46: Msg("invalid TokenDecl")
+ | 47: Msg("invalid Declaration")
+ | 48: Msg("invalid Declaration")
+ | 49: Msg("invalid Declaration")
+ | 50: Msg("this symbol not expected in Coco")
+ | 51: Msg("invalid start of the program")
+ ELSE Texts.WriteString(w, "error "); Texts.WriteInt(w, n, 0)
+ END
+ ELSE
+ CASE n OF
+ | 201: Msg("unexpected end of file");
+ | 202: Msg("string terminator not on this line");
+ | 203: Msg("a literal must not have attributes");
+ | 204: Msg("this symbol kind not allowed in production");
+ | 205: Msg("symbol declared without attributes");
+ | 206: Msg("symbol declared with attributes");
+ | 207: Msg("name declared twice");
+ | 208: Msg("this type not allowed on left side of production");
+ | 209: Msg("symbol earlier referenced without attributes");
+ | 210: Msg("symbol earlier referenced with attributes");
+ | 211: Msg("missing production for grammar name");
+ | 212: Msg("grammar symbol must not have attributes");
+ | 213: Msg("a literal must not be declared with a structure")
+ | 214: Msg("semantic action not allowed here")
+ | 215: Msg("undefined name")
+ | 216: Msg("attributes not allowed in token declaration")
+ | 217: Msg("name does not match name in heading")
+ | 220: Msg("token may be empty")
+ | 221: Msg("token must not start with an iteration")
+ | 222: Msg("only characters allowed in comment declaration")
+ | 223: Msg("only terminals may be weak")
+ | 224:
+ | 225: Msg("comment delimiter must not exceed 2 characters")
+ | 226: Msg("character set contains more than one character")
+ ELSE Texts.WriteString(w, "error "); Texts.WriteInt(w, n, 0)
+ END
+ END;
+Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
+END Error;
+
+PROCEDURE Options(VAR s: Texts.Scanner);
+ VAR i: INTEGER;
+BEGIN
+ IF s.nextCh = "/" THEN Texts.Scan(s); Texts.Scan(s);
+ IF s.class = Texts.Name THEN i := 0;
+ WHILE s.s[i] # 0X DO
+ IF CAP(s.s[i]) = "X" THEN CRT.ddt[7] := TRUE
+ ELSIF CAP(s.s[i]) = "S" THEN CRT.ddt[1] := TRUE
+ END;
+ INC(i)
+ END
+ END
+ END;
+END Options;
+
+
+PROCEDURE Compile*;
+ VAR s: Texts.Scanner; src, t: Texts.Text;
+ pos, beg, end, time: LONGINT; i: INTEGER;
+BEGIN
+ Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
+ src := NIL; pos := 0;
+ IF (s.class = Texts.Char) & (s.c = "^") THEN
+ Oberon.GetSelection(t, beg, end, time);
+ IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s) END
+ END;
+ IF s.class = Texts.Name THEN
+ NEW(src); Texts.Open(src, s.s);
+ ELSIF (s.class = Texts.Char) & (s.c = "@") THEN
+ Oberon.GetSelection(t, beg, end, time);
+ IF time >= 0 THEN src := t; pos := beg; s.s := " " END
+ END;
+ IF src # NIL THEN
+ Texts.WriteString (w, "Coco/R - Compiler-Compiler V2.2"); Texts.Append(Oberon.Log, w.buf);
+ i := 0; WHILE i < 10 DO CRT.ddt[i] := FALSE; INC(i) END;
+ Options(s);
+ Texts.WriteLn(w); Texts.WriteString(w, s.s); Texts.Append(Oberon.Log, w.buf);
+ CRS.Reset(src, pos, Error); lastErrPos := -10;
+ CRP.Parse
+ END
+END Compile;
+
+BEGIN
+ Texts.OpenWriter(w)
+END Coco.
diff --git a/tools/Coco/Parser.FRM b/tools/Coco/Parser.FRM
--- /dev/null
+++ b/tools/Coco/Parser.FRM
@@ -0,0 +1,65 @@
+(* parser module generated by Coco-R *)
+MODULE -->modulename;
+
+IMPORT -->scanner;
+
+CONST
+ -->constants
+ setSize = 32; nSets = (maxT DIV setSize) + 1;
+
+TYPE
+ SymbolSet = ARRAY nSets OF SET;
+
+VAR
+ sym: INTEGER; (* current input symbol *)
+ symSet: ARRAY nrSets OF SymbolSet;
+
+-->declarations
+
+PROCEDURE Error (n: INTEGER);
+BEGIN -->errors
+END Error;
+
+PROCEDURE Get;
+BEGIN
+ -->scanProc
+END Get;
+
+PROCEDURE Expect(n: INTEGER);
+BEGIN IF sym = n THEN Get ELSE Error(n) END
+END Expect;
+
+PROCEDURE StartOf(s: INTEGER): BOOLEAN;
+BEGIN RETURN (sym MOD setSize) IN symSet[s, sym DIV setSize]
+END StartOf;
+
+PROCEDURE ExpectWeak(n, follow: INTEGER);
+BEGIN
+ IF sym = n THEN Get
+ ELSE Error(n); WHILE ~ StartOf(follow) DO Get END
+ END
+END ExpectWeak;
+
+PROCEDURE WeakSeparator(n, syFol, repFol: INTEGER): BOOLEAN;
+ VAR s: SymbolSet; i: INTEGER;
+BEGIN
+ IF sym = n THEN Get; RETURN TRUE
+ ELSIF StartOf(repFol) THEN RETURN FALSE
+ ELSE
+ i := 0; WHILE i < nSets DO s[i] := symSet[syFol, i] + symSet[repFol, i] + symSet[0, i]; INC(i) END;
+ Error(n); WHILE ~ ((sym MOD setSize) IN s[sym DIV setSize]) DO Get END;
+ RETURN StartOf(syFol)
+ END
+END WeakSeparator;
+
+-->productions
+
+PROCEDURE Parse*;
+BEGIN
+ Get;
+-->parseRoot
+END Parse;
+
+BEGIN
+-->initialization
+END -->modulename.
diff --git a/tools/Coco/README b/tools/Coco/README
--- /dev/null
+++ b/tools/Coco/README
@@ -0,0 +1 @@
+ftp://ftp.ethoberon.ethz.ch/Oberon/OberonV4/Sources/Coco/
diff --git a/tools/Coco/Scanner.FRM b/tools/Coco/Scanner.FRM
--- /dev/null
+++ b/tools/Coco/Scanner.FRM
@@ -0,0 +1,103 @@
+(* scanner module generated by Coco-R *)
+MODULE -->modulename;
+
+IMPORT Texts, SYSTEM;
+
+CONST
+ EOL = 0DX;
+ EOF = 0X;
+ maxLexLen = 127;
+-->declarations
+
+TYPE
+ ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT);
+ StartTable = ARRAY 128 OF INTEGER;
+
+VAR
+ src*: Texts.Text; (*source text. To be set by the main pgm*)
+ pos*: LONGINT; (*position of current symbol*)
+ line*, col*, len*: INTEGER; (*line, column, length of current symbol*)
+ nextPos*: LONGINT; (*position of lookahead symbol*)
+ nextLine*, nextCol*, nextLen*: INTEGER; (*line, column, length of lookahead symbol*)
+ errors*: INTEGER; (*number of errors detected*)
+ Error*: ErrorProc;
+
+ ch: CHAR; (*current input character*)
+ r: Texts.Reader; (*global reader*)
+ chPos: LONGINT; (*position of current character*)
+ chLine: INTEGER; (*current line number*)
+ lineStart: LONGINT; (*start position of current line*)
+ apx: INTEGER; (*length of appendix*)
+ oldEols: INTEGER; (*nr. of EOLs in a comment*)
+
+ start: StartTable; (*start state for every character*)
+
+
+PROCEDURE NextCh; (*return global variable ch*)
+BEGIN
+ Texts.Read(r, ch); INC(chPos);
+ IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END
+END NextCh;
+
+
+PROCEDURE Comment(): BOOLEAN;
+ VAR level, startLine: INTEGER; oldLineStart: LONGINT;
+BEGIN (*Comment*)
+ level := 1; startLine := chLine; oldLineStart := lineStart;
+-->comment
+END Comment;
+
+
+PROCEDURE Get*(VAR sym: INTEGER);
+VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR;
+
+ PROCEDURE CheckLiteral;
+ BEGIN
+ IF nextLen < maxLexLen THEN lexeme[nextLen] := 0X END;
+-->literals
+ END CheckLiteral;
+
+BEGIN
+-->GetSy1
+ IF ch > 7FX THEN ch := " " END;
+ pos := nextPos; col := nextCol; line := nextLine; len := nextLen;
+ nextPos := chPos; nextCol := SHORT(chPos - lineStart); nextLine := chLine; nextLen := 0;
+ state := start[ORD(ch)]; apx := 0;
+ LOOP
+ IF nextLen < maxLexLen THEN lexeme[nextLen] := ch END;
+ INC(nextLen);
+ NextCh;
+ IF state > 0 THEN
+ CASE state OF
+-->GetSy2
+ END (*CASE*)
+ ELSE sym := noSym; RETURN (*NextCh already done*)
+ END (*IF*)
+ END (*LOOP*)
+END Get;
+
+
+PROCEDURE GetName*(pos: LONGINT; len: INTEGER; VAR s: ARRAY OF CHAR);
+ VAR i: INTEGER; r: Texts.Reader;
+BEGIN
+ Texts.OpenReader(r, src, pos);
+ IF len >= LEN(s) THEN len := SHORT(LEN(s)) - 1 END;
+ i := 0; WHILE i < len DO Texts.Read(r, s[i]); INC(i) END;
+ s[i] := 0X
+END GetName;
+
+PROCEDURE StdErrorProc* (n: INTEGER; pos: LONGINT);
+BEGIN INC(errors) END StdErrorProc;
+
+PROCEDURE Reset* (t: Texts.Text; pos: LONGINT; errProc: ErrorProc);
+BEGIN
+ src := t; Error := errProc;
+ Texts.OpenReader(r, src, pos);
+ chPos := pos - 1; chLine := 1; lineStart := 0;
+ oldEols := 0; apx := 0; errors := 0;
+ NextCh
+END Reset;
+
+BEGIN
+-->initialization
+END -->modulename.
diff --git a/tools/Coco/Sets.obn b/tools/Coco/Sets.obn
--- /dev/null
+++ b/tools/Coco/Sets.obn
@@ -0,0 +1,138 @@
+MODULE Sets;
+
+IMPORT Texts;
+
+CONST size* = 32;
+
+
+PROCEDURE Clear*(VAR s: ARRAY OF SET);
+ VAR i: INTEGER;
+BEGIN
+ i := 0; WHILE i < LEN(s) DO s[i] := {}; INC(i) END
+END Clear;
+
+
+PROCEDURE Fill*(VAR s: ARRAY OF SET);
+ VAR i: INTEGER;
+BEGIN
+ i := 0; WHILE i < LEN(s) DO s[i] := {0 .. size-1}; INC(i) END
+END Fill;
+
+
+PROCEDURE Incl*(VAR s: ARRAY OF SET; x: INTEGER);
+BEGIN INCL(s[x DIV size], x MOD size)
+END Incl;
+
+
+PROCEDURE Excl*(VAR s: ARRAY OF SET; x: INTEGER);
+BEGIN EXCL(s[x DIV size], x MOD size)
+END Excl;
+
+
+PROCEDURE In*(VAR s: ARRAY OF SET; x: INTEGER): BOOLEAN;
+BEGIN RETURN x MOD size IN s[x DIV size]
+END In;
+
+
+PROCEDURE Includes*(VAR s1, s2: ARRAY OF SET): BOOLEAN;
+ VAR i: INTEGER;
+BEGIN
+ i := 0;
+ WHILE i < LEN(s1) DO
+ IF s1[i] + s2[i] # s1[i] THEN RETURN FALSE END;
+ INC(i)
+ END;
+ RETURN TRUE;
+END Includes;
+
+
+PROCEDURE Elements*(VAR s: ARRAY OF SET; VAR lastElem: INTEGER): INTEGER;
+ VAR i, n, max: INTEGER;
+BEGIN
+ i := 0; n := 0; max := SHORT(LEN(s)) * size;
+ WHILE i < max DO
+ IF (i MOD size) IN s[i DIV size] THEN INC(n); lastElem := i END;
+ INC(i)
+ END;
+ RETURN n
+END Elements;
+
+
+PROCEDURE Empty*(VAR s: ARRAY OF SET): BOOLEAN;
+ VAR i: INTEGER;
+BEGIN
+ i := 0;
+ WHILE i < LEN(s) DO
+ IF s[i] # {} THEN RETURN FALSE END;
+ INC(i)
+ END;
+ RETURN TRUE
+END Empty;
+
+
+PROCEDURE Equal*(VAR s1, s2: ARRAY OF SET): BOOLEAN;
+ VAR i: INTEGER;
+BEGIN
+ i := 0;
+ WHILE i < LEN(s1) DO
+ IF s1[i] # s2[i] THEN RETURN FALSE END;
+ INC(i)
+ END;
+ RETURN TRUE
+END Equal;
+
+
+PROCEDURE Different*(VAR s1, s2: ARRAY OF SET): BOOLEAN;
+ VAR i: INTEGER;
+BEGIN
+ i := 0;
+ WHILE i < LEN(s1) DO
+ IF s1[i] * s2[i] # {} THEN RETURN FALSE END;
+ INC(i)
+ END;
+ RETURN TRUE
+END Different;
+
+
+PROCEDURE Unite*(VAR s1, s2: ARRAY OF SET);
+ VAR i: INTEGER;
+BEGIN
+ i := 0; WHILE i < LEN(s1) DO s1[i] := s1[i] + s2[i]; INC(i) END
+END Unite;
+
+
+PROCEDURE Differ*(VAR s1, s2: ARRAY OF SET);
+ VAR i: INTEGER;
+BEGIN
+ i := 0; WHILE i < LEN(s1) DO s1[i] := s1[i] - s2[i]; INC(i) END
+END Differ;
+
+
+PROCEDURE Intersect*(VAR s1, s2, s3: ARRAY OF SET);
+ VAR i: INTEGER;
+BEGIN
+ i := 0; WHILE i < LEN(s1) DO s3[i] := s1[i] * s2[i]; INC(i) END
+END Intersect;
+
+
+PROCEDURE Print*(VAR f: Texts.Writer; s: ARRAY OF SET; w, indent: INTEGER);
+ VAR col, i, max: INTEGER;
+BEGIN
+ i := 0; col := indent; max := SHORT(LEN(s)) * size;
+ Texts.Write(f, "{");
+ WHILE i < max DO
+ IF In(s, i) THEN
+ IF col + 4 > w THEN
+ Texts.WriteLn(f);
+ col := 0; WHILE col < indent DO Texts.Write(f, " "); INC(col) END
+ END;
+ Texts.WriteInt(f, i, 3); Texts.Write(f, ",");
+ INC(col, 4)
+ END;
+ INC(i)
+ END;
+ Texts.Write(f, "}")
+END Print;
+
+
+END Sets.
diff --git a/tools/Coco/make.sh b/tools/Coco/make.sh
--- /dev/null
+++ b/tools/Coco/make.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+set -e
+
+PATH="../..:$PATH"
+
+obn-compile.sh Coco
diff --git a/tools/Coco/voc/.gitignore b/tools/Coco/voc/.gitignore
--- /dev/null
@@ -0,0 +1,5 @@
+Coco.Compile
+*.o
+*.sym
+*.h
+*.c
diff --git a/tools/Coco/voc/CocoCompile.Mod b/tools/Coco/voc/CocoCompile.Mod
--- /dev/null
@@ -0,0 +1,4 @@
+MODULE CocoCompile;
+IMPORT Coco;
+BEGIN Coco.Compile;
+END CocoCompile.
diff --git a/tools/Coco/voc/make.sh b/tools/Coco/voc/make.sh
--- /dev/null
+++ b/tools/Coco/voc/make.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+set -e
+
+voc ../Sets.obn ../CRS.obn ../CRT.obn ../CRX.obn ../CRA.obn ../CRP.obn ../Coco.obn CocoCompile.Mod -m
+mv CocoCompile Coco.Compile
+rm -f *.o *.sym *.h *.c
diff --git a/tools/TextV4/.gitignore b/tools/TextV4/.gitignore
--- /dev/null
+++ b/tools/TextV4/.gitignore
@@ -0,0 +1,2 @@
+classes
+tmp
diff --git a/TextV4/TextV4 b/tools/TextV4/TextV4
diff --git a/TextV4/TextV4.obn b/tools/TextV4/TextV4.obn
diff --git a/tools/TextV4/make.sh b/tools/TextV4/make.sh
--- /dev/null
+++ b/tools/TextV4/make.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+set -e
+
+PATH="../..:$PATH"
+
+obn-compile.sh TextV4
diff --git a/tools/TextV4/voc/.gitignore b/tools/TextV4/voc/.gitignore
--- /dev/null
@@ -0,0 +1,7 @@
+TextV4.Print
+TextV4.ToAscii
+TextV4.ToText
+*.o
+*.sym
+*.h
+*.c
similarity index 100%
rename from TextV4/voc/TextV4Print.Mod
rename to tools/TextV4/voc/TextV4Print.Mod
rename from TextV4/voc/TextV4Print.Mod
rename to tools/TextV4/voc/TextV4Print.Mod
similarity index 100%
rename from TextV4/voc/TextV4ToAscii.Mod
rename to tools/TextV4/voc/TextV4ToAscii.Mod
rename from TextV4/voc/TextV4ToAscii.Mod
rename to tools/TextV4/voc/TextV4ToAscii.Mod
similarity index 100%
rename from TextV4/voc/TextV4ToText.Mod
rename to tools/TextV4/voc/TextV4ToText.Mod
rename from TextV4/voc/TextV4ToText.Mod
rename to tools/TextV4/voc/TextV4ToText.Mod
diff --git a/TextV4/voc/make.sh b/tools/TextV4/voc/make.sh
similarity index 57%
rename from TextV4/voc/make.sh
rename to tools/TextV4/voc/make.sh
index fb631761a930931fab0cb36baae0dea36fce2340..50e6814d820558e93989066d7be55520379a96c4 100755 (executable)
rename from TextV4/voc/make.sh
rename to tools/TextV4/voc/make.sh
index fb631761a930931fab0cb36baae0dea36fce2340..50e6814d820558e93989066d7be55520379a96c4 100755 (executable)
--- a/TextV4/voc/make.sh
+++ b/tools/TextV4/voc/make.sh
set -e
voc -F ../TextV4.obn TextV4ToAscii.Mod -m TextV4ToText.Mod -m TextV4Print.Mod -m
+mv TextV4ToAscii TextV4.ToAscii
+mv TextV4ToText TextV4.ToText
+mv TextV4Print TextV4.Print
rm -f *.o *.sym *.h *.c