This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] don't use chainon when building VMS descriptors in Ada FE
- From: Nathan Froyd <froydnj at codesourcery dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Tue, 13 Jul 2010 12:49:05 -0700
- Subject: [PATCH] don't use chainon when building VMS descriptors in Ada FE
This patch gives the Ada FE the same treatment the Fortran and ObjC
frontends have recently undergone: removing chainon when building fields
lists for TYPE_FIELDS. This change eliminates quadratic behavior and
makes a future refactoring of TREE_CHAIN easier.
Tested on x86_64-unknown-linux-gnu. I don't have a VMS machine to test
the changes on, so the goodness of the changes is not exactly
confirmed. At least it builds, right? OK to commit?
-Nathan
* gcc-interface/utils.c (make_descriptor_field): Add tree **
parameter.
(build_vms_descriptor32): Adjust calls to it for new parameter.
(build_vms_descriptor): Likewise.
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 162147)
+++ gcc-interface/utils.c (working copy)
@@ -198,7 +198,7 @@ static tree split_plus (tree, tree *);
static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree);
-static tree make_descriptor_field (const char *,tree, tree, tree);
+static tree make_descriptor_field (const char *,tree, tree, tree, tree **);
static bool potential_alignment_gap (tree, tree, tree);
static void process_attributes (tree, struct attrib *);
@@ -2291,7 +2291,7 @@ build_vms_descriptor32 (tree type, Mecha
{
tree record_type = make_node (RECORD_TYPE);
tree pointer32_type;
- tree field_list = 0;
+ tree field_list = NULL_TREE;
int klass;
int dtype = 0;
tree inner_type;
@@ -2299,6 +2299,7 @@ build_vms_descriptor32 (tree type, Mecha
int i;
tree *idx_arr;
tree tem;
+ tree *field_chain = NULL;
/* If TYPE is an unconstrained array, use the underlying array type. */
if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -2425,34 +2426,27 @@ build_vms_descriptor32 (tree type, Mecha
/* Make the type for a descriptor for VMS. The first four fields are the
same for all types. */
- field_list
- = chainon (field_list,
- make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1),
- record_type,
- size_in_bytes
- ((mech == By_Descriptor_A
- || mech == By_Short_Descriptor_A)
- ? inner_type : type)));
- field_list
- = chainon (field_list,
- make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
- record_type, size_int (dtype)));
- field_list
- = chainon (field_list,
- make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
- record_type, size_int (klass)));
+ field_list =
+ make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1),
+ record_type,
+ size_in_bytes
+ ((mech == By_Descriptor_A
+ || mech == By_Short_Descriptor_A)
+ ? inner_type : type), &field_chain);
+ make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
+ record_type, size_int (dtype), &field_chain);
+ make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
+ record_type, size_int (klass), &field_chain);
/* 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. */
pointer32_type = build_pointer_type_for_mode (type, SImode, false);
- field_list
- = chainon (field_list,
- make_descriptor_field ("POINTER", pointer32_type, record_type,
- build_unary_op (ADDR_EXPR,
- pointer32_type,
- build0 (PLACEHOLDER_EXPR,
- type))));
+ make_descriptor_field ("POINTER", pointer32_type, record_type,
+ build_unary_op (ADDR_EXPR,
+ pointer32_type,
+ build0 (PLACEHOLDER_EXPR,
+ type)), &field_chain);
switch (mech)
{
@@ -2464,59 +2458,41 @@ build_vms_descriptor32 (tree type, Mecha
case By_Descriptor_SB:
case By_Short_Descriptor_SB:
- field_list
- = chainon (field_list,
- make_descriptor_field
- ("SB_L1", gnat_type_for_size (32, 1), record_type,
- TREE_CODE (type) == ARRAY_TYPE
- ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) : size_zero_node));
- field_list
- = chainon (field_list,
- make_descriptor_field
- ("SB_U1", gnat_type_for_size (32, 1), record_type,
- TREE_CODE (type) == ARRAY_TYPE
- ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) : size_zero_node));
+ make_descriptor_field ("SB_L1", gnat_type_for_size (32, 1), record_type,
+ (TREE_CODE (type) == ARRAY_TYPE
+ ? TYPE_MIN_VALUE (TYPE_DOMAIN (type))
+ : size_zero_node), &field_chain);
+ make_descriptor_field ("SB_U1", gnat_type_for_size (32, 1), record_type,
+ (TREE_CODE (type) == ARRAY_TYPE
+ ? TYPE_MAX_VALUE (TYPE_DOMAIN (type))
+ : size_zero_node), &field_chain);
break;
case By_Descriptor_A:
case By_Short_Descriptor_A:
case By_Descriptor_NCA:
case By_Short_Descriptor_NCA:
- field_list = chainon (field_list,
- make_descriptor_field ("SCALE",
- gnat_type_for_size (8, 1),
- record_type,
- size_zero_node));
-
- field_list = chainon (field_list,
- make_descriptor_field ("DIGITS",
- gnat_type_for_size (8, 1),
- record_type,
- size_zero_node));
-
- field_list
- = chainon (field_list,
- make_descriptor_field
- ("AFLAGS", gnat_type_for_size (8, 1), record_type,
- size_int ((mech == By_Descriptor_NCA ||
- mech == By_Short_Descriptor_NCA)
- ? 0
- /* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */
- : (TREE_CODE (type) == ARRAY_TYPE
- && TYPE_CONVENTION_FORTRAN_P (type)
- ? 224 : 192))));
-
- field_list = chainon (field_list,
- make_descriptor_field ("DIMCT",
- gnat_type_for_size (8, 1),
- record_type,
- size_int (ndim)));
-
- field_list = chainon (field_list,
- make_descriptor_field ("ARSIZE",
- gnat_type_for_size (32, 1),
- record_type,
- size_in_bytes (type)));
+ make_descriptor_field ("SCALE", gnat_type_for_size (8, 1),
+ record_type, size_zero_node, &field_chain);
+
+ make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1),
+ record_type, size_zero_node, &field_chain);
+
+ make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1), record_type,
+ size_int ((mech == By_Descriptor_NCA ||
+ mech == By_Short_Descriptor_NCA)
+ ? 0
+ /* Set FL_COLUMN, FL_COEFF, and
+ FL_BOUNDS. */
+ : (TREE_CODE (type) == ARRAY_TYPE
+ && TYPE_CONVENTION_FORTRAN_P (type)
+ ? 224 : 192)), &field_chain);
+
+ make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1),
+ record_type, size_int (ndim), &field_chain);
+
+ make_descriptor_field ("ARSIZE", gnat_type_for_size (32, 1),
+ record_type, size_in_bytes (type), &field_chain);
/* Now build a pointer to the 0,0,0... element. */
tem = build0 (PLACEHOLDER_EXPR, type);
@@ -2526,16 +2502,9 @@ build_vms_descriptor32 (tree type, Mecha
convert (TYPE_DOMAIN (inner_type), size_zero_node),
NULL_TREE, NULL_TREE);
- field_list
- = chainon (field_list,
- make_descriptor_field
- ("A0",
- build_pointer_type_for_mode (inner_type, SImode, false),
- record_type,
- build1 (ADDR_EXPR,
- build_pointer_type_for_mode (inner_type, SImode,
- false),
- tem)));
+ make_descriptor_field ("A0", pointer32_type, record_type,
+ build1 (ADDR_EXPR, pointer32_type, tem),
+ &field_chain);
/* Next come the addressing coefficients. */
tem = size_one_node;
@@ -2553,11 +2522,8 @@ build_vms_descriptor32 (tree type, Mecha
fname[0] = ((mech == By_Descriptor_NCA ||
mech == By_Short_Descriptor_NCA) ? 'S' : 'M');
fname[1] = '0' + i, fname[2] = 0;
- field_list
- = chainon (field_list,
- make_descriptor_field (fname,
- gnat_type_for_size (32, 1),
- record_type, idx_length));
+ make_descriptor_field (fname, gnat_type_for_size (32, 1),
+ record_type, idx_length, &field_chain);
if (mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA)
tem = idx_length;
@@ -2569,18 +2535,14 @@ build_vms_descriptor32 (tree type, Mecha
char fname[3];
fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0;
- field_list
- = chainon (field_list,
- make_descriptor_field
- (fname, gnat_type_for_size (32, 1), record_type,
- TYPE_MIN_VALUE (idx_arr[i])));
+ make_descriptor_field (fname, gnat_type_for_size (32, 1),
+ record_type, TYPE_MIN_VALUE (idx_arr[i]),
+ &field_chain);
fname[0] = 'U';
- field_list
- = chainon (field_list,
- make_descriptor_field
- (fname, gnat_type_for_size (32, 1), record_type,
- TYPE_MAX_VALUE (idx_arr[i])));
+ make_descriptor_field (fname, gnat_type_for_size (32, 1),
+ record_type, TYPE_MAX_VALUE (idx_arr[i]),
+ &field_chain);
}
break;
@@ -2605,7 +2567,7 @@ build_vms_descriptor (tree type, Mechani
{
tree record64_type = make_node (RECORD_TYPE);
tree pointer64_type;
- tree field_list64 = 0;
+ tree field_list64 = NULL_TREE;
int klass;
int dtype = 0;
tree inner_type;
@@ -2613,6 +2575,7 @@ build_vms_descriptor (tree type, Mechani
int i;
tree *idx_arr;
tree tem;
+ tree *field_chain64 = NULL;
/* If TYPE is an unconstrained array, use the underlying array type. */
if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -2735,38 +2698,25 @@ build_vms_descriptor (tree type, Mechani
/* Make the type for a 64-bit descriptor for VMS. The first six fields
are the same for all types. */
field_list64
- = chainon (field_list64,
- make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
- record64_type, size_int (1)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
- record64_type, size_int (dtype)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
- record64_type, size_int (klass)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
- record64_type, ssize_int (-1)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
- record64_type,
- size_in_bytes (mech == By_Descriptor_A
- ? inner_type : type)));
+ = make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
+ record64_type, size_int (1), &field_chain64);
+ make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
+ record64_type, size_int (dtype), &field_chain64);
+ make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
+ record64_type, size_int (klass), &field_chain64);
+ make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
+ record64_type, ssize_int (-1), &field_chain64);
+ make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1), record64_type,
+ size_in_bytes (mech == By_Descriptor_A
+ ? inner_type : type), &field_chain64);
pointer64_type = build_pointer_type_for_mode (type, DImode, false);
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("POINTER", pointer64_type,
- record64_type,
- build_unary_op (ADDR_EXPR,
- pointer64_type,
- build0 (PLACEHOLDER_EXPR,
- type))));
+ make_descriptor_field ("POINTER", pointer64_type, record64_type,
+ build_unary_op (ADDR_EXPR,
+ pointer64_type,
+ build0 (PLACEHOLDER_EXPR,
+ type)), &field_chain64);
switch (mech)
{
@@ -2775,61 +2725,44 @@ build_vms_descriptor (tree type, Mechani
break;
case By_Descriptor_SB:
- field_list64
- = chainon (field_list64,
- make_descriptor_field
- ("SB_L1", gnat_type_for_size (64, 1), record64_type,
- TREE_CODE (type) == ARRAY_TYPE
- ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) : size_zero_node));
- field_list64
- = chainon (field_list64,
- make_descriptor_field
- ("SB_U1", gnat_type_for_size (64, 1), record64_type,
- TREE_CODE (type) == ARRAY_TYPE
- ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) : size_zero_node));
+ make_descriptor_field ("SB_L1", gnat_type_for_size (64, 1),
+ record64_type,
+ (TREE_CODE (type) == ARRAY_TYPE
+ ? TYPE_MIN_VALUE (TYPE_DOMAIN (type))
+ : size_zero_node), &field_chain64);
+ make_descriptor_field ("SB_U1", gnat_type_for_size (64, 1),
+ record64_type,
+ (TREE_CODE (type) == ARRAY_TYPE
+ ? TYPE_MAX_VALUE (TYPE_DOMAIN (type))
+ : size_zero_node), &field_chain64);
break;
case By_Descriptor_A:
case By_Descriptor_NCA:
- field_list64 = chainon (field_list64,
- make_descriptor_field ("SCALE",
- gnat_type_for_size (8, 1),
- record64_type,
- size_zero_node));
-
- field_list64 = chainon (field_list64,
- make_descriptor_field ("DIGITS",
- gnat_type_for_size (8, 1),
- record64_type,
- size_zero_node));
-
- field_list64
- = chainon (field_list64,
- make_descriptor_field
- ("AFLAGS", gnat_type_for_size (8, 1), record64_type,
- size_int (mech == By_Descriptor_NCA
- ? 0
- /* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */
- : (TREE_CODE (type) == ARRAY_TYPE
- && TYPE_CONVENTION_FORTRAN_P (type)
- ? 224 : 192))));
-
- field_list64 = chainon (field_list64,
- make_descriptor_field ("DIMCT",
- gnat_type_for_size (8, 1),
- record64_type,
- size_int (ndim)));
-
- field_list64 = chainon (field_list64,
- make_descriptor_field ("MBZ",
- gnat_type_for_size (32, 1),
- record64_type,
- size_int (0)));
- field_list64 = chainon (field_list64,
- make_descriptor_field ("ARSIZE",
- gnat_type_for_size (64, 1),
- record64_type,
- size_in_bytes (type)));
+ make_descriptor_field ("SCALE", gnat_type_for_size (8, 1),
+ record64_type, size_zero_node, &field_chain64);
+
+ make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1),
+ record64_type, size_zero_node, &field_chain64);
+
+ make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1),
+ record64_type,
+ size_int (mech == By_Descriptor_NCA
+ ? 0
+ /* Set FL_COLUMN, FL_COEFF, and
+ FL_BOUNDS. */
+ : (TREE_CODE (type) == ARRAY_TYPE
+ && TYPE_CONVENTION_FORTRAN_P (type)
+ ? 224 : 192)), &field_chain64);
+
+ make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1),
+ record64_type, size_int (ndim), &field_chain64);
+
+ make_descriptor_field ("MBZ", gnat_type_for_size (32, 1),
+ record64_type, size_int (0), &field_chain64);
+ make_descriptor_field ("ARSIZE", gnat_type_for_size (64, 1),
+ record64_type, size_in_bytes (type),
+ &field_chain64);
/* Now build a pointer to the 0,0,0... element. */
tem = build0 (PLACEHOLDER_EXPR, type);
@@ -2839,16 +2772,9 @@ build_vms_descriptor (tree type, Mechani
convert (TYPE_DOMAIN (inner_type), size_zero_node),
NULL_TREE, NULL_TREE);
- field_list64
- = chainon (field_list64,
- make_descriptor_field
- ("A0",
- build_pointer_type_for_mode (inner_type, DImode, false),
- record64_type,
- build1 (ADDR_EXPR,
- build_pointer_type_for_mode (inner_type, DImode,
- false),
- tem)));
+ make_descriptor_field ("A0", pointer64_type, record64_type,
+ build1 (ADDR_EXPR, pointer64_type, tem),
+ &field_chain64);
/* Next come the addressing coefficients. */
tem = size_one_node;
@@ -2865,11 +2791,8 @@ build_vms_descriptor (tree type, Mechani
fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M');
fname[1] = '0' + i, fname[2] = 0;
- field_list64
- = chainon (field_list64,
- make_descriptor_field (fname,
- gnat_type_for_size (64, 1),
- record64_type, idx_length));
+ make_descriptor_field (fname, gnat_type_for_size (64, 1),
+ record64_type, idx_length, &field_chain64);
if (mech == By_Descriptor_NCA)
tem = idx_length;
@@ -2881,18 +2804,14 @@ build_vms_descriptor (tree type, Mechani
char fname[3];
fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0;
- field_list64
- = chainon (field_list64,
- make_descriptor_field
- (fname, gnat_type_for_size (64, 1), record64_type,
- TYPE_MIN_VALUE (idx_arr[i])));
+ make_descriptor_field (fname, gnat_type_for_size (64, 1),
+ record64_type, TYPE_MIN_VALUE (idx_arr[i]),
+ &field_chain64);
fname[0] = 'U';
- field_list64
- = chainon (field_list64,
- make_descriptor_field
- (fname, gnat_type_for_size (64, 1), record64_type,
- TYPE_MAX_VALUE (idx_arr[i])));
+ make_descriptor_field (fname, gnat_type_for_size (64, 1),
+ record64_type, TYPE_MAX_VALUE (idx_arr[i]),
+ &field_chain64);
}
break;
@@ -2909,12 +2828,16 @@ build_vms_descriptor (tree type, Mechani
static tree
make_descriptor_field (const char *name, tree type,
- tree rec_type, tree initial)
+ tree rec_type, tree initial, tree **chain)
{
tree field
= create_field_decl (get_identifier (name), type, rec_type, NULL_TREE,
NULL_TREE, 0, 0);
+ if (*chain != NULL)
+ **chain = field;
+ *chain = &TREE_CHAIN (field);
+
DECL_INITIAL (field) = initial;
return field;
}