aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/utils.c
diff options
context:
space:
mode:
authorRichard Kenner <kenner@vlsi1.ultra.nyu.edu>2004-06-28 21:37:16 +0000
committerRichard Kenner <kenner@gcc.gnu.org>2004-06-28 17:37:16 -0400
commit909f21b39e4d27523d76258a039fd79911f11494 (patch)
treea44463195d1b28c4051fddd70db0dd209f3a0fe1 /gcc/ada/utils.c
parent0b55e9321430150f742bc7be3f7da16b1a3872d5 (diff)
downloadgcc-909f21b39e4d27523d76258a039fd79911f11494.zip
gcc-909f21b39e4d27523d76258a039fd79911f11494.tar.gz
gcc-909f21b39e4d27523d76258a039fd79911f11494.tar.bz2
decl.c: Remove calls to add_decl_expr...
* decl.c: Remove calls to add_decl_expr, pushdecl, rest_of_compilation, and rest_of_type_compilation; add arg to create_*_decl. (annotate_decl_with_node): Deleted. (gnat_to_gnu_entity, case E_Array_Type): Set location of fields. * gigi.h (get_decls, block_has_vars, pushdecl): Deleted. (get_current_block_context, gnat_pushdecl): New declarations. (gnat_init_stmt_group): Likewise. (create_var_decl, create_type_decl, create_subprog_decl): Add new arg. * misc.c (LANG_HOOKS_CLEAR_BINDING_STACK): Deleted. (LANG_HOOKS_GETDECLS, LANG_HOOKS_PUSHDECL): Deleted. (gnat_init): Call gnat_init_stmt_group. * trans.c (global_stmt_group, gnu_elab_proc_decl): New variables. (gnu_pending_elaboration_list): Deleted. (mark_visited, mark_unvisited, gnat_init_stmt_group): New functions. (gigi): Rearrange initialization calls and move some to last above. (gnat_to_gnu): If statement and not in procedure, go into elab proc. Delete calls to add_decl_expr; add arg to create_*_decl. (gnat_to_gnu, case N_Loop): Recalculate side effects on COND_EXPR. (gnat_to_gnu, case N_Subprogram_Body): Move some code to begin_subprog_body and call it. Don't push and pop ggc context. (gnat_to_gnu, case N_Compilation_Unit): Rework to support elab proc. (add_stmt): Remove handling of DECL_EXPR from here. If not in function, mark visited. (add_decl_expr): Put global at top level. Check for cases of DECL_INITIAL we have to handle here. (process_type): Add extra arg to create_type_decl. (build_unit_elab): Rework to just gimplify. * utils.c (pending_elaborations, elist_stack, getdecls): Deleted. (block_has_vars, mark_visited, add_pending_elaborations): Likewise. (get_pending_elaborations, pending_elaborations_p): Likewise. (push_pending_elaborations, pop_pending_elaborations): Likewise. (get_elaboration_location, insert_elaboration_list): Likewise. (gnat_binding_level): Renamed from ada_binding_level. (init_gnat_to_gnu): Don't clear pending_elaborations. (global_bindings_p): Treat as global if no current_binding_level. (set_current_block_context): New function. (gnat_pushdecl): Renamed from pushdecl; major rework. All callers changed. (create_type_decl, create_var_decl, create_subprog_decl): Add new arg. (finish_record_type): Call call pushdecl for stub decl. (function_nesting_depth): Deleted. (begin_subprog_body): Delete obsolete code. * utils2.c (build_call_alloc_dealloc): Add new arg to create_var_decl. From-SVN: r83816
Diffstat (limited to 'gcc/ada/utils.c')
-rw-r--r--gcc/ada/utils.c439
1 files changed, 140 insertions, 299 deletions
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 53823e8..5a0d558 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -79,21 +79,6 @@ tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
of `save_gnu_tree' for more info. */
static GTY((length ("max_gnat_nodes"))) tree *associate_gnat_to_gnu;
-/* This listhead is used to record any global objects that need elaboration.
- TREE_PURPOSE is the variable to be elaborated and TREE_VALUE is the
- initial value to assign. */
-
-static GTY(()) tree pending_elaborations;
-
-/* This stack allows us to momentarily switch to generating elaboration
- lists for an inner context. */
-
-struct e_stack GTY((chain_next ("%h.next"))) {
- struct e_stack *next;
- tree elab_list;
-};
-static GTY(()) struct e_stack *elist_stack;
-
/* This variable keeps a table for types for each precision so that we only
allocate each of them once. Signed and unsigned types are kept separate.
@@ -108,10 +93,10 @@ static GTY(()) tree float_types[NUM_MACHINE_MODES];
/* For each binding contour we allocate a binding_level structure to indicate
the binding depth. */
-struct ada_binding_level GTY((chain_next ("%h.chain")))
+struct gnat_binding_level GTY((chain_next ("%h.chain")))
{
/* The binding level containing this one (the enclosing binding level). */
- struct ada_binding_level *chain;
+ struct gnat_binding_level *chain;
/* The BLOCK node for this level. */
tree block;
/* If nonzero, the setjmp buffer that needs to be updated for any
@@ -120,10 +105,10 @@ struct ada_binding_level GTY((chain_next ("%h.chain")))
};
/* The binding level currently in effect. */
-static GTY(()) struct ada_binding_level *current_binding_level;
+static GTY(()) struct gnat_binding_level *current_binding_level;
-/* A chain of ada_binding_level structures awaiting reuse. */
-static GTY((deletable)) struct ada_binding_level *free_binding_level;
+/* A chain of gnat_binding_level structures awaiting reuse. */
+static GTY((deletable)) struct gnat_binding_level *free_binding_level;
/* A chain of unused BLOCK nodes. */
static GTY((deletable)) tree free_block_chain;
@@ -133,21 +118,20 @@ struct language_function GTY(())
int unused;
};
-static tree mark_visited (tree *, int *, void *);
static void gnat_define_builtin (const char *, tree, int, const char *, bool);
static void gnat_install_builtins (void);
-static tree merge_sizes (tree, tree, tree, int, int);
+static tree merge_sizes (tree, tree, tree, bool, bool);
static tree compute_related_constant (tree, tree);
static tree split_plus (tree, tree *);
-static int value_zerop (tree);
+static bool value_zerop (tree);
static void gnat_gimplify_function (tree);
static void gnat_finalize (tree);
static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree);
static tree make_descriptor_field (const char *,tree, tree, tree);
-static int value_factor_p (tree, int);
-static int potential_alignment_gap (tree, tree, tree);
+static bool value_factor_p (tree, HOST_WIDE_INT);
+static bool potential_alignment_gap (tree, tree, tree);
/* Initialize the association of GNAT nodes to GCC trees. */
@@ -156,8 +140,6 @@ init_gnat_to_gnu (void)
{
associate_gnat_to_gnu
= (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (tree));
-
- pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
}
/* GNAT_ENTITY is a GNAT tree node for an entity. GNU_DECL is the GCC tree
@@ -211,16 +193,8 @@ present_gnu_tree (Entity_Id gnat_entity)
int
global_bindings_p (void)
{
- return (force_global != 0 || current_binding_level->chain == 0 ? -1 : 0);
-}
-
-/* Return the list of declarations in the current level. Note that this list
- is in reverse order (it has to be so for back-end compatibility). */
-
-tree
-getdecls (void)
-{
- return BLOCK_VARS (current_binding_level->block);
+ return (force_global != 0 || current_binding_level == 0
+ || current_binding_level->chain == 0 ? -1 : 0);
}
/* Enter a new binding level. */
@@ -228,7 +202,7 @@ getdecls (void)
void
gnat_pushlevel ()
{
- struct ada_binding_level *newlevel = NULL;
+ struct gnat_binding_level *newlevel = NULL;
/* Reuse a struct for this binding level, if there is one. */
if (free_binding_level)
@@ -238,8 +212,8 @@ gnat_pushlevel ()
}
else
newlevel
- = (struct ada_binding_level *)
- ggc_alloc (sizeof (struct ada_binding_level));
+ = (struct gnat_binding_level *)
+ ggc_alloc (sizeof (struct gnat_binding_level));
/* Use a free BLOCK, if any; otherwise, allocate one. */
if (free_block_chain)
@@ -264,6 +238,16 @@ gnat_pushlevel ()
current_binding_level = newlevel;
}
+/* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
+ and point FNDECL to this BLOCK. */
+
+void
+set_current_block_context (tree fndecl)
+{
+ BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
+ DECL_INITIAL (fndecl) = current_binding_level->block;
+}
+
/* Set the jmpbuf_decl for the current binding level to DECL. */
void
@@ -285,7 +269,7 @@ get_block_jmpbuf_decl ()
void
gnat_poplevel ()
{
- struct ada_binding_level *level = current_binding_level;
+ struct gnat_binding_level *level = current_binding_level;
tree block = level->block;
BLOCK_VARS (block) = nreverse (BLOCK_VARS (block));
@@ -329,59 +313,33 @@ insert_block (tree block)
TREE_CHAIN (block) = BLOCK_SUBBLOCKS (current_binding_level->block);
BLOCK_SUBBLOCKS (current_binding_level->block) = block;
}
-
-/* Return nonzero if the current binding has any variables. This means
- it will have a BLOCK node. */
-
-int
-block_has_vars ()
-{
- return BLOCK_VARS (current_binding_level->block) != 0;
-}
-
-/* Utility function to mark nodes with TREE_VISITED. Called from walk_tree.
- We use this to indicate all variable sizes and positions in global types
- may not be shared by any subprogram. */
-
-static tree
-mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
-{
- if (TREE_VISITED (*tp))
- *walk_subtrees = 0;
- else
- TREE_VISITED (*tp) = 1;
-
- return NULL_TREE;
-}
-/* Records a ..._DECL node DECL as belonging to the current lexical scope.
- Returns the ..._DECL node. */
+/* Records a ..._DECL node DECL as belonging to the current lexical scope
+ and uses GNAT_NODE for location information. */
-tree
-pushdecl (tree decl)
+void
+gnat_pushdecl (tree decl, Node_Id gnat_node)
{
/* If at top level, there is no context. But PARM_DECLs always go in the
- level of its function. Also, at toplevel we must protect all trees
- that are part of sizes and positions. */
+ level of its function. */
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
- {
- /* Make a DECL_EXPR so we'll walk into the appropriate fields of
- the type or decl. */
- tree decl_expr = build1 (DECL_EXPR, void_type_node, decl);
-
- DECL_CONTEXT (decl) = 0;
- walk_tree (&decl_expr, mark_visited, NULL, NULL);
- }
+ DECL_CONTEXT (decl) = 0;
else
DECL_CONTEXT (decl) = current_function_decl;
- /* Put the declaration on the list. The list of declarations is in reverse
- order. The list will be reversed later.
+ /* Set the location of DECL and emit a declaration for it. */
+ if (Present (gnat_node))
+ Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
+ add_decl_expr (decl, gnat_node);
- Don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into the list. 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)
+ /* Put the declaration on the list. The list of declarations is in reverse
+ order. The list will be reversed later. We don't do this for global
+ variables. Also, don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into
+ the list. They will cause trouble with the debugger and aren't needed
+ anyway. */
+ if (!global_bindings_p ()
+ && (TREE_CODE (decl) != TYPE_DECL
+ || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE))
{
TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
BLOCK_VARS (current_binding_level->block) = decl;
@@ -404,8 +362,9 @@ pushdecl (tree decl)
&& DECL_ARTIFICIAL (TYPE_NAME (TREE_TYPE (decl)))
&& ! DECL_ARTIFICIAL (decl))))
TYPE_NAME (TREE_TYPE (decl)) = decl;
-
- return decl;
+
+ if (TREE_CODE (decl) != CONST_DECL)
+ rest_of_decl_compilation (decl, NULL, global_bindings_p (), 0);
}
/* Do little here. Set up the standard declarations later after the
@@ -433,14 +392,21 @@ gnat_init_decl_processing (void)
set_sizetype (size_type_node);
build_common_tree_nodes_2 (0);
- pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype));
-
- /* We need to make the integer type before doing anything else.
- We stitch this in to the appropriate GNAT type later. */
- pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
- integer_type_node));
- pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
- char_type_node));
+ /* Give names and make TYPE_DECLs for common types. */
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
+ integer_type_node),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
+ char_type_node),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"),
+ long_integer_type_node),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
+ void_type_node),
+ Empty);
ptr_void_type_node = build_pointer_type (void_type_node);
@@ -462,7 +428,7 @@ gnat_define_builtin (const char *name, tree type,
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
make_decl_rtl (decl, NULL);
- pushdecl (decl);
+ gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (decl) = function_code;
TREE_READONLY (decl) = const_p;
@@ -540,7 +506,6 @@ gnat_install_builtins ()
BUILT_IN_STACK_RESTORE, "stack_restore", false);
}
-
/* Create the predefined scalar types such as `integer_type_node' needed
in the gcc back-end and initialize the global binding level. */
@@ -560,8 +525,8 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
longest_float_type_node = make_node (REAL_TYPE);
TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE;
layout_type (longest_float_type_node);
- pushdecl (build_decl (TYPE_DECL, get_identifier ("longest float type"),
- longest_float_type_node));
+ create_type_decl (get_identifier ("longest float type"),
+ longest_float_type_node, NULL, 0, 1, Empty);
}
else
longest_float_type_node = TREE_TYPE (long_long_float_type);
@@ -569,12 +534,11 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
except_type_node = TREE_TYPE (exception_type);
unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
- pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
- unsigned_type_node));
+ create_type_decl (get_identifier ("unsigned int"), unsigned_type_node,
+ NULL, 0, 1, Empty);
- void_type_decl_node
- = pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
- void_type_node));
+ void_type_decl_node = create_type_decl (get_identifier ("void"),
+ void_type_node, NULL, 0, 1, Empty);
void_ftype = build_function_type (void_type_node, NULL_TREE);
ptr_void_ftype = build_pointer_type (void_ftype);
@@ -590,7 +554,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
sizetype,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* free is a function declaration tree for a function to free memory. */
free_decl
@@ -599,13 +563,14 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Make the types and functions used for exception processing. */
jmpbuf_type
= build_array_type (gnat_type_for_mode (Pmode, 0),
build_index_type (build_int_2 (5, 0)));
- pushdecl (build_decl (TYPE_DECL, get_identifier ("JMPBUF_T"), jmpbuf_type));
+ create_type_decl (get_identifier ("JMPBUF_T"), jmpbuf_type, NULL,
+ 0, 1, Empty);
jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
/* Functions to get and set the jumpbuf pointer for the current thread. */
@@ -613,7 +578,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
= create_subprog_decl
(get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
set_jmpbuf_decl
= create_subprog_decl
@@ -621,7 +586,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Function to get the current exception. */
get_excptr_decl
@@ -629,7 +594,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
(get_identifier ("system__soft_links__get_gnat_exception"),
NULL_TREE,
build_function_type (build_pointer_type (except_type_node), NULL_TREE),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Functions that raise exceptions. */
raise_nodefer_decl
@@ -639,7 +604,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
build_pointer_type (except_type_node),
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Hooks to call when entering/leaving an exception handler. */
begin_handler_decl
@@ -648,7 +613,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
end_handler_decl
= create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
@@ -656,7 +621,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* If in no exception handlers mode, all raise statements are redirected to
__gnat_last_chance_handler. No need to redefine raise_nodefer_decl, since
@@ -672,7 +637,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
integer_type_node,
endlink))),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
gnat_raise_decls[i] = decl;
@@ -694,7 +659,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE,
integer_type_node,
endlink))),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
}
/* Indicate that these never return. */
@@ -720,7 +685,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
(get_identifier ("__builtin_setjmp"), NULL_TREE,
build_function_type (integer_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
@@ -732,7 +697,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
(get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
@@ -740,17 +705,14 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
main_identifier_node = get_identifier ("main");
}
-/* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL
- nodes (FIELDLIST), finish constructing the record or union type.
- If HAS_REP is nonzero, this record has a rep clause; don't call
- layout_type but merely set the size and alignment ourselves.
- If DEFER_DEBUG is nonzero, do not call the debugging routines
- on this type; it will be done later. */
+/* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL nodes
+ (FIELDLIST), finish constructing the record or union type. If HAS_REP is
+ nonzero, this record has a rep clause; don't call layout_type but merely set
+ the size and alignment ourselves. If DEFER_DEBUG is nonzero, do not call
+ the debugging routines on this type; it will be done later. */
void
-finish_record_type (tree record_type,
- tree fieldlist,
- int has_rep,
+finish_record_type (tree record_type, tree fieldlist, int has_rep,
int defer_debug)
{
enum tree_code code = TREE_CODE (record_type);
@@ -761,14 +723,8 @@ finish_record_type (tree record_type,
tree field;
TYPE_FIELDS (record_type) = fieldlist;
-
- if (TYPE_NAME (record_type) != 0
- && TREE_CODE (TYPE_NAME (record_type)) == TYPE_DECL)
- TYPE_STUB_DECL (record_type) = TYPE_NAME (record_type);
- else
- TYPE_STUB_DECL (record_type)
- = pushdecl (build_decl (TYPE_DECL, TYPE_NAME (record_type),
- record_type));
+ TYPE_STUB_DECL (record_type)
+ = build_decl (TYPE_DECL, NULL_TREE, record_type);
/* We don't need both the typedef name and the record name output in
the debugging information, since they are the same. */
@@ -942,7 +898,10 @@ finish_record_type (tree record_type,
tree new_record_type
= make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
? UNION_TYPE : TREE_CODE (record_type));
- tree orig_id = DECL_NAME (TYPE_STUB_DECL (record_type));
+ tree orig_name = TYPE_NAME (record_type);
+ tree orig_id
+ = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
+ : orig_name);
tree new_id
= concat_id_with_name (orig_id,
TREE_CODE (record_type) == QUAL_UNION_TYPE
@@ -954,7 +913,7 @@ finish_record_type (tree record_type,
TYPE_NAME (new_record_type) = new_id;
TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
TYPE_STUB_DECL (new_record_type)
- = pushdecl (build_decl (TYPE_DECL, new_id, new_record_type));
+ = build_decl (TYPE_DECL, NULL_TREE, new_record_type);
DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
@@ -1086,11 +1045,8 @@ finish_record_type (tree record_type,
We return an expression for the size. */
static tree
-merge_sizes (tree last_size,
- tree first_bit,
- tree size,
- int special,
- int has_rep)
+merge_sizes (tree last_size, tree first_bit, tree size, bool special,
+ bool has_rep)
{
tree type = TREE_TYPE (last_size);
tree new;
@@ -1188,13 +1144,9 @@ split_plus (tree in, tree *pvar)
object. RETURNS_BY_REF is nonzero if the function returns by reference.
RETURNS_WITH_DSP is nonzero if the function is to return with a
depressed stack pointer. */
-
tree
-create_subprog_type (tree return_type,
- tree param_decl_list,
- tree cico_list,
- int returns_unconstrained,
- int returns_by_ref,
+create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
+ int returns_unconstrained, int returns_by_ref,
int returns_with_dsp)
{
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
@@ -1275,7 +1227,7 @@ create_index_type (tree min, tree max, tree index)
type = copy_type (type);
SET_TYPE_INDEX_TYPE (type, index);
- add_decl_expr (create_type_decl (NULL_TREE, type, NULL, 1, 0), Empty);
+ create_type_decl (NULL_TREE, type, NULL, 1, 0, Empty);
return type;
}
@@ -1283,17 +1235,18 @@ create_index_type (tree min, tree max, tree index)
string) and TYPE is a ..._TYPE node giving its data type.
ARTIFICIAL_P is nonzero if this is a declaration that was generated
by the compiler. DEBUG_INFO_P is nonzero if we need to write debugging
- information about this type. */
+ information about this type. GNAT_NODE is used for the position of
+ the decl. */
tree
create_type_decl (tree type_name, tree type, struct attrib *attr_list,
- int artificial_p, int debug_info_p)
+ int artificial_p, int debug_info_p, Node_Id gnat_node)
{
tree type_decl = build_decl (TYPE_DECL, type_name, type);
enum tree_code code = TREE_CODE (type);
DECL_ARTIFICIAL (type_decl) = artificial_p;
- pushdecl (type_decl);
+
process_attributes (type_decl, attr_list);
/* Pass type declaration information to the debugger unless this is an
@@ -1309,6 +1262,9 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
&& TYPE_IS_DUMMY_P (TREE_TYPE (type))))
rest_of_decl_compilation (type_decl, NULL, global_bindings_p (), 0);
+ if (!TYPE_IS_DUMMY_P (type))
+ gnat_pushdecl (type_decl, gnat_node);
+
return type_decl;
}
@@ -1326,12 +1282,14 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
definition: no storage is to be allocated for the variable here).
STATIC_FLAG is only relevant when not at top level. In that case
- it indicates whether to always allocate storage to the variable. */
+ it indicates whether to always allocate storage to the variable.
+
+ GNAT_NODE is used for the position of the decl. */
tree
create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
int const_flag, int public_flag, int extern_flag,
- int static_flag, struct attrib *attr_list)
+ int static_flag, struct attrib *attr_list, Node_Id gnat_node)
{
int init_const
= (var_init == 0
@@ -1357,17 +1315,10 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
save any variable elaborations for the elaboration routine. If we are
just annotating types, throw away the initialization if it isn't a
constant. */
-
if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL)
|| (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init)))
var_init = 0;
- if (global_bindings_p () && var_init != 0 && ! init_const)
- {
- add_pending_elaborations (var_decl, var_init);
- var_init = 0;
- }
-
DECL_INITIAL (var_decl) = var_init;
TREE_READONLY (var_decl) = const_flag;
DECL_EXTERNAL (var_decl) = extern_flag;
@@ -1386,9 +1337,8 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
process_attributes (var_decl, attr_list);
- /* Add this decl to the current binding level and generate any
- needed code and RTL. */
- var_decl = pushdecl (var_decl);
+ /* Add this decl to the current binding level. */
+ gnat_pushdecl (var_decl, gnat_node);
if (TREE_SIDE_EFFECTS (var_decl))
TREE_ADDRESSABLE (var_decl) = 1;
@@ -1407,13 +1357,8 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
the address of this field for aliasing purposes. */
tree
-create_field_decl (tree field_name,
- tree field_type,
- tree record_type,
- int packed,
- tree size,
- tree pos,
- int addressable)
+create_field_decl (tree field_name, tree field_type, tree record_type,
+ int packed, tree size, tree pos, int addressable)
{
tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
@@ -1540,7 +1485,7 @@ create_field_decl (tree field_name,
/* Subroutine of previous function: return nonzero if EXP, ignoring any side
effects, has the value of zero. */
-static int
+static bool
value_zerop (tree exp)
{
if (TREE_CODE (exp) == COMPOUND_EXPR)
@@ -1629,36 +1574,11 @@ process_attributes (tree decl, struct attrib *attr_list)
}
}
-/* Add some pending elaborations on the list. */
+/* Return true if VALUE is a known to be a multiple of FACTOR, which must be
+ a power of 2. */
-void
-add_pending_elaborations (tree var_decl, tree var_init)
-{
- if (var_init != 0)
- Check_Elaboration_Code_Allowed (error_gnat_node);
-
- pending_elaborations
- = chainon (pending_elaborations, build_tree_list (var_decl, var_init));
-}
-
-/* Obtain any pending elaborations and clear the old list. */
-
-tree
-get_pending_elaborations (void)
-{
- /* Each thing added to the list went on the end; we want it on the
- beginning. */
- tree result = TREE_CHAIN (pending_elaborations);
-
- TREE_CHAIN (pending_elaborations) = 0;
- return result;
-}
-
-/* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
- of 2. */
-
-static int
-value_factor_p (tree value, int factor)
+static bool
+value_factor_p (tree value, HOST_WIDE_INT factor)
{
if (host_integerp (value, 1))
return tree_low_cst (value, 1) % factor == 0;
@@ -1676,7 +1596,7 @@ value_factor_p (tree value, int factor)
is the distance in bits between the end of PREV_FIELD and the starting
position of CURR_FIELD. It is ignored if null. */
-static int
+static bool
potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
{
/* If this is the first field of the record, there cannot be any gap */
@@ -1716,64 +1636,6 @@ potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
return 1;
}
-/* Return nonzero if there are pending elaborations. */
-
-int
-pending_elaborations_p (void)
-{
- return TREE_CHAIN (pending_elaborations) != 0;
-}
-
-/* Save a copy of the current pending elaboration list and make a new
- one. */
-
-void
-push_pending_elaborations (void)
-{
- struct e_stack *p = (struct e_stack *) ggc_alloc (sizeof (struct e_stack));
-
- p->next = elist_stack;
- p->elab_list = pending_elaborations;
- elist_stack = p;
- pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
-}
-
-/* Pop the stack of pending elaborations. */
-
-void
-pop_pending_elaborations (void)
-{
- struct e_stack *p = elist_stack;
-
- pending_elaborations = p->elab_list;
- elist_stack = p->next;
-}
-
-/* Return the current position in pending_elaborations so we can insert
- elaborations after that point. */
-
-tree
-get_elaboration_location (void)
-{
- return tree_last (pending_elaborations);
-}
-
-/* Insert the current elaborations after ELAB, which is in some elaboration
- list. */
-
-void
-insert_elaboration_list (tree elab)
-{
- tree next = TREE_CHAIN (elab);
-
- if (TREE_CHAIN (pending_elaborations))
- {
- TREE_CHAIN (elab) = TREE_CHAIN (pending_elaborations);
- TREE_CHAIN (tree_last (pending_elaborations)) = next;
- TREE_CHAIN (pending_elaborations) = 0;
- }
-}
-
/* Returns a LABEL_DECL node for LABEL_NAME. */
tree
@@ -1794,17 +1656,13 @@ create_label_decl (tree label_name)
PARM_DECL nodes chained through the TREE_CHAIN field).
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
- appropriate fields in the FUNCTION_DECL. */
+ appropriate fields in the FUNCTION_DECL. GNAT_NODE gives the location. */
tree
-create_subprog_decl (tree subprog_name,
- tree asm_name,
- tree subprog_type,
- tree param_decl_list,
- int inline_flag,
- int public_flag,
- int extern_flag,
- struct attrib *attr_list)
+create_subprog_decl (tree subprog_name, tree asm_name,
+ tree subprog_type, tree param_decl_list, int inline_flag,
+ int public_flag, int extern_flag,
+ struct attrib *attr_list, Node_Id gnat_node)
{
tree return_type = TREE_TYPE (subprog_type);
tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type);
@@ -1834,7 +1692,7 @@ create_subprog_decl (tree subprog_name,
process_attributes (subprog_decl, attr_list);
/* Add this decl to the current binding level. */
- subprog_decl = pushdecl (subprog_decl);
+ gnat_pushdecl (subprog_decl, gnat_node);
/* Output the assembler code and/or RTL for the declaration. */
rest_of_decl_compilation (subprog_decl, 0, global_bindings_p (), 0);
@@ -1842,12 +1700,6 @@ create_subprog_decl (tree subprog_name,
return subprog_decl;
}
-/* Count how deep we are into nested functions. This is because
- we shouldn't call the backend function context routines unless we
- are in a nested function. */
-
-static int function_nesting_depth;
-
/* Set up the framework for generating code for SUBPROG_DECL, a subprogram
body. This routine needs to be invoked before processing the declarations
appearing in the subprogram. */
@@ -1857,30 +1709,22 @@ begin_subprog_body (tree subprog_decl)
{
tree param_decl;
- if (function_nesting_depth++ != 0)
- push_function_context ();
-
+ current_function_decl = subprog_decl;
announce_function (subprog_decl);
- /* Make this field nonzero so further routines know that this is not
- tentative. error_mark_node is replaced below with the adequate BLOCK. */
- DECL_INITIAL (subprog_decl) = error_mark_node;
-
- /* This function exists in static storage. This does not mean `static' in
- the C sense! */
- TREE_STATIC (subprog_decl) = 1;
-
/* Enter a new binding level and show that all the parameters belong to
this function. */
- current_function_decl = subprog_decl;
gnat_pushlevel ();
-
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = TREE_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl;
- init_function_start (subprog_decl);
- expand_function_start (subprog_decl, 0);
+ make_decl_rtl (subprog_decl, NULL);
+
+ /* We handle pending sizes via the elaboration of types, so we don't need to
+ save them. This causes them to be marked as part of the outer function
+ and then discarded. */
+ get_pending_sizes ();
}
/* Finish the definition of the current subprogram and compile it all the way
@@ -1978,11 +1822,8 @@ gnat_finalize (tree fndecl)
ATTRS is nonzero, use that for the function attribute list. */
tree
-builtin_function (const char *name,
- tree type,
- int function_code,
- enum built_in_class class,
- const char *library_name,
+builtin_function (const char *name, tree type, int function_code,
+ enum built_in_class class, const char *library_name,
tree attrs)
{
tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
@@ -1992,7 +1833,7 @@ builtin_function (const char *name,
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
- pushdecl (decl);
+ gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
if (attrs)
@@ -2295,7 +2136,7 @@ build_template (tree template_type, tree array_type, tree expr)
/* Build a VMS descriptor from a Mechanism_Type, which must specify
a descriptor type, and the GCC type of an object. Each FIELD_DECL
in the type contains in its DECL_INITIAL the expression to use when
- a constructor is made for the type. GNAT_ENTITY is a gnat node used
+ a constructor is made for the type. GNAT_ENTITY is an entity used
to print out an error message if the mechanism cannot be applied to
an object of that type and also for the name. */
@@ -2581,8 +2422,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
}
finish_record_type (record_type, field_list, 0, 1);
- pushdecl (build_decl (TYPE_DECL, create_concat_name (gnat_entity, "DESC"),
- record_type));
+ create_type_decl (create_concat_name (gnat_entity, "DESC"), record_type,
+ NULL, 1, 0, gnat_entity);
return record_type;
}