#include "convert.h"
#include "ggc.h"
#include "obstack.h"
+#include "target.h"
#include "ada.h"
#include "types.h"
#include "ada-tree.h"
#include "gigi.h"
-/* Setting this to 1 suppresses hashing of types. */
-extern int debug_no_type_hash;
-
/* Provide default values for the macros controlling stack checking.
This is copied from GCC's expr.h. */
{
tree gnu_decl;
+ /* The back end never attempts to annotate generic types */
+ if (Is_Generic_Type (gnat_entity) && type_annotate_only)
+ return void_type_node;
+
/* Convert the ada entity type into a GCC TYPE_DECL node. */
gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
if (TREE_CODE (gnu_decl) != TYPE_DECL)
goto object;
case E_Exception:
- /* If this is not a VMS exception, treat it as a normal object.
- Otherwise, make an object at the specific address of character
- type, point to it, and convert it to integer, and mask off
- the lower 3 bits. */
- if (! Is_VMS_Exception (gnat_entity))
- goto object;
-
- /* Allocate the global object that we use to get the value of the
- exception. */
- gnu_decl = create_var_decl (gnu_entity_id,
- (Present (Interface_Name (gnat_entity))
- ? create_concat_name (gnat_entity, 0)
- : NULL_TREE),
- char_type_node, NULL_TREE, 0, 0, 1, 1,
- 0);
-
- /* Now return the expression giving the desired value. */
- gnu_decl
- = build_binary_op (BIT_AND_EXPR, integer_type_node,
- convert (integer_type_node,
- build_unary_op (ADDR_EXPR, NULL_TREE,
- gnu_decl)),
- build_unary_op (NEGATE_EXPR, integer_type_node,
- build_int_2 (7, 0)));
-
- save_gnu_tree (gnat_entity, gnu_decl, 1);
- saved = 1;
- break;
+ /* We used to special case VMS exceptions here to directly map them to
+ their associated condition code. Since this code had to be masked
+ dynamically to strip off the severity bits, this caused trouble in
+ the GCC/ZCX case because the "type" pointers we store in the tables
+ have to be static. We now don't special case here anymore, and let
+ the regular processing take place, which leaves us with a regular
+ exception data object for VMS exceptions too. The condition code
+ mapping is taken care of by the front end and the bitmasking by the
+ runtime library. */
+ goto object;
case E_Discriminant:
case E_Component:
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
{
if (gnu_expr != 0 && kind == E_Constant)
- {
- gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr));
- if (CONTAINS_PLACEHOLDER_P (gnu_size))
- gnu_size = build (WITH_RECORD_EXPR, bitsizetype,
- gnu_size, gnu_expr);
- }
+ gnu_size
+ = SUBSTITUTE_PLACEHOLDER_IN_EXPR
+ (TYPE_SIZE (TREE_TYPE (gnu_expr)), gnu_expr);
/* We may have no GNU_EXPR because No_Initialization is
set even though there's an Expression. */
(TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
gnu_expr = convert (gnu_type, gnu_expr);
- /* This name is external or there was a name specified, use it.
- Don't use the Interface_Name if there is an address clause.
- (see CD30005). */
- if ((Present (Interface_Name (gnat_entity))
- && No (Address_Clause (gnat_entity)))
- || (Is_Public (gnat_entity)
- && (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity))))
+ /* If this name is external or there was a name specified, use it,
+ unless this is a VMS exception object since this would conflict
+ with the symbol we need to export in addition. Don't use the
+ Interface_Name if there is an address clause (see CD30005). */
+ if (! Is_VMS_Exception (gnat_entity)
+ &&
+ ((Present (Interface_Name (gnat_entity))
+ && No (Address_Clause (gnat_entity)))
+ ||
+ (Is_Public (gnat_entity)
+ && (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity)))))
gnu_ext_name = create_concat_name (gnat_entity, 0);
if (const_flag)
gnu_value, gnu_literal_list);
}
- TYPE_FIELDS (gnu_type) = nreverse (gnu_literal_list);
+ TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
/* Note that the bounds are updated at the end of this function
because to avoid an infinite recursion when we get the bounds of
= TYPE_MODULAR_P (gnu_type)
? gnu_high : TYPE_MAX_VALUE (gnu_type);
TYPE_PRECISION (gnu_subtype) = esize;
- TREE_UNSIGNED (gnu_subtype) = 1;
+ TYPE_UNSIGNED (gnu_subtype) = 1;
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
TYPE_PACKED_ARRAY_TYPE_P (gnu_subtype)
= Is_Packed_Array_Type (gnat_entity);
/* This should be an unsigned type if the lower bound is constant
and non-negative or if the base type is unsigned; a signed type
otherwise. */
- TREE_UNSIGNED (gnu_type)
- = (TREE_UNSIGNED (TREE_TYPE (gnu_type))
+ TYPE_UNSIGNED (gnu_type)
+ = (TYPE_UNSIGNED (TREE_TYPE (gnu_type))
|| (TREE_CODE (TYPE_MIN_VALUE (gnu_type)) == INTEGER_CST
&& TREE_INT_CST_HIGH (TYPE_MIN_VALUE (gnu_type)) >= 0)
|| TYPE_BIASED_REPRESENTATION_P (gnu_type)
= create_concat_name (gnat_entity, "XUB");
TYPE_NAME (gnu_fat_type) = create_concat_name (gnat_entity, "XUP");
TYPE_IS_FAT_POINTER_P (gnu_fat_type) = 1;
- TREE_READONLY (gnu_template_type) = 1;
+ TYPE_READONLY (gnu_template_type) = 1;
/* Make a node for the array. If we are not defining the array
suppress expanding incomplete types and save the node as the type
/* Install all the fields into the template. */
finish_record_type (gnu_template_type, gnu_template_fields, 0, 0);
- TREE_READONLY (gnu_template_type) = 1;
+ TYPE_READONLY (gnu_template_type) = 1;
/* Now make the array of arrays and update the pointer to the array
in the fat pointer. Note that it is the first field. */
else if (TREE_CODE (gnu_high) == INTEGER_CST
&& TREE_OVERFLOW (gnu_high))
gnu_high = gnu_max;
- else if (TREE_UNSIGNED (gnu_base_subtype)
+ else if (TYPE_UNSIGNED (gnu_base_subtype)
|| TREE_CODE (gnu_high) == INTEGER_CST)
gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
else
convert (bitsizetype, gnu_max_size),
TYPE_SIZE (gnu_type));
- /* We don't want any array types shared for two reasons: first,
- we want to keep differently-named types distinct; second,
- setting TYPE_MULTI_ARRAY_TYPE of one type can clobber
- another. */
- debug_no_type_hash = 1;
for (index = array_dim - 1; index >= 0; index --)
{
gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
finish_record_type (gnu_bound_rec_type, gnu_field_list, 0, 0);
}
- debug_no_type_hash = 0;
TYPE_CONVENTION_FORTRAN_P (gnu_type)
= (Convention (gnat_entity) == Convention_Fortran);
TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
= TYPE_MAX_VALUE (gnu_inner_type);
TYPE_PRECISION (gnu_subtype)
= TYPE_PRECISION (gnu_inner_type);
- TREE_UNSIGNED (gnu_subtype)
- = TREE_UNSIGNED (gnu_inner_type);
+ TYPE_UNSIGNED (gnu_subtype)
+ = TYPE_UNSIGNED (gnu_inner_type);
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
layout_type (gnu_subtype);
int got_fat_p = 0;
int made_dummy = 0;
tree gnu_desig_type = 0;
+ enum machine_mode p_mode = mode_for_size (esize, MODE_INT, 0);
+
+ if (!targetm.valid_pointer_mode (p_mode))
+ p_mode = ptr_mode;
if (No (gnat_desig_full)
&& (Ekind (gnat_desig_type) == E_Class_Wide_Type
}
else if (gnat_desig_type == gnat_entity)
{
- gnu_type = build_pointer_type (make_node (VOID_TYPE));
+ gnu_type
+ = build_pointer_type_for_mode (make_node (VOID_TYPE),
+ p_mode,
+ No_Strict_Aliasing (gnat_entity));
TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
}
else
}
}
- gnu_type = build_pointer_type (gnu_desig_type);
+ gnu_type
+ = build_pointer_type_for_mode (gnu_desig_type, p_mode,
+ No_Strict_Aliasing (gnat_entity));
}
/* If we are not defining this object and we made a dummy pointer,
it means that a size of zero should be treated as an unspecified size. */
static tree
-validate_size (Uint uint_size,
- tree gnu_type,
- Entity_Id gnat_object,
- enum tree_code kind,
- int component_p,
- int zero_ok)
+validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
+ enum tree_code kind, int component_p, int zero_ok)
{
Node_Id gnat_error_node;
tree type_size
else if (TYPE_FAT_POINTER_P (gnu_type))
type_size = bitsize_int (POINTER_SIZE);
+ /* If this is an access type, the minimum size is that given by the smallest
+ integral mode that's valid for pointers. */
+ if (TREE_CODE (gnu_type) == POINTER_TYPE)
+ {
+ enum machine_mode p_mode;
+
+ for (p_mode = GET_CLASS_NARROWEST_MODE (MODE_INT);
+ !targetm.valid_pointer_mode (p_mode);
+ p_mode = GET_MODE_WIDER_MODE (p_mode))
+ ;
+
+ type_size = bitsize_int (GET_MODE_BITSIZE (p_mode));
+ }
+
/* If the size of the object is a constant, the new size must not be
smaller. */
if (TREE_CODE (type_size) != INTEGER_CST
= ((TREE_CODE (type) == INTEGER_TYPE
&& TYPE_BIASED_REPRESENTATION_P (type))
|| biased_p);
- TREE_UNSIGNED (new_type)
- = TREE_UNSIGNED (type) | TYPE_BIASED_REPRESENTATION_P (new_type);
+ TYPE_UNSIGNED (new_type)
+ = TYPE_UNSIGNED (type) | TYPE_BIASED_REPRESENTATION_P (new_type);
TYPE_RM_SIZE_INT (new_type) = bitsize_int (size);
return new_type;
OSDN Git Service
