DEADSOFTWARE

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