DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / dsw-obn.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Добавлены строки в отладочную информацию класса (быстрохак)
[dsw-obn.git] / tools / Coco / CRX.obn
1 MODULE CRX; (* H.Moessenboeck 17.11.93 *)
2
3 IMPORT Oberon, Texts, Sets, CRS, CRT, SYSTEM;
4
5 CONST
6 symSetSize = 100;
7 maxTerm = 3; (* sets of size < maxTerm are enumerated *)
8
9 tErr = 0; altErr = 1; syncErr = 2;
10 EOL = 0DX;
11
12 VAR
13 maxSS: INTEGER; (* number of symbol sets *)
14 errorNr: INTEGER; (* highest parser error number *)
15 curSy: INTEGER; (* symbol whose production is currently generated *)
16 err, w: Texts.Writer;
17 fram: Texts.Reader;
18 src: Texts.Reader;
19 syn: Texts.Writer;
20 scanner: ARRAY 32 OF CHAR;
21 symSet: ARRAY symSetSize OF CRT.Set;
22
23
24 PROCEDURE Restriction(n: INTEGER);
25 BEGIN
26 Texts.WriteLn(w); Texts.WriteString(w, "Restriction ");
27 Texts.WriteInt(w, n, 0); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf);
28 HALT(99)
29 END Restriction;
30
31 PROCEDURE PutS(s: ARRAY OF CHAR);
32 VAR i: INTEGER;
33 BEGIN i := 0;
34 WHILE (i < LEN(s)) & (s[i] # 0X) DO
35 IF s[i] = "$" THEN Texts.WriteLn(syn) ELSE Texts.Write(syn, s[i]) END;
36 INC(i)
37 END
38 END PutS;
39
40 PROCEDURE PutI(i: INTEGER);
41 BEGIN Texts.WriteInt(syn, i, 0)
42 END PutI;
43
44 PROCEDURE Indent(n: INTEGER);
45 VAR i: INTEGER;
46 BEGIN i := 0; WHILE i < n DO Texts.Write(syn, " "); INC(i) END
47 END Indent;
48
49 PROCEDURE PutSet(s: SET);
50 VAR i: INTEGER; first: BOOLEAN;
51 BEGIN
52 i := 0; first := TRUE;
53 WHILE i < Sets.size DO
54 IF i IN s THEN
55 IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END;
56 PutI(i)
57 END;
58 INC(i)
59 END
60 END PutSet;
61
62 PROCEDURE PutSet1(s: CRT.Set);
63 VAR i: INTEGER; first: BOOLEAN;
64 BEGIN
65 i := 0; first := TRUE;
66 WHILE i <= CRT.maxT DO
67 IF Sets.In(s, i) THEN
68 IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END;
69 PutI(i)
70 END;
71 INC(i)
72 END
73 END PutSet1;
74
75 PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER;
76 VAR i: INTEGER;
77 BEGIN
78 i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
79 RETURN i
80 END Length;
81
82 PROCEDURE Alternatives(gp: INTEGER): INTEGER;
83 VAR gn: CRT.GraphNode; n: INTEGER;
84 BEGIN
85 n := 0;
86 WHILE gp > 0 DO
87 CRT.GetNode(gp, gn); gp := gn.p2; INC(n)
88 END;
89 RETURN n
90 END Alternatives;
91
92 PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file <fram> to file <syn> until <stopStr>*)
93 VAR ch, startCh: CHAR; i, j, high: INTEGER;
94 BEGIN
95 startCh := stopStr[0]; high := Length(stopStr) - 1; Texts.Read (fram, ch);
96 WHILE ch # 0X DO
97 IF ch = startCh THEN (* check if stopString occurs *)
98 i := 0;
99 REPEAT
100 IF i = high THEN RETURN END; (*stopStr[0..i] found; no unrecognized character*)
101 Texts.Read (fram, ch); INC(i);
102 UNTIL ch # stopStr[i];
103 (*stopStr[0..i-1] found; 1 unrecognized character*)
104 j := 0; WHILE j < i DO Texts.Write(syn, stopStr[j]); INC(j) END
105 ELSE Texts.Write (syn, ch); Texts.Read(fram, ch)
106 END
107 END
108 END CopyFramePart;
109
110 PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER);
111 (*Copy sequence <position> from <src> to <syn>*)
112 VAR ch: CHAR; i: INTEGER; nChars: LONGINT; r: Texts.Reader;
113 BEGIN
114 IF (pos.beg >= 0) & (pos.len > 0) THEN
115 Texts.OpenReader(r, CRS.src, pos.beg); Texts.Read(r, ch);
116 nChars := pos.len - 1;
117 Indent(indent);
118 LOOP
119 WHILE ch = EOL DO
120 Texts.WriteLn(syn); Indent(indent);
121 IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
122 i := pos.col;
123 WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *)
124 IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END;
125 DEC(i)
126 END
127 END;
128 Texts.Write (syn, ch);
129 IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
130 END
131 END
132
133 (* IF pos.beg >= 0 THEN
134 Texts.OpenReader(r, CRS.src, pos.beg);
135 nChars := pos.len; col := pos.col - 1; ch := " ";
136 WHILE (nChars > 0) & (ch = " ") DO (*skip leading blanks*)
137 Texts.Read(r, ch); DEC(nChars); INC(col)
138 END;
139 Indent(indent);
140 LOOP
141 WHILE ch = EOL DO
142 Texts.WriteLn(syn); Indent(indent);
143 IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
144 i := col - 1;
145 WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *)
146 IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END;
147 DEC(i)
148 END
149 END;
150 Texts.Write (syn, ch);
151 IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
152 END (* LOOP *)
153 END *)
154 END CopySourcePart;
155
156 PROCEDURE GenErrorMsg (errTyp, errSym: INTEGER; VAR errNr: INTEGER);
157 VAR i: INTEGER; name: ARRAY 32 OF CHAR; sn: CRT.SymbolNode;
158 BEGIN
159 INC (errorNr); errNr := errorNr;
160 CRT.GetSym (errSym, sn); COPY(sn.name, name);
161 i := 0; WHILE name[i] # 0X DO IF name[i] = CHR(34) THEN name[i] := "'" END; INC(i) END;
162 Texts.WriteString(err, " |");
163 Texts.WriteInt (err, errNr, 3); Texts.WriteString (err, ": Msg("); Texts.Write(err, CHR(34));
164 CASE errTyp OF
165 | tErr : Texts.WriteString (err, name); Texts.WriteString (err, " expected")
166 | altErr : Texts.WriteString (err, "invalid "); Texts.WriteString (err, name)
167 | syncErr: Texts.WriteString (err, "this symbol not expected in "); Texts.WriteString (err, name)
168 END;
169 Texts.Write(err, CHR(34)); Texts.Write(err, ")"); Texts.WriteLn(err)
170 END GenErrorMsg;
171
172 PROCEDURE NewCondSet (set: CRT.Set): INTEGER;
173 VAR i: INTEGER;
174 BEGIN
175 i := 1; (*skip symSet[0]*)
176 WHILE i <= maxSS DO
177 IF Sets.Equal(set, symSet[i]) THEN RETURN i END;
178 INC(i)
179 END;
180 INC(maxSS); IF maxSS > symSetSize THEN Restriction (9) END;
181 symSet[maxSS] := set;
182 RETURN maxSS
183 END NewCondSet;
184
185 PROCEDURE GenCond (set: CRT.Set);
186 VAR sx, i, n: INTEGER;
187
188 PROCEDURE Small(s: CRT.Set): BOOLEAN;
189 BEGIN
190 i := Sets.size;
191 WHILE i <= CRT.maxT DO
192 IF Sets.In(set, i) THEN RETURN FALSE END;
193 INC(i)
194 END;
195 RETURN TRUE
196 END Small;
197
198 BEGIN
199 n := Sets.Elements(set, i);
200 (*IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
201 ELSIF (n > 1) & Small(set) THEN
202 PutS(" sym IN {"); PutSet(set[0]); PutS("} ")
203 ELSIF n <= maxTerm THEN
204 i := 0;
205 WHILE i <= CRT.maxT DO
206 IF Sets.In (set, i) THEN
207 PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
208 DEC(n); IF n > 0 THEN PutS(" OR") END
209 END;
210 INC(i)
211 END
212 ELSE PutS(" sym IN symSet["); PutI(NewCondSet(set)); PutS(",0]")
213 END;*)
214 IF n = 0 THEN PutS(" FALSE") (*this branch should never be taken*)
215 ELSIF n <= maxTerm THEN
216 i := 0;
217 WHILE i <= CRT.maxT DO
218 IF Sets.In (set, i) THEN
219 PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
220 DEC(n); IF n > 0 THEN PutS(" OR") END
221 END;
222 INC(i)
223 END
224 ELSE PutS(" StartOf("); PutI(NewCondSet(set)); PutS(") ")
225 END;
226
227 END GenCond;
228
229 PROCEDURE GenCode (gp, indent: INTEGER; checked: CRT.Set);
230 VAR gn, gn2: CRT.GraphNode; sn: CRT.SymbolNode; gp2: INTEGER;
231 s1, s2: CRT.Set; errNr, alts: INTEGER; equal: BOOLEAN;
232 BEGIN
233 WHILE gp > 0 DO
234 CRT.GetNode (gp, gn);
235 CASE gn.typ OF
236
237 | CRT.nt:
238 Indent(indent);
239 CRT.GetSym(gn.p1, sn); PutS(sn.name);
240 IF gn.pos.beg >= 0 THEN
241 Texts.Write(syn, "("); CopySourcePart(gn.pos, 0); Texts.Write(syn, ")")
242 END;
243 PutS(";$")
244
245 | CRT.t:
246 CRT.GetSym(gn.p1, sn); Indent(indent);
247 IF Sets.In(checked, gn.p1) THEN
248 PutS("Get;$")
249 ELSE
250 PutS("Expect("); PutI(gn.p1); PutS(");$")
251 END
252
253 | CRT.wt:
254 CRT.CompExpected(ABS(gn.next), curSy, s1);
255 CRT.GetSet(0, s2); Sets.Unite(s1, s2);
256 CRT.GetSym(gn.p1, sn); Indent(indent);
257 PutS("ExpectWeak("); PutI(gn.p1); PutS(", "); PutI(NewCondSet(s1)); PutS(");$")
258
259 | CRT.any:
260 Indent(indent); PutS("Get;$")
261
262 | CRT.eps: (* nothing *)
263
264 | CRT.sem:
265 CopySourcePart(gn.pos, indent); PutS(";$");
266
267 | CRT.sync:
268 CRT.GetSet(gn.p1, s1);
269 GenErrorMsg (syncErr, curSy, errNr);
270 Indent(indent);
271 PutS("WHILE ~("); GenCond(s1); PutS(") DO Error(");
272 PutI(errNr); PutS("); Get END;$")
273
274 | CRT.alt:
275 CRT.CompFirstSet(gp, s1); equal := Sets.Equal(s1, checked);
276 alts := Alternatives(gp);
277 IF alts > 5 THEN Indent(indent); PutS("CASE sym OF$") END;
278 gp2 := gp;
279 WHILE gp2 # 0 DO
280 CRT.GetNode(gp2, gn2);
281 CRT.CompExpected(gn2.p1, curSy, s1);
282 Indent(indent);
283 IF alts > 5 THEN PutS("| "); PutSet1(s1); PutS(": ") (*case labels*)
284 ELSIF gp2 = gp THEN PutS("IF"); GenCond(s1); PutS(" THEN$")
285 ELSIF (gn2.p2 = 0) & equal THEN PutS("ELSE$")
286 ELSE PutS("ELSIF"); GenCond(s1); PutS(" THEN$")
287 END;
288 Sets.Unite(s1, checked);
289 GenCode(gn2.p1, indent + 2, s1);
290 gp2 := gn2.p2
291 END;
292 IF ~ equal THEN
293 GenErrorMsg(altErr, curSy, errNr);
294 Indent(indent); PutS("ELSE Error("); PutI(errNr); PutS(")$")
295 END;
296 Indent(indent); PutS("END;$")
297
298 | CRT.iter:
299 CRT.GetNode(gn.p1, gn2);
300 Indent(indent); PutS("WHILE");
301 IF gn2.typ = CRT.wt THEN
302 CRT.CompExpected(ABS(gn2.next), curSy, s1);
303 CRT.CompExpected(ABS(gn.next), curSy, s2);
304 CRT.GetSym(gn2.p1, sn);
305 PutS(" WeakSeparator("); PutI(gn2.p1); PutS(", "); PutI(NewCondSet(s1));
306 PutS(", "); PutI(NewCondSet(s2)); PutS(") ");
307 Sets.Clear(s1); (*for inner structure*)
308 IF gn2.next > 0 THEN gp2 := gn2.next ELSE gp2 := 0 END
309 ELSE
310 gp2 := gn.p1; CRT.CompFirstSet(gp2, s1); GenCond(s1)
311 END;
312 PutS(" DO$");
313 GenCode(gp2, indent + 2, s1);
314 Indent(indent); PutS("END;$")
315
316 | CRT.opt:
317 CRT.CompFirstSet(gn.p1, s1);
318 IF ~ Sets.Equal(checked, s1) THEN
319 Indent(indent); PutS("IF"); GenCond(s1); PutS(" THEN$");
320 GenCode(gn.p1, indent + 2, s1);
321 Indent(indent); PutS("END;$")
322 ELSE GenCode(gn.p1, indent, checked)
323 END
324
325 END; (*CASE*)
326 IF ~ (gn.typ IN {CRT.eps, CRT.sem, CRT.sync}) THEN Sets.Clear(checked) END;
327 gp := gn.next
328 END
329 END GenCode;
330
331 PROCEDURE GenCodePragmas;
332 VAR i, p: INTEGER; sn: CRT.SymbolNode;
333
334 PROCEDURE P(s1, s2: ARRAY OF CHAR);
335 BEGIN
336 PutS(" "); PutS(scanner); PutS(s1); PutS(" := "); PutS(scanner); PutS(s2); PutS(";$")
337 END P;
338
339 BEGIN
340 i := CRT.maxT + 1;
341 WHILE i <= CRT.maxP DO
342 CRT.GetSym(i, sn);
343 PutS(" IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$ END;$");
344 INC(i)
345 END;
346 P(".nextPos", ".pos"); P(".nextCol", ".col"); P(".nextLine", ".line"); P(".nextLen", ".len")
347 END GenCodePragmas;
348
349 PROCEDURE GenProcedureHeading (sn: CRT.SymbolNode; forward: BOOLEAN);
350 BEGIN
351 PutS("PROCEDURE ");
352 IF forward THEN Texts.Write(syn, "^") END;
353 PutS(sn.name);
354 IF sn.attrPos.beg >= 0 THEN
355 Texts.Write(syn, "("); CopySourcePart(sn.attrPos, 0); Texts.Write(syn, ")")
356 END;
357 PutS(";$")
358 END GenProcedureHeading;
359
360 PROCEDURE GenForwardRefs;
361 VAR sp: INTEGER; sn: CRT.SymbolNode;
362 BEGIN
363 IF ~ CRT.ddt[5] THEN
364 sp := CRT.firstNt;
365 WHILE sp <= CRT.lastNt DO (* for all nonterminals *)
366 CRT.GetSym (sp, sn); GenProcedureHeading(sn, TRUE);
367 INC(sp)
368 END;
369 Texts.WriteLn(syn)
370 END
371 END GenForwardRefs;
372
373 PROCEDURE GenProductions;
374 VAR sn: CRT.SymbolNode; checked: CRT.Set;
375 BEGIN
376 curSy := CRT.firstNt;
377 WHILE curSy <= CRT.lastNt DO (* for all nonterminals *)
378 CRT.GetSym (curSy, sn); GenProcedureHeading (sn, FALSE);
379 IF sn.semPos.beg >= 0 THEN CopySourcePart(sn.semPos, 2); PutS(" $") END;
380 PutS("BEGIN$"); Sets.Clear(checked);
381 GenCode (sn.struct, 2, checked);
382 PutS("END "); PutS(sn.name); PutS(";$$");
383 INC (curSy);
384 END;
385 END GenProductions;
386
387 PROCEDURE InitSets;
388 VAR i, j: INTEGER;
389 BEGIN
390 i := 0; CRT.GetSet(0, symSet[0]);
391 WHILE i <= maxSS DO
392 j := 0;
393 WHILE j <= CRT.maxT DIV Sets.size DO
394 PutS(" symSet["); PutI(i); PutS(", ");PutI(j);
395 PutS("] := {"); PutSet(symSet[i, j]); PutS("};$");
396 INC(j)
397 END;
398 INC(i)
399 END
400 END InitSets;
401
402 PROCEDURE *Show(t: Texts.Text; op: INTEGER; beg, end: LONGINT);
403 BEGIN END Show;
404
405 PROCEDURE GenCompiler*;
406 VAR errNr, i: INTEGER; checked: CRT.Set;
407 gn: CRT.GraphNode; sn: CRT.SymbolNode;
408 parser: ARRAY 32 OF CHAR;
409 t: Texts.Text; pos: LONGINT;
410 ch1, ch2: CHAR;
411 BEGIN
412 CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
413 COPY(sn.name, parser); i := Length(parser); parser[i] := "P"; parser[i+1] := 0X;
414 COPY(parser, scanner); scanner[i] := "S";
415
416 NEW(t); Texts.Open(t, "Parser.FRM"); Texts.OpenReader(fram, t, 0);
417 IF t.len = 0 THEN
418 Texts.WriteString(w, "Parser.FRM not found"); Texts.WriteLn(w);
419 Texts.Append(Oberon.Log, w.buf); HALT(99)
420 END;
421
422 Texts.OpenWriter(err); Texts.WriteLn(err);
423 i := 0;
424 WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END;
425
426 (*----- write *P.Mod -----*)
427 Texts.OpenWriter(syn);
428 NEW(t); t.notify := Show; Texts.Open(t, "");
429 CopyFramePart("-->modulename"); PutS(parser);
430 CopyFramePart("-->scanner"); PutS(scanner);
431 IF CRT.importPos.beg >= 0 THEN PutS(", "); CopySourcePart(CRT.importPos, 0) END;
432 CopyFramePart("-->constants");
433 PutS("maxP = "); PutI(CRT.maxP); PutS(";$");
434 PutS(" maxT = "); PutI(CRT.maxT); PutS(";$");
435 PutS(" nrSets = ;$"); Texts.Append(t, syn.buf); pos := t.len - 2;
436 CopyFramePart("-->declarations"); CopySourcePart(CRT.semDeclPos, 0);
437 CopyFramePart("-->errors"); PutS(scanner); PutS(".Error(n, "); PutS(scanner); PutS(".nextPos)");
438 CopyFramePart("-->scanProc");
439 IF CRT.maxT = CRT.maxP THEN PutS(scanner); PutS(".Get(sym)")
440 ELSE
441 PutS("LOOP "); PutS(scanner); PutS(".Get(sym);$");
442 PutS(" IF sym > maxT THEN$");
443 GenCodePragmas;
444 PutS(" ELSE EXIT$");
445 PutS(" END$");
446 PutS("END$")
447 END;
448 CopyFramePart("-->productions"); GenForwardRefs; GenProductions;
449 CopyFramePart("-->parseRoot"); Sets.Clear(checked); GenCode (CRT.root, 2, checked);
450 CopyFramePart("-->initialization"); InitSets;
451 CopyFramePart("-->modulename"); PutS(parser); Texts.Write(syn, ".");
452 Texts.Append(t, syn.buf); Texts.Append(t, err.buf);
453 PutI(maxSS+1); (*if no set, maxSS = -1*) Texts.Insert(t, pos, syn.buf);
454 i := Length(parser); parser[i] := "."; parser[i+1] := "M"; parser[i+2] := "o"; parser[i+3] := "d"; parser[i+4] := 0X;
455 Texts.Close(t, parser)
456 END GenCompiler;
457
458 PROCEDURE WriteStatistics*;
459 BEGIN
460 Texts.WriteInt (w, CRT.maxT + 1, 0); Texts.WriteString(w, " t, ");
461 Texts.WriteInt (w, CRT.maxSymbols - CRT.firstNt + CRT.maxT + 1, 0); Texts.WriteString(w, " syms, ");
462 Texts.WriteInt (w, CRT.nNodes, 0); Texts.WriteString(w, " nodes, ");
463 Texts.WriteInt (w, maxSS, 0); Texts.WriteString(w, "sets");
464 Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
465 END WriteStatistics;
466
467 PROCEDURE Init*;
468 BEGIN
469 errorNr := -1; maxSS := 0 (*symSet[0] reserved for all SYNC sets*)
470 END Init;
471
472 BEGIN
473 Texts.OpenWriter(w)
474 END CRX.
Another attempt to make Oberon compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024