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