Commit 1eb58520 by Arnaud Charlet

ada-tree.h (DECL_BY_DESCRIPTOR_P): Delete.

2014-08-01  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/ada-tree.h (DECL_BY_DESCRIPTOR_P): Delete.
	(DECL_FUNCTION_STUB): Likewise.
	(SET_DECL_FUNCTION_STUB): Likewise.
	(DECL_PARM_ALT_TYPE): Likewise.
	(SET_DECL_PARM_ALT_TYPE): Likewise.
	(TYPE_VAX_FLOATING_POINT_P): Delete.
	(TYPE_DIGITS_VALUE): Likewise.
	(SET_TYPE_DIGITS_VALUE): Likewise.
	* gcc-interface/gigi.h (standard_datatypes): Remove ADT_malloc32_decl.
	(malloc32_decl): Delete.
	(build_vms_descriptor): Likewise.
	(build_vms_descriptor32): Likewise.
	(fill_vms_descriptor): Likewise.
	(convert_vms_descriptor): Likewise.
	(TARGET_ABI_OPEN_VMS): Likewise.
	(TARGET_MALLOC64): Likewise.
	* gcc-interface/decl.c (add_parallel_type_for_packed_array): New.
	(gnat_to_gnu_entity): Call it to add the original type as a parallel
	type to the implementation type of a packed array type.
	<E_Procedure>: Remove now obsolete kludge.
	<E_Exception>: Delete obsolete comment.
	<object>: Small tweak.
	<E_Subprogram_Type>: Remove support for stub subprograms, as well as
	for the descriptor passing mechanism.
	(gnat_to_gnu_param): Likewise.
	* gcc-interface/misc.c (gnat_init_gcc_fp): Remove special case.
	(gnat_print_type): Adjust.
	* gcc-interface/trans.c (gigi): Remove obsolete initializations.
	(vms_builtin_establish_handler_decl): Delete.
	(gnat_vms_condition_handler_decl): Likewise.
	(establish_gnat_vms_condition_handler): Likewise.
	(build_function_stub): Likewise.
	(Subprogram_Body_to_gnu): Do not call above functions.
	(Call_to_gnu): Remove support for the descriptor passing mechanism.
	* gcc-interface/utils.c (make_descriptor_field): Delete.
	(build_vms_descriptor32): Likewise.
	(build_vms_descriptor): Likewise.
	(fill_vms_descriptor): Likewise.
	(convert_vms_descriptor64): Likewise.
	(convert_vms_descriptor32): Likewise.
	(convert_vms_descriptor): Likewise.
	* gcc-interface/utils.c (unchecked_convert): Likewise.
	* gcc-interface/utils2.c (maybe_wrap_malloc): Remove obsolete stuff.

2014-08-01  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (gigi): Use gnat_to_gnu_type for the exception
	type and get_unpadded_type for the longest FP type.
	(Attribute_to_gnu) <Machine>: Compare the precision of the types.
	(convert_with_check): Adjust formatting and remove FIXME.

2014-08-01  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
	Do not convert the RM bounds to the base type.
	(E_Floating_Point_Subtype): Likewise.
	(E_Array_Subtype): Convert the bounds to the base type.
	* gcc-interface/trans.c (get_type_length): New function.
	(Attribute_to_gnu) <Range_Length>: Call it.
	<Length>: Likewise.
	(Loop_Statement_to_gnu): Convert the bounds to the base type.
	(gnat_to_gnu) <N_In>: Likewise.
	* gcc-interface/utils.c (make_type_from_size): Do not convert the RM
	bounds to the base type.
	(create_range_type): Likewise.
	(convert): Convert the bounds to the base type for biased types.
	* gcc-interface/utils2.c (compare_arrays): Convert the bounds to the
	base type.

2014-08-01  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (gnat_to_gnu) <N_Selected_Component>: Remove
	incorrect implicit type derivation.
	* gcc-interface/utils.c (max_size) <tcc_reference>: Convert the bounds
	to the base type.

From-SVN: r213462
parent ecda544d
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (DECL_BY_DESCRIPTOR_P): Delete.
(DECL_FUNCTION_STUB): Likewise.
(SET_DECL_FUNCTION_STUB): Likewise.
(DECL_PARM_ALT_TYPE): Likewise.
(SET_DECL_PARM_ALT_TYPE): Likewise.
(TYPE_VAX_FLOATING_POINT_P): Delete.
(TYPE_DIGITS_VALUE): Likewise.
(SET_TYPE_DIGITS_VALUE): Likewise.
* gcc-interface/gigi.h (standard_datatypes): Remove ADT_malloc32_decl.
(malloc32_decl): Delete.
(build_vms_descriptor): Likewise.
(build_vms_descriptor32): Likewise.
(fill_vms_descriptor): Likewise.
(convert_vms_descriptor): Likewise.
(TARGET_ABI_OPEN_VMS): Likewise.
(TARGET_MALLOC64): Likewise.
* gcc-interface/decl.c (add_parallel_type_for_packed_array): New.
(gnat_to_gnu_entity): Call it to add the original type as a parallel
type to the implementation type of a packed array type.
<E_Procedure>: Remove now obsolete kludge.
<E_Exception>: Delete obsolete comment.
<object>: Small tweak.
<E_Subprogram_Type>: Remove support for stub subprograms, as well as
for the descriptor passing mechanism.
(gnat_to_gnu_param): Likewise.
* gcc-interface/misc.c (gnat_init_gcc_fp): Remove special case.
(gnat_print_type): Adjust.
* gcc-interface/trans.c (gigi): Remove obsolete initializations.
(vms_builtin_establish_handler_decl): Delete.
(gnat_vms_condition_handler_decl): Likewise.
(establish_gnat_vms_condition_handler): Likewise.
(build_function_stub): Likewise.
(Subprogram_Body_to_gnu): Do not call above functions.
(Call_to_gnu): Remove support for the descriptor passing mechanism.
* gcc-interface/utils.c (make_descriptor_field): Delete.
(build_vms_descriptor32): Likewise.
(build_vms_descriptor): Likewise.
(fill_vms_descriptor): Likewise.
(convert_vms_descriptor64): Likewise.
(convert_vms_descriptor32): Likewise.
(convert_vms_descriptor): Likewise.
* gcc-interface/utils.c (unchecked_convert): Likewise.
* gcc-interface/utils2.c (maybe_wrap_malloc): Remove obsolete stuff.
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (gigi): Use gnat_to_gnu_type for the exception
type and get_unpadded_type for the longest FP type.
(Attribute_to_gnu) <Machine>: Compare the precision of the types.
(convert_with_check): Adjust formatting and remove FIXME.
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
Do not convert the RM bounds to the base type.
(E_Floating_Point_Subtype): Likewise.
(E_Array_Subtype): Convert the bounds to the base type.
* gcc-interface/trans.c (get_type_length): New function.
(Attribute_to_gnu) <Range_Length>: Call it.
<Length>: Likewise.
(Loop_Statement_to_gnu): Convert the bounds to the base type.
(gnat_to_gnu) <N_In>: Likewise.
* gcc-interface/utils.c (make_type_from_size): Do not convert the RM
bounds to the base type.
(create_range_type): Likewise.
(convert): Convert the bounds to the base type for biased types.
* gcc-interface/utils2.c (compare_arrays): Convert the bounds to the
base type.
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu) <N_Selected_Component>: Remove
incorrect implicit type derivation.
* gcc-interface/utils.c (max_size) <tcc_reference>: Convert the bounds
to the base type.
2014-08-01 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Analyze_Attribute): Preanalyze and resolve the
prefix of attribute Loop_Entry.
* sem_prag.adb (Analyze_Pragma): Verify the placement of pragma
Loop_Variant with respect to an enclosing loop (if any).
(Contains_Loop_Entry): Update the parameter profile and all
calls to this routine.
* sem_res.adb (Resolve_Call): Code reformatting. Do not ask
for the corresponding body before determining the nature of the
ultimate alias's declarative node.
2014-08-01 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb, sem_ch4.adb: Minor reformatting.
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_eval.adb (Rewrite_In_Raise_CE): Don't try to reuse inner
constraint error node since it is a list member.
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_warn.adb: Minor reformatting.
2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* einfo.adb (Underlying_Type): Return the underlying full view
of a private type if present.
* freeze.adb (Freeze_Entity):
Build a single freeze node for partial, full and underlying full
views, if any.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Private_Type>: Add a
missing guard before the access to the Underlying_Full_View.
* gcc-interface/trans.c (process_freeze_entity): Deal with underlying
full view if present.
* gcc-interface/utils.c (make_dummy_type): Avoid superfluous work.
2014-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Entry_Call): When an entry has
......
......@@ -120,11 +120,6 @@ do { \
|| TREE_CODE (NODE) == ENUMERAL_TYPE) \
&& TYPE_BY_REFERENCE_P (NODE))
/* For INTEGER_TYPE, nonzero if this really represents a VAX
floating-point type. */
#define TYPE_VAX_FLOATING_POINT_P(NODE) \
TYPE_LANG_FLAG_3 (INTEGER_TYPE_CHECK (NODE))
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is the
type for an object whose type includes its template in addition to
its value (only true for RECORD_TYPE). */
......@@ -257,7 +252,11 @@ do { \
bound but they must nevertheless be valid in the GCC type system, otherwise
the optimizer can pretend that they simply don't exist. Therefore they
must be within the range of values allowed by the lower bound in the GCC
sense, hence the GCC lower bound be set to that of the base type. */
sense, hence the GCC lower bound be set to that of the base type.
This lower bound is translated directly without the adjustments that may
be required for type compatibility, so it will generally be necessary to
convert it to the base type of the numerical type before using it. */
#define TYPE_RM_MIN_VALUE(NODE) TYPE_RM_VALUE ((NODE), 1)
#define SET_TYPE_RM_MIN_VALUE(NODE, X) SET_TYPE_RM_VALUE ((NODE), 1, (X))
......@@ -269,7 +268,11 @@ do { \
bound but they must nevertheless be valid in the GCC type system, otherwise
the optimizer can pretend that they simply don't exist. Therefore they
must be within the range of values allowed by the upper bound in the GCC
sense, hence the GCC upper bound be set to that of the base type. */
sense, hence the GCC upper bound be set to that of the base type.
This upper bound is translated directly without the adjustments that may
be required for type compatibility, so it will generally be necessary to
convert it to the base type of the numerical type before using it. */
#define TYPE_RM_MAX_VALUE(NODE) TYPE_RM_VALUE ((NODE), 2)
#define SET_TYPE_RM_MAX_VALUE(NODE, X) SET_TYPE_RM_VALUE ((NODE), 2, (X))
......@@ -294,15 +297,18 @@ do { \
#define SET_TYPE_MODULUS(NODE, X) \
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, this is the
Digits_Value. */
#define TYPE_DIGITS_VALUE(NODE) \
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, this is
the type corresponding to the Ada index type. */
the type corresponding to the Ada index type. It is necessary to keep
these 2 views for every array type because the TYPE_DOMAIN is subject
to strong constraints in GENERIC: it must be a subtype of SIZETYPE and
may not be superflat, i.e. the upper bound must always be larger or
equal to the lower bound minus 1 (i.e. the canonical length formula
must always yield a non-negative number), which means that at least
one of the bounds may need to be a conditional expression. There are
no such constraints on the TYPE_INDEX_TYPE because gigi is prepared to
deal with the superflat case; moreover the TYPE_INDEX_TYPE is used as
the index type for the debug info and, therefore, needs to be as close
as possible to the source index type. */
#define TYPE_INDEX_TYPE(NODE) \
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_INDEX_TYPE(NODE, X) \
......@@ -388,9 +394,6 @@ do { \
is readonly. */
#define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
/* Nonzero in a PARM_DECL if we are to pass by descriptor. */
#define DECL_BY_DESCRIPTOR_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE))
/* Nonzero in a VAR_DECL if it is a pointer renaming a global object. */
#define DECL_RENAMING_GLOBAL_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE))
......@@ -448,19 +451,6 @@ do { \
#define SET_DECL_PARALLEL_TYPE(NODE, X) \
SET_DECL_LANG_SPECIFIC (TYPE_DECL_CHECK (NODE), X)
/* In a FUNCTION_DECL, points to the stub associated with the function
if any, otherwise 0. */
#define DECL_FUNCTION_STUB(NODE) \
GET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE))
#define SET_DECL_FUNCTION_STUB(NODE, X) \
SET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE), X)
/* In a PARM_DECL, points to the alternate TREE_TYPE. */
#define DECL_PARM_ALT_TYPE(NODE) \
GET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE))
#define SET_DECL_PARM_ALT_TYPE(NODE, X) \
SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
/* Flags added to ref nodes. */
......
......@@ -395,10 +395,8 @@ enum standard_datatypes
ADT_sbitsize_unit_node,
/* Function declaration nodes for run-time functions for allocating memory.
Ada allocators cause calls to these functions to be generated. Malloc32
is used only on 64bit systems needing to allocate 32bit memory. */
Ada allocators cause calls to this function to be generated. */
ADT_malloc_decl,
ADT_malloc32_decl,
/* Likewise for freeing memory. */
ADT_free_decl,
......@@ -471,7 +469,6 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
#define sbitsize_one_node gnat_std_decls[(int) ADT_sbitsize_one_node]
#define sbitsize_unit_node gnat_std_decls[(int) ADT_sbitsize_unit_node]
#define malloc_decl gnat_std_decls[(int) ADT_malloc_decl]
#define malloc32_decl gnat_std_decls[(int) ADT_malloc32_decl]
#define free_decl gnat_std_decls[(int) ADT_free_decl]
#define mulv64_decl gnat_std_decls[(int) ADT_mulv64_decl]
#define parent_name_id gnat_std_decls[(int) ADT_parent_name_id]
......@@ -783,19 +780,6 @@ extern void rest_of_subprog_body_compilation (tree subprog_decl);
Return a constructor for the template. */
extern tree build_template (tree template_type, tree array_type, tree expr);
/* Build a 64bit 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
to print out an error message if the mechanism cannot be applied to
an object of that type and also for the name. */
extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
Entity_Id gnat_entity);
/* Build a 32bit VMS descriptor from a Mechanism_Type. See above. */
extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech,
Entity_Id gnat_entity);
/* Build a type to be used to represent an aliased object whose nominal type
is an unconstrained array. This consists of a RECORD_TYPE containing a
field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an ARRAY_TYPE.
......@@ -963,19 +947,6 @@ extern tree build_allocator (tree type, tree init, tree result_type,
Entity_Id gnat_proc, Entity_Id gnat_pool,
Node_Id gnat_node, bool);
/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result.
GNAT_ACTUAL is the actual parameter for which the descriptor is built. */
extern tree fill_vms_descriptor (tree gnu_type, tree gnu_expr,
Node_Id gnat_actual);
/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
pointer or fat pointer type. GNU_EXPR_ALT_TYPE is the alternate (32-bit)
pointer type of GNU_EXPR. GNAT_SUBPROG is the subprogram to which the
descriptor is passed. */
extern tree convert_vms_descriptor (tree gnu_type, tree gnu_expr,
tree gnu_expr_alt_type,
Entity_Id gnat_subprog);
/* Indicate that we need to take the address of T and that it therefore
should not be allocated in a register. Returns true if successful. */
extern bool gnat_mark_addressable (tree t);
......@@ -1067,19 +1038,6 @@ extern void enumerate_modes (void (*f) (const char *, int, int, int, int, int,
}
#endif
/* Let code know whether we are targeting VMS without need of
intrusive preprocessor directives. */
#ifndef TARGET_ABI_OPEN_VMS
#define TARGET_ABI_OPEN_VMS 0
#endif
/* VMS option set by default, when clear forces 32bit mallocs and 32bit
Descriptors. Always used in combination with TARGET_ABI_OPEN_VMS
so no effect on non-VMS systems. */
#if TARGET_ABI_OPEN_VMS == 0
#define flag_vms_malloc64 0
#endif
/* Convenient shortcuts. */
#define VECTOR_TYPE_P(TYPE) (TREE_CODE (TYPE) == VECTOR_TYPE)
......
......@@ -407,10 +407,8 @@ gnat_init_gcc_fp (void)
flag_signed_zeros = 0;
/* Assume that FP operations can trap if S'Machine_Overflow is true,
but don't override the user if not.
??? Alpha/VMS enables FP traps without declaring it. */
if (Machine_Overflows_On_Target || TARGET_ABI_OPEN_VMS)
but don't override the user if not. */
if (Machine_Overflows_On_Target)
flag_trapping_math = 1;
else if (!global_options_set.x_flag_trapping_math)
flag_trapping_math = 0;
......@@ -469,8 +467,6 @@ gnat_print_type (FILE *file, tree node, int indent)
else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
indent + 4);
else if (TYPE_VAX_FLOATING_POINT_P (node))
;
else
print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
......
......@@ -300,10 +300,14 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
last < first holds. */
if (integer_zerop (length2))
{
tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
length_zero_p = true;
ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
ub1
= convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
lb1
= convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
comparison = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
......@@ -319,20 +323,23 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2)
just use its length computed from the actual stored bounds. */
else if (TREE_CODE (length2) == INTEGER_CST)
{
tree bt;
tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
ub1
= convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
lb1
= convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
/* Note that we know that UB2 and LB2 are constant and hence
cannot contain a PLACEHOLDER_EXPR. */
ub2 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
lb2 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
bt = get_base_type (TREE_TYPE (ub1));
ub2
= convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2))));
lb2
= convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2))));
comparison
= fold_build2_loc (loc, EQ_EXPR, result_type,
build_binary_op (MINUS_EXPR, bt, ub1, lb1),
build_binary_op (MINUS_EXPR, bt, ub2, lb2));
build_binary_op (MINUS_EXPR, b, ub1, lb1),
build_binary_op (MINUS_EXPR, b, ub2, lb2));
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
if (EXPR_P (comparison))
SET_EXPR_LOCATION (comparison, loc);
......@@ -2152,18 +2159,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
tree size_to_malloc
= aligning_type ? TYPE_SIZE_UNIT (aligning_type) : data_size;
tree malloc_ptr;
/* On VMS, if pointers are 64-bit and the allocator size is 32-bit or
Convention C, allocate 32-bit memory. */
if (TARGET_ABI_OPEN_VMS
&& POINTER_SIZE == 64
&& Nkind (gnat_node) == N_Allocator
&& (UI_To_Int (Esize (Etype (gnat_node))) == 32
|| Convention (Etype (gnat_node)) == Convention_C))
malloc_ptr = build_call_n_expr (malloc32_decl, 1, size_to_malloc);
else
malloc_ptr = build_call_n_expr (malloc_decl, 1, size_to_malloc);
tree malloc_ptr = build_call_n_expr (malloc_decl, 1, size_to_malloc);
if (aligning_type)
{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment