Skip to content

R
riscv-gcc-1
Commit 909f21b3 by Richard Kenner Committed by Richard Kenner
Options

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
parent 0b55e932
Showing with 491 additions and 606 deletions
gcc/ada/ChangeLog
2004-06-28 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* 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.
2004-06-28 Robert Dewar <dewar@gnat.com> 2004-06-28 Robert Dewar <dewar@gnat.com>
* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, * mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
......
gcc/ada/decl.c
...@@ -103,7 +103,6 @@ static void set_rm_size (Uint, tree, Entity_Id); ...@@ -103,7 +103,6 @@ static void set_rm_size (Uint, tree, Entity_Id);
static tree make_type_from_size (tree, tree, int); static tree make_type_from_size (tree, tree, int);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int); static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
static void check_ok_for_atomic (tree, Entity_Id, int); static void check_ok_for_atomic (tree, Entity_Id, int);
static void annotate_decl_with_node (tree, Node_Id);
/* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
GCC type corresponding to that entity. GNAT_ENTITY is assumed to GCC type corresponding to that entity. GNAT_ENTITY is assumed to
...@@ -957,9 +956,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -957,9 +956,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_new_var gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"), = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, gnu_expr, NULL_TREE, gnu_new_type, gnu_expr,
0, 0, 0, 0, 0); 0, 0, 0, 0, 0, gnat_entity);
annotate_decl_with_node (gnu_new_var, gnat_entity);
add_decl_expr (gnu_new_var, gnat_entity);
if (gnu_expr != 0) if (gnu_expr != 0)
add_stmt_with_node add_stmt_with_node
...@@ -1028,8 +1025,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1028,8 +1025,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_expr, const_flag, gnu_expr, const_flag,
Is_Public (gnat_entity), Is_Public (gnat_entity),
imported_p || !definition, imported_p || !definition,
static_p, attr_list); static_p, attr_list, gnat_entity);
annotate_decl_with_node (gnu_decl, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
...@@ -1041,8 +1037,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1041,8 +1037,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (Present (Address_Clause (gnat_entity)) && used_by_ref) if (Present (Address_Clause (gnat_entity)) && used_by_ref)
DECL_POINTER_ALIAS_SET (gnu_decl) = 0; DECL_POINTER_ALIAS_SET (gnu_decl) = 0;
add_decl_expr (gnu_decl, gnat_entity);
if (definition && DECL_SIZE (gnu_decl) != 0 if (definition && DECL_SIZE (gnu_decl) != 0
&& get_block_jmpbuf_decl () && get_block_jmpbuf_decl ()
&& (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST && (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST
...@@ -1069,9 +1063,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1069,9 +1063,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_corr_var tree gnu_corr_var
= create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
gnu_expr, 0, Is_Public (gnat_entity), 0, gnu_expr, 0, Is_Public (gnat_entity), 0,
static_p, 0); static_p, 0, gnat_entity);
add_decl_expr (gnu_corr_var, gnat_entity);
SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
} }
...@@ -1152,9 +1145,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1152,9 +1145,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type); gnu_type);
tree gnu_literal tree gnu_literal
= create_var_decl (get_entity_name (gnat_literal), = create_var_decl (get_entity_name (gnat_literal),
0, gnu_type, gnu_value, 1, 0, 0, 0, 0); 0, gnu_type, gnu_value, 1, 0, 0, 0, 0,
gnat_literal);
add_decl_expr (gnu_literal, gnat_literal);
save_gnu_tree (gnat_literal, gnu_literal, 0); save_gnu_tree (gnat_literal, gnu_literal, 0);
gnu_literal_list = tree_cons (DECL_NAME (gnu_literal), gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
gnu_value, gnu_literal_list); gnu_value, gnu_literal_list);
...@@ -1463,7 +1456,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1463,7 +1456,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
this_deferred = this_made_decl = 1; this_deferred = this_made_decl = 1;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0); save_gnu_tree (gnat_entity, gnu_decl, 0);
saved = 1; saved = 1;
} }
...@@ -1526,8 +1519,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1526,8 +1519,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_ind_subtype, gnu_ind_subtype,
gnu_template_type, 0, 0, 0, 0); gnu_template_type, 0, 0, 0, 0);
annotate_decl_with_node (gnu_min_field, gnat_entity); Sloc_to_locus (Sloc (gnat_entity),
annotate_decl_with_node (gnu_max_field, gnat_entity); &DECL_SOURCE_LOCATION (gnu_min_field));
Sloc_to_locus (Sloc (gnat_entity),
&DECL_SOURCE_LOCATION (gnu_max_field));
gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field); gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field);
/* We can't use build_component_ref here since the template /* We can't use build_component_ref here since the template
...@@ -1669,8 +1664,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1669,8 +1664,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
create_type_decl (create_concat_name (gnat_entity, "XUA"), create_type_decl (create_concat_name (gnat_entity, "XUA"),
tem, 0, ! Comes_From_Source (gnat_entity), tem, 0, ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
rest_of_type_compilation (gnu_fat_type, global_bindings_p ());
/* Create a record type for the object and its template and /* Create a record type for the object and its template and
set the template at a negative offset. */ set the template at a negative offset. */
...@@ -1688,7 +1682,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1688,7 +1682,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Give the thin pointer type a name. */ /* Give the thin pointer type a name. */
create_type_decl (create_concat_name (gnat_entity, "XUX"), create_type_decl (create_concat_name (gnat_entity, "XUX"),
build_pointer_type (tem), 0, build_pointer_type (tem), 0,
! Comes_From_Source (gnat_entity), debug_info_p); ! Comes_From_Source (gnat_entity), debug_info_p,
gnat_entity);
} }
break; break;
...@@ -2060,8 +2055,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2060,8 +2055,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
* Treat_As_Volatile (gnat_entity)))); * Treat_As_Volatile (gnat_entity))));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
annotate_decl_with_node (gnu_decl, gnat_entity);
if (! Comes_From_Source (gnat_entity)) if (! Comes_From_Source (gnat_entity))
DECL_ARTIFICIAL (gnu_decl) = 1; DECL_ARTIFICIAL (gnu_decl) = 1;
...@@ -2291,8 +2285,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2291,8 +2285,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
this_deferred = 1; this_deferred = 1;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
annotate_decl_with_node (gnu_decl, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0); save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1; this_made_decl = saved = 1;
} }
...@@ -2571,7 +2564,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2571,7 +2564,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = make_node (RECORD_TYPE); gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_id; TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_STUB_DECL (gnu_type) TYPE_STUB_DECL (gnu_type)
= pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type)); = create_type_decl (NULL_TREE, gnu_type, NULL, 0, 0,
gnat_entity);
TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type); TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
for (gnat_field = First_Entity (gnat_entity); for (gnat_field = First_Entity (gnat_entity);
...@@ -2736,11 +2730,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2736,11 +2730,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity); TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
TYPE_NAME (gnu_type) = gnu_entity_id; TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_STUB_DECL (gnu_type) TYPE_STUB_DECL (gnu_type)
= pushdecl (build_decl (TYPE_DECL, TYPE_NAME (gnu_type), = create_type_decl (TYPE_NAME (gnu_type), gnu_type,
gnu_type)); NULL, 1, debug_info_p, gnat_entity);
DECL_ARTIFICIAL (TYPE_STUB_DECL (gnu_type)) = 1;
DECL_IGNORED_P (TYPE_STUB_DECL (gnu_type)) = ! debug_info_p;
rest_of_type_compilation (gnu_type, global_bindings_p ());
} }
/* Otherwise, go down all the components in the new type and /* Otherwise, go down all the components in the new type and
...@@ -2772,7 +2763,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2772,7 +2763,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
(make_dummy_type (Directly_Designated_Type (gnat_entity))); (make_dummy_type (Directly_Designated_Type (gnat_entity)));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0); save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1; this_made_decl = saved = 1;
...@@ -3039,7 +3030,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3039,7 +3030,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0); save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1; this_made_decl = saved = 1;
...@@ -3500,7 +3491,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3500,7 +3491,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
DECL_POINTS_TO_READONLY_P (gnu_param) DECL_POINTS_TO_READONLY_P (gnu_param)
= (Ekind (gnat_param) == E_In_Parameter = (Ekind (gnat_param) == E_In_Parameter
&& (by_ref_p || by_component_ptr_p)); && (by_ref_p || by_component_ptr_p));
annotate_decl_with_node (gnu_param, gnat_param); Sloc_to_locus (Sloc (gnat_param),
&DECL_SOURCE_LOCATION (gnu_param));
save_gnu_tree (gnat_param, gnu_param, 0); save_gnu_tree (gnat_param, gnu_param, 0);
gnu_param_list = chainon (gnu_param, gnu_param_list); gnu_param_list = chainon (gnu_param, gnu_param_list);
...@@ -3528,7 +3520,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3528,7 +3520,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_field = create_field_decl (gnu_param_name, gnu_param_type, gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
gnu_return_type, 0, 0, 0, 0); gnu_return_type, 0, 0, 0, 0);
annotate_decl_with_node (gnu_field, gnat_param); Sloc_to_locus (Sloc (gnat_param),
&DECL_SOURCE_LOCATION (gnu_field));
TREE_CHAIN (gnu_field) = gnu_field_list; TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field; gnu_field_list = gnu_field;
gnu_return_list = tree_cons (gnu_field, gnu_param, gnu_return_list = tree_cons (gnu_field, gnu_param,
...@@ -3625,21 +3618,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3625,21 +3618,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_decl gnu_decl
= create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
gnu_address, 0, Is_Public (gnat_entity), gnu_address, 0, Is_Public (gnat_entity),
extern_flag, 0, 0); extern_flag, 0, 0, gnat_entity);
DECL_BY_REF_P (gnu_decl) = 1; DECL_BY_REF_P (gnu_decl) = 1;
add_decl_expr (gnu_decl, gnat_entity);
} }
else if (kind == E_Subprogram_Type) else if (kind == E_Subprogram_Type)
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
else else
{ {
gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name, gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name,
gnu_type, gnu_param_list, gnu_type, gnu_param_list,
inline_flag, public_flag, inline_flag, public_flag,
extern_flag, attr_list); extern_flag, attr_list,
gnat_entity);
DECL_STUBBED_P (gnu_decl) DECL_STUBBED_P (gnu_decl)
= Convention (gnat_entity) == Convention_Stubbed; = Convention (gnat_entity) == Convention_Stubbed;
} }
...@@ -3700,8 +3693,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3700,8 +3693,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
updates when we see it. */ updates when we see it. */
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
annotate_decl_with_node (gnu_decl, gnat_entity);
save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0); save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
break; break;
...@@ -3916,16 +3908,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -3916,16 +3908,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_USER_ALIGN (gnu_type) = 1; TYPE_USER_ALIGN (gnu_type) = 1;
if (gnu_decl == 0) if (gnu_decl == 0)
{
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p, gnat_entity);
annotate_decl_with_node (gnu_decl, gnat_entity);
}
else else
TREE_TYPE (gnu_decl) = gnu_type; TREE_TYPE (gnu_decl) = gnu_type;
add_decl_expr (gnu_decl, gnat_entity);
} }
if (IN (kind, Type_Kind) && ! TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))) if (IN (kind, Type_Kind) && ! TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
...@@ -4018,7 +4005,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4018,7 +4005,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_MAX_VALUE (gnu_scalar_type) TYPE_MAX_VALUE (gnu_scalar_type)
= gnat_to_gnu (Type_High_Bound (gnat_entity)); = gnat_to_gnu (Type_High_Bound (gnat_entity));
if (kind == E_Enumeration_Type) if (TREE_CODE (gnu_scalar_type) == ENUMERAL_TYPE)
{ {
TYPE_STUB_DECL (gnu_scalar_type) = gnu_decl; TYPE_STUB_DECL (gnu_scalar_type) = gnu_decl;
...@@ -4301,11 +4288,10 @@ make_dummy_type (Entity_Id gnat_type) ...@@ -4301,11 +4288,10 @@ make_dummy_type (Entity_Id gnat_type)
gnu_type = make_node (ENUMERAL_TYPE); gnu_type = make_node (ENUMERAL_TYPE);
TYPE_NAME (gnu_type) = get_entity_name (gnat_type); TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
TYPE_DUMMY_P (gnu_type) = 1;
if (AGGREGATE_TYPE_P (gnu_type)) if (AGGREGATE_TYPE_P (gnu_type))
TYPE_STUB_DECL (gnu_type) TYPE_STUB_DECL (gnu_type) = build_decl (TYPE_DECL, NULL_TREE, gnu_type);
= pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
TYPE_DUMMY_P (gnu_type) = 1;
dummy_node_table[gnat_underlying] = gnu_type; dummy_node_table[gnat_underlying] = gnu_type;
return gnu_type; return gnu_type;
...@@ -4538,15 +4524,12 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity, ...@@ -4538,15 +4524,12 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity,
/* Now create the variable if we need it. */ /* Now create the variable if we need it. */
if (need_debug || (expr_variable && expr_global)) if (need_debug || (expr_variable && expr_global))
{
gnu_decl gnu_decl
= create_var_decl (create_concat_name (gnat_entity, = create_var_decl (create_concat_name (gnat_entity,
IDENTIFIER_POINTER (gnu_name)), IDENTIFIER_POINTER (gnu_name)),
NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1, NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
Is_Public (gnat_entity), ! definition, 0, 0); Is_Public (gnat_entity), ! definition, 0, 0,
annotate_decl_with_node (gnu_decl, gnat_entity); gnat_entity);
add_decl_expr (gnu_decl, gnat_entity);
}
/* We only need to use this variable if we are in global context since GCC /* We only need to use this variable if we are in global context since GCC
can do the right thing in the local case. */ can do the right thing in the local case. */
...@@ -4757,7 +4740,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -4757,7 +4740,8 @@ maybe_pad_type (tree type, tree size, unsigned int align,
0, ! Comes_From_Source (gnat_entity), 0, ! Comes_From_Source (gnat_entity),
! (TYPE_NAME (type) != 0 ! (TYPE_NAME (type) != 0
&& TREE_CODE (TYPE_NAME (type)) == TYPE_DECL && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
&& DECL_IGNORED_P (TYPE_NAME (type)))); && DECL_IGNORED_P (TYPE_NAME (type))),
gnat_entity);
/* If we are changing the alignment and the input type is a record with /* If we are changing the alignment and the input type is a record with
BLKmode and a small constant size, try to make a form that has an BLKmode and a small constant size, try to make a form that has an
...@@ -4805,7 +4789,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -4805,7 +4789,9 @@ maybe_pad_type (tree type, tree size, unsigned int align,
|| ! DECL_IGNORED_P (TYPE_NAME (type)))) || ! DECL_IGNORED_P (TYPE_NAME (type))))
{ {
tree marker = make_node (RECORD_TYPE); tree marker = make_node (RECORD_TYPE);
tree name = DECL_NAME (TYPE_NAME (record)); tree name = (TREE_CODE (TYPE_NAME (record)) == TYPE_DECL
? DECL_NAME (TYPE_NAME (record))
: TYPE_NAME (record));
tree orig_name = TYPE_NAME (type); tree orig_name = TYPE_NAME (type);
if (TREE_CODE (orig_name) == TYPE_DECL) if (TREE_CODE (orig_name) == TYPE_DECL)
...@@ -4819,13 +4805,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -4819,13 +4805,9 @@ maybe_pad_type (tree type, tree size, unsigned int align,
0, 0); 0, 0);
if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition) if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition)
{ create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
tree gnu_xvz sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0,
= create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE, gnat_entity);
sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0);
add_decl_expr (gnu_xvz, gnat_entity);
}
} }
type = record; type = record;
...@@ -4965,9 +4947,7 @@ choices_to_gnu (tree operand, Node_Id choices) ...@@ -4965,9 +4947,7 @@ choices_to_gnu (tree operand, Node_Id choices)
DEFINITION is nonzero if this field is for a record being defined. */ DEFINITION is nonzero if this field is for a record being defined. */
static tree static tree
gnat_to_gnu_field (Entity_Id gnat_field, gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
tree gnu_record_type,
int packed,
int definition) int definition)
{ {
tree gnu_field_id = get_entity_name (gnat_field); tree gnu_field_id = get_entity_name (gnat_field);
...@@ -5181,7 +5161,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, ...@@ -5181,7 +5161,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
packed, gnu_size, gnu_pos, packed, gnu_size, gnu_pos,
Is_Aliased (gnat_field)); Is_Aliased (gnat_field));
annotate_decl_with_node (gnu_field, gnat_field); Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field); TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
if (Ekind (gnat_field) == E_Discriminant) if (Ekind (gnat_field) == E_Discriminant)
...@@ -5250,14 +5230,9 @@ is_variable_size (tree type) ...@@ -5250,14 +5230,9 @@ is_variable_size (tree type)
fields of the record and then the record type is finished. */ fields of the record and then the record type is finished. */
static void static void
components_to_record (tree gnu_record_type, components_to_record (tree gnu_record_type, Node_Id component_list,
Node_Id component_list, tree gnu_field_list, int packed, int definition,
tree gnu_field_list, tree *p_gnu_rep_list, int cancel_alignment, int all_rep)
int packed,
int definition,
tree *p_gnu_rep_list,
int cancel_alignment,
int all_rep)
{ {
Node_Id component_decl; Node_Id component_decl;
Entity_Id gnat_field; Entity_Id gnat_field;
...@@ -6185,21 +6160,11 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, int comp_p) ...@@ -6185,21 +6160,11 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, int comp_p)
gnat_error_point, gnat_entity); gnat_error_point, gnat_entity);
} }
/* Set the DECL_SOURCE_LOCATION of GNU_DECL to the location of /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type
GNAT_NODE. */ with all size expressions that contain F updated by replacing F with R.
This is identical to GCC's substitute_in_type except that it knows about
static void TYPE_INDEX_TYPE. If F is NULL_TREE, always make a new RECORD_TYPE, even if
annotate_decl_with_node (tree gnu_decl, Node_Id gnat_node) nothing has changed. */
{
Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_decl));
}
/* Given a type T, a FIELD_DECL F, and a replacement value R,
return a new type with all size expressions that contain F
updated by replacing F with R. This is identical to GCC's
substitute_in_type except that it knows about TYPE_INDEX_TYPE.
If F is NULL_TREE, always make a new RECORD_TYPE, even if nothing has
changed. */
tree tree
gnat_substitute_in_type (tree t, tree f, tree r) gnat_substitute_in_type (tree t, tree f, tree r)
......
gcc/ada/gigi.h
...@@ -111,8 +111,6 @@ extern tree get_unpadded_type (Entity_Id); ...@@ -111,8 +111,6 @@ extern tree get_unpadded_type (Entity_Id);
extern tree maybe_variable (tree); extern tree maybe_variable (tree);
/* Create a record type that contains a field of TYPE with a starting bit /* Create a record type that contains a field of TYPE with a starting bit
position so that it is aligned to ALIGN bits. */
/* Create a record type that contains a field of TYPE with a starting bit
position so that it is aligned to ALIGN bits and is SIZE bytes long. */ position so that it is aligned to ALIGN bits and is SIZE bytes long. */
extern tree make_aligning_type (tree, int, tree); extern tree make_aligning_type (tree, int, tree);
...@@ -367,14 +365,14 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1]; ...@@ -367,14 +365,14 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
/* Returns non-zero if we are currently in the global binding level */ /* Returns non-zero if we are currently in the global binding level */
extern int global_bindings_p (void); extern int global_bindings_p (void);
/* Returns 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). */
extern tree getdecls (void);
/* Enter and exit a new binding level. */ /* Enter and exit a new binding level. */
extern void gnat_pushlevel (void); extern void gnat_pushlevel (void);
extern void gnat_poplevel (void); extern void gnat_poplevel (void);
/* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
and point FNDECL to this BLOCK. */
extern void set_current_block_context (tree);
/* Set the jmpbuf_decl for the current binding level to DECL. */ /* Set the jmpbuf_decl for the current binding level to DECL. */
extern void set_block_jmpbuf_decl (tree); extern void set_block_jmpbuf_decl (tree);
...@@ -386,15 +384,11 @@ extern tree get_block_jmpbuf_decl (void); ...@@ -386,15 +384,11 @@ extern tree get_block_jmpbuf_decl (void);
to handle the BLOCK node inside the BIND_EXPR. */ to handle the BLOCK node inside the BIND_EXPR. */
extern void insert_block (tree); extern void insert_block (tree);
/* Return nonzero if the are any variables in the current block. */ /* Records a ..._DECL node DECL as belonging to the current lexical scope
extern int block_has_vars (void); and uses GNAT_ENTITY for location information. */
extern void gnat_pushdecl (tree, Entity_Id);
/* Records a ..._DECL node DECL as belonging to the current lexical scope. extern void gnat_init_stmt_group (void);
Returns the ..._DECL node. */
extern tree pushdecl (tree);
/* Create the predefined scalar types such as `integer_type_node' needed
in the gcc back-end and initialize the global binding level. */
extern void gnat_init_decl_processing (void); extern void gnat_init_decl_processing (void);
extern void init_gigi_decls (tree, tree); extern void init_gigi_decls (tree, tree);
extern void gnat_init_gcc_eh (void); extern void gnat_init_gcc_eh (void);
...@@ -476,8 +470,9 @@ extern tree create_index_type (tree, tree, tree); ...@@ -476,8 +470,9 @@ extern tree create_index_type (tree, tree, tree);
string) and TYPE is a ..._TYPE node giving its data type. string) and TYPE is a ..._TYPE node giving its data type.
ARTIFICIAL_P is nonzero if this is a declaration that was generated 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 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
extern tree create_type_decl (tree, tree, struct attrib *, int, int); the decl. */
extern tree create_type_decl (tree, tree, struct attrib *, int, int, Node_Id);
/* Returns a GCC VAR_DECL node. VAR_NAME gives the name of the variable. /* Returns a GCC VAR_DECL node. VAR_NAME gives the name of the variable.
ASM_NAME is its assembler name (if provided). TYPE is ASM_NAME is its assembler name (if provided). TYPE is
...@@ -492,9 +487,11 @@ extern tree create_type_decl (tree, tree, struct attrib *, int, int); ...@@ -492,9 +487,11 @@ extern tree create_type_decl (tree, tree, struct attrib *, int, int);
when processing an external variable declaration (as opposed to a when processing an external variable declaration (as opposed to a
definition: no storage is to be allocated for the variable here). definition: no storage is to be allocated for the variable here).
STATIC_FLAG is only relevant when not at top level. In that case 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. */
extern tree create_var_decl (tree, tree, tree, tree, int, int, int, int, extern tree create_var_decl (tree, tree, tree, tree, int, int, int, int,
struct attrib *); struct attrib *, Node_Id);
/* Given a DECL and ATTR_LIST, apply the listed attributes. */ /* Given a DECL and ATTR_LIST, apply the listed attributes. */
extern void process_attributes (tree, struct attrib *); extern void process_attributes (tree, struct attrib *);
...@@ -542,10 +539,10 @@ extern tree create_param_decl (tree, tree, int); ...@@ -542,10 +539,10 @@ extern tree create_param_decl (tree, tree, int);
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
PARM_DECL nodes chained through the TREE_CHAIN field). PARM_DECL nodes chained through the TREE_CHAIN field).
INLINE_FLAG, PUBLIC_FLAG, and EXTERN_FLAG are used to set the appropriate INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
fields in the FUNCTION_DECL. */ appropriate fields in the FUNCTION_DECL. GNAT_NODE gives the location. */
extern tree create_subprog_decl (tree, tree, tree, tree, int, int, int, extern tree create_subprog_decl (tree, tree, tree, tree, int, int, int,
struct attrib *); struct attrib *, Node_Id);
/* Returns a LABEL_DECL node for LABEL_NAME. */ /* Returns a LABEL_DECL node for LABEL_NAME. */
extern tree create_label_decl (tree); extern tree create_label_decl (tree);
......
gcc/ada/misc.c
...@@ -123,12 +123,18 @@ static void gnat_adjust_rli (record_layout_info); ...@@ -123,12 +123,18 @@ static void gnat_adjust_rli (record_layout_info);
#define LANG_HOOKS_HONOR_READONLY true #define LANG_HOOKS_HONOR_READONLY true
#undef LANG_HOOKS_HASH_TYPES #undef LANG_HOOKS_HASH_TYPES
#define LANG_HOOKS_HASH_TYPES false #define LANG_HOOKS_HASH_TYPES false
#undef LANG_HOOKS_CLEAR_BINDING_STACK
#define LANG_HOOKS_CLEAR_BINDING_STACK lhd_do_nothing
#undef LANG_HOOKS_PUSHLEVEL #undef LANG_HOOKS_PUSHLEVEL
#define LANG_HOOKS_PUSHLEVEL lhd_do_nothing_i #define LANG_HOOKS_PUSHLEVEL lhd_do_nothing_i
#undef LANG_HOOKS_POPLEVEL #undef LANG_HOOKS_POPLEVEL
#define LANG_HOOKS_POPLEVEL lhd_do_nothing_iii_return_null_tree #define LANG_HOOKS_POPLEVEL lhd_do_nothing_iii_return_null_tree
#undef LANG_HOOKS_SET_BLOCK #undef LANG_HOOKS_SET_BLOCK
#define LANG_HOOKS_SET_BLOCK lhd_do_nothing_t #define LANG_HOOKS_SET_BLOCK lhd_do_nothing_t
#undef LANG_HOOKS_GETDECLS
#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
#undef LANG_HOOKS_PUSHDECL
#define LANG_HOOKS_PUSHDECL lhd_return_tree
#undef LANG_HOOKS_FINISH_INCOMPLETE_DECL #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
#define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
#undef LANG_HOOKS_GET_ALIAS_SET #undef LANG_HOOKS_GET_ALIAS_SET
...@@ -392,6 +398,9 @@ internal_error_function (const char *msgid, va_list *ap) ...@@ -392,6 +398,9 @@ internal_error_function (const char *msgid, va_list *ap)
static bool static bool
gnat_init (void) gnat_init (void)
{ {
/* Initialize translations and the outer statement group. */
gnat_init_stmt_group ();
/* Performs whatever initialization steps needed by the language-dependent /* Performs whatever initialization steps needed by the language-dependent
lexical analyzer. */ lexical analyzer. */
gnat_init_decl_processing (); gnat_init_decl_processing ();
......
gcc/ada/trans.c
...@@ -88,6 +88,7 @@ struct stmt_group GTY((chain_next ("%h.previous"))) { ...@@ -88,6 +88,7 @@ struct stmt_group GTY((chain_next ("%h.previous"))) {
}; };
static GTY(()) struct stmt_group *current_stmt_group; static GTY(()) struct stmt_group *current_stmt_group;
static struct stmt_group *global_stmt_group;
/* List of unused struct stmt_group nodes. */ /* List of unused struct stmt_group nodes. */
static GTY((deletable)) struct stmt_group *stmt_group_free_list; static GTY((deletable)) struct stmt_group *stmt_group_free_list;
...@@ -113,9 +114,8 @@ static GTY(()) tree gnu_loop_label_stack; ...@@ -113,9 +114,8 @@ static GTY(()) tree gnu_loop_label_stack;
TREE_VALUE of each entry is the label at the end of the switch. */ TREE_VALUE of each entry is the label at the end of the switch. */
static GTY(()) tree gnu_switch_label_stack; static GTY(()) tree gnu_switch_label_stack;
/* List of TREE_LIST nodes containing pending elaborations lists. /* The FUNCTION_DECL for the elaboration procedure for the main unit. */
used to prevent the elaborations being reclaimed by GC. */ static GTY(()) tree gnu_elab_proc_decl;
static GTY(()) tree gnu_pending_elaboration_lists;
/* Map GNAT tree codes to GCC tree codes for simple expressions. */ /* Map GNAT tree codes to GCC tree codes for simple expressions. */
static enum tree_code gnu_codes[Number_Node_Kinds]; static enum tree_code gnu_codes[Number_Node_Kinds];
...@@ -127,6 +127,8 @@ static void record_code_position (Node_Id); ...@@ -127,6 +127,8 @@ static void record_code_position (Node_Id);
static void insert_code_for (Node_Id); static void insert_code_for (Node_Id);
static void start_stmt_group (void); static void start_stmt_group (void);
static void add_cleanup (tree); static void add_cleanup (tree);
static tree mark_visited (tree *, int *, void *);
static tree mark_unvisited (tree *, int *, void *);
static tree end_stmt_group (void); static tree end_stmt_group (void);
static void add_stmt_list (List_Id); static void add_stmt_list (List_Id);
static tree build_stmt_group (List_Id, bool); static tree build_stmt_group (List_Id, bool);
...@@ -148,7 +150,7 @@ static tree extract_values (tree, tree); ...@@ -148,7 +150,7 @@ static tree extract_values (tree, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id); static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static tree maybe_implicit_deref (tree); static tree maybe_implicit_deref (tree);
static tree gnat_stabilize_reference_1 (tree, int); static tree gnat_stabilize_reference_1 (tree, int);
static int build_unit_elab (Entity_Id, int, tree); static bool build_unit_elab (void);
static void annotate_with_node (tree, Node_Id); static void annotate_with_node (tree, Node_Id);
/* Constants for +0.5 and -0.5 for float-to-integer rounding. */ /* Constants for +0.5 and -0.5 for float-to-integer rounding. */
...@@ -159,22 +161,13 @@ static REAL_VALUE_TYPE dconstmp5; ...@@ -159,22 +161,13 @@ static REAL_VALUE_TYPE dconstmp5;
structures and then generates code. */ structures and then generates code. */
void void
gigi (Node_Id gnat_root, gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
int max_gnat_node, struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr,
int number_name, struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
struct Node *nodes_ptr, struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
Node_Id *next_node_ptr, struct List_Header *list_headers_ptr, Int number_units ATTRIBUTE_UNUSED,
Node_Id *prev_node_ptr, char *file_info_ptr ATTRIBUTE_UNUSED, Entity_Id standard_integer,
struct Elist_Header *elists_ptr, Entity_Id standard_long_long_float, Entity_Id standard_exception_type,
struct Elmt_Item *elmts_ptr,
struct String_Entry *strings_ptr,
Char_Code *string_chars_ptr,
struct List_Header *list_headers_ptr,
Int number_units ATTRIBUTE_UNUSED,
char *file_info_ptr ATTRIBUTE_UNUSED,
Entity_Id standard_integer,
Entity_Id standard_long_long_float,
Entity_Id standard_exception_type,
Int gigi_operating_mode) Int gigi_operating_mode)
{ {
tree gnu_standard_long_long_float; tree gnu_standard_long_long_float;
...@@ -193,6 +186,10 @@ gigi (Node_Id gnat_root, ...@@ -193,6 +186,10 @@ gigi (Node_Id gnat_root,
type_annotate_only = (gigi_operating_mode == 1); type_annotate_only = (gigi_operating_mode == 1);
init_gnat_to_gnu ();
gnat_compute_largest_alignment ();
init_dummy_type ();
/* If we are just annotating types, give VOID_TYPE zero sizes to avoid /* If we are just annotating types, give VOID_TYPE zero sizes to avoid
errors. */ errors. */
if (type_annotate_only) if (type_annotate_only)
...@@ -204,20 +201,6 @@ gigi (Node_Id gnat_root, ...@@ -204,20 +201,6 @@ gigi (Node_Id gnat_root,
if (Nkind (gnat_root) != N_Compilation_Unit) if (Nkind (gnat_root) != N_Compilation_Unit)
gigi_abort (301); gigi_abort (301);
/* Initialize ourselves. */
init_gnat_to_gnu ();
init_dummy_type ();
init_code_table ();
gnat_compute_largest_alignment ();
start_stmt_group ();
/* Enable GNAT stack checking method if needed */
if (!Stack_Check_Probes_On_Target)
set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
if (Exception_Mechanism == Front_End_ZCX)
abort ();
/* Save the type we made for integer as the type for Standard.Integer. /* Save the type we made for integer as the type for Standard.Integer.
Then make the rest of the standard types. Note that some of these Then make the rest of the standard types. Note that some of these
may be subtypes. */ may be subtypes. */
...@@ -226,9 +209,6 @@ gigi (Node_Id gnat_root, ...@@ -226,9 +209,6 @@ gigi (Node_Id gnat_root,
gnu_except_ptr_stack = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE); gnu_except_ptr_stack = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
REAL_ARITHMETIC (dconstp5, RDIV_EXPR, dconst1, dconst2);
REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2);
gnu_standard_long_long_float gnu_standard_long_long_float
= gnat_to_gnu_entity (Base_Type (standard_long_long_float), NULL_TREE, 0); = gnat_to_gnu_entity (Base_Type (standard_long_long_float), NULL_TREE, 0);
gnu_standard_exception_type gnu_standard_exception_type
...@@ -251,6 +231,28 @@ gigi (Node_Id gnat_root, ...@@ -251,6 +231,28 @@ gigi (Node_Id gnat_root,
gnat_to_gnu (gnat_root); gnat_to_gnu (gnat_root);
} }
/* Perform initializations for this module. */
void
gnat_init_stmt_group ()
{
/* Initialize ourselves. */
init_code_table ();
start_stmt_group ();
global_stmt_group = current_stmt_group;
/* Enable GNAT stack checking method if needed */
if (!Stack_Check_Probes_On_Target)
set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
if (Exception_Mechanism == Front_End_ZCX)
abort ();
REAL_ARITHMETIC (dconstp5, RDIV_EXPR, dconst1, dconst2);
REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2);
}
/* This function is the driver of the GNAT to GCC tree transformation /* This function is the driver of the GNAT to GCC tree transformation
process. It is the entry point of the tree transformer. GNAT_NODE is the process. It is the entry point of the tree transformer. GNAT_NODE is the
root of some GNAT tree. Return the root of the corresponding GCC tree. root of some GNAT tree. Return the root of the corresponding GCC tree.
...@@ -263,6 +265,7 @@ gigi (Node_Id gnat_root, ...@@ -263,6 +265,7 @@ gigi (Node_Id gnat_root,
tree tree
gnat_to_gnu (Node_Id gnat_node) gnat_to_gnu (Node_Id gnat_node)
{ {
bool went_into_elab_proc = false;
tree gnu_result = error_mark_node; /* Default to no value. */ tree gnu_result = error_mark_node; /* Default to no value. */
tree gnu_result_type = void_type_node; tree gnu_result_type = void_type_node;
tree gnu_expr; tree gnu_expr;
...@@ -287,6 +290,27 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -287,6 +290,27 @@ gnat_to_gnu (Node_Id gnat_node)
return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)), return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
build_call_raise (CE_Range_Check_Failed)); build_call_raise (CE_Range_Check_Failed));
/* If this is a Statement and we are at top level, it must be part of
the elaboration procedure, so mark us as being in that procedure
and push our context. */
if (!current_function_decl
&& ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
&& Nkind (gnat_node) != N_Null_Statement)
|| Nkind (gnat_node) == N_Procedure_Call_Statement
|| Nkind (gnat_node) == N_Label
|| Nkind (gnat_node) == N_Handled_Sequence_Of_Statements
|| ((Nkind (gnat_node) == N_Raise_Constraint_Error
|| Nkind (gnat_node) == N_Raise_Storage_Error
|| Nkind (gnat_node) == N_Raise_Program_Error)
&& (Ekind (Etype (gnat_node)) == E_Void))))
{
current_function_decl = gnu_elab_proc_decl;
start_stmt_group ();
gnat_pushlevel ();
went_into_elab_proc = true;
}
switch (Nkind (gnat_node)) switch (Nkind (gnat_node))
{ {
/********************************/ /********************************/
...@@ -721,14 +745,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -721,14 +745,11 @@ gnat_to_gnu (Node_Id gnat_node)
{ {
if ((Is_Public (gnat_temp) || global_bindings_p ()) if ((Is_Public (gnat_temp) || global_bindings_p ())
&& ! TREE_CONSTANT (gnu_expr)) && ! TREE_CONSTANT (gnu_expr))
{
gnu_expr gnu_expr
= create_var_decl (create_concat_name (gnat_temp, "init"), = create_var_decl (create_concat_name (gnat_temp, "init"),
NULL_TREE, TREE_TYPE (gnu_expr), NULL_TREE, TREE_TYPE (gnu_expr),
gnu_expr, 0, Is_Public (gnat_temp), 0, gnu_expr, 0, Is_Public (gnat_temp), 0,
0, 0); 0, 0, gnat_temp);
add_decl_expr (gnu_expr, gnat_temp);
}
else else
gnu_expr = maybe_variable (gnu_expr); gnu_expr = maybe_variable (gnu_expr);
...@@ -995,15 +1016,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -995,15 +1016,11 @@ gnat_to_gnu (Node_Id gnat_node)
Prefix is a unit, not an object with a GCC equivalent. Similarly Prefix is a unit, not an object with a GCC equivalent. Similarly
for Elaborated, since that variable isn't otherwise known. */ for Elaborated, since that variable isn't otherwise known. */
if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec) if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
{ return (create_subprog_decl
gnu_prefix
= create_subprog_decl
(create_concat_name (Entity (Prefix (gnat_node)), (create_concat_name (Entity (Prefix (gnat_node)),
attribute == Attr_Elab_Body attribute == Attr_Elab_Body
? "elabb" : "elabs"), ? "elabb" : "elabs"),
NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0); NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0, gnat_node));
return gnu_prefix;
}
gnu_prefix = gnat_to_gnu (Prefix (gnat_node)); gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
gnu_type = TREE_TYPE (gnu_prefix); gnu_type = TREE_TYPE (gnu_prefix);
...@@ -2272,6 +2289,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -2272,6 +2289,7 @@ gnat_to_gnu (Node_Id gnat_node)
{ {
COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt; COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt;
gnu_result = gnu_cond_expr; gnu_result = gnu_cond_expr;
recalculate_side_effects (gnu_cond_expr);
} }
else else
gnu_result = gnu_loop_stmt; gnu_result = gnu_loop_stmt;
...@@ -2489,31 +2507,14 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -2489,31 +2507,14 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_subprog_type = TREE_TYPE (gnu_subprog_decl); gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
/* 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 ();
/* ??? Temporarily do this to avoid GC throwing away outer stuff. */
ggc_push_context ();
/* Set the line number in the decl to correspond to that of /* Set the line number in the decl to correspond to that of
the body so that the line number notes are written the body so that the line number notes are written
correctly. */ correctly. */
Sloc_to_locus (Sloc (gnat_node), Sloc_to_locus (Sloc (gnat_node),
&DECL_SOURCE_LOCATION (gnu_subprog_decl)); &DECL_SOURCE_LOCATION (gnu_subprog_decl));
current_function_decl = gnu_subprog_decl; begin_subprog_body (gnu_subprog_decl);
announce_function (gnu_subprog_decl);
/* Enter a new binding level and show that all the parameters belong to
this function. */
gnat_pushlevel ();
for (gnu_expr = DECL_ARGUMENTS (gnu_subprog_decl); gnu_expr;
gnu_expr = TREE_CHAIN (gnu_expr))
DECL_CONTEXT (gnu_expr) = gnu_subprog_decl;
make_decl_rtl (gnu_subprog_decl, NULL);
gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
/* If there are OUT parameters, we need to ensure that the return /* If there are OUT parameters, we need to ensure that the return
...@@ -2595,8 +2596,6 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -2595,8 +2596,6 @@ gnat_to_gnu (Node_Id gnat_node)
} }
pop_stack (&gnu_return_label_stack); pop_stack (&gnu_return_label_stack);
if (!type_annotate_only)
add_decl_expr (current_function_decl, gnat_node);
/* Initialize the information node for the function and set the /* Initialize the information node for the function and set the
end location. */ end location. */
...@@ -2621,7 +2620,6 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -2621,7 +2620,6 @@ gnat_to_gnu (Node_Id gnat_node)
mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node))); mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
write_symbols = save_write_symbols; write_symbols = save_write_symbols;
debug_hooks = save_debug_hooks; debug_hooks = save_debug_hooks;
ggc_pop_context ();
gnu_result = alloc_stmt_list (); gnu_result = alloc_stmt_list ();
} }
break; break;
...@@ -3151,6 +3149,28 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3151,6 +3149,28 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Compilation_Unit: case N_Compilation_Unit:
/* If this is the main unit, make the decl for the elaboration
procedure. Otherwise, push a statement group for this nested
compilation unit. */
if (gnat_node == Cunit (Main_Unit))
{
bool body_p = (Defining_Entity (Unit (gnat_node)),
Nkind (Unit (gnat_node)) == N_Package_Body
|| Nkind (Unit (gnat_node)) == N_Subprogram_Body);
Entity_Id gnat_unit_entity = Defining_Entity (Unit (gnat_node));
gnu_elab_proc_decl
= create_subprog_decl
(create_concat_name (gnat_unit_entity,
body_p ? "elabb" : "elabs"),
NULL_TREE, void_ftype, NULL_TREE, 0, 1, 0, 0, gnat_unit_entity);
DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
allocate_struct_function (gnu_elab_proc_decl);
Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
cfun = 0;
}
else
start_stmt_group (); start_stmt_group ();
/* For a body, first process the spec if there is one. */ /* For a body, first process the spec if there is one. */
...@@ -3169,7 +3189,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3169,7 +3189,7 @@ gnat_to_gnu (Node_Id gnat_node)
|| Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration || Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration
|| Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration) || Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration)
{ {
gnu_result = end_stmt_group (); gnu_result = alloc_stmt_list ();
break; break;
} }
} }
...@@ -3182,17 +3202,19 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3182,17 +3202,19 @@ gnat_to_gnu (Node_Id gnat_node)
add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node))); add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node)));
add_stmt_list (Actions (Aux_Decls_Node (gnat_node))); add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
/* Generate elaboration code for this unit, if necessary, and /* If this is the main unit, generate elaboration code for this
say whether we did or not. */ unit, if necessary, and say whether we did or not. Otherwise,
Set_Has_No_Elaboration_Code there is no elaboration code and we end our statement group. */
(gnat_node, if (gnat_node == Cunit (Main_Unit))
build_unit_elab {
(Defining_Entity (Unit (gnat_node)), Set_Has_No_Elaboration_Code (gnat_node, build_unit_elab ());
Nkind (Unit (gnat_node)) == N_Package_Body gnu_result = alloc_stmt_list ();
|| Nkind (Unit (gnat_node)) == N_Subprogram_Body, }
get_pending_elaborations ())); else
{
Set_Has_No_Elaboration_Code (gnat_node, 1);
gnu_result = end_stmt_group (); gnu_result = end_stmt_group ();
}
break; break;
case N_Subprogram_Body_Stub: case N_Subprogram_Body_Stub:
...@@ -3258,8 +3280,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3258,8 +3280,7 @@ gnat_to_gnu (Node_Id gnat_node)
&& Exception_Mechanism == Setjmp_Longjmp); && Exception_Mechanism == Setjmp_Longjmp);
bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node)); bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp); bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
/* The statement(s) for the block itself. */ tree gnu_inner_block; /* The statement(s) for the block itself. */
tree gnu_inner_block;
/* If there are any exceptions or cleanup processing involved, we need /* If there are any exceptions or cleanup processing involved, we need
an outer statement group (for Setjmp_Longjmp) and binding level. */ an outer statement group (for Setjmp_Longjmp) and binding level. */
...@@ -3285,14 +3306,12 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3285,14 +3306,12 @@ gnat_to_gnu (Node_Id gnat_node)
= create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE, = create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE,
jmpbuf_ptr_type, jmpbuf_ptr_type,
build_call_0_expr (get_jmpbuf_decl), build_call_0_expr (get_jmpbuf_decl),
0, 0, 0, 0, 0); 0, 0, 0, 0, 0, gnat_node);
gnu_jmpbuf_decl gnu_jmpbuf_decl
= create_var_decl (get_identifier ("JMP_BUF"), = create_var_decl (get_identifier ("JMP_BUF"),
NULL_TREE, jmpbuf_type, NULL_TREE, jmpbuf_type,
NULL_TREE, 0, 0, 0, 0, 0); NULL_TREE, 0, 0, 0, 0, 0, gnat_node);
add_decl_expr (gnu_jmpsave_decl, gnat_node);
add_decl_expr (gnu_jmpbuf_decl, gnat_node);
set_block_jmpbuf_decl (gnu_jmpbuf_decl); set_block_jmpbuf_decl (gnu_jmpbuf_decl);
/* When we exit this block, restore the saved value. */ /* When we exit this block, restore the saved value. */
...@@ -3340,8 +3359,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3340,8 +3359,7 @@ gnat_to_gnu (Node_Id gnat_node)
NULL_TREE, NULL_TREE,
build_pointer_type (except_type_node), build_pointer_type (except_type_node),
build_call_0_expr (get_excptr_decl), build_call_0_expr (get_excptr_decl),
0, 0, 0, 0, 0)); 0, 0, 0, 0, 0, gnat_node));
add_decl_expr (TREE_VALUE (gnu_except_ptr_stack), gnat_node);
/* Generate code for each handler. The N_Exception_Handler case /* Generate code for each handler. The N_Exception_Handler case
below does the real work and returns a COND_EXPR for each below does the real work and returns a COND_EXPR for each
...@@ -3602,9 +3620,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3602,9 +3620,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_incoming_exc_ptr gnu_incoming_exc_ptr
= create_var_decl (get_identifier ("EXPTR"), NULL_TREE, = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
ptr_type_node, gnu_current_exc_ptr, ptr_type_node, gnu_current_exc_ptr,
0, 0, 0, 0, 0); 0, 0, 0, 0, 0, gnat_node);
add_decl_expr (gnu_incoming_exc_ptr, gnat_node);
add_stmt_with_node (build_call_1_expr (begin_handler_decl, add_stmt_with_node (build_call_1_expr (begin_handler_decl,
gnu_incoming_exc_ptr), gnu_incoming_exc_ptr),
gnat_node); gnat_node);
...@@ -3863,6 +3880,16 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3863,6 +3880,16 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = alloc_stmt_list (); gnu_result = alloc_stmt_list ();
} }
/* If we pushed our level as part of processing the elaboration routine,
pop it back now. */
if (went_into_elab_proc)
{
add_stmt (gnu_result);
gnat_poplevel ();
gnu_result = end_stmt_group ();
current_function_decl = NULL_TREE;
}
/* Set the location information into the result. If we're supposed to /* Set the location information into the result. If we're supposed to
return something of void_type, it means we have something we're return something of void_type, it means we have something we're
elaborating for effect, so just return. */ elaborating for effect, so just return. */
...@@ -4030,28 +4057,10 @@ add_stmt (tree gnu_stmt) ...@@ -4030,28 +4057,10 @@ add_stmt (tree gnu_stmt)
{ {
append_to_statement_list (gnu_stmt, &current_stmt_group->stmt_list); append_to_statement_list (gnu_stmt, &current_stmt_group->stmt_list);
/* If this is a DECL_EXPR for a variable with DECL_INITIAL set /* If we're at top level, show everything in here is in use in case
and decl has a padded type, convert it to the unpadded type so the any of it is shared by a subprogram. */
assignment is done properly. In other case, the gimplification if (!current_function_decl)
of the DECL_EXPR will deal with DECL_INITIAL. */ walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
if (TREE_CODE (gnu_stmt) == DECL_EXPR
&& TREE_CODE (DECL_EXPR_DECL (gnu_stmt)) == VAR_DECL
&& DECL_INITIAL (DECL_EXPR_DECL (gnu_stmt))
&& TREE_CODE (TREE_TYPE (DECL_EXPR_DECL (gnu_stmt))) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (DECL_EXPR_DECL (gnu_stmt))))
{
tree gnu_decl = DECL_EXPR_DECL (gnu_stmt);
tree gnu_lhs
= convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_decl))), gnu_decl);
tree gnu_assign_stmt
= build_binary_op (MODIFY_EXPR, NULL_TREE,
gnu_lhs, DECL_INITIAL (gnu_decl));
DECL_INITIAL (gnu_decl) = 0;
annotate_with_locus (gnu_assign_stmt, DECL_SOURCE_LOCATION (gnu_decl));
add_stmt (gnu_assign_stmt);
}
} }
/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */ /* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
...@@ -4070,6 +4079,8 @@ add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node) ...@@ -4070,6 +4079,8 @@ add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node)
void void
add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
{ {
struct stmt_group *save_stmt_group = current_stmt_group;
/* If this is a variable that Gigi is to ignore, we may have been given /* If this is a variable that Gigi is to ignore, we may have been given
an ERROR_MARK. So test for it. We also might have been given a an ERROR_MARK. So test for it. We also might have been given a
reference for a renaming. So only do something for a decl. Also reference for a renaming. So only do something for a decl. Also
...@@ -4079,8 +4090,76 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) ...@@ -4079,8 +4090,76 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
&& TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE)) && TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE))
return; return;
if (global_bindings_p ())
current_stmt_group = global_stmt_group;
add_stmt_with_node (build (DECL_EXPR, void_type_node, gnu_decl), add_stmt_with_node (build (DECL_EXPR, void_type_node, gnu_decl),
gnat_entity); gnat_entity);
if (global_bindings_p ())
current_stmt_group = save_stmt_group;
/* If this is a DECL_EXPR for a variable with DECL_INITIAl set,
there are two cases we need to handle here. */
if (TREE_CODE (gnu_decl) == VAR_DECL && DECL_INITIAL (gnu_decl))
{
tree gnu_init = DECL_INITIAL (gnu_decl);
tree gnu_lhs = NULL_TREE;
/* If this is a DECL_EXPR for a variable with DECL_INITIAL set
and decl has a padded type, convert it to the unpadded type so the
assignment is done properly. */
if (TREE_CODE (TREE_TYPE (gnu_decl)) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_decl)))
gnu_lhs
= convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_decl))), gnu_decl);
/* Otherwise, if this is going into memory and the initializer isn't
valid for the assembler and loader. Gimplification could do this,
but would be run too late if -fno-unit-at-a-time. */
else if (TREE_STATIC (gnu_decl)
&& !initializer_constant_valid_p (gnu_init,
TREE_TYPE (gnu_decl)))
gnu_lhs = gnu_decl;
if (gnu_lhs)
{
tree gnu_assign_stmt
= build_binary_op (MODIFY_EXPR, NULL_TREE,
gnu_lhs, DECL_INITIAL (gnu_decl));
DECL_INITIAL (gnu_decl) = 0;
annotate_with_locus (gnu_assign_stmt,
DECL_SOURCE_LOCATION (gnu_decl));
add_stmt (gnu_assign_stmt);
}
}
}
/* 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;
}
/* Likewise, but to mark as unvisited. */
static tree
mark_unvisited (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
void *data ATTRIBUTE_UNUSED)
{
TREE_VISITED (*tp) = 0;
return NULL_TREE;
} }
/* Add GNU_CLEANUP, a cleanup action, to the current code group. */ /* Add GNU_CLEANUP, a cleanup action, to the current code group. */
...@@ -5083,7 +5162,7 @@ process_type (Entity_Id gnat_entity) ...@@ -5083,7 +5162,7 @@ process_type (Entity_Id gnat_entity)
{ {
tree gnu_decl = create_type_decl (get_entity_name (gnat_entity), tree gnu_decl = create_type_decl (get_entity_name (gnat_entity),
make_dummy_type (gnat_entity), make_dummy_type (gnat_entity),
0, 0, 0); 0, 0, 0, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0); save_gnu_tree (gnat_entity, gnu_decl, 0);
if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind) if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
...@@ -5510,93 +5589,43 @@ gnat_stabilize_reference_1 (tree e, int force) ...@@ -5510,93 +5589,43 @@ gnat_stabilize_reference_1 (tree e, int force)
return result; return result;
} }
/* GNAT_UNIT is the Defining_Identifier for some package or subprogram, /* Take care of building the elaboration procedure for the main unit.
either a spec or a body, BODY_P says which. If needed, make a function
to be the elaboration routine for that object and perform the elaborations
in GNU_ELAB_LIST.
Return 1 if we didn't need an elaboration function, zero otherwise. */ Return true if we didn't need an elaboration function, false otherwise. */
static int static bool
build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) build_unit_elab ()
{ {
tree gnu_decl; tree body, stmts;
rtx insn;
int result = 1;
/* ??? For now, force nothing to do. */ /* Mark everything we have as not visited. */
gnu_elab_list = 0; walk_tree_without_duplicates (&current_stmt_group->stmt_list,
mark_unvisited, NULL);
/* If we have nothing to do, return. */
if (gnu_elab_list == 0)
return 1;
/* Prevent the elaboration list from being reclaimed by the GC. */
gnu_pending_elaboration_lists = chainon (gnu_pending_elaboration_lists,
gnu_elab_list);
/* Set our file and line number to that of the object and set up the
elaboration routine. */
gnu_decl = create_subprog_decl (create_concat_name (gnat_unit,
body_p ?
"elabb" : "elabs"),
NULL_TREE, void_ftype, NULL_TREE, 0, 1, 0,
0);
DECL_ELABORATION_PROC_P (gnu_decl) = 1;
begin_subprog_body (gnu_decl);
gnat_pushlevel ();
expand_start_bindings (0);
/* Emit the assignments for the elaborations we have to do. If there /* Set the current function to be the elaboration procedure, pop our
is no destination, this is just a call to execute some statement binding level, end our statement group, and gimplify what we have. */
that was placed within the declarative region. But first save a set_current_block_context (gnu_elab_proc_decl);
pointer so we can see if any insns were generated. */
insn = get_last_insn ();
for (; gnu_elab_list; gnu_elab_list = TREE_CHAIN (gnu_elab_list))
if (TREE_PURPOSE (gnu_elab_list) == NULL_TREE)
{
if (TREE_VALUE (gnu_elab_list) != 0)
expand_expr_stmt (TREE_VALUE (gnu_elab_list));
}
else
{
tree lhs = TREE_PURPOSE (gnu_elab_list);
input_location = DECL_SOURCE_LOCATION (lhs);
/* If LHS has a padded type, convert it to the unpadded type
so the assignment is done properly. */
if (TREE_CODE (TREE_TYPE (lhs)) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (lhs)))
lhs = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (lhs))), lhs);
emit_line_note (input_location);
expand_expr_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE,
TREE_PURPOSE (gnu_elab_list),
TREE_VALUE (gnu_elab_list)));
}
/* See if any non-NOTE insns were generated. */
for (insn = NEXT_INSN (insn); insn; insn = NEXT_INSN (insn))
if (GET_RTX_CLASS (GET_CODE (insn)) == RTX_INSN)
{
result = 0;
break;
}
expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel (); gnat_poplevel ();
end_subprog_body (alloc_stmt_list ()); body = end_stmt_group ();
current_function_decl = gnu_elab_proc_decl;
gimplify_body (&body, gnu_elab_proc_decl);
/* We should have a BIND_EXPR, but it may or may not have any statements
in it. If it doesn't have any, we have nothing to do. */
stmts = body;
if (TREE_CODE (stmts) == BIND_EXPR)
stmts = BIND_EXPR_BODY (stmts);
/* If there are no statements, we have nothing to do. */
if (!stmts || !STATEMENT_LIST_HEAD (stmts))
return true;
/* We are finished with the elaboration list it can now be discarded. */ /* Otherwise, compile the function. Note that we'll be gimplifying
gnu_pending_elaboration_lists = TREE_CHAIN (gnu_pending_elaboration_lists); it twice, but that's fine for the nodes we use. */
begin_subprog_body (gnu_elab_proc_decl);
end_subprog_body (body);
/* If there were no insns, we don't need an elab routine. It would return false;
be nice to not output this one, but there's no good way to do that. */
return result;
} }
extern char *__gnat_to_canonical_file_spec (char *); extern char *__gnat_to_canonical_file_spec (char *);
......
gcc/ada/utils.c
...@@ -79,21 +79,6 @@ tree gnat_raise_decls[(int) LAST_REASON_CODE + 1]; ...@@ -79,21 +79,6 @@ tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
of `save_gnu_tree' for more info. */ of `save_gnu_tree' for more info. */
static GTY((length ("max_gnat_nodes"))) tree *associate_gnat_to_gnu; 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 /* 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. allocate each of them once. Signed and unsigned types are kept separate.
...@@ -108,10 +93,10 @@ static GTY(()) tree float_types[NUM_MACHINE_MODES]; ...@@ -108,10 +93,10 @@ static GTY(()) tree float_types[NUM_MACHINE_MODES];
/* For each binding contour we allocate a binding_level structure to indicate /* For each binding contour we allocate a binding_level structure to indicate
the binding depth. */ 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). */ /* 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. */ /* The BLOCK node for this level. */
tree block; tree block;
/* If nonzero, the setjmp buffer that needs to be updated for any /* 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"))) ...@@ -120,10 +105,10 @@ struct ada_binding_level GTY((chain_next ("%h.chain")))
}; };
/* The binding level currently in effect. */ /* 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. */ /* A chain of gnat_binding_level structures awaiting reuse. */
static GTY((deletable)) struct ada_binding_level *free_binding_level; static GTY((deletable)) struct gnat_binding_level *free_binding_level;
/* A chain of unused BLOCK nodes. */ /* A chain of unused BLOCK nodes. */
static GTY((deletable)) tree free_block_chain; static GTY((deletable)) tree free_block_chain;
...@@ -133,21 +118,20 @@ struct language_function GTY(()) ...@@ -133,21 +118,20 @@ struct language_function GTY(())
int unused; int unused;
}; };
static tree mark_visited (tree *, int *, void *);
static void gnat_define_builtin (const char *, tree, int, const char *, bool); static void gnat_define_builtin (const char *, tree, int, const char *, bool);
static void gnat_install_builtins (void); 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 compute_related_constant (tree, tree);
static tree split_plus (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_gimplify_function (tree);
static void gnat_finalize (tree); static void gnat_finalize (tree);
static tree float_type_for_precision (int, enum machine_mode); static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree); static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree);
static tree make_descriptor_field (const char *,tree, tree, tree); static tree make_descriptor_field (const char *,tree, tree, tree);
static int value_factor_p (tree, int); static bool value_factor_p (tree, HOST_WIDE_INT);
static int potential_alignment_gap (tree, tree, tree); static bool potential_alignment_gap (tree, tree, tree);
/* Initialize the association of GNAT nodes to GCC trees. */ /* Initialize the association of GNAT nodes to GCC trees. */
...@@ -156,8 +140,6 @@ init_gnat_to_gnu (void) ...@@ -156,8 +140,6 @@ init_gnat_to_gnu (void)
{ {
associate_gnat_to_gnu associate_gnat_to_gnu
= (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (tree)); = (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 /* 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) ...@@ -211,16 +193,8 @@ present_gnu_tree (Entity_Id gnat_entity)
int int
global_bindings_p (void) global_bindings_p (void)
{ {
return (force_global != 0 || current_binding_level->chain == 0 ? -1 : 0); return (force_global != 0 || current_binding_level == 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);
} }
/* Enter a new binding level. */ /* Enter a new binding level. */
...@@ -228,7 +202,7 @@ getdecls (void) ...@@ -228,7 +202,7 @@ getdecls (void)
void void
gnat_pushlevel () 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. */ /* Reuse a struct for this binding level, if there is one. */
if (free_binding_level) if (free_binding_level)
...@@ -238,8 +212,8 @@ gnat_pushlevel () ...@@ -238,8 +212,8 @@ gnat_pushlevel ()
} }
else else
newlevel newlevel
= (struct ada_binding_level *) = (struct gnat_binding_level *)
ggc_alloc (sizeof (struct ada_binding_level)); ggc_alloc (sizeof (struct gnat_binding_level));
/* Use a free BLOCK, if any; otherwise, allocate one. */ /* Use a free BLOCK, if any; otherwise, allocate one. */
if (free_block_chain) if (free_block_chain)
...@@ -264,6 +238,16 @@ gnat_pushlevel () ...@@ -264,6 +238,16 @@ gnat_pushlevel ()
current_binding_level = newlevel; 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. */ /* Set the jmpbuf_decl for the current binding level to DECL. */
void void
...@@ -285,7 +269,7 @@ get_block_jmpbuf_decl () ...@@ -285,7 +269,7 @@ get_block_jmpbuf_decl ()
void void
gnat_poplevel () gnat_poplevel ()
{ {
struct ada_binding_level *level = current_binding_level; struct gnat_binding_level *level = current_binding_level;
tree block = level->block; tree block = level->block;
BLOCK_VARS (block) = nreverse (BLOCK_VARS (block)); BLOCK_VARS (block) = nreverse (BLOCK_VARS (block));
...@@ -330,58 +314,32 @@ insert_block (tree block) ...@@ -330,58 +314,32 @@ insert_block (tree block)
BLOCK_SUBBLOCKS (current_binding_level->block) = block; BLOCK_SUBBLOCKS (current_binding_level->block) = block;
} }
/* Return nonzero if the current binding has any variables. This means /* Records a ..._DECL node DECL as belonging to the current lexical scope
it will have a BLOCK node. */ and uses GNAT_NODE for location information. */
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. */
tree void
pushdecl (tree decl) gnat_pushdecl (tree decl, Node_Id gnat_node)
{ {
/* If at top level, there is no context. But PARM_DECLs always go in the /* 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 level of its function. */
that are part of sizes and positions. */
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL) 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; DECL_CONTEXT (decl) = 0;
walk_tree (&decl_expr, mark_visited, NULL, NULL);
}
else else
DECL_CONTEXT (decl) = current_function_decl; DECL_CONTEXT (decl) = current_function_decl;
/* Put the declaration on the list. The list of declarations is in reverse /* Set the location of DECL and emit a declaration for it. */
order. The list will be reversed later. 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 /* Put the declaration on the list. The list of declarations is in reverse
will cause trouble with the debugger and aren't needed anyway. */ order. The list will be reversed later. We don't do this for global
if (TREE_CODE (decl) != TYPE_DECL variables. Also, don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into
|| TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE) 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); TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
BLOCK_VARS (current_binding_level->block) = decl; BLOCK_VARS (current_binding_level->block) = decl;
...@@ -405,7 +363,8 @@ pushdecl (tree decl) ...@@ -405,7 +363,8 @@ pushdecl (tree decl)
&& ! DECL_ARTIFICIAL (decl)))) && ! DECL_ARTIFICIAL (decl))))
TYPE_NAME (TREE_TYPE (decl)) = 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 /* Do little here. Set up the standard declarations later after the
...@@ -433,14 +392,21 @@ gnat_init_decl_processing (void) ...@@ -433,14 +392,21 @@ gnat_init_decl_processing (void)
set_sizetype (size_type_node); set_sizetype (size_type_node);
build_common_tree_nodes_2 (0); build_common_tree_nodes_2 (0);
pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype)); /* Give names and make TYPE_DECLs for common types. */
gnat_pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype),
/* We need to make the integer type before doing anything else. Empty);
We stitch this in to the appropriate GNAT type later. */ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"), integer_type_node),
integer_type_node)); Empty);
pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"), gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
char_type_node)); 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); ptr_void_type_node = build_pointer_type (void_type_node);
...@@ -462,7 +428,7 @@ gnat_define_builtin (const char *name, tree type, ...@@ -462,7 +428,7 @@ gnat_define_builtin (const char *name, tree type,
if (library_name) if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name)); SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
make_decl_rtl (decl, NULL); make_decl_rtl (decl, NULL);
pushdecl (decl); gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL; DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (decl) = function_code; DECL_FUNCTION_CODE (decl) = function_code;
TREE_READONLY (decl) = const_p; TREE_READONLY (decl) = const_p;
...@@ -540,7 +506,6 @@ gnat_install_builtins () ...@@ -540,7 +506,6 @@ gnat_install_builtins ()
BUILT_IN_STACK_RESTORE, "stack_restore", false); BUILT_IN_STACK_RESTORE, "stack_restore", false);
} }
/* Create the predefined scalar types such as `integer_type_node' needed /* Create the predefined scalar types such as `integer_type_node' needed
in the gcc back-end and initialize the global binding level. */ 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) ...@@ -560,8 +525,8 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
longest_float_type_node = make_node (REAL_TYPE); longest_float_type_node = make_node (REAL_TYPE);
TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE; TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE;
layout_type (longest_float_type_node); layout_type (longest_float_type_node);
pushdecl (build_decl (TYPE_DECL, get_identifier ("longest float type"), create_type_decl (get_identifier ("longest float type"),
longest_float_type_node)); longest_float_type_node, NULL, 0, 1, Empty);
} }
else else
longest_float_type_node = TREE_TYPE (long_long_float_type); 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) ...@@ -569,12 +534,11 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
except_type_node = TREE_TYPE (exception_type); except_type_node = TREE_TYPE (exception_type);
unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1); unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"), create_type_decl (get_identifier ("unsigned int"), unsigned_type_node,
unsigned_type_node)); NULL, 0, 1, Empty);
void_type_decl_node void_type_decl_node = create_type_decl (get_identifier ("void"),
= pushdecl (build_decl (TYPE_DECL, get_identifier ("void"), void_type_node, NULL, 0, 1, Empty);
void_type_node));
void_ftype = build_function_type (void_type_node, NULL_TREE); void_ftype = build_function_type (void_type_node, NULL_TREE);
ptr_void_ftype = build_pointer_type (void_ftype); ptr_void_ftype = build_pointer_type (void_ftype);
...@@ -590,7 +554,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -590,7 +554,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
sizetype, sizetype,
endlink)), 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 is a function declaration tree for a function to free memory. */
free_decl free_decl
...@@ -599,13 +563,14 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -599,13 +563,14 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
ptr_void_type_node, ptr_void_type_node,
endlink)), endlink)),
NULL_TREE, 0, 1, 1, 0); NULL_TREE, 0, 1, 1, 0, Empty);
/* Make the types and functions used for exception processing. */ /* Make the types and functions used for exception processing. */
jmpbuf_type jmpbuf_type
= build_array_type (gnat_type_for_mode (Pmode, 0), = build_array_type (gnat_type_for_mode (Pmode, 0),
build_index_type (build_int_2 (5, 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); jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
/* Functions to get and set the jumpbuf pointer for the current thread. */ /* 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) ...@@ -613,7 +578,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
= create_subprog_decl = create_subprog_decl
(get_identifier ("system__soft_links__get_jmpbuf_address_soft"), (get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE), 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 set_jmpbuf_decl
= create_subprog_decl = create_subprog_decl
...@@ -621,7 +586,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -621,7 +586,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
NULL_TREE, NULL_TREE,
build_function_type (void_type_node, build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)), 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. */ /* Function to get the current exception. */
get_excptr_decl get_excptr_decl
...@@ -629,7 +594,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -629,7 +594,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
(get_identifier ("system__soft_links__get_gnat_exception"), (get_identifier ("system__soft_links__get_gnat_exception"),
NULL_TREE, NULL_TREE,
build_function_type (build_pointer_type (except_type_node), 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. */ /* Functions that raise exceptions. */
raise_nodefer_decl raise_nodefer_decl
...@@ -639,7 +604,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -639,7 +604,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
build_pointer_type (except_type_node), build_pointer_type (except_type_node),
endlink)), endlink)),
NULL_TREE, 0, 1, 1, 0); NULL_TREE, 0, 1, 1, 0, Empty);
/* Hooks to call when entering/leaving an exception handler. */ /* Hooks to call when entering/leaving an exception handler. */
begin_handler_decl begin_handler_decl
...@@ -648,7 +613,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -648,7 +613,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
ptr_void_type_node, ptr_void_type_node,
endlink)), endlink)),
NULL_TREE, 0, 1, 1, 0); NULL_TREE, 0, 1, 1, 0, Empty);
end_handler_decl end_handler_decl
= create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE, = 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) ...@@ -656,7 +621,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
ptr_void_type_node, ptr_void_type_node,
endlink)), 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 /* If in no exception handlers mode, all raise statements are redirected to
__gnat_last_chance_handler. No need to redefine raise_nodefer_decl, since __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) ...@@ -672,7 +637,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
integer_type_node, integer_type_node,
endlink))), endlink))),
NULL_TREE, 0, 1, 1, 0); NULL_TREE, 0, 1, 1, 0, Empty);
for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++) for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
gnat_raise_decls[i] = decl; gnat_raise_decls[i] = decl;
...@@ -694,7 +659,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -694,7 +659,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
tree_cons (NULL_TREE, tree_cons (NULL_TREE,
integer_type_node, integer_type_node,
endlink))), endlink))),
NULL_TREE, 0, 1, 1, 0); NULL_TREE, 0, 1, 1, 0, Empty);
} }
/* Indicate that these never return. */ /* Indicate that these never return. */
...@@ -720,7 +685,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -720,7 +685,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
(get_identifier ("__builtin_setjmp"), NULL_TREE, (get_identifier ("__builtin_setjmp"), NULL_TREE,
build_function_type (integer_type_node, build_function_type (integer_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)), 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_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP; DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
...@@ -732,7 +697,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) ...@@ -732,7 +697,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
(get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE, (get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE,
build_function_type (void_type_node, build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)), 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_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF; 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) ...@@ -740,17 +705,14 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
main_identifier_node = get_identifier ("main"); main_identifier_node = get_identifier ("main");
} }
/* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL /* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL nodes
nodes (FIELDLIST), finish constructing the record or union type. (FIELDLIST), finish constructing the record or union type. If HAS_REP is
If HAS_REP is nonzero, this record has a rep clause; don't call nonzero, this record has a rep clause; don't call layout_type but merely set
layout_type but merely set the size and alignment ourselves. the size and alignment ourselves. If DEFER_DEBUG is nonzero, do not call
If DEFER_DEBUG is nonzero, do not call the debugging routines the debugging routines on this type; it will be done later. */
on this type; it will be done later. */
void void
finish_record_type (tree record_type, finish_record_type (tree record_type, tree fieldlist, int has_rep,
tree fieldlist,
int has_rep,
int defer_debug) int defer_debug)
{ {
enum tree_code code = TREE_CODE (record_type); enum tree_code code = TREE_CODE (record_type);
...@@ -761,14 +723,8 @@ finish_record_type (tree record_type, ...@@ -761,14 +723,8 @@ finish_record_type (tree record_type,
tree field; tree field;
TYPE_FIELDS (record_type) = fieldlist; 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) TYPE_STUB_DECL (record_type)
= pushdecl (build_decl (TYPE_DECL, TYPE_NAME (record_type), = build_decl (TYPE_DECL, NULL_TREE, record_type);
record_type));
/* We don't need both the typedef name and the record name output in /* We don't need both the typedef name and the record name output in
the debugging information, since they are the same. */ the debugging information, since they are the same. */
...@@ -942,7 +898,10 @@ finish_record_type (tree record_type, ...@@ -942,7 +898,10 @@ finish_record_type (tree record_type,
tree new_record_type tree new_record_type
= make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
? UNION_TYPE : TREE_CODE (record_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 tree new_id
= concat_id_with_name (orig_id, = concat_id_with_name (orig_id,
TREE_CODE (record_type) == QUAL_UNION_TYPE TREE_CODE (record_type) == QUAL_UNION_TYPE
...@@ -954,7 +913,7 @@ finish_record_type (tree record_type, ...@@ -954,7 +913,7 @@ finish_record_type (tree record_type,
TYPE_NAME (new_record_type) = new_id; TYPE_NAME (new_record_type) = new_id;
TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT; TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
TYPE_STUB_DECL (new_record_type) 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_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type)) DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
= DECL_IGNORED_P (TYPE_STUB_DECL (record_type)); = DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
...@@ -1086,11 +1045,8 @@ finish_record_type (tree record_type, ...@@ -1086,11 +1045,8 @@ finish_record_type (tree record_type,
We return an expression for the size. */ We return an expression for the size. */
static tree static tree
merge_sizes (tree last_size, merge_sizes (tree last_size, tree first_bit, tree size, bool special,
tree first_bit, bool has_rep)
tree size,
int special,
int has_rep)
{ {
tree type = TREE_TYPE (last_size); tree type = TREE_TYPE (last_size);
tree new; tree new;
...@@ -1188,13 +1144,9 @@ split_plus (tree in, tree *pvar) ...@@ -1188,13 +1144,9 @@ split_plus (tree in, tree *pvar)
object. RETURNS_BY_REF is nonzero if the function returns by reference. 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 RETURNS_WITH_DSP is nonzero if the function is to return with a
depressed stack pointer. */ depressed stack pointer. */
tree tree
create_subprog_type (tree return_type, create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
tree param_decl_list, int returns_unconstrained, int returns_by_ref,
tree cico_list,
int returns_unconstrained,
int returns_by_ref,
int returns_with_dsp) int returns_with_dsp)
{ {
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of /* 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) ...@@ -1275,7 +1227,7 @@ create_index_type (tree min, tree max, tree index)
type = copy_type (type); type = copy_type (type);
SET_TYPE_INDEX_TYPE (type, index); 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; return type;
} }
...@@ -1283,17 +1235,18 @@ create_index_type (tree min, tree max, tree index) ...@@ -1283,17 +1235,18 @@ create_index_type (tree min, tree max, tree index)
string) and TYPE is a ..._TYPE node giving its data type. string) and TYPE is a ..._TYPE node giving its data type.
ARTIFICIAL_P is nonzero if this is a declaration that was generated 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 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 tree
create_type_decl (tree type_name, tree type, struct attrib *attr_list, 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); tree type_decl = build_decl (TYPE_DECL, type_name, type);
enum tree_code code = TREE_CODE (type); enum tree_code code = TREE_CODE (type);
DECL_ARTIFICIAL (type_decl) = artificial_p; DECL_ARTIFICIAL (type_decl) = artificial_p;
pushdecl (type_decl);
process_attributes (type_decl, attr_list); process_attributes (type_decl, attr_list);
/* Pass type declaration information to the debugger unless this is an /* 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, ...@@ -1309,6 +1262,9 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
&& TYPE_IS_DUMMY_P (TREE_TYPE (type)))) && TYPE_IS_DUMMY_P (TREE_TYPE (type))))
rest_of_decl_compilation (type_decl, NULL, global_bindings_p (), 0); 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; return type_decl;
} }
...@@ -1326,12 +1282,14 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list, ...@@ -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). definition: no storage is to be allocated for the variable here).
STATIC_FLAG is only relevant when not at top level. In that case 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 tree
create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
int const_flag, int public_flag, int extern_flag, 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 int init_const
= (var_init == 0 = (var_init == 0
...@@ -1357,17 +1315,10 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, ...@@ -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 save any variable elaborations for the elaboration routine. If we are
just annotating types, throw away the initialization if it isn't a just annotating types, throw away the initialization if it isn't a
constant. */ constant. */
if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL) if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL)
|| (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init))) || (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init)))
var_init = 0; 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; DECL_INITIAL (var_decl) = var_init;
TREE_READONLY (var_decl) = const_flag; TREE_READONLY (var_decl) = const_flag;
DECL_EXTERNAL (var_decl) = extern_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, ...@@ -1386,9 +1337,8 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
process_attributes (var_decl, attr_list); process_attributes (var_decl, attr_list);
/* Add this decl to the current binding level and generate any /* Add this decl to the current binding level. */
needed code and RTL. */ gnat_pushdecl (var_decl, gnat_node);
var_decl = pushdecl (var_decl);
if (TREE_SIDE_EFFECTS (var_decl)) if (TREE_SIDE_EFFECTS (var_decl))
TREE_ADDRESSABLE (var_decl) = 1; TREE_ADDRESSABLE (var_decl) = 1;
...@@ -1407,13 +1357,8 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, ...@@ -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. */ the address of this field for aliasing purposes. */
tree tree
create_field_decl (tree field_name, create_field_decl (tree field_name, tree field_type, tree record_type,
tree field_type, int packed, tree size, tree pos, int addressable)
tree record_type,
int packed,
tree size,
tree pos,
int addressable)
{ {
tree field_decl = build_decl (FIELD_DECL, field_name, field_type); tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
...@@ -1540,7 +1485,7 @@ create_field_decl (tree field_name, ...@@ -1540,7 +1485,7 @@ create_field_decl (tree field_name,
/* Subroutine of previous function: return nonzero if EXP, ignoring any side /* Subroutine of previous function: return nonzero if EXP, ignoring any side
effects, has the value of zero. */ effects, has the value of zero. */
static int static bool
value_zerop (tree exp) value_zerop (tree exp)
{ {
if (TREE_CODE (exp) == COMPOUND_EXPR) if (TREE_CODE (exp) == COMPOUND_EXPR)
...@@ -1629,36 +1574,11 @@ process_attributes (tree decl, struct attrib *attr_list) ...@@ -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 static bool
add_pending_elaborations (tree var_decl, tree var_init) value_factor_p (tree value, HOST_WIDE_INT factor)
{
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)
{ {
if (host_integerp (value, 1)) if (host_integerp (value, 1))
return tree_low_cst (value, 1) % factor == 0; return tree_low_cst (value, 1) % factor == 0;
...@@ -1676,7 +1596,7 @@ value_factor_p (tree value, int factor) ...@@ -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 is the distance in bits between the end of PREV_FIELD and the starting
position of CURR_FIELD. It is ignored if null. */ position of CURR_FIELD. It is ignored if null. */
static int static bool
potential_alignment_gap (tree prev_field, tree curr_field, tree offset) 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 */ /* 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) ...@@ -1716,64 +1636,6 @@ potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
return 1; 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. */ /* Returns a LABEL_DECL node for LABEL_NAME. */
tree tree
...@@ -1794,17 +1656,13 @@ create_label_decl (tree label_name) ...@@ -1794,17 +1656,13 @@ create_label_decl (tree label_name)
PARM_DECL nodes chained through the TREE_CHAIN field). PARM_DECL nodes chained through the TREE_CHAIN field).
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the 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 tree
create_subprog_decl (tree subprog_name, create_subprog_decl (tree subprog_name, tree asm_name,
tree asm_name, tree subprog_type, tree param_decl_list, int inline_flag,
tree subprog_type, int public_flag, int extern_flag,
tree param_decl_list, struct attrib *attr_list, Node_Id gnat_node)
int inline_flag,
int public_flag,
int extern_flag,
struct attrib *attr_list)
{ {
tree return_type = TREE_TYPE (subprog_type); tree return_type = TREE_TYPE (subprog_type);
tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type); tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type);
...@@ -1834,7 +1692,7 @@ create_subprog_decl (tree subprog_name, ...@@ -1834,7 +1692,7 @@ create_subprog_decl (tree subprog_name,
process_attributes (subprog_decl, attr_list); process_attributes (subprog_decl, attr_list);
/* Add this decl to the current binding level. */ /* 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. */ /* Output the assembler code and/or RTL for the declaration. */
rest_of_decl_compilation (subprog_decl, 0, global_bindings_p (), 0); rest_of_decl_compilation (subprog_decl, 0, global_bindings_p (), 0);
...@@ -1842,12 +1700,6 @@ create_subprog_decl (tree subprog_name, ...@@ -1842,12 +1700,6 @@ create_subprog_decl (tree subprog_name,
return subprog_decl; 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 /* Set up the framework for generating code for SUBPROG_DECL, a subprogram
body. This routine needs to be invoked before processing the declarations body. This routine needs to be invoked before processing the declarations
appearing in the subprogram. */ appearing in the subprogram. */
...@@ -1857,30 +1709,22 @@ begin_subprog_body (tree subprog_decl) ...@@ -1857,30 +1709,22 @@ begin_subprog_body (tree subprog_decl)
{ {
tree param_decl; tree param_decl;
if (function_nesting_depth++ != 0) current_function_decl = subprog_decl;
push_function_context ();
announce_function (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 /* Enter a new binding level and show that all the parameters belong to
this function. */ this function. */
current_function_decl = subprog_decl;
gnat_pushlevel (); gnat_pushlevel ();
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl; for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = TREE_CHAIN (param_decl)) param_decl = TREE_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl; DECL_CONTEXT (param_decl) = subprog_decl;
init_function_start (subprog_decl); make_decl_rtl (subprog_decl, NULL);
expand_function_start (subprog_decl, 0);
/* 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 /* Finish the definition of the current subprogram and compile it all the way
...@@ -1978,11 +1822,8 @@ gnat_finalize (tree fndecl) ...@@ -1978,11 +1822,8 @@ gnat_finalize (tree fndecl)
ATTRS is nonzero, use that for the function attribute list. */ ATTRS is nonzero, use that for the function attribute list. */
tree tree
builtin_function (const char *name, builtin_function (const char *name, tree type, int function_code,
tree type, enum built_in_class class, const char *library_name,
int function_code,
enum built_in_class class,
const char *library_name,
tree attrs) tree attrs)
{ {
tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
...@@ -1992,7 +1833,7 @@ builtin_function (const char *name, ...@@ -1992,7 +1833,7 @@ builtin_function (const char *name,
if (library_name) if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name)); SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
pushdecl (decl); gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = class; DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code; DECL_FUNCTION_CODE (decl) = function_code;
if (attrs) if (attrs)
...@@ -2295,7 +2136,7 @@ build_template (tree template_type, tree array_type, tree expr) ...@@ -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 /* Build a VMS descriptor from a Mechanism_Type, which must specify
a descriptor type, and the GCC type of an object. Each FIELD_DECL 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 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 to print out an error message if the mechanism cannot be applied to
an object of that type and also for the name. */ 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) ...@@ -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); finish_record_type (record_type, field_list, 0, 1);
pushdecl (build_decl (TYPE_DECL, create_concat_name (gnat_entity, "DESC"), create_type_decl (create_concat_name (gnat_entity, "DESC"), record_type,
record_type)); NULL, 1, 0, gnat_entity);
return record_type; return record_type;
} }
......
gcc/ada/utils2.c
...@@ -1751,9 +1751,10 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align, ...@@ -1751,9 +1751,10 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
tree gnu_range tree gnu_range
= build_range_type (NULL_TREE, size_one_node, gnu_size); = build_range_type (NULL_TREE, size_one_node, gnu_size);
tree gnu_array_type = build_array_type (char_type_node, gnu_range); tree gnu_array_type = build_array_type (char_type_node, gnu_range);
tree gnu_decl = tree gnu_decl
create_var_decl (get_identifier ("RETVAL"), NULL_TREE, = create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
gnu_array_type, NULL_TREE, 0, 0, 0, 0, 0); gnu_array_type, NULL_TREE, 0, 0, 0, 0, 0,
gnat_node);
return convert (ptr_void_type_node, return convert (ptr_void_type_node,
build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl)); build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl));
...@@ -1779,12 +1780,8 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align, ...@@ -1779,12 +1780,8 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
the storage pool to use. */ the storage pool to use. */
tree tree
build_allocator (tree type, build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
tree init, Entity_Id gnat_pool, Node_Id gnat_node)
tree result_type,
Entity_Id gnat_proc,
Entity_Id gnat_pool,
Node_Id gnat_node)
{ {
tree size = TYPE_SIZE_UNIT (type); tree size = TYPE_SIZE_UNIT (type);
tree result; tree result;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment