Patchwork Flag-controlled type conversions/promotions

login
register
mail settings
Submitter Andreas Kloeckner
Date Nov. 9, 2011, 11:09 p.m.
Message ID <871utgao55.fsf@ding.tiker.net>
Download mbox | patch
Permalink /patch/124741/
State New
Headers show

Comments

Andreas Kloeckner - Nov. 9, 2011, 11:09 p.m.
Hi there,

please find attached the patch and the Changelog entry for our work on
the fortran bug #48426.

The attached patch implements the options

-finteger-4-integer-8
-freal-4-real-8
-freal-4-real-10
-freal-4-real-16
-freal-8-real-4
-freal-8-real-10
-freal-8-real-16

to implement a variety of automatic type promotions. (This is particularly
helpful if one wants to quickly check whether a certain code has a bug limiting
its precision away from full machine accuracy.)

A similar promotion feature is available in Fujitsu compilers, see here:

http://www.lahey.com/docs/fujitsu%20compiler%20option%20list.pdf

(e.g. -CcR8R16)

The implementation work on this was done by Zydrunas Gimbutas, not by me.
Zydrunas has authorized me to submit this for inclusion in gcc. Both he
and I have gone through the FSF's copyright assignment process and have
current papers for that on file.

We tested the change by running Kahan's Fortran paranoia tests using all
supported conversions, we ran the LINPACK tests (at all supported
conversions) as well as a number of manually-written conversion tests.

Zydrunas and Andreas
Steve Kargl - Dec. 24, 2011, 5:11 p.m.
On Wed, Nov 09, 2011 at 06:09:58PM -0500, Andreas Kloeckner wrote:
> Hi there,
> 
> please find attached the patch and the Changelog entry for our work on
> the fortran bug #48426.
> 
> The attached patch implements the options
> 
> -finteger-4-integer-8
> -freal-4-real-8
> -freal-4-real-10
> -freal-4-real-16
> -freal-8-real-4
> -freal-8-real-10
> -freal-8-real-16
> 
> to implement a variety of automatic type promotions. (This is particularly
> helpful if one wants to quickly check whether a certain code has a bug limiting
> its precision away from full machine accuracy.)
> 
> A similar promotion feature is available in Fujitsu compilers, see here:
> 
> http://www.lahey.com/docs/fujitsu%20compiler%20option%20list.pdf
> 
> (e.g. -CcR8R16)
> 
> The implementation work on this was done by Zydrunas Gimbutas, not by me.
> Zydrunas has authorized me to submit this for inclusion in gcc. Both he
> and I have gone through the FSF's copyright assignment process and have
> current papers for that on file.
> 
> We tested the change by running Kahan's Fortran paranoia tests using all
> supported conversions, we ran the LINPACK tests (at all supported
> conversions) as well as a number of manually-written conversion tests.
> 
> Zydrunas and Andreas

Andreas,

My apologies for letting this feature/patch fall through the
cracks.  I have time over the next few days to review/test/
and commit this patch.  Are there any changes that I need to
known about?

Patch

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 181224)
+++ gcc/fortran/decl.c	(working copy)
@@ -2097,8 +2097,24 @@ 
 	  return MATCH_ERROR;
 	}
       ts->kind /= 2;
+
     }
 
+  if (ts->type == BT_INTEGER)
+    {
+      if( ts->kind == 4 && gfc_option.flag_integer4_kind ==  8) ts->kind =  8;
+    }
+
+  if (ts->type == BT_REAL || ts->type == BT_COMPLEX)
+    {
+      if( ts->kind == 4 && gfc_option.flag_real4_kind ==  8) ts->kind =  8;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 10) ts->kind = 10;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 16) ts->kind = 16;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind ==  4) ts->kind =  4;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 10) ts->kind = 10;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 16) ts->kind = 16;
+    }
+
   if (gfc_validate_kind (ts->type, ts->kind, true) < 0)
     {
       gfc_error ("Old-style type declaration %s*%d not supported at %C",
@@ -2243,6 +2259,22 @@ 
   if(m == MATCH_ERROR)
      gfc_current_locus = where;
   
+
+  if (ts->type == BT_INTEGER)
+    {
+      if( ts->kind == 4 && gfc_option.flag_integer4_kind ==  8) ts->kind =  8;
+    }
+
+  if (ts->type == BT_REAL || ts->type == BT_COMPLEX)
+    {
+      if( ts->kind == 4 && gfc_option.flag_real4_kind ==  8) ts->kind =  8;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 10) ts->kind = 10;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 16) ts->kind = 16;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind ==  4) ts->kind =  4;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 10) ts->kind = 10;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 16) ts->kind = 16;
+    }
+
   /* Return what we know from the test(s).  */
   return m;
 
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 181224)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2215,6 +2215,9 @@ 
   int flag_default_double;
   int flag_default_integer;
   int flag_default_real;
+  int flag_integer4_kind;
+  int flag_real4_kind;
+  int flag_real8_kind;
   int flag_dollar_ok;
   int flag_underscoring;
   int flag_second_underscore;
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt	(revision 181224)
+++ gcc/fortran/lang.opt	(working copy)
@@ -394,6 +394,10 @@ 
 Fortran RejectNegative
 Assume that the source file is fixed form
 
+finteger-4-integer-8
+Fortran RejectNegative
+Interpret any 4-byte integer as an 8-byte integer
+
 fintrinsic-modules-path
 Fortran RejectNegative Joined Separate
 Specify where to find the compiled intrinsic modules
@@ -494,6 +498,30 @@ 
 Fortran
 Enable range checking during compilation
 
+freal-4-real-8
+Fortran RejectNegative
+Interpret any 4-byte real as an 8-byte real
+
+freal-4-real-10
+Fortran RejectNegative
+Interpret any 4-byte real as a 10-byte real
+
+freal-4-real-16
+Fortran RejectNegative
+Interpret any 4-byte real as a 16-byte real
+
+freal-8-real-4
+Fortran RejectNegative
+Interpret any 8-byte real as a 4-byte real
+
+freal-8-real-10
+Fortran RejectNegative
+Interpret any 8-byte real as a 10-byte real
+
+freal-8-real-16
+Fortran RejectNegative
+Interpret any 8-byte real as a 16-byte real
+
 frealloc-lhs
 Fortran
 Reallocate the LHS in assignments
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 181224)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -362,7 +362,7 @@ 
   unsigned int mode;
   int i_index, r_index, kind;
   bool saw_i4 = false, saw_i8 = false;
-  bool saw_r4 = false, saw_r8 = false, saw_r16 = false;
+  bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false;
 
   for (i_index = 0, mode = MIN_MODE_INT; mode <= MAX_MODE_INT; mode++)
     {
@@ -456,6 +456,8 @@ 
 	saw_r4 = true;
       if (kind == 8)
 	saw_r8 = true;
+      if (kind == 10)
+	saw_r10 = true;
       if (kind == 16)
 	saw_r16 = true;
 
@@ -495,6 +497,17 @@ 
 	 be issued when NUMERIC_STORAGE_SIZE is used.  */
       gfc_numeric_storage_size = 4 * 8;
     }
+  else if (saw_i8 && gfc_option.flag_integer4_kind == 8 )
+    {
+      if (!saw_i8)
+	fatal_error ("integer kind=8 not available for -finteger-4-integer-8 option");
+      gfc_default_integer_kind = 8;
+
+      /* Even if the user specified that the default integer kind be 8,
+         the numeric storage size isn't 64.  In this case, a warning will
+	 be issued when NUMERIC_STORAGE_SIZE is used.  */
+      gfc_numeric_storage_size = 4 * 8;
+    }
   else if (saw_i4)
     {
       gfc_default_integer_kind = 4;
@@ -513,6 +526,24 @@ 
 	fatal_error ("real kind=8 not available for -fdefault-real-8 option");
       gfc_default_real_kind = 8;
     }
+  else if (gfc_option.flag_real4_kind == 8 )
+  {
+    if (!saw_r8)
+      fatal_error ("real kind=8 not available for -freal-4-real-8 option");
+    gfc_default_real_kind = 8;
+  }
+  else if (gfc_option.flag_real4_kind == 10 )
+  {
+    if (!saw_r10)
+      fatal_error ("real kind=10 not available for -freal-4-real-10 option");
+    gfc_default_real_kind = 10;
+  }
+  else if (gfc_option.flag_real4_kind == 16 )
+  {
+    if (!saw_r16)
+      fatal_error ("real kind=16 not available for -freal-4-real-16 option");
+    gfc_default_real_kind = 16;
+  }
   else if (saw_r4)
     gfc_default_real_kind = 4;
   else
@@ -529,6 +560,24 @@ 
     gfc_default_double_kind = 8;
   else if (gfc_option.flag_default_real && saw_r16)
     gfc_default_double_kind = 16;
+  else if (gfc_option.flag_real8_kind == 4 )
+  {
+    if (!saw_r4)
+      fatal_error ("real kind=4 not available for -freal-8-real-4 option");
+    gfc_default_double_kind = 4;
+  }
+  else if (gfc_option.flag_real8_kind == 10 )
+  {
+    if (!saw_r10)
+      fatal_error ("real kind=10 not available for -freal-8-real-10 option");
+    gfc_default_double_kind = 10;
+  }
+  else if (gfc_option.flag_real8_kind == 16 )
+  {
+    if (!saw_r16)
+      fatal_error ("real kind=10 not available for -freal-8-real-16 option");
+    gfc_default_double_kind = 16;
+  }
   else if (saw_r4 && saw_r8)
     gfc_default_double_kind = 8;
   else
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 181224)
+++ gcc/fortran/primary.c	(working copy)
@@ -224,6 +224,8 @@ 
   if (kind == -1)
     return MATCH_ERROR;
 
+  if( kind == 4 && gfc_option.flag_integer4_kind ==  8) kind =  8;
+
   if (gfc_validate_kind (BT_INTEGER, kind, true) < 0)
     {
       gfc_error ("Integer kind %d at %C not available", kind);
@@ -636,6 +638,14 @@ 
 	  goto cleanup;
 	}
       kind = gfc_default_double_kind;
+
+      if (kind == 4 && gfc_option.flag_real4_kind ==  8) kind =  8;
+      if (kind == 4 && gfc_option.flag_real4_kind == 10) kind = 10;
+      if (kind == 4 && gfc_option.flag_real4_kind == 16) kind = 16;
+      if (kind == 8 && gfc_option.flag_real8_kind ==  4) kind =  4;
+      if (kind == 8 && gfc_option.flag_real8_kind == 10) kind = 10;
+      if (kind == 8 && gfc_option.flag_real8_kind == 16) kind = 16;
+
       break;
 
     case 'q':
@@ -666,6 +676,13 @@ 
       if (kind == -2)
 	kind = gfc_default_real_kind;
 
+      if (kind == 4 && gfc_option.flag_real4_kind ==  8) kind =  8;
+      if (kind == 4 && gfc_option.flag_real4_kind == 10) kind = 10;
+      if (kind == 4 && gfc_option.flag_real4_kind == 16) kind = 16;
+      if (kind == 8 && gfc_option.flag_real8_kind ==  4) kind =  4;
+      if (kind == 8 && gfc_option.flag_real8_kind == 10) kind = 10;
+      if (kind == 8 && gfc_option.flag_real8_kind == 16) kind = 16;
+
       if (gfc_validate_kind (BT_REAL, kind, true) < 0)
 	{
 	  gfc_error ("Invalid real kind %d at %C", kind);
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c	(revision 181224)
+++ gcc/fortran/options.c	(working copy)
@@ -116,6 +116,9 @@ 
   gfc_option.flag_default_double = 0;
   gfc_option.flag_default_integer = 0;
   gfc_option.flag_default_real = 0;
+  gfc_option.flag_integer4_kind = 0;
+  gfc_option.flag_real4_kind = 0;
+  gfc_option.flag_real8_kind = 0;
   gfc_option.flag_dollar_ok = 0;
   gfc_option.flag_underscoring = 1;
   gfc_option.flag_whole_file = 1;
@@ -849,6 +852,34 @@ 
       gfc_option.flag_default_double = value;
       break;
 
+    case OPT_finteger_4_integer_8:
+      gfc_option.flag_integer4_kind = 8;
+      break;
+
+    case OPT_freal_4_real_8:
+      gfc_option.flag_real4_kind = 8;
+      break;
+
+    case OPT_freal_4_real_10:
+      gfc_option.flag_real4_kind = 10;
+      break;
+
+    case OPT_freal_4_real_16:
+      gfc_option.flag_real4_kind = 16;
+      break;
+
+    case OPT_freal_8_real_4:
+      gfc_option.flag_real8_kind = 4;
+      break;
+
+    case OPT_freal_8_real_10:
+      gfc_option.flag_real8_kind = 10;
+      break;
+
+    case OPT_freal_8_real_16:
+      gfc_option.flag_real8_kind = 16;
+      break;
+
     case OPT_finit_local_zero:
       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
       gfc_option.flag_init_integer_value = 0;