Line data Source code
1 : /* m2block.cc provides an interface to maintaining block structures.
2 :
3 : Copyright (C) 2012-2026 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 11916947 : assert_global_names (void)
139 : {
140 11916947 : tree p = global_binding_level->names;
141 :
142 6134127978 : while (p)
143 6122211031 : p = TREE_CHAIN (p);
144 11916947 : }
145 :
146 : /* lookupLabel return label tree in current scope, otherwise
147 : NULL_TREE. */
148 :
149 : static tree
150 224692 : lookupLabel (tree id)
151 : {
152 224692 : tree t;
153 :
154 813022 : for (t = current_binding_level->labels; t != NULL_TREE; t = TREE_CHAIN (t))
155 : {
156 710216 : tree l = TREE_VALUE (t);
157 :
158 710216 : 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 224692 : m2block_getLabel (location_t location, char *name)
169 : {
170 224692 : tree id = get_identifier (name);
171 224692 : tree label = lookupLabel (id);
172 :
173 224692 : if (label == NULL_TREE)
174 : {
175 102806 : label = build_decl (location, LABEL_DECL, id, void_type_node);
176 102806 : current_binding_level->labels
177 102806 : = tree_cons (NULL_TREE, label, current_binding_level->labels);
178 : }
179 224692 : if (DECL_CONTEXT (label) == NULL_TREE)
180 102818 : DECL_CONTEXT (label) = current_function_decl;
181 224692 : ASSERT ((DECL_CONTEXT (label) == current_function_decl),
182 224692 : current_function_decl);
183 :
184 224692 : DECL_MODE (label) = VOIDmode;
185 224692 : return label;
186 : }
187 :
188 : static void
189 120925 : init_binding_level (struct binding_level *l)
190 : {
191 120925 : l->fndecl = NULL;
192 120925 : l->names = NULL;
193 120925 : l->is_global = 0;
194 120925 : l->context = NULL;
195 120925 : l->next = NULL;
196 120925 : l->list = NULL;
197 120925 : vec_alloc (l->m2_statements, 1);
198 120925 : l->constants = NULL;
199 120925 : l->init_functions = NULL;
200 120925 : l->types = NULL;
201 120925 : l->decl = NULL;
202 120925 : l->labels = NULL;
203 120925 : l->count = 0;
204 120925 : }
205 :
206 : static struct binding_level *
207 120925 : newLevel (void)
208 : {
209 120925 : struct binding_level *newlevel = ggc_alloc<binding_level> ();
210 :
211 120925 : init_binding_level (newlevel);
212 :
213 : /* Now we a push_statement_list. */
214 120925 : vec_safe_push (newlevel->m2_statements, m2block_begin_statement_list ());
215 120925 : return newlevel;
216 : }
217 :
218 : tree *
219 1304945 : m2block_cur_stmt_list_addr (void)
220 : {
221 1304945 : ASSERT_CONDITION (current_binding_level != NULL);
222 1304945 : int l = vec_safe_length (current_binding_level->m2_statements) - 1;
223 :
224 1304945 : 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 85359 : m2block_push_statement_list (tree t)
251 : {
252 85359 : ASSERT_CONDITION (current_binding_level != NULL);
253 85359 : vec_safe_push (current_binding_level->m2_statements, t);
254 85359 : return t;
255 : }
256 :
257 : /* pop_statement_list pops and returns a statement list from the
258 : current binding level. */
259 :
260 : tree
261 191320 : m2block_pop_statement_list (void)
262 : {
263 191320 : ASSERT_CONDITION (current_binding_level != NULL);
264 191320 : {
265 191320 : tree t = current_binding_level->m2_statements->pop ();
266 :
267 191320 : 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 206284 : m2block_begin_statement_list (void)
276 : {
277 206284 : 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 4172631 : findLevel (tree fndecl)
285 : {
286 4172631 : struct binding_level *b;
287 :
288 4172631 : if (fndecl == NULL_TREE)
289 4066658 : return global_binding_level;
290 :
291 105973 : b = head_binding_level;
292 105973 : while ((b != NULL) && (b->fndecl != fndecl))
293 0 : b = b->list;
294 :
295 105973 : if (b == NULL)
296 : {
297 105973 : b = newLevel ();
298 105973 : b->fndecl = fndecl;
299 105973 : b->context = fndecl;
300 105973 : b->is_global = false;
301 105973 : b->list = head_binding_level;
302 105973 : b->next = NULL;
303 : }
304 : return b;
305 : }
306 :
307 : /* pushFunctionScope push a binding level. */
308 :
309 : void
310 4250436 : m2block_pushFunctionScope (tree fndecl)
311 : {
312 4250436 : struct binding_level *n;
313 4250436 : 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 4250436 : if (current_binding_level != NULL
323 107449 : && (current_binding_level->fndecl == fndecl))
324 : {
325 77805 : current_binding_level->count++;
326 77805 : return;
327 : }
328 :
329 : /* Firstly check to see that fndecl is not already on the binding
330 : stack. */
331 :
332 4202449 : 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 29818 : ASSERT_CONDITION (b->fndecl != fndecl);
335 :
336 4172631 : n = findLevel (fndecl);
337 :
338 : /* Add this level to the front of the stack. */
339 4172631 : n->next = current_binding_level;
340 4172631 : 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 183766 : m2block_popFunctionScope (void)
348 : {
349 183766 : tree fndecl = current_binding_level->fndecl;
350 :
351 : #if defined(DEBUGGING)
352 : if (fndecl != NULL)
353 : printf ("popFunctionScope\n");
354 : #endif
355 :
356 183766 : if (current_binding_level->count > 0)
357 : {
358 : /* Multiple pushes have occurred of the same function scope (and
359 : ignored), pop them likewise. */
360 77805 : current_binding_level->count--;
361 77805 : return fndecl;
362 : }
363 105961 : ASSERT_CONDITION (current_binding_level->fndecl
364 105961 : != NULL_TREE); /* Expecting local scope. */
365 :
366 105961 : ASSERT_CONDITION (current_binding_level->constants
367 105961 : == NULL_TREE); /* Should not be used. */
368 105961 : ASSERT_CONDITION (current_binding_level->names
369 105961 : == NULL_TREE); /* Should be cleared. */
370 105961 : ASSERT_CONDITION (current_binding_level->decl
371 105961 : == NULL_TREE); /* Should be cleared. */
372 :
373 105961 : current_binding_level = current_binding_level->next;
374 105961 : 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 4066658 : m2block_pushGlobalScope (void)
383 : {
384 : #if defined(DEBUGGING)
385 : printf ("pushGlobalScope\n");
386 : #endif
387 4066658 : m2block_pushFunctionScope (NULL_TREE);
388 4066658 : }
389 :
390 : /* popGlobalScope pops the current binding level, it expects this
391 : binding level to be the global binding level. */
392 :
393 : void
394 4066616 : m2block_popGlobalScope (void)
395 : {
396 4066616 : ASSERT_CONDITION (
397 4066616 : current_binding_level->is_global); /* Expecting global scope. */
398 4066616 : ASSERT_CONDITION (current_binding_level == global_binding_level);
399 :
400 4066616 : if (current_binding_level->count > 0)
401 : {
402 0 : current_binding_level->count--;
403 0 : return;
404 : }
405 :
406 4066616 : current_binding_level = current_binding_level->next;
407 : #if defined(DEBUGGING)
408 : printf ("popGlobalScope\n");
409 : #endif
410 :
411 4066616 : 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 107017 : m2block_finishFunctionDecl (location_t location, tree fndecl)
424 : {
425 107017 : tree context = current_binding_level->context;
426 107017 : tree block = DECL_INITIAL (fndecl);
427 107017 : tree bind_expr = DECL_SAVED_TREE (fndecl);
428 107017 : tree i;
429 :
430 107017 : if (block == NULL_TREE)
431 : {
432 105973 : block = make_node (BLOCK);
433 105973 : DECL_INITIAL (fndecl) = block;
434 105973 : TREE_USED (block) = true;
435 105973 : BLOCK_SUBBLOCKS (block) = NULL_TREE;
436 : }
437 107017 : BLOCK_SUPERCONTEXT (block) = context;
438 :
439 214034 : BLOCK_VARS (block)
440 107017 : = chainon (BLOCK_VARS (block), current_binding_level->names);
441 107017 : TREE_USED (fndecl) = true;
442 :
443 107017 : if (bind_expr == NULL_TREE)
444 : {
445 105973 : bind_expr
446 105973 : = build3 (BIND_EXPR, void_type_node, current_binding_level->names,
447 : current_binding_level->decl, block);
448 105973 : 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 107017 : SET_EXPR_LOCATION (bind_expr, location);
469 :
470 107017 : current_binding_level->names = NULL_TREE;
471 107017 : current_binding_level->decl = NULL_TREE;
472 107017 : }
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 105961 : m2block_finishFunctionCode (tree fndecl)
481 : {
482 105961 : tree bind_expr;
483 105961 : tree block;
484 105961 : tree statements = m2block_pop_statement_list ();
485 105961 : tree_stmt_iterator i;
486 :
487 105961 : ASSERT_CONDITION (DECL_SAVED_TREE (fndecl) != NULL_TREE);
488 :
489 105961 : bind_expr = DECL_SAVED_TREE (fndecl);
490 105961 : ASSERT_CONDITION (TREE_CODE (bind_expr) == BIND_EXPR);
491 :
492 105961 : block = DECL_INITIAL (fndecl);
493 105961 : ASSERT_CONDITION (TREE_CODE (block) == BLOCK);
494 :
495 105961 : if (current_binding_level->names != NULL_TREE)
496 : {
497 69281 : BIND_EXPR_VARS (bind_expr)
498 69281 : = chainon (BIND_EXPR_VARS (bind_expr), current_binding_level->names);
499 69281 : current_binding_level->names = NULL_TREE;
500 : }
501 105961 : if (current_binding_level->labels != NULL_TREE)
502 : {
503 : tree t;
504 :
505 128667 : for (t = current_binding_level->labels; t != NULL_TREE;
506 102788 : t = TREE_CHAIN (t))
507 : {
508 102788 : tree l = TREE_VALUE (t);
509 :
510 102788 : BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), l);
511 : }
512 25879 : current_binding_level->labels = NULL_TREE;
513 : }
514 :
515 105961 : BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr);
516 :
517 105961 : if (current_binding_level->decl != NULL_TREE)
518 614791 : for (i = tsi_start (current_binding_level->decl); !tsi_end_p (i);
519 545510 : tsi_next (&i))
520 545510 : append_to_statement_list_force (*tsi_stmt_ptr (i),
521 : &BIND_EXPR_BODY (bind_expr));
522 :
523 1292347 : for (i = tsi_start (statements); !tsi_end_p (i); tsi_next (&i))
524 1186386 : append_to_statement_list_force (*tsi_stmt_ptr (i),
525 : &BIND_EXPR_BODY (bind_expr));
526 :
527 105961 : current_binding_level->decl = NULL_TREE;
528 105961 : }
529 :
530 : void
531 13418 : m2block_finishGlobals (void)
532 : {
533 13418 : tree context = global_binding_level->context;
534 13418 : tree block = make_node (BLOCK);
535 13418 : tree p = global_binding_level->names;
536 :
537 13418 : BLOCK_SUBBLOCKS (block) = NULL;
538 13418 : TREE_USED (block) = 1;
539 :
540 13418 : BLOCK_VARS (block) = p;
541 :
542 13418 : DECL_INITIAL (context) = block;
543 13418 : BLOCK_SUPERCONTEXT (block) = context;
544 13418 : }
545 :
546 : /* pushDecl pushes a declaration onto the current binding level. */
547 :
548 : tree
549 7850331 : m2block_pushDecl (tree decl)
550 : {
551 : /* External objects aren't nested, other objects may be. */
552 :
553 7850331 : if (decl != current_function_decl)
554 7850331 : 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 7850331 : TREE_CHAIN (decl) = current_binding_level->names;
561 7850331 : current_binding_level->names = decl;
562 :
563 7850331 : assert_global_names ();
564 :
565 7850331 : 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 626610 : m2block_addDeclExpr (tree t)
588 : {
589 626610 : append_to_statement_list_force (t, ¤t_binding_level->decl);
590 626610 : }
591 :
592 : /* RememberType remember the type t in the ggc marked list. */
593 :
594 : tree
595 1755645 : m2block_RememberType (tree t)
596 : {
597 1755645 : global_binding_level->types
598 1755645 : = tree_cons (NULL_TREE, t, global_binding_level->types);
599 1755645 : 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 10845748 : m2block_global_constant (tree t)
608 : {
609 10845748 : tree s;
610 :
611 10845748 : if (global_binding_level->constants != NULL_TREE)
612 1713839117 : for (s = global_binding_level->constants; s != NULL_TREE;
613 1703008321 : s = TREE_CHAIN (s))
614 : {
615 1710848612 : tree c = TREE_VALUE (s);
616 :
617 1710848612 : if (c == t)
618 : return t;
619 : }
620 :
621 3005457 : global_binding_level->constants
622 3005457 : = tree_cons (NULL_TREE, t, global_binding_level->constants);
623 3005457 : 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 24858480 : m2block_RememberConstant (tree t)
633 : {
634 24858480 : if ((t != NULL) && (m2tree_IsAConstant (t)))
635 10780399 : 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 142521 : m2block_toplevel (void)
671 : {
672 142521 : if (current_binding_level == NULL)
673 : return true;
674 142521 : if (current_binding_level->fndecl == NULL)
675 142521 : return true;
676 : return false;
677 : }
678 :
679 : /* GetErrorNode returns the gcc error_mark_node. */
680 :
681 : tree
682 16338866 : m2block_GetErrorNode (void)
683 : {
684 16338866 : 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 105580 : m2block_GetGlobalContext (void)
700 : {
701 105580 : 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 1304945 : do_add_stmt (tree t)
708 : {
709 1304945 : if (current_binding_level != NULL)
710 1304945 : append_to_statement_list_force (t, m2block_cur_stmt_list_addr ());
711 1304945 : return t;
712 : }
713 :
714 : /* flush_pending_note flushes a pending_statement note if necessary. */
715 :
716 : static void
717 396649 : flush_pending_note (void)
718 : {
719 396649 : if (pending_statement && (M2Options_GetM2g ()))
720 : {
721 56216 : tree note = build_empty_stmt (pending_location);
722 56216 : pending_statement = false;
723 56216 : do_add_stmt (note);
724 : }
725 396649 : }
726 :
727 : /* add_stmt t is a statement. Add it to the statement-tree. */
728 :
729 : tree
730 1248729 : m2block_add_stmt (location_t location, tree t)
731 : {
732 1248729 : if ((CAN_HAVE_LOCATION_P (t)) && (!EXPR_HAS_LOCATION (t)))
733 991864 : SET_EXPR_LOCATION (t, location);
734 :
735 1248729 : if (pending_statement && (pending_location != location))
736 247823 : flush_pending_note ();
737 :
738 1248729 : pending_statement = false;
739 1248729 : 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 482879 : m2block_addStmtNote (location_t location)
748 : {
749 482879 : if (pending_statement && (pending_location != location))
750 148826 : flush_pending_note ();
751 :
752 482879 : pending_statement = true;
753 482879 : pending_location = location;
754 482879 : }
755 :
756 : void
757 153510 : m2block_removeStmtNote (void)
758 : {
759 153510 : pending_statement = false;
760 153510 : }
761 :
762 : /* init - initialize the data structures in this module. */
763 :
764 : void
765 14952 : m2block_init (void)
766 : {
767 14952 : global_binding_level = newLevel ();
768 14952 : global_binding_level->context = build_translation_unit_decl (NULL);
769 14952 : global_binding_level->is_global = true;
770 14952 : current_binding_level = NULL;
771 14952 : }
772 :
773 : #include "gt-m2-m2block.h"
|
