Commit 0e228dd9 by Nathan Froyd Committed by Nathan Froyd

gigi.h (gnat_build_constructor): Take a VEC instead of a TREE_LIST.

	* gcc-interface/gigi.h (gnat_build_constructor): Take a VEC instead
	of a TREE_LIST.  Update comment.
	* gcc-interface/trans.c (gigi): Build a VEC instead of a TREE_LIST.
	Adjust call to gnat_build_constructor.
	(Attribute_to_gnu): Likewise.
	(gnat_to_gnu): Likewise.
	(pos_to_constructor): Likewise.
	(extract_values): Likewise.
	* gcc-interface/utils.c (build_template): Likewise.
	(convert_vms_descriptor64): Likewise.
	(convert_vms_descriptor32): Likewise.
	(convert_to_fat_pointer): Likewise.
	(convert): Likewise.
	(unchecked_convert): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Likewise.
	* gcc-interface/utils2.c (build_allocator): Likewise.
	(fill_vms_descriptor): Likewise.
	(gnat_build_constructor): Take a VEC instead of a TREE_LIST.
	(compare_elmt_bitpos): Adjust for parameters being constructor_elts
	instead of TREE_LISTs.

From-SVN: r161529
parent 079e7538
2010-06-29 Nathan Froyd <froydnj@codesourcery.com>
* gcc-interface/gigi.h (gnat_build_constructor): Take a VEC instead
of a TREE_LIST. Update comment.
* gcc-interface/trans.c (gigi): Build a VEC instead of a TREE_LIST.
Adjust call to gnat_build_constructor.
(Attribute_to_gnu): Likewise.
(gnat_to_gnu): Likewise.
(pos_to_constructor): Likewise.
(extract_values): Likewise.
* gcc-interface/utils.c (build_template): Likewise.
(convert_vms_descriptor64): Likewise.
(convert_vms_descriptor32): Likewise.
(convert_to_fat_pointer): Likewise.
(convert): Likewise.
(unchecked_convert): Likewise.
* gcc-interface/decl.c (gnat_to_gnu_entity): Likewise.
* gcc-interface/utils2.c (build_allocator): Likewise.
(fill_vms_descriptor): Likewise.
(gnat_build_constructor): Take a VEC instead of a TREE_LIST.
(compare_elmt_bitpos): Adjust for parameters being constructor_elts
instead of TREE_LISTs.
2010-06-28 Steven Bosscher <steven@gcc.gnu.org> 2010-06-28 Steven Bosscher <steven@gcc.gnu.org>
* gcc-interface/misc.c: Do not include except.h. * gcc-interface/misc.c: Do not include except.h.
......
...@@ -1047,15 +1047,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1047,15 +1047,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= TYPE_PADDING_P (gnu_type) = TYPE_PADDING_P (gnu_type)
? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type)))
: TYPE_FIELDS (gnu_type); : TYPE_FIELDS (gnu_type);
gnu_expr VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1);
= gnat_build_constructor tree t = build_template (TREE_TYPE (template_field),
(gnu_type, TREE_TYPE (TREE_CHAIN (template_field)),
tree_cons NULL_TREE);
(template_field, CONSTRUCTOR_APPEND_ELT (v, template_field, t);
build_template (TREE_TYPE (template_field), gnu_expr = gnat_build_constructor (gnu_type, v);
TREE_TYPE (TREE_CHAIN (template_field)),
NULL_TREE),
NULL_TREE));
} }
/* Convert the expression to the type of the object except in the /* Convert the expression to the type of the object except in the
......
...@@ -785,9 +785,9 @@ extern tree build_call_0_expr (tree fundecl); ...@@ -785,9 +785,9 @@ extern tree build_call_0_expr (tree fundecl);
(N_Raise_{Constraint,Storage,Program}_Error). */ (N_Raise_{Constraint,Storage,Program}_Error). */
extern tree build_call_raise (int msg, Node_Id gnat_node, char kind); extern tree build_call_raise (int msg, Node_Id gnat_node, char kind);
/* Return a CONSTRUCTOR of TYPE whose list is LIST. This is not the /* Return a CONSTRUCTOR of TYPE whose elements are V. This is not the
same as build_constructor in the language-independent tree.c. */ same as build_constructor in the language-independent tree.c. */
extern tree gnat_build_constructor (tree type, tree list); extern tree gnat_build_constructor (tree type, VEC(constructor_elt,gc) *v);
/* Return a COMPONENT_REF to access a field that is given by COMPONENT, /* Return a COMPONENT_REF to access a field that is given by COMPONENT,
an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL, an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL,
......
...@@ -545,10 +545,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, ...@@ -545,10 +545,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
if (TARGET_VTABLE_USES_DESCRIPTORS) if (TARGET_VTABLE_USES_DESCRIPTORS)
{ {
tree null_node = fold_convert (ptr_void_ftype, null_pointer_node); tree null_node = fold_convert (ptr_void_ftype, null_pointer_node);
tree field_list = NULL_TREE, null_list = NULL_TREE; tree field_list = NULL_TREE;
int j; int j;
VEC(constructor_elt,gc) *null_vec = NULL;
constructor_elt *elt;
fdesc_type_node = make_node (RECORD_TYPE); fdesc_type_node = make_node (RECORD_TYPE);
VEC_safe_grow (constructor_elt, gc, null_vec,
TARGET_VTABLE_USES_DESCRIPTORS);
elt = (VEC_address (constructor_elt,null_vec)
+ TARGET_VTABLE_USES_DESCRIPTORS - 1);
for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++) for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
{ {
...@@ -557,12 +563,14 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, ...@@ -557,12 +563,14 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
NULL_TREE, NULL_TREE, 0, 1); NULL_TREE, NULL_TREE, 0, 1);
TREE_CHAIN (field) = field_list; TREE_CHAIN (field) = field_list;
field_list = field; field_list = field;
null_list = tree_cons (field, null_node, null_list); elt->index = field;
elt->value = null_node;
elt--;
} }
finish_record_type (fdesc_type_node, nreverse (field_list), 0, false); finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
record_builtin_type ("descriptor", fdesc_type_node); record_builtin_type ("descriptor", fdesc_type_node);
null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list); null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_vec);
} }
long_long_float_type long_long_float_type
...@@ -1231,10 +1239,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) ...@@ -1231,10 +1239,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
else if (TARGET_VTABLE_USES_DESCRIPTORS else if (TARGET_VTABLE_USES_DESCRIPTORS
&& Is_Dispatch_Table_Entity (Etype (gnat_node))) && Is_Dispatch_Table_Entity (Etype (gnat_node)))
{ {
tree gnu_field, gnu_list = NULL_TREE, t; tree gnu_field, t;
/* Descriptors can only be built here for top-level functions. */ /* Descriptors can only be built here for top-level functions. */
bool build_descriptor = (global_bindings_p () != 0); bool build_descriptor = (global_bindings_p () != 0);
int i; int i;
VEC(constructor_elt,gc) *gnu_vec = NULL;
constructor_elt *elt;
gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_result_type = get_unpadded_type (Etype (gnat_node));
...@@ -1249,6 +1259,10 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) ...@@ -1249,6 +1259,10 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
gnu_result = build1 (INDIRECT_REF, gnu_result_type, gnu_result); gnu_result = build1 (INDIRECT_REF, gnu_result_type, gnu_result);
} }
VEC_safe_grow (constructor_elt, gc, gnu_vec,
TARGET_VTABLE_USES_DESCRIPTORS);
elt = (VEC_address (constructor_elt, gnu_vec)
+ TARGET_VTABLE_USES_DESCRIPTORS - 1);
for (gnu_field = TYPE_FIELDS (gnu_result_type), i = 0; for (gnu_field = TYPE_FIELDS (gnu_result_type), i = 0;
i < TARGET_VTABLE_USES_DESCRIPTORS; i < TARGET_VTABLE_USES_DESCRIPTORS;
gnu_field = TREE_CHAIN (gnu_field), i++) gnu_field = TREE_CHAIN (gnu_field), i++)
...@@ -1263,10 +1277,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) ...@@ -1263,10 +1277,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
t = build3 (COMPONENT_REF, ptr_void_ftype, gnu_result, t = build3 (COMPONENT_REF, ptr_void_ftype, gnu_result,
gnu_field, NULL_TREE); gnu_field, NULL_TREE);
gnu_list = tree_cons (gnu_field, t, gnu_list); elt->index = gnu_field;
elt->value = t;
elt--;
} }
gnu_result = gnat_build_constructor (gnu_result_type, gnu_list); gnu_result = gnat_build_constructor (gnu_result_type, gnu_vec);
break; break;
} }
...@@ -3912,24 +3928,21 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3912,24 +3928,21 @@ gnat_to_gnu (Node_Id gnat_node)
String_Id gnat_string = Strval (gnat_node); String_Id gnat_string = Strval (gnat_node);
int length = String_Length (gnat_string); int length = String_Length (gnat_string);
int i; int i;
tree gnu_list = NULL_TREE;
tree gnu_idx = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type)); tree gnu_idx = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
VEC(constructor_elt,gc) *gnu_vec
= VEC_alloc (constructor_elt, gc, length);
for (i = 0; i < length; i++) for (i = 0; i < length; i++)
{ {
gnu_list tree t = build_int_cst (TREE_TYPE (gnu_result_type),
= tree_cons (gnu_idx, Get_String_Char (gnat_string, i + 1));
build_int_cst (TREE_TYPE (gnu_result_type),
Get_String_Char (gnat_string,
i + 1)),
gnu_list);
CONSTRUCTOR_APPEND_ELT (gnu_vec, gnu_idx, t);
gnu_idx = int_const_binop (PLUS_EXPR, gnu_idx, integer_one_node, gnu_idx = int_const_binop (PLUS_EXPR, gnu_idx, integer_one_node,
0); 0);
} }
gnu_result gnu_result = gnat_build_constructor (gnu_result_type, gnu_vec);
= gnat_build_constructor (gnu_result_type, nreverse (gnu_list));
} }
break; break;
...@@ -4317,7 +4330,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4317,7 +4330,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type); gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type);
if (Null_Record_Present (gnat_node)) if (Null_Record_Present (gnat_node))
gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE); gnu_result = gnat_build_constructor (gnu_aggr_type, NULL);
else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
|| TREE_CODE (gnu_aggr_type) == UNION_TYPE) || TREE_CODE (gnu_aggr_type) == UNION_TYPE)
...@@ -7307,9 +7320,9 @@ static tree ...@@ -7307,9 +7320,9 @@ static tree
pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
Entity_Id gnat_component_type) Entity_Id gnat_component_type)
{ {
tree gnu_expr_list = NULL_TREE;
tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type)); tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
tree gnu_expr; tree gnu_expr;
VEC(constructor_elt,gc) *gnu_expr_vec = NULL;
for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr)) for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr))
{ {
...@@ -7332,14 +7345,13 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, ...@@ -7332,14 +7345,13 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty); gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty);
} }
gnu_expr_list CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index,
= tree_cons (gnu_index, convert (TREE_TYPE (gnu_array_type), gnu_expr), convert (TREE_TYPE (gnu_array_type), gnu_expr));
gnu_expr_list);
gnu_index = int_const_binop (PLUS_EXPR, gnu_index, integer_one_node, 0); gnu_index = int_const_binop (PLUS_EXPR, gnu_index, integer_one_node, 0);
} }
return gnat_build_constructor (gnu_array_type, nreverse (gnu_expr_list)); return gnat_build_constructor (gnu_array_type, gnu_expr_vec);
} }
/* Subroutine of assoc_to_constructor: VALUES is a list of field associations, /* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
...@@ -7350,8 +7362,8 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, ...@@ -7350,8 +7362,8 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
static tree static tree
extract_values (tree values, tree record_type) extract_values (tree values, tree record_type)
{ {
tree result = NULL_TREE;
tree field, tem; tree field, tem;
VEC(constructor_elt,gc) *v = NULL;
for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field))
{ {
...@@ -7385,10 +7397,10 @@ extract_values (tree values, tree record_type) ...@@ -7385,10 +7397,10 @@ extract_values (tree values, tree record_type)
if (!value) if (!value)
continue; continue;
result = tree_cons (field, value, result); CONSTRUCTOR_APPEND_ELT (v, field, value);
} }
return gnat_build_constructor (record_type, nreverse (result)); return gnat_build_constructor (record_type, v);
} }
/* EXP is to be treated as an array or record. Handle the cases when it is /* EXP is to be treated as an array or record. Handle the cases when it is
......
...@@ -2222,7 +2222,7 @@ max_size (tree exp, bool max_p) ...@@ -2222,7 +2222,7 @@ max_size (tree exp, bool max_p)
tree tree
build_template (tree template_type, tree array_type, tree expr) build_template (tree template_type, tree array_type, tree expr)
{ {
tree template_elts = NULL_TREE; VEC(constructor_elt,gc) *template_elts = NULL;
tree bound_list = NULL_TREE; tree bound_list = NULL_TREE;
tree field; tree field;
...@@ -2271,11 +2271,11 @@ build_template (tree template_type, tree array_type, tree expr) ...@@ -2271,11 +2271,11 @@ build_template (tree template_type, tree array_type, tree expr)
min = SUBSTITUTE_PLACEHOLDER_IN_EXPR (min, expr); min = SUBSTITUTE_PLACEHOLDER_IN_EXPR (min, expr);
max = SUBSTITUTE_PLACEHOLDER_IN_EXPR (max, expr); max = SUBSTITUTE_PLACEHOLDER_IN_EXPR (max, expr);
template_elts = tree_cons (TREE_CHAIN (field), max, CONSTRUCTOR_APPEND_ELT (template_elts, field, min);
tree_cons (field, min, template_elts)); CONSTRUCTOR_APPEND_ELT (template_elts, TREE_CHAIN (field), max);
} }
return gnat_build_constructor (template_type, nreverse (template_elts)); return gnat_build_constructor (template_type, template_elts);
} }
/* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a /* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a
...@@ -2950,6 +2950,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -2950,6 +2950,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
/* See the head comment of build_vms_descriptor. */ /* See the head comment of build_vms_descriptor. */
int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
tree lfield, ufield; tree lfield, ufield;
VEC(constructor_elt,gc) *v;
/* Convert POINTER to the pointer-to-array type. */ /* Convert POINTER to the pointer-to-array type. */
gnu_expr64 = convert (p_array_type, gnu_expr64); gnu_expr64 = convert (p_array_type, gnu_expr64);
...@@ -2959,14 +2960,15 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -2959,14 +2960,15 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
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. */
v = VEC_alloc (constructor_elt, gc, 2);
t = TREE_CHAIN (TREE_CHAIN (klass)); 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, CONSTRUCTOR_APPEND_ELT (v, min_field,
convert (TREE_TYPE (min_field), integer_one_node), convert (TREE_TYPE (min_field),
tree_cons (max_field, integer_one_node));
convert (TREE_TYPE (max_field), t), CONSTRUCTOR_APPEND_ELT (v, max_field,
NULL_TREE)); convert (TREE_TYPE (max_field), t));
template_tree = gnat_build_constructor (template_type, t); template_tree = gnat_build_constructor (template_type, v);
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. */
...@@ -2990,10 +2992,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -2990,10 +2992,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
(TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
/* Build the template in the form of a constructor. */ /* Build the template in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (template_type), lfield, v = VEC_alloc (constructor_elt, gc, 2);
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (template_type), lfield);
ufield, NULL_TREE)); CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (template_type)),
template_tree = gnat_build_constructor (template_type, t); ufield);
template_tree = gnat_build_constructor (template_type, v);
/* 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,
...@@ -3037,10 +3040,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3037,10 +3040,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
(TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
/* Build the template in the form of a constructor. */ /* Build the template in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (template_type), lfield, v = VEC_alloc (constructor_elt, gc, 2);
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (template_type), lfield);
ufield, NULL_TREE)); CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (template_type)),
template_tree = gnat_build_constructor (template_type, t); ufield);
template_tree = gnat_build_constructor (template_type, v);
template_tree = build3 (COND_EXPR, template_type, u, template_tree = build3 (COND_EXPR, template_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),
...@@ -3057,10 +3061,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3057,10 +3061,11 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
} }
/* Build the fat pointer in the form of a constructor. */ /* Build the fat pointer in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr64, v = VEC_alloc (constructor_elt, gc, 2);
tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)), CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (gnu_type), gnu_expr64);
template_addr, NULL_TREE)); CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (gnu_type)),
return gnat_build_constructor (gnu_type, t); template_addr);
return gnat_build_constructor (gnu_type, v);
} }
else else
...@@ -3098,6 +3103,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3098,6 +3103,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
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 iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
VEC(constructor_elt,gc) *v;
/* Convert POINTER to the pointer-to-array type. */ /* Convert POINTER to the pointer-to-array type. */
gnu_expr32 = convert (p_array_type, gnu_expr32); gnu_expr32 = convert (p_array_type, gnu_expr32);
...@@ -3107,14 +3113,15 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3107,14 +3113,15 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
case 1: /* Class S */ case 1: /* Class S */
case 15: /* Class SB */ case 15: /* Class SB */
/* Build {1, LENGTH} template; LENGTH is the 1st field. */ /* Build {1, LENGTH} template; LENGTH is the 1st field. */
v = VEC_alloc (constructor_elt, gc, 2);
t = TYPE_FIELDS (desc_type); t = TYPE_FIELDS (desc_type);
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, CONSTRUCTOR_APPEND_ELT (v, min_field,
convert (TREE_TYPE (min_field), integer_one_node), convert (TREE_TYPE (min_field),
tree_cons (max_field, integer_one_node));
convert (TREE_TYPE (max_field), t), CONSTRUCTOR_APPEND_ELT (v, max_field,
NULL_TREE)); convert (TREE_TYPE (max_field), t));
template_tree = gnat_build_constructor (template_type, t); template_tree = gnat_build_constructor (template_type, v);
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. */
...@@ -3178,11 +3185,12 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) ...@@ -3178,11 +3185,12 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
} }
/* Build the fat pointer in the form of a constructor. */ /* Build the fat pointer in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr32, v = VEC_alloc (constructor_elt, gc, 2);
tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)), CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (gnu_type), gnu_expr32);
template_addr, NULL_TREE)); CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (gnu_type)),
template_addr);
return gnat_build_constructor (gnu_type, t); return gnat_build_constructor (gnu_type, v);
} }
else else
...@@ -3551,19 +3559,19 @@ convert_to_fat_pointer (tree type, tree expr) ...@@ -3551,19 +3559,19 @@ convert_to_fat_pointer (tree type, tree expr)
tree p_array_type = TREE_TYPE (TYPE_FIELDS (type)); tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
tree etype = TREE_TYPE (expr); tree etype = TREE_TYPE (expr);
tree template_tree; tree template_tree;
VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 2);
/* If EXPR is null, make a fat pointer that contains null pointers to the /* If EXPR is null, make a fat pointer that contains null pointers to the
template and array. */ template and array. */
if (integer_zerop (expr)) if (integer_zerop (expr))
return {
gnat_build_constructor CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
(type, convert (p_array_type, expr));
tree_cons (TYPE_FIELDS (type), CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)),
convert (p_array_type, expr), convert (build_pointer_type (template_type),
tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), expr));
convert (build_pointer_type (template_type), return gnat_build_constructor (type, v);
expr), }
NULL_TREE)));
/* If EXPR is a thin pointer, make template and data from the record.. */ /* If EXPR is a thin pointer, make template and data from the record.. */
else if (TYPE_IS_THIN_POINTER_P (etype)) else if (TYPE_IS_THIN_POINTER_P (etype))
...@@ -3598,15 +3606,12 @@ convert_to_fat_pointer (tree type, tree expr) ...@@ -3598,15 +3606,12 @@ convert_to_fat_pointer (tree type, tree expr)
Note that the call to "build_template" above is still fine because it Note that the call to "build_template" above is still fine because it
will only refer to the provided TEMPLATE_TYPE in this case. */ will only refer to the provided TEMPLATE_TYPE in this case. */
return CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
gnat_build_constructor convert (p_array_type, expr));
(type, CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)),
tree_cons (TYPE_FIELDS (type), build_unary_op (ADDR_EXPR, NULL_TREE,
convert (p_array_type, expr), template_tree));
tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), return gnat_build_constructor (type, v);
build_unary_op (ADDR_EXPR, NULL_TREE,
template_tree),
NULL_TREE)));
} }
/* Convert to a thin pointer type, TYPE. The only thing we know how to convert /* Convert to a thin pointer type, TYPE. The only thing we know how to convert
...@@ -3663,6 +3668,8 @@ convert (tree type, tree expr) ...@@ -3663,6 +3668,8 @@ convert (tree type, tree expr)
constructor to build the record, unless a variable size is involved. */ constructor to build the record, unless a variable size is involved. */
else if (code == RECORD_TYPE && TYPE_PADDING_P (type)) else if (code == RECORD_TYPE && TYPE_PADDING_P (type))
{ {
VEC(constructor_elt,gc) *v;
/* If we previously converted from another type and our type is /* If we previously converted from another type and our type is
of variable size, remove the conversion to avoid the need for of variable size, remove the conversion to avoid the need for
variable-sized temporaries. Likewise for a conversion between variable-sized temporaries. Likewise for a conversion between
...@@ -3713,13 +3720,10 @@ convert (tree type, tree expr) ...@@ -3713,13 +3720,10 @@ convert (tree type, tree expr)
expr), expr),
false); false);
return v = VEC_alloc (constructor_elt, gc, 1);
gnat_build_constructor (type, CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
tree_cons (TYPE_FIELDS (type), convert (TREE_TYPE (TYPE_FIELDS (type)), expr));
convert (TREE_TYPE return gnat_build_constructor (type, v);
(TYPE_FIELDS (type)),
expr),
NULL_TREE));
} }
/* If the input type has padding, remove it and convert to the output type. /* If the input type has padding, remove it and convert to the output type.
...@@ -3771,20 +3775,19 @@ convert (tree type, tree expr) ...@@ -3771,20 +3775,19 @@ convert (tree type, tree expr)
if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type)) if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type))
{ {
tree obj_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); tree obj_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 2);
/* If the source already has a template, get a reference to the /* If the source already has a template, get a reference to the
associated array only, as we are going to rebuild a template associated array only, as we are going to rebuild a template
for the target type anyway. */ for the target type anyway. */
expr = maybe_unconstrained_array (expr); expr = maybe_unconstrained_array (expr);
return CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
gnat_build_constructor build_template (TREE_TYPE (TYPE_FIELDS (type)),
(type, obj_type, NULL_TREE));
tree_cons (TYPE_FIELDS (type), CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)),
build_template (TREE_TYPE (TYPE_FIELDS (type)), convert (obj_type, expr));
obj_type, NULL_TREE), return gnat_build_constructor (type, v);
tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
convert (obj_type, expr), NULL_TREE)));
} }
/* There are some special cases of expressions that we process /* There are some special cases of expressions that we process
...@@ -4114,11 +4117,14 @@ convert (tree type, tree expr) ...@@ -4114,11 +4117,14 @@ convert (tree type, tree expr)
case RECORD_TYPE: case RECORD_TYPE:
if (TYPE_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype)) if (TYPE_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype))
return {
gnat_build_constructor VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1);
(type, tree_cons (TYPE_FIELDS (type),
convert (TREE_TYPE (TYPE_FIELDS (type)), expr), CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
NULL_TREE)); convert (TREE_TYPE (TYPE_FIELDS (type)),
expr));
return gnat_build_constructor (type, v);
}
/* ... fall through ... */ /* ... fall through ... */
...@@ -4410,11 +4416,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) ...@@ -4410,11 +4416,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
tree rec_type = make_node (RECORD_TYPE); tree rec_type = make_node (RECORD_TYPE);
tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type, tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type,
NULL_TREE, NULL_TREE, 1, 0); NULL_TREE, NULL_TREE, 1, 0);
VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1);
TYPE_FIELDS (rec_type) = field; TYPE_FIELDS (rec_type) = field;
layout_type (rec_type); layout_type (rec_type);
expr = gnat_build_constructor (rec_type, build_tree_list (field, expr)); CONSTRUCTOR_APPEND_ELT (v, field, expr);
expr = gnat_build_constructor (rec_type, v);
expr = unchecked_convert (type, expr, notrunc_p); expr = unchecked_convert (type, expr, notrunc_p);
} }
......
...@@ -1521,34 +1521,31 @@ build_call_raise (int msg, Node_Id gnat_node, char kind) ...@@ -1521,34 +1521,31 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
static int static int
compare_elmt_bitpos (const PTR rt1, const PTR rt2) compare_elmt_bitpos (const PTR rt1, const PTR rt2)
{ {
const_tree const elmt1 = * (const_tree const *) rt1; const constructor_elt * const elmt1 = (const constructor_elt const *) rt1;
const_tree const elmt2 = * (const_tree const *) rt2; const constructor_elt * const elmt2 = (const constructor_elt const *) rt2;
const_tree const field1 = TREE_PURPOSE (elmt1); const_tree const field1 = elmt1->index;
const_tree const field2 = TREE_PURPOSE (elmt2); const_tree const field2 = elmt2->index;
const int ret const int ret
= tree_int_cst_compare (bit_position (field1), bit_position (field2)); = tree_int_cst_compare (bit_position (field1), bit_position (field2));
return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2)); return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2));
} }
/* Return a CONSTRUCTOR of TYPE whose list is LIST. */ /* Return a CONSTRUCTOR of TYPE whose elements are V. */
tree tree
gnat_build_constructor (tree type, tree list) gnat_build_constructor (tree type, VEC(constructor_elt,gc) *v)
{ {
bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST); bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
bool side_effects = false; bool side_effects = false;
tree elmt, result; tree result, obj, val;
int n_elmts; unsigned int n_elmts;
/* Scan the elements to see if they are all constant or if any has side /* Scan the elements to see if they are all constant or if any has side
effects, to let us set global flags on the resulting constructor. Count effects, to let us set global flags on the resulting constructor. Count
the elements along the way for possible sorting purposes below. */ the elements along the way for possible sorting purposes below. */
for (n_elmts = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), n_elmts ++) FOR_EACH_CONSTRUCTOR_ELT (v, n_elmts, obj, val)
{ {
tree obj = TREE_PURPOSE (elmt);
tree val = TREE_VALUE (elmt);
/* The predicate must be in keeping with output_constructor. */ /* The predicate must be in keeping with output_constructor. */
if (!TREE_CONSTANT (val) if (!TREE_CONSTANT (val)
|| (TREE_CODE (type) == RECORD_TYPE || (TREE_CODE (type) == RECORD_TYPE
...@@ -1565,27 +1562,10 @@ gnat_build_constructor (tree type, tree list) ...@@ -1565,27 +1562,10 @@ gnat_build_constructor (tree type, tree list)
by increasing bit position. This is necessary to ensure the by increasing bit position. This is necessary to ensure the
constructor can be output as static data. */ constructor can be output as static data. */
if (allconstant && TREE_CODE (type) == RECORD_TYPE && n_elmts > 1) if (allconstant && TREE_CODE (type) == RECORD_TYPE && n_elmts > 1)
{ qsort (VEC_address (constructor_elt, v), n_elmts,
/* Fill an array with an element tree per index, and ask qsort to order sizeof (constructor_elt), compare_elmt_bitpos);
them according to what a bitpos comparison function says. */
tree *gnu_arr = (tree *) alloca (sizeof (tree) * n_elmts);
int i;
for (i = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), i++)
gnu_arr[i] = elmt;
qsort (gnu_arr, n_elmts, sizeof (tree), compare_elmt_bitpos); result = build_constructor (type, v);
/* Then reconstruct the list from the sorted array contents. */
list = NULL_TREE;
for (i = n_elmts - 1; i >= 0; i--)
{
TREE_CHAIN (gnu_arr[i]) = list;
list = gnu_arr[i];
}
}
result = build_constructor_from_list (type, list);
TREE_CONSTANT (result) = TREE_STATIC (result) = allconstant; TREE_CONSTANT (result) = TREE_STATIC (result) = allconstant;
TREE_SIDE_EFFECTS (result) = side_effects; TREE_SIDE_EFFECTS (result) = side_effects;
TREE_READONLY (result) = TYPE_READONLY (type) || allconstant; TREE_READONLY (result) = TYPE_READONLY (type) || allconstant;
...@@ -1986,7 +1966,6 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, ...@@ -1986,7 +1966,6 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type)); tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type));
tree storage_ptr_type = build_pointer_type (storage_type); tree storage_ptr_type = build_pointer_type (storage_type);
tree storage; tree storage;
tree template_cons = NULL_TREE;
size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (storage_type), size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (storage_type),
init); init);
...@@ -2013,12 +1992,12 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, ...@@ -2013,12 +1992,12 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
bounds. */ bounds. */
if (init) if (init)
{ {
template_cons = tree_cons (TREE_CHAIN (TYPE_FIELDS (storage_type)), VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 2);
init, NULL_TREE);
template_cons = tree_cons (TYPE_FIELDS (storage_type), CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (storage_type),
build_template (template_type, type, build_template (template_type, type, init));
init), CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (storage_type)),
template_cons); init);
return convert return convert
(result_type, (result_type,
...@@ -2027,7 +2006,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, ...@@ -2027,7 +2006,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
(MODIFY_EXPR, storage_type, (MODIFY_EXPR, storage_type,
build_unary_op (INDIRECT_REF, NULL_TREE, build_unary_op (INDIRECT_REF, NULL_TREE,
convert (storage_ptr_type, storage)), convert (storage_ptr_type, storage)),
gnat_build_constructor (storage_type, template_cons)), gnat_build_constructor (storage_type, v)),
convert (storage_ptr_type, storage))); convert (storage_ptr_type, storage)));
} }
else else
...@@ -2100,10 +2079,11 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) ...@@ -2100,10 +2079,11 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
{ {
tree parm_decl = get_gnu_tree (gnat_formal); tree parm_decl = get_gnu_tree (gnat_formal);
tree record_type = TREE_TYPE (TREE_TYPE (parm_decl)); tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
tree const_list = NULL_TREE, field; tree field;
const bool do_range_check const bool do_range_check
= strcmp ("MBO", = strcmp ("MBO",
IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type)))); IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
VEC(constructor_elt,gc) *v = NULL;
expr = maybe_unconstrained_array (expr); expr = maybe_unconstrained_array (expr);
gnat_mark_addressable (expr); gnat_mark_addressable (expr);
...@@ -2135,10 +2115,10 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) ...@@ -2135,10 +2115,10 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
N_Raise_Constraint_Error), N_Raise_Constraint_Error),
NULL_TREE)); NULL_TREE));
} }
const_list = tree_cons (field, conexpr, const_list); CONSTRUCTOR_APPEND_ELT (v, field, conexpr);
} }
return gnat_build_constructor (record_type, nreverse (const_list)); return gnat_build_constructor (record_type, v);
} }
/* Indicate that we need to take the address of T and that it therefore /* Indicate that we need to take the address of T and that it therefore
......
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