restructure array descriptors

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

restructure array descriptors

Richard Henderson-2
This fixes gfortran.fortran-torture/execute/strarray_3.f90 failures on
Alpha.  The problem in this test case is that the array descriptor in
MAIN and foo3 for the A parameter were different types with different
alias sets.  This led the scheduler to move a load past a store.
Hilarity ensues.

Unfortunately we can't quite make do with a *single* instance of a
descriptor (for each rank).  In order to do that, we'd need some other
front-end level data structure to hang on to the ancilliary data that
we currently stuff into lang_type.

So instead I make them variants of one another.  Since they are variants,
they all get the same alias set.  More, casts between them are considered
useless, and are removed.  This allows better optimization at the tree level.
The variants do not differ in any way visible to the generic parts of the
compiler -- only the bits we stuff in lang_type.  And those bits are
irrelevant once we're done with emitting GENERIC.

Please look carefully at gfc_trans_allocate_array_storage.  I'm not sure
that propagating the initial value to info->data is correct.  Should I
be arranging to re-read from the descriptor every time?

Tested on alphaev6 and i686 linux.

Ok?


r~


        * trans-array.c (gfc_conv_descriptor_data_get): Rename from
        gfc_conv_descriptor_data.  Cast the result to the DATAPTR type.
        (gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): New.
        (gfc_trans_allocate_array_storage): Use them.
        (gfc_array_allocate, gfc_array_deallocate): Likewise.
        (gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor): Likewise.
        (gfc_trans_deferred_array): Likewise.
        * trans-expr.c (gfc_conv_function_call): Likewise.
        (gfc_trans_subcomponent_assign): Likewise.
        (gfc_trans_pointer_assignment): Likewise.
        * trans-intrinsic.c (gfc_conv_allocated): Likewise.
        * trans-types.c (gfc_array_descriptor_base): New.
        (gfc_get_element_type): Use GFC_TYPE_ARRAY_DATAPTR_TYPE.
        (gfc_get_array_descriptor_base): Break out from ...
        (gfc_get_array_type_bounds): ... here.  Create type variants.
        * trans-array.h (gfc_conv_descriptor_data_get): Declare.
        (gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): Declare.

Index: trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.48
diff -u -p -d -r1.48 trans-array.c
--- trans-array.c 5 Jun 2005 18:03:40 -0000 1.48
+++ trans-array.c 10 Jun 2005 00:55:37 -0000
@@ -134,22 +134,62 @@ gfc_array_dataptr_type (tree desc)
 #define LBOUND_SUBFIELD 1
 #define UBOUND_SUBFIELD 2
 
+/* This provides READ-ONLY access to the data field.  The field itself
+   doesn't have the proper type.  */
+
 tree
-gfc_conv_descriptor_data (tree desc)
+gfc_conv_descriptor_data_get (tree desc)
 {
-  tree field;
-  tree type;
+  tree field, type, t;
 
   type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   field = TYPE_FIELDS (type);
   gcc_assert (DATA_FIELD == 0);
-  gcc_assert (field != NULL_TREE
-  && TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
-  && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == ARRAY_TYPE);
 
-  return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t);
+
+  return t;
+}
+
+/* This provides WRITE access to the data field.  */
+
+tree
+gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  gfc_add_modify_expr (block, t, fold_convert (TREE_TYPE (field), value));
+
+  return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), value);
+}
+
+
+/* This provides address access to the data field.  This should only be
+   used by array allocation, passing this on to the runtime.  */
+
+tree
+gfc_conv_descriptor_data_addr (tree desc)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  return gfc_build_addr_expr (NULL, t);
 }
 
 tree
@@ -407,18 +447,15 @@ gfc_trans_allocate_array_storage (gfc_lo
   tree tmp;
   tree args;
   tree desc;
-  tree data;
   bool onstack;
 
   desc = info->descriptor;
-  data = gfc_conv_descriptor_data (desc);
+  info->offset = gfc_index_zero_node;
   if (size == NULL_TREE)
     {
       /* A callee allocated array.  */
-      gfc_add_modify_expr (&loop->pre, data, convert (TREE_TYPE (data),
-                                                      gfc_index_zero_node));
-      info->data = data;
-      info->offset = gfc_index_zero_node;
+      gfc_conv_descriptor_data_set (&loop->pre, desc, null_pointer_node);
+      info->data = gfc_conv_descriptor_data_get (desc);
       onstack = FALSE;
     }
   else
@@ -436,11 +473,8 @@ gfc_trans_allocate_array_storage (gfc_lo
   tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
   tmp);
   tmp = gfc_create_var (tmp, "A");
-  tmp = gfc_build_addr_expr (TREE_TYPE (data), tmp);
-  gfc_add_modify_expr (&loop->pre, data, tmp);
-  info->data = data;
-  info->offset = gfc_index_zero_node;
-
+  tmp = gfc_build_addr_expr (NULL, tmp);
+  info->data = gfc_conv_descriptor_data_set (&loop->pre, desc, tmp);
  }
       else
  {
@@ -454,11 +488,8 @@ gfc_trans_allocate_array_storage (gfc_lo
   else
     gcc_unreachable ();
   tmp = gfc_build_function_call (tmp, args);
-  tmp = convert (TREE_TYPE (data), tmp);
-  gfc_add_modify_expr (&loop->pre, data, tmp);
-
-  info->data = data;
-  info->offset = gfc_index_zero_node;
+  tmp = gfc_evaluate_now (tmp, &loop->pre);
+  info->data = gfc_conv_descriptor_data_set (&loop->pre, desc, tmp);
  }
     }
 
@@ -470,7 +501,8 @@ gfc_trans_allocate_array_storage (gfc_lo
   if (!onstack)
     {
       /* Free the temporary.  */
-      tmp = convert (pvoid_type_node, info->data);
+      tmp = gfc_conv_descriptor_data_get (desc);
+      tmp = fold_convert (pvoid_type_node, tmp);
       tmp = gfc_chainon_list (NULL_TREE, tmp);
       tmp = gfc_build_function_call (gfor_fndecl_internal_free, tmp);
       gfc_add_expr_to_block (&loop->post, tmp);
@@ -1308,7 +1340,7 @@ gfc_conv_array_data (tree descriptor)
         }
     }
   else
-    return gfc_conv_descriptor_data (descriptor);
+    return gfc_conv_descriptor_data_get (descriptor);
 }
 
 
@@ -2749,9 +2781,8 @@ gfc_array_allocate (gfc_se * se, gfc_ref
       lower, upper, &se->pre);
 
   /* Allocate memory to store the data.  */
-  tmp = gfc_conv_descriptor_data (se->expr);
-  pointer = gfc_build_addr_expr (NULL, tmp);
-  pointer = gfc_evaluate_now (pointer, &se->pre);
+  tmp = gfc_conv_descriptor_data_addr (se->expr);
+  pointer = gfc_evaluate_now (tmp, &se->pre);
 
   if (TYPE_PRECISION (gfc_array_index_type) == 32)
     allocate = gfor_fndecl_allocate;
@@ -2766,8 +2797,6 @@ gfc_array_allocate (gfc_se * se, gfc_ref
   tmp = gfc_build_function_call (allocate, tmp);
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  pointer = gfc_conv_descriptor_data (se->expr);
-  
   tmp = gfc_conv_descriptor_offset (se->expr);
   gfc_add_modify_expr (&se->pre, tmp, offset);
 }
@@ -2786,10 +2815,8 @@ gfc_array_deallocate (tree descriptor)
 
   gfc_start_block (&block);
   /* Get a pointer to the data.  */
-  tmp = gfc_conv_descriptor_data (descriptor);
-  tmp = gfc_build_addr_expr (NULL, tmp);
-  var = gfc_create_var (TREE_TYPE (tmp), "ptr");
-  gfc_add_modify_expr (&block, var, tmp);
+  tmp = gfc_conv_descriptor_data_addr (descriptor);
+  var = gfc_evaluate_now (tmp, &block);
 
   /* Parameter is the address of the data component.  */
   tmp = gfc_chainon_list (NULL_TREE, var);
@@ -3253,7 +3280,7 @@ gfc_trans_dummy_array_bias (gfc_symbol *
   /* This is for the case where the array data is used directly without
      calling the repack function.  */
   if (no_repack || partial != NULL_TREE)
-    stmt_packed = gfc_conv_descriptor_data (dumdesc);
+    stmt_packed = gfc_conv_descriptor_data_get (dumdesc);
   else
     stmt_packed = NULL_TREE;
 
@@ -3420,7 +3447,7 @@ gfc_trans_dummy_array_bias (gfc_symbol *
 
       /* Only do the cleanup if the array was repacked.  */
       tmp = gfc_build_indirect_ref (dumdesc);
-      tmp = gfc_conv_descriptor_data (tmp);
+      tmp = gfc_conv_descriptor_data_get (tmp);
       tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc);
       stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
 
@@ -3843,10 +3870,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
       tmp = gfc_build_indirect_ref (tmp);
       tmp = gfc_build_array_ref (tmp, offset);
       offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp);
-
-      tmp = gfc_conv_descriptor_data (parm);
-      gfc_add_modify_expr (&loop.pre, tmp,
-   fold_convert (TREE_TYPE (tmp), offset));
+      gfc_conv_descriptor_data_set (&loop.pre, parm, offset);
 
       if (se->direct_byref)
  {
@@ -4013,9 +4037,7 @@ gfc_trans_deferred_array (gfc_symbol * s
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   /* NULLIFY the data pointer.  */
-  tmp = gfc_conv_descriptor_data (descriptor);
-  gfc_add_modify_expr (&fnblock, tmp,
-       convert (TREE_TYPE (tmp), integer_zero_node));
+  gfc_conv_descriptor_data_set (&fnblock, descriptor, null_pointer_node);
 
   gfc_add_expr_to_block (&fnblock, body);
 
@@ -4028,7 +4050,7 @@ gfc_trans_deferred_array (gfc_symbol * s
       /* Deallocate if still allocated at the end of the procedure.  */
       deallocate = gfc_array_deallocate (descriptor);
 
-      tmp = gfc_conv_descriptor_data (descriptor);
+      tmp = gfc_conv_descriptor_data_get (descriptor);
       tmp = build2 (NE_EXPR, boolean_type_node, tmp,
     build_int_cst (TREE_TYPE (tmp), 0));
       tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ());
Index: trans-array.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.h,v
retrieving revision 1.8
diff -u -p -d -r1.8 trans-array.h
--- trans-array.h 12 Mar 2005 21:44:32 -0000 1.8
+++ trans-array.h 10 Jun 2005 00:55:37 -0000
@@ -96,7 +96,9 @@ tree gfc_conv_array_lbound (tree, int);
 tree gfc_conv_array_ubound (tree, int);
 
 /* Build expressions for accessing components of an array descriptor.  */
-tree gfc_conv_descriptor_data (tree);
+tree gfc_conv_descriptor_data_get (tree);
+tree gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
+tree gfc_conv_descriptor_data_addr (tree);
 tree gfc_conv_descriptor_offset (tree);
 tree gfc_conv_descriptor_dtype (tree);
 tree gfc_conv_descriptor_stride (tree, tree);
Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.49
diff -u -p -d -r1.49 trans-expr.c
--- trans-expr.c 1 Jun 2005 07:18:20 -0000 1.49
+++ trans-expr.c 10 Jun 2005 00:55:37 -0000
@@ -1356,7 +1356,7 @@ gfc_conv_function_call (gfc_se * se, gfc
  {
   /* Check the data pointer hasn't been modified.  This would
      happen in a function returning a pointer.  */
-  tmp = gfc_conv_descriptor_data (info->descriptor);
+  tmp = gfc_conv_descriptor_data_get (info->descriptor);
   tmp = build2 (NE_EXPR, boolean_type_node, tmp, info->data);
   gfc_trans_runtime_check (tmp, gfc_strconst_fault, &se->pre);
  }
@@ -1717,12 +1717,7 @@ gfc_trans_subcomponent_assign (tree dest
  {
   /* Array pointer.  */
   if (expr->expr_type == EXPR_NULL)
-    {
-      dest = gfc_conv_descriptor_data (dest);
-      tmp = fold_convert (TREE_TYPE (se.expr),
-  null_pointer_node);
-      gfc_add_modify_expr (&block, dest, tmp);
-    }
+    gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
   else
     {
       rss = gfc_walk_expr (expr);
@@ -2068,11 +2063,7 @@ gfc_trans_pointer_assignment (gfc_expr *
       gfc_conv_expr_descriptor (&lse, expr1, lss);
       /* Implement Nullify.  */
       if (expr2->expr_type == EXPR_NULL)
-        {
-          lse.expr = gfc_conv_descriptor_data (lse.expr);
-          rse.expr = fold_convert (TREE_TYPE (lse.expr), null_pointer_node);
-          gfc_add_modify_expr (&block, lse.expr, rse.expr);
-        }
+ gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node);
       else
         {
           lse.direct_byref = 1;
Index: trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.50
diff -u -p -d -r1.50 trans-intrinsic.c
--- trans-intrinsic.c 26 May 2005 18:36:09 -0000 1.50
+++ trans-intrinsic.c 10 Jun 2005 00:55:38 -0000
@@ -2189,7 +2189,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr
   arg1se.descriptor_only = 1;
   gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
 
-  tmp = gfc_conv_descriptor_data (arg1se.expr);
+  tmp = gfc_conv_descriptor_data_get (arg1se.expr);
   tmp = build2 (NE_EXPR, boolean_type_node, tmp,
  fold_convert (TREE_TYPE (tmp), null_pointer_node));
   se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
@@ -2235,7 +2235,7 @@ gfc_conv_associated (gfc_se *se, gfc_exp
           /* A pointer to an array.  */
           arg1se.descriptor_only = 1;
           gfc_conv_expr_lhs (&arg1se, arg1->expr);
-          tmp2 = gfc_conv_descriptor_data (arg1se.expr);
+          tmp2 = gfc_conv_descriptor_data_get (arg1se.expr);
         }
       tmp = build2 (NE_EXPR, boolean_type_node, tmp2,
     fold_convert (TREE_TYPE (tmp2), null_pointer_node));
Index: trans-types.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.45
diff -u -p -d -r1.45 trans-types.c
--- trans-types.c 26 May 2005 18:36:10 -0000 1.45
+++ trans-types.c 10 Jun 2005 00:55:38 -0000
@@ -59,6 +59,7 @@ tree gfc_charlen_type_node;
 
 static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
+static GTY(()) tree gfc_array_descriptor_base[GFC_MAX_DIMENSIONS];
 
 /* Arrays for all integral and real kinds.  We'll fill this in at runtime
    after the target has a chance to process command-line options.  */
@@ -688,7 +689,7 @@ gfc_get_element_type (tree type)
   else
     {
       gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-      element = TREE_TYPE (TYPE_FIELDS (type));
+      element = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
 
       gcc_assert (TREE_CODE (element) == POINTER_TYPE);
       element = TREE_TYPE (element);
@@ -1095,6 +1096,61 @@ gfc_get_nodesc_array_type (tree etype, g
   return type;
 }
 
+/* Return or create the base type for an array descriptor.  */
+
+static tree
+gfc_get_array_descriptor_base (int dimen)
+{
+  tree fat_type, fieldlist, decl, arraytype;
+  char name[16 + GFC_RANK_DIGITS + 1];
+
+  gcc_assert (dimen >= 1 && dimen <= GFC_MAX_DIMENSIONS);
+  if (gfc_array_descriptor_base[dimen - 1])
+    return gfc_array_descriptor_base[dimen - 1];
+
+  /* Build the type node.  */
+  fat_type = make_node (RECORD_TYPE);
+
+  sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen);
+  TYPE_NAME (fat_type) = get_identifier (name);
+
+  /* Add the data member as the first element of the descriptor.  */
+  decl = build_decl (FIELD_DECL, get_identifier ("data"), ptr_type_node);
+
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = decl;
+
+  /* Add the base component.  */
+  decl = build_decl (FIELD_DECL, get_identifier ("offset"),
+     gfc_array_index_type);
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = chainon (fieldlist, decl);
+
+  /* Add the dtype component.  */
+  decl = build_decl (FIELD_DECL, get_identifier ("dtype"),
+     gfc_array_index_type);
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = chainon (fieldlist, decl);
+
+  /* Build the array type for the stride and bound components.  */
+  arraytype =
+    build_array_type (gfc_get_desc_dim_type (),
+      build_range_type (gfc_array_index_type,
+ gfc_index_zero_node,
+ gfc_rank_cst[dimen - 1]));
+
+  decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = chainon (fieldlist, decl);
+
+  /* Finish off the type.  */
+  TYPE_FIELDS (fat_type) = fieldlist;
+
+  gfc_finish_type (fat_type);
+
+  gfc_array_descriptor_base[dimen - 1] = fat_type;
+  return fat_type;
+}
 
 /* Build an array (descriptor) type with given bounds.  */
 
@@ -1102,25 +1158,13 @@ tree
 gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
    tree * ubound, int packed)
 {
-  tree fat_type, fat_pointer_type;
-  tree fieldlist;
-  tree arraytype;
-  tree decl;
-  int n;
   char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
+  tree fat_type, base_type, arraytype, lower, upper, stride, tmp;
   const char *typename;
-  tree lower;
-  tree upper;
-  tree stride;
-  tree tmp;
+  int n;
 
-  /* Build the type node.  */
-  fat_type = make_node (RECORD_TYPE);
-  GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
-  TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
-    ggc_alloc_cleared (sizeof (struct lang_type));
-  GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
-  GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
+  base_type = gfc_get_array_descriptor_base (dimen);
+  fat_type = build_variant_type_copy (base_type);
 
   tmp = TYPE_NAME (etype);
   if (tmp && TREE_CODE (tmp) == TYPE_DECL)
@@ -1129,20 +1173,22 @@ gfc_get_array_type_bounds (tree etype, i
     typename = IDENTIFIER_POINTER (tmp);
   else
     typename = "unknown";
-
   sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen,
    GFC_MAX_SYMBOL_LEN, typename);
   TYPE_NAME (fat_type) = get_identifier (name);
-  TYPE_PACKED (fat_type) = 0;
 
-  fat_pointer_type = build_pointer_type (fat_type);
+  GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
+  TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
+    ggc_alloc_cleared (sizeof (struct lang_type));
+
+  GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
+  GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
 
   /* Build an array descriptor record type.  */
   if (packed != 0)
     stride = gfc_index_one_node;
   else
     stride = NULL_TREE;
-
   for (n = 0; n < dimen; n++)
     {
       GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
@@ -1183,6 +1229,7 @@ gfc_get_array_type_bounds (tree etype, i
  stride = NULL_TREE;
     }
   GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
+
   /* TODO: known offsets for descriptors.  */
   GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
 
@@ -1193,42 +1240,6 @@ gfc_get_array_type_bounds (tree etype, i
   arraytype = build_pointer_type (arraytype);
   GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
 
-  /* The pointer to the array data.  */
-  decl = build_decl (FIELD_DECL, get_identifier ("data"), arraytype);
-
-  DECL_CONTEXT (decl) = fat_type;
-  /* Add the data member as the first element of the descriptor.  */
-  fieldlist = decl;
-
-  /* Add the base component.  */
-  decl = build_decl (FIELD_DECL, get_identifier ("offset"),
-     gfc_array_index_type);
-  DECL_CONTEXT (decl) = fat_type;
-  fieldlist = chainon (fieldlist, decl);
-
-  /* Add the dtype component.  */
-  decl = build_decl (FIELD_DECL, get_identifier ("dtype"),
-     gfc_array_index_type);
-  DECL_CONTEXT (decl) = fat_type;
-  fieldlist = chainon (fieldlist, decl);
-
-  /* Build the array type for the stride and bound components.  */
-  arraytype =
-    build_array_type (gfc_get_desc_dim_type (),
-      build_range_type (gfc_array_index_type,
- gfc_index_zero_node,
- gfc_rank_cst[dimen - 1]));
-
-  decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);
-  DECL_CONTEXT (decl) = fat_type;
-  DECL_INITIAL (decl) = NULL_TREE;
-  fieldlist = chainon (fieldlist, decl);
-
-  /* Finish off the type.  */
-  TYPE_FIELDS (fat_type) = fieldlist;
-
-  gfc_finish_type (fat_type);
-
   return fat_type;
 }
 
Reply | Threaded
Open this post in threaded view
|

Re: restructure array descriptors

Richard Henderson-2
On Thu, Jun 09, 2005 at 06:29:24PM -0700, Richard Henderson wrote:
> Please look carefully at gfc_trans_allocate_array_storage.  I'm not sure
> that propagating the initial value to info->data is correct.  Should I
> be arranging to re-read from the descriptor every time?

I dropped this bit, so that what gets put into info->data is always
the field.  This should be safe in all cases.  I've committed the
following version of this patch.

Tested on i686-linux too.


r~


        * trans-array.c (gfc_conv_descriptor_data_get): Rename from
        gfc_conv_descriptor_data.  Cast the result to the DATAPTR type.
        (gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): New.
        (gfc_trans_allocate_array_storage): Use them.
        (gfc_array_allocate, gfc_array_deallocate): Likewise.
        (gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor): Likewise.
        (gfc_trans_deferred_array): Likewise.
        * trans-expr.c (gfc_conv_function_call): Likewise.
        (gfc_trans_subcomponent_assign): Likewise.
        (gfc_trans_pointer_assignment): Likewise.
        * trans-intrinsic.c (gfc_conv_allocated): Likewise.
        * trans-types.c (gfc_array_descriptor_base): New.
        (gfc_get_element_type): Use GFC_TYPE_ARRAY_DATAPTR_TYPE.
        (gfc_get_array_descriptor_base): Break out from ...
        (gfc_get_array_type_bounds): ... here.  Create type variants.
        * trans-array.h (gfc_conv_descriptor_data_get): Declare.
        (gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): Declare.

Index: trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.49
diff -u -p -d -r1.49 trans-array.c
--- trans-array.c 11 Jun 2005 22:29:17 -0000 1.49
+++ trans-array.c 13 Jun 2005 06:16:58 -0000
@@ -134,22 +134,60 @@ gfc_array_dataptr_type (tree desc)
 #define LBOUND_SUBFIELD 1
 #define UBOUND_SUBFIELD 2
 
+/* This provides READ-ONLY access to the data field.  The field itself
+   doesn't have the proper type.  */
+
 tree
-gfc_conv_descriptor_data (tree desc)
+gfc_conv_descriptor_data_get (tree desc)
 {
-  tree field;
-  tree type;
+  tree field, type, t;
 
   type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   field = TYPE_FIELDS (type);
   gcc_assert (DATA_FIELD == 0);
-  gcc_assert (field != NULL_TREE
-  && TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
-  && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == ARRAY_TYPE);
 
-  return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t);
+
+  return t;
+}
+
+/* This provides WRITE access to the data field.  */
+
+void
+gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  gfc_add_modify_expr (block, t, fold_convert (TREE_TYPE (field), value));
+}
+
+
+/* This provides address access to the data field.  This should only be
+   used by array allocation, passing this on to the runtime.  */
+
+tree
+gfc_conv_descriptor_data_addr (tree desc)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
+  return gfc_build_addr_expr (NULL, t);
 }
 
 tree
@@ -407,18 +445,14 @@ gfc_trans_allocate_array_storage (gfc_lo
   tree tmp;
   tree args;
   tree desc;
-  tree data;
   bool onstack;
 
   desc = info->descriptor;
-  data = gfc_conv_descriptor_data (desc);
+  info->offset = gfc_index_zero_node;
   if (size == NULL_TREE)
     {
       /* A callee allocated array.  */
-      gfc_add_modify_expr (&loop->pre, data, convert (TREE_TYPE (data),
-                                                      gfc_index_zero_node));
-      info->data = data;
-      info->offset = gfc_index_zero_node;
+      gfc_conv_descriptor_data_set (&loop->pre, desc, null_pointer_node);
       onstack = FALSE;
     }
   else
@@ -436,11 +470,8 @@ gfc_trans_allocate_array_storage (gfc_lo
   tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
   tmp);
   tmp = gfc_create_var (tmp, "A");
-  tmp = gfc_build_addr_expr (TREE_TYPE (data), tmp);
-  gfc_add_modify_expr (&loop->pre, data, tmp);
-  info->data = data;
-  info->offset = gfc_index_zero_node;
-
+  tmp = gfc_build_addr_expr (NULL, tmp);
+  gfc_conv_descriptor_data_set (&loop->pre, desc, tmp);
  }
       else
  {
@@ -454,13 +485,11 @@ gfc_trans_allocate_array_storage (gfc_lo
   else
     gcc_unreachable ();
   tmp = gfc_build_function_call (tmp, args);
-  tmp = convert (TREE_TYPE (data), tmp);
-  gfc_add_modify_expr (&loop->pre, data, tmp);
-
-  info->data = data;
-  info->offset = gfc_index_zero_node;
+  tmp = gfc_evaluate_now (tmp, &loop->pre);
+  gfc_conv_descriptor_data_set (&loop->pre, desc, tmp);
  }
     }
+  info->data = gfc_conv_descriptor_data_get (desc);
 
   /* The offset is zero because we create temporaries with a zero
      lower bound.  */
@@ -470,7 +499,8 @@ gfc_trans_allocate_array_storage (gfc_lo
   if (!onstack)
     {
       /* Free the temporary.  */
-      tmp = convert (pvoid_type_node, info->data);
+      tmp = gfc_conv_descriptor_data_get (desc);
+      tmp = fold_convert (pvoid_type_node, tmp);
       tmp = gfc_chainon_list (NULL_TREE, tmp);
       tmp = gfc_build_function_call (gfor_fndecl_internal_free, tmp);
       gfc_add_expr_to_block (&loop->post, tmp);
@@ -1308,7 +1338,7 @@ gfc_conv_array_data (tree descriptor)
         }
     }
   else
-    return gfc_conv_descriptor_data (descriptor);
+    return gfc_conv_descriptor_data_get (descriptor);
 }
 
 
@@ -2749,9 +2779,8 @@ gfc_array_allocate (gfc_se * se, gfc_ref
       lower, upper, &se->pre);
 
   /* Allocate memory to store the data.  */
-  tmp = gfc_conv_descriptor_data (se->expr);
-  pointer = gfc_build_addr_expr (NULL, tmp);
-  pointer = gfc_evaluate_now (pointer, &se->pre);
+  tmp = gfc_conv_descriptor_data_addr (se->expr);
+  pointer = gfc_evaluate_now (tmp, &se->pre);
 
   if (TYPE_PRECISION (gfc_array_index_type) == 32)
     allocate = gfor_fndecl_allocate;
@@ -2766,8 +2795,6 @@ gfc_array_allocate (gfc_se * se, gfc_ref
   tmp = gfc_build_function_call (allocate, tmp);
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  pointer = gfc_conv_descriptor_data (se->expr);
-  
   tmp = gfc_conv_descriptor_offset (se->expr);
   gfc_add_modify_expr (&se->pre, tmp, offset);
 }
@@ -2786,10 +2813,8 @@ gfc_array_deallocate (tree descriptor, t
 
   gfc_start_block (&block);
   /* Get a pointer to the data.  */
-  tmp = gfc_conv_descriptor_data (descriptor);
-  tmp = gfc_build_addr_expr (NULL, tmp);
-  var = gfc_create_var (TREE_TYPE (tmp), "ptr");
-  gfc_add_modify_expr (&block, var, tmp);
+  tmp = gfc_conv_descriptor_data_addr (descriptor);
+  var = gfc_evaluate_now (tmp, &block);
 
   /* Parameter is the address of the data component.  */
   tmp = gfc_chainon_list (NULL_TREE, var);
@@ -3253,7 +3278,7 @@ gfc_trans_dummy_array_bias (gfc_symbol *
   /* This is for the case where the array data is used directly without
      calling the repack function.  */
   if (no_repack || partial != NULL_TREE)
-    stmt_packed = gfc_conv_descriptor_data (dumdesc);
+    stmt_packed = gfc_conv_descriptor_data_get (dumdesc);
   else
     stmt_packed = NULL_TREE;
 
@@ -3420,7 +3445,7 @@ gfc_trans_dummy_array_bias (gfc_symbol *
 
       /* Only do the cleanup if the array was repacked.  */
       tmp = gfc_build_indirect_ref (dumdesc);
-      tmp = gfc_conv_descriptor_data (tmp);
+      tmp = gfc_conv_descriptor_data_get (tmp);
       tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc);
       stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
 
@@ -3843,10 +3868,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
       tmp = gfc_build_indirect_ref (tmp);
       tmp = gfc_build_array_ref (tmp, offset);
       offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp);
-
-      tmp = gfc_conv_descriptor_data (parm);
-      gfc_add_modify_expr (&loop.pre, tmp,
-   fold_convert (TREE_TYPE (tmp), offset));
+      gfc_conv_descriptor_data_set (&loop.pre, parm, offset);
 
       if (se->direct_byref)
  {
@@ -4013,9 +4035,7 @@ gfc_trans_deferred_array (gfc_symbol * s
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   /* NULLIFY the data pointer.  */
-  tmp = gfc_conv_descriptor_data (descriptor);
-  gfc_add_modify_expr (&fnblock, tmp,
-       convert (TREE_TYPE (tmp), integer_zero_node));
+  gfc_conv_descriptor_data_set (&fnblock, descriptor, null_pointer_node);
 
   gfc_add_expr_to_block (&fnblock, body);
 
@@ -4028,7 +4048,7 @@ gfc_trans_deferred_array (gfc_symbol * s
       /* Deallocate if still allocated at the end of the procedure.  */
       deallocate = gfc_array_deallocate (descriptor, null_pointer_node);
 
-      tmp = gfc_conv_descriptor_data (descriptor);
+      tmp = gfc_conv_descriptor_data_get (descriptor);
       tmp = build2 (NE_EXPR, boolean_type_node, tmp,
     build_int_cst (TREE_TYPE (tmp), 0));
       tmp = build3_v (COND_EXPR, tmp, deallocate, build_empty_stmt ());
Index: trans-array.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.h,v
retrieving revision 1.9
diff -u -p -d -r1.9 trans-array.h
--- trans-array.h 11 Jun 2005 22:29:17 -0000 1.9
+++ trans-array.h 13 Jun 2005 06:16:58 -0000
@@ -96,7 +96,9 @@ tree gfc_conv_array_lbound (tree, int);
 tree gfc_conv_array_ubound (tree, int);
 
 /* Build expressions for accessing components of an array descriptor.  */
-tree gfc_conv_descriptor_data (tree);
+tree gfc_conv_descriptor_data_get (tree);
+void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
+tree gfc_conv_descriptor_data_addr (tree);
 tree gfc_conv_descriptor_offset (tree);
 tree gfc_conv_descriptor_dtype (tree);
 tree gfc_conv_descriptor_stride (tree, tree);
Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.50
diff -u -p -d -r1.50 trans-expr.c
--- trans-expr.c 12 Jun 2005 15:20:54 -0000 1.50
+++ trans-expr.c 13 Jun 2005 06:16:58 -0000
@@ -1353,7 +1353,7 @@ gfc_conv_function_call (gfc_se * se, gfc
  {
   /* Check the data pointer hasn't been modified.  This would
      happen in a function returning a pointer.  */
-  tmp = gfc_conv_descriptor_data (info->descriptor);
+  tmp = gfc_conv_descriptor_data_get (info->descriptor);
   tmp = build2 (NE_EXPR, boolean_type_node, tmp, info->data);
   gfc_trans_runtime_check (tmp, gfc_strconst_fault, &se->pre);
  }
@@ -1714,12 +1714,7 @@ gfc_trans_subcomponent_assign (tree dest
  {
   /* Array pointer.  */
   if (expr->expr_type == EXPR_NULL)
-    {
-      dest = gfc_conv_descriptor_data (dest);
-      tmp = fold_convert (TREE_TYPE (se.expr),
-  null_pointer_node);
-      gfc_add_modify_expr (&block, dest, tmp);
-    }
+    gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
   else
     {
       rss = gfc_walk_expr (expr);
@@ -2065,11 +2060,7 @@ gfc_trans_pointer_assignment (gfc_expr *
       gfc_conv_expr_descriptor (&lse, expr1, lss);
       /* Implement Nullify.  */
       if (expr2->expr_type == EXPR_NULL)
-        {
-          lse.expr = gfc_conv_descriptor_data (lse.expr);
-          rse.expr = fold_convert (TREE_TYPE (lse.expr), null_pointer_node);
-          gfc_add_modify_expr (&block, lse.expr, rse.expr);
-        }
+ gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node);
       else
         {
           lse.direct_byref = 1;
Index: trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.50
diff -u -p -d -r1.50 trans-intrinsic.c
--- trans-intrinsic.c 26 May 2005 18:36:09 -0000 1.50
+++ trans-intrinsic.c 13 Jun 2005 06:16:59 -0000
@@ -2189,7 +2189,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr
   arg1se.descriptor_only = 1;
   gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
 
-  tmp = gfc_conv_descriptor_data (arg1se.expr);
+  tmp = gfc_conv_descriptor_data_get (arg1se.expr);
   tmp = build2 (NE_EXPR, boolean_type_node, tmp,
  fold_convert (TREE_TYPE (tmp), null_pointer_node));
   se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
@@ -2235,7 +2235,7 @@ gfc_conv_associated (gfc_se *se, gfc_exp
           /* A pointer to an array.  */
           arg1se.descriptor_only = 1;
           gfc_conv_expr_lhs (&arg1se, arg1->expr);
-          tmp2 = gfc_conv_descriptor_data (arg1se.expr);
+          tmp2 = gfc_conv_descriptor_data_get (arg1se.expr);
         }
       tmp = build2 (NE_EXPR, boolean_type_node, tmp2,
     fold_convert (TREE_TYPE (tmp2), null_pointer_node));
Index: trans-types.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.46
diff -u -p -d -r1.46 trans-types.c
--- trans-types.c 12 Jun 2005 15:20:55 -0000 1.46
+++ trans-types.c 13 Jun 2005 06:16:59 -0000
@@ -59,6 +59,7 @@ tree gfc_charlen_type_node;
 
 static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
+static GTY(()) tree gfc_array_descriptor_base[GFC_MAX_DIMENSIONS];
 
 /* Arrays for all integral and real kinds.  We'll fill this in at runtime
    after the target has a chance to process command-line options.  */
@@ -688,7 +689,7 @@ gfc_get_element_type (tree type)
   else
     {
       gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-      element = TREE_TYPE (TYPE_FIELDS (type));
+      element = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
 
       gcc_assert (TREE_CODE (element) == POINTER_TYPE);
       element = TREE_TYPE (element);
@@ -1095,6 +1096,61 @@ gfc_get_nodesc_array_type (tree etype, g
   return type;
 }
 
+/* Return or create the base type for an array descriptor.  */
+
+static tree
+gfc_get_array_descriptor_base (int dimen)
+{
+  tree fat_type, fieldlist, decl, arraytype;
+  char name[16 + GFC_RANK_DIGITS + 1];
+
+  gcc_assert (dimen >= 1 && dimen <= GFC_MAX_DIMENSIONS);
+  if (gfc_array_descriptor_base[dimen - 1])
+    return gfc_array_descriptor_base[dimen - 1];
+
+  /* Build the type node.  */
+  fat_type = make_node (RECORD_TYPE);
+
+  sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen);
+  TYPE_NAME (fat_type) = get_identifier (name);
+
+  /* Add the data member as the first element of the descriptor.  */
+  decl = build_decl (FIELD_DECL, get_identifier ("data"), ptr_type_node);
+
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = decl;
+
+  /* Add the base component.  */
+  decl = build_decl (FIELD_DECL, get_identifier ("offset"),
+     gfc_array_index_type);
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = chainon (fieldlist, decl);
+
+  /* Add the dtype component.  */
+  decl = build_decl (FIELD_DECL, get_identifier ("dtype"),
+     gfc_array_index_type);
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = chainon (fieldlist, decl);
+
+  /* Build the array type for the stride and bound components.  */
+  arraytype =
+    build_array_type (gfc_get_desc_dim_type (),
+      build_range_type (gfc_array_index_type,
+ gfc_index_zero_node,
+ gfc_rank_cst[dimen - 1]));
+
+  decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);
+  DECL_CONTEXT (decl) = fat_type;
+  fieldlist = chainon (fieldlist, decl);
+
+  /* Finish off the type.  */
+  TYPE_FIELDS (fat_type) = fieldlist;
+
+  gfc_finish_type (fat_type);
+
+  gfc_array_descriptor_base[dimen - 1] = fat_type;
+  return fat_type;
+}
 
 /* Build an array (descriptor) type with given bounds.  */
 
@@ -1102,25 +1158,13 @@ tree
 gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
    tree * ubound, int packed)
 {
-  tree fat_type, fat_pointer_type;
-  tree fieldlist;
-  tree arraytype;
-  tree decl;
-  int n;
   char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
+  tree fat_type, base_type, arraytype, lower, upper, stride, tmp;
   const char *typename;
-  tree lower;
-  tree upper;
-  tree stride;
-  tree tmp;
+  int n;
 
-  /* Build the type node.  */
-  fat_type = make_node (RECORD_TYPE);
-  GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
-  TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
-    ggc_alloc_cleared (sizeof (struct lang_type));
-  GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
-  GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
+  base_type = gfc_get_array_descriptor_base (dimen);
+  fat_type = build_variant_type_copy (base_type);
 
   tmp = TYPE_NAME (etype);
   if (tmp && TREE_CODE (tmp) == TYPE_DECL)
@@ -1129,20 +1173,22 @@ gfc_get_array_type_bounds (tree etype, i
     typename = IDENTIFIER_POINTER (tmp);
   else
     typename = "unknown";
-
   sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen,
    GFC_MAX_SYMBOL_LEN, typename);
   TYPE_NAME (fat_type) = get_identifier (name);
-  TYPE_PACKED (fat_type) = 0;
 
-  fat_pointer_type = build_pointer_type (fat_type);
+  GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
+  TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
+    ggc_alloc_cleared (sizeof (struct lang_type));
+
+  GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
+  GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
 
   /* Build an array descriptor record type.  */
   if (packed != 0)
     stride = gfc_index_one_node;
   else
     stride = NULL_TREE;
-
   for (n = 0; n < dimen; n++)
     {
       GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
@@ -1183,6 +1229,7 @@ gfc_get_array_type_bounds (tree etype, i
  stride = NULL_TREE;
     }
   GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
+
   /* TODO: known offsets for descriptors.  */
   GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
 
@@ -1193,42 +1240,6 @@ gfc_get_array_type_bounds (tree etype, i
   arraytype = build_pointer_type (arraytype);
   GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
 
-  /* The pointer to the array data.  */
-  decl = build_decl (FIELD_DECL, get_identifier ("data"), arraytype);
-
-  DECL_CONTEXT (decl) = fat_type;
-  /* Add the data member as the first element of the descriptor.  */
-  fieldlist = decl;
-
-  /* Add the base component.  */
-  decl = build_decl (FIELD_DECL, get_identifier ("offset"),
-     gfc_array_index_type);
-  DECL_CONTEXT (decl) = fat_type;
-  fieldlist = chainon (fieldlist, decl);
-
-  /* Add the dtype component.  */
-  decl = build_decl (FIELD_DECL, get_identifier ("dtype"),
-     gfc_array_index_type);
-  DECL_CONTEXT (decl) = fat_type;
-  fieldlist = chainon (fieldlist, decl);
-
-  /* Build the array type for the stride and bound components.  */
-  arraytype =
-    build_array_type (gfc_get_desc_dim_type (),
-      build_range_type (gfc_array_index_type,
- gfc_index_zero_node,
- gfc_rank_cst[dimen - 1]));
-
-  decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);
-  DECL_CONTEXT (decl) = fat_type;
-  DECL_INITIAL (decl) = NULL_TREE;
-  fieldlist = chainon (fieldlist, decl);
-
-  /* Finish off the type.  */
-  TYPE_FIELDS (fat_type) = fieldlist;
-
-  gfc_finish_type (fat_type);
-
   return fat_type;
 }