+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>
* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
static tree make_type_from_size (tree, tree, int);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
static void check_ok_for_atomic (tree, Entity_Id, int);
-static void annotate_decl_with_node (tree, Node_Id);
\f
/* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
GCC type corresponding to that entity. GNAT_ENTITY is assumed to
gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, gnu_expr,
- 0, 0, 0, 0, 0);
- annotate_decl_with_node (gnu_new_var, gnat_entity);
- add_decl_expr (gnu_new_var, gnat_entity);
+ 0, 0, 0, 0, 0, gnat_entity);
if (gnu_expr != 0)
add_stmt_with_node
gnu_expr, const_flag,
Is_Public (gnat_entity),
imported_p || !definition,
- static_p, attr_list);
- annotate_decl_with_node (gnu_decl, gnat_entity);
+ static_p, attr_list, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
if (Present (Address_Clause (gnat_entity)) && used_by_ref)
DECL_POINTER_ALIAS_SET (gnu_decl) = 0;
- add_decl_expr (gnu_decl, gnat_entity);
-
if (definition && DECL_SIZE (gnu_decl) != 0
&& get_block_jmpbuf_decl ()
&& (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST
tree gnu_corr_var
= create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
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);
}
gnu_type);
tree gnu_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);
gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
gnu_value, gnu_literal_list);
this_deferred = this_made_decl = 1;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
+ debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0);
saved = 1;
}
gnu_ind_subtype,
gnu_template_type, 0, 0, 0, 0);
- annotate_decl_with_node (gnu_min_field, gnat_entity);
- annotate_decl_with_node (gnu_max_field, gnat_entity);
+ Sloc_to_locus (Sloc (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);
/* We can't use build_component_ref here since the template
create_type_decl (create_concat_name (gnat_entity, "XUA"),
tem, 0, ! Comes_From_Source (gnat_entity),
- debug_info_p);
- rest_of_type_compilation (gnu_fat_type, global_bindings_p ());
+ debug_info_p, gnat_entity);
/* Create a record type for the object and its template and
set the template at a negative offset. */
/* Give the thin pointer type a name. */
create_type_decl (create_concat_name (gnat_entity, "XUX"),
build_pointer_type (tem), 0,
- ! Comes_From_Source (gnat_entity), debug_info_p);
+ ! Comes_From_Source (gnat_entity), debug_info_p,
+ gnat_entity);
}
break;
* Treat_As_Volatile (gnat_entity))));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
+ debug_info_p, gnat_entity);
if (! Comes_From_Source (gnat_entity))
DECL_ARTIFICIAL (gnu_decl) = 1;
this_deferred = 1;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
+ debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1;
}
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_id;
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);
for (gnat_field = First_Entity (gnat_entity);
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_STUB_DECL (gnu_type)
- = pushdecl (build_decl (TYPE_DECL, TYPE_NAME (gnu_type),
- gnu_type));
- 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 ());
+ = create_type_decl (TYPE_NAME (gnu_type), gnu_type,
+ NULL, 1, debug_info_p, gnat_entity);
}
/* Otherwise, go down all the components in the new type and
(make_dummy_type (Directly_Designated_Type (gnat_entity)));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
+ debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
+ debug_info_p, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1;
DECL_POINTS_TO_READONLY_P (gnu_param)
= (Ekind (gnat_param) == E_In_Parameter
&& (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);
gnu_param_list = chainon (gnu_param, gnu_param_list);
gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
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;
gnu_field_list = gnu_field;
gnu_return_list = tree_cons (gnu_field, gnu_param,
gnu_decl
= create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
gnu_address, 0, Is_Public (gnat_entity),
- extern_flag, 0, 0);
+ extern_flag, 0, 0, gnat_entity);
DECL_BY_REF_P (gnu_decl) = 1;
- add_decl_expr (gnu_decl, gnat_entity);
}
else if (kind == E_Subprogram_Type)
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
+ debug_info_p, gnat_entity);
else
{
gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name,
gnu_type, gnu_param_list,
inline_flag, public_flag,
- extern_flag, attr_list);
+ extern_flag, attr_list,
+ gnat_entity);
DECL_STUBBED_P (gnu_decl)
= Convention (gnat_entity) == Convention_Stubbed;
}
updates when we see it. */
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
+ debug_info_p, gnat_entity);
save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
break;
TYPE_USER_ALIGN (gnu_type) = 1;
if (gnu_decl == 0)
- {
- gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
- ! Comes_From_Source (gnat_entity),
- debug_info_p);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- }
+ gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
+ ! Comes_From_Source (gnat_entity),
+ debug_info_p, gnat_entity);
else
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)))
TYPE_MAX_VALUE (gnu_scalar_type)
= 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;
gnu_type = make_node (ENUMERAL_TYPE);
TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
+ TYPE_DUMMY_P (gnu_type) = 1;
if (AGGREGATE_TYPE_P (gnu_type))
- TYPE_STUB_DECL (gnu_type)
- = pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
+ TYPE_STUB_DECL (gnu_type) = build_decl (TYPE_DECL, NULL_TREE, gnu_type);
- TYPE_DUMMY_P (gnu_type) = 1;
dummy_node_table[gnat_underlying] = gnu_type;
return gnu_type;
/* Now create the variable if we need it. */
if (need_debug || (expr_variable && expr_global))
- {
- gnu_decl
- = create_var_decl (create_concat_name (gnat_entity,
- IDENTIFIER_POINTER (gnu_name)),
- NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
- Is_Public (gnat_entity), ! definition, 0, 0);
- annotate_decl_with_node (gnu_decl, gnat_entity);
- add_decl_expr (gnu_decl, gnat_entity);
- }
+ gnu_decl
+ = create_var_decl (create_concat_name (gnat_entity,
+ IDENTIFIER_POINTER (gnu_name)),
+ NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
+ Is_Public (gnat_entity), ! definition, 0, 0,
+ gnat_entity);
/* We only need to use this variable if we are in global context since GCC
can do the right thing in the local case. */
0, ! Comes_From_Source (gnat_entity),
! (TYPE_NAME (type) != 0
&& 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
BLKmode and a small constant size, try to make a form that has an
|| ! DECL_IGNORED_P (TYPE_NAME (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);
if (TREE_CODE (orig_name) == TYPE_DECL)
0, 0);
if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition)
- {
- tree gnu_xvz
- = create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
- sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0);
-
- add_decl_expr (gnu_xvz, gnat_entity);
- }
+ create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
+ sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0,
+ gnat_entity);
}
type = record;
DEFINITION is nonzero if this field is for a record being defined. */
static tree
-gnat_to_gnu_field (Entity_Id gnat_field,
- tree gnu_record_type,
- int packed,
+gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
int definition)
{
tree gnu_field_id = get_entity_name (gnat_field);
gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
packed, gnu_size, gnu_pos,
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);
if (Ekind (gnat_field) == E_Discriminant)
fields of the record and then the record type is finished. */
static void
-components_to_record (tree gnu_record_type,
- Node_Id component_list,
- tree gnu_field_list,
- int packed,
- int definition,
- tree *p_gnu_rep_list,
- int cancel_alignment,
- int all_rep)
+components_to_record (tree gnu_record_type, Node_Id component_list,
+ tree gnu_field_list, int packed, int definition,
+ tree *p_gnu_rep_list, int cancel_alignment, int all_rep)
{
Node_Id component_decl;
Entity_Id gnat_field;
gnat_error_point, gnat_entity);
}
\f
-/* Set the DECL_SOURCE_LOCATION of GNU_DECL to the location of
- GNAT_NODE. */
-
-static void
-annotate_decl_with_node (tree gnu_decl, Node_Id gnat_node)
-{
- Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_decl));
-}
-\f
-/* 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. */
+/* 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
gnat_substitute_in_type (tree t, tree f, tree r)
/* Called when we need to protect a variable object using a save_expr. */
extern tree maybe_variable (tree);
-/* 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. */
extern tree make_aligning_type (tree, int, tree);
/* Returns non-zero if we are currently in the global binding level */
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. */
extern void gnat_pushlevel (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. */
extern void set_block_jmpbuf_decl (tree);
to handle the BLOCK node inside the BIND_EXPR. */
extern void insert_block (tree);
-/* Return nonzero if the are any variables in the current block. */
-extern int block_has_vars (void);
+/* Records a ..._DECL node DECL as belonging to the current lexical scope
+ 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.
- 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_stmt_group (void);
extern void gnat_init_decl_processing (void);
extern void init_gigi_decls (tree, tree);
extern void gnat_init_gcc_eh (void);
string) and TYPE is a ..._TYPE node giving its data type.
ARTIFICIAL_P is nonzero if this is a declaration that was generated
by the compiler. DEBUG_INFO_P is nonzero if we need to write debugging
- information about this type. */
-extern tree create_type_decl (tree, tree, struct attrib *, int, int);
+ information about this type. GNAT_NODE is used for the position of
+ 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.
ASM_NAME is its assembler name (if provided). TYPE is
when processing an external variable declaration (as opposed to a
definition: no storage is to be allocated for the variable here).
STATIC_FLAG is only relevant when not at top level. In that case
- it indicates whether to always allocate storage to the variable. */
+ it indicates whether to always allocate storage to the variable.
+
+ GNAT_NODE is used for the position of the decl. */
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. */
extern void process_attributes (tree, struct attrib *);
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
PARM_DECL nodes chained through the TREE_CHAIN field).
- INLINE_FLAG, PUBLIC_FLAG, and EXTERN_FLAG are used to set the appropriate
- fields in the FUNCTION_DECL. */
+ INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
+ appropriate fields in the FUNCTION_DECL. GNAT_NODE gives the location. */
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. */
extern tree create_label_decl (tree);
#define LANG_HOOKS_HONOR_READONLY true
#undef LANG_HOOKS_HASH_TYPES
#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
#define LANG_HOOKS_PUSHLEVEL lhd_do_nothing_i
#undef LANG_HOOKS_POPLEVEL
#define LANG_HOOKS_POPLEVEL lhd_do_nothing_iii_return_null_tree
#undef LANG_HOOKS_SET_BLOCK
#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
#define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
#undef LANG_HOOKS_GET_ALIAS_SET
static bool
gnat_init (void)
{
+ /* Initialize translations and the outer statement group. */
+ gnat_init_stmt_group ();
+
/* Performs whatever initialization steps needed by the language-dependent
lexical analyzer. */
gnat_init_decl_processing ();
};
static GTY(()) struct stmt_group *current_stmt_group;
+static struct stmt_group *global_stmt_group;
/* List of unused struct stmt_group nodes. */
static GTY((deletable)) struct stmt_group *stmt_group_free_list;
TREE_VALUE of each entry is the label at the end of the switch. */
static GTY(()) tree gnu_switch_label_stack;
-/* List of TREE_LIST nodes containing pending elaborations lists.
- used to prevent the elaborations being reclaimed by GC. */
-static GTY(()) tree gnu_pending_elaboration_lists;
+/* The FUNCTION_DECL for the elaboration procedure for the main unit. */
+static GTY(()) tree gnu_elab_proc_decl;
/* Map GNAT tree codes to GCC tree codes for simple expressions. */
static enum tree_code gnu_codes[Number_Node_Kinds];
static void insert_code_for (Node_Id);
static void start_stmt_group (void);
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 void add_stmt_list (List_Id);
static tree build_stmt_group (List_Id, bool);
static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static tree maybe_implicit_deref (tree);
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);
/* Constants for +0.5 and -0.5 for float-to-integer rounding. */
structures and then generates code. */
void
-gigi (Node_Id gnat_root,
- int max_gnat_node,
- int number_name,
- struct Node *nodes_ptr,
- Node_Id *next_node_ptr,
- Node_Id *prev_node_ptr,
- struct Elist_Header *elists_ptr,
- 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,
+gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
+ struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr,
+ struct Elist_Header *elists_ptr, 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)
{
tree gnu_standard_long_long_float;
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
errors. */
if (type_annotate_only)
if (Nkind (gnat_root) != N_Compilation_Unit)
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.
Then make the rest of the standard types. Note that some of these
may be subtypes. */
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
= gnat_to_gnu_entity (Base_Type (standard_long_long_float), NULL_TREE, 0);
gnu_standard_exception_type
gnat_to_gnu (gnat_root);
}
\f
+/* 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);
+}
+\f
/* 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
root of some GNAT tree. Return the root of the corresponding GCC tree.
tree
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_type = void_type_node;
tree gnu_expr;
return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
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))
{
/********************************/
{
if ((Is_Public (gnat_temp) || global_bindings_p ())
&& ! TREE_CONSTANT (gnu_expr))
- {
- gnu_expr
- = create_var_decl (create_concat_name (gnat_temp, "init"),
- NULL_TREE, TREE_TYPE (gnu_expr),
- gnu_expr, 0, Is_Public (gnat_temp), 0,
- 0, 0);
- add_decl_expr (gnu_expr, gnat_temp);
- }
+ gnu_expr
+ = create_var_decl (create_concat_name (gnat_temp, "init"),
+ NULL_TREE, TREE_TYPE (gnu_expr),
+ gnu_expr, 0, Is_Public (gnat_temp), 0,
+ 0, 0, gnat_temp);
else
gnu_expr = maybe_variable (gnu_expr);
Prefix is a unit, not an object with a GCC equivalent. Similarly
for Elaborated, since that variable isn't otherwise known. */
if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
- {
- gnu_prefix
- = create_subprog_decl
- (create_concat_name (Entity (Prefix (gnat_node)),
- attribute == Attr_Elab_Body
- ? "elabb" : "elabs"),
- NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0);
- return gnu_prefix;
- }
+ return (create_subprog_decl
+ (create_concat_name (Entity (Prefix (gnat_node)),
+ attribute == Attr_Elab_Body
+ ? "elabb" : "elabs"),
+ NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0, gnat_node));
gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
gnu_type = TREE_TYPE (gnu_prefix);
{
COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt;
gnu_result = gnu_cond_expr;
+ recalculate_side_effects (gnu_cond_expr);
}
else
gnu_result = gnu_loop_stmt;
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
the body so that the line number notes are written
correctly. */
Sloc_to_locus (Sloc (gnat_node),
&DECL_SOURCE_LOCATION (gnu_subprog_decl));
- current_function_decl = gnu_subprog_decl;
- announce_function (gnu_subprog_decl);
+ begin_subprog_body (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);
/* If there are OUT parameters, we need to ensure that the return
}
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
end location. */
mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
write_symbols = save_write_symbols;
debug_hooks = save_debug_hooks;
- ggc_pop_context ();
gnu_result = alloc_stmt_list ();
}
break;
case N_Compilation_Unit:
- start_stmt_group ();
+ /* 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 ();
/* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body
|| Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration
|| Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration)
{
- gnu_result = end_stmt_group ();
+ gnu_result = alloc_stmt_list ();
break;
}
}
add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node)));
add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
- /* Generate elaboration code for this unit, if necessary, and
- say whether we did or not. */
- Set_Has_No_Elaboration_Code
- (gnat_node,
- build_unit_elab
- (Defining_Entity (Unit (gnat_node)),
- Nkind (Unit (gnat_node)) == N_Package_Body
- || Nkind (Unit (gnat_node)) == N_Subprogram_Body,
- get_pending_elaborations ()));
-
- gnu_result = end_stmt_group ();
+ /* If this is the main unit, generate elaboration code for this
+ unit, if necessary, and say whether we did or not. Otherwise,
+ there is no elaboration code and we end our statement group. */
+ if (gnat_node == Cunit (Main_Unit))
+ {
+ Set_Has_No_Elaboration_Code (gnat_node, build_unit_elab ());
+ gnu_result = alloc_stmt_list ();
+ }
+ else
+ {
+ Set_Has_No_Elaboration_Code (gnat_node, 1);
+ gnu_result = end_stmt_group ();
+ }
break;
case N_Subprogram_Body_Stub:
&& Exception_Mechanism == Setjmp_Longjmp);
bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
- /* The statement(s) for the block itself. */
- tree gnu_inner_block;
+ tree gnu_inner_block; /* The statement(s) for the block itself. */
/* If there are any exceptions or cleanup processing involved, we need
an outer statement group (for Setjmp_Longjmp) and binding level. */
= create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE,
jmpbuf_ptr_type,
build_call_0_expr (get_jmpbuf_decl),
- 0, 0, 0, 0, 0);
+ 0, 0, 0, 0, 0, gnat_node);
gnu_jmpbuf_decl
= create_var_decl (get_identifier ("JMP_BUF"),
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);
/* When we exit this block, restore the saved value. */
NULL_TREE,
build_pointer_type (except_type_node),
build_call_0_expr (get_excptr_decl),
- 0, 0, 0, 0, 0));
- add_decl_expr (TREE_VALUE (gnu_except_ptr_stack), gnat_node);
+ 0, 0, 0, 0, 0, gnat_node));
/* Generate code for each handler. The N_Exception_Handler case
below does the real work and returns a COND_EXPR for each
gnu_incoming_exc_ptr
= create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
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,
gnu_incoming_exc_ptr),
gnat_node);
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
return something of void_type, it means we have something we're
elaborating for effect, so just return. */
{
append_to_statement_list (gnu_stmt, ¤t_stmt_group->stmt_list);
- /* 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. In other case, the gimplification
- of the DECL_EXPR will deal with DECL_INITIAL. */
- 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);
- }
+ /* If we're at top level, show everything in here is in use in case
+ any of it is shared by a subprogram. */
+ if (!current_function_decl)
+ walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
}
/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
void
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
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
&& TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE))
return;
+ if (global_bindings_p ())
+ current_stmt_group = global_stmt_group;
+
add_stmt_with_node (build (DECL_EXPR, void_type_node, gnu_decl),
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. */
{
tree gnu_decl = create_type_decl (get_entity_name (gnat_entity),
make_dummy_type (gnat_entity),
- 0, 0, 0);
+ 0, 0, 0, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0);
if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
return result;
}
\f
-/* GNAT_UNIT is the Defining_Identifier for some package or subprogram,
- 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.
+/* Take care of building the elaboration procedure for the main unit.
- 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
-build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
+static bool
+build_unit_elab ()
{
- tree gnu_decl;
- rtx insn;
- int result = 1;
-
- /* ??? For now, force nothing to do. */
- gnu_elab_list = 0;
-
- /* 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
- is no destination, this is just a call to execute some statement
- that was placed within the declarative region. But first save a
- 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)));
- }
+ tree body, stmts;
- /* 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;
- }
+ /* Mark everything we have as not visited. */
+ walk_tree_without_duplicates (¤t_stmt_group->stmt_list,
+ mark_unvisited, NULL);
- expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+ /* Set the current function to be the elaboration procedure, pop our
+ binding level, end our statement group, and gimplify what we have. */
+ set_current_block_context (gnu_elab_proc_decl);
gnat_poplevel ();
- end_subprog_body (alloc_stmt_list ());
-
- /* We are finished with the elaboration list it can now be discarded. */
- gnu_pending_elaboration_lists = TREE_CHAIN (gnu_pending_elaboration_lists);
-
- /* If there were no insns, we don't need an elab routine. It would
- be nice to not output this one, but there's no good way to do that. */
- return result;
+ 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;
+
+ /* Otherwise, compile the function. Note that we'll be gimplifying
+ it twice, but that's fine for the nodes we use. */
+ begin_subprog_body (gnu_elab_proc_decl);
+ end_subprog_body (body);
+
+ return false;
}
\f
extern char *__gnat_to_canonical_file_spec (char *);
of `save_gnu_tree' for more info. */
static GTY((length ("max_gnat_nodes"))) tree *associate_gnat_to_gnu;
-/* This listhead is used to record any global objects that need elaboration.
- TREE_PURPOSE is the variable to be elaborated and TREE_VALUE is the
- initial value to assign. */
-
-static GTY(()) tree pending_elaborations;
-
-/* This stack allows us to momentarily switch to generating elaboration
- lists for an inner context. */
-
-struct e_stack GTY((chain_next ("%h.next"))) {
- struct e_stack *next;
- tree elab_list;
-};
-static GTY(()) struct e_stack *elist_stack;
-
/* This variable keeps a table for types for each precision so that we only
allocate each of them once. Signed and unsigned types are kept separate.
/* For each binding contour we allocate a binding_level structure to indicate
the binding depth. */
-struct ada_binding_level GTY((chain_next ("%h.chain")))
+struct gnat_binding_level GTY((chain_next ("%h.chain")))
{
/* The binding level containing this one (the enclosing binding level). */
- struct ada_binding_level *chain;
+ struct gnat_binding_level *chain;
/* The BLOCK node for this level. */
tree block;
/* If nonzero, the setjmp buffer that needs to be updated for any
};
/* The binding level currently in effect. */
-static GTY(()) struct ada_binding_level *current_binding_level;
+static GTY(()) struct gnat_binding_level *current_binding_level;
-/* A chain of ada_binding_level structures awaiting reuse. */
-static GTY((deletable)) struct ada_binding_level *free_binding_level;
+/* A chain of gnat_binding_level structures awaiting reuse. */
+static GTY((deletable)) struct gnat_binding_level *free_binding_level;
/* A chain of unused BLOCK nodes. */
static GTY((deletable)) tree free_block_chain;
int unused;
};
-static tree mark_visited (tree *, int *, void *);
static void gnat_define_builtin (const char *, tree, int, const char *, bool);
static void gnat_install_builtins (void);
-static tree merge_sizes (tree, tree, tree, int, int);
+static tree merge_sizes (tree, tree, tree, bool, bool);
static tree compute_related_constant (tree, tree);
static tree split_plus (tree, tree *);
-static int value_zerop (tree);
+static bool value_zerop (tree);
static void gnat_gimplify_function (tree);
static void gnat_finalize (tree);
static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree);
static tree make_descriptor_field (const char *,tree, tree, tree);
-static int value_factor_p (tree, int);
-static int potential_alignment_gap (tree, tree, tree);
+static bool value_factor_p (tree, HOST_WIDE_INT);
+static bool potential_alignment_gap (tree, tree, tree);
\f
/* Initialize the association of GNAT nodes to GCC trees. */
{
associate_gnat_to_gnu
= (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (tree));
-
- pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
}
/* GNAT_ENTITY is a GNAT tree node for an entity. GNU_DECL is the GCC tree
int
global_bindings_p (void)
{
- return (force_global != 0 || current_binding_level->chain == 0 ? -1 : 0);
-}
-
-/* Return the list of declarations in the current level. Note that this list
- is in reverse order (it has to be so for back-end compatibility). */
-
-tree
-getdecls (void)
-{
- return BLOCK_VARS (current_binding_level->block);
+ return (force_global != 0 || current_binding_level == 0
+ || current_binding_level->chain == 0 ? -1 : 0);
}
/* Enter a new binding level. */
void
gnat_pushlevel ()
{
- struct ada_binding_level *newlevel = NULL;
+ struct gnat_binding_level *newlevel = NULL;
/* Reuse a struct for this binding level, if there is one. */
if (free_binding_level)
}
else
newlevel
- = (struct ada_binding_level *)
- ggc_alloc (sizeof (struct ada_binding_level));
+ = (struct gnat_binding_level *)
+ ggc_alloc (sizeof (struct gnat_binding_level));
/* Use a free BLOCK, if any; otherwise, allocate one. */
if (free_block_chain)
current_binding_level = newlevel;
}
+/* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
+ and point FNDECL to this BLOCK. */
+
+void
+set_current_block_context (tree fndecl)
+{
+ BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
+ DECL_INITIAL (fndecl) = current_binding_level->block;
+}
+
/* Set the jmpbuf_decl for the current binding level to DECL. */
void
void
gnat_poplevel ()
{
- struct ada_binding_level *level = current_binding_level;
+ struct gnat_binding_level *level = current_binding_level;
tree block = level->block;
BLOCK_VARS (block) = nreverse (BLOCK_VARS (block));
TREE_CHAIN (block) = BLOCK_SUBBLOCKS (current_binding_level->block);
BLOCK_SUBBLOCKS (current_binding_level->block) = block;
}
-
-/* Return nonzero if the current binding has any variables. This means
- it will have a BLOCK node. */
-
-int
-block_has_vars ()
-{
- return BLOCK_VARS (current_binding_level->block) != 0;
-}
-\f
-/* 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;
-}
\f
-/* Records a ..._DECL node DECL as belonging to the current lexical scope.
- Returns the ..._DECL node. */
+/* Records a ..._DECL node DECL as belonging to the current lexical scope
+ and uses GNAT_NODE for location information. */
-tree
-pushdecl (tree decl)
+void
+gnat_pushdecl (tree decl, Node_Id gnat_node)
{
/* If at top level, there is no context. But PARM_DECLs always go in the
- level of its function. Also, at toplevel we must protect all trees
- that are part of sizes and positions. */
+ level of its function. */
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
- {
- /* Make a DECL_EXPR so we'll walk into the appropriate fields of
- the type or decl. */
- tree decl_expr = build1 (DECL_EXPR, void_type_node, decl);
-
- DECL_CONTEXT (decl) = 0;
- walk_tree (&decl_expr, mark_visited, NULL, NULL);
- }
+ DECL_CONTEXT (decl) = 0;
else
DECL_CONTEXT (decl) = current_function_decl;
- /* Put the declaration on the list. The list of declarations is in reverse
- order. The list will be reversed later.
+ /* Set the location of DECL and emit a declaration for it. */
+ if (Present (gnat_node))
+ Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
+ add_decl_expr (decl, gnat_node);
- Don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into the list. They
- will cause trouble with the debugger and aren't needed anyway. */
- if (TREE_CODE (decl) != TYPE_DECL
- || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE)
+ /* Put the declaration on the list. The list of declarations is in reverse
+ order. The list will be reversed later. We don't do this for global
+ variables. Also, don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into
+ the list. They will cause trouble with the debugger and aren't needed
+ anyway. */
+ if (!global_bindings_p ()
+ && (TREE_CODE (decl) != TYPE_DECL
+ || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE))
{
TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
BLOCK_VARS (current_binding_level->block) = decl;
&& DECL_ARTIFICIAL (TYPE_NAME (TREE_TYPE (decl)))
&& ! DECL_ARTIFICIAL (decl))))
TYPE_NAME (TREE_TYPE (decl)) = decl;
-
- return decl;
+
+ if (TREE_CODE (decl) != CONST_DECL)
+ rest_of_decl_compilation (decl, NULL, global_bindings_p (), 0);
}
\f
/* Do little here. Set up the standard declarations later after the
set_sizetype (size_type_node);
build_common_tree_nodes_2 (0);
- pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype));
-
- /* We need to make the integer type before doing anything else.
- We stitch this in to the appropriate GNAT type later. */
- pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
- integer_type_node));
- pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
- char_type_node));
+ /* Give names and make TYPE_DECLs for common types. */
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
+ integer_type_node),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
+ char_type_node),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"),
+ long_integer_type_node),
+ Empty);
+ gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
+ void_type_node),
+ Empty);
ptr_void_type_node = build_pointer_type (void_type_node);
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
make_decl_rtl (decl, NULL);
- pushdecl (decl);
+ gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (decl) = function_code;
TREE_READONLY (decl) = const_p;
BUILT_IN_STACK_RESTORE, "stack_restore", false);
}
-
/* Create the predefined scalar types such as `integer_type_node' needed
in the gcc back-end and initialize the global binding level. */
longest_float_type_node = make_node (REAL_TYPE);
TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE;
layout_type (longest_float_type_node);
- pushdecl (build_decl (TYPE_DECL, get_identifier ("longest float type"),
- longest_float_type_node));
+ create_type_decl (get_identifier ("longest float type"),
+ longest_float_type_node, NULL, 0, 1, Empty);
}
else
longest_float_type_node = TREE_TYPE (long_long_float_type);
except_type_node = TREE_TYPE (exception_type);
unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
- pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
- unsigned_type_node));
+ create_type_decl (get_identifier ("unsigned int"), unsigned_type_node,
+ NULL, 0, 1, Empty);
- void_type_decl_node
- = pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
- void_type_node));
+ void_type_decl_node = create_type_decl (get_identifier ("void"),
+ void_type_node, NULL, 0, 1, Empty);
void_ftype = build_function_type (void_type_node, NULL_TREE);
ptr_void_ftype = build_pointer_type (void_ftype);
tree_cons (NULL_TREE,
sizetype,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* free is a function declaration tree for a function to free memory. */
free_decl
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Make the types and functions used for exception processing. */
jmpbuf_type
= build_array_type (gnat_type_for_mode (Pmode, 0),
build_index_type (build_int_2 (5, 0)));
- pushdecl (build_decl (TYPE_DECL, get_identifier ("JMPBUF_T"), jmpbuf_type));
+ create_type_decl (get_identifier ("JMPBUF_T"), jmpbuf_type, NULL,
+ 0, 1, Empty);
jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
/* Functions to get and set the jumpbuf pointer for the current thread. */
= create_subprog_decl
(get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
set_jmpbuf_decl
= create_subprog_decl
NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Function to get the current exception. */
get_excptr_decl
(get_identifier ("system__soft_links__get_gnat_exception"),
NULL_TREE,
build_function_type (build_pointer_type (except_type_node), NULL_TREE),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Functions that raise exceptions. */
raise_nodefer_decl
tree_cons (NULL_TREE,
build_pointer_type (except_type_node),
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* Hooks to call when entering/leaving an exception handler. */
begin_handler_decl
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
end_handler_decl
= create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
/* If in no exception handlers mode, all raise statements are redirected to
__gnat_last_chance_handler. No need to redefine raise_nodefer_decl, since
tree_cons (NULL_TREE,
integer_type_node,
endlink))),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
gnat_raise_decls[i] = decl;
tree_cons (NULL_TREE,
integer_type_node,
endlink))),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
}
/* Indicate that these never return. */
(get_identifier ("__builtin_setjmp"), NULL_TREE,
build_function_type (integer_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
(get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, 0, 1, 1, 0, Empty);
DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
main_identifier_node = get_identifier ("main");
}
\f
-/* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL
- nodes (FIELDLIST), finish constructing the record or union type.
- If HAS_REP is nonzero, this record has a rep clause; don't call
- layout_type but merely set the size and alignment ourselves.
- If DEFER_DEBUG is nonzero, do not call the debugging routines
- on this type; it will be done later. */
+/* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL nodes
+ (FIELDLIST), finish constructing the record or union type. If HAS_REP is
+ nonzero, this record has a rep clause; don't call layout_type but merely set
+ the size and alignment ourselves. If DEFER_DEBUG is nonzero, do not call
+ the debugging routines on this type; it will be done later. */
void
-finish_record_type (tree record_type,
- tree fieldlist,
- int has_rep,
+finish_record_type (tree record_type, tree fieldlist, int has_rep,
int defer_debug)
{
enum tree_code code = TREE_CODE (record_type);
tree field;
TYPE_FIELDS (record_type) = fieldlist;
-
- if (TYPE_NAME (record_type) != 0
- && TREE_CODE (TYPE_NAME (record_type)) == TYPE_DECL)
- TYPE_STUB_DECL (record_type) = TYPE_NAME (record_type);
- else
- TYPE_STUB_DECL (record_type)
- = pushdecl (build_decl (TYPE_DECL, TYPE_NAME (record_type),
- record_type));
+ TYPE_STUB_DECL (record_type)
+ = build_decl (TYPE_DECL, NULL_TREE, record_type);
/* We don't need both the typedef name and the record name output in
the debugging information, since they are the same. */
tree new_record_type
= make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
? UNION_TYPE : TREE_CODE (record_type));
- tree orig_id = DECL_NAME (TYPE_STUB_DECL (record_type));
+ tree orig_name = TYPE_NAME (record_type);
+ tree orig_id
+ = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
+ : orig_name);
tree new_id
= concat_id_with_name (orig_id,
TREE_CODE (record_type) == QUAL_UNION_TYPE
TYPE_NAME (new_record_type) = new_id;
TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
TYPE_STUB_DECL (new_record_type)
- = pushdecl (build_decl (TYPE_DECL, new_id, new_record_type));
+ = build_decl (TYPE_DECL, NULL_TREE, new_record_type);
DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
We return an expression for the size. */
static tree
-merge_sizes (tree last_size,
- tree first_bit,
- tree size,
- int special,
- int has_rep)
+merge_sizes (tree last_size, tree first_bit, tree size, bool special,
+ bool has_rep)
{
tree type = TREE_TYPE (last_size);
tree new;
object. RETURNS_BY_REF is nonzero if the function returns by reference.
RETURNS_WITH_DSP is nonzero if the function is to return with a
depressed stack pointer. */
-
tree
-create_subprog_type (tree return_type,
- tree param_decl_list,
- tree cico_list,
- int returns_unconstrained,
- int returns_by_ref,
+create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
+ int returns_unconstrained, int returns_by_ref,
int returns_with_dsp)
{
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
type = copy_type (type);
SET_TYPE_INDEX_TYPE (type, index);
- add_decl_expr (create_type_decl (NULL_TREE, type, NULL, 1, 0), Empty);
+ create_type_decl (NULL_TREE, type, NULL, 1, 0, Empty);
return type;
}
\f
string) and TYPE is a ..._TYPE node giving its data type.
ARTIFICIAL_P is nonzero if this is a declaration that was generated
by the compiler. DEBUG_INFO_P is nonzero if we need to write debugging
- information about this type. */
+ information about this type. GNAT_NODE is used for the position of
+ the decl. */
tree
create_type_decl (tree type_name, tree type, struct attrib *attr_list,
- int artificial_p, int debug_info_p)
+ int artificial_p, int debug_info_p, Node_Id gnat_node)
{
tree type_decl = build_decl (TYPE_DECL, type_name, type);
enum tree_code code = TREE_CODE (type);
DECL_ARTIFICIAL (type_decl) = artificial_p;
- pushdecl (type_decl);
+
process_attributes (type_decl, attr_list);
/* Pass type declaration information to the debugger unless this is an
&& TYPE_IS_DUMMY_P (TREE_TYPE (type))))
rest_of_decl_compilation (type_decl, NULL, global_bindings_p (), 0);
+ if (!TYPE_IS_DUMMY_P (type))
+ gnat_pushdecl (type_decl, gnat_node);
+
return type_decl;
}
definition: no storage is to be allocated for the variable here).
STATIC_FLAG is only relevant when not at top level. In that case
- it indicates whether to always allocate storage to the variable. */
+ it indicates whether to always allocate storage to the variable.
+
+ GNAT_NODE is used for the position of the decl. */
tree
create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
int const_flag, int public_flag, int extern_flag,
- int static_flag, struct attrib *attr_list)
+ int static_flag, struct attrib *attr_list, Node_Id gnat_node)
{
int init_const
= (var_init == 0
save any variable elaborations for the elaboration routine. If we are
just annotating types, throw away the initialization if it isn't a
constant. */
-
if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL)
|| (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init)))
var_init = 0;
- if (global_bindings_p () && var_init != 0 && ! init_const)
- {
- add_pending_elaborations (var_decl, var_init);
- var_init = 0;
- }
-
DECL_INITIAL (var_decl) = var_init;
TREE_READONLY (var_decl) = const_flag;
DECL_EXTERNAL (var_decl) = extern_flag;
process_attributes (var_decl, attr_list);
- /* Add this decl to the current binding level and generate any
- needed code and RTL. */
- var_decl = pushdecl (var_decl);
+ /* Add this decl to the current binding level. */
+ gnat_pushdecl (var_decl, gnat_node);
if (TREE_SIDE_EFFECTS (var_decl))
TREE_ADDRESSABLE (var_decl) = 1;
the address of this field for aliasing purposes. */
tree
-create_field_decl (tree field_name,
- tree field_type,
- tree record_type,
- int packed,
- tree size,
- tree pos,
- int addressable)
+create_field_decl (tree field_name, tree field_type, tree record_type,
+ int packed, tree size, tree pos, int addressable)
{
tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
/* Subroutine of previous function: return nonzero if EXP, ignoring any side
effects, has the value of zero. */
-static int
+static bool
value_zerop (tree exp)
{
if (TREE_CODE (exp) == COMPOUND_EXPR)
}
}
\f
-/* Add some pending elaborations on the list. */
+/* Return true if VALUE is a known to be a multiple of FACTOR, which must be
+ a power of 2. */
-void
-add_pending_elaborations (tree var_decl, tree var_init)
-{
- if (var_init != 0)
- Check_Elaboration_Code_Allowed (error_gnat_node);
-
- pending_elaborations
- = chainon (pending_elaborations, build_tree_list (var_decl, var_init));
-}
-
-/* Obtain any pending elaborations and clear the old list. */
-
-tree
-get_pending_elaborations (void)
-{
- /* Each thing added to the list went on the end; we want it on the
- beginning. */
- tree result = TREE_CHAIN (pending_elaborations);
-
- TREE_CHAIN (pending_elaborations) = 0;
- return result;
-}
-
-/* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
- of 2. */
-
-static int
-value_factor_p (tree value, int factor)
+static bool
+value_factor_p (tree value, HOST_WIDE_INT factor)
{
if (host_integerp (value, 1))
return tree_low_cst (value, 1) % factor == 0;
is the distance in bits between the end of PREV_FIELD and the starting
position of CURR_FIELD. It is ignored if null. */
-static int
+static bool
potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
{
/* If this is the first field of the record, there cannot be any gap */
return 1;
}
-/* Return nonzero if there are pending elaborations. */
-
-int
-pending_elaborations_p (void)
-{
- return TREE_CHAIN (pending_elaborations) != 0;
-}
-
-/* Save a copy of the current pending elaboration list and make a new
- one. */
-
-void
-push_pending_elaborations (void)
-{
- struct e_stack *p = (struct e_stack *) ggc_alloc (sizeof (struct e_stack));
-
- p->next = elist_stack;
- p->elab_list = pending_elaborations;
- elist_stack = p;
- pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
-}
-
-/* Pop the stack of pending elaborations. */
-
-void
-pop_pending_elaborations (void)
-{
- struct e_stack *p = elist_stack;
-
- pending_elaborations = p->elab_list;
- elist_stack = p->next;
-}
-
-/* Return the current position in pending_elaborations so we can insert
- elaborations after that point. */
-
-tree
-get_elaboration_location (void)
-{
- return tree_last (pending_elaborations);
-}
-
-/* Insert the current elaborations after ELAB, which is in some elaboration
- list. */
-
-void
-insert_elaboration_list (tree elab)
-{
- tree next = TREE_CHAIN (elab);
-
- if (TREE_CHAIN (pending_elaborations))
- {
- TREE_CHAIN (elab) = TREE_CHAIN (pending_elaborations);
- TREE_CHAIN (tree_last (pending_elaborations)) = next;
- TREE_CHAIN (pending_elaborations) = 0;
- }
-}
-
/* Returns a LABEL_DECL node for LABEL_NAME. */
tree
PARM_DECL nodes chained through the TREE_CHAIN field).
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
- appropriate fields in the FUNCTION_DECL. */
+ appropriate fields in the FUNCTION_DECL. GNAT_NODE gives the location. */
tree
-create_subprog_decl (tree subprog_name,
- tree asm_name,
- tree subprog_type,
- tree param_decl_list,
- int inline_flag,
- int public_flag,
- int extern_flag,
- struct attrib *attr_list)
+create_subprog_decl (tree subprog_name, tree asm_name,
+ tree subprog_type, tree param_decl_list, int inline_flag,
+ int public_flag, int extern_flag,
+ struct attrib *attr_list, Node_Id gnat_node)
{
tree return_type = TREE_TYPE (subprog_type);
tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type);
process_attributes (subprog_decl, attr_list);
/* Add this decl to the current binding level. */
- subprog_decl = pushdecl (subprog_decl);
+ gnat_pushdecl (subprog_decl, gnat_node);
/* Output the assembler code and/or RTL for the declaration. */
rest_of_decl_compilation (subprog_decl, 0, global_bindings_p (), 0);
return subprog_decl;
}
\f
-/* Count how deep we are into nested functions. This is because
- we shouldn't call the backend function context routines unless we
- are in a nested function. */
-
-static int function_nesting_depth;
-
/* Set up the framework for generating code for SUBPROG_DECL, a subprogram
body. This routine needs to be invoked before processing the declarations
appearing in the subprogram. */
{
tree param_decl;
- if (function_nesting_depth++ != 0)
- push_function_context ();
-
+ current_function_decl = subprog_decl;
announce_function (subprog_decl);
- /* Make this field nonzero so further routines know that this is not
- tentative. error_mark_node is replaced below with the adequate BLOCK. */
- DECL_INITIAL (subprog_decl) = error_mark_node;
-
- /* This function exists in static storage. This does not mean `static' in
- the C sense! */
- TREE_STATIC (subprog_decl) = 1;
-
/* Enter a new binding level and show that all the parameters belong to
this function. */
- current_function_decl = subprog_decl;
gnat_pushlevel ();
-
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = TREE_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl;
- init_function_start (subprog_decl);
- expand_function_start (subprog_decl, 0);
+ make_decl_rtl (subprog_decl, NULL);
+
+ /* We handle pending sizes via the elaboration of types, so we don't need to
+ save them. This causes them to be marked as part of the outer function
+ and then discarded. */
+ get_pending_sizes ();
}
/* Finish the definition of the current subprogram and compile it all the way
ATTRS is nonzero, use that for the function attribute list. */
tree
-builtin_function (const char *name,
- tree type,
- int function_code,
- enum built_in_class class,
- const char *library_name,
+builtin_function (const char *name, tree type, int function_code,
+ enum built_in_class class, const char *library_name,
tree attrs)
{
tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
- pushdecl (decl);
+ gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
if (attrs)
/* Build a VMS descriptor from a Mechanism_Type, which must specify
a descriptor type, and the GCC type of an object. Each FIELD_DECL
in the type contains in its DECL_INITIAL the expression to use when
- a constructor is made for the type. GNAT_ENTITY is a gnat node used
+ a constructor is made for the type. GNAT_ENTITY is an entity used
to print out an error message if the mechanism cannot be applied to
an object of that type and also for the name. */
}
finish_record_type (record_type, field_list, 0, 1);
- pushdecl (build_decl (TYPE_DECL, create_concat_name (gnat_entity, "DESC"),
- record_type));
+ create_type_decl (create_concat_name (gnat_entity, "DESC"), record_type,
+ NULL, 1, 0, gnat_entity);
return record_type;
}
tree gnu_range
= build_range_type (NULL_TREE, size_one_node, gnu_size);
tree gnu_array_type = build_array_type (char_type_node, gnu_range);
- tree gnu_decl =
- create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
- gnu_array_type, NULL_TREE, 0, 0, 0, 0, 0);
+ tree gnu_decl
+ = create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
+ gnu_array_type, NULL_TREE, 0, 0, 0, 0, 0,
+ gnat_node);
return convert (ptr_void_type_node,
build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl));
the storage pool to use. */
tree
-build_allocator (tree type,
- tree init,
- tree result_type,
- Entity_Id gnat_proc,
- Entity_Id gnat_pool,
- Node_Id gnat_node)
+build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
+ Entity_Id gnat_pool, Node_Id gnat_node)
{
tree size = TYPE_SIZE_UNIT (type);
tree result;
projects / gcc.git / commitdiff