Patchwork don't use chainon when building VMS descriptors in Ada FE

login
register
mail settings
Submitter Nathan Froyd
Date July 13, 2010, 7:49 p.m.
Message ID <20100713194905.GK12333@codesourcery.com>
Download mbox | patch
Permalink /patch/58812/
State New
Headers show

Comments

Nathan Froyd - July 13, 2010, 7:49 p.m.
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.
Eric Botcazou - July 20, 2010, 5:36 p.m.
> 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.

The usage of chainon is indeed bogus here.  The canonical way of building 
field lists in gigi is to prepend fields and call nreverse at the end.

Patch

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;
 }