From 2231f17fa0b742bec5fdcad0894d02af2ddab08c Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 19 Sep 2010 13:48:51 +0000 Subject: gigi.h (get_elaboration_procedure): Declare. * gcc-interface/gigi.h (get_elaboration_procedure): Declare. (gnat_zaplevel): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity): Do not force global binding level for an external constant. : Force the local context and create a fake scope before translating the defining expression of an external constant. : Treat external constants at the global level explicitly for renaming declarations. (elaborate_expression_1): Force the variable to be static if the expression is global. * gcc-interface/trans.c (get_elaboration_procedure): New function. (call_to_gnu): Use it. (gnat_to_gnu): Likewise. : Do not test Is_Public to force the creation of an initialization variable. (add_decl_expr): Discard the statement if the declaration is external. * gcc-interface/utils.c (gnat_pushdecl): Do not put the declaration in the current block if it is external. (create_var_decl_1): Do not test Is_Public to set TREE_STATIC. (gnat_zaplevel): New global function. From-SVN: r164416 --- gcc/ada/gcc-interface/utils.c | 40 +++++++++++++++++++++++++++------------- 1 file changed, 27 insertions(+), 13 deletions(-) (limited to 'gcc/ada/gcc-interface/utils.c') diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index cadc4d7..98a1565 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -411,6 +411,22 @@ gnat_poplevel (void) free_binding_level = level; } +/* Exit a binding level and discard the associated BLOCK. */ + +void +gnat_zaplevel (void) +{ + struct gnat_binding_level *level = current_binding_level; + tree block = level->block; + + BLOCK_CHAIN (block) = free_block_chain; + free_block_chain = block; + + /* Free this binding structure. */ + current_binding_level = level->chain; + level->chain = free_binding_level; + free_binding_level = level; +} /* Records a ..._DECL node DECL as belonging to the current lexical scope and uses GNAT_NODE for location information and propagating flags. */ @@ -441,13 +457,12 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) add_decl_expr (decl, gnat_node); /* Put the declaration on the list. The list of declarations is in reverse - order. The list will be reversed later. Put global variables in the - globals list and builtin functions in a dedicated list to speed up - further lookups. Don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into - the list, as they will cause trouble with the debugger and aren't needed - anyway. */ - if (TREE_CODE (decl) != TYPE_DECL - || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE) + order. The list will be reversed later. Put global declarations in the + globals list and local ones in the current block. But skip TYPE_DECLs + for UNCONSTRAINED_ARRAY_TYPE in both cases, as they will cause trouble + with the debugger and aren't needed anyway. */ + if (!(TREE_CODE (decl) == TYPE_DECL + && TREE_CODE (TREE_TYPE (decl)) == UNCONSTRAINED_ARRAY_TYPE)) { if (global_bindings_p ()) { @@ -456,7 +471,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) if (TREE_CODE (decl) == FUNCTION_DECL && DECL_BUILT_IN (decl)) VEC_safe_push (tree, gc, builtin_decls, decl); } - else + else if (!DECL_EXTERNAL (decl)) { tree block; /* Fake PARM_DECLs go into the topmost block of the function. */ @@ -1371,12 +1386,11 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, && !have_global_bss_p ()) DECL_COMMON (var_decl) = 1; - /* If it's public and not external, always allocate storage for it. - At the global binding level we need to allocate static storage for the - variable if and only if it's not external. If we are not at the top level - we allocate automatic storage unless requested not to. */ + /* At the global binding level, we need to allocate static storage for the + variable if it isn't external. Otherwise, we allocate automatic storage + unless requested not to. */ TREE_STATIC (var_decl) - = !extern_flag && (public_flag || static_flag || global_bindings_p ()); + = !extern_flag && (static_flag || global_bindings_p ()); /* For an external constant whose initializer is not absolute, do not emit debug info. In DWARF this would mean a global relocation in a read-only -- cgit v1.1