From patchwork Thu Jun 17 19:07:28 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Nathan Froyd X-Patchwork-Id: 56081 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 366B71007D2 for ; Fri, 18 Jun 2010 05:07:48 +1000 (EST) Received: (qmail 8095 invoked by alias); 17 Jun 2010 19:07:46 -0000 Received: (qmail 8079 invoked by uid 22791); 17 Jun 2010 19:07:42 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, TW_TR, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mail.codesourcery.com (HELO mail.codesourcery.com) (38.113.113.100) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 17 Jun 2010 19:07:30 +0000 Received: (qmail 31739 invoked from network); 17 Jun 2010 19:07:28 -0000 Received: from unknown (HELO localhost) (froydnj@127.0.0.2) by mail.codesourcery.com with ESMTPA; 17 Jun 2010 19:07:28 -0000 Date: Thu, 17 Jun 2010 12:07:28 -0700 From: Nathan Froyd To: gcc-patches@gcc.gnu.org Subject: [PATCH, RFC/RFH] remove uses of build_constructor_from_list from Ada FE Message-ID: <20100617190728.GQ27105@codesourcery.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.17+20080114 (2008-01-14) X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org The patch below is a WIP, untested patch to remove build_constructor_from_list from the Ada FE. This project really boils down to changing the interface and callers of gnat_build_constructor appropriately. However, there's one remaining call that I'm not sure what to do about. From gcc-interface/trans.c:Subprogram_Body_to_gnu: gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); if (list_length (gnu_cico_list) == 1) gnu_retval = TREE_VALUE (gnu_cico_list); else gnu_retval = gnat_build_constructor (TREE_TYPE (gnu_subprog_type), gnu_cico_list); TYPE_CI_CO_LIST is defined thusly: /* For a FUNCTION_TYPE, if the subprogram has parameters passed by copy in/ copy out, this is the list of nodes used to specify the return values of the out (or in out) parameters that are passed by copy in/copy out. For a full description of the copy in/copy out parameter passing mechanism refer to the routine gnat_to_gnu_entity. */ #define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE)) Because TYPE_LANG_SLOT_1 exists in middle-end code, changing it is tricky, but probably doable if one were so inclined. I think the options here are: - Change TYPE_LANG_SLOT_1 to a union { tree, VEC }. Redefine accessors appropriately, audit FEs for funny business. Use the VEC member for TYPE_CI_CO_LIST. Update uses of TYPE_CI_CO_LIST. - Write utility function for trans.c (constructor_list_to_vec, perhaps) that puts things in the shiny new VEC format that gnat_build_constructor expects. I think the second one is preferable, but it's not quite as effective in TREE_LIST removal as the first. Are there other options that I've not considered (highly possible), or does the second option seem like the best way forward? Thanks for the comments, -Nathan diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index fb4769b..4f48a45 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1036,15 +1036,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = TYPE_PADDING_P (gnu_type) ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) : TYPE_FIELDS (gnu_type); - gnu_expr - = gnat_build_constructor - (gnu_type, - tree_cons - (template_field, - build_template (TREE_TYPE (template_field), - TREE_TYPE (TREE_CHAIN (template_field)), - NULL_TREE), - NULL_TREE)); + VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1); + tree t = build_template (TREE_TYPE (template_field), + TREE_TYPE (TREE_CHAIN (template_field)), + NULL_TREE); + CONSTRUCTOR_APPEND_ELT (v, template_field, t); + gnu_expr = gnat_build_constructor (gnu_type, t); } /* Convert the expression to the type of the object except in the diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 74a94d7..12b1632 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -785,9 +785,9 @@ extern tree build_call_0_expr (tree fundecl); (N_Raise_{Constraint,Storage,Program}_Error). */ 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. */ -extern tree gnat_build_constructor (tree type, tree list); +extern tree gnat_build_constructor (tree type, VEC(constructor_elt) *v); /* 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, diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index e163d92..314476b 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -546,10 +546,15 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, if (TARGET_VTABLE_USES_DESCRIPTORS) { 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; + VEC(constructor_elt,gc) *null_vec = NULL; + constructor_elt *elt; fdesc_type_node = make_node (RECORD_TYPE); + VEC_safe_grow (constructor_elt, gc, null_vec, + TARGET_VTABLE_USES_DESCRIPTORS); + elt = VEC_address (null_vec) + TARGET_VTABLE_USES_DESCRIPTORS - 1; for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++) { @@ -558,12 +563,14 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, NULL_TREE, NULL_TREE, 0, 1); TREE_CHAIN (field) = field_list; field_list = field; - null_list = tree_cons (field, null_node, null_list); + e->index = field; + e->value = null_node; + e--; } finish_record_type (fdesc_type_node, nreverse (field_list), 0, false); 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 @@ -1232,10 +1239,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) else if (TARGET_VTABLE_USES_DESCRIPTORS && 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. */ bool build_descriptor = (global_bindings_p () != 0); int i; + VEC(constructor_elt,gc) *gnu_vec = NULL; + constructor_elt *elt; gnu_result_type = get_unpadded_type (Etype (gnat_node)); @@ -1250,6 +1259,9 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) 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 (gnu_vec) + TARGET_VTABLE_USES_DESCRIPTORS - 1; for (gnu_field = TYPE_FIELDS (gnu_result_type), i = 0; i < TARGET_VTABLE_USES_DESCRIPTORS; gnu_field = TREE_CHAIN (gnu_field), i++) @@ -1264,10 +1276,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) t = build3 (COMPONENT_REF, ptr_void_ftype, gnu_result, gnu_field, NULL_TREE); - gnu_list = tree_cons (gnu_field, t, gnu_list); + e->index = gnu_field; + e->value = t; + e--; } - gnu_result = gnat_build_constructor (gnu_result_type, gnu_list); + gnu_result = gnat_build_constructor (gnu_result_type, gnu_vec); break; } @@ -3911,24 +3925,21 @@ gnat_to_gnu (Node_Id gnat_node) String_Id gnat_string = Strval (gnat_node); int length = String_Length (gnat_string); int i; - tree gnu_list = NULL_TREE; 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++) { - gnu_list - = tree_cons (gnu_idx, - build_int_cst (TREE_TYPE (gnu_result_type), - Get_String_Char (gnat_string, - i + 1)), - gnu_list); + tree t = build_int_cst (TREE_TYPE (gnu_result_type), + Get_String_Char (gnat_string, i + 1)); + CONSTRUCTOR_APPEND_ELT (gnu_vec, gnu_idx, t); gnu_idx = int_const_binop (PLUS_EXPR, gnu_idx, integer_one_node, 0); } - gnu_result - = gnat_build_constructor (gnu_result_type, nreverse (gnu_list)); + gnu_result = gnat_build_constructor (gnu_result_type, gnu_vec); } break; @@ -4316,7 +4327,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type); 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 || TREE_CODE (gnu_aggr_type) == UNION_TYPE) @@ -7299,9 +7310,9 @@ static tree pos_to_constructor (Node_Id gnat_expr, tree gnu_array_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_expr; + VEC(constructor_elt,gc) *gnu_expr_vec = NULL; for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr)) { @@ -7324,14 +7335,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_list - = tree_cons (gnu_index, convert (TREE_TYPE (gnu_array_type), gnu_expr), - gnu_expr_list); + CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index + convert (TREE_TYPE (gnu_array_type), gnu_expr)) 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, @@ -7342,8 +7352,8 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, static tree extract_values (tree values, tree record_type) { - tree result = NULL_TREE; tree field, tem; + VEC(constructor_elt,gc) *v = NULL; for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) { @@ -7377,10 +7387,10 @@ extract_values (tree values, tree record_type) if (!value) 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 diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 0416db3..9f200c7 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2222,7 +2222,7 @@ max_size (tree exp, bool max_p) tree build_template (tree template_type, tree array_type, tree expr) { - tree template_elts = NULL_TREE; + VEC(constructor_elt,gc) *template_elts = NULL_TREE; tree bound_list = NULL_TREE; tree field; @@ -2271,11 +2271,11 @@ build_template (tree template_type, tree array_type, tree expr) min = SUBSTITUTE_PLACEHOLDER_IN_EXPR (min, expr); max = SUBSTITUTE_PLACEHOLDER_IN_EXPR (max, expr); - template_elts = tree_cons (TREE_CHAIN (field), max, - tree_cons (field, min, template_elts)); + CONSTRUCTOR_APPEND_ELT (template_elts, TREE_CHAIN (field), max); + CONSTRUCTOR_APPEND_ELT (template_elts, field, min); } - 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 @@ -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. */ int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); tree lfield, ufield; + VEC(constructor_elt,gc) *v; /* Convert POINTER to the pointer-to-array type. */ 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) case 1: /* Class S */ case 15: /* Class SB */ /* Build {1, LENGTH} template; LENGTH64 is the 5th field. */ + v = VEC_alloc (constructor_elt, gc, 2); t = TREE_CHAIN (TREE_CHAIN (klass)); t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); - t = tree_cons (min_field, - convert (TREE_TYPE (min_field), integer_one_node), - tree_cons (max_field, - convert (TREE_TYPE (max_field), t), - NULL_TREE)); - template_tree = gnat_build_constructor (template_type, t); + CONSTRUCTOR_APPEND_ELT (v, min_field, + convert (TREE_TYPE (min_field), + integer_one_node)); + CONSTRUCTOR_APPEND_ELT (v, max_field, + convert (TREE_TYPE (max_field), t)); + template_tree = gnat_build_constructor (template_type, v); template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree); /* For class S, we are done. */ @@ -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); /* Build the template in the form of a constructor. */ - t = tree_cons (TYPE_FIELDS (template_type), lfield, - tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), - ufield, NULL_TREE)); - template_tree = gnat_build_constructor (template_type, t); + v = VEC_alloc (constructor_elt, gc, 2); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (template_type), lfield); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (template_type)), + ufield); + template_tree = gnat_build_constructor (template_type, v); /* Otherwise use the {1, LENGTH} template we build above. */ 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) (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); /* Build the template in the form of a constructor. */ - t = tree_cons (TYPE_FIELDS (template_type), lfield, - tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), - ufield, NULL_TREE)); - template_tree = gnat_build_constructor (template_type, t); + v = VEC_alloc (constructor_elt, gc, 2); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (template_type), lfield); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (template_type)), + ufield); + template_tree = gnat_build_constructor (template_type, v); template_tree = build3 (COND_EXPR, template_type, u, build_call_raise (CE_Length_Check_Failed, Empty, N_Raise_Constraint_Error), @@ -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. */ - t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr64, - tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)), - template_addr, NULL_TREE)); - return gnat_build_constructor (gnu_type, t); + v = VEC_alloc (constructor_elt, gc, 2); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (gnu_type), gnu_expr64); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (gnu_type)), + template_addr); + return gnat_build_constructor (gnu_type, v); } else @@ -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; /* See the head comment of build_vms_descriptor. */ int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); + VEC(constructor_elt,gc) *v; /* Convert POINTER to the pointer-to-array type. */ 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) case 1: /* Class S */ case 15: /* Class SB */ /* Build {1, LENGTH} template; LENGTH is the 1st field. */ + v = VEC_alloc (constructor_elt, gc, 2); t = TYPE_FIELDS (desc_type); t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); - t = tree_cons (min_field, - convert (TREE_TYPE (min_field), integer_one_node), - tree_cons (max_field, - convert (TREE_TYPE (max_field), t), - NULL_TREE)); - template_tree = gnat_build_constructor (template_type, t); + CONSTRUCTOR_APPEND_ELT (v, min_field, + convert (TREE_TYPE (min_field), + integer_one_node)); + CONSTRUCTOR_APPEND_ELT (v, max_field, + convert (TREE_TYPE (max_field), t)); + template_tree = gnat_build_constructor (template_type, v); template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree); /* For class S, we are done. */ @@ -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. */ - t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr32, - tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)), - template_addr, NULL_TREE)); + v = VEC_alloc (constructor_elt, gc, 2); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (gnu_type), gnu_expr32); + 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 @@ -3551,19 +3559,19 @@ convert_to_fat_pointer (tree type, tree expr) tree p_array_type = TREE_TYPE (TYPE_FIELDS (type)); tree etype = TREE_TYPE (expr); 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 template and array. */ if (integer_zerop (expr)) - return - gnat_build_constructor - (type, - tree_cons (TYPE_FIELDS (type), - convert (p_array_type, expr), - tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - convert (build_pointer_type (template_type), - expr), - NULL_TREE))); + { + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), + convert (p_array_type, expr)); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)), + convert (build_pointer_type (template_type), + expr)); + return gnat_build_constructor (type, v); + } /* If EXPR is a thin pointer, make template and data from the record.. */ else if (TYPE_IS_THIN_POINTER_P (etype)) @@ -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 will only refer to the provided TEMPLATE_TYPE in this case. */ - return - gnat_build_constructor - (type, - tree_cons (TYPE_FIELDS (type), - convert (p_array_type, expr), - tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - build_unary_op (ADDR_EXPR, NULL_TREE, - template_tree), - NULL_TREE))); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), + convert (p_array_type, expr)); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)), + build_unary_op (ADDR_EXPR, NULL_TREE, + template_tree)); + return gnat_build_constructor (type, v); } /* Convert to a thin pointer type, TYPE. The only thing we know how to convert @@ -3663,6 +3668,8 @@ convert (tree type, tree expr) constructor to build the record, unless a variable size is involved. */ 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 of variable size, remove the conversion to avoid the need for variable-sized temporaries. Likewise for a conversion between @@ -3713,13 +3720,10 @@ convert (tree type, tree expr) expr), false); - return - gnat_build_constructor (type, - tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE - (TYPE_FIELDS (type)), - expr), - NULL_TREE)); + v = VEC_alloc (constructor_elt, gc, 1); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), + convert (TREE_TYPE (TYPE_FIELDS (type)), expr)); + return gnat_build_constructor (type, v); } /* If the input type has padding, remove it and convert to the output type. @@ -3771,20 +3775,19 @@ convert (tree type, tree expr) if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type)) { tree obj_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); + VEC(constructor_elt,gc) = VEC_alloc (constructor_elt, gc, 2); /* If the source already has a template, get a reference to the associated array only, as we are going to rebuild a template for the target type anyway. */ expr = maybe_unconstrained_array (expr); - return - gnat_build_constructor - (type, - tree_cons (TYPE_FIELDS (type), - build_template (TREE_TYPE (TYPE_FIELDS (type)), - obj_type, NULL_TREE), - tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - convert (obj_type, expr), NULL_TREE))); + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), + build_template (TREE_TYPE (TYPE_FIELDS (type)), + obj_type, NULL_TREE)); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)), + convert (obj_type, expr)); + return gnat_build_constructor (type, v); } /* There are some special cases of expressions that we process @@ -4114,11 +4117,14 @@ convert (tree type, tree expr) case RECORD_TYPE: if (TYPE_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype)) - return - gnat_build_constructor - (type, tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE (TYPE_FIELDS (type)), expr), - NULL_TREE)); + { + VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1); + + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), + convert (TREE_TYPE (TYPE_FIELDS (type)), + expr)); + return gnat_build_constructor (type, v); + } /* ... fall through ... */ @@ -4410,11 +4416,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) tree rec_type = make_node (RECORD_TYPE); tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type, NULL_TREE, NULL_TREE, 1, 0); + VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1); TYPE_FIELDS (rec_type) = field; 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); } diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 1c224a3..f0e555b 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -1521,34 +1521,31 @@ build_call_raise (int msg, Node_Id gnat_node, char kind) static int compare_elmt_bitpos (const PTR rt1, const PTR rt2) { - const_tree const elmt1 = * (const_tree const *) rt1; - const_tree const elmt2 = * (const_tree const *) rt2; - const_tree const field1 = TREE_PURPOSE (elmt1); - const_tree const field2 = TREE_PURPOSE (elmt2); + const constructor_elt const *elmt1 = (const constructor_elt const *) rt1; + const constructor_elt const *elmt2 = (const constructor_elt const *) rt2; + const_tree const field1 = elmt1->index; + const_tree const field2 = elmt2->index; const int ret = tree_int_cst_compare (bit_position (field1), bit_position (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 -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 side_effects = false; - tree elmt, result; + tree result, obj, val; int n_elmts; /* 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 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. */ if (!TREE_CONSTANT (val) || (TREE_CODE (type) == RECORD_TYPE @@ -1565,27 +1562,10 @@ gnat_build_constructor (tree type, tree list) by increasing bit position. This is necessary to ensure the constructor can be output as static data. */ if (allconstant && TREE_CODE (type) == RECORD_TYPE && n_elmts > 1) - { - /* Fill an array with an element tree per index, and ask qsort to order - 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 (VEC_address (v), n_elmts, sizeof (constructor_elt), + compare_elmt_bitpos); - qsort (gnu_arr, n_elmts, sizeof (tree), compare_elmt_bitpos); - - /* 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); + result = build_constructor (type, v); TREE_CONSTANT (result) = TREE_STATIC (result) = allconstant; TREE_SIDE_EFFECTS (result) = side_effects; TREE_READONLY (result) = TYPE_READONLY (type) || allconstant; @@ -1987,7 +1967,6 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type)); tree storage_ptr_type = build_pointer_type (storage_type); tree storage; - tree template_cons = NULL_TREE; size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (storage_type), init); @@ -2014,12 +1993,12 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, bounds. */ if (init) { - template_cons = tree_cons (TREE_CHAIN (TYPE_FIELDS (storage_type)), - init, NULL_TREE); - template_cons = tree_cons (TYPE_FIELDS (storage_type), - build_template (template_type, type, - init), - template_cons); + VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 2); + + CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (storage_type), + build_template (template_type, type, init)); + CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (storage_type)), + init); return convert (result_type, @@ -2028,7 +2007,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, (MODIFY_EXPR, storage_type, build_unary_op (INDIRECT_REF, NULL_TREE, convert (storage_ptr_type, storage)), - gnat_build_constructor (storage_type, template_cons)), + gnat_build_constructor (storage_type, v)), convert (storage_ptr_type, storage))); } else @@ -2101,10 +2080,11 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) { tree parm_decl = get_gnu_tree (gnat_formal); tree record_type = TREE_TYPE (TREE_TYPE (parm_decl)); - tree const_list = NULL_TREE, field; + tree field; const bool do_range_check = strcmp ("MBO", IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type)))); + VEC(constructor_elt,gc) *v = NULL; expr = maybe_unconstrained_array (expr); gnat_mark_addressable (expr); @@ -2136,10 +2116,10 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) N_Raise_Constraint_Error), 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