]>
Commit | Line | Data |
---|---|---|
7401123f GM |
1 | (* P0SymBuild.mod pass 0 symbol creation. |
2 | ||
3 | Copyright (C) 2011-2021 Free Software Foundation, Inc. | |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. | |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE P0SymBuild ; | |
23 | ||
24 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
25 | FROM M2Printf IMPORT printf0, printf1, printf2 ; | |
26 | FROM Lists IMPORT List, InitList, KillList, IncludeItemIntoList, RemoveItemFromList, NoOfItemsInList, GetItemFromList, IsItemInList ; | |
27 | FROM M2Batch IMPORT MakeDefinitionSource, MakeProgramSource, MakeImplementationSource ; | |
28 | FROM SymbolTable IMPORT NulSym, MakeInnerModule, SetCurrentModule, SetFileModule, MakeError ; | |
29 | FROM NameKey IMPORT Name, NulName ; | |
30 | FROM M2Quads IMPORT PushT, PushTF, PopT, PopTF, PopN, OperandT, PopTtok, PushTtok ; | |
31 | FROM M2Reserved IMPORT ImportTok ; | |
32 | FROM M2Debug IMPORT Assert ; | |
33 | FROM M2MetaError IMPORT MetaErrorT1, MetaErrorT2, MetaError1, MetaError2 ; | |
34 | FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ; | |
e61ec3e2 | 35 | IMPORT M2Error ; |
7401123f GM |
36 | |
37 | ||
38 | CONST | |
39 | Debugging = FALSE ; | |
40 | ||
41 | TYPE | |
42 | Kind = (module, program, defimp, inner, procedure, universe, unknown) ; | |
43 | ||
fd948137 | 44 | BlockInfoPtr = POINTER TO RECORD |
7401123f GM |
45 | name : Name ; |
46 | kind : Kind ; | |
47 | sym : CARDINAL ; | |
48 | level : CARDINAL ; | |
49 | token : CARDINAL ; (* where the block starts. *) | |
50 | LocalModules, (* locally declared modules at the current level *) | |
51 | ImportedModules: List ; (* current list of imports for the scanned module *) | |
52 | toPC, | |
53 | toReturn, | |
54 | toNext, (* next in same level *) | |
55 | toUp, (* return to outer level *) | |
56 | toDown : BlockInfoPtr ; (* first of the inner level *) | |
57 | END ; | |
58 | ||
59 | VAR | |
60 | headBP, | |
61 | curBP : BlockInfoPtr ; | |
62 | Level : CARDINAL ; | |
63 | ||
64 | ||
65 | (* | |
66 | nSpaces - | |
67 | *) | |
68 | ||
69 | PROCEDURE nSpaces (n: CARDINAL) ; | |
70 | BEGIN | |
71 | WHILE n>0 DO | |
72 | printf0(" ") ; | |
73 | DEC(n) | |
74 | END | |
75 | END nSpaces ; | |
76 | ||
77 | ||
78 | (* | |
79 | DisplayB - | |
80 | *) | |
81 | ||
82 | PROCEDURE DisplayB (b: BlockInfoPtr) ; | |
83 | BEGIN | |
84 | CASE b^.kind OF | |
85 | ||
86 | program : printf1("MODULE %a ;\n", b^.name) | | |
87 | defimp : printf1("DEFIMP %a ;\n", b^.name) | | |
88 | inner : printf1("INNER MODULE %a ;\n", b^.name) | | |
89 | procedure: printf1("PROCEDURE %a ;\n", b^.name) | |
90 | ||
91 | ELSE | |
92 | HALT | |
93 | END | |
94 | END DisplayB ; | |
95 | ||
96 | ||
97 | (* | |
98 | DisplayBlock - | |
99 | *) | |
100 | ||
101 | PROCEDURE DisplayBlock (b: BlockInfoPtr; l: CARDINAL) ; | |
102 | VAR | |
103 | a: BlockInfoPtr ; | |
104 | BEGIN | |
105 | nSpaces(l) ; | |
106 | DisplayB(b) ; | |
107 | a := b^.toDown ; | |
108 | INC(l, 3) ; | |
109 | WHILE a#NIL DO | |
110 | DisplayBlock(a, l) ; | |
111 | a := a^.toNext | |
112 | END ; | |
113 | DEC(l, 3) ; | |
114 | nSpaces(l) ; | |
115 | printf1("END %a\n", b^.name) | |
116 | END DisplayBlock ; | |
117 | ||
118 | ||
119 | (* | |
120 | pc - an interactive debugging aid callable from gdb. | |
121 | *) | |
122 | ||
35e03669 | 123 | (* |
7401123f GM |
124 | PROCEDURE pc ; |
125 | BEGIN | |
126 | DisplayB(curBP) | |
127 | END pc ; | |
35e03669 | 128 | *) |
7401123f GM |
129 | |
130 | ||
131 | (* | |
132 | Display - | |
133 | *) | |
134 | ||
135 | PROCEDURE Display ; | |
136 | VAR | |
137 | b: BlockInfoPtr ; | |
138 | BEGIN | |
139 | printf0("Universe of Modula-2 modules\n") ; | |
140 | IF headBP#NIL | |
141 | THEN | |
142 | b := headBP^.toDown ; | |
143 | WHILE b#NIL DO | |
144 | DisplayBlock(b, 0) ; | |
145 | b := b^.toNext | |
146 | END | |
147 | END | |
148 | END Display ; | |
149 | ||
150 | ||
151 | (* | |
152 | addDown - adds, b, to the down link of, a. | |
153 | *) | |
154 | ||
155 | PROCEDURE addDown (a, b: BlockInfoPtr) ; | |
156 | BEGIN | |
157 | IF a^.toDown=NIL | |
158 | THEN | |
159 | a^.toDown := b | |
160 | ELSE | |
161 | a := a^.toDown ; | |
162 | WHILE a^.toNext#NIL DO | |
163 | a := a^.toNext | |
164 | END ; | |
165 | a^.toNext := b | |
166 | END | |
167 | END addDown ; | |
168 | ||
169 | ||
170 | (* | |
171 | GraftBlock - add a new block, b, into the tree in the correct order. | |
172 | *) | |
173 | ||
174 | PROCEDURE GraftBlock (b: BlockInfoPtr) ; | |
175 | BEGIN | |
176 | Assert(curBP#NIL) ; | |
177 | Assert(ABS(Level-curBP^.level)<=1) ; | |
178 | CASE Level-curBP^.level OF | |
179 | ||
180 | -1: (* returning up to the outer scope *) | |
181 | curBP := curBP^.toUp ; | |
182 | Assert(curBP^.toNext=NIL) ; | |
183 | curBP^.toNext := b | | |
184 | 0: (* add toNext *) | |
185 | Assert(curBP^.toNext=NIL) ; | |
186 | curBP^.toNext := b ; | |
187 | b^.toUp := curBP^.toUp | | |
188 | +1: (* insert down a level *) | |
189 | b^.toUp := curBP ; (* save return value *) | |
190 | addDown(curBP, b) | |
191 | ||
192 | ELSE | |
193 | HALT | |
194 | END ; | |
195 | curBP := b | |
196 | END GraftBlock ; | |
197 | ||
198 | ||
199 | (* | |
200 | BeginBlock - denotes the start of the next block. We remember all imports and | |
201 | local modules and procedures created in this block. | |
202 | *) | |
203 | ||
204 | PROCEDURE BeginBlock (n: Name; k: Kind; s: CARDINAL; tok: CARDINAL) ; | |
205 | VAR | |
206 | b: BlockInfoPtr ; | |
207 | BEGIN | |
208 | NEW(b) ; | |
209 | WITH b^ DO | |
210 | name := n ; | |
211 | kind := k ; | |
212 | sym := s ; | |
213 | InitList(LocalModules) ; | |
214 | InitList(ImportedModules) ; | |
215 | toPC := NIL ; | |
216 | toReturn := NIL ; | |
217 | toNext := NIL ; | |
218 | toDown := NIL ; | |
219 | toUp := NIL ; | |
220 | level := Level ; | |
221 | token := tok | |
222 | END ; | |
223 | GraftBlock(b) | |
224 | END BeginBlock ; | |
225 | ||
226 | ||
227 | (* | |
228 | InitUniverse - | |
229 | *) | |
230 | ||
231 | PROCEDURE InitUniverse ; | |
232 | BEGIN | |
233 | NEW(curBP) ; | |
234 | WITH curBP^ DO | |
235 | name := NulName ; | |
236 | kind := universe ; | |
237 | sym := NulSym ; | |
238 | InitList(LocalModules) ; | |
239 | InitList(ImportedModules) ; | |
240 | toNext := NIL ; | |
241 | toDown := NIL ; | |
242 | toUp := curBP ; | |
243 | level := Level | |
244 | END ; | |
245 | headBP := curBP | |
246 | END InitUniverse ; | |
247 | ||
248 | ||
249 | (* | |
250 | FlushImports - | |
251 | *) | |
252 | ||
253 | PROCEDURE FlushImports (b: BlockInfoPtr) ; | |
254 | VAR | |
255 | i, n : CARDINAL ; | |
256 | modname: Name ; | |
7401123f GM |
257 | BEGIN |
258 | WITH b^ DO | |
259 | i := 1 ; | |
35e03669 | 260 | n := NoOfItemsInList (ImportedModules) ; |
7401123f | 261 | WHILE i<=n DO |
35e03669 GM |
262 | modname := GetItemFromList (ImportedModules, i) ; |
263 | sym := MakeDefinitionSource (GetTokenNo (), modname) ; | |
264 | Assert (sym # NulSym) ; | |
265 | INC (i) | |
7401123f GM |
266 | END |
267 | END | |
268 | END FlushImports ; | |
269 | ||
270 | ||
271 | (* | |
272 | EndBlock - shutdown the module and create definition symbols for all imported | |
273 | modules. | |
274 | *) | |
275 | ||
276 | PROCEDURE EndBlock ; | |
277 | BEGIN | |
278 | FlushImports(curBP) ; | |
279 | curBP := curBP^.toUp ; | |
280 | DEC(Level) ; | |
281 | IF Level=0 | |
282 | THEN | |
283 | FlushImports(curBP) | |
284 | END | |
285 | END EndBlock ; | |
286 | ||
287 | ||
288 | (* | |
289 | RegisterLocalModule - register, n, as a local module. | |
290 | *) | |
291 | ||
292 | PROCEDURE RegisterLocalModule (n: Name) ; | |
293 | BEGIN | |
294 | (* printf1('seen local module %a\n', n) ; *) | |
295 | WITH curBP^ DO | |
296 | IncludeItemIntoList(LocalModules, n) ; | |
297 | RemoveItemFromList(ImportedModules, n) | |
298 | END | |
299 | END RegisterLocalModule ; | |
300 | ||
301 | ||
302 | (* | |
303 | RegisterImport - register, n, as a module imported from either a local scope or definition module. | |
304 | *) | |
305 | ||
306 | PROCEDURE RegisterImport (n: Name) ; | |
307 | VAR | |
308 | bp: BlockInfoPtr ; | |
309 | BEGIN | |
310 | (* printf1('register import from module %a\n', n) ; *) | |
311 | Assert(curBP#NIL) ; | |
312 | Assert(curBP^.toUp#NIL) ; | |
313 | bp := curBP^.toUp ; (* skip over current module *) | |
314 | WITH bp^ DO | |
315 | IF NOT IsItemInList(LocalModules, n) | |
316 | THEN | |
317 | IncludeItemIntoList(ImportedModules, n) | |
318 | END | |
319 | END | |
320 | END RegisterImport ; | |
321 | ||
322 | ||
323 | (* | |
324 | RegisterImports - | |
325 | *) | |
326 | ||
327 | PROCEDURE RegisterImports ; | |
328 | VAR | |
329 | i, n: CARDINAL ; | |
330 | BEGIN | |
331 | PopT(n) ; (* n = # of the Ident List *) | |
332 | IF OperandT(n+1)=ImportTok | |
333 | THEN | |
334 | (* Ident list contains Module Names *) | |
335 | i := 1 ; | |
336 | WHILE i<=n DO | |
337 | RegisterImport(OperandT(n+1-i)) ; | |
338 | INC(i) | |
339 | END | |
340 | ELSE | |
341 | (* Ident List contains list of objects *) | |
342 | RegisterImport(OperandT(n+1)) | |
343 | END ; | |
344 | PopN(n+1) (* clear stack *) | |
345 | END RegisterImports ; | |
346 | ||
347 | ||
348 | (* | |
349 | RegisterInnerImports - | |
350 | *) | |
351 | ||
352 | PROCEDURE RegisterInnerImports ; | |
353 | VAR | |
354 | n: CARDINAL ; | |
355 | BEGIN | |
356 | PopT(n) ; (* n = # of the Ident List *) | |
357 | IF OperandT(n+1)=ImportTok | |
358 | THEN | |
359 | (* Ident list contains list of objects, which will be seen outside the scope of this module *) | |
360 | (* | |
361 | i := 1 ; | |
362 | WHILE i<=n DO | |
363 | RegisterImport(OperandT(n+1-i)) ; | |
364 | INC(i) | |
365 | END | |
366 | *) | |
367 | ELSE | |
368 | (* Ident List contains list of objects, but we are importing directly from a module OperandT(n+1) *) | |
369 | RegisterImport(OperandT(n+1)) | |
370 | END ; | |
371 | PopN(n+1) (* clear stack *) | |
372 | END RegisterInnerImports ; | |
373 | ||
374 | ||
375 | (* | |
376 | RegisterProgramModule - register the top of stack as a program module. | |
377 | *) | |
378 | ||
379 | PROCEDURE RegisterProgramModule ; | |
380 | VAR | |
381 | n : Name ; | |
382 | sym: CARDINAL ; | |
383 | tok: CARDINAL ; | |
384 | BEGIN | |
fd948137 GM |
385 | Assert (Level=0) ; |
386 | INC (Level) ; | |
7401123f GM |
387 | PopTtok (n, tok) ; |
388 | PushTtok (n, tok) ; | |
fd948137 GM |
389 | sym := MakeProgramSource (tok, n) ; |
390 | SetCurrentModule (sym) ; | |
391 | SetFileModule (sym) ; | |
392 | BeginBlock (n, program, sym, tok) ; | |
e61ec3e2 | 393 | M2Error.EnterProgramScope (n) |
7401123f GM |
394 | END RegisterProgramModule ; |
395 | ||
396 | ||
397 | (* | |
398 | RegisterImplementationModule - register the top of stack as an implementation module. | |
399 | *) | |
400 | ||
401 | PROCEDURE RegisterImplementationModule ; | |
402 | VAR | |
403 | n : Name ; | |
404 | sym: CARDINAL ; | |
405 | tok: CARDINAL ; | |
406 | BEGIN | |
fd948137 GM |
407 | Assert (Level=0) ; |
408 | INC (Level) ; | |
7401123f GM |
409 | PopTtok (n, tok) ; |
410 | PushTtok (n, tok) ; | |
fd948137 GM |
411 | sym := MakeImplementationSource (tok, n) ; |
412 | SetCurrentModule (sym) ; | |
413 | SetFileModule (sym) ; | |
414 | BeginBlock (n, defimp, sym, tok) ; | |
e61ec3e2 | 415 | M2Error.EnterImplementationScope (n) |
7401123f GM |
416 | END RegisterImplementationModule ; |
417 | ||
418 | ||
419 | (* | |
420 | RegisterDefinitionModule - register the top of stack as a definition module. | |
421 | *) | |
422 | ||
423 | PROCEDURE RegisterDefinitionModule ; | |
424 | VAR | |
425 | n : Name ; | |
426 | sym: CARDINAL ; | |
427 | tok: CARDINAL ; | |
428 | BEGIN | |
429 | Assert(Level=0) ; | |
430 | INC(Level) ; | |
431 | PopTtok (n, tok) ; | |
432 | PushTtok (n, tok) ; | |
fd948137 GM |
433 | sym := MakeDefinitionSource (tok, n) ; |
434 | SetCurrentModule (sym) ; | |
435 | SetFileModule (sym) ; | |
436 | BeginBlock (n, defimp, sym, tok) ; | |
e61ec3e2 | 437 | M2Error.EnterDefinitionScope (n) |
7401123f GM |
438 | END RegisterDefinitionModule ; |
439 | ||
440 | ||
441 | (* | |
442 | RegisterInnerModule - register the top of stack as an inner module, this module name | |
443 | will be removed from the list of outstanding imports in the | |
444 | current module block. | |
445 | *) | |
446 | ||
447 | PROCEDURE RegisterInnerModule ; | |
448 | VAR | |
449 | n : Name ; | |
450 | tok: CARDINAL ; | |
451 | BEGIN | |
452 | INC(Level) ; | |
453 | PopTtok (n, tok) ; | |
454 | PushTtok (n, tok) ; | |
fd948137 GM |
455 | RegisterLocalModule (n) ; |
456 | BeginBlock (n, inner, NulSym, tok) ; | |
e61ec3e2 | 457 | M2Error.EnterModuleScope (n) |
7401123f GM |
458 | END RegisterInnerModule ; |
459 | ||
460 | ||
461 | (* | |
462 | RegisterProcedure - register the top of stack as a procedure. | |
463 | *) | |
464 | ||
465 | PROCEDURE RegisterProcedure ; | |
466 | VAR | |
467 | n : Name ; | |
468 | tok: CARDINAL ; | |
469 | BEGIN | |
470 | INC (Level) ; | |
471 | PopTtok (n, tok) ; | |
472 | PushTtok (n, tok) ; | |
e61ec3e2 GM |
473 | BeginBlock (n, procedure, NulSym, tok) ; |
474 | M2Error.EnterProcedureScope (n) | |
7401123f GM |
475 | END RegisterProcedure ; |
476 | ||
477 | ||
478 | (* | |
479 | EndBuildProcedure - ends building a Procedure. | |
480 | *) | |
481 | ||
482 | PROCEDURE EndProcedure ; | |
483 | VAR | |
484 | NameEnd, NameStart: Name ; | |
485 | end, start : CARDINAL ; | |
486 | BEGIN | |
487 | PopTtok (NameEnd, end) ; | |
488 | PopTtok (NameStart, start) ; | |
489 | Assert (start # UnknownTokenNo) ; | |
490 | Assert (end # UnknownTokenNo) ; | |
491 | IF NameEnd # NameStart | |
492 | THEN | |
493 | IF NameEnd = NulName | |
494 | THEN | |
495 | MetaErrorT1 (start, | |
496 | 'procedure name at beginning {%1Ea} does not match the name at end', | |
497 | MakeError (start, NameStart)) ; | |
498 | MetaError1 ('procedure name at end does not match the name at beginning {%1Ea}', | |
499 | MakeError (start, NameStart)) | |
500 | ELSE | |
501 | MetaErrorT2 (start, | |
502 | 'procedure name at beginning {%1Ea} does not match the name at end {%2a}', | |
503 | MakeError (start, curBP^.name), MakeError (end, NameEnd)) ; | |
504 | MetaErrorT2 (end, | |
505 | 'procedure name at end {%1Ea} does not match the name at beginning {%2Ea}', | |
506 | MakeError (end, NameEnd), MakeError (start, curBP^.name)) | |
507 | END | |
508 | END ; | |
e61ec3e2 | 509 | EndBlock ; |
966f05c8 | 510 | M2Error.LeaveErrorScope |
7401123f GM |
511 | END EndProcedure ; |
512 | ||
513 | ||
514 | (* | |
515 | EndModule - | |
516 | *) | |
517 | ||
518 | PROCEDURE EndModule ; | |
519 | VAR | |
520 | NameEnd, NameStart: Name ; | |
521 | end, start : CARDINAL ; | |
522 | BEGIN | |
523 | PopTtok (NameEnd, end) ; | |
524 | PopTtok (NameStart, start) ; | |
525 | Assert (start # UnknownTokenNo) ; | |
526 | Assert (end # UnknownTokenNo) ; | |
527 | IF NameEnd # NameStart | |
528 | THEN | |
529 | IF NameEnd = NulName | |
530 | THEN | |
531 | MetaErrorT1 (start, | |
532 | 'module name at beginning {%1Ea} does not match the name at end', | |
533 | MakeError (start, NameStart)) ; | |
534 | MetaError1 ('module name at end does not match the name at beginning {%1Ea}', | |
535 | MakeError (start, NameStart)) | |
536 | ELSE | |
537 | MetaErrorT2 (start, | |
538 | 'module name at beginning {%1Ea} does not match the name at end {%2a}', | |
539 | MakeError (start, curBP^.name), MakeError (end, NameEnd)) ; | |
540 | MetaErrorT2 (end, | |
541 | 'module name at end {%1Ea} does not match the name at beginning {%2Ea}', | |
542 | MakeError (end, NameEnd), MakeError (start, curBP^.name)) | |
543 | END | |
544 | END ; | |
e61ec3e2 | 545 | EndBlock ; |
966f05c8 | 546 | M2Error.LeaveErrorScope |
7401123f GM |
547 | END EndModule ; |
548 | ||
549 | ||
550 | (* | |
551 | DeclareModules - declare all inner modules seen at the current block level. | |
552 | *) | |
553 | ||
554 | PROCEDURE DeclareModules ; | |
555 | VAR | |
556 | b: BlockInfoPtr ; | |
557 | s: CARDINAL ; | |
558 | BEGIN | |
559 | b := curBP^.toDown ; | |
35e03669 GM |
560 | WHILE b # NIL DO |
561 | IF b^.kind = inner | |
7401123f GM |
562 | THEN |
563 | IF Debugging | |
564 | THEN | |
35e03669 | 565 | printf1 ("*** declaring inner module %a\n", b^.name) |
7401123f | 566 | END ; |
35e03669 GM |
567 | s := MakeInnerModule (curBP^.token, b^.name) ; |
568 | Assert (s # NulSym) | |
7401123f GM |
569 | END ; |
570 | b := b^.toNext | |
571 | END | |
572 | END DeclareModules ; | |
573 | ||
574 | ||
35e03669 | 575 | (**** |
7401123f GM |
576 | (* |
577 | MoveNext - | |
578 | *) | |
579 | ||
580 | PROCEDURE MoveNext ; | |
581 | VAR | |
582 | b: BlockInfoPtr ; | |
583 | BEGIN | |
584 | IF curBP^.toNext#NIL | |
585 | THEN | |
586 | b := curBP^.toUp ; | |
587 | (* moving to next *) | |
588 | curBP := curBP^.toNext ; | |
589 | (* remember our return *) | |
590 | curBP^.toUp := b | |
591 | END | |
592 | END MoveNext ; | |
593 | ||
594 | ||
595 | (* | |
596 | MoveDown - | |
597 | *) | |
598 | ||
599 | PROCEDURE MoveDown ; | |
600 | VAR | |
601 | b: BlockInfoPtr ; | |
602 | BEGIN | |
603 | (* move down a level *) | |
604 | (* remember where we came from *) | |
605 | b := curBP ; | |
606 | curBP := curBP^.toDown ; | |
607 | curBP^.toUp := b | |
608 | END MoveDown ; | |
609 | ||
610 | ||
611 | (* | |
612 | MoveUp - | |
613 | *) | |
614 | ||
615 | PROCEDURE MoveUp ; | |
616 | BEGIN | |
617 | (* move up to the outer scope *) | |
618 | curBP := curBP^.toUp ; | |
619 | END MoveUp ; | |
35e03669 | 620 | ***** *) |
7401123f GM |
621 | |
622 | ||
623 | (* | |
624 | Move - | |
625 | *) | |
626 | ||
627 | PROCEDURE Move ; | |
628 | VAR | |
629 | b: BlockInfoPtr ; | |
630 | BEGIN | |
631 | IF Level=curBP^.level | |
632 | THEN | |
633 | b := curBP^.toReturn ; | |
634 | (* moving to next *) | |
635 | curBP := curBP^.toNext ; | |
636 | (* remember our return *) | |
637 | curBP^.toReturn := b | |
638 | ELSE | |
639 | WHILE Level#curBP^.level DO | |
640 | IF Level<curBP^.level | |
641 | THEN | |
642 | (* move up to the outer scope *) | |
643 | b := curBP ; | |
644 | curBP := curBP^.toReturn ; | |
645 | curBP^.toPC := b^.toNext (* remember where we reached *) | |
646 | ELSE | |
647 | (* move down a level *) | |
648 | (* remember where we came from *) | |
649 | b := curBP ; | |
650 | IF curBP^.toPC=NIL | |
651 | THEN | |
652 | Assert(curBP^.toDown#NIL) ; | |
653 | curBP^.toPC := curBP^.toDown | |
654 | END ; | |
655 | Assert(curBP^.toPC#NIL) ; | |
656 | curBP := curBP^.toPC ; | |
657 | curBP^.toReturn := b | |
658 | END | |
659 | END | |
660 | END | |
661 | END Move ; | |
662 | ||
663 | ||
664 | (* | |
665 | EnterBlock - | |
666 | *) | |
667 | ||
668 | PROCEDURE EnterBlock (n: Name) ; | |
669 | BEGIN | |
670 | Assert(curBP#NIL) ; | |
671 | INC(Level) ; | |
672 | Move ; | |
673 | IF Debugging | |
674 | THEN | |
675 | nSpaces(Level*3) ; | |
676 | IF n=curBP^.name | |
677 | THEN | |
678 | printf1('block %a\n', n) | |
679 | ELSE | |
680 | printf2('seen block %a but tree has recorded %a\n', n, curBP^.name) | |
681 | END | |
682 | END ; | |
683 | Assert((n=curBP^.name) OR (curBP^.name=NulName)) ; | |
684 | DeclareModules | |
685 | END EnterBlock ; | |
686 | ||
687 | ||
688 | (* | |
689 | LeaveBlock - | |
690 | *) | |
691 | ||
692 | PROCEDURE LeaveBlock ; | |
693 | BEGIN | |
694 | IF Debugging | |
695 | THEN | |
696 | printf1('leaving block %a ', curBP^.name) | |
697 | END ; | |
698 | DEC(Level) ; | |
699 | Move | |
700 | END LeaveBlock ; | |
701 | ||
702 | ||
703 | (* | |
704 | P0Init - | |
705 | *) | |
706 | ||
707 | PROCEDURE P0Init ; | |
708 | BEGIN | |
709 | headBP := NIL ; | |
710 | curBP := NIL ; | |
711 | Level := 0 ; | |
712 | InitUniverse | |
713 | END P0Init ; | |
714 | ||
715 | ||
716 | (* | |
717 | P1Init - | |
718 | *) | |
719 | ||
720 | PROCEDURE P1Init ; | |
721 | BEGIN | |
722 | IF Debugging | |
723 | THEN | |
724 | Display | |
725 | END ; | |
726 | (* curBP := headBP^.toDown ; *) | |
727 | curBP := headBP ; | |
728 | Assert(curBP#NIL) ; | |
729 | curBP^.toPC := curBP^.toDown ; | |
730 | curBP^.toReturn := curBP ; | |
731 | Level := 0 | |
732 | END P1Init ; | |
733 | ||
734 | ||
735 | END P0SymBuild. |