if (stable)
{
- gnu_decl = maybe_stable_expr;
/* ??? No DECL_EXPR is created so we need to mark
the expression manually lest it is shared. */
if (global_bindings_p ())
- mark_visited (&gnu_decl);
+ MARK_VISITED (maybe_stable_expr);
+ gnu_decl = maybe_stable_expr;
save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true;
annotate_object (gnat_entity, gnu_type, NULL_TREE,
/* ??? create_type_decl is not invoked on the inner types so
the MULT_EXPR node built above will never be marked. */
- mark_visited (&TYPE_SIZE_UNIT (gnu_arr_type));
+ MARK_VISITED (TYPE_SIZE_UNIT (gnu_arr_type));
}
}
the MULT_EXPR node built above may not be marked by the call
to create_type_decl below. */
if (global_bindings_p ())
- mark_visited (&DECL_FIELD_OFFSET (gnu_field));
+ MARK_VISITED (DECL_FIELD_OFFSET (gnu_field));
}
}
UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
}
-/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding
- GCC type, set Component_Bit_Offset and Esize to the position and size
- used by Gigi. */
+/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type,
+ set Component_Bit_Offset and Esize of the components to the position and
+ size used by Gigi. */
static void
annotate_rep (Entity_Id gnat_entity, tree gnu_type)
{
- tree gnu_list;
- tree gnu_entry;
Entity_Id gnat_field;
+ tree gnu_list;
- /* We operate by first making a list of all fields and their positions
- (we can get the sizes easily at any time) by a recursive call
- and then update all the sizes into the tree. */
- gnu_list = compute_field_positions (gnu_type, NULL_TREE,
- size_zero_node, bitsize_zero_node,
- BIGGEST_ALIGNMENT);
+ /* We operate by first making a list of all fields and their position (we
+ can get the size easily) and then update all the sizes in the tree. */
+ gnu_list = compute_field_positions (gnu_type, NULL_TREE, size_zero_node,
+ bitsize_zero_node, BIGGEST_ALIGNMENT);
- for (gnat_field = First_Entity (gnat_entity); Present (gnat_field);
+ for (gnat_field = First_Entity (gnat_entity);
+ Present (gnat_field);
gnat_field = Next_Entity (gnat_field))
- if ((Ekind (gnat_field) == E_Component
- || (Ekind (gnat_field) == E_Discriminant
- && !Is_Unchecked_Union (Scope (gnat_field)))))
+ if (Ekind (gnat_field) == E_Component
+ || (Ekind (gnat_field) == E_Discriminant
+ && !Is_Unchecked_Union (Scope (gnat_field))))
{
- tree parent_offset = bitsize_zero_node;
+ tree parent_offset, t;
- gnu_entry = purpose_member (gnat_to_gnu_field_decl (gnat_field),
- gnu_list);
-
- if (gnu_entry)
+ t = purpose_member (gnat_to_gnu_field_decl (gnat_field), gnu_list);
+ if (t)
{
if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
- /* In this mode the tag and parent components have not been
+ /* In this mode the tag and parent components are not
generated, so we add the appropriate offset to each
component. For a component appearing in the current
extension, the offset is the size of the parent. */
- if (Is_Derived_Type (gnat_entity)
- && Original_Record_Component (gnat_field) == gnat_field)
- parent_offset
- = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
- bitsizetype);
- else
- parent_offset = bitsize_int (POINTER_SIZE);
+ if (Is_Derived_Type (gnat_entity)
+ && Original_Record_Component (gnat_field) == gnat_field)
+ parent_offset
+ = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
+ bitsizetype);
+ else
+ parent_offset = bitsize_int (POINTER_SIZE);
}
+ else
+ parent_offset = bitsize_zero_node;
- Set_Component_Bit_Offset
- (gnat_field,
- annotate_value
- (size_binop (PLUS_EXPR,
- bit_from_pos (TREE_PURPOSE (TREE_VALUE (gnu_entry)),
- TREE_VALUE (TREE_VALUE
- (TREE_VALUE (gnu_entry)))),
- parent_offset)));
+ Set_Component_Bit_Offset
+ (gnat_field,
+ annotate_value
+ (size_binop (PLUS_EXPR,
+ bit_from_pos (TREE_PURPOSE (TREE_VALUE (t)),
+ TREE_VALUE (TREE_VALUE
+ (TREE_VALUE (t)))),
+ parent_offset)));
Set_Esize (gnat_field,
- annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry))));
+ annotate_value (DECL_SIZE (TREE_PURPOSE (t))));
}
- else if (Is_Tagged_Type (gnat_entity)
- && Is_Derived_Type (gnat_entity))
+ else if (Is_Tagged_Type (gnat_entity) && Is_Derived_Type (gnat_entity))
{
- /* If there is no gnu_entry, this is an inherited component whose
+ /* If there is no entry, this is an inherited component whose
position is the same as in the parent type. */
Set_Component_Bit_Offset
(gnat_field,
Component_Bit_Offset (Original_Record_Component (gnat_field)));
+
Set_Esize (gnat_field,
Esize (Original_Record_Component (gnat_field)));
}
}
}
-
+\f
/* Scan all fields in GNU_TYPE and build entries where TREE_PURPOSE is the
FIELD_DECL and TREE_VALUE a TREE_LIST with TREE_PURPOSE being the byte
position and TREE_VALUE being a TREE_LIST with TREE_PURPOSE the value to be
tree gnu_bitpos, unsigned int offset_align)
{
tree gnu_field;
- tree gnu_result = gnu_list;
- for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field;
+ for (gnu_field = TYPE_FIELDS (gnu_type);
+ gnu_field;
gnu_field = TREE_CHAIN (gnu_field))
{
tree gnu_our_bitpos = size_binop (PLUS_EXPR, gnu_bitpos,
unsigned int our_offset_align
= MIN (offset_align, DECL_OFFSET_ALIGN (gnu_field));
- gnu_result
+ gnu_list
= tree_cons (gnu_field,
tree_cons (gnu_our_offset,
tree_cons (size_int (our_offset_align),
gnu_our_bitpos, NULL_TREE),
NULL_TREE),
- gnu_result);
+ gnu_list);
if (DECL_INTERNAL_P (gnu_field))
- gnu_result
- = compute_field_positions (TREE_TYPE (gnu_field), gnu_result,
+ gnu_list
+ = compute_field_positions (TREE_TYPE (gnu_field), gnu_list,
gnu_our_offset, gnu_our_bitpos,
our_offset_align);
}
- return gnu_result;
+ return gnu_list;
}
\f
/* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
return false;
}
-/* 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.
- If this is an expression, return the GCC equivalent of the expression. If
- it is a statement, return the statement. In the case when called for a
- statement, it may also add statements to the current statement group, in
- which case anything it returns is to be interpreted as occurring after
- anything `it already added. */
+/* 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. If this
+ is an expression, return the GCC equivalent of the expression. If this
+ is a statement, return the statement or add it to the current statement
+ group, in which case anything returned is to be interpreted as occurring
+ after anything added. */
tree
gnat_to_gnu (Node_Id gnat_node)
{
+ const Node_Kind kind = Nkind (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;
- tree gnu_lhs, gnu_rhs;
+ tree gnu_expr, gnu_lhs, gnu_rhs;
Node_Id gnat_temp;
/* Save node number for error message and set location information. */
error_gnat_node = gnat_node;
Sloc_to_locus (Sloc (gnat_node), &input_location);
- if (type_annotate_only
- && IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call))
+ /* If this node is a statement and we are only annotating types, return an
+ empty statement list. */
+ if (type_annotate_only && IN (kind, N_Statement_Other_Than_Procedure_Call))
return alloc_stmt_list ();
- /* If this node is a non-static subexpression and we are only
- annotating types, make this into a NULL_EXPR. */
+ /* If this node is a non-static subexpression and we are only annotating
+ types, make this into a NULL_EXPR. */
if (type_annotate_only
- && IN (Nkind (gnat_node), N_Subexpr)
- && Nkind (gnat_node) != N_Identifier
+ && IN (kind, N_Subexpr)
+ && kind != N_Identifier
&& !Compile_Time_Known_Value (gnat_node))
return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
build_call_raise (CE_Range_Check_Failed, gnat_node,
N_Raise_Constraint_Error));
- /* 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 we are in the elaboration procedure, check if we are violating a
- No_Elaboration_Code restriction by having a statement there. */
- if ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
- && Nkind (gnat_node) != N_Null_Statement
- && Nkind (gnat_node) != N_SCIL_Dispatch_Table_Object_Init
- && Nkind (gnat_node) != N_SCIL_Dispatch_Table_Tag_Init
- && Nkind (gnat_node) != N_SCIL_Dispatching_Call
- && Nkind (gnat_node) != N_SCIL_Tag_Init)
- || Nkind (gnat_node) == N_Procedure_Call_Statement
- || Nkind (gnat_node) == N_Label
- || Nkind (gnat_node) == N_Implicit_Label_Declaration
- || 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)))
+ if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
+ && !IN (kind, N_SCIL_Node)
+ && kind != N_Null_Statement)
+ || kind == N_Procedure_Call_Statement
+ || kind == N_Label
+ || kind == N_Implicit_Label_Declaration
+ || kind == N_Handled_Sequence_Of_Statements
+ || (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void))
{
+ /* 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)
{
current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
went_into_elab_proc = true;
}
- /* Don't check for a possible No_Elaboration_Code restriction violation
- on N_Handled_Sequence_Of_Statements, as we want to signal an error on
+ /* If we are in the elaboration procedure, check if we are violating a
+ No_Elaboration_Code restriction by having a statement there. Don't
+ check for a possible No_Elaboration_Code restriction violation on
+ N_Handled_Sequence_Of_Statements, as we want to signal an error on
every nested real statement instead. This also avoids triggering
spurious errors on dummy (empty) sequences created by the front-end
for package bodies in some cases. */
-
if (current_function_decl == TREE_VALUE (gnu_elab_proc_stack)
- && Nkind (gnat_node) != N_Handled_Sequence_Of_Statements)
+ && kind != N_Handled_Sequence_Of_Statements)
Check_Elaboration_Code_Allowed (gnat_node);
}
- switch (Nkind (gnat_node))
+ switch (kind)
{
/********************************/
/* Chapter 2: Lexical Elements */
break;
if (Present (Expression (gnat_node))
- && !(Nkind (gnat_node) == N_Object_Declaration
- && No_Initialization (gnat_node))
+ && !(kind == N_Object_Declaration && No_Initialization (gnat_node))
&& (!type_annotate_only
|| Compile_Time_Known_Value (Expression (gnat_node))))
{
= convert_with_check (Etype (gnat_node), gnu_result,
Do_Overflow_Check (gnat_node),
Do_Range_Check (Expression (gnat_node)),
- Nkind (gnat_node) == N_Type_Conversion
+ kind == N_Type_Conversion
&& Float_Truncate (gnat_node), gnat_node);
break;
gnu_object, gnu_high));
}
- if (Nkind (gnat_node) == N_Not_In)
+ if (kind == N_Not_In)
gnu_result = invert_truthvalue (gnu_result);
}
break;
Modular_Integer_Kind))
{
enum tree_code code
- = (Nkind (gnat_node) == N_Op_Or ? BIT_IOR_EXPR
- : Nkind (gnat_node) == N_Op_And ? BIT_AND_EXPR
+ = (kind == N_Op_Or ? BIT_IOR_EXPR
+ : kind == N_Op_And ? BIT_AND_EXPR
: BIT_XOR_EXPR);
gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
case N_Op_Shift_Right_Arithmetic:
case N_And_Then: case N_Or_Else:
{
- enum tree_code code = gnu_codes[Nkind (gnat_node)];
+ enum tree_code code = gnu_codes[kind];
bool ignore_lhs_overflow = false;
tree gnu_type;
/* If this is a shift whose count is not guaranteed to be correct,
we need to adjust the shift count. */
- if (IN (Nkind (gnat_node), N_Op_Shift)
- && !Shift_Count_OK (gnat_node))
+ if (IN (kind, N_Op_Shift) && !Shift_Count_OK (gnat_node))
{
tree gnu_count_type = get_base_type (TREE_TYPE (gnu_rhs));
tree gnu_max_shift
= convert (gnu_count_type, TYPE_SIZE (gnu_type));
- if (Nkind (gnat_node) == N_Op_Rotate_Left
- || Nkind (gnat_node) == N_Op_Rotate_Right)
+ if (kind == N_Op_Rotate_Left || kind == N_Op_Rotate_Right)
gnu_rhs = build_binary_op (TRUNC_MOD_EXPR, gnu_count_type,
gnu_rhs, gnu_max_shift);
- else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic)
+ else if (kind == N_Op_Shift_Right_Arithmetic)
gnu_rhs
= build_binary_op
(MIN_EXPR, gnu_count_type,
so we may need to choose a different type. In this case,
we have to ignore integer overflow lest it propagates all
the way down and causes a CE to be explicitly raised. */
- if (Nkind (gnat_node) == N_Op_Shift_Right
- && !TYPE_UNSIGNED (gnu_type))
+ if (kind == N_Op_Shift_Right && !TYPE_UNSIGNED (gnu_type))
{
gnu_type = gnat_unsigned_type (gnu_type);
ignore_lhs_overflow = true;
}
- else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic
+ else if (kind == N_Op_Shift_Right_Arithmetic
&& TYPE_UNSIGNED (gnu_type))
{
gnu_type = gnat_signed_type (gnu_type);
do overflow checking, do it here. The goal is to push
the expansions further into the back end over time. */
if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target
- && (Nkind (gnat_node) == N_Op_Add
- || Nkind (gnat_node) == N_Op_Subtract
- || Nkind (gnat_node) == N_Op_Multiply)
+ && (kind == N_Op_Add
+ || kind == N_Op_Subtract
+ || kind == N_Op_Multiply)
&& !TYPE_UNSIGNED (gnu_type)
&& !FLOAT_TYPE_P (gnu_type))
gnu_result = build_binary_op_trapv (code, gnu_type,
/* If this is a logical shift with the shift count not verified,
we must return zero if it is too large. We cannot compensate
above in this case. */
- if ((Nkind (gnat_node) == N_Op_Shift_Left
- || Nkind (gnat_node) == N_Op_Shift_Right)
+ if ((kind == N_Op_Shift_Left || kind == N_Op_Shift_Right)
&& !Shift_Count_OK (gnat_node))
gnu_result
= build_cond_expr
= gnat_to_gnu (Next (Next (First (Expressions (gnat_node)))));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
- gnu_result = build_cond_expr (gnu_result_type,
- gnat_truthvalue_conversion (gnu_cond),
- gnu_true, gnu_false);
+ gnu_result
+ = build_cond_expr (gnu_result_type, gnu_cond, gnu_true, gnu_false);
}
break;
&& !TYPE_UNSIGNED (gnu_result_type)
&& !FLOAT_TYPE_P (gnu_result_type))
gnu_result
- = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)],
+ = build_unary_op_trapv (gnu_codes[kind],
gnu_result_type, gnu_expr, gnat_node);
else
- gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
+ gnu_result = build_unary_op (gnu_codes[kind],
gnu_result_type, gnu_expr);
break;
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result
- = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node,
- Nkind (gnat_node));
+ = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node, kind);
/* If the type is VOID, this is a statement, so we need to
generate the code for the call. Handle a Condition, if there
/* Mark everything as used to prevent node sharing with subprograms.
Note that walk_tree knows how to deal with TYPE_DECL, but neither
VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */
- mark_visited (&gnu_stmt);
+ MARK_VISITED (gnu_stmt);
if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL)
{
- mark_visited (&DECL_SIZE (gnu_decl));
- mark_visited (&DECL_SIZE_UNIT (gnu_decl));
- mark_visited (&DECL_INITIAL (gnu_decl));
+ MARK_VISITED (DECL_SIZE (gnu_decl));
+ MARK_VISITED (DECL_SIZE_UNIT (gnu_decl));
+ MARK_VISITED (DECL_INITIAL (gnu_decl));
}
}
else
static tree
mark_visited_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
- if (TREE_VISITED (*tp))
+ tree t = *tp;
+
+ if (TREE_VISITED (t))
*walk_subtrees = 0;
/* Don't mark a dummy type as visited because we want to mark its sizes
and fields once it's filled in. */
- else if (!TYPE_IS_DUMMY_P (*tp))
- TREE_VISITED (*tp) = 1;
+ else if (!TYPE_IS_DUMMY_P (t))
+ TREE_VISITED (t) = 1;
- if (TYPE_P (*tp))
- TYPE_SIZES_GIMPLIFIED (*tp) = 1;
+ if (TYPE_P (t))
+ TYPE_SIZES_GIMPLIFIED (t) = 1;
return NULL_TREE;
}
+/* Mark nodes rooted at T with TREE_VISITED and types as having their
+ sized gimplified. We use this to indicate all variable sizes and
+ positions in global types may not be shared by any subprogram. */
+
+void
+mark_visited (tree t)
+{
+ walk_tree (&t, mark_visited_r, NULL, NULL);
+}
+
/* Utility function to unshare expressions wrapped up in a SAVE_EXPR. */
static tree
return NULL_TREE;
}
-/* Mark nodes rooted at *TP with TREE_VISITED and types as having their
- sized gimplified. We use this to indicate all variable sizes and
- positions in global types may not be shared by any subprogram. */
-
-void
-mark_visited (tree *tp)
-{
- walk_tree (tp, mark_visited_r, NULL, NULL);
-}
-
/* Add GNU_CLEANUP, a cleanup action, to the current code group and
set its location to that of GNAT_NODE if present. */
OSDN Git Service
