[gomp] Make VLA types gimplifiable

[Jakub Jelinek <jakub at redhat dot com>]

Hi!

Unlike C/C++ frontends where type size expressions etc. are just
SAVE_EXPRs that for e.g. parameters can be gimplified immediately
at the beginning of the function, Fortran FE uses some artificial
variables in those and those are only initialized in the initial
statements in the function.  Changing that would be too much
work IMHO, as Fortran type sizes can be basically arbitrary Fortran
expressions and all the expression trans-* code relies on being
able to create temporaries, so it won't create one big SAVE_EXPR.
So, we need to gimplify the type sizes right after we know
all the variables they depend on are initialized.
Using gimplify_type_sizes doesn't work at this point, since none of the
variables that are used made through gimplification yet, so
gimplify_type_sizes ICEs on e.g. missing DECL_SEEN_IN_BIND_EXPR_P
flags.  This patch has its own, somewhat simplified version of
gimplify_type_sizes that creates vars etc. the Fortran FE trans-*
way.

Ok for gomp?

This patch relies on the gimplify.c part of
http://gcc.gnu.org/ml/gcc-patches/2005-11/msg00001.html
Richard, can you please commit those 2 hunks?
I haven't played yet with the function.c hunks, they weren't
necessary for any of the tests in the testsuite.  It might work
just fine with this patch, but I haven't tried the function.c hunk
yet.

2005-11-05  Jakub Jelinek  <jakub@redhat.com>

	* trans-decl.c (gfc_trans_dummy_character): Add SYM argument.
	Call gfc_trans_vla_type_sizes.
	(gfc_trans_auto_character_variable): Call gfc_trans_vla_type_sizes.
	(gfc_trans_vla_one_sizepos, gfc_trans_vla_type_sizes_1,
	gfc_trans_vla_type_sizes): New functions.
	(gfc_trans_deferred_vars): Adjust gfc_trans_dummy_character
	callers.  Call gfc_trans_vla_type_sizes on assumed-length
	character parameters.
	* trans-array.c (gfc_trans_array_bounds,
	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias): Call
	gfc_trans_vla_type_sizes.
	* trans.h (gfc_trans_vla_type_sizes): New prototype.

--- gcc/fortran/trans-decl.c.jj	2005-11-01 20:01:13.000000000 +0100
+++ gcc/fortran/trans-decl.c	2005-11-05 11:05:45.000000000 +0100
@@ -2185,7 +2185,7 @@ gfc_build_builtin_function_decls (void)
 /* Evaluate the length of dummy character variables.  */
 
 static tree
-gfc_trans_dummy_character (gfc_charlen * cl, tree fnbody)
+gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl, tree fnbody)
 {
   stmtblock_t body;
 
@@ -2195,7 +2195,9 @@ gfc_trans_dummy_character (gfc_charlen *
 
   /* Evaluate the string length expression.  */
   gfc_trans_init_string_length (cl, &body);
-  
+
+  gfc_trans_vla_type_sizes (sym, &body);
+
   gfc_add_expr_to_block (&body, fnbody);
   return gfc_finish_block (&body);
 }
@@ -2218,6 +2220,8 @@ gfc_trans_auto_character_variable (gfc_s
   /* Evaluate the string length expression.  */
   gfc_trans_init_string_length (sym->ts.cl, &body);
 
+  gfc_trans_vla_type_sizes (sym, &body);
+
   decl = sym->backend_decl;
 
   /* Emit a DECL_EXPR for this variable, which will cause the
@@ -2248,6 +2252,93 @@ gfc_trans_assign_aux_var (gfc_symbol * s
   return gfc_finish_block (&body);
 }
 
+static void
+gfc_trans_vla_one_sizepos (tree *tp, stmtblock_t *body)
+{
+  tree t = *tp, var, val;
+
+  if (t == NULL || t == error_mark_node)
+    return;
+  if (TREE_CONSTANT (t) || DECL_P (t))
+    return;
+
+  if (TREE_CODE (t) == SAVE_EXPR)
+    {
+      if (SAVE_EXPR_RESOLVED_P (t))
+	{
+	  *tp = TREE_OPERAND (t, 0);
+	  return;
+	}
+      val = TREE_OPERAND (t, 0);
+    }
+  else
+    val = t;
+
+  var = gfc_create_var_np (TREE_TYPE (t), NULL);
+  gfc_add_decl_to_function (var);
+  gfc_add_modify_expr (body, var, val);
+  if (TREE_CODE (t) == SAVE_EXPR)
+    TREE_OPERAND (t, 0) = var;
+  *tp = var;
+}
+
+static void
+gfc_trans_vla_type_sizes_1 (tree type, stmtblock_t *body)
+{
+  tree t;
+
+  if (type == NULL || type == error_mark_node)
+    return;
+
+  type = TYPE_MAIN_VARIANT (type);
+
+  if (TREE_CODE (type) == INTEGER_TYPE)
+    {
+      gfc_trans_vla_one_sizepos (&TYPE_MIN_VALUE (type), body);
+      gfc_trans_vla_one_sizepos (&TYPE_MAX_VALUE (type), body);
+
+      for (t = TYPE_NEXT_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
+	{
+	  TYPE_MIN_VALUE (t) = TYPE_MIN_VALUE (type);
+	  TYPE_MAX_VALUE (t) = TYPE_MAX_VALUE (type);
+	}
+    }
+  else if (TREE_CODE (type) == ARRAY_TYPE)
+    {
+      gfc_trans_vla_type_sizes_1 (TREE_TYPE (type), body);
+      gfc_trans_vla_type_sizes_1 (TYPE_DOMAIN (type), body);
+      gfc_trans_vla_one_sizepos (&TYPE_SIZE (type), body);
+      gfc_trans_vla_one_sizepos (&TYPE_SIZE_UNIT (type), body);
+
+      for (t = TYPE_NEXT_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
+	{
+	  TYPE_SIZE (t) = TYPE_SIZE (type);
+	  TYPE_SIZE_UNIT (t) = TYPE_SIZE_UNIT (type);
+	}
+    }
+}
+
+/* Make sure all type sizes and array domains are either constant,
+   or variable or parameter decls.  This is a simplified variant
+   of gimplify_type_sizes, but we can't use it here, as none of the
+   variables in the expressions have been gimplified yet.
+   As type sizes and domains for various variable length arrays
+   contain VAR_DECLs that are only initialized at gfc_trans_deferred_vars
+   time, without this routine gimplify_type_sizes in the middle-end
+   could result in the type sizes being gimplified earlier than where
+   those variables are initialized.  */
+
+void
+gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
+{
+  tree type = TREE_TYPE (sym->backend_decl);
+
+  while (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+
+  gfc_trans_vla_type_sizes_1 (type, body);
+}
+
 
 /* Generate function entry and exit code, and add it to the function body.
    This includes:
@@ -2261,6 +2352,8 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 {
   locus loc;
   gfc_symbol *sym;
+  gfc_formal_arglist *f;
+  stmtblock_t body;
 
   /* Deal with implicit return variables.  Explicit return variables will
      already have been added.  */
@@ -2287,7 +2380,8 @@ gfc_trans_deferred_vars (gfc_symbol * pr
       else if (proc_sym->ts.type == BT_CHARACTER)
 	{
 	  if (TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
-	    fnbody = gfc_trans_dummy_character (proc_sym->ts.cl, fnbody);
+	    fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl,
+						fnbody);
 	}
       else
 	gcc_assert (gfc_option.flag_f2c
@@ -2350,7 +2444,7 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 	  gfc_get_backend_locus (&loc);
 	  gfc_set_backend_locus (&sym->declared_at);
 	  if (sym->attr.dummy || sym->attr.result)
-	    fnbody = gfc_trans_dummy_character (sym->ts.cl, fnbody);
+	    fnbody = gfc_trans_dummy_character (sym, sym->ts.cl, fnbody);
 	  else
 	    fnbody = gfc_trans_auto_character_variable (sym, fnbody);
 	  gfc_set_backend_locus (&loc);
@@ -2366,7 +2460,18 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 	gcc_unreachable ();
     }
 
-  return fnbody;
+  gfc_init_block (&body);
+
+  for (f = proc_sym->formal; f; f = f->next)
+    if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
+      {
+	gcc_assert (f->sym->ts.cl->backend_decl != NULL);
+	if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
+	  gfc_trans_vla_type_sizes (f->sym, &body);
+      }
+
+  gfc_add_expr_to_block (&body, fnbody);
+  return gfc_finish_block (&body);
 }
 
 
--- gcc/fortran/trans-array.c.jj	2005-10-28 23:03:00.000000000 +0200
+++ gcc/fortran/trans-array.c	2005-11-05 10:46:51.000000000 +0100
@@ -3180,6 +3180,8 @@ gfc_trans_array_bounds (tree type, gfc_s
       size = stride;
     }
 
+  gfc_trans_vla_type_sizes (sym, pblock);
+
   *poffset = offset;
   return size;
 }
@@ -3216,6 +3218,8 @@ gfc_trans_auto_array_allocation (tree de
     {
       gfc_trans_init_string_length (sym->ts.cl, &block);
 
+      gfc_trans_vla_type_sizes (sym, &block);
+
       /* Emit a DECL_EXPR for this variable, which will cause the
 	 gimplifier to allocate storage, and all that good stuff.  */
       tmp = build1 (DECL_EXPR, TREE_TYPE (decl), decl);
@@ -3590,6 +3594,8 @@ gfc_trans_dummy_array_bias (gfc_symbol *
   if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
     gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), offset);
 
+  gfc_trans_vla_type_sizes (sym, &block);
+
   stmt = gfc_finish_block (&block);
 
   gfc_start_block (&block);
--- gcc/fortran/trans.h.jj	2005-11-01 20:01:13.000000000 +0100
+++ gcc/fortran/trans.h	2005-11-05 10:48:27.000000000 +0100
@@ -317,6 +317,8 @@ tree gfc_conv_string_tmp (gfc_se *, tree
 tree gfc_get_expr_charlen (gfc_expr *);
 /* Initialize a string length variable.  */
 void gfc_trans_init_string_length (gfc_charlen *, stmtblock_t *);
+/* Ensure type sizes can be gimplified.  */
+void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *);
 
 /* Add an expression to the end of a block.  */
 void gfc_add_expr_to_block (stmtblock_t *, tree);

	Jakub