]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | /* m2block.cc provides an interface to maintaining block structures. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2012-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
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 | assert_global_names (void) | |
122 | { | |
123 | tree p = global_binding_level->names; | |
124 | ||
125 | while (p) | |
126 | p = TREE_CHAIN (p); | |
127 | } | |
128 | ||
129 | /* lookupLabel return label tree in current scope, otherwise | |
130 | NULL_TREE. */ | |
131 | ||
132 | static tree | |
133 | lookupLabel (tree id) | |
134 | { | |
135 | tree t; | |
136 | ||
137 | for (t = current_binding_level->labels; t != NULL_TREE; t = TREE_CHAIN (t)) | |
138 | { | |
139 | tree l = TREE_VALUE (t); | |
140 | ||
141 | 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 | m2block_getLabel (location_t location, char *name) | |
152 | { | |
153 | tree id = get_identifier (name); | |
154 | tree label = lookupLabel (id); | |
155 | ||
156 | if (label == NULL_TREE) | |
157 | { | |
158 | label = build_decl (location, LABEL_DECL, id, void_type_node); | |
159 | current_binding_level->labels | |
160 | = tree_cons (NULL_TREE, label, current_binding_level->labels); | |
161 | } | |
162 | if (DECL_CONTEXT (label) == NULL_TREE) | |
163 | DECL_CONTEXT (label) = current_function_decl; | |
164 | ASSERT ((DECL_CONTEXT (label) == current_function_decl), | |
165 | current_function_decl); | |
166 | ||
167 | DECL_MODE (label) = VOIDmode; | |
168 | return label; | |
169 | } | |
170 | ||
171 | static void | |
172 | init_binding_level (struct binding_level *l) | |
173 | { | |
174 | l->fndecl = NULL; | |
175 | l->names = NULL; | |
176 | l->is_global = 0; | |
177 | l->context = NULL; | |
178 | l->next = NULL; | |
179 | l->list = NULL; | |
180 | vec_alloc (l->m2_statements, 1); | |
181 | l->constants = NULL; | |
182 | l->init_functions = NULL; | |
183 | l->types = NULL; | |
184 | l->decl = NULL; | |
185 | l->labels = NULL; | |
186 | l->count = 0; | |
187 | } | |
188 | ||
189 | static struct binding_level * | |
190 | newLevel (void) | |
191 | { | |
192 | struct binding_level *newlevel = ggc_alloc<binding_level> (); | |
193 | ||
194 | init_binding_level (newlevel); | |
195 | ||
196 | /* Now we a push_statement_list. */ | |
197 | vec_safe_push (newlevel->m2_statements, m2block_begin_statement_list ()); | |
198 | return newlevel; | |
199 | } | |
200 | ||
201 | tree * | |
202 | m2block_cur_stmt_list_addr (void) | |
203 | { | |
204 | ASSERT_CONDITION (current_binding_level != NULL); | |
205 | int l = vec_safe_length (current_binding_level->m2_statements) - 1; | |
206 | ||
207 | return &(*current_binding_level->m2_statements)[l]; | |
208 | } | |
209 | ||
210 | tree | |
211 | m2block_cur_stmt_list (void) | |
212 | { | |
213 | tree *t = m2block_cur_stmt_list_addr (); | |
214 | ||
215 | 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 | m2block_is_building_stmt_list (void) | |
224 | { | |
225 | ASSERT_CONDITION (current_binding_level != NULL); | |
226 | 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 | m2block_push_statement_list (tree t) | |
234 | { | |
235 | ASSERT_CONDITION (current_binding_level != NULL); | |
236 | vec_safe_push (current_binding_level->m2_statements, t); | |
237 | return t; | |
238 | } | |
239 | ||
240 | /* pop_statement_list pops and returns a statement list from the | |
241 | current binding level. */ | |
242 | ||
243 | tree | |
244 | m2block_pop_statement_list (void) | |
245 | { | |
246 | ASSERT_CONDITION (current_binding_level != NULL); | |
247 | { | |
248 | tree t = current_binding_level->m2_statements->pop (); | |
249 | ||
250 | 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 | m2block_begin_statement_list (void) | |
259 | { | |
260 | 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 | findLevel (tree fndecl) | |
268 | { | |
269 | struct binding_level *b; | |
270 | ||
271 | if (fndecl == NULL_TREE) | |
272 | return global_binding_level; | |
273 | ||
274 | b = head_binding_level; | |
275 | while ((b != NULL) && (b->fndecl != fndecl)) | |
276 | b = b->list; | |
277 | ||
278 | if (b == NULL) | |
279 | { | |
280 | b = newLevel (); | |
281 | b->fndecl = fndecl; | |
282 | b->context = fndecl; | |
283 | b->is_global = FALSE; | |
284 | b->list = head_binding_level; | |
285 | b->next = NULL; | |
286 | } | |
287 | return b; | |
288 | } | |
289 | ||
290 | /* pushFunctionScope push a binding level. */ | |
291 | ||
292 | void | |
293 | m2block_pushFunctionScope (tree fndecl) | |
294 | { | |
295 | struct binding_level *n; | |
296 | 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 | if (current_binding_level != NULL | |
306 | && (current_binding_level->fndecl == fndecl)) | |
307 | { | |
308 | current_binding_level->count++; | |
309 | return; | |
310 | } | |
311 | ||
312 | /* Firstly check to see that fndecl is not already on the binding | |
313 | stack. */ | |
314 | ||
315 | 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 | ASSERT_CONDITION (b->fndecl != fndecl); | |
318 | ||
319 | n = findLevel (fndecl); | |
320 | ||
321 | /* Add this level to the front of the stack. */ | |
322 | n->next = current_binding_level; | |
323 | 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 | m2block_popFunctionScope (void) | |
331 | { | |
332 | tree fndecl = current_binding_level->fndecl; | |
333 | ||
334 | #if defined(DEBUGGING) | |
335 | if (fndecl != NULL) | |
336 | printf ("popFunctionScope\n"); | |
337 | #endif | |
338 | ||
339 | if (current_binding_level->count > 0) | |
340 | { | |
341 | /* Multiple pushes have occurred of the same function scope (and | |
342 | ignored), pop them likewise. */ | |
343 | current_binding_level->count--; | |
344 | return fndecl; | |
345 | } | |
346 | ASSERT_CONDITION (current_binding_level->fndecl | |
347 | != NULL_TREE); /* Expecting local scope. */ | |
348 | ||
349 | ASSERT_CONDITION (current_binding_level->constants | |
350 | == NULL_TREE); /* Should not be used. */ | |
351 | ASSERT_CONDITION (current_binding_level->names | |
352 | == NULL_TREE); /* Should be cleared. */ | |
353 | ASSERT_CONDITION (current_binding_level->decl | |
354 | == NULL_TREE); /* Should be cleared. */ | |
355 | ||
356 | current_binding_level = current_binding_level->next; | |
357 | 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 | m2block_pushGlobalScope (void) | |
366 | { | |
367 | #if defined(DEBUGGING) | |
368 | printf ("pushGlobalScope\n"); | |
369 | #endif | |
370 | m2block_pushFunctionScope (NULL_TREE); | |
371 | } | |
372 | ||
373 | /* popGlobalScope pops the current binding level, it expects this | |
374 | binding level to be the global binding level. */ | |
375 | ||
376 | void | |
377 | m2block_popGlobalScope (void) | |
378 | { | |
379 | ASSERT_CONDITION ( | |
380 | current_binding_level->is_global); /* Expecting global scope. */ | |
381 | ASSERT_CONDITION (current_binding_level == global_binding_level); | |
382 | ||
383 | if (current_binding_level->count > 0) | |
384 | { | |
385 | current_binding_level->count--; | |
386 | return; | |
387 | } | |
388 | ||
389 | current_binding_level = current_binding_level->next; | |
390 | #if defined(DEBUGGING) | |
391 | printf ("popGlobalScope\n"); | |
392 | #endif | |
393 | ||
394 | 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 | m2block_finishFunctionDecl (location_t location, tree fndecl) | |
407 | { | |
408 | tree context = current_binding_level->context; | |
409 | tree block = DECL_INITIAL (fndecl); | |
410 | tree bind_expr = DECL_SAVED_TREE (fndecl); | |
411 | tree i; | |
412 | ||
413 | if (block == NULL_TREE) | |
414 | { | |
415 | block = make_node (BLOCK); | |
416 | DECL_INITIAL (fndecl) = block; | |
417 | TREE_USED (block) = TRUE; | |
418 | BLOCK_SUBBLOCKS (block) = NULL_TREE; | |
419 | } | |
420 | BLOCK_SUPERCONTEXT (block) = context; | |
421 | ||
422 | BLOCK_VARS (block) | |
423 | = chainon (BLOCK_VARS (block), current_binding_level->names); | |
424 | TREE_USED (fndecl) = TRUE; | |
425 | ||
426 | if (bind_expr == NULL_TREE) | |
427 | { | |
428 | bind_expr | |
429 | = build3 (BIND_EXPR, void_type_node, current_binding_level->names, | |
430 | current_binding_level->decl, block); | |
431 | DECL_SAVED_TREE (fndecl) = bind_expr; | |
432 | } | |
433 | else | |
434 | { | |
435 | if (!chain_member (current_binding_level->names, | |
436 | BIND_EXPR_VARS (bind_expr))) | |
437 | { | |
438 | BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), | |
439 | current_binding_level->names); | |
440 | ||
441 | if (current_binding_level->names != NULL_TREE) | |
442 | { | |
443 | for (i = current_binding_level->names; i != NULL_TREE; | |
444 | i = DECL_CHAIN (i)) | |
445 | append_to_statement_list_force (i, | |
446 | &BIND_EXPR_BODY (bind_expr)); | |
447 | ||
448 | } | |
449 | } | |
450 | } | |
451 | SET_EXPR_LOCATION (bind_expr, location); | |
452 | ||
453 | current_binding_level->names = NULL_TREE; | |
454 | current_binding_level->decl = NULL_TREE; | |
455 | } | |
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 | m2block_finishFunctionCode (tree fndecl) | |
464 | { | |
465 | tree bind_expr; | |
466 | tree block; | |
467 | tree statements = m2block_pop_statement_list (); | |
468 | tree_stmt_iterator i; | |
469 | ||
470 | ASSERT_CONDITION (DECL_SAVED_TREE (fndecl) != NULL_TREE); | |
471 | ||
472 | bind_expr = DECL_SAVED_TREE (fndecl); | |
473 | ASSERT_CONDITION (TREE_CODE (bind_expr) == BIND_EXPR); | |
474 | ||
475 | block = DECL_INITIAL (fndecl); | |
476 | ASSERT_CONDITION (TREE_CODE (block) == BLOCK); | |
477 | ||
478 | if (current_binding_level->names != NULL_TREE) | |
479 | { | |
480 | BIND_EXPR_VARS (bind_expr) | |
481 | = chainon (BIND_EXPR_VARS (bind_expr), current_binding_level->names); | |
482 | current_binding_level->names = NULL_TREE; | |
483 | } | |
484 | if (current_binding_level->labels != NULL_TREE) | |
485 | { | |
486 | tree t; | |
487 | ||
488 | for (t = current_binding_level->labels; t != NULL_TREE; | |
489 | t = TREE_CHAIN (t)) | |
490 | { | |
491 | tree l = TREE_VALUE (t); | |
492 | ||
493 | BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), l); | |
494 | } | |
495 | current_binding_level->labels = NULL_TREE; | |
496 | } | |
497 | ||
498 | BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr); | |
499 | ||
500 | if (current_binding_level->decl != NULL_TREE) | |
501 | for (i = tsi_start (current_binding_level->decl); !tsi_end_p (i); | |
502 | tsi_next (&i)) | |
503 | append_to_statement_list_force (*tsi_stmt_ptr (i), | |
504 | &BIND_EXPR_BODY (bind_expr)); | |
505 | ||
506 | for (i = tsi_start (statements); !tsi_end_p (i); tsi_next (&i)) | |
507 | append_to_statement_list_force (*tsi_stmt_ptr (i), | |
508 | &BIND_EXPR_BODY (bind_expr)); | |
509 | ||
510 | current_binding_level->decl = NULL_TREE; | |
511 | } | |
512 | ||
513 | void | |
514 | m2block_finishGlobals (void) | |
515 | { | |
516 | tree context = global_binding_level->context; | |
517 | tree block = make_node (BLOCK); | |
518 | tree p = global_binding_level->names; | |
519 | ||
520 | BLOCK_SUBBLOCKS (block) = NULL; | |
521 | TREE_USED (block) = 1; | |
522 | ||
523 | BLOCK_VARS (block) = p; | |
524 | ||
525 | DECL_INITIAL (context) = block; | |
526 | BLOCK_SUPERCONTEXT (block) = context; | |
527 | } | |
528 | ||
529 | /* pushDecl pushes a declaration onto the current binding level. */ | |
530 | ||
531 | tree | |
532 | m2block_pushDecl (tree decl) | |
533 | { | |
534 | /* External objects aren't nested, other objects may be. */ | |
535 | ||
536 | if (decl != current_function_decl) | |
537 | 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 | TREE_CHAIN (decl) = current_binding_level->names; | |
544 | current_binding_level->names = decl; | |
545 | ||
546 | assert_global_names (); | |
547 | ||
548 | 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 | m2block_includeDecl (tree decl) | |
556 | { | |
557 | tree p = current_binding_level->names; | |
558 | ||
559 | while (p != decl && p != NULL) | |
560 | p = TREE_CHAIN (p); | |
561 | if (p != decl) | |
562 | m2block_pushDecl (decl); | |
563 | } | |
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 | m2block_addDeclExpr (tree t) | |
571 | { | |
572 | append_to_statement_list_force (t, ¤t_binding_level->decl); | |
573 | } | |
574 | ||
575 | /* RememberType remember the type t in the ggc marked list. */ | |
576 | ||
577 | tree | |
578 | m2block_RememberType (tree t) | |
579 | { | |
580 | global_binding_level->types | |
581 | = tree_cons (NULL_TREE, t, global_binding_level->types); | |
582 | 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 | m2block_global_constant (tree t) | |
591 | { | |
592 | tree s; | |
593 | ||
594 | if (global_binding_level->constants != NULL_TREE) | |
595 | for (s = global_binding_level->constants; s != NULL_TREE; | |
596 | s = TREE_CHAIN (s)) | |
597 | { | |
598 | tree c = TREE_VALUE (s); | |
599 | ||
600 | if (c == t) | |
601 | return t; | |
602 | } | |
603 | ||
604 | global_binding_level->constants | |
605 | = tree_cons (NULL_TREE, t, global_binding_level->constants); | |
606 | 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 | m2block_RememberConstant (tree t) | |
616 | { | |
617 | if ((t != NULL) && (m2tree_IsAConstant (t))) | |
618 | 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 | m2block_DumpGlobalConstants (void) | |
627 | { | |
628 | tree s; | |
629 | ||
630 | if (global_binding_level->constants != NULL_TREE) | |
631 | for (s = global_binding_level->constants; TREE_CHAIN (s); | |
632 | s = TREE_CHAIN (s)) | |
633 | debug_tree (s); | |
634 | 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 | m2block_RememberInitModuleFunction (tree t) | |
644 | { | |
645 | global_binding_level->init_functions | |
646 | = tree_cons (NULL_TREE, t, global_binding_level->init_functions); | |
647 | return t; | |
648 | } | |
649 | ||
650 | /* toplevel return TRUE if we are in the global scope. */ | |
651 | ||
652 | int | |
653 | m2block_toplevel (void) | |
654 | { | |
655 | if (current_binding_level == NULL) | |
656 | return TRUE; | |
657 | if (current_binding_level->fndecl == NULL) | |
658 | return TRUE; | |
659 | return FALSE; | |
660 | } | |
661 | ||
662 | /* GetErrorNode returns the gcc error_mark_node. */ | |
663 | ||
664 | tree | |
665 | m2block_GetErrorNode (void) | |
666 | { | |
667 | return error_mark_node; | |
668 | } | |
669 | ||
670 | /* GetGlobals - returns a list of global variables, functions, | |
671 | constants. */ | |
672 | ||
673 | tree | |
674 | m2block_GetGlobals (void) | |
675 | { | |
676 | assert_global_names (); | |
677 | return global_binding_level->names; | |
678 | } | |
679 | ||
680 | /* GetGlobalContext - returns the global context tree. */ | |
681 | ||
682 | tree | |
683 | m2block_GetGlobalContext (void) | |
684 | { | |
685 | 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 | do_add_stmt (tree t) | |
692 | { | |
693 | if (current_binding_level != NULL) | |
694 | append_to_statement_list_force (t, m2block_cur_stmt_list_addr ()); | |
695 | return t; | |
696 | } | |
697 | ||
698 | /* flush_pending_note - flushes a pending_statement note if | |
699 | necessary. */ | |
700 | ||
701 | static void | |
702 | flush_pending_note (void) | |
703 | { | |
704 | 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_INPUT_P (note) = FALSE; | |
715 | ASM_VOLATILE_P (note) = FALSE; | |
716 | #else | |
717 | tree note = build_empty_stmt (pending_location); | |
718 | #endif | |
719 | pending_statement = FALSE; | |
720 | do_add_stmt (note); | |
721 | } | |
722 | } | |
723 | ||
724 | /* add_stmt t is a statement. Add it to the statement-tree. */ | |
725 | ||
726 | tree | |
727 | m2block_add_stmt (location_t location, tree t) | |
728 | { | |
729 | if ((CAN_HAVE_LOCATION_P (t)) && (!EXPR_HAS_LOCATION (t))) | |
730 | SET_EXPR_LOCATION (t, location); | |
731 | ||
732 | if (pending_statement && (pending_location != location)) | |
733 | flush_pending_note (); | |
734 | ||
735 | pending_statement = FALSE; | |
736 | 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 | m2block_addStmtNote (location_t location) | |
745 | { | |
746 | if (pending_statement && (pending_location != location)) | |
747 | flush_pending_note (); | |
748 | ||
749 | pending_statement = TRUE; | |
750 | pending_location = location; | |
751 | } | |
752 | ||
753 | void | |
754 | m2block_removeStmtNote (void) | |
755 | { | |
756 | pending_statement = FALSE; | |
757 | } | |
758 | ||
759 | /* init - initialize the data structures in this module. */ | |
760 | ||
761 | void | |
762 | m2block_init (void) | |
763 | { | |
764 | global_binding_level = newLevel (); | |
765 | global_binding_level->context = build_translation_unit_decl (NULL); | |
766 | global_binding_level->is_global = TRUE; | |
767 | current_binding_level = NULL; | |
768 | } | |
769 | ||
770 | #include "gt-m2-m2block.h" |