trans-array.c (gfc_conv_descriptor_data_get): Rename from gfc_conv_descriptor_data.

        * 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.

From-SVN: r100872

6 files changed, 164 insertions, 120 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a63f475..4bd62d1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,23 @@
+2005-06-12  Richard Henderson  <rth@redhat.com>
+
+	* 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.
+
 2005-06-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
@@ -7,7 +27,7 @@
 	(gfc_return_by_reference): Always look at sym, never at sym->result.
 
 2005-06-11  Steven G. Kargl  <kargls@comcast.net>
-        
+	
 	PR fortran/17792
 	PR fortran/21375
 	* trans-array.c (gfc_array_deallocate): pstat is new argument
@@ -154,7 +174,7 @@
 	dereference the temporary upon return.
 
 2005-05-29  Janne Blomqvist  <jblomqvi@vipunen.hut.fi>
-            Steven G. Kargl  <kargls@comcast.net>
+	    Steven G. Kargl  <kargls@comcast.net>
   
 	fortran/PR20846
 	* io.c (gfc_match_inquire): Implement constraints on UNIT and FILE usage.
@@ -171,7 +191,7 @@
 	(gfc_check_integer_range): Chop extra bits in subnormal numbers.
 
 2005-05-28  Jerry DeLisle   <jvdelisle@verizon.net>
-            Steven G. Kargl  <kargls@comcast.net>
+	    Steven G. Kargl  <kargls@comcast.net>
 
 	* intrinsic.texi: added documentation for BIT_SIZE, BTEST, CHAR, CEILING
 	and CMPLX
@@ -443,7 +463,7 @@
 	* trans-const.c (gfc_conv_mpz_to_tree): Fix comment.
 
 2005-04-19  Arnaud Desitter  <arnaud.desitter@ouce.ox.ac.uk>
-            Steven G. Kargl  <kargls@comcast.net>
+	    Steven G. Kargl  <kargls@comcast.net>
 
 	* invoke.texi: Update -Waliasing description
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index ea5ec52..2060fa1 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -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_loopinfo * loop, gfc_ss_info * info,
   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_loopinfo * loop, gfc_ss_info * info,
 	  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_loopinfo * loop, gfc_ss_info * info,
 	  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_loopinfo * loop, gfc_ss_info * info,
   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 * ref, tree pstat)
 			      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 * ref, tree pstat)
   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, tree pstat)
 
   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 * sym, tree tmpdesc, tree body)
   /* 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 * sym, tree tmpdesc, tree body)
 	
       /* 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, gfc_expr * expr, gfc_ss * ss)
       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 * sym, tree body)
   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 * sym, tree body)
       /* 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 ());
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 95a69f3..377411c 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -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);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index ee6de7e..4395534 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1353,7 +1353,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 		{
 		  /* 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, gfc_component * cm, gfc_expr * expr)
 	{
 	  /* 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 * expr1, gfc_expr * expr2)
       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;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 8a0cfe4..ab498ef 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2189,7 +2189,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *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_expr *expr)
           /* 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));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index c550eec..f0e5453 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -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, gfc_array_spec * as, int packed)
   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, int dimen, tree * lbound,
     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, int dimen, tree * lbound,
 	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, int dimen, tree * lbound,
   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;
 }