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 : : /* GetTotalConstants returns the number of global constants. */
119 : :
120 : : int
121 : 0 : m2block_GetTotalConstants (void)
122 : : {
123 : 0 : return m2treelib_nCount (global_binding_level->constants);
124 : : }
125 : :
126 : : /* GetGlobalTypes returns the number of global types. */
127 : :
128 : : int
129 : 0 : m2block_GetGlobalTypes (void)
130 : : {
131 : 0 : return m2treelib_nCount (global_binding_level->types);
132 : : }
133 : :
134 : : /* assert_global_names asserts that the global_binding_level->names
135 : : can be chained. */
136 : :
137 : : static void
138 : 12763183 : assert_global_names (void)
139 : : {
140 : 12763183 : tree p = global_binding_level->names;
141 : :
142 : 6286681336 : while (p)
143 : 6273918153 : p = TREE_CHAIN (p);
144 : 12763183 : }
145 : :
146 : : /* lookupLabel return label tree in current scope, otherwise
147 : : NULL_TREE. */
148 : :
149 : : static tree
150 : 252607 : lookupLabel (tree id)
151 : : {
152 : 252607 : tree t;
153 : :
154 : 902460 : for (t = current_binding_level->labels; t != NULL_TREE; t = TREE_CHAIN (t))
155 : : {
156 : 787431 : tree l = TREE_VALUE (t);
157 : :
158 : 787431 : if (id == DECL_NAME (l))
159 : : return l;
160 : : }
161 : : return NULL_TREE;
162 : : }
163 : :
164 : : /* getLabel return the label name or create a label name in the
165 : : current scope. */
166 : :
167 : : tree
168 : 252607 : m2block_getLabel (location_t location, char *name)
169 : : {
170 : 252607 : tree id = get_identifier (name);
171 : 252607 : tree label = lookupLabel (id);
172 : :
173 : 252607 : if (label == NULL_TREE)
174 : : {
175 : 115029 : label = build_decl (location, LABEL_DECL, id, void_type_node);
176 : 115029 : current_binding_level->labels
177 : 115029 : = tree_cons (NULL_TREE, label, current_binding_level->labels);
178 : : }
179 : 252607 : if (DECL_CONTEXT (label) == NULL_TREE)
180 : 115041 : DECL_CONTEXT (label) = current_function_decl;
181 : 252607 : ASSERT ((DECL_CONTEXT (label) == current_function_decl),
182 : 252607 : current_function_decl);
183 : :
184 : 252607 : DECL_MODE (label) = VOIDmode;
185 : 252607 : return label;
186 : : }
187 : :
188 : : static void
189 : 134710 : init_binding_level (struct binding_level *l)
190 : : {
191 : 134710 : l->fndecl = NULL;
192 : 134710 : l->names = NULL;
193 : 134710 : l->is_global = 0;
194 : 134710 : l->context = NULL;
195 : 134710 : l->next = NULL;
196 : 134710 : l->list = NULL;
197 : 134710 : vec_alloc (l->m2_statements, 1);
198 : 134710 : l->constants = NULL;
199 : 134710 : l->init_functions = NULL;
200 : 134710 : l->types = NULL;
201 : 134710 : l->decl = NULL;
202 : 134710 : l->labels = NULL;
203 : 134710 : l->count = 0;
204 : 134710 : }
205 : :
206 : : static struct binding_level *
207 : 134710 : newLevel (void)
208 : : {
209 : 134710 : struct binding_level *newlevel = ggc_alloc<binding_level> ();
210 : :
211 : 134710 : init_binding_level (newlevel);
212 : :
213 : : /* Now we a push_statement_list. */
214 : 134710 : vec_safe_push (newlevel->m2_statements, m2block_begin_statement_list ());
215 : 134710 : return newlevel;
216 : : }
217 : :
218 : : tree *
219 : 1425946 : m2block_cur_stmt_list_addr (void)
220 : : {
221 : 1425946 : ASSERT_CONDITION (current_binding_level != NULL);
222 : 1425946 : int l = vec_safe_length (current_binding_level->m2_statements) - 1;
223 : :
224 : 1425946 : return &(*current_binding_level->m2_statements)[l];
225 : : }
226 : :
227 : : tree
228 : 0 : m2block_cur_stmt_list (void)
229 : : {
230 : 0 : tree *t = m2block_cur_stmt_list_addr ();
231 : :
232 : 0 : return *t;
233 : : }
234 : :
235 : : /* is_building_stmt_list returns true if we are building a
236 : : statement list. true is returned if we are in a binding level and
237 : : a statement list is under construction. */
238 : :
239 : : int
240 : 0 : m2block_is_building_stmt_list (void)
241 : : {
242 : 0 : ASSERT_CONDITION (current_binding_level != NULL);
243 : 0 : return !vec_safe_is_empty (current_binding_level->m2_statements);
244 : : }
245 : :
246 : : /* push_statement_list pushes the statement list t onto the
247 : : current binding level. */
248 : :
249 : : tree
250 : 96136 : m2block_push_statement_list (tree t)
251 : : {
252 : 96136 : ASSERT_CONDITION (current_binding_level != NULL);
253 : 96136 : vec_safe_push (current_binding_level->m2_statements, t);
254 : 96136 : return t;
255 : : }
256 : :
257 : : /* pop_statement_list pops and returns a statement list from the
258 : : current binding level. */
259 : :
260 : : tree
261 : 213896 : m2block_pop_statement_list (void)
262 : : {
263 : 213896 : ASSERT_CONDITION (current_binding_level != NULL);
264 : 213896 : {
265 : 213896 : tree t = current_binding_level->m2_statements->pop ();
266 : :
267 : 213896 : return t;
268 : : }
269 : : }
270 : :
271 : : /* begin_statement_list starts a tree statement. It pushes the
272 : : statement list and returns the list node. */
273 : :
274 : : tree
275 : 230846 : m2block_begin_statement_list (void)
276 : : {
277 : 230846 : return alloc_stmt_list ();
278 : : }
279 : :
280 : : /* findLevel returns the binding level associated with fndecl one
281 : : is created if there is no existing one on head_binding_level. */
282 : :
283 : : static struct binding_level *
284 : 4391267 : findLevel (tree fndecl)
285 : : {
286 : 4391267 : struct binding_level *b;
287 : :
288 : 4391267 : if (fndecl == NULL_TREE)
289 : 4273495 : return global_binding_level;
290 : :
291 : 117772 : b = head_binding_level;
292 : 117772 : while ((b != NULL) && (b->fndecl != fndecl))
293 : 0 : b = b->list;
294 : :
295 : 117772 : if (b == NULL)
296 : : {
297 : 117772 : b = newLevel ();
298 : 117772 : b->fndecl = fndecl;
299 : 117772 : b->context = fndecl;
300 : 117772 : b->is_global = false;
301 : 117772 : b->list = head_binding_level;
302 : 117772 : b->next = NULL;
303 : : }
304 : : return b;
305 : : }
306 : :
307 : : /* pushFunctionScope push a binding level. */
308 : :
309 : : void
310 : 4476761 : m2block_pushFunctionScope (tree fndecl)
311 : : {
312 : 4476761 : struct binding_level *n;
313 : 4476761 : struct binding_level *b;
314 : :
315 : : #if defined(DEBUGGING)
316 : : if (fndecl != NULL)
317 : : printf ("pushFunctionScope\n");
318 : : #endif
319 : :
320 : : /* Allow multiple consecutive pushes of the same scope. */
321 : :
322 : 4476761 : if (current_binding_level != NULL
323 : 119248 : && (current_binding_level->fndecl == fndecl))
324 : : {
325 : 85494 : current_binding_level->count++;
326 : 85494 : return;
327 : : }
328 : :
329 : : /* Firstly check to see that fndecl is not already on the binding
330 : : stack. */
331 : :
332 : 4425195 : for (b = current_binding_level; b != NULL; b = b->next)
333 : : /* Only allowed one instance of the binding on the stack at a time. */
334 : 33928 : ASSERT_CONDITION (b->fndecl != fndecl);
335 : :
336 : 4391267 : n = findLevel (fndecl);
337 : :
338 : : /* Add this level to the front of the stack. */
339 : 4391267 : n->next = current_binding_level;
340 : 4391267 : current_binding_level = n;
341 : : }
342 : :
343 : : /* popFunctionScope - pops a binding level, returning the function
344 : : associated with the binding level. */
345 : :
346 : : tree
347 : 203254 : m2block_popFunctionScope (void)
348 : : {
349 : 203254 : tree fndecl = current_binding_level->fndecl;
350 : :
351 : : #if defined(DEBUGGING)
352 : : if (fndecl != NULL)
353 : : printf ("popFunctionScope\n");
354 : : #endif
355 : :
356 : 203254 : if (current_binding_level->count > 0)
357 : : {
358 : : /* Multiple pushes have occurred of the same function scope (and
359 : : ignored), pop them likewise. */
360 : 85494 : current_binding_level->count--;
361 : 85494 : return fndecl;
362 : : }
363 : 117760 : ASSERT_CONDITION (current_binding_level->fndecl
364 : 117760 : != NULL_TREE); /* Expecting local scope. */
365 : :
366 : 117760 : ASSERT_CONDITION (current_binding_level->constants
367 : 117760 : == NULL_TREE); /* Should not be used. */
368 : 117760 : ASSERT_CONDITION (current_binding_level->names
369 : 117760 : == NULL_TREE); /* Should be cleared. */
370 : 117760 : ASSERT_CONDITION (current_binding_level->decl
371 : 117760 : == NULL_TREE); /* Should be cleared. */
372 : :
373 : 117760 : current_binding_level = current_binding_level->next;
374 : 117760 : return fndecl;
375 : : }
376 : :
377 : : /* pushGlobalScope push the global scope onto the binding level
378 : : stack. There can only ever be one instance of the global binding
379 : : level on the stack. */
380 : :
381 : : void
382 : 4273495 : m2block_pushGlobalScope (void)
383 : : {
384 : : #if defined(DEBUGGING)
385 : : printf ("pushGlobalScope\n");
386 : : #endif
387 : 4273495 : m2block_pushFunctionScope (NULL_TREE);
388 : 4273495 : }
389 : :
390 : : /* popGlobalScope pops the current binding level, it expects this
391 : : binding level to be the global binding level. */
392 : :
393 : : void
394 : 4273453 : m2block_popGlobalScope (void)
395 : : {
396 : 4273453 : ASSERT_CONDITION (
397 : 4273453 : current_binding_level->is_global); /* Expecting global scope. */
398 : 4273453 : ASSERT_CONDITION (current_binding_level == global_binding_level);
399 : :
400 : 4273453 : if (current_binding_level->count > 0)
401 : : {
402 : 0 : current_binding_level->count--;
403 : 0 : return;
404 : : }
405 : :
406 : 4273453 : current_binding_level = current_binding_level->next;
407 : : #if defined(DEBUGGING)
408 : : printf ("popGlobalScope\n");
409 : : #endif
410 : :
411 : 4273453 : assert_global_names ();
412 : : }
413 : :
414 : : /* finishFunctionDecl removes declarations from the current binding
415 : : level and places them inside fndecl. The current binding level is
416 : : then able to be destroyed by a call to popFunctionScope.
417 : :
418 : : The extra tree nodes associated with fndecl will be created such
419 : : as BIND_EXPR, BLOCK and the initial STATEMENT_LIST containing the
420 : : DECL_EXPR is also created. */
421 : :
422 : : void
423 : 118816 : m2block_finishFunctionDecl (location_t location, tree fndecl)
424 : : {
425 : 118816 : tree context = current_binding_level->context;
426 : 118816 : tree block = DECL_INITIAL (fndecl);
427 : 118816 : tree bind_expr = DECL_SAVED_TREE (fndecl);
428 : 118816 : tree i;
429 : :
430 : 118816 : if (block == NULL_TREE)
431 : : {
432 : 117772 : block = make_node (BLOCK);
433 : 117772 : DECL_INITIAL (fndecl) = block;
434 : 117772 : TREE_USED (block) = true;
435 : 117772 : BLOCK_SUBBLOCKS (block) = NULL_TREE;
436 : : }
437 : 118816 : BLOCK_SUPERCONTEXT (block) = context;
438 : :
439 : 237632 : BLOCK_VARS (block)
440 : 118816 : = chainon (BLOCK_VARS (block), current_binding_level->names);
441 : 118816 : TREE_USED (fndecl) = true;
442 : :
443 : 118816 : if (bind_expr == NULL_TREE)
444 : : {
445 : 117772 : bind_expr
446 : 117772 : = build3 (BIND_EXPR, void_type_node, current_binding_level->names,
447 : : current_binding_level->decl, block);
448 : 117772 : DECL_SAVED_TREE (fndecl) = bind_expr;
449 : : }
450 : : else
451 : : {
452 : 2088 : if (!chain_member (current_binding_level->names,
453 : 1044 : BIND_EXPR_VARS (bind_expr)))
454 : : {
455 : 630 : BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr),
456 : : current_binding_level->names);
457 : :
458 : 630 : if (current_binding_level->names != NULL_TREE)
459 : : {
460 : 198 : for (i = current_binding_level->names; i != NULL_TREE;
461 : 102 : i = DECL_CHAIN (i))
462 : 102 : append_to_statement_list_force (i,
463 : : &BIND_EXPR_BODY (bind_expr));
464 : :
465 : : }
466 : : }
467 : : }
468 : 118816 : SET_EXPR_LOCATION (bind_expr, location);
469 : :
470 : 118816 : current_binding_level->names = NULL_TREE;
471 : 118816 : current_binding_level->decl = NULL_TREE;
472 : 118816 : }
473 : :
474 : : /* finishFunctionCode adds cur_stmt_list to fndecl. The current
475 : : binding level is then able to be destroyed by a call to
476 : : popFunctionScope. The cur_stmt_list is appended to the
477 : : STATEMENT_LIST. */
478 : :
479 : : void
480 : 117760 : m2block_finishFunctionCode (tree fndecl)
481 : : {
482 : 117760 : tree bind_expr;
483 : 117760 : tree block;
484 : 117760 : tree statements = m2block_pop_statement_list ();
485 : 117760 : tree_stmt_iterator i;
486 : :
487 : 117760 : ASSERT_CONDITION (DECL_SAVED_TREE (fndecl) != NULL_TREE);
488 : :
489 : 117760 : bind_expr = DECL_SAVED_TREE (fndecl);
490 : 117760 : ASSERT_CONDITION (TREE_CODE (bind_expr) == BIND_EXPR);
491 : :
492 : 117760 : block = DECL_INITIAL (fndecl);
493 : 117760 : ASSERT_CONDITION (TREE_CODE (block) == BLOCK);
494 : :
495 : 117760 : if (current_binding_level->names != NULL_TREE)
496 : : {
497 : 76639 : BIND_EXPR_VARS (bind_expr)
498 : 76639 : = chainon (BIND_EXPR_VARS (bind_expr), current_binding_level->names);
499 : 76639 : current_binding_level->names = NULL_TREE;
500 : : }
501 : 117760 : if (current_binding_level->labels != NULL_TREE)
502 : : {
503 : : tree t;
504 : :
505 : 143643 : for (t = current_binding_level->labels; t != NULL_TREE;
506 : 115011 : t = TREE_CHAIN (t))
507 : : {
508 : 115011 : tree l = TREE_VALUE (t);
509 : :
510 : 115011 : BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), l);
511 : : }
512 : 28632 : current_binding_level->labels = NULL_TREE;
513 : : }
514 : :
515 : 117760 : BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr);
516 : :
517 : 117760 : if (current_binding_level->decl != NULL_TREE)
518 : 673955 : for (i = tsi_start (current_binding_level->decl); !tsi_end_p (i);
519 : 597316 : tsi_next (&i))
520 : 597316 : append_to_statement_list_force (*tsi_stmt_ptr (i),
521 : : &BIND_EXPR_BODY (bind_expr));
522 : :
523 : 1414480 : for (i = tsi_start (statements); !tsi_end_p (i); tsi_next (&i))
524 : 1296720 : append_to_statement_list_force (*tsi_stmt_ptr (i),
525 : : &BIND_EXPR_BODY (bind_expr));
526 : :
527 : 117760 : current_binding_level->decl = NULL_TREE;
528 : 117760 : }
529 : :
530 : : void
531 : 15466 : m2block_finishGlobals (void)
532 : : {
533 : 15466 : tree context = global_binding_level->context;
534 : 15466 : tree block = make_node (BLOCK);
535 : 15466 : tree p = global_binding_level->names;
536 : :
537 : 15466 : BLOCK_SUBBLOCKS (block) = NULL;
538 : 15466 : TREE_USED (block) = 1;
539 : :
540 : 15466 : BLOCK_VARS (block) = p;
541 : :
542 : 15466 : DECL_INITIAL (context) = block;
543 : 15466 : BLOCK_SUPERCONTEXT (block) = context;
544 : 15466 : }
545 : :
546 : : /* pushDecl pushes a declaration onto the current binding level. */
547 : :
548 : : tree
549 : 8489730 : m2block_pushDecl (tree decl)
550 : : {
551 : : /* External objects aren't nested, other objects may be. */
552 : :
553 : 8489730 : if (decl != current_function_decl)
554 : 8489730 : DECL_CONTEXT (decl) = current_binding_level->context;
555 : :
556 : : /* Put the declaration on the list. The list of declarations is in
557 : : reverse order. The list will be reversed later if necessary. This
558 : : needs to be this way for compatibility with the back-end. */
559 : :
560 : 8489730 : TREE_CHAIN (decl) = current_binding_level->names;
561 : 8489730 : current_binding_level->names = decl;
562 : :
563 : 8489730 : assert_global_names ();
564 : :
565 : 8489730 : return decl;
566 : : }
567 : :
568 : : /* includeDecl pushes a declaration onto the current binding level
569 : : providing it is not already present. */
570 : :
571 : : void
572 : 0 : m2block_includeDecl (tree decl)
573 : : {
574 : 0 : tree p = current_binding_level->names;
575 : :
576 : 0 : while (p != decl && p != NULL)
577 : 0 : p = TREE_CHAIN (p);
578 : 0 : if (p != decl)
579 : 0 : m2block_pushDecl (decl);
580 : 0 : }
581 : :
582 : : /* addDeclExpr adds the DECL_EXPR node t to the statement list
583 : : current_binding_level->decl. This allows us to order all
584 : : declarations at the beginning of the function. */
585 : :
586 : : void
587 : 679086 : m2block_addDeclExpr (tree t)
588 : : {
589 : 679086 : append_to_statement_list_force (t, ¤t_binding_level->decl);
590 : 679086 : }
591 : :
592 : : /* RememberType remember the type t in the ggc marked list. */
593 : :
594 : : tree
595 : 1812113 : m2block_RememberType (tree t)
596 : : {
597 : 1812113 : global_binding_level->types
598 : 1812113 : = tree_cons (NULL_TREE, t, global_binding_level->types);
599 : 1812113 : return t;
600 : : }
601 : :
602 : : /* global_constant returns t. It chains t onto the
603 : : global_binding_level list of constants, if it is not already
604 : : present. */
605 : :
606 : : tree
607 : 11509324 : m2block_global_constant (tree t)
608 : : {
609 : 11509324 : tree s;
610 : :
611 : 11509324 : if (global_binding_level->constants != NULL_TREE)
612 : 1755304024 : for (s = global_binding_level->constants; s != NULL_TREE;
613 : 1743811638 : s = TREE_CHAIN (s))
614 : : {
615 : 1752069840 : tree c = TREE_VALUE (s);
616 : :
617 : 1752069840 : if (c == t)
618 : : return t;
619 : : }
620 : :
621 : 3251122 : global_binding_level->constants
622 : 3251122 : = tree_cons (NULL_TREE, t, global_binding_level->constants);
623 : 3251122 : return t;
624 : : }
625 : :
626 : : /* RememberConstant adds a tree t onto the list of constants to
627 : : be marked whenever the ggc re-marks all used storage. Constants
628 : : live throughout the whole compilation and they can be used by
629 : : many different functions if necessary. */
630 : :
631 : : tree
632 : 26488344 : m2block_RememberConstant (tree t)
633 : : {
634 : 26488344 : if ((t != NULL) && (m2tree_IsAConstant (t)))
635 : 11441336 : return m2block_global_constant (t);
636 : : return t;
637 : : }
638 : :
639 : : /* DumpGlobalConstants displays all global constants and checks
640 : : none are poisoned. */
641 : :
642 : : tree
643 : 0 : m2block_DumpGlobalConstants (void)
644 : : {
645 : 0 : tree s;
646 : :
647 : 0 : if (global_binding_level->constants != NULL_TREE)
648 : 0 : for (s = global_binding_level->constants; TREE_CHAIN (s);
649 : 0 : s = TREE_CHAIN (s))
650 : 0 : debug_tree (s);
651 : 0 : return NULL_TREE;
652 : : }
653 : :
654 : : /* RememberInitModuleFunction records tree t in the global
655 : : binding level. So that it will not be garbage collected. In
656 : : theory the inner modules could be placed inside the
657 : : current_binding_level I suspect. */
658 : :
659 : : tree
660 : 0 : m2block_RememberInitModuleFunction (tree t)
661 : : {
662 : 0 : global_binding_level->init_functions
663 : 0 : = tree_cons (NULL_TREE, t, global_binding_level->init_functions);
664 : 0 : return t;
665 : : }
666 : :
667 : : /* toplevel return true if we are in the global scope. */
668 : :
669 : : bool
670 : 147450 : m2block_toplevel (void)
671 : : {
672 : 147450 : if (current_binding_level == NULL)
673 : : return true;
674 : 147450 : if (current_binding_level->fndecl == NULL)
675 : 147450 : return true;
676 : : return false;
677 : : }
678 : :
679 : : /* GetErrorNode returns the gcc error_mark_node. */
680 : :
681 : : tree
682 : 17414536 : m2block_GetErrorNode (void)
683 : : {
684 : 17414536 : return error_mark_node;
685 : : }
686 : :
687 : : /* GetGlobals returns a list of global variables, functions and constants. */
688 : :
689 : : tree
690 : 0 : m2block_GetGlobals (void)
691 : : {
692 : 0 : assert_global_names ();
693 : 0 : return global_binding_level->names;
694 : : }
695 : :
696 : : /* GetGlobalContext - returns the global context tree. */
697 : :
698 : : tree
699 : 106250 : m2block_GetGlobalContext (void)
700 : : {
701 : 106250 : return global_binding_level->context;
702 : : }
703 : :
704 : : /* do_add_stmt t is a statement. Add it to the statement-tree. */
705 : :
706 : : static tree
707 : 1425946 : do_add_stmt (tree t)
708 : : {
709 : 1425946 : if (current_binding_level != NULL)
710 : 1425946 : append_to_statement_list_force (t, m2block_cur_stmt_list_addr ());
711 : 1425946 : return t;
712 : : }
713 : :
714 : : /* flush_pending_note flushes a pending_statement note if necessary. */
715 : :
716 : : static void
717 : 443144 : flush_pending_note (void)
718 : : {
719 : 443144 : if (pending_statement && (M2Options_GetM2g ()))
720 : : {
721 : 55692 : tree note = build_empty_stmt (pending_location);
722 : 55692 : pending_statement = false;
723 : 55692 : do_add_stmt (note);
724 : : }
725 : 443144 : }
726 : :
727 : : /* add_stmt t is a statement. Add it to the statement-tree. */
728 : :
729 : : tree
730 : 1370254 : m2block_add_stmt (location_t location, tree t)
731 : : {
732 : 1370254 : if ((CAN_HAVE_LOCATION_P (t)) && (!EXPR_HAS_LOCATION (t)))
733 : 1089742 : SET_EXPR_LOCATION (t, location);
734 : :
735 : 1370254 : if (pending_statement && (pending_location != location))
736 : 277437 : flush_pending_note ();
737 : :
738 : 1370254 : pending_statement = false;
739 : 1370254 : return do_add_stmt (t);
740 : : }
741 : :
742 : : /* addStmtNote remember this location represents the start of a
743 : : Modula-2 statement. It is flushed if another different location
744 : : is generated or another tree is given to add_stmt. */
745 : :
746 : : void
747 : 545793 : m2block_addStmtNote (location_t location)
748 : : {
749 : 545793 : if (pending_statement && (pending_location != location))
750 : 165707 : flush_pending_note ();
751 : :
752 : 545793 : pending_statement = true;
753 : 545793 : pending_location = location;
754 : 545793 : }
755 : :
756 : : void
757 : 168888 : m2block_removeStmtNote (void)
758 : : {
759 : 168888 : pending_statement = false;
760 : 168888 : }
761 : :
762 : : /* init - initialize the data structures in this module. */
763 : :
764 : : void
765 : 16938 : m2block_init (void)
766 : : {
767 : 16938 : global_binding_level = newLevel ();
768 : 16938 : global_binding_level->context = build_translation_unit_decl (NULL);
769 : 16938 : global_binding_level->is_global = true;
770 : 16938 : current_binding_level = NULL;
771 : 16938 : }
772 : :
773 : : #include "gt-m2-m2block.h"
|
