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