]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* M2Scope.mod derive the subset of quadruples for each scope. |
2 | ||
a945c346 | 3 | Copyright (C) 2003-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
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 M2Scope ; | |
23 | ||
24 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
25 | FROM M2Debug IMPORT Assert ; | |
26 | FROM NameKey IMPORT Name ; | |
27 | ||
28 | FROM SymbolTable IMPORT IsProcedure, IsDefImp, GetProcedureQuads, GetScope, | |
29 | GetProcedureScope, IsModule, IsModuleWithinProcedure, | |
30 | GetSymName, GetErrorScope, NulSym ; | |
31 | ||
32 | FROM M2Options IMPORT DisplayQuadruples ; | |
33 | FROM M2Printf IMPORT printf0, printf1 ; | |
34 | FROM M2Quads IMPORT QuadOperator, GetFirstQuad, GetNextQuad, GetQuad, DisplayQuadRange ; | |
35 | FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord, | |
36 | PopWord, PushWord, PeepWord ; | |
37 | IMPORT M2Error ; | |
38 | ||
39 | ||
40 | CONST | |
41 | Debugging = FALSE ; | |
42 | ||
43 | TYPE | |
44 | scopeKind = (unsetscope, ignorescope, procedurescope, modulescope, definitionscope, implementationscope, programscope) ; | |
45 | ||
46 | ScopeBlock = POINTER TO RECORD | |
47 | scopeSym : CARDINAL ; | |
48 | kindScope: scopeKind ; | |
49 | low, high: CARDINAL ; | |
50 | next : ScopeBlock ; | |
51 | END ; | |
52 | ||
53 | VAR | |
54 | FreeList: ScopeBlock ; | |
55 | ||
56 | ||
57 | (* | |
58 | New - | |
59 | *) | |
60 | ||
61 | PROCEDURE New (VAR sb: ScopeBlock) ; | |
62 | BEGIN | |
63 | IF FreeList = NIL | |
64 | THEN | |
65 | NEW (sb) | |
66 | ELSE | |
67 | sb := FreeList ; | |
68 | FreeList := FreeList^.next | |
69 | END | |
70 | END New ; | |
71 | ||
72 | ||
73 | (* | |
74 | Dispose - | |
75 | *) | |
76 | ||
77 | PROCEDURE Dispose (VAR sb: ScopeBlock) ; | |
78 | BEGIN | |
79 | sb^.next := FreeList ; | |
80 | FreeList := sb ; | |
81 | sb := NIL | |
82 | END Dispose ; | |
83 | ||
84 | ||
85 | (* | |
86 | SetScope - assigns the scopeSym and kindScope. | |
87 | *) | |
88 | ||
89 | PROCEDURE SetScope (sb: ScopeBlock; sym: CARDINAL; kindScope: scopeKind) ; | |
90 | BEGIN | |
91 | sb^.scopeSym := sym ; | |
92 | sb^.kindScope := kindScope | |
93 | END SetScope ; | |
94 | ||
95 | ||
96 | (* | |
97 | AddToRange - returns a ScopeBlock pointer to the last block. The, | |
98 | quad, will be added to the end of sb or a later block | |
99 | if First is TRUE. | |
100 | *) | |
101 | ||
102 | PROCEDURE AddToRange (sb: ScopeBlock; | |
103 | First: BOOLEAN; quad: CARDINAL) : ScopeBlock ; | |
104 | BEGIN | |
105 | IF First | |
106 | THEN | |
107 | IF sb^.high=0 | |
108 | THEN | |
109 | sb^.high := sb^.low | |
110 | END ; | |
111 | sb^.next := InitScopeBlock (NulSym) ; | |
112 | sb := sb^.next | |
113 | END ; | |
114 | IF sb^.low=0 | |
115 | THEN | |
116 | sb^.low := quad | |
117 | END ; | |
118 | sb^.high := quad ; | |
119 | RETURN sb | |
120 | END AddToRange ; | |
121 | ||
122 | ||
123 | (* | |
124 | GetGlobalQuads - | |
125 | *) | |
126 | ||
127 | PROCEDURE GetGlobalQuads (sb: ScopeBlock; scope: CARDINAL) : ScopeBlock ; | |
128 | VAR | |
129 | prev, | |
130 | nb : ScopeBlock ; | |
131 | NestedLevel, | |
132 | i : CARDINAL ; | |
133 | op : QuadOperator ; | |
134 | op1, op2, op3: CARDINAL ; | |
135 | First : BOOLEAN ; | |
136 | start, end : CARDINAL ; | |
137 | BEGIN | |
138 | NestedLevel := 0 ; | |
139 | prev := NIL ; | |
140 | First := FALSE ; | |
141 | IF (GetScope(scope)#NulSym) AND | |
142 | (IsProcedure(GetScope(scope)) OR | |
143 | (IsModule(scope) AND IsModuleWithinProcedure(scope))) | |
144 | THEN | |
145 | GetProcedureQuads (GetProcedureScope (scope), i, start, end) ; | |
146 | GetQuad (i, op, op1, op2, op3) ; | |
147 | WHILE (op#ModuleScopeOp) OR (op3#scope) DO | |
148 | i := GetNextQuad (i) ; | |
149 | GetQuad (i, op, op1, op2, op3) | |
150 | END ; | |
151 | end := i ; | |
152 | GetQuad (end, op, op1, op2, op3) ; | |
153 | WHILE (op#FinallyEndOp) OR (op3#scope) DO | |
154 | end := GetNextQuad (end) ; | |
155 | GetQuad (end, op, op1, op2, op3) | |
156 | END | |
157 | ELSE | |
158 | i := GetFirstQuad () ; | |
159 | end := 0 | |
160 | END ; | |
161 | nb := sb ; | |
162 | sb^.low := 0 ; | |
163 | sb^.high := 0 ; | |
164 | LOOP | |
165 | IF i=0 | |
166 | THEN | |
167 | IF Debugging | |
168 | THEN | |
169 | DisplayScope (sb) | |
170 | END ; | |
171 | RETURN sb | |
172 | END ; | |
173 | GetQuad (i, op, op1, op2, op3) ; | |
174 | IF op=ProcedureScopeOp | |
175 | THEN | |
176 | INC (NestedLevel) | |
177 | ELSIF op=ReturnOp | |
178 | THEN | |
179 | IF NestedLevel>0 | |
180 | THEN | |
181 | DEC (NestedLevel) | |
182 | END ; | |
183 | IF NestedLevel=0 | |
184 | THEN | |
185 | First := TRUE | |
186 | END | |
187 | ELSIF NestedLevel=0 | |
188 | THEN | |
189 | IF op=StartDefFileOp | |
190 | THEN | |
191 | nb := AddToRange (nb, TRUE, i) ; | |
192 | SetScope (nb, op3, definitionscope) ; | |
193 | prev := nb | |
194 | ELSIF (op=StartModFileOp) OR (op=InitStartOp) | |
195 | THEN | |
196 | nb := AddToRange (nb, TRUE, i) ; | |
197 | IF IsDefImp (op3) | |
198 | THEN | |
199 | SetScope (nb, op3, implementationscope) | |
200 | ELSE | |
201 | SetScope (nb, op3, programscope) | |
202 | END ; | |
203 | prev := nb | |
204 | ELSE | |
205 | nb := AddToRange (nb, First, i) ; | |
206 | IF op = InitEndOp | |
207 | THEN | |
208 | IF IsDefImp (op3) | |
209 | THEN | |
210 | SetScope (nb, op3, implementationscope) | |
211 | ELSE | |
212 | SetScope (nb, op3, programscope) | |
213 | END ; | |
214 | prev := nb | |
215 | ELSIF First | |
216 | THEN | |
217 | Assert (prev # NIL) ; | |
218 | SetScope (nb, prev^.scopeSym, prev^.kindScope) | |
219 | END | |
220 | END ; | |
221 | First := FALSE | |
222 | END ; | |
223 | IF i=end | |
224 | THEN | |
225 | IF Debugging | |
226 | THEN | |
227 | DisplayScope (sb) | |
228 | END ; | |
229 | RETURN sb | |
230 | END ; | |
231 | i := GetNextQuad (i) | |
232 | END | |
233 | END GetGlobalQuads ; | |
234 | ||
235 | ||
236 | (* | |
237 | GetProcQuads - | |
238 | *) | |
239 | ||
240 | PROCEDURE GetProcQuads (sb: ScopeBlock; | |
241 | proc: CARDINAL) : ScopeBlock ; | |
242 | VAR | |
243 | nb : ScopeBlock ; | |
244 | scope, start, | |
245 | end, i, last : CARDINAL ; | |
246 | op : QuadOperator ; | |
247 | op1, op2, op3: CARDINAL ; | |
248 | First : BOOLEAN ; | |
249 | s : StackOfWord ; | |
250 | n : Name ; | |
251 | BEGIN | |
252 | s := InitStackWord () ; | |
253 | IF Debugging | |
254 | THEN | |
255 | n := GetSymName (proc) ; | |
256 | printf1("GetProcQuads for %a\n", n) | |
257 | END ; | |
258 | Assert(IsProcedure(proc)) ; | |
259 | GetProcedureQuads(proc, scope, start, end) ; | |
260 | IF Debugging | |
261 | THEN | |
262 | printf1(" proc %d\n", proc) ; | |
263 | printf1(" scope %d\n", scope) ; | |
264 | printf1(" start %d\n", start) ; | |
265 | printf1(" end %d\n", end) | |
266 | END ; | |
267 | PushWord(s, 0) ; | |
268 | First := FALSE ; | |
269 | i := scope ; | |
270 | last := scope ; | |
271 | nb := sb ; | |
272 | sb^.low := scope ; | |
273 | sb^.high := 0 ; | |
274 | SetScope (sb, proc, procedurescope) ; | |
275 | WHILE (i<=end) AND (start#0) DO | |
276 | GetQuad (i, op, op1, op2, op3) ; | |
277 | IF (op=ProcedureScopeOp) OR (op=ModuleScopeOp) | |
278 | THEN | |
279 | IF (PeepWord(s, 1)=proc) AND (op3=proc) | |
280 | THEN | |
281 | nb := AddToRange (nb, First, last) ; | |
282 | First := FALSE | |
283 | END ; | |
284 | PushWord (s, op3) ; | |
285 | IF op=ProcedureScopeOp | |
286 | THEN | |
287 | SetScope (nb, proc, procedurescope) | |
288 | ELSE | |
289 | SetScope (nb, proc, modulescope) | |
290 | END | |
291 | ELSIF (op=ReturnOp) OR (op=FinallyEndOp) | |
292 | THEN | |
293 | op3 := PopWord (s) ; | |
294 | IF PeepWord (s, 1) = proc | |
295 | THEN | |
296 | First := TRUE | |
297 | END | |
298 | ELSE | |
299 | IF PeepWord (s, 1) = proc | |
300 | THEN | |
301 | nb := AddToRange (nb, First, i) ; | |
302 | First := FALSE | |
303 | END | |
304 | END ; | |
305 | last := i ; | |
306 | i := GetNextQuad (i) | |
307 | END ; | |
308 | IF start<=nb^.high | |
309 | THEN | |
310 | nb^.high := end | |
311 | ELSE | |
312 | nb^.next := InitScopeBlock (NulSym) ; | |
313 | nb := nb^.next ; | |
314 | SetScope (nb, proc, unsetscope) ; | |
315 | WITH nb^ DO | |
316 | low := start ; | |
317 | high := end | |
318 | END | |
319 | END ; | |
320 | s := KillStackWord (s) ; | |
321 | RETURN sb | |
322 | END GetProcQuads ; | |
323 | ||
324 | ||
325 | (* | |
326 | DisplayScope - | |
327 | *) | |
328 | ||
329 | PROCEDURE DisplayScope (sb: ScopeBlock) ; | |
330 | VAR | |
331 | name: Name ; | |
332 | BEGIN | |
333 | WITH sb^ DO | |
334 | printf0 ("scope: ") ; | |
335 | CASE sb^.kindScope OF | |
336 | ||
337 | unsetscope : printf0 ("unset") | | |
338 | ignorescope : printf0 ("ignore") | | |
339 | procedurescope : name := GetSymName (scopeSym) ; | |
340 | printf1 ("procedure %a", name) | | |
341 | modulescope : name := GetSymName (scopeSym) ; | |
342 | printf1 ("inner module %a", name) | | |
343 | definitionscope : name := GetSymName (scopeSym) ; | |
344 | printf1 ("definition module %a", name) | | |
345 | implementationscope: name := GetSymName (scopeSym) ; | |
346 | printf1 ("implementation module %a", name) | | |
347 | programscope : name := GetSymName (scopeSym) ; | |
348 | printf1 ("program module %a", name) | |
349 | ||
350 | END ; | |
351 | printf0 ("\n") ; | |
40b91158 | 352 | DisplayQuadRange (scopeSym, low, high) ; |
1eee94d3 GM |
353 | IF next#NIL |
354 | THEN | |
355 | DisplayScope (next) | |
356 | END | |
357 | END | |
358 | END DisplayScope ; | |
359 | ||
360 | ||
361 | (* | |
362 | InitScopeBlock - | |
363 | *) | |
364 | ||
365 | PROCEDURE InitScopeBlock (scope: CARDINAL) : ScopeBlock ; | |
366 | VAR | |
367 | sb: ScopeBlock ; | |
368 | BEGIN | |
369 | New (sb) ; | |
370 | WITH sb^ DO | |
371 | next := NIL ; | |
372 | kindScope := unsetscope ; | |
373 | IF scope=NulSym | |
374 | THEN | |
375 | low := 0 ; | |
376 | high := 0 | |
377 | ELSE | |
378 | IF IsProcedure (scope) | |
379 | THEN | |
380 | sb := GetProcQuads (sb, scope) | |
381 | ELSE | |
382 | sb := GetGlobalQuads (sb, scope) ; | |
383 | END ; | |
384 | IF DisplayQuadruples | |
385 | THEN | |
386 | DisplayScope (sb) | |
387 | END | |
388 | END | |
389 | END ; | |
390 | RETURN sb | |
391 | END InitScopeBlock ; | |
392 | ||
393 | ||
394 | (* | |
395 | KillScopeBlock - destroys the ScopeBlock sb and assign sb to NIL. | |
396 | *) | |
397 | ||
398 | PROCEDURE KillScopeBlock (VAR sb: ScopeBlock) ; | |
399 | VAR | |
400 | t: ScopeBlock ; | |
401 | BEGIN | |
402 | t := sb ; | |
403 | WHILE t # NIL DO | |
404 | sb := t ; | |
405 | t := t^.next ; | |
406 | Dispose (sb) ; | |
407 | END ; | |
408 | sb := NIL | |
409 | END KillScopeBlock ; | |
410 | ||
411 | ||
412 | (* | |
413 | ForeachScopeBlockDo - | |
414 | *) | |
415 | ||
416 | PROCEDURE ForeachScopeBlockDo (sb: ScopeBlock; p: ScopeProcedure) ; | |
417 | BEGIN | |
418 | IF DisplayQuadruples | |
419 | THEN | |
420 | printf0 ("ForeachScopeBlockDo\n") | |
421 | END ; | |
422 | WHILE sb#NIL DO | |
423 | WITH sb^ DO | |
424 | IF DisplayQuadruples | |
425 | THEN | |
426 | DisplayScope (sb) | |
427 | END ; | |
428 | enter (sb) ; | |
429 | IF (low # 0) AND (high # 0) | |
430 | THEN | |
40b91158 | 431 | p (scopeSym, low, high) |
1eee94d3 GM |
432 | END ; |
433 | leave (sb) | |
434 | END ; | |
435 | sb := sb^.next | |
436 | END ; | |
437 | IF DisplayQuadruples | |
438 | THEN | |
439 | printf0 ("end ForeachScopeBlockDo\n\n") | |
440 | END ; | |
441 | END ForeachScopeBlockDo ; | |
442 | ||
443 | ||
444 | (* | |
445 | enter - | |
446 | *) | |
447 | ||
448 | PROCEDURE enter (sb: ScopeBlock) ; | |
449 | BEGIN | |
450 | WITH sb^ DO | |
451 | CASE kindScope OF | |
452 | ||
453 | unsetscope, | |
454 | ignorescope : | | |
455 | procedurescope , | |
456 | modulescope , | |
457 | definitionscope , | |
458 | implementationscope, | |
459 | programscope : M2Error.EnterErrorScope (GetErrorScope (scopeSym)) | |
460 | ||
461 | END | |
462 | END | |
463 | END enter ; | |
464 | ||
465 | ||
466 | (* | |
467 | leave - | |
468 | *) | |
469 | ||
470 | PROCEDURE leave (sb: ScopeBlock) ; | |
471 | BEGIN | |
472 | CASE sb^.kindScope OF | |
473 | ||
474 | unsetscope, | |
475 | ignorescope : | | |
476 | ||
477 | ELSE | |
478 | M2Error.LeaveErrorScope | |
479 | END | |
480 | END leave ; | |
481 | ||
482 | ||
483 | ||
484 | (* | |
485 | Init - initializes the global variables for this module. | |
486 | *) | |
487 | ||
488 | PROCEDURE Init ; | |
489 | BEGIN | |
490 | FreeList := NIL | |
491 | END Init ; | |
492 | ||
493 | ||
494 | BEGIN | |
495 | Init | |
496 | END M2Scope. |