vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 09:52:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding powerpc target

Browse source
This commit is contained in:
Norayr Chilingarian 2014-01-06 20:30:21 +04:00
parent b18729c519
commit 931dae4763
37 changed files with 2846 additions and 4948 deletions
Download patch file Download diff file Expand all files Collapse all files

376
src/tools/coco/CR.ATG
View file

@ -1,376 +0,0 @@
COMPILER CR (*H.Moessenboeck 17.11.93, Coco/R*)
(*---------------------- semantic declarations ----------------------------*)
IMPORT CRT, CRA, CRX, Sets, Texts := CmdlnTexts, 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.

175
src/tools/coco/CRA.Mod
View file

@ -1,6 +1,14 @@
MODULE CRA; (* handles the DFA *)
(* The following check seems to be unnecessary. It reported an error if a symbol + context
was a prefix of another symbol, e.g.:
s1 = "a" "b" "c".
s2 = "a" CONTEXT("b").
But this is ok
IF t.state.endOf # CRT.noSym THEN
PutS("$Ambiguous CONTEXT clause.$"); correct := FALSE
END*)
MODULE CRA; (* handles the DFA *)
IMPORT Oberon, Texts := CmdlnTexts, Sets, CRS, CRT;
IMPORT Oberon, Texts, Sets, CRS, CRT;
CONST
maxStates = 300;
@ -30,6 +38,9 @@ TYPE
next: Target;
END;
Comment = POINTER TO CommentNode;
CommentNode = RECORD (* info about a comment syntax *)
start,stop: ARRAY 2 OF CHAR;
@ -43,7 +54,6 @@ TYPE
state: State; (* new state *)
next: Melted;
END;
VAR
firstState: State;
@ -53,10 +63,10 @@ VAR
stateNr: INTEGER; (*number of last allocated state*)
firstMelted: Melted; (* list of melted states *)
firstComment: Comment; (* list of comments *)
dirtyDFA: BOOLEAN; (* DFA may be nondeterministic *)
out: Texts.Writer; (* current output *)
fram: Texts.Reader; (* scanner frame input *)
PROCEDURE SemErr(nr: INTEGER);
BEGIN CRS.Error(200+nr, CRS.pos)
END SemErr;
@ -101,8 +111,9 @@ BEGIN
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(")")
Sets.Fill(s1); Sets.Differ(s1, s); PutS("~ "); PutRange(s1)
ELSE
PutS("(");
i := 0;
WHILE i <= top DO
IF hi[i] = lo[i] THEN PutS("(ch="); PutC(lo[i])
@ -113,7 +124,8 @@ BEGIN
Put(")");
IF i < top THEN PutS(" OR ") END;
INC(i)
END
END;
PutS(")");
END
END PutRange;
@ -217,6 +229,7 @@ END NewState;
PROCEDURE NewTransition(from, to: State; typ, sym, tc: INTEGER);
VAR a: Action; t: Target;
BEGIN
IF to = firstState THEN SemErr(21) END;
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)
@ -359,17 +372,33 @@ BEGIN
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;
VAR n: INTEGER; S: ARRAY maxStates OF State; visited: CRT.MarkList;
PROCEDURE NumberNodes (gp: INTEGER; state: State);
VAR gn: CRT.GraphNode;
BEGIN
IF gp = 0 THEN RETURN END; (*end of graph*)
CRT.GetNode(gp, gn);
IF gn.line # 0 THEN RETURN END; (*already visited*)
IF state = NIL 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 final state*)
CASE gn.typ OF
CRT.class, CRT.char: NumberNodes(ABS(gn.next), NIL)
| CRT.opt: NumberNodes(ABS(gn.next), NIL); NumberNodes(gn.p1, state)
| CRT.iter: NumberNodes(ABS(gn.next), state); NumberNodes(gn.p1, state)
| CRT.alt: NumberNodes(gn.p1, state); NumberNodes(gn.p2, state)
END
END NumberNodes;
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
END TheState;
PROCEDURE Step(from: State; gp: INTEGER);
@ -384,45 +413,39 @@ PROCEDURE ConvertToStates*(gp0, sp: INTEGER);
END
END Step;
PROCEDURE FindTrans(gp: INTEGER; state: State);
VAR gn: CRT.GraphNode; new: BOOLEAN;
PROCEDURE FindTrans (gp: INTEGER; start: BOOLEAN);
VAR gn: CRT.GraphNode;
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*)
IF (gp = 0) OR Sets.In(visited, gp) THEN RETURN END;
Sets.Incl(visited, gp); CRT.GetNode(gp, gn);
IF start THEN Step(S[gn.line], gp) END; (*start of group of equally numbered nodes*)
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)
CRT.class, CRT.char: FindTrans(ABS(gn.next), TRUE)
| CRT.opt: FindTrans(ABS(gn.next), TRUE); FindTrans(gn.p1, FALSE)
| CRT.iter: FindTrans(ABS(gn.next), FALSE); FindTrans(gn.p1, FALSE)
| CRT.alt: FindTrans(gn.p1, FALSE); FindTrans(gn.p2, FALSE)
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)
n := 0; NumberNodes(gp0, firstState);
CRT.ClearMarkList(visited); FindTrans(gp0, TRUE)
END ConvertToStates;
PROCEDURE MatchDFA* (s: ARRAY OF CHAR; sp: INTEGER; VAR matchedSp: INTEGER);
VAR state, to: State; a: Action; i, len: INTEGER;
VAR state, to: State; a: Action; i, len: INTEGER; weakMatch: BOOLEAN;
BEGIN (*s with quotes*)
state := firstState; i := 1; len := Length(s) - 1;
state := firstState; i := 1; len := Length(s) - 1; weakMatch := FALSE;
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;
IF a^.typ = CRT.class THEN weakMatch := TRUE END;
state := a.target.state; INC(i)
END;
IF weakMatch & (i < len) THEN state := firstState; i := 1; dirtyDFA := TRUE 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);
@ -542,11 +565,7 @@ VAR
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;
IF t^.state.ctx THEN ctx := TRUE; END;
t := t^.next
END
END GetStateSet;
@ -595,7 +614,6 @@ BEGIN
Texts.Append(Oberon.Log, out.buf)
END MeltStates;
PROCEDURE MakeDeterministic*(VAR correct: BOOLEAN);
VAR state: State; changed: BOOLEAN;
@ -677,56 +695,60 @@ BEGIN
END PrintStates;
PROCEDURE GenComment(com:Comment);
PROCEDURE GenComment(com:Comment; i: INTEGER);
PROCEDURE GenBody;
BEGIN
PutS(" LOOP$");
PutS(" IF "); PutChCond(com^.stop[0]); PutS(" THEN$");
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;$");
PutS(" DEC(level);$");
PutS(" IF level = 0 THEN oldEols := chLine - startLine; NextCh; RETURN TRUE END;$");
PutS(" NextCh;$");
ELSE
PutS(" NextCh;$");
PutS(" IF "); PutChCond(com^.stop[1]); PutS(" THEN$");
PutS(" DEC(level);$");
PutS(" IF level=0 THEN oldEols := chLine - startLine; NextCh; RETURN TRUE END;$");
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;$");
PutS(" END;$");
END;
IF com^.nested THEN
PutS(" ELSIF "); PutChCond(com^.start[0]); PutS(" THEN$");
PutS(" ELSIF "); PutChCond(com^.start[0]); PutS(" THEN$");
IF Length(com^.start) = 1 THEN
PutS(" INC(level); NextCh;$");
PutS(" INC(level); NextCh;$");
ELSE
PutS(" NextCh;$");
PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$");
PutS(" INC(level); NextCh;$");
PutS(" END;$");
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;$");
PutS(" ELSIF ch = EOF THEN RETURN FALSE$");
PutS(" ELSE NextCh END;$");
PutS(" END;$");
END GenBody;
BEGIN
PutS(" IF "); PutChCond(com^.start[0]); PutS(" THEN$");
PutS("PROCEDURE Comment"); PutI(i); PutS("(): BOOLEAN;$");
PutS(" VAR level, startLine: INTEGER; oldLineStart: LONGINT;$");
PutS("BEGIN$");
PutS(" level := 1; startLine := chLine; oldLineStart := lineStart;$");
IF Length(com^.start) = 1 THEN
PutS(" NextCh;$");
PutS(" NextCh;$");
GenBody;
PutS(" END;");
ELSE
PutS(" NextCh;$");
PutS(" IF "); PutChCond(com^.start[1]); PutS(" THEN$");
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;");
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$");
END;
END GenComment;
PutS("END Comment"); PutI(i); PutS(";$$$")
END GenComment;
PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file <fram> to file <out> until <stopStr>*)
@ -829,7 +851,7 @@ PROCEDURE *Show (t: Texts.Text; op: INTEGER; beg, end: LONGINT);
END Show;
PROCEDURE WriteScanner*;
PROCEDURE WriteScanner* (VAR ok: BOOLEAN);
VAR
scanner: ARRAY 32 OF CHAR;
name: ARRAY 64 OF CHAR;
@ -863,6 +885,7 @@ VAR
END FillStartTab;
BEGIN
IF dirtyDFA THEN MakeDeterministic(ok) END;
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;
@ -877,22 +900,22 @@ BEGIN
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;
com := firstComment; i := 0;
WHILE com # NIL DO GenComment(com, i); com := com^.next; INC(i) 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;
PutS("$ IF "); com := firstComment; i := 0;
WHILE com # NIL DO
PutChCond(com^.start[0]);
PutS(" & Comment"); PutI(i); PutS("() ");
IF com^.next # NIL THEN PutS(" OR ") END;
com := com^.next
com := com^.next; INC(i)
END;
PutS(") & Comment() THEN Get(sym); RETURN END;")
PutS(" THEN Get(sym); RETURN END;")
END;
CopyFramePart("-->GetSy2");
state := firstState.next;
@ -912,7 +935,7 @@ BEGIN
END;
CopyFramePart("-->modulename"); PutS(scanner); Put(".");
NEW(t); (*t.notify := Show;*) Texts.Open(t, ""); Texts.Append(t, out.buf);
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;
@ -922,9 +945,11 @@ PROCEDURE Init*;
BEGIN
firstState := NIL; lastState := NIL; stateNr := -1;
rootState := NewState();
firstMelted := NIL; firstComment := NIL
firstMelted := NIL; firstComment := NIL;
dirtyDFA := FALSE
END Init;
BEGIN
Texts.OpenWriter(out)
END CRA.

442
src/tools/coco/CRP.Mod
View file

@ -1,12 +1,12 @@
(* parser module generated by Coco-R *)
MODULE CRP;
IMPORT CRS, CRT, CRA, CRX, Sets, Texts := CmdlnTexts, Oberon;
IMPORT CRS, CRT, CRA, CRX, Sets, Texts, Oberon;
CONST
maxP = 39;
maxT = 38;
nrSets = 18;
maxP = 42;
maxT = 41;
nrSets = 20;
setSize = 32; nSets = (maxT DIV setSize) + 1;
@ -73,7 +73,7 @@ PROCEDURE FixString (VAR s: ARRAY OF CHAR; len: INTEGER);
BEGIN
double := FALSE;
FOR i := 0 TO len-2 DO
IF s[i] = '"' THEN double := TRUE END
IF s[i] = '"' THEN double := TRUE ELSIF s[i] = " " THEN SemErr(24) END
END;
IF ~ double THEN s[0] := '"'; s[len-1] := '"' END
END FixString;
@ -89,9 +89,9 @@ PROCEDURE Get;
BEGIN
LOOP CRS.Get(sym);
IF sym > maxT THEN
IF sym = 39 THEN
IF sym = 42 THEN
CRS.GetName(CRS.nextPos, CRS.nextLen, str); SetDDT(str)
END;
END ;
CRS.nextPos := CRS.pos;
CRS.nextCol := CRS.col;
CRS.nextLine := CRS.line;
@ -161,22 +161,22 @@ BEGIN
ELSE (*string*)
CRT.StrToGraph(name, gL, gR)
END ;
ELSIF (sym = 23) THEN
ELSIF (sym = 24) THEN
Get;
TokenExpr(gL, gR);
Expect(24);
ELSIF (sym = 28) THEN
Expect(25);
ELSIF (sym = 29) THEN
Get;
TokenExpr(gL, gR);
Expect(29);
Expect(30);
CRT.MakeOption(gL, gR) ;
ELSIF (sym = 30) THEN
ELSIF (sym = 31) THEN
Get;
TokenExpr(gL, gR);
Expect(31);
Expect(32);
CRT.MakeIteration(gL, gR) ;
ELSE Error(39)
END;
ELSE Error(42)
END ;
END TokenFactor;
PROCEDURE TokenTerm(VAR gL, gR: INTEGER);
@ -186,14 +186,14 @@ BEGIN
WHILE StartOf(1) DO
TokenFactor(gL2, gR2);
CRT.ConcatSeq(gL, gR, gL2, gR2) ;
END;
IF (sym = 33) THEN
END ;
IF (sym = 34) THEN
Get;
Expect(23);
Expect(24);
TokenExpr(gL2, gR2);
SetCtx(gL2); CRT.ConcatSeq(gL, gR, gL2, gR2) ;
Expect(24);
END;
Expect(25);
END ;
END TokenTerm;
PROCEDURE Factor(VAR gL, gR: INTEGER);
@ -205,10 +205,10 @@ PROCEDURE Factor(VAR gL, gR: INTEGER);
BEGIN
gL :=0; gR := 0; weak := FALSE ;
CASE sym OF
| 1,2,27: IF (sym = 27) THEN
| 1,2,28: IF (sym = 28) THEN
Get;
weak := TRUE ;
END;
END ;
Symbol(name, kind);
sp := CRT.FindSym(name); undef := sp = CRT.noSym;
IF undef THEN
@ -225,7 +225,7 @@ BEGIN
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
IF (sym = 35) OR (sym = 37) THEN
Attribs(pos);
CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn);
CRT.GetSym(sp, sn);
@ -237,30 +237,30 @@ BEGIN
ELSIF StartOf(2) THEN
CRT.GetSym(sp, sn);
IF sn.attrPos.beg >= 0 THEN SemErr(6) END ;
ELSE Error(40)
END;
| 23: Get;
ELSE Error(43)
END ;
| 24: Get;
Expression(gL, gR);
Expect(24);
| 28: Get;
Expect(25);
| 29: Get;
Expression(gL, gR);
Expect(29);
Expect(30);
CRT.MakeOption(gL, gR) ;
| 30: Get;
| 31: Get;
Expression(gL, gR);
Expect(31);
Expect(32);
CRT.MakeIteration(gL, gR) ;
| 36: SemText(pos);
| 39: SemText(pos);
gL := CRT.NewNode(CRT.sem, 0, 0);
gR := gL;
CRT.GetNode(gL, gn); gn.pos := pos; CRT.PutNode(gL, gn) ;
| 25: Get;
| 26: Get;
Sets.Fill(set); Sets.Excl(set, CRT.eofSy);
gL := CRT.NewNode(CRT.any, CRT.NewSet(set), 0); gR := gL ;
| 32: Get;
| 33: Get;
gL := CRT.NewNode(CRT.sync, 0, 0); gR := gL ;
ELSE Error(41)
END;
ELSE Error(44)
END ;
END Factor;
PROCEDURE Term(VAR gL, gR: INTEGER);
@ -272,11 +272,11 @@ BEGIN
WHILE StartOf(3) DO
Factor(gL2, gR2);
CRT.ConcatSeq(gL, gR, gL2, gR2) ;
END;
END ;
ELSIF StartOf(4) THEN
gL := CRT.NewNode(CRT.eps, 0, 0); gR := gL ;
ELSE Error(42)
END;
ELSE Error(45)
END ;
END Term;
PROCEDURE Symbol(VAR name: CRT.Name; VAR kind: INTEGER);
@ -287,8 +287,8 @@ BEGIN
ELSIF (sym = 2) THEN
Get;
kind := string ;
ELSE Error(43)
END;
ELSE Error(46)
END ;
CRS.GetName(CRS.pos, CRS.len, name);
IF kind = string THEN FixString(name, CRS.len) END ;
END Symbol;
@ -310,10 +310,10 @@ BEGIN
WHILE s[i] # s[0] DO
Sets.Incl(set, ORD(s[i])); INC(i)
END ;
ELSIF (sym = 22) THEN
ELSIF (sym = 23) THEN
Get;
Expect(23);
Expect(3);
Expect(24);
Expect(4);
CRS.GetName(CRS.pos, CRS.len, name);
n := 0; i := 0;
WHILE name[i] # 0X DO
@ -321,20 +321,20 @@ BEGIN
INC(i)
END;
Sets.Clear(set); Sets.Incl(set, n) ;
Expect(24);
ELSIF (sym = 25) THEN
Expect(25);
ELSIF (sym = 26) THEN
Get;
Sets.Fill(set) ;
ELSE Error(44)
END;
ELSE Error(47)
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
WHILE (sym = 21) OR (sym = 22) DO
IF (sym = 21) THEN
Get;
SimSet(set2);
Sets.Unite(set, set2) ;
@ -342,8 +342,8 @@ BEGIN
Get;
SimSet(set2);
Sets.Differ(set, set2) ;
END;
END;
END ;
END ;
END Set;
PROCEDURE TokenExpr(VAR gL, gR: INTEGER);
@ -351,13 +351,13 @@ PROCEDURE TokenExpr(VAR gL, gR: INTEGER);
BEGIN
TokenTerm(gL, gR);
first := TRUE ;
WHILE WeakSeparator(26, 1, 5) DO
WHILE WeakSeparator(27, 1, 5) DO
TokenTerm(gL2, gR2);
IF first THEN
CRT.MakeFirstAlt(gL, gR); first := FALSE
END;
CRT.ConcatAlt(gL, gR, gL2, gR2) ;
END;
END ;
END TokenExpr;
PROCEDURE TokenDecl(typ: INTEGER);
@ -371,11 +371,11 @@ BEGIN
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
WHILE ~( StartOf(6) ) DO Error(48); Get END ;
IF (sym = 9) THEN
Get;
TokenExpr(gL, gR);
Expect(9);
Expect(10);
IF kind # ident THEN SemErr(13) END;
CRT.CompleteGraph(gR);
CRA.ConvertToStates(gL, sp) ;
@ -383,13 +383,13 @@ BEGIN
IF kind = ident THEN genScanner := FALSE
ELSE MatchLiteral(sp)
END ;
ELSE Error(46)
END;
IF (sym = 36) THEN
ELSE Error(49)
END ;
IF (sym = 39) THEN
SemText(pos);
IF typ = CRT.t THEN SemErr(14) END;
CRT.GetSym(sp, sn); sn.semPos := pos; CRT.PutSym(sp, sn) ;
END;
END ;
END TokenDecl;
PROCEDURE SetDecl;
@ -398,10 +398,10 @@ BEGIN
Expect(1);
CRS.GetName(CRS.pos, CRS.len, name);
c := CRT.ClassWithName(name); IF c >= 0 THEN SemErr(7) END ;
Expect(8);
Expect(9);
Set(set);
c := CRT.NewClass(name, set) ;
Expect(9);
Expect(10);
END SetDecl;
PROCEDURE Expression(VAR gL, gR: INTEGER);
@ -409,80 +409,99 @@ PROCEDURE Expression(VAR gL, gR: INTEGER);
BEGIN
Term(gL, gR);
first := TRUE ;
WHILE WeakSeparator(26, 2, 8) DO
WHILE WeakSeparator(27, 2, 8) DO
Term(gL2, gR2);
IF first THEN
CRT.MakeFirstAlt(gL, gR); first := FALSE
END;
CRT.ConcatAlt(gL, gR, gL2, gR2) ;
END;
END ;
END Expression;
PROCEDURE SemText(VAR semPos: CRT.Position);
BEGIN
Expect(36);
Expect(39);
semPos.beg := CRS.nextPos; semPos.col := CRS.nextCol ;
WHILE StartOf(9) DO
Get;
END;
Expect(37);
semPos.len := SHORT(CRS.pos - semPos.beg) ;
IF StartOf(10) THEN
Get;
ELSIF (sym = 3) THEN
Get;
SemErr(18) ;
ELSE
Get;
SemErr(19) ;
END ;
END ;
Expect(40);
semPos.len := 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
IF (sym = 35) THEN
Get;
END;
Expect(35);
attrPos.len := SHORT(CRS.pos - attrPos.beg) ;
attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol ;
WHILE StartOf(11) DO
Get;
END ;
Expect(36);
attrPos.len := CRS.pos - attrPos.beg ;
ELSIF (sym = 37) THEN
Get;
attrPos.beg := CRS.nextPos; attrPos.col := CRS.nextCol ;
WHILE StartOf(12) DO
Get;
END ;
Expect(38);
attrPos.len := CRS.pos - attrPos.beg ;
ELSE Error(50)
END ;
END Attribs;
PROCEDURE Declaration;
VAR gL1, gR1, gL2, gR2: INTEGER; nested: BOOLEAN;
BEGIN
IF (sym = 11) THEN
IF (sym = 12) THEN
Get;
WHILE (sym = 1) DO
SetDecl;
END;
ELSIF (sym = 12) THEN
Get;
WHILE (sym = 1) OR (sym = 2) DO
TokenDecl(CRT.t);
END;
END ;
ELSIF (sym = 13) THEN
Get;
WHILE (sym = 1) OR (sym = 2) DO
TokenDecl(CRT.pr);
END;
TokenDecl(CRT.t);
END ;
ELSIF (sym = 14) THEN
Get;
Expect(15);
TokenExpr(gL1, gR1);
WHILE (sym = 1) OR (sym = 2) DO
TokenDecl(CRT.pr);
END ;
ELSIF (sym = 15) THEN
Get;
Expect(16);
TokenExpr(gL1, gR1);
Expect(17);
TokenExpr(gL2, gR2);
IF (sym = 17) THEN
IF (sym = 18) THEN
Get;
nested := TRUE ;
ELSIF StartOf(11) THEN
ELSIF StartOf(13) THEN
nested := FALSE ;
ELSE Error(47)
END;
ELSE Error(51)
END ;
CRA.NewComment(gL1, gL2, nested) ;
ELSIF (sym = 18) THEN
ELSIF (sym = 19) THEN
Get;
IF (sym = 19) THEN
IF (sym = 20) THEN
Get;
CRT.ignoreCase := TRUE ;
ELSIF StartOf(12) THEN
ELSIF StartOf(14) THEN
Set(CRT.ignored);
ELSE Error(48)
END;
ELSE Error(49)
END;
ELSE Error(52)
END ;
ELSE Error(53)
END ;
END Declaration;
PROCEDURE CR;
@ -491,7 +510,7 @@ PROCEDURE CR;
gn: CRT.GraphNode; sn: CRT.SymbolNode;
name, gramName: CRT.Name;
BEGIN
Expect(4);
Expect(5);
Texts.OpenWriter(w);
CRT.Init; CRX.Init; CRA.Init;
gramLine := CRS.line;
@ -503,28 +522,28 @@ BEGIN
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
WHILE StartOf(15) DO
IF (sym = 6) THEN
Get;
CRT.importPos.beg := CRS.nextPos ;
WHILE StartOf(14) DO
WHILE StartOf(16) DO
Get;
END;
Expect(6);
CRT.importPos.len := SHORT(CRS.pos - CRT.importPos.beg);
END ;
Expect(7);
CRT.importPos.len := 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);
END ;
END ;
CRT.semDeclPos.len := CRS.nextPos - CRT.semDeclPos.beg;
CRT.semDeclPos.col := 0 ;
WHILE StartOf(15) DO
WHILE StartOf(17) DO
Declaration;
END;
WHILE ~( (sym = 0) OR (sym = 7)) DO Error(50); Get END;
Expect(7);
END ;
WHILE ~( (sym = 0) OR (sym = 8)) DO Error(54); Get END ;
Expect(8);
IF genScanner THEN CRA.MakeDeterministic(ok) END;
CRT.nNodes := 0 ;
WHILE (sym = 1) DO
@ -543,23 +562,23 @@ BEGIN
sn.line := CRS.line
END;
hasAttrs := sn.attrPos.beg >= 0 ;
IF (sym = 34) THEN
IF (sym = 35) OR (sym = 37) THEN
Attribs(sn.attrPos);
IF ~undef & ~hasAttrs THEN SemErr(9) END;
CRT.PutSym(sp, sn) ;
ELSIF (sym = 8) OR (sym = 36) THEN
ELSIF (sym = 9) OR (sym = 39) THEN
IF ~undef & hasAttrs THEN SemErr(10) END ;
ELSE Error(51)
END;
IF (sym = 36) THEN
ELSE Error(55)
END ;
IF (sym = 39) THEN
SemText(sn.semPos);
END;
ExpectWeak(8, 16);
END ;
ExpectWeak(9, 18);
Expression(sn.struct, gR);
CRT.CompleteGraph(gR); CRT.PutSym(sp, sn);
IF CRT.ddt[2] THEN CRT.PrintGraph END ;
ExpectWeak(9, 17);
END;
ExpectWeak(10, 19);
END ;
sp := CRT.FindSym(gramName);
IF sp = CRT.noSym THEN SemErr(11);
ELSE
@ -567,7 +586,7 @@ BEGIN
IF sn.attrPos.beg >= 0 THEN SemErr(12) END;
CRT.root := CRT.NewNode(CRT.nt, sp, gramLine);
END ;
Expect(10);
Expect(11);
Expect(1);
CRS.GetName(CRS.pos, CRS.len, name);
IF name # gramName THEN SemErr(17) END;
@ -589,7 +608,7 @@ BEGIN
IF genScanner THEN
Texts.WriteString(w, " +scanner");
Texts.Append(Oberon.Log, w.buf);
CRA.WriteScanner
CRA.WriteScanner(ok)
END;
IF CRT.ddt[8] THEN CRX.WriteStatistics END
END
@ -598,7 +617,7 @@ BEGIN
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);
Expect(10);
END CR;
@ -611,93 +630,102 @@ BEGIN
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[0, 0] := {0,1,2,8,9,12,13,14,15,19};
symSet[0, 1] := {7};
symSet[1, 0] := {1,2,24,29,31};
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[2, 0] := {1,2,10,24,25,26,27,28,29,30,31};
symSet[2, 1] := {0,1,7};
symSet[3, 0] := {1,2,24,26,28,29,31};
symSet[3, 1] := {1,7};
symSet[4, 0] := {10,25,27,30};
symSet[4, 1] := {0};
symSet[5, 0] := {8,10,12,13,14,15,17,18,19,25,30};
symSet[5, 1] := {0};
symSet[6, 0] := {0,1,2,8,9,12,13,14,15,19};
symSet[6, 1] := {7};
symSet[7, 0] := {1,2,8,12,13,14,15,19};
symSet[7, 1] := {7};
symSet[8, 0] := {10,25,30};
symSet[8, 1] := {0};
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};
symSet[9, 1] := {0,1,2,3,4,5,6,7,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,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,3,4,5,6,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] := {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[11, 1] := {0,1,2,3,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[12, 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[12, 1] := {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[13, 0] := {8,12,13,14,15,19};
symSet[13, 1] := {};
symSet[14, 0] := {1,2,23,26};
symSet[14, 1] := {};
symSet[15, 0] := {1,2,3,4,5,6,7,9,10,11,16,17,18,20,21,22,23,24,25,26,27,28,29,30,31};
symSet[15, 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[16, 0] := {1,2,3,4,5,6,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[16, 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[17, 0] := {12,13,14,15,19};
symSet[17, 1] := {};
symSet[18, 0] := {0,1,2,8,9,10,12,13,14,15,19,24,26,27,28,29,31};
symSet[18, 1] := {1,7};
symSet[19, 0] := {0,1,2,8,9,11,12,13,14,15,19};
symSet[19, 1] := {7};
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")
| 3: Msg("badString expected")
| 4: Msg("number expected")
| 5: Msg("'COMPILER' expected")
| 6: Msg("'IMPORT' expected")
| 7: Msg("';' expected")
| 8: Msg("'PRODUCTIONS' expected")
| 9: Msg("'=' expected")
| 10: Msg("'.' expected")
| 11: Msg("'END' expected")
| 12: Msg("'CHARACTERS' expected")
| 13: Msg("'TOKENS' expected")
| 14: Msg("'PRAGMAS' expected")
| 15: Msg("'COMMENTS' expected")
| 16: Msg("'FROM' expected")
| 17: Msg("'TO' expected")
| 18: Msg("'NESTED' expected")
| 19: Msg("'IGNORE' expected")
| 20: Msg("'CASE' expected")
| 21: Msg("'+' expected")
| 22: Msg("'-' expected")
| 23: Msg("'CHR' expected")
| 24: Msg("'(' expected")
| 25: Msg("')' expected")
| 26: Msg("'ANY' expected")
| 27: Msg("'|' expected")
| 28: Msg("'WEAK' expected")
| 29: Msg("'[' expected")
| 30: Msg("']' expected")
| 31: Msg("'{' expected")
| 32: Msg("'}' expected")
| 33: Msg("'SYNC' expected")
| 34: Msg("'CONTEXT' expected")
| 35: Msg("'<' expected")
| 36: Msg("'>' expected")
| 37: Msg("'<.' expected")
| 38: Msg("'.>' expected")
| 39: Msg("'(.' expected")
| 40: Msg("'.)' expected")
| 41: Msg("??? expected")
| 42: Msg("invalid TokenFactor")
| 43: Msg("invalid Factor")
| 44: Msg("invalid Factor")
| 45: Msg("invalid Term")
| 46: Msg("invalid Symbol")
| 47: Msg("invalid SimSet")
| 48: Msg("this symbol not expected in TokenDecl")
| 49: Msg("invalid TokenDecl")
| 50: Msg("invalid Attribs")
| 51: Msg("invalid Declaration")
| 52: Msg("invalid Declaration")
| 53: Msg("invalid Declaration")
| 54: Msg("this symbol not expected in CR")
| 55: Msg("invalid CR")

133
src/tools/coco/CRS.Mod
View file

@ -7,7 +7,7 @@ CONST
EOL = 0DX;
EOF = 0X;
maxLexLen = 127;
noSym = 38;
noSym = 41;
TYPE
ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT);
@ -35,8 +35,11 @@ VAR
PROCEDURE NextCh; (*return global variable ch*)
BEGIN
Texts.Read(r, ch); INC(chPos);
IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END
IF oldEols > 0 THEN DEC(oldEols); ch := EOL
ELSE
Texts.Read(r, ch); INC(chPos);
IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END
END
END NextCh;
@ -52,8 +55,9 @@ BEGIN (*Comment*)
IF (ch ="*") THEN
NextCh;
IF (ch =")") THEN
DEC(level); oldEols := chLine - startLine; NextCh;
IF level=0 THEN RETURN TRUE END
DEC(level);
IF level=0 THEN oldEols := chLine - startLine; NextCh; RETURN TRUE END;
NextCh;
END;
ELSIF (ch ="(") THEN
NextCh;
@ -79,33 +83,33 @@ VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR;
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
| "A": IF lexeme = "ANY" THEN sym := 26
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
| "C": IF lexeme = "CASE" THEN sym := 20
ELSIF lexeme = "CHARACTERS" THEN sym := 12
ELSIF lexeme = "CHR" THEN sym := 23
ELSIF lexeme = "COMMENTS" THEN sym := 15
ELSIF lexeme = "COMPILER" THEN sym := 5
ELSIF lexeme = "CONTEXT" THEN sym := 34
END
| "E": IF lexeme = "END" THEN sym := 10
| "E": IF lexeme = "END" THEN sym := 11
END
| "F": IF lexeme = "FROM" THEN sym := 15
| "F": IF lexeme = "FROM" THEN sym := 16
END
| "I": IF lexeme = "IGNORE" THEN sym := 18
ELSIF lexeme = "IMPORT" THEN sym := 5
| "I": IF lexeme = "IGNORE" THEN sym := 19
ELSIF lexeme = "IMPORT" THEN sym := 6
END
| "N": IF lexeme = "NESTED" THEN sym := 17
| "N": IF lexeme = "NESTED" THEN sym := 18
END
| "P": IF lexeme = "PRAGMAS" THEN sym := 13
ELSIF lexeme = "PRODUCTIONS" THEN sym := 7
| "P": IF lexeme = "PRAGMAS" THEN sym := 14
ELSIF lexeme = "PRODUCTIONS" THEN sym := 8
END
| "S": IF lexeme = "SYNC" THEN sym := 32
| "S": IF lexeme = "SYNC" THEN sym := 33
END
| "T": IF lexeme = "TO" THEN sym := 16
ELSIF lexeme = "TOKENS" THEN sym := 12
| "T": IF lexeme = "TO" THEN sym := 17
ELSIF lexeme = "TOKENS" THEN sym := 13
END
| "W": IF lexeme = "WEAK" THEN sym := 27
| "W": IF lexeme = "WEAK" THEN sym := 28
END
ELSE
END
@ -129,42 +133,50 @@ BEGIN
| 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
| 2: sym := 2; RETURN
| 3: sym := 3; RETURN
| 4: IF (ch>="0") & (ch<="9") THEN
ELSE sym := 4; RETURN
END;
| 5: IF (ch>="0") & (ch<="9") THEN
ELSE sym := 3; RETURN
ELSE sym := 42; RETURN
END;
| 6: IF (ch>="0") & (ch<="9") THEN
ELSE sym := 39; RETURN
| 6: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="!") OR (ch>="#") THEN
ELSIF (ch=CHR(13)) THEN state := 3;
ELSIF (ch =CHR(34)) THEN state := 2;
ELSE sym := noSym; RETURN
END;
| 7: sym := 6; RETURN
| 8: sym := 8; RETURN
| 9: IF (ch =")") THEN state := 22;
ELSE sym := 9; RETURN
| 7: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="&") OR (ch>="(") THEN
ELSIF (ch=CHR(13)) THEN state := 3;
ELSIF (ch ="'") THEN state := 2;
ELSE sym := noSym; RETURN
END;
| 8: sym := 7; RETURN
| 9: sym := 9; RETURN
| 10: IF (ch =">") THEN state := 23;
ELSIF (ch =")") THEN state := 25;
ELSE sym := 10; RETURN
END;
| 10: sym := 20; RETURN
| 11: sym := 21; RETURN
| 12: IF (ch =".") THEN state := 21;
ELSE sym := 23; RETURN
| 12: sym := 22; RETURN
| 13: IF (ch =".") THEN state := 24;
ELSE sym := 24; RETURN
END;
| 13: sym := 24; RETURN
| 14: sym := 26; RETURN
| 15: sym := 28; RETURN
| 14: sym := 25; RETURN
| 15: sym := 27; RETURN
| 16: sym := 29; RETURN
| 17: sym := 30; RETURN
| 18: sym := 31; RETURN
| 19: sym := 34; RETURN
| 20: sym := 35; RETURN
| 19: sym := 32; RETURN
| 20: IF (ch =".") THEN state := 22;
ELSE sym := 35; RETURN
END;
| 21: sym := 36; RETURN
| 22: sym := 37; RETURN
| 23: sym := 0; ch := 0X; RETURN
| 23: sym := 38; RETURN
| 24: sym := 39; RETURN
| 25: sym := 40; RETURN
| 26: sym := 0; ch := 0X; RETURN
END (*CASE*)
ELSE sym := noSym; RETURN (*NextCh already done*)
@ -195,7 +207,7 @@ BEGIN
END Reset;
BEGIN
start[0]:=23; start[1]:=0; start[2]:=0; start[3]:=0;
start[0]:=26; 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;
@ -203,28 +215,29 @@ BEGIN
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[32]:=0; start[33]:=0; start[34]:=6; start[35]:=0;
start[36]:=5; start[37]:=0; start[38]:=0; start[39]:=7;
start[40]:=13; start[41]:=14; start[42]:=0; start[43]:=11;
start[44]:=0; start[45]:=12; start[46]:=10; start[47]:=0;
start[48]:=4; start[49]:=4; start[50]:=4; start[51]:=4;
start[52]:=4; start[53]:=4; start[54]:=4; start[55]:=4;
start[56]:=4; start[57]:=4; start[58]:=0; start[59]:=8;
start[60]:=20; start[61]:=9; start[62]:=21; 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[88]:=1; start[89]:=1; start[90]:=1; start[91]:=16;
start[92]:=0; start[93]:=17; 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;
start[120]:=1; start[121]:=1; start[122]:=1; start[123]:=18;
start[124]:=15; start[125]:=19; start[126]:=0; start[127]:=0;
END CRS.

20
src/tools/coco/CRT.Mod
View file

@ -1,6 +1,6 @@
MODULE CRT; (* H.Moessenboeck 17.11.93, Cocol-R Tables *)
MODULE CRT; (* Cocol-R Tables *)
IMPORT Texts := CmdlnTexts, Oberon, Sets;
IMPORT Texts := CmdlnTexts,(* Oberon, Sets;
CONST
maxSymbols* = 300; (*max nr of t, nt, and pragmas*)
@ -27,7 +27,7 @@ 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*)
len*: LONGINT; (*length*)
col*: INTEGER; (*column number of start position*)
END;
@ -129,7 +129,7 @@ BEGIN
HALT(99)
END Restriction;
PROCEDURE ClearMarkList(VAR m: MarkList);
PROCEDURE ClearMarkList*(VAR m: MarkList);
VAR i: INTEGER;
BEGIN
i := 0; WHILE i < maxNodes DIV Sets.size DO m[i] := {}; INC(i) END;
@ -303,10 +303,10 @@ PROCEDURE CompFollowSets;
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)
IF i = curSy THEN Sets.Excl(follow[i].nts, j) END
END;
INC(j)
END;
END
END Complete;
BEGIN (* CompFollowSets *)
@ -323,7 +323,7 @@ BEGIN (* CompFollowSets *)
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);
@ -945,9 +945,8 @@ PROCEDURE TestIfNtToTerm* (VAR ok: BOOLEAN);
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;
IF (gn.typ = nt) & ~ Sets.In(termList, gn.p1) THEN RETURN FALSE END;
IF (gn.typ = alt) & ~ IsTerm(gn.p1) & ((gn.p2 = 0) OR ~IsTerm(gn.p2)) THEN RETURN FALSE END;
gp := gn.next
END;
RETURN TRUE
@ -992,3 +991,4 @@ BEGIN (* CRT *)
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.

163
src/tools/coco/CRX.Mod
View file

@ -1,11 +1,11 @@
MODULE CRX; (* H.Moessenboeck 17.11.93 *)
MODULE CRX;
IMPORT Oberon, Texts := CmdlnTexts, Sets, CRS, CRT, SYSTEM;
IMPORT Oberon, Texts, Sets, CRS, CRT, SYSTEM;
CONST
CONST
symSetSize = 100;
maxTerm = 3; (* sets of size < maxTerm are enumerated *)
tErr = 0; altErr = 1; syncErr = 2;
EOL = 0DX;
@ -23,7 +23,7 @@ VAR
PROCEDURE Restriction(n: INTEGER);
BEGIN
Texts.WriteLn(w); Texts.WriteString(w, "Restriction ");
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;
@ -32,7 +32,7 @@ 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;
IF s[i] = "$" THEN Texts.WriteLn(syn) ELSE Texts.Write(syn, s[i]) END ;
INC(i)
END
END PutS;
@ -52,9 +52,9 @@ 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;
IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END ;
PutI(i)
END;
END ;
INC(i)
END
END PutSet;
@ -65,9 +65,9 @@ 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;
IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END ;
PutI(i)
END;
END ;
INC(i)
END
END PutSet1;
@ -75,7 +75,7 @@ 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;
i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END ;
RETURN i
END Length;
@ -85,7 +85,7 @@ BEGIN
n := 0;
WHILE gp > 0 DO
CRT.GetNode(gp, gn); gp := gn.p2; INC(n)
END;
END ;
RETURN n
END Alternatives;
@ -97,7 +97,7 @@ BEGIN
IF ch = startCh THEN (* check if stopString occurs *)
i := 0;
REPEAT
IF i = high THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*)
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*)
@ -107,7 +107,7 @@ BEGIN
END
END CopyFramePart;
PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER);
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
@ -118,13 +118,13 @@ BEGIN
LOOP
WHILE ch = EOL DO
Texts.WriteLn(syn); Indent(indent);
IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
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;
IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END ;
DEC(i)
END
END;
END ;
Texts.Write (syn, ch);
IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
END
@ -135,18 +135,18 @@ BEGIN
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;
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;
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;
IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END ;
DEC(i)
END
END;
END ;
Texts.Write (syn, ch);
IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
END (* LOOP *)
@ -154,18 +154,18 @@ BEGIN
END CopySourcePart;
PROCEDURE GenErrorMsg (errTyp, errSym: INTEGER; VAR errNr: INTEGER);
VAR i: INTEGER; name: ARRAY 32 OF CHAR; sn: CRT.SymbolNode;
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;
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;
END ;
Texts.Write(err, CHR(34)); Texts.Write(err, ")"); Texts.WriteLn(err)
END GenErrorMsg;
@ -174,27 +174,27 @@ PROCEDURE NewCondSet (set: CRT.Set): 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;
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;
IF Sets.In(set, i) THEN RETURN FALSE END ;
INC(i)
END;
END ;
RETURN TRUE
END Small;
BEGIN
n := Sets.Elements(set, i);
(*IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
@ -206,11 +206,11 @@ BEGIN
IF Sets.In (set, i) THEN
PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
DEC(n); IF n > 0 THEN PutS(" OR") END
END;
END ;
INC(i)
END
ELSE PutS(" sym IN symSet["); PutI(NewCondSet(set)); PutS(",0]")
END;*)
END ;*)
IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
ELSIF n <= maxTerm THEN
i := 0;
@ -218,12 +218,12 @@ BEGIN
IF Sets.In (set, i) THEN
PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
DEC(n); IF n > 0 THEN PutS(" OR") END
END;
END ;
INC(i)
END
ELSE PutS(" StartOf("); PutI(NewCondSet(set)); PutS(") ")
END;
END ;
END GenCond;
PROCEDURE GenCode (gp, indent: INTEGER; checked: CRT.Set);
@ -233,15 +233,15 @@ 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;
END ;
PutS(";$")
| CRT.t:
CRT.GetSym(gn.p1, sn); Indent(indent);
IF Sets.In(checked, gn.p1) THEN
@ -249,32 +249,32 @@ BEGIN
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:
| CRT.sem:
CopySourcePart(gn.pos, indent); PutS(";$");
| CRT.sync:
CRT.GetSet(gn.p1, s1);
GenErrorMsg (syncErr, curSy, errNr);
Indent(indent);
Indent(indent);
PutS("WHILE ~("); GenCond(s1); PutS(") DO Error(");
PutI(errNr); PutS("); Get END;$")
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;
IF alts > 5 THEN Indent(indent); PutS("CASE sym OF$") END ;
gp2 := gp;
WHILE gp2 # 0 DO
CRT.GetNode(gp2, gn2);
@ -284,16 +284,16 @@ BEGIN
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;
END ;
Sets.Unite(s1, checked);
GenCode(gn2.p1, indent + 2, s1);
gp2 := gn2.p2
END;
END ;
IF ~ equal THEN
GenErrorMsg(altErr, curSy, errNr);
Indent(indent); PutS("ELSE Error("); PutI(errNr); PutS(")$")
END;
Indent(indent); PutS("END;$")
END ;
Indent(indent); PutS("END ;$")
| CRT.iter:
CRT.GetNode(gn.p1, gn2);
@ -302,58 +302,58 @@ BEGIN
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(" 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;
END ;
PutS(" DO$");
GenCode(gp2, indent + 2, s1);
Indent(indent); PutS("END;$")
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;$")
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;
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
WHILE i <= CRT.maxP DO
CRT.GetSym(i, sn);
PutS(" IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$ END;$");
PutS(" IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$ END ;$");
INC(i)
END;
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;
IF forward THEN Texts.Write(syn, "^") END ;
PutS(sn.name);
IF sn.attrPos.beg >= 0 THEN
IF sn.attrPos.beg >= 0 THEN
Texts.Write(syn, "("); CopySourcePart(sn.attrPos, 0); Texts.Write(syn, ")")
END;
END ;
PutS(";$")
END GenProcedureHeading;
@ -365,7 +365,7 @@ BEGIN
WHILE sp <= CRT.lastNt DO (* for all nonterminals *)
CRT.GetSym (sp, sn); GenProcedureHeading(sn, TRUE);
INC(sp)
END;
END ;
Texts.WriteLn(syn)
END
END GenForwardRefs;
@ -376,26 +376,26 @@ 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;
IF sn.semPos.beg >= 0 THEN CopySourcePart(sn.semPos, 2); PutS(" $") END ;
PutS("BEGIN$"); Sets.Clear(checked);
GenCode (sn.struct, 2, checked);
GenCode (sn.struct, 2, checked);
PutS("END "); PutS(sn.name); PutS(";$$");
INC (curSy);
END;
END ;
END GenProductions;
PROCEDURE InitSets;
VAR i, j: INTEGER;
BEGIN
i := 0; CRT.GetSet(0, symSet[0]);
WHILE i <= maxSS DO
WHILE i <= maxSS DO
j := 0;
WHILE j <= CRT.maxT DIV Sets.size DO
PutS(" symSet["); PutI(i); PutS(", ");PutI(j);
PutS(" symSet["); PutI(i); PutS(", ");PutI(j);
PutS("] := {"); PutSet(symSet[i, j]); PutS("};$");
INC(j)
END;
INC(i)
END ;
INC(i)
END
END InitSets;
@ -406,29 +406,29 @@ 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;
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;
END ;
Texts.OpenWriter(err); Texts.WriteLn(err);
i := 0;
WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END;
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, "");
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;
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(";$");
@ -444,7 +444,7 @@ BEGIN
PutS(" ELSE EXIT$");
PutS(" END$");
PutS("END$")
END;
END ;
CopyFramePart("-->productions"); GenForwardRefs; GenProductions;
CopyFramePart("-->parseRoot"); Sets.Clear(checked); GenCode (CRT.root, 2, checked);
CopyFramePart("-->initialization"); InitSets;
@ -472,3 +472,4 @@ END Init;
BEGIN
Texts.OpenWriter(w)
END CRX.

124
src/tools/coco/Coco.Mod
View file

@ -19,7 +19,7 @@
==========================================================================*)
MODULE Coco;
IMPORT Oberon, (*TextFrames,*) Texts := CmdlnTexts,(* Viewers,*) CRS, CRP, CRT;
IMPORT Oberon, TextFrames, Texts, Viewers, CRS, CRP, CRT;
CONST minErrDist = 8;
@ -42,55 +42,59 @@ BEGIN
| 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")
| 3: Msg("badString expected")
| 4: Msg("number expected")
| 5: Msg("'COMPILER' expected")
| 6: Msg("'IMPORT' expected")
| 7: Msg("';' expected")
| 8: Msg("'PRODUCTIONS' expected")
| 9: Msg("'=' expected")
| 10: Msg("'.' expected")
| 11: Msg("'END' expected")
| 12: Msg("'CHARACTERS' expected")
| 13: Msg("'TOKENS' expected")
| 14: Msg("'PRAGMAS' expected")
| 15: Msg("'COMMENTS' expected")
| 16: Msg("'FROM' expected")
| 17: Msg("'TO' expected")
| 18: Msg("'NESTED' expected")
| 19: Msg("'IGNORE' expected")
| 20: Msg("'CASE' expected")
| 21: Msg("'+' expected")
| 22: Msg("'-' expected")
| 23: Msg("'CHR' expected")
| 24: Msg("'(' expected")
| 25: Msg("')' expected")
| 26: Msg("'ANY' expected")
| 27: Msg("'|' expected")
| 28: Msg("'WEAK' expected")
| 29: Msg("'[' expected")
| 30: Msg("']' expected")
| 31: Msg("'{' expected")
| 32: Msg("'}' expected")
| 33: Msg("'SYNC' expected")
| 34: Msg("'CONTEXT' expected")
| 35: Msg("'<' expected")
| 36: Msg("'>' expected")
| 37: Msg("'<.' expected")
| 38: Msg("'.>' expected")
| 39: Msg("'(.' expected")
| 40: Msg("'.)' expected")
| 41: Msg("??? expected")
| 42: Msg("invalid TokenFactor")
| 43: Msg("invalid Factor")
| 44: Msg("invalid Factor")
| 45: Msg("invalid Term")
| 46: Msg("invalid Symbol")
| 47: Msg("invalid SimSet")
| 48: Msg("this symbol not expected in TokenDecl")
| 49: Msg("invalid TokenDecl")
| 50: Msg("invalid Attribs")
| 51: Msg("invalid Declaration")
| 52: Msg("invalid Declaration")
| 53: Msg("invalid Declaration")
| 54: Msg("this symbol not expected in CR")
| 55: Msg("invalid CR")
ELSE Texts.WriteString(w, "error "); Texts.WriteInt(w, n, 0)
END
ELSE
@ -112,11 +116,13 @@ BEGIN
| 215: Msg("undefined name")
| 216: Msg("attributes not allowed in token declaration")
| 217: Msg("name does not match name in heading")
| 218: Msg("bad string in semantic action")
| 219: Msg("Missing end of previous semantic action")
| 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:
| 224: Msg("tokens must not contain blanks")
| 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)
@ -128,7 +134,7 @@ END Error;
PROCEDURE Options(VAR s: Texts.Scanner);
VAR i: INTEGER;
BEGIN
IF s.nextCh = "/" THEN Texts.Scan(s); Texts.Scan(s);
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
@ -142,19 +148,19 @@ END Options;
PROCEDURE Compile*;
VAR (*v: Viewers.Viewer;*)(* f: TextFrames.Frame; *) s: Texts.Scanner; src, t: Texts.Text;
VAR v: Viewers.Viewer; f: TextFrames.Frame; 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);
Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
f := Oberon.Par.frame(TextFrames.Frame);
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;*)
END;
IF s.class = Texts.Name THEN
NEW(src); Texts.Open(src, s.s);
(*ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
v := Oberon.MarkedViewer();
IF (v # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
src := v.dsc.next(TextFrames.Frame).text;
@ -162,7 +168,7 @@ BEGIN
END
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*)
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);
@ -175,6 +181,6 @@ BEGIN
END Compile;
BEGIN
Texts.OpenWriter(w);
Compile;
Texts.OpenWriter(w)
END Coco.

5
src/tools/coco/Coco.Report.ps.1
View file

File diff suppressed because one or more lines are too long

83
src/tools/coco/Coco.Tool
View file

@ -1,83 +0,0 @@
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}.þ

8
src/tools/coco/Oberon.Mod
View file

@ -1,8 +0,0 @@
MODULE Oberon;
IMPORT Texts := CmdlnTexts;
VAR Log* : Texts.Text;
END Oberon.

65
src/tools/coco/Parser.FRM
View file

@ -1,65 +0,0 @@
(* 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.

103
src/tools/coco/Scanner.FRM
View file

@ -1,103 +0,0 @@
(* scanner module generated by Coco-R *)
MODULE -->modulename;
IMPORT Texts := CmdlnTexts, 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.

138
src/tools/coco/Sets.Mod
View file

@ -1,138 +0,0 @@
MODULE Sets;
IMPORT Texts := CmdlnTexts;
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.

471
src/tools/coco/v4_compat/Oberon.Mod
View file

@ -1,471 +0,0 @@
MODULE Oberon; (*JG 6.9.90 / 23.9.93*)
IMPORT SYSTEM, Unix, Kernel, Modules, Input, Display, Fonts, Viewers, Texts, X11; (* << *)
CONST
(*message ids*)
consume* = 0; track* = 1;
defocus* = 0; neutralize* = 1; mark* = 2;
BasicCycle = 20;
ESC = 1BX; SETUP = 0A4X;
TYPE
Painter* = PROCEDURE (x, y: INTEGER);
Marker* = RECORD Fade*, Draw*: Painter END;
Cursor* = RECORD
marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
END;
ParList* = POINTER TO ParRec;
ParRec* = RECORD
vwr*: Viewers.Viewer;
frame*: Display.Frame;
text*: Texts.Text;
pos*: LONGINT
END;
InputMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
keys*: SET;
X*, Y*: INTEGER;
ch*: CHAR;
fnt*: Fonts.Font;
col*, voff*: SHORTINT
END;
SelectionMsg* = RECORD (Display.FrameMsg)
time*: LONGINT;
text*: Texts.Text;
beg*, end*: LONGINT
END;
ControlMsg* = RECORD (Display.FrameMsg)
id*, X*, Y*: INTEGER
END;
CopyOverMsg* = RECORD (Display.FrameMsg)
text*: Texts.Text;
beg*, end*: LONGINT
END;
CopyMsg* = RECORD (Display.FrameMsg)
F*: Display.Frame
END;
Task* = POINTER TO TaskDesc;
Handler* = PROCEDURE;
TaskDesc* = RECORD
next: Task;
safe*: BOOLEAN;
time*: LONGINT;
handle*: Handler
END;
VAR
User*: ARRAY 12 OF CHAR; (* << *)
Arrow*, Star*: Marker;
Mouse*, Pointer*: Cursor;
FocusViewer*: Viewers.Viewer;
Log*: Texts.Text;
Par*: ParList; (*actual parameters*)
CurTask*, PrevTask: Task;
CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
Password*: LONGINT;
DW, DH, CL, H0, H1, H2, H3: INTEGER;
unitW: INTEGER;
ActCnt: INTEGER; (*action count for GC*)
Mod: Modules.Module;
ArrowFade: Painter; (* << *)
(*user identification*)
PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
VAR i: INTEGER; a, b, c: LONGINT;
BEGIN
a := 0; b := 0; i := 0;
WHILE s[i] # 0X DO
c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]);
INC(i)
END;
IF b >= 32768 THEN b := b - 65536 END;
RETURN b * 65536 + a
END Code;
PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR);
BEGIN COPY(user, User); Password := Code(password)
END SetUser;
(*clocks*)
PROCEDURE GetClock* (VAR t, d: LONGINT);
BEGIN Kernel.GetClock(t, d)
END GetClock;
PROCEDURE SetClock* (t, d: LONGINT);
BEGIN Kernel.SetClock(t, d)
END SetClock;
PROCEDURE Time* (): LONGINT;
BEGIN RETURN Input.Time()
END Time;
(*cursor handling*)
PROCEDURE FlipArrow (X, Y: INTEGER); (* << *)
END FlipArrow;
PROCEDURE FlipStar (X, Y: INTEGER);
BEGIN
IF X < CL THEN
IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END
ELSE
IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END
END ;
IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END;
Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2)
END FlipStar;
PROCEDURE OpenCursor* (VAR c: Cursor);
BEGIN c.on := FALSE; c.X := 0; c.Y := 0
END OpenCursor;
PROCEDURE FadeCursor* (VAR c: Cursor);
BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END
END FadeCursor;
PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER); (* << RC *)
BEGIN
IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN
c.marker.Fade(c.X, c.Y); c.on := FALSE
END;
IF c.marker.Fade = ArrowFade THEN
IF m.Fade # ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.noCursor) END
ELSE
IF m.Fade = ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.arrow) END
END ;
IF ~c.on THEN
m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE
END
END DrawCursor;
(*display management*)
PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER);
BEGIN
IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN
FadeCursor(Mouse)
END;
IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN
FadeCursor(Pointer)
END
END RemoveMarks;
PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg);
BEGIN
WITH V: Viewers.Viewer DO
IF M IS InputMsg THEN
WITH M: InputMsg DO
IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
END;
ELSIF M IS ControlMsg THEN
WITH M: ControlMsg DO
IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
END
ELSIF M IS Viewers.ViewerMsg THEN
WITH M: Viewers.ViewerMsg DO
IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN
RemoveMarks(V.X, V.Y, V.W, V.H);
Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0)
ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN
RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y);
Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0)
END
END
END
END
END HandleFiller;
PROCEDURE OpenDisplay* (UW, SW, H: INTEGER);
VAR Filler: Viewers.Viewer;
BEGIN
Input.SetMouseLimits(Viewers.curW + UW + SW, H);
Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0);
NEW(Filler); Filler.handle := HandleFiller;
Viewers.InitTrack(UW, H, Filler); (*init user track*)
NEW(Filler); Filler.handle := HandleFiller;
Viewers.InitTrack(SW, H, Filler) (*init system track*)
END OpenDisplay;
PROCEDURE DisplayWidth* (X: INTEGER): INTEGER;
BEGIN RETURN DW
END DisplayWidth;
PROCEDURE DisplayHeight* (X: INTEGER): INTEGER;
BEGIN RETURN DH
END DisplayHeight;
PROCEDURE OpenTrack* (X, W: INTEGER);
VAR Filler: Viewers.Viewer;
BEGIN
NEW(Filler); Filler.handle := HandleFiller;
Viewers.OpenTrack(X, W, Filler)
END OpenTrack;
PROCEDURE UserTrack* (X: INTEGER): INTEGER;
BEGIN RETURN X DIV DW * DW
END UserTrack;
PROCEDURE SystemTrack* (X: INTEGER): INTEGER;
BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5
END SystemTrack;
PROCEDURE UY (X: INTEGER): INTEGER;
VAR fil, bot, alt, max: Display.Frame;
BEGIN
Viewers.Locate(X, 0, fil, bot, alt, max);
IF fil.H >= DH DIV 8 THEN RETURN DH END;
RETURN max.Y + max.H DIV 2
END UY;
PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER);
BEGIN
IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
ELSE X := DX DIV DW * DW; Y := UY(X)
END
END AllocateUserViewer;
PROCEDURE SY (X: INTEGER): INTEGER;
VAR fil, bot, alt, max: Display.Frame;
BEGIN
Viewers.Locate(X, DH, fil, bot, alt, max);
IF fil.H >= DH DIV 8 THEN RETURN DH END;
IF max.H >= DH - H0 THEN RETURN max.Y + H3 END;
IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END;
IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END;
IF max # bot THEN RETURN max.Y + max.H DIV 2 END;
IF bot.H >= H1 THEN RETURN bot.H DIV 2 END;
RETURN alt.Y + alt.H DIV 2
END SY;
PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER);
BEGIN
IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X)
END
END AllocateSystemViewer;
PROCEDURE MarkedViewer* (): Viewers.Viewer;
BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
END MarkedViewer;
PROCEDURE PassFocus* (V: Viewers.Viewer);
VAR M: ControlMsg;
BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V
END PassFocus;
(*command interpretation*)
PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);
VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
BEGIN res := 1;
i := 0; j := 0;
WHILE name[j] # 0X DO
IF name[j] = "." THEN i := j END;
INC(j)
END;
IF i > 0 THEN
name[i] := 0X;
Mod := Modules.ThisMod(name);
IF Modules.res = 0 THEN
INC(i); j := i;
WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END;
name[j - i] := 0X;
P := Modules.ThisCommand(Mod, name);
IF Modules.res = 0 THEN
Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P; res := 0
ELSE res := -1
END
ELSE res := Modules.res
END
ELSE res := -1
END
END Call;
PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
VAR M: SelectionMsg;
BEGIN
M.time := -1; Viewers.Broadcast(M); time := M.time;
IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END
END GetSelection;
PROCEDURE GC;
BEGIN IF ActCnt <= 0 THEN Kernel.GC(FALSE); ActCnt := BasicCycle END
END GC;
PROCEDURE Install* (T: Task);
VAR t: Task;
BEGIN t := PrevTask;
WHILE (t.next # PrevTask) & (t.next # T) DO t := t.next END;
IF (t.next # T) & (CurTask # T) THEN
IF CurTask # NIL THEN (* called from a task *)
T.next := CurTask.next; CurTask.next := T
ELSE (* no task is currently running *)
T.next := PrevTask.next; PrevTask.next := T
END
END
END Install;
PROCEDURE Remove* (T: Task);
VAR t: Task;
BEGIN t := PrevTask;
WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END;
IF t.next = T THEN t.next := t.next.next; PrevTask := t.next END;
IF CurTask = T THEN CurTask := PrevTask.next END
END Remove;
PROCEDURE Collect* (count: INTEGER);
BEGIN ActCnt := count
END Collect;
PROCEDURE SetFont* (fnt: Fonts.Font);
BEGIN CurFnt := fnt
END SetFont;
PROCEDURE SetColor* (col: SHORTINT);
BEGIN CurCol := col
END SetColor;
PROCEDURE SetOffset* (voff: SHORTINT);
BEGIN CurOff := voff
END SetOffset;
PROCEDURE MinTime(): LONGINT; (* << *)
VAR minTime: LONGINT; t: Task;
BEGIN
minTime := MAX(LONGINT); t := PrevTask;
REPEAT
IF (t.time # -1) & (t.time < minTime) THEN minTime := t.time END ;
t := t.next;
UNTIL t = PrevTask ;
RETURN minTime
END MinTime;
PROCEDURE NotifyTasks; (* << *)
VAR t0, p: Task;
BEGIN t0 := PrevTask;
REPEAT
CurTask := PrevTask.next;
IF CurTask.time = -1 THEN
IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
p := CurTask; CurTask.handle; PrevTask.next := CurTask;
IF CurTask # p THEN RETURN END (*detect Remove(CurTask)*)
END;
PrevTask := CurTask
UNTIL CurTask = t0
END NotifyTasks;
PROCEDURE Loop*;
VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg;
prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR;
VM: Viewers.ViewerMsg; i: INTEGER; res: LONGINT; (* << *)
BEGIN
res := Kernel.sigsetjmp(Kernel.trapEnv, 1); (* << *)
LOOP
CurTask := NIL;
Input.Mouse(keys, X, Y);
IF Input.Available() > 0 THEN Input.Read(ch);
IF ch < 0F0X THEN
IF ch = ESC THEN
N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer)
ELSIF ch = SETUP THEN
N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N)
ELSIF ch = 0CX THEN (* << *)
N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer);
VM.id := Viewers.suspend; Viewers.Broadcast(VM);
VM.id := Viewers.restore; Viewers.Broadcast(VM)
ELSE
M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff;
FocusViewer.handle(FocusViewer, M);
DEC(ActCnt); NotifyTasks
END
ELSIF ch = 0F1X THEN Display.SetMode(0, {})
ELSIF ch = 0F2X THEN Display.SetMode(0, {0})
ELSIF ch = 0F3X THEN Display.SetMode(0, {2})
ELSIF ch = 0F4X THEN X11.InitColors
ELSIF Kernel.FKey[ORD(ch) - 0F0H] # NIL THEN Kernel.FKey[ORD(ch) - 0F0H]
END
ELSIF keys # {} THEN
M.id := track; M.X := X; M.Y := Y; M.keys := keys;
REPEAT
V := Viewers.This(M.X, M.Y); V.handle(V, M);
Input.Mouse(M.keys, M.X, M.Y)
UNTIL M.keys = {};
DEC(ActCnt); NotifyTasks
ELSE
IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN
M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.This(X, Y); V.handle(V, M);
prevX := X; prevY := Y
END;
X11.DoSync; (* << *)
IF X11.EventsQueued(X11.display, X11.QueuedAfterReading) = 0 THEN (* << *)
Kernel.Select(MinTime() - Input.Time()); NotifyTasks;
FOR i := 0 TO 7 DO Kernel.readySet[i] := {} END
END ;
CurTask := PrevTask.next;
IF (CurTask.time <= Input.Time()) & (CurTask.time # -1) THEN
IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
CurTask.handle; PrevTask.next := CurTask
END;
PrevTask := CurTask
END
END
END Loop;
BEGIN User[0] := 0X;
Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow;
ArrowFade := FlipArrow; (* << *)
Star.Fade := FlipStar; Star.Draw := FlipStar;
OpenCursor(Mouse); OpenCursor(Pointer);
DW := Display.Width; DH := Display.Height; CL := Display.ColLeft;
H3 := DH - DH DIV 3;
H2 := H3 - H3 DIV 2;
H1 := DH DIV 5;
H0 := DH DIV 10;
(* moved into Configuration.Mod
unitW := DW DIV 8;
OpenDisplay(unitW * 5, unitW * 3, DH);
FocusViewer := Viewers.This(0, 0);
*)
CurFnt := Fonts.Default;
CurCol := Display.white;
CurOff := 0;
Collect(BasicCycle);
NEW(PrevTask);
PrevTask.handle := GC;
PrevTask.safe := TRUE;
PrevTask.time := -1; (* << *)
PrevTask.next := PrevTask;
CurTask := NIL;
Display.SetMode(0, {});
END Oberon.

471
src/tools/coco/v4_compat/Oberon.Mod_orig
View file

@ -1,471 +0,0 @@
MODULE Oberon; (*JG 6.9.90 / 23.9.93*)
IMPORT SYSTEM, Unix, Kernel, Modules, Input, Display, Fonts, Viewers, Texts, X11; (* << *)
CONST
(*message ids*)
consume* = 0; track* = 1;
defocus* = 0; neutralize* = 1; mark* = 2;
BasicCycle = 20;
ESC = 1BX; SETUP = 0A4X;
TYPE
Painter* = PROCEDURE (x, y: INTEGER);
Marker* = RECORD Fade*, Draw*: Painter END;
Cursor* = RECORD
marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
END;
ParList* = POINTER TO ParRec;
ParRec* = RECORD
vwr*: Viewers.Viewer;
frame*: Display.Frame;
text*: Texts.Text;
pos*: LONGINT
END;
InputMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
keys*: SET;
X*, Y*: INTEGER;
ch*: CHAR;
fnt*: Fonts.Font;
col*, voff*: SHORTINT
END;
SelectionMsg* = RECORD (Display.FrameMsg)
time*: LONGINT;
text*: Texts.Text;
beg*, end*: LONGINT
END;
ControlMsg* = RECORD (Display.FrameMsg)
id*, X*, Y*: INTEGER
END;
CopyOverMsg* = RECORD (Display.FrameMsg)
text*: Texts.Text;
beg*, end*: LONGINT
END;
CopyMsg* = RECORD (Display.FrameMsg)
F*: Display.Frame
END;
Task* = POINTER TO TaskDesc;
Handler* = PROCEDURE;
TaskDesc* = RECORD
next: Task;
safe*: BOOLEAN;
time*: LONGINT;
handle*: Handler
END;
VAR
User*: ARRAY 12 OF CHAR; (* << *)
Arrow*, Star*: Marker;
Mouse*, Pointer*: Cursor;
FocusViewer*: Viewers.Viewer;
Log*: Texts.Text;
Par*: ParList; (*actual parameters*)
CurTask*, PrevTask: Task;
CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
Password*: LONGINT;
DW, DH, CL, H0, H1, H2, H3: INTEGER;
unitW: INTEGER;
ActCnt: INTEGER; (*action count for GC*)
Mod: Modules.Module;
ArrowFade: Painter; (* << *)
(*user identification*)
PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
VAR i: INTEGER; a, b, c: LONGINT;
BEGIN
a := 0; b := 0; i := 0;
WHILE s[i] # 0X DO
c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]);
INC(i)
END;
IF b >= 32768 THEN b := b - 65536 END;
RETURN b * 65536 + a
END Code;
PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR);
BEGIN COPY(user, User); Password := Code(password)
END SetUser;
(*clocks*)
PROCEDURE GetClock* (VAR t, d: LONGINT);
BEGIN Kernel.GetClock(t, d)
END GetClock;
PROCEDURE SetClock* (t, d: LONGINT);
BEGIN Kernel.SetClock(t, d)
END SetClock;
PROCEDURE Time* (): LONGINT;
BEGIN RETURN Input.Time()
END Time;
(*cursor handling*)
PROCEDURE FlipArrow (X, Y: INTEGER); (* << *)
END FlipArrow;
PROCEDURE FlipStar (X, Y: INTEGER);
BEGIN
IF X < CL THEN
IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END
ELSE
IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END
END ;
IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END;
Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2)
END FlipStar;
PROCEDURE OpenCursor* (VAR c: Cursor);
BEGIN c.on := FALSE; c.X := 0; c.Y := 0
END OpenCursor;
PROCEDURE FadeCursor* (VAR c: Cursor);
BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END
END FadeCursor;
PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER); (* << RC *)
BEGIN
IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN
c.marker.Fade(c.X, c.Y); c.on := FALSE
END;
IF c.marker.Fade = ArrowFade THEN
IF m.Fade # ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.noCursor) END
ELSE
IF m.Fade = ArrowFade THEN X11.DefineCursor(X11.display, X11.primary, X11.arrow) END
END ;
IF ~c.on THEN
m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE
END
END DrawCursor;
(*display management*)
PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER);
BEGIN
IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN
FadeCursor(Mouse)
END;
IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN
FadeCursor(Pointer)
END
END RemoveMarks;
PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg);
BEGIN
WITH V: Viewers.Viewer DO
IF M IS InputMsg THEN
WITH M: InputMsg DO
IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
END;
ELSIF M IS ControlMsg THEN
WITH M: ControlMsg DO
IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
END
ELSIF M IS Viewers.ViewerMsg THEN
WITH M: Viewers.ViewerMsg DO
IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN
RemoveMarks(V.X, V.Y, V.W, V.H);
Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0)
ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN
RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y);
Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0)
END
END
END
END
END HandleFiller;
PROCEDURE OpenDisplay* (UW, SW, H: INTEGER);
VAR Filler: Viewers.Viewer;
BEGIN
Input.SetMouseLimits(Viewers.curW + UW + SW, H);
Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0);
NEW(Filler); Filler.handle := HandleFiller;
Viewers.InitTrack(UW, H, Filler); (*init user track*)
NEW(Filler); Filler.handle := HandleFiller;
Viewers.InitTrack(SW, H, Filler) (*init system track*)
END OpenDisplay;
PROCEDURE DisplayWidth* (X: INTEGER): INTEGER;
BEGIN RETURN DW
END DisplayWidth;
PROCEDURE DisplayHeight* (X: INTEGER): INTEGER;
BEGIN RETURN DH
END DisplayHeight;
PROCEDURE OpenTrack* (X, W: INTEGER);
VAR Filler: Viewers.Viewer;
BEGIN
NEW(Filler); Filler.handle := HandleFiller;
Viewers.OpenTrack(X, W, Filler)
END OpenTrack;
PROCEDURE UserTrack* (X: INTEGER): INTEGER;
BEGIN RETURN X DIV DW * DW
END UserTrack;
PROCEDURE SystemTrack* (X: INTEGER): INTEGER;
BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5
END SystemTrack;
PROCEDURE UY (X: INTEGER): INTEGER;
VAR fil, bot, alt, max: Display.Frame;
BEGIN
Viewers.Locate(X, 0, fil, bot, alt, max);
IF fil.H >= DH DIV 8 THEN RETURN DH END;
RETURN max.Y + max.H DIV 2
END UY;
PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER);
BEGIN
IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
ELSE X := DX DIV DW * DW; Y := UY(X)
END
END AllocateUserViewer;
PROCEDURE SY (X: INTEGER): INTEGER;
VAR fil, bot, alt, max: Display.Frame;
BEGIN
Viewers.Locate(X, DH, fil, bot, alt, max);
IF fil.H >= DH DIV 8 THEN RETURN DH END;
IF max.H >= DH - H0 THEN RETURN max.Y + H3 END;
IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END;
IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END;
IF max # bot THEN RETURN max.Y + max.H DIV 2 END;
IF bot.H >= H1 THEN RETURN bot.H DIV 2 END;
RETURN alt.Y + alt.H DIV 2
END SY;
PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER);
BEGIN
IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X)
END
END AllocateSystemViewer;
PROCEDURE MarkedViewer* (): Viewers.Viewer;
BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
END MarkedViewer;
PROCEDURE PassFocus* (V: Viewers.Viewer);
VAR M: ControlMsg;
BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V
END PassFocus;
(*command interpretation*)
PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);
VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
BEGIN res := 1;
i := 0; j := 0;
WHILE name[j] # 0X DO
IF name[j] = "." THEN i := j END;
INC(j)
END;
IF i > 0 THEN
name[i] := 0X;
Mod := Modules.ThisMod(name);
IF Modules.res = 0 THEN
INC(i); j := i;
WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END;
name[j - i] := 0X;
P := Modules.ThisCommand(Mod, name);
IF Modules.res = 0 THEN
Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P; res := 0
ELSE res := -1
END
ELSE res := Modules.res
END
ELSE res := -1
END
END Call;
PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
VAR M: SelectionMsg;
BEGIN
M.time := -1; Viewers.Broadcast(M); time := M.time;
IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END
END GetSelection;
PROCEDURE GC;
BEGIN IF ActCnt <= 0 THEN Kernel.GC(FALSE); ActCnt := BasicCycle END
END GC;
PROCEDURE Install* (T: Task);
VAR t: Task;
BEGIN t := PrevTask;
WHILE (t.next # PrevTask) & (t.next # T) DO t := t.next END;
IF (t.next # T) & (CurTask # T) THEN
IF CurTask # NIL THEN (* called from a task *)
T.next := CurTask.next; CurTask.next := T
ELSE (* no task is currently running *)
T.next := PrevTask.next; PrevTask.next := T
END
END
END Install;
PROCEDURE Remove* (T: Task);
VAR t: Task;
BEGIN t := PrevTask;
WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END;
IF t.next = T THEN t.next := t.next.next; PrevTask := t.next END;
IF CurTask = T THEN CurTask := PrevTask.next END
END Remove;
PROCEDURE Collect* (count: INTEGER);
BEGIN ActCnt := count
END Collect;
PROCEDURE SetFont* (fnt: Fonts.Font);
BEGIN CurFnt := fnt
END SetFont;
PROCEDURE SetColor* (col: SHORTINT);
BEGIN CurCol := col
END SetColor;
PROCEDURE SetOffset* (voff: SHORTINT);
BEGIN CurOff := voff
END SetOffset;
PROCEDURE MinTime(): LONGINT; (* << *)
VAR minTime: LONGINT; t: Task;
BEGIN
minTime := MAX(LONGINT); t := PrevTask;
REPEAT
IF (t.time # -1) & (t.time < minTime) THEN minTime := t.time END ;
t := t.next;
UNTIL t = PrevTask ;
RETURN minTime
END MinTime;
PROCEDURE NotifyTasks; (* << *)
VAR t0, p: Task;
BEGIN t0 := PrevTask;
REPEAT
CurTask := PrevTask.next;
IF CurTask.time = -1 THEN
IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
p := CurTask; CurTask.handle; PrevTask.next := CurTask;
IF CurTask # p THEN RETURN END (*detect Remove(CurTask)*)
END;
PrevTask := CurTask
UNTIL CurTask = t0
END NotifyTasks;
PROCEDURE Loop*;
VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg;
prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR;
VM: Viewers.ViewerMsg; i: INTEGER; res: LONGINT; (* << *)
BEGIN
res := Kernel.sigsetjmp(Kernel.trapEnv, 1); (* << *)
LOOP
CurTask := NIL;
Input.Mouse(keys, X, Y);
IF Input.Available() > 0 THEN Input.Read(ch);
IF ch < 0F0X THEN
IF ch = ESC THEN
N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer)
ELSIF ch = SETUP THEN
N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N)
ELSIF ch = 0CX THEN (* << *)
N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer);
VM.id := Viewers.suspend; Viewers.Broadcast(VM);
VM.id := Viewers.restore; Viewers.Broadcast(VM)
ELSE
M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff;
FocusViewer.handle(FocusViewer, M);
DEC(ActCnt); NotifyTasks
END
ELSIF ch = 0F1X THEN Display.SetMode(0, {})
ELSIF ch = 0F2X THEN Display.SetMode(0, {0})
ELSIF ch = 0F3X THEN Display.SetMode(0, {2})
ELSIF ch = 0F4X THEN X11.InitColors
ELSIF Kernel.FKey[ORD(ch) - 0F0H] # NIL THEN Kernel.FKey[ORD(ch) - 0F0H]
END
ELSIF keys # {} THEN
M.id := track; M.X := X; M.Y := Y; M.keys := keys;
REPEAT
V := Viewers.This(M.X, M.Y); V.handle(V, M);
Input.Mouse(M.keys, M.X, M.Y)
UNTIL M.keys = {};
DEC(ActCnt); NotifyTasks
ELSE
IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN
M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.This(X, Y); V.handle(V, M);
prevX := X; prevY := Y
END;
X11.DoSync; (* << *)
IF X11.EventsQueued(X11.display, X11.QueuedAfterReading) = 0 THEN (* << *)
Kernel.Select(MinTime() - Input.Time()); NotifyTasks;
FOR i := 0 TO 7 DO Kernel.readySet[i] := {} END
END ;
CurTask := PrevTask.next;
IF (CurTask.time <= Input.Time()) & (CurTask.time # -1) THEN
IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
CurTask.handle; PrevTask.next := CurTask
END;
PrevTask := CurTask
END
END
END Loop;
BEGIN User[0] := 0X;
Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow;
ArrowFade := FlipArrow; (* << *)
Star.Fade := FlipStar; Star.Draw := FlipStar;
OpenCursor(Mouse); OpenCursor(Pointer);
DW := Display.Width; DH := Display.Height; CL := Display.ColLeft;
H3 := DH - DH DIV 3;
H2 := H3 - H3 DIV 2;
H1 := DH DIV 5;
H0 := DH DIV 10;
(* moved into Configuration.Mod
unitW := DW DIV 8;
OpenDisplay(unitW * 5, unitW * 3, DH);
FocusViewer := Viewers.This(0, 0);
*)
CurFnt := Fonts.Default;
CurCol := Display.white;
CurOff := 0;
Collect(BasicCycle);
NEW(PrevTask);
PrevTask.handle := GC;
PrevTask.safe := TRUE;
PrevTask.time := -1; (* << *)
PrevTask.next := PrevTask;
CurTask := NIL;
Display.SetMode(0, {});
END Oberon.

1363
src/tools/coco/v4_compat/TextFrames.Mod
View file

File diff suppressed because it is too large Load diff

1362
src/tools/coco/v4_compat/TextFrames.Mod_orig
View file

File diff suppressed because it is too large Load diff