Patchwork [fortran] Add string padding on assignment

login
register
mail settings
Submitter Thomas Koenig
Date Sept. 27, 2010, 6:50 p.m.
Message ID <1285613431.7401.5.camel@linux-fd1f.site>
Download mbox | patch
Permalink /patch/65907/
State New
Headers show

Comments

Thomas Koenig - Sept. 27, 2010, 6:50 p.m.
Hello world,

this patch addresses the case where a constant string is assigned to a
longer string, requiring padding with blanks.  This adds the blanks in
the front end, transforming

character*2 a
a = 'y'


into
character*2 a
a = 'y '

To avoid bloat for strings, I set an arbitrary limit of <8 spaces to be
padded, but of course I'd welcome better suggesionts.

Regression-tested.  OK for trunk with or without a better strategy?

	Thomas

2010-09-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45636
	* frontend-passes.c (optimize_assignment):  In an assignment,
	fill up blanks on the right-hand side if fewer than
	STRING_PAD_LIMIT characters are missing.

2010-09-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45636
	* gfortran.dg/character_pad_1.f90:  New test.
Thomas Koenig - Sept. 30, 2010, 6:17 p.m.
I wrote:

> 
> 2010-09-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
> 	PR fortran/45636
> 	* frontend-passes.c (optimize_assignment):  In an assignment,
> 	fill up blanks on the right-hand side if fewer than
> 	STRING_PAD_LIMIT characters are missing.
> 
> 2010-09-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
> 	PR fortran/45636
> 	* gfortran.dg/character_pad_1.f90:  New test.
> 

Ping?

	Thomas
Jakub Jelinek - Sept. 30, 2010, 6:31 p.m.
On Thu, Sep 30, 2010 at 08:17:06PM +0200, Thomas Koenig wrote:
> I wrote:
> 
> > 
> > 2010-09-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
> > 
> > 	PR fortran/45636
> > 	* frontend-passes.c (optimize_assignment):  In an assignment,
> > 	fill up blanks on the right-hand side if fewer than
> > 	STRING_PAD_LIMIT characters are missing.
> > 
> > 2010-09-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
> > 
> > 	PR fortran/45636
> > 	* gfortran.dg/character_pad_1.f90:  New test.
> > 
> 
> Ping?

I think it would be best to handle this in the middle-end, and if not,
at least use can_store_by_pieces etc. from middle-end to see whether
it is going to be expanded together as a bunch of stores.  Because,
otherwise, .rodata grows.  In your patch you are looking only at the length
of the padding.  Now, if you have a 4KB string in the source and assign it
once to 4KB+1, once to 4KB+2, once to 4KB+3, once 4KB+4, once 4KB+4
character variable, the patch results in 5 ~ 4KB strings in .rodata instead
of just one.

	Jakub

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 164618)
+++ frontend-passes.c	(Arbeitskopie)
@@ -165,10 +165,10 @@  optimize_assignment (gfc_code * c)
   lhs = c->expr1;
   rhs = c->expr2;
 
-  /* Optimize away a = trim(b), where a is a character variable.  */
-
   if (lhs->ts.type == BT_CHARACTER)
     {
+      /* Optimize away a = trim(b), where a is a character variable.  */
+
       if (rhs->expr_type == EXPR_FUNCTION &&
 	  rhs->value.function.isym &&
 	  rhs->value.function.isym->id == GFC_ISYM_TRIM)
@@ -177,8 +177,69 @@  optimize_assignment (gfc_code * c)
 	  optimize_assignment (c);
 	  return;
 	}
+
+      /* Fill up blanks on the right-hand side on assignment, if they extend
+	 the length by less than 8 bytes.  This is an arbitrary limit.*/
+
+#define STRING_PAD_LIMIT 8
+
+      if (rhs->expr_type == EXPR_CONSTANT)
+	{
+	  mpz_t lhs_l, diff;
+	  bool valid_lhs = false;
+
+	  mpz_init (lhs_l);
+	  mpz_init (diff);
+
+	  if (lhs->ref && lhs->ref->type == REF_SUBSTRING)
+	    {
+	      if (lhs->ref->u.ss.start->expr_type == EXPR_CONSTANT
+		  && lhs->ref->u.ss.end->expr_type == EXPR_CONSTANT)
+		{
+		  mpz_sub (lhs_l, lhs->ref->u.ss.end->value.integer,
+			   lhs->ref->u.ss.start->value.integer);
+		  mpz_add_ui (lhs_l, lhs_l, 1u);
+		  valid_lhs = true;
+		}
+	    }
+	  else if (lhs->ts.u.cl->length)
+	    {
+	      mpz_set (lhs_l, lhs->ts.u.cl->length->value.integer);
+	      valid_lhs = true;
+	    }
+
+	  if (valid_lhs)
+	    {
+	      mpz_sub_ui (diff, lhs_l, rhs->value.character.length);
+	      if (mpz_cmp_si (diff, 0) > 0
+		  && mpz_cmp_si (diff, STRING_PAD_LIMIT) < 0)
+		{
+		  long int sz;
+		  int i;
+		  gfc_char_t *v;
+
+		  sz = mpz_get_si (lhs_l);
+		  v = gfc_get_wide_string (sz);
+
+		  memcpy (v, rhs->value.character.string,
+			  rhs->value.character.length*sizeof(gfc_char_t));
+
+		  for (i=rhs->value.character.length; i<sz; i++)
+		    v[i] = ' ';
+
+		  gfc_free (rhs->value.character.string);
+		  rhs->value.character.string = v;
+		  rhs->value.character.length = sz;
+		}
+	    }
+
+	  mpz_clear (lhs_l);
+	  mpz_clear(diff);
+	}
     }
 
+#undef STRING_PAD_LIMIT
+
   if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
     optimize_binop_array_assignment (c, &rhs, false);
 }