if (!Stack_Check_Probes_On_Target)
set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
+ /* Retrieve alignment settings. */
+ double_float_alignment = get_target_double_float_alignment ();
+ double_scalar_alignment = get_target_double_scalar_alignment ();
+
/* Record the builtin types. Define `integer' and `unsigned char' first so
that dbx will output them first. */
record_builtin_type ("integer", integer_type_node);
static tree
Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
{
- tree gnu_result = error_mark_node;
- tree gnu_result_type;
- tree gnu_expr;
- bool prefix_unused = false;
tree gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
tree gnu_type = TREE_TYPE (gnu_prefix);
+ tree gnu_expr, gnu_result_type, gnu_result = error_mark_node;
+ bool prefix_unused = false;
/* If the input is a NULL_EXPR, make a new one. */
if (TREE_CODE (gnu_prefix) == NULL_EXPR)
break;
case Attr_Alignment:
- if (TREE_CODE (gnu_prefix) == COMPONENT_REF
- && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
- == RECORD_TYPE)
- && (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
- gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
+ {
+ unsigned int align;
- gnu_type = TREE_TYPE (gnu_prefix);
- gnu_result_type = get_unpadded_type (Etype (gnat_node));
- prefix_unused = true;
+ if (TREE_CODE (gnu_prefix) == COMPONENT_REF
+ && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
+ == RECORD_TYPE)
+ && (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
+ gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
- gnu_result = size_int ((TREE_CODE (gnu_prefix) == COMPONENT_REF
- ? DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1))
- : TYPE_ALIGN (gnu_type)) / BITS_PER_UNIT);
+ gnu_type = TREE_TYPE (gnu_prefix);
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ prefix_unused = true;
+
+ if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
+ align = DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1)) / BITS_PER_UNIT;
+ else
+ {
+ Node_Id gnat_prefix = Prefix (gnat_node);
+ Entity_Id gnat_type = Etype (gnat_prefix);
+ unsigned int double_align;
+ bool is_capped_double, align_clause;
+
+ /* If the default alignment of "double" or larger scalar types is
+ specifically capped and there is an alignment clause neither
+ on the type nor on the prefix itself, return the cap. */
+ if ((double_align = double_float_alignment) > 0)
+ is_capped_double
+ = is_double_float_or_array (gnat_type, &align_clause);
+ else if ((double_align = double_scalar_alignment) > 0)
+ is_capped_double
+ = is_double_scalar_or_array (gnat_type, &align_clause);
+ else
+ is_capped_double = align_clause = false;
+
+ if (is_capped_double
+ && Nkind (gnat_prefix) == N_Identifier
+ && Present (Alignment_Clause (Entity (gnat_prefix))))
+ align_clause = true;
+
+ if (is_capped_double && !align_clause)
+ align = double_align;
+ else
+ align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
+ }
+
+ gnu_result = size_int (align);
+ }
break;
case Attr_First:
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);
+
if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL)
{
mark_visited (&DECL_SIZE_UNIT (gnu_decl));
mark_visited (&DECL_INITIAL (gnu_decl));
}
- /* In any case, we have to deal with our own TYPE_ADA_SIZE field. */
- if (TREE_CODE (gnu_decl) == TYPE_DECL
- && (TREE_CODE (type) == RECORD_TYPE
- || TREE_CODE (type) == UNION_TYPE
- || TREE_CODE (type) == QUAL_UNION_TYPE)
- && (t = TYPE_ADA_SIZE (type)))
- mark_visited (&t);
+
+ /* In any case, we have to deal with our own fields. */
+ else if (TREE_CODE (gnu_decl) == TYPE_DECL)
+ switch (TREE_CODE (type))
+ {
+ case RECORD_TYPE:
+ case UNION_TYPE:
+ case QUAL_UNION_TYPE:
+ if ((t = TYPE_ADA_SIZE (type)))
+ mark_visited (&t);
+ break;
+
+ case INTEGER_TYPE:
+ case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
+ case REAL_TYPE:
+ if ((t = TYPE_RM_MIN_VALUE (type)))
+ mark_visited (&t);
+ if ((t = TYPE_RM_MAX_VALUE (type)))
+ mark_visited (&t);
+ break;
+
+ default:
+ break;
+ }
}
else
add_stmt_with_node (gnu_stmt, gnat_entity);
if (!TREE_SIDE_EFFECTS (exp))
return exp;
- /* If it is a conversion, protect what's inside the conversion.
+ /* If this is a conversion, protect what's inside the conversion.
Similarly, if we're indirectly referencing something, we only
- actually need to protect the address since the data itself can't
- change in these situations. */
- else if (TREE_CODE (exp) == NON_LVALUE_EXPR
- || CONVERT_EXPR_P (exp)
- || TREE_CODE (exp) == VIEW_CONVERT_EXPR
- || TREE_CODE (exp) == INDIRECT_REF
- || TREE_CODE (exp) == UNCONSTRAINED_ARRAY_REF)
- return build1 (TREE_CODE (exp), type,
- protect_multiple_eval (TREE_OPERAND (exp, 0)));
-
- /* If EXP is a fat pointer or something that can be placed into a register,
- just make a SAVE_EXPR. */
+ need to protect the address since the data itself can't change
+ in these situations. */
+ if (TREE_CODE (exp) == NON_LVALUE_EXPR
+ || CONVERT_EXPR_P (exp)
+ || TREE_CODE (exp) == VIEW_CONVERT_EXPR
+ || TREE_CODE (exp) == INDIRECT_REF
+ || TREE_CODE (exp) == UNCONSTRAINED_ARRAY_REF)
+ return build1 (TREE_CODE (exp), type,
+ protect_multiple_eval (TREE_OPERAND (exp, 0)));
+
+ /* If this is a fat pointer or something that can be placed into a
+ register, just make a SAVE_EXPR. */
if (TYPE_FAT_POINTER_P (type) || TYPE_MODE (type) != BLKmode)
return save_expr (exp);
- /* Otherwise, dereference, protect the address, and re-reference. */
- else
- return
- build_unary_op (INDIRECT_REF, type,
- save_expr (build_unary_op (ADDR_EXPR,
- build_reference_type (type),
- exp)));
+ /* Otherwise, reference, protect the address and dereference. */
+ return
+ build_unary_op (INDIRECT_REF, type,
+ save_expr (build_unary_op (ADDR_EXPR,
+ build_reference_type (type),
+ exp)));
}
\f
/* This is equivalent to stabilize_reference in tree.c, but we know how to
OSDN Git Service
