Commit c6bd4220 by Eric Botcazou Committed by Eric Botcazou

init.c (__gnat_set_globals): Add prototype.

	* init.c (__gnat_set_globals): Add prototype.
	* adaint.c (__gnat_binder_supports_auto_init): Likewise.
	(__gnat_sals_init_using_constructors): Likewise.
	* gcc-interface/utils.c (gnat_pushlevel): Likewise.
	(get_block_jmpbuf_decl): Likewise.
	(gnat_poplevel): Likewise.
	(merge_sizes): Rename local variable.
	(copy_type): Likewise.
	(build_vms_descriptor32): Likewise.
	(build_vms_descriptor): Likewise.
	(convert_vms_descriptor64): Likewise.
	(convert_vms_descriptor32): Likewise.
	(convert_to_fat_pointer): Likewise.
	(maybe_unconstrained_array): Likewise.
	(def_fn_type): Use promoted type with va_arg.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Add declaration.
	(substitute_in_type): Rename local variable.
	* gcc-interface/Make-lang.in (ada-warn): Use STRICT_WARN.

From-SVN: r149007
parent 92ec3570
2009-06-27 Eric Botcazou <ebotcazou@adacore.com>
* init.c (__gnat_set_globals): Add prototype.
* adaint.c (__gnat_binder_supports_auto_init): Likewise.
(__gnat_sals_init_using_constructors): Likewise.
* gcc-interface/utils.c (gnat_pushlevel): Likewise.
(get_block_jmpbuf_decl): Likewise.
(gnat_poplevel): Likewise.
(merge_sizes): Rename local variable.
(copy_type): Likewise.
(build_vms_descriptor32): Likewise.
(build_vms_descriptor): Likewise.
(convert_vms_descriptor64): Likewise.
(convert_vms_descriptor32): Likewise.
(convert_to_fat_pointer): Likewise.
(maybe_unconstrained_array): Likewise.
(def_fn_type): Use promoted type with va_arg.
* gcc-interface/decl.c (gnat_to_gnu_entity): Add declaration.
(substitute_in_type): Rename local variable.
* gcc-interface/Make-lang.in (ada-warn): Use STRICT_WARN.
2009-06-26 Laurent GUERBY <laurent@guerby.net> 2009-06-26 Laurent GUERBY <laurent@guerby.net>
* tb-gcc.c (trace_callback): Use char* instead of void*. * tb-gcc.c (trace_callback): Use char* instead of void*.
......
...@@ -3510,7 +3510,7 @@ __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED, ...@@ -3510,7 +3510,7 @@ __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
/* Indicates if platforms supports automatic initialization through the /* Indicates if platforms supports automatic initialization through the
constructor mechanism */ constructor mechanism */
int int
__gnat_binder_supports_auto_init () __gnat_binder_supports_auto_init (void)
{ {
#ifdef VMS #ifdef VMS
return 0; return 0;
...@@ -3522,7 +3522,7 @@ __gnat_binder_supports_auto_init () ...@@ -3522,7 +3522,7 @@ __gnat_binder_supports_auto_init ()
/* Indicates that Stand-Alone Libraries are automatically initialized through /* Indicates that Stand-Alone Libraries are automatically initialized through
the constructor mechanism */ the constructor mechanism */
int int
__gnat_sals_init_using_constructors () __gnat_sals_init_using_constructors (void)
{ {
#if defined (__vxworks) || defined (__Lynx__) || defined (VMS) #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
return 0; return 0;
......
...@@ -75,12 +75,10 @@ ADA_FLAGS_TO_PASS = \ ...@@ -75,12 +75,10 @@ ADA_FLAGS_TO_PASS = \
.SUFFIXES: .ada .adb .ads .SUFFIXES: .ada .adb .ads
# FIXME: need to add $(ADA_CFLAGS) to .c.o suffix rule # FIXME: need to add $(ADA_CFLAGS) to .c.o suffix rule
# Use loose warnings for this front end, but add some special flags # Use mildly strict warnings for this front end and add special flags.
ada-warn = $(ADA_CFLAGS) $(WERROR) ada-warn = $(ADA_CFLAGS) $(filter-out -pedantic, $(STRICT_WARN))
# unresolved warnings in a couple of files # Unresolved warnings in specific files.
ada/tracebak.o-warn = -Wno-error ada/adaint.o-warn = -Wno-error
ada/b_gnat1.o-warn = -Wno-error
ada/b_gnatb.o-warn = -Wno-error
.adb.o: .adb.o:
$(CC) -c $(ALL_ADAFLAGS) $(ADA_INCLUDES) $< $(OUTPUT_OPTION) $(CC) -c $(ALL_ADAFLAGS) $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
......
...@@ -2898,7 +2898,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2898,7 +2898,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnat_field = Next_Stored_Discriminant (gnat_field)) gnat_field = Next_Stored_Discriminant (gnat_field))
if (Present (Corresponding_Discriminant (gnat_field))) if (Present (Corresponding_Discriminant (gnat_field)))
{ {
gnu_field = gnat_to_gnu_field_decl (gnat_field); tree gnu_field = gnat_to_gnu_field_decl (gnat_field);
tree gnu_ref tree gnu_ref
= build3 (COMPONENT_REF, TREE_TYPE (gnu_field), = build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
gnu_get_parent, gnu_field, NULL_TREE); gnu_get_parent, gnu_field, NULL_TREE);
...@@ -7840,7 +7840,7 @@ compatible_signatures_p (tree ftype1, tree ftype2) ...@@ -7840,7 +7840,7 @@ compatible_signatures_p (tree ftype1, tree ftype2)
tree tree
substitute_in_type (tree t, tree f, tree r) substitute_in_type (tree t, tree f, tree r)
{ {
tree new_tree; tree nt;
gcc_assert (CONTAINS_PLACEHOLDER_P (r)); gcc_assert (CONTAINS_PLACEHOLDER_P (r));
...@@ -7861,15 +7861,15 @@ substitute_in_type (tree t, tree f, tree r) ...@@ -7861,15 +7861,15 @@ substitute_in_type (tree t, tree f, tree r)
if (low == TYPE_GCC_MIN_VALUE (t) && high == TYPE_GCC_MAX_VALUE (t)) if (low == TYPE_GCC_MIN_VALUE (t) && high == TYPE_GCC_MAX_VALUE (t))
return t; return t;
new_tree = copy_type (t); nt = copy_type (t);
TYPE_GCC_MIN_VALUE (new_tree) = low; TYPE_GCC_MIN_VALUE (nt) = low;
TYPE_GCC_MAX_VALUE (new_tree) = high; TYPE_GCC_MAX_VALUE (nt) = high;
if (TREE_CODE (t) == INTEGER_TYPE && TYPE_INDEX_TYPE (t)) if (TREE_CODE (t) == INTEGER_TYPE && TYPE_INDEX_TYPE (t))
SET_TYPE_INDEX_TYPE SET_TYPE_INDEX_TYPE
(new_tree, substitute_in_type (TYPE_INDEX_TYPE (t), f, r)); (nt, substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
return new_tree; return nt;
} }
/* Then the subtypes. */ /* Then the subtypes. */
...@@ -7882,21 +7882,21 @@ substitute_in_type (tree t, tree f, tree r) ...@@ -7882,21 +7882,21 @@ substitute_in_type (tree t, tree f, tree r)
if (low == TYPE_RM_MIN_VALUE (t) && high == TYPE_RM_MAX_VALUE (t)) if (low == TYPE_RM_MIN_VALUE (t) && high == TYPE_RM_MAX_VALUE (t))
return t; return t;
new_tree = copy_type (t); nt = copy_type (t);
SET_TYPE_RM_MIN_VALUE (new_tree, low); SET_TYPE_RM_MIN_VALUE (nt, low);
SET_TYPE_RM_MAX_VALUE (new_tree, high); SET_TYPE_RM_MAX_VALUE (nt, high);
return new_tree; return nt;
} }
return t; return t;
case COMPLEX_TYPE: case COMPLEX_TYPE:
new_tree = substitute_in_type (TREE_TYPE (t), f, r); nt = substitute_in_type (TREE_TYPE (t), f, r);
if (new_tree == TREE_TYPE (t)) if (nt == TREE_TYPE (t))
return t; return t;
return build_complex_type (new_tree); return build_complex_type (nt);
case OFFSET_TYPE: case OFFSET_TYPE:
case METHOD_TYPE: case METHOD_TYPE:
...@@ -7913,16 +7913,16 @@ substitute_in_type (tree t, tree f, tree r) ...@@ -7913,16 +7913,16 @@ substitute_in_type (tree t, tree f, tree r)
if (component == TREE_TYPE (t) && domain == TYPE_DOMAIN (t)) if (component == TREE_TYPE (t) && domain == TYPE_DOMAIN (t))
return t; return t;
new_tree = build_array_type (component, domain); nt = build_array_type (component, domain);
TYPE_ALIGN (new_tree) = TYPE_ALIGN (t); TYPE_ALIGN (nt) = TYPE_ALIGN (t);
TYPE_USER_ALIGN (new_tree) = TYPE_USER_ALIGN (t); TYPE_USER_ALIGN (nt) = TYPE_USER_ALIGN (t);
SET_TYPE_MODE (new_tree, TYPE_MODE (t)); SET_TYPE_MODE (nt, TYPE_MODE (t));
TYPE_SIZE (new_tree) = SUBSTITUTE_IN_EXPR (TYPE_SIZE (t), f, r); TYPE_SIZE (nt) = SUBSTITUTE_IN_EXPR (TYPE_SIZE (t), f, r);
TYPE_SIZE_UNIT (new_tree) = SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (t), f, r); TYPE_SIZE_UNIT (nt) = SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (t), f, r);
TYPE_NONALIASED_COMPONENT (new_tree) = TYPE_NONALIASED_COMPONENT (t); TYPE_NONALIASED_COMPONENT (nt) = TYPE_NONALIASED_COMPONENT (t);
TYPE_MULTI_ARRAY_P (new_tree) = TYPE_MULTI_ARRAY_P (t); TYPE_MULTI_ARRAY_P (nt) = TYPE_MULTI_ARRAY_P (t);
TYPE_CONVENTION_FORTRAN_P (new_tree) = TYPE_CONVENTION_FORTRAN_P (t); TYPE_CONVENTION_FORTRAN_P (nt) = TYPE_CONVENTION_FORTRAN_P (t);
return new_tree; return nt;
} }
case RECORD_TYPE: case RECORD_TYPE:
...@@ -7935,8 +7935,8 @@ substitute_in_type (tree t, tree f, tree r) ...@@ -7935,8 +7935,8 @@ substitute_in_type (tree t, tree f, tree r)
/* Start out with no fields, make new fields, and chain them /* Start out with no fields, make new fields, and chain them
in. If we haven't actually changed the type of any field, in. If we haven't actually changed the type of any field,
discard everything we've done and return the old type. */ discard everything we've done and return the old type. */
new_tree = copy_type (t); nt = copy_type (t);
TYPE_FIELDS (new_tree) = NULL_TREE; TYPE_FIELDS (nt) = NULL_TREE;
for (field = TYPE_FIELDS (t); field; field = TREE_CHAIN (field)) for (field = TYPE_FIELDS (t); field; field = TREE_CHAIN (field))
{ {
...@@ -7967,23 +7967,23 @@ substitute_in_type (tree t, tree f, tree r) ...@@ -7967,23 +7967,23 @@ substitute_in_type (tree t, tree f, tree r)
} }
} }
DECL_CONTEXT (new_field) = new_tree; DECL_CONTEXT (new_field) = nt;
SET_DECL_ORIGINAL_FIELD (new_field, SET_DECL_ORIGINAL_FIELD (new_field,
(DECL_ORIGINAL_FIELD (field) (DECL_ORIGINAL_FIELD (field)
? DECL_ORIGINAL_FIELD (field) : field)); ? DECL_ORIGINAL_FIELD (field) : field));
TREE_CHAIN (new_field) = TYPE_FIELDS (new_tree); TREE_CHAIN (new_field) = TYPE_FIELDS (nt);
TYPE_FIELDS (new_tree) = new_field; TYPE_FIELDS (nt) = new_field;
} }
if (!changed_field) if (!changed_field)
return t; return t;
TYPE_FIELDS (new_tree) = nreverse (TYPE_FIELDS (new_tree)); TYPE_FIELDS (nt) = nreverse (TYPE_FIELDS (nt));
TYPE_SIZE (new_tree) = SUBSTITUTE_IN_EXPR (TYPE_SIZE (t), f, r); TYPE_SIZE (nt) = SUBSTITUTE_IN_EXPR (TYPE_SIZE (t), f, r);
TYPE_SIZE_UNIT (new_tree) = SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (t), f, r); TYPE_SIZE_UNIT (nt) = SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (t), f, r);
SET_TYPE_ADA_SIZE (new_tree, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (t), f, r)); SET_TYPE_ADA_SIZE (nt, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (t), f, r));
return new_tree; return nt;
} }
default: default:
......
...@@ -319,7 +319,7 @@ global_bindings_p (void) ...@@ -319,7 +319,7 @@ global_bindings_p (void)
/* Enter a new binding level. */ /* Enter a new binding level. */
void void
gnat_pushlevel () gnat_pushlevel (void)
{ {
struct gnat_binding_level *newlevel = NULL; struct gnat_binding_level *newlevel = NULL;
...@@ -379,7 +379,7 @@ set_block_jmpbuf_decl (tree decl) ...@@ -379,7 +379,7 @@ set_block_jmpbuf_decl (tree decl)
/* Get the jmpbuf_decl, if any, for the current binding level. */ /* Get the jmpbuf_decl, if any, for the current binding level. */
tree tree
get_block_jmpbuf_decl () get_block_jmpbuf_decl (void)
{ {
return current_binding_level->jmpbuf_decl; return current_binding_level->jmpbuf_decl;
} }
...@@ -387,7 +387,7 @@ get_block_jmpbuf_decl () ...@@ -387,7 +387,7 @@ get_block_jmpbuf_decl ()
/* Exit a binding level. Set any BLOCK into the current code group. */ /* Exit a binding level. Set any BLOCK into the current code group. */
void void
gnat_poplevel () gnat_poplevel (void)
{ {
struct gnat_binding_level *level = current_binding_level; struct gnat_binding_level *level = current_binding_level;
tree block = level->block; tree block = level->block;
...@@ -1017,33 +1017,33 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special, ...@@ -1017,33 +1017,33 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special,
bool has_rep) bool has_rep)
{ {
tree type = TREE_TYPE (last_size); tree type = TREE_TYPE (last_size);
tree new_tree; tree new_size;
if (!special || TREE_CODE (size) != COND_EXPR) if (!special || TREE_CODE (size) != COND_EXPR)
{ {
new_tree = size_binop (PLUS_EXPR, first_bit, size); new_size = size_binop (PLUS_EXPR, first_bit, size);
if (has_rep) if (has_rep)
new_tree = size_binop (MAX_EXPR, last_size, new_tree); new_size = size_binop (MAX_EXPR, last_size, new_size);
} }
else else
new_tree = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0), new_size = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0),
integer_zerop (TREE_OPERAND (size, 1)) integer_zerop (TREE_OPERAND (size, 1))
? last_size : merge_sizes (last_size, first_bit, ? last_size : merge_sizes (last_size, first_bit,
TREE_OPERAND (size, 1), TREE_OPERAND (size, 1),
1, has_rep), 1, has_rep),
integer_zerop (TREE_OPERAND (size, 2)) integer_zerop (TREE_OPERAND (size, 2))
? last_size : merge_sizes (last_size, first_bit, ? last_size : merge_sizes (last_size, first_bit,
TREE_OPERAND (size, 2), TREE_OPERAND (size, 2),
1, has_rep)); 1, has_rep));
/* We don't need any NON_VALUE_EXPRs and they can confuse us (especially /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
when fed through substitute_in_expr) into thinking that a constant when fed through substitute_in_expr) into thinking that a constant
size is not constant. */ size is not constant. */
while (TREE_CODE (new_tree) == NON_LVALUE_EXPR) while (TREE_CODE (new_size) == NON_LVALUE_EXPR)
new_tree = TREE_OPERAND (new_tree, 0); new_size = TREE_OPERAND (new_size, 0);
return new_tree; return new_size;
} }
/* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are /* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are
...@@ -1163,18 +1163,18 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list, ...@@ -1163,18 +1163,18 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
tree tree
copy_type (tree type) copy_type (tree type)
{ {
tree new_tree = copy_node (type); tree new_type = copy_node (type);
/* copy_node clears this field instead of copying it, because it is /* copy_node clears this field instead of copying it, because it is
aliased with TREE_CHAIN. */ aliased with TREE_CHAIN. */
TYPE_STUB_DECL (new_tree) = TYPE_STUB_DECL (type); TYPE_STUB_DECL (new_type) = TYPE_STUB_DECL (type);
TYPE_POINTER_TO (new_tree) = 0; TYPE_POINTER_TO (new_type) = 0;
TYPE_REFERENCE_TO (new_tree) = 0; TYPE_REFERENCE_TO (new_type) = 0;
TYPE_MAIN_VARIANT (new_tree) = new_tree; TYPE_MAIN_VARIANT (new_type) = new_type;
TYPE_NEXT_VARIANT (new_tree) = 0; TYPE_NEXT_VARIANT (new_type) = 0;
return new_tree; return new_type;
} }
/* Return a subtype of sizetype with range MIN to MAX and whose /* Return a subtype of sizetype with range MIN to MAX and whose
...@@ -2515,7 +2515,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2515,7 +2515,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
tree record_type = make_node (RECORD_TYPE); tree record_type = make_node (RECORD_TYPE);
tree pointer32_type; tree pointer32_type;
tree field_list = 0; tree field_list = 0;
int class_i; int klass;
int dtype = 0; int dtype = 0;
tree inner_type; tree inner_type;
int ndim; int ndim;
...@@ -2627,22 +2627,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2627,22 +2627,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{ {
case By_Descriptor_A: case By_Descriptor_A:
case By_Short_Descriptor_A: case By_Short_Descriptor_A:
class_i = 4; klass = 4;
break; break;
case By_Descriptor_NCA: case By_Descriptor_NCA:
case By_Short_Descriptor_NCA: case By_Short_Descriptor_NCA:
class_i = 10; klass = 10;
break; break;
case By_Descriptor_SB: case By_Descriptor_SB:
case By_Short_Descriptor_SB: case By_Short_Descriptor_SB:
class_i = 15; klass = 15;
break; break;
case By_Descriptor: case By_Descriptor:
case By_Short_Descriptor: case By_Short_Descriptor:
case By_Descriptor_S: case By_Descriptor_S:
case By_Short_Descriptor_S: case By_Short_Descriptor_S:
default: default:
class_i = 1; klass = 1;
break; break;
} }
...@@ -2664,7 +2664,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2664,7 +2664,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
field_list = chainon (field_list, field_list = chainon (field_list,
make_descriptor_field ("CLASS", make_descriptor_field ("CLASS",
gnat_type_for_size (8, 1), gnat_type_for_size (8, 1),
record_type, size_int (class_i))); record_type, size_int (klass)));
/* Of course this will crash at run-time if the address space is not /* Of course this will crash at run-time if the address space is not
within the low 32 bits, but there is nothing else we can do. */ within the low 32 bits, but there is nothing else we can do. */
...@@ -2830,7 +2830,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2830,7 +2830,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
tree record64_type = make_node (RECORD_TYPE); tree record64_type = make_node (RECORD_TYPE);
tree pointer64_type; tree pointer64_type;
tree field_list64 = 0; tree field_list64 = 0;
int class_i; int klass;
int dtype = 0; int dtype = 0;
tree inner_type; tree inner_type;
int ndim; int ndim;
...@@ -2941,18 +2941,18 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2941,18 +2941,18 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
switch (mech) switch (mech)
{ {
case By_Descriptor_A: case By_Descriptor_A:
class_i = 4; klass = 4;
break; break;
case By_Descriptor_NCA: case By_Descriptor_NCA:
class_i = 10; klass = 10;
break; break;
case By_Descriptor_SB: case By_Descriptor_SB:
class_i = 15; klass = 15;
break; break;
case By_Descriptor: case By_Descriptor:
case By_Descriptor_S: case By_Descriptor_S:
default: default:
class_i = 1; klass = 1;
break; break;
} }
...@@ -2971,7 +2971,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) ...@@ -2971,7 +2971,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
field_list64 = chainon (field_list64, field_list64 = chainon (field_list64,
make_descriptor_field ("CLASS", make_descriptor_field ("CLASS",
gnat_type_for_size (8, 1), gnat_type_for_size (8, 1),
record64_type, size_int (class_i))); record64_type, size_int (klass)));
field_list64 = chainon (field_list64, field_list64 = chainon (field_list64,
make_descriptor_field ("MBMO", make_descriptor_field ("MBMO",
...@@ -3154,9 +3154,9 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3154,9 +3154,9 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
/* The CLASS field is the 3rd field in the descriptor. */ /* The CLASS field is the 3rd field in the descriptor. */
tree class_tree = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 6th field in the descriptor. */ /* The POINTER field is the 6th field in the descriptor. */
tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class_tree))); tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
/* Retrieve the value of the POINTER field. */ /* Retrieve the value of the POINTER field. */
tree gnu_expr64 tree gnu_expr64
...@@ -3174,18 +3174,18 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3174,18 +3174,18 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type)); tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
tree template_tree, template_addr, aflags, dimct, t, u; tree template_tree, template_addr, aflags, dimct, t, u;
/* See the head comment of build_vms_descriptor. */ /* See the head comment of build_vms_descriptor. */
int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class_tree)); int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
tree lfield, ufield; tree lfield, ufield;
/* Convert POINTER to the type of the P_ARRAY field. */ /* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr64 = convert (p_array_type, gnu_expr64); gnu_expr64 = convert (p_array_type, gnu_expr64);
switch (iclass) switch (iklass)
{ {
case 1: /* Class S */ case 1: /* Class S */
case 15: /* Class SB */ case 15: /* Class SB */
/* Build {1, LENGTH} template; LENGTH64 is the 5th field. */ /* Build {1, LENGTH} template; LENGTH64 is the 5th field. */
t = TREE_CHAIN (TREE_CHAIN (class_tree)); t = TREE_CHAIN (TREE_CHAIN (klass));
t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
t = tree_cons (min_field, t = tree_cons (min_field,
convert (TREE_TYPE (min_field), integer_one_node), convert (TREE_TYPE (min_field), integer_one_node),
...@@ -3196,12 +3196,12 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3196,12 +3196,12 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree); template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree);
/* For class S, we are done. */ /* For class S, we are done. */
if (iclass == 1) if (iklass == 1)
break; break;
/* Test that we really have a SB descriptor, like DEC Ada. */ /* Test that we really have a SB descriptor, like DEC Ada. */
t = build3 (COMPONENT_REF, TREE_TYPE (class_tree), desc, class_tree, NULL); t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
u = convert (TREE_TYPE (class_tree), DECL_INITIAL (class_tree)); u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
u = build_binary_op (EQ_EXPR, integer_type_node, t, u); u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and /* If so, there is already a template in the descriptor and
it is located right after the POINTER field. The fields are it is located right after the POINTER field. The fields are
...@@ -3271,7 +3271,8 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3271,7 +3271,8 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
build_call_raise (CE_Length_Check_Failed, Empty, build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error), N_Raise_Constraint_Error),
template_tree); template_tree);
template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree); template_addr
= build_unary_op (ADDR_EXPR, p_bounds_type, template_tree);
break; break;
case 10: /* Class NCA */ case 10: /* Class NCA */
...@@ -3302,9 +3303,9 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3302,9 +3303,9 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
/* The CLASS field is the 3rd field in the descriptor. */ /* The CLASS field is the 3rd field in the descriptor. */
tree class_tree = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 4th field in the descriptor. */ /* The POINTER field is the 4th field in the descriptor. */
tree pointer = TREE_CHAIN (class_tree); tree pointer = TREE_CHAIN (klass);
/* Retrieve the value of the POINTER field. */ /* Retrieve the value of the POINTER field. */
tree gnu_expr32 tree gnu_expr32
...@@ -3322,12 +3323,12 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3322,12 +3323,12 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type)); tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
tree template_tree, template_addr, aflags, dimct, t, u; tree template_tree, template_addr, aflags, dimct, t, u;
/* See the head comment of build_vms_descriptor. */ /* See the head comment of build_vms_descriptor. */
int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class_tree)); int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
/* Convert POINTER to the type of the P_ARRAY field. */ /* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr32 = convert (p_array_type, gnu_expr32); gnu_expr32 = convert (p_array_type, gnu_expr32);
switch (iclass) switch (iklass)
{ {
case 1: /* Class S */ case 1: /* Class S */
case 15: /* Class SB */ case 15: /* Class SB */
...@@ -3343,17 +3344,18 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3343,17 +3344,18 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree); template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree);
/* For class S, we are done. */ /* For class S, we are done. */
if (iclass == 1) if (iklass == 1)
break; break;
/* Test that we really have a SB descriptor, like DEC Ada. */ /* Test that we really have a SB descriptor, like DEC Ada. */
t = build3 (COMPONENT_REF, TREE_TYPE (class_tree), desc, class_tree, NULL); t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
u = convert (TREE_TYPE (class_tree), DECL_INITIAL (class_tree)); u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
u = build_binary_op (EQ_EXPR, integer_type_node, t, u); u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and /* If so, there is already a template in the descriptor and
it is located right after the POINTER field. */ it is located right after the POINTER field. */
t = TREE_CHAIN (pointer); t = TREE_CHAIN (pointer);
template_tree = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); template_tree
= build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
/* Otherwise use the {1, LENGTH} template we build above. */ /* Otherwise use the {1, LENGTH} template we build above. */
template_addr = build3 (COND_EXPR, p_bounds_type, u, template_addr = build3 (COND_EXPR, p_bounds_type, u,
build_unary_op (ADDR_EXPR, p_bounds_type, build_unary_op (ADDR_EXPR, p_bounds_type,
...@@ -3384,12 +3386,14 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3384,12 +3386,14 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
/* There is already a template in the descriptor and it is /* There is already a template in the descriptor and it is
located at the start of block 3 (12th field). */ located at the start of block 3 (12th field). */
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t)))); t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
template_tree = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); template_tree
= build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
template_tree = build3 (COND_EXPR, p_bounds_type, u, template_tree = build3 (COND_EXPR, p_bounds_type, u,
build_call_raise (CE_Length_Check_Failed, Empty, build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error), N_Raise_Constraint_Error),
template_tree); template_tree);
template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree); template_addr
= build_unary_op (ADDR_EXPR, p_bounds_type, template_tree);
break; break;
case 10: /* Class NCA */ case 10: /* Class NCA */
...@@ -3774,7 +3778,8 @@ convert_to_fat_pointer (tree type, tree expr) ...@@ -3774,7 +3778,8 @@ convert_to_fat_pointer (tree type, tree expr)
tree_cons (TYPE_FIELDS (type), tree_cons (TYPE_FIELDS (type),
convert (p_array_type, expr), convert (p_array_type, expr),
tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
build_unary_op (ADDR_EXPR, NULL_TREE, template_tree), build_unary_op (ADDR_EXPR, NULL_TREE,
template_tree),
NULL_TREE))); NULL_TREE)));
} }
...@@ -4304,20 +4309,21 @@ tree ...@@ -4304,20 +4309,21 @@ tree
maybe_unconstrained_array (tree exp) maybe_unconstrained_array (tree exp)
{ {
enum tree_code code = TREE_CODE (exp); enum tree_code code = TREE_CODE (exp);
tree new_tree; tree new_exp;
switch (TREE_CODE (TREE_TYPE (exp))) switch (TREE_CODE (TREE_TYPE (exp)))
{ {
case UNCONSTRAINED_ARRAY_TYPE: case UNCONSTRAINED_ARRAY_TYPE:
if (code == UNCONSTRAINED_ARRAY_REF) if (code == UNCONSTRAINED_ARRAY_REF)
{ {
new_tree new_exp
= build_unary_op (INDIRECT_REF, NULL_TREE, = build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 0), build_component_ref (TREE_OPERAND (exp, 0),
get_identifier ("P_ARRAY"), get_identifier ("P_ARRAY"),
NULL_TREE, false)); NULL_TREE, false));
TREE_READONLY (new_tree) = TREE_STATIC (new_tree) = TREE_READONLY (exp); TREE_READONLY (new_exp) = TREE_STATIC (new_exp)
return new_tree; = TREE_READONLY (exp);
return new_exp;
} }
else if (code == NULL_EXPR) else if (code == NULL_EXPR)
...@@ -4331,12 +4337,13 @@ maybe_unconstrained_array (tree exp) ...@@ -4331,12 +4337,13 @@ maybe_unconstrained_array (tree exp)
it contains a template. */ it contains a template. */
if (TYPE_IS_PADDING_P (TREE_TYPE (exp))) if (TYPE_IS_PADDING_P (TREE_TYPE (exp)))
{ {
new_tree = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp); new_exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
if (TREE_CODE (TREE_TYPE (new_tree)) == RECORD_TYPE if (TREE_CODE (TREE_TYPE (new_exp)) == RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_tree))) && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_exp)))
return return
build_component_ref (new_tree, NULL_TREE, build_component_ref (new_exp, NULL_TREE,
TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_tree))), TREE_CHAIN
(TYPE_FIELDS (TREE_TYPE (new_exp))),
0); 0);
} }
else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp))) else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
...@@ -4864,7 +4871,7 @@ def_fn_type (builtin_type def, builtin_type ret, bool var, int n, ...) ...@@ -4864,7 +4871,7 @@ def_fn_type (builtin_type def, builtin_type ret, bool var, int n, ...)
va_start (list, n); va_start (list, n);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {
builtin_type a = va_arg (list, builtin_type); builtin_type a = (builtin_type) va_arg (list, int);
t = builtin_types[a]; t = builtin_types[a];
if (t == error_mark_node) if (t == error_mark_node)
goto egress; goto egress;
......
...@@ -178,7 +178,7 @@ __gnat_get_specific_dispatching (int priority) ...@@ -178,7 +178,7 @@ __gnat_get_specific_dispatching (int priority)
file now sets the __gl_* variables directly. */ file now sets the __gl_* variables directly. */
void void
__gnat_set_globals () __gnat_set_globals (void)
{ {
} }
......
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