Branch data Line data Source code
1 : : /* m2block.cc provides an interface to maintaining block structures.
2 : :
3 : : Copyright (C) 2012-2025 Free Software Foundation, Inc.
4 : : Contributed by Gaius Mulley <gaius@glam.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 : : #include "gcc-consolidation.h"
23 : :
24 : : #define m2block_c
25 : : #include "m2assert.h"
26 : : #include "m2block.h"
27 : : #include "m2decl.h"
28 : : #include "m2options.h"
29 : : #include "m2tree.h"
30 : : #include "m2treelib.h"
31 : : #include "m2pp.h"
32 : :
33 : : /* For each binding contour we allocate a binding_level structure
34 : : which records the entities defined or declared in that contour.
35 : : Contours include:
36 : :
37 : : the global one one for each subprogram definition
38 : :
39 : : Binding contours are used to create GCC tree BLOCK nodes. */
40 : :
41 : : struct GTY (()) binding_level
42 : : {
43 : : /* The function associated with the scope. This is NULL_TREE for the
44 : : global scope. */
45 : : tree fndecl;
46 : :
47 : : /* A chain of _DECL nodes for all variables, constants, functions,
48 : : and typedef types. These are in the reverse of the order supplied. */
49 : : tree names;
50 : :
51 : : /* A boolean to indicate whether this is binding level is a global ie
52 : : outer module scope. In which case fndecl will be NULL_TREE. */
53 : : int is_global;
54 : :
55 : : /* The context of the binding level, for a function binding level
56 : : this will be the same as fndecl, however for a global binding level
57 : : this is a translation_unit. */
58 : : tree context;
59 : :
60 : : /* The binding level below this one. This field is only used when
61 : : the binding level has been pushed by pushFunctionScope. */
62 : : struct binding_level *next;
63 : :
64 : : /* All binding levels are placed onto this list. */
65 : : struct binding_level *list;
66 : :
67 : : /* A varray of trees, which represent the list of statement
68 : : sequences. */
69 : : vec<tree, va_gc> *m2_statements;
70 : :
71 : : /* A list of constants (only kept in the global binding level).
72 : : Constants need to be kept through the life of the compilation, as the
73 : : same constants can be used in any scope. */
74 : : tree constants;
75 : :
76 : : /* A list of inner module initialization functions. */
77 : : tree init_functions;
78 : :
79 : : /* A list of types created by M2GCCDeclare prior to code generation
80 : : and those which may not be specifically declared and saved via a
81 : : push_decl. */
82 : : tree types;
83 : :
84 : : /* A list of all DECL_EXPR created within this binding level. This
85 : : will be prepended to the statement list once the binding level (scope
86 : : is finished). */
87 : : tree decl;
88 : :
89 : : /* A list of labels which have been created in this scope. */
90 : : tree labels;
91 : :
92 : : /* The number of times this level has been pushed. */
93 : : int count;
94 : : };
95 : :
96 : : /* The binding level currently in effect. */
97 : :
98 : : static GTY (()) struct binding_level *current_binding_level;
99 : :
100 : : /* The outermost binding level, for names of file scope. This is
101 : : created when the compiler is started and exists through the entire
102 : : run. */
103 : :
104 : : static GTY (()) struct binding_level *global_binding_level;
105 : :
106 : : /* The head of the binding level lists. */
107 : : static GTY (()) struct binding_level *head_binding_level;
108 : :
109 : : /* The current statement tree. */
110 : :
111 : : typedef struct stmt_tree_s *stmt_tree_t;
112 : :
113 : : #undef DEBUGGING
114 : :
115 : : static location_t pending_location;
116 : : static int pending_statement = false;
117 : :
118 : : /* assert_global_names asserts that the global_binding_level->names
119 : : can be chained. */
120 : :
121 : : static void
122 : 9346141 : assert_global_names (void)
123 : : {
124 : 9346141 : tree p = global_binding_level->names;
125 : :
126 : 3102807575 : while (p)
127 : 3093461434 : p = TREE_CHAIN (p);
128 : 9346141 : }
129 : :
130 : : /* lookupLabel return label tree in current scope, otherwise
131 : : NULL_TREE. */
132 : :
133 : : static tree
134 : 212467 : lookupLabel (tree id)
135 : : {
136 : 212467 : tree t;
137 : :
138 : 748738 : for (t = current_binding_level->labels; t != NULL_TREE; t = TREE_CHAIN (t))
139 : : {
140 : 654383 : tree l = TREE_VALUE (t);
141 : :
142 : 654383 : if (id == DECL_NAME (l))
143 : : return l;
144 : : }
145 : : return NULL_TREE;
146 : : }
147 : :
148 : : /* getLabel return the label name or create a label name in the
149 : : current scope. */
150 : :
151 : : tree
152 : 212467 : m2block_getLabel (location_t location, char *name)
153 : : {
154 : 212467 : tree id = get_identifier (name);
155 : 212467 : tree label = lookupLabel (id);
156 : :
157 : 212467 : if (label == NULL_TREE)
158 : : {
159 : 94355 : label = build_decl (location, LABEL_DECL, id, void_type_node);
160 : 94355 : current_binding_level->labels
161 : 94355 : = tree_cons (NULL_TREE, label, current_binding_level->labels);
162 : : }
163 : 212467 : if (DECL_CONTEXT (label) == NULL_TREE)
164 : 94367 : DECL_CONTEXT (label) = current_function_decl;
165 : 212467 : ASSERT ((DECL_CONTEXT (label) == current_function_decl),
166 : 212467 : current_function_decl);
167 : :
168 : 212467 : DECL_MODE (label) = VOIDmode;
169 : 212467 : return label;
170 : : }
171 : :
172 : : static void
173 : 120198 : init_binding_level (struct binding_level *l)
174 : : {
175 : 120198 : l->fndecl = NULL;
176 : 120198 : l->names = NULL;
177 : 120198 : l->is_global = 0;
178 : 120198 : l->context = NULL;
179 : 120198 : l->next = NULL;
180 : 120198 : l->list = NULL;
181 : 120198 : vec_alloc (l->m2_statements, 1);
182 : 120198 : l->constants = NULL;
183 : 120198 : l->init_functions = NULL;
184 : 120198 : l->types = NULL;
185 : 120198 : l->decl = NULL;
186 : 120198 : l->labels = NULL;
187 : 120198 : l->count = 0;
188 : 120198 : }
189 : :
190 : : static struct binding_level *
191 : 120198 : newLevel (void)
192 : : {
193 : 120198 : struct binding_level *newlevel = ggc_alloc<binding_level> ();
194 : :
195 : 120198 : init_binding_level (newlevel);
196 : :
197 : : /* Now we a push_statement_list. */
198 : 120198 : vec_safe_push (newlevel->m2_statements, m2block_begin_statement_list ());
199 : 120198 : return newlevel;
200 : : }
201 : :
202 : : tree *
203 : 1218310 : m2block_cur_stmt_list_addr (void)
204 : : {
205 : 1218310 : ASSERT_CONDITION (current_binding_level != NULL);
206 : 1218310 : int l = vec_safe_length (current_binding_level->m2_statements) - 1;
207 : :
208 : 1218310 : return &(*current_binding_level->m2_statements)[l];
209 : : }
210 : :
211 : : tree
212 : 0 : m2block_cur_stmt_list (void)
213 : : {
214 : 0 : tree *t = m2block_cur_stmt_list_addr ();
215 : :
216 : 0 : return *t;
217 : : }
218 : :
219 : : /* is_building_stmt_list returns true if we are building a
220 : : statement list. true is returned if we are in a binding level and
221 : : a statement list is under construction. */
222 : :
223 : : int
224 : 0 : m2block_is_building_stmt_list (void)
225 : : {
226 : 0 : ASSERT_CONDITION (current_binding_level != NULL);
227 : 0 : return !vec_safe_is_empty (current_binding_level->m2_statements);
228 : : }
229 : :
230 : : /* push_statement_list pushes the statement list t onto the
231 : : current binding level. */
232 : :
233 : : tree
234 : 85692 : m2block_push_statement_list (tree t)
235 : : {
236 : 85692 : ASSERT_CONDITION (current_binding_level != NULL);
237 : 85692 : vec_safe_push (current_binding_level->m2_statements, t);
238 : 85692 : return t;
239 : : }
240 : :
241 : : /* pop_statement_list pops and returns a statement list from the
242 : : current binding level. */
243 : :
244 : : tree
245 : 189718 : m2block_pop_statement_list (void)
246 : : {
247 : 189718 : ASSERT_CONDITION (current_binding_level != NULL);
248 : 189718 : {
249 : 189718 : tree t = current_binding_level->m2_statements->pop ();
250 : :
251 : 189718 : return t;
252 : : }
253 : : }
254 : :
255 : : /* begin_statement_list starts a tree statement. It pushes the
256 : : statement list and returns the list node. */
257 : :
258 : : tree
259 : 205890 : m2block_begin_statement_list (void)
260 : : {
261 : 205890 : return alloc_stmt_list ();
262 : : }
263 : :
264 : : /* findLevel returns the binding level associated with fndecl one
265 : : is created if there is no existing one on head_binding_level. */
266 : :
267 : : static struct binding_level *
268 : 2809350 : findLevel (tree fndecl)
269 : : {
270 : 2809350 : struct binding_level *b;
271 : :
272 : 2809350 : if (fndecl == NULL_TREE)
273 : 2705312 : return global_binding_level;
274 : :
275 : 104038 : b = head_binding_level;
276 : 104038 : while ((b != NULL) && (b->fndecl != fndecl))
277 : 0 : b = b->list;
278 : :
279 : 104038 : if (b == NULL)
280 : : {
281 : 104038 : b = newLevel ();
282 : 104038 : b->fndecl = fndecl;
283 : 104038 : b->context = fndecl;
284 : 104038 : b->is_global = false;
285 : 104038 : b->list = head_binding_level;
286 : 104038 : b->next = NULL;
287 : : }
288 : : return b;
289 : : }
290 : :
291 : : /* pushFunctionScope push a binding level. */
292 : :
293 : : void
294 : 2882930 : m2block_pushFunctionScope (tree fndecl)
295 : : {
296 : 2882930 : struct binding_level *n;
297 : 2882930 : struct binding_level *b;
298 : :
299 : : #if defined(DEBUGGING)
300 : : if (fndecl != NULL)
301 : : printf ("pushFunctionScope\n");
302 : : #endif
303 : :
304 : : /* Allow multiple consecutive pushes of the same scope. */
305 : :
306 : 2882930 : if (current_binding_level != NULL
307 : 105514 : && (current_binding_level->fndecl == fndecl))
308 : : {
309 : 73580 : current_binding_level->count++;
310 : 73580 : return;
311 : : }
312 : :
313 : : /* Firstly check to see that fndecl is not already on the binding
314 : : stack. */
315 : :
316 : 2841458 : for (b = current_binding_level; b != NULL; b = b->next)
317 : : /* Only allowed one instance of the binding on the stack at a time. */
318 : 32108 : ASSERT_CONDITION (b->fndecl != fndecl);
319 : :
320 : 2809350 : n = findLevel (fndecl);
321 : :
322 : : /* Add this level to the front of the stack. */
323 : 2809350 : n->next = current_binding_level;
324 : 2809350 : current_binding_level = n;
325 : : }
326 : :
327 : : /* popFunctionScope - pops a binding level, returning the function
328 : : associated with the binding level. */
329 : :
330 : : tree
331 : 177606 : m2block_popFunctionScope (void)
332 : : {
333 : 177606 : tree fndecl = current_binding_level->fndecl;
334 : :
335 : : #if defined(DEBUGGING)
336 : : if (fndecl != NULL)
337 : : printf ("popFunctionScope\n");
338 : : #endif
339 : :
340 : 177606 : if (current_binding_level->count > 0)
341 : : {
342 : : /* Multiple pushes have occurred of the same function scope (and
343 : : ignored), pop them likewise. */
344 : 73580 : current_binding_level->count--;
345 : 73580 : return fndecl;
346 : : }
347 : 104026 : ASSERT_CONDITION (current_binding_level->fndecl
348 : 104026 : != NULL_TREE); /* Expecting local scope. */
349 : :
350 : 104026 : ASSERT_CONDITION (current_binding_level->constants
351 : 104026 : == NULL_TREE); /* Should not be used. */
352 : 104026 : ASSERT_CONDITION (current_binding_level->names
353 : 104026 : == NULL_TREE); /* Should be cleared. */
354 : 104026 : ASSERT_CONDITION (current_binding_level->decl
355 : 104026 : == NULL_TREE); /* Should be cleared. */
356 : :
357 : 104026 : current_binding_level = current_binding_level->next;
358 : 104026 : return fndecl;
359 : : }
360 : :
361 : : /* pushGlobalScope push the global scope onto the binding level
362 : : stack. There can only ever be one instance of the global binding
363 : : level on the stack. */
364 : :
365 : : void
366 : 2705312 : m2block_pushGlobalScope (void)
367 : : {
368 : : #if defined(DEBUGGING)
369 : : printf ("pushGlobalScope\n");
370 : : #endif
371 : 2705312 : m2block_pushFunctionScope (NULL_TREE);
372 : 2705312 : }
373 : :
374 : : /* popGlobalScope pops the current binding level, it expects this
375 : : binding level to be the global binding level. */
376 : :
377 : : void
378 : 2705270 : m2block_popGlobalScope (void)
379 : : {
380 : 2705270 : ASSERT_CONDITION (
381 : 2705270 : current_binding_level->is_global); /* Expecting global scope. */
382 : 2705270 : ASSERT_CONDITION (current_binding_level == global_binding_level);
383 : :
384 : 2705270 : if (current_binding_level->count > 0)
385 : : {
386 : 0 : current_binding_level->count--;
387 : 0 : return;
388 : : }
389 : :
390 : 2705270 : current_binding_level = current_binding_level->next;
391 : : #if defined(DEBUGGING)
392 : : printf ("popGlobalScope\n");
393 : : #endif
394 : :
395 : 2705270 : assert_global_names ();
396 : : }
397 : :
398 : : /* finishFunctionDecl removes declarations from the current binding
399 : : level and places them inside fndecl. The current binding level is
400 : : then able to be destroyed by a call to popFunctionScope.
401 : :
402 : : The extra tree nodes associated with fndecl will be created such
403 : : as BIND_EXPR, BLOCK and the initial STATEMENT_LIST containing the
404 : : DECL_EXPR is also created. */
405 : :
406 : : void
407 : 105082 : m2block_finishFunctionDecl (location_t location, tree fndecl)
408 : : {
409 : 105082 : tree context = current_binding_level->context;
410 : 105082 : tree block = DECL_INITIAL (fndecl);
411 : 105082 : tree bind_expr = DECL_SAVED_TREE (fndecl);
412 : 105082 : tree i;
413 : :
414 : 105082 : if (block == NULL_TREE)
415 : : {
416 : 104038 : block = make_node (BLOCK);
417 : 104038 : DECL_INITIAL (fndecl) = block;
418 : 104038 : TREE_USED (block) = true;
419 : 104038 : BLOCK_SUBBLOCKS (block) = NULL_TREE;
420 : : }
421 : 105082 : BLOCK_SUPERCONTEXT (block) = context;
422 : :
423 : 210164 : BLOCK_VARS (block)
424 : 105082 : = chainon (BLOCK_VARS (block), current_binding_level->names);
425 : 105082 : TREE_USED (fndecl) = true;
426 : :
427 : 105082 : if (bind_expr == NULL_TREE)
428 : : {
429 : 104038 : bind_expr
430 : 104038 : = build3 (BIND_EXPR, void_type_node, current_binding_level->names,
431 : : current_binding_level->decl, block);
432 : 104038 : DECL_SAVED_TREE (fndecl) = bind_expr;
433 : : }
434 : : else
435 : : {
436 : 2088 : if (!chain_member (current_binding_level->names,
437 : 1044 : BIND_EXPR_VARS (bind_expr)))
438 : : {
439 : 630 : BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr),
440 : : current_binding_level->names);
441 : :
442 : 630 : if (current_binding_level->names != NULL_TREE)
443 : : {
444 : 198 : for (i = current_binding_level->names; i != NULL_TREE;
445 : 102 : i = DECL_CHAIN (i))
446 : 102 : append_to_statement_list_force (i,
447 : : &BIND_EXPR_BODY (bind_expr));
448 : :
449 : : }
450 : : }
451 : : }
452 : 105082 : SET_EXPR_LOCATION (bind_expr, location);
453 : :
454 : 105082 : current_binding_level->names = NULL_TREE;
455 : 105082 : current_binding_level->decl = NULL_TREE;
456 : 105082 : }
457 : :
458 : : /* finishFunctionCode adds cur_stmt_list to fndecl. The current
459 : : binding level is then able to be destroyed by a call to
460 : : popFunctionScope. The cur_stmt_list is appended to the
461 : : STATEMENT_LIST. */
462 : :
463 : : void
464 : 104026 : m2block_finishFunctionCode (tree fndecl)
465 : : {
466 : 104026 : tree bind_expr;
467 : 104026 : tree block;
468 : 104026 : tree statements = m2block_pop_statement_list ();
469 : 104026 : tree_stmt_iterator i;
470 : :
471 : 104026 : ASSERT_CONDITION (DECL_SAVED_TREE (fndecl) != NULL_TREE);
472 : :
473 : 104026 : bind_expr = DECL_SAVED_TREE (fndecl);
474 : 104026 : ASSERT_CONDITION (TREE_CODE (bind_expr) == BIND_EXPR);
475 : :
476 : 104026 : block = DECL_INITIAL (fndecl);
477 : 104026 : ASSERT_CONDITION (TREE_CODE (block) == BLOCK);
478 : :
479 : 104026 : if (current_binding_level->names != NULL_TREE)
480 : : {
481 : 66189 : BIND_EXPR_VARS (bind_expr)
482 : 66189 : = chainon (BIND_EXPR_VARS (bind_expr), current_binding_level->names);
483 : 66189 : current_binding_level->names = NULL_TREE;
484 : : }
485 : 104026 : if (current_binding_level->labels != NULL_TREE)
486 : : {
487 : : tree t;
488 : :
489 : 118459 : for (t = current_binding_level->labels; t != NULL_TREE;
490 : 94337 : t = TREE_CHAIN (t))
491 : : {
492 : 94337 : tree l = TREE_VALUE (t);
493 : :
494 : 94337 : BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), l);
495 : : }
496 : 24122 : current_binding_level->labels = NULL_TREE;
497 : : }
498 : :
499 : 104026 : BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr);
500 : :
501 : 104026 : if (current_binding_level->decl != NULL_TREE)
502 : 557763 : for (i = tsi_start (current_binding_level->decl); !tsi_end_p (i);
503 : 491574 : tsi_next (&i))
504 : 491574 : append_to_statement_list_force (*tsi_stmt_ptr (i),
505 : : &BIND_EXPR_BODY (bind_expr));
506 : :
507 : 1204592 : for (i = tsi_start (statements); !tsi_end_p (i); tsi_next (&i))
508 : 1100566 : append_to_statement_list_force (*tsi_stmt_ptr (i),
509 : : &BIND_EXPR_BODY (bind_expr));
510 : :
511 : 104026 : current_binding_level->decl = NULL_TREE;
512 : 104026 : }
513 : :
514 : : void
515 : 14714 : m2block_finishGlobals (void)
516 : : {
517 : 14714 : tree context = global_binding_level->context;
518 : 14714 : tree block = make_node (BLOCK);
519 : 14714 : tree p = global_binding_level->names;
520 : :
521 : 14714 : BLOCK_SUBBLOCKS (block) = NULL;
522 : 14714 : TREE_USED (block) = 1;
523 : :
524 : 14714 : BLOCK_VARS (block) = p;
525 : :
526 : 14714 : DECL_INITIAL (context) = block;
527 : 14714 : BLOCK_SUPERCONTEXT (block) = context;
528 : 14714 : }
529 : :
530 : : /* pushDecl pushes a declaration onto the current binding level. */
531 : :
532 : : tree
533 : 6640871 : m2block_pushDecl (tree decl)
534 : : {
535 : : /* External objects aren't nested, other objects may be. */
536 : :
537 : 6640871 : if (decl != current_function_decl)
538 : 6640871 : DECL_CONTEXT (decl) = current_binding_level->context;
539 : :
540 : : /* Put the declaration on the list. The list of declarations is in
541 : : reverse order. The list will be reversed later if necessary. This
542 : : needs to be this way for compatibility with the back-end. */
543 : :
544 : 6640871 : TREE_CHAIN (decl) = current_binding_level->names;
545 : 6640871 : current_binding_level->names = decl;
546 : :
547 : 6640871 : assert_global_names ();
548 : :
549 : 6640871 : return decl;
550 : : }
551 : :
552 : : /* includeDecl pushes a declaration onto the current binding level
553 : : providing it is not already present. */
554 : :
555 : : void
556 : 0 : m2block_includeDecl (tree decl)
557 : : {
558 : 0 : tree p = current_binding_level->names;
559 : :
560 : 0 : while (p != decl && p != NULL)
561 : 0 : p = TREE_CHAIN (p);
562 : 0 : if (p != decl)
563 : 0 : m2block_pushDecl (decl);
564 : 0 : }
565 : :
566 : : /* addDeclExpr adds the DECL_EXPR node t to the statement list
567 : : current_binding_level->decl. This allows us to order all
568 : : declarations at the beginning of the function. */
569 : :
570 : : void
571 : 568950 : m2block_addDeclExpr (tree t)
572 : : {
573 : 568950 : append_to_statement_list_force (t, ¤t_binding_level->decl);
574 : 568950 : }
575 : :
576 : : /* RememberType remember the type t in the ggc marked list. */
577 : :
578 : : tree
579 : 1208171 : m2block_RememberType (tree t)
580 : : {
581 : 1208171 : global_binding_level->types
582 : 1208171 : = tree_cons (NULL_TREE, t, global_binding_level->types);
583 : 1208171 : return t;
584 : : }
585 : :
586 : : /* global_constant returns t. It chains t onto the
587 : : global_binding_level list of constants, if it is not already
588 : : present. */
589 : :
590 : : tree
591 : 9665178 : m2block_global_constant (tree t)
592 : : {
593 : 9665178 : tree s;
594 : :
595 : 9665178 : if (global_binding_level->constants != NULL_TREE)
596 : 1229791283 : for (s = global_binding_level->constants; s != NULL_TREE;
597 : 1220142265 : s = TREE_CHAIN (s))
598 : : {
599 : 1226773230 : tree c = TREE_VALUE (s);
600 : :
601 : 1226773230 : if (c == t)
602 : : return t;
603 : : }
604 : :
605 : 3034213 : global_binding_level->constants
606 : 3034213 : = tree_cons (NULL_TREE, t, global_binding_level->constants);
607 : 3034213 : return t;
608 : : }
609 : :
610 : : /* RememberConstant adds a tree t onto the list of constants to
611 : : be marked whenever the ggc re-marks all used storage. Constants
612 : : live throughout the whole compilation and they can be used by
613 : : many different functions if necessary. */
614 : :
615 : : tree
616 : 19515178 : m2block_RememberConstant (tree t)
617 : : {
618 : 19515178 : if ((t != NULL) && (m2tree_IsAConstant (t)))
619 : 9614996 : return m2block_global_constant (t);
620 : : return t;
621 : : }
622 : :
623 : : /* DumpGlobalConstants displays all global constants and checks
624 : : none are poisoned. */
625 : :
626 : : tree
627 : 0 : m2block_DumpGlobalConstants (void)
628 : : {
629 : 0 : tree s;
630 : :
631 : 0 : if (global_binding_level->constants != NULL_TREE)
632 : 0 : for (s = global_binding_level->constants; TREE_CHAIN (s);
633 : 0 : s = TREE_CHAIN (s))
634 : 0 : debug_tree (s);
635 : 0 : return NULL_TREE;
636 : : }
637 : :
638 : : /* RememberInitModuleFunction records tree t in the global
639 : : binding level. So that it will not be garbage collected. In
640 : : theory the inner modules could be placed inside the
641 : : current_binding_level I suspect. */
642 : :
643 : : tree
644 : 0 : m2block_RememberInitModuleFunction (tree t)
645 : : {
646 : 0 : global_binding_level->init_functions
647 : 0 : = tree_cons (NULL_TREE, t, global_binding_level->init_functions);
648 : 0 : return t;
649 : : }
650 : :
651 : : /* toplevel return true if we are in the global scope. */
652 : :
653 : : bool
654 : 109221 : m2block_toplevel (void)
655 : : {
656 : 109221 : if (current_binding_level == NULL)
657 : : return true;
658 : 109221 : if (current_binding_level->fndecl == NULL)
659 : 109197 : return true;
660 : : return false;
661 : : }
662 : :
663 : : /* GetErrorNode returns the gcc error_mark_node. */
664 : :
665 : : tree
666 : 11628900 : m2block_GetErrorNode (void)
667 : : {
668 : 11628900 : return error_mark_node;
669 : : }
670 : :
671 : : /* GetGlobals returns a list of global variables, functions and constants. */
672 : :
673 : : tree
674 : 0 : m2block_GetGlobals (void)
675 : : {
676 : 0 : assert_global_names ();
677 : 0 : return global_binding_level->names;
678 : : }
679 : :
680 : : /* GetGlobalContext - returns the global context tree. */
681 : :
682 : : tree
683 : 104194 : m2block_GetGlobalContext (void)
684 : : {
685 : 104194 : return global_binding_level->context;
686 : : }
687 : :
688 : : /* do_add_stmt t is a statement. Add it to the statement-tree. */
689 : :
690 : : static tree
691 : 1218310 : do_add_stmt (tree t)
692 : : {
693 : 1218310 : if (current_binding_level != NULL)
694 : 1218310 : append_to_statement_list_force (t, m2block_cur_stmt_list_addr ());
695 : 1218310 : return t;
696 : : }
697 : :
698 : : /* flush_pending_note flushes a pending_statement note if necessary. */
699 : :
700 : : static void
701 : 357428 : flush_pending_note (void)
702 : : {
703 : 357428 : if (pending_statement && (M2Options_GetM2g ()))
704 : : {
705 : 53012 : tree note = build_empty_stmt (pending_location);
706 : 53012 : pending_statement = false;
707 : 53012 : do_add_stmt (note);
708 : : }
709 : 357428 : }
710 : :
711 : : /* add_stmt t is a statement. Add it to the statement-tree. */
712 : :
713 : : tree
714 : 1165298 : m2block_add_stmt (location_t location, tree t)
715 : : {
716 : 1165298 : if ((CAN_HAVE_LOCATION_P (t)) && (!EXPR_HAS_LOCATION (t)))
717 : 930702 : SET_EXPR_LOCATION (t, location);
718 : :
719 : 1165298 : if (pending_statement && (pending_location != location))
720 : 225647 : flush_pending_note ();
721 : :
722 : 1165298 : pending_statement = false;
723 : 1165298 : return do_add_stmt (t);
724 : : }
725 : :
726 : : /* addStmtNote remember this location represents the start of a
727 : : Modula-2 statement. It is flushed if another different location
728 : : is generated or another tree is given to add_stmt. */
729 : :
730 : : void
731 : 445879 : m2block_addStmtNote (location_t location)
732 : : {
733 : 445879 : if (pending_statement && (pending_location != location))
734 : 131781 : flush_pending_note ();
735 : :
736 : 445879 : pending_statement = true;
737 : 445879 : pending_location = location;
738 : 445879 : }
739 : :
740 : : void
741 : 145060 : m2block_removeStmtNote (void)
742 : : {
743 : 145060 : pending_statement = false;
744 : 145060 : }
745 : :
746 : : /* init - initialize the data structures in this module. */
747 : :
748 : : void
749 : 16160 : m2block_init (void)
750 : : {
751 : 16160 : global_binding_level = newLevel ();
752 : 16160 : global_binding_level->context = build_translation_unit_decl (NULL);
753 : 16160 : global_binding_level->is_global = true;
754 : 16160 : current_binding_level = NULL;
755 : 16160 : }
756 : :
757 : : #include "gt-m2-m2block.h"
|
