arith.c: Include system.h, not real system headers.

        * arith.c: Include system.h, not real system headers.
        (MPZ_NULL, MPF_NULL, DEF_GFC_INTEGER_KIND, DEF_GFC_LOGICAL_KIND,
        DEF_GFC_REAL_KIND, GFC_SP_KIND, GFC_SP_PREC, GFC_SP_EMIN, GFC_SP_EMAX,
        GFC_DP_KIND, GFC_DP_PREC, GFC_DP_EMIN, GFC_DP_EMAX, GFC_QP_KIND,
        GFC_QP_PREC, GFC_QP_EMIN, GFC_QP_EMAX): Remove.
        (gfc_integer_kinds, gfc_logical_kinds, gfc_real_kinds,
        gfc_index_integer_kind, gfc_default_integer_kind,
        gfc_default_real_kind,gfc_default_double_kind,
        gfc_default_character_kind, gfc_default_logical_kind,
        gfc_default_complex_kind, validate_integer, validate_real,
        validate_logical, validate_character,
        gfc_validate_kind): Move to trans-types.c.
        (gfc_set_model_kind): Use gfc_validate_kind.
        (gfc_set_model): Just copy the current precision to default.
        (gfc_arith_init_1): Use mpfr precision 128 for integer setup.
        * f95-lang.c (gfc_init_decl_processing): Invoke gfc_init_kinds.
        * gfortran.h: Update file commentary.
        * trans-types.c (MAX_INT_KINDS, MAX_REAL_KINDS): New.
        (gfc_default_integer_kind_1, gfc_default_real_kind_1,
        gfc_default_double_kind_1, gfc_default_character_kind_1,
        gfc_default_logical_kind_1, gfc_default_complex_kind_1): New.
        (gfc_init_kinds): New.
        (gfc_init_types): Don't set gfc_index_integer_kind here.
        * trans-types.h (gfc_init_kinds): Declare.
        * doc/invoke.texi: Clarify DOUBLE PRECISION behaviour wrt -r8.

From-SVN: r86637

1 files changed, 10 insertions, 251 deletions

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index ec19682..85f5138 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -26,82 +26,10 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
    and this file provides the interface.  */
 
 #include "config.h"
-
-#include <string.h>
-
+#include "system.h"
 #include "gfortran.h"
 #include "arith.h"
 
-/* The gfc_(integer|real)_kinds[] structures have everything the front
-   end needs to know about integers and real numbers on the target.
-   Other entries of the structure are calculated from these values.
-   The first entry is the default kind, the second entry of the real
-   structure is the default double kind.  */
-
-#define MPZ_NULL {{0,0,0}}
-#define MPF_NULL {{0,0,0,0}}
-
-#define DEF_GFC_INTEGER_KIND(KIND,RADIX,DIGITS,BIT_SIZE)		\
-	{KIND, RADIX, DIGITS, BIT_SIZE, 0, MPZ_NULL, MPZ_NULL, MPZ_NULL}
-
-#define DEF_GFC_LOGICAL_KIND(KIND,BIT_SIZE)				\
-	{KIND, BIT_SIZE}
-
-#define DEF_GFC_REAL_KIND(KIND,RADIX,DIGITS,MIN_EXP, MAX_EXP)		\
-	{KIND, RADIX, DIGITS, MIN_EXP, MAX_EXP,				\
-	 0, 0, MPF_NULL, MPF_NULL, MPF_NULL}
-
-gfc_integer_info gfc_integer_kinds[] = {
-  DEF_GFC_INTEGER_KIND (4, 2, 31, 32),
-  DEF_GFC_INTEGER_KIND (8, 2, 63, 64),
-  DEF_GFC_INTEGER_KIND (2, 2, 15, 16),
-  DEF_GFC_INTEGER_KIND (1, 2,  7,  8),
-  DEF_GFC_INTEGER_KIND (0, 0,  0,  0)
-};
-
-gfc_logical_info gfc_logical_kinds[] = {
-  DEF_GFC_LOGICAL_KIND (4, 32),
-  DEF_GFC_LOGICAL_KIND (8, 64),
-  DEF_GFC_LOGICAL_KIND (2, 16),
-  DEF_GFC_LOGICAL_KIND (1,  8),
-  DEF_GFC_LOGICAL_KIND (0,  0)
-};
-
-
-/* IEEE-754 uses 1.xEe representation whereas the fortran standard
-   uses 0.xEe representation.  Hence the exponents below are biased
-   by one.  */
-
-#define GFC_SP_KIND      4
-#define GFC_SP_PREC     24   /* p    =   24, IEEE-754  */
-#define GFC_SP_EMIN   -125   /* emin = -126, IEEE-754  */
-#define GFC_SP_EMAX    128   /* emin =  127, IEEE-754  */
-
-/* Double precision model numbers.  */
-#define GFC_DP_KIND      8
-#define GFC_DP_PREC     53   /* p    =    53, IEEE-754  */
-#define GFC_DP_EMIN  -1021   /* emin = -1022, IEEE-754  */
-#define GFC_DP_EMAX   1024   /* emin =  1023, IEEE-754  */
-
-/* Quad precision model numbers.  Not used.  */
-#define GFC_QP_KIND     16
-#define GFC_QP_PREC    113   /* p    =    113, IEEE-754  */
-#define GFC_QP_EMIN -16381   /* emin = -16382, IEEE-754  */
-#define GFC_QP_EMAX  16384   /* emin =  16383, IEEE-754  */
-
-gfc_real_info gfc_real_kinds[] = {
-  DEF_GFC_REAL_KIND (GFC_SP_KIND, 2, GFC_SP_PREC, GFC_SP_EMIN, GFC_SP_EMAX),
-  DEF_GFC_REAL_KIND (GFC_DP_KIND, 2, GFC_DP_PREC, GFC_DP_EMIN, GFC_DP_EMAX),
-  DEF_GFC_REAL_KIND (0, 0,  0,     0,    0)
-};
-
-
-/* The integer kind to use for array indices.  This will be set to the
-   proper value based on target information from the backend.  */
-
-int gfc_index_integer_kind;
-
-
 /* MPFR does not have a direct replacement for mpz_set_f() from GMP.
    It's easily implemented with a few calls though.  */
 
@@ -128,20 +56,13 @@ gfc_mpfr_to_mpz (mpz_t z, mpfr_t x)
 void
 gfc_set_model_kind (int kind)
 {
-  switch (kind)
-	{
-    case GFC_SP_KIND:
-      mpfr_set_default_prec (GFC_SP_PREC);
-      break;
-    case GFC_DP_KIND:
-      mpfr_set_default_prec (GFC_DP_PREC);
-      break;
-    case GFC_QP_KIND:
-      mpfr_set_default_prec (GFC_QP_PREC);
-      break;
-    default:
-      gfc_internal_error ("gfc_set_model_kind(): Bad model number");
-    }
+  int index = gfc_validate_kind (BT_REAL, kind, false);
+  int base2prec;
+
+  base2prec = gfc_real_kinds[index].digits;
+  if (gfc_real_kinds[index].radix != 2)
+    base2prec *= gfc_real_kinds[index].radix / 2;
+  mpfr_set_default_prec (base2prec);
 }
 
 
@@ -150,20 +71,7 @@ gfc_set_model_kind (int kind)
 void
 gfc_set_model (mpfr_t x)
 {
-  switch (mpfr_get_prec (x))
-    {
-    case GFC_SP_PREC:
-      mpfr_set_default_prec (GFC_SP_PREC);
-      break;
-    case GFC_DP_PREC:
-      mpfr_set_default_prec (GFC_DP_PREC);
-      break;
-    case GFC_QP_PREC:
-      mpfr_set_default_prec (GFC_QP_PREC);
-      break;
-    default:
-      gfc_internal_error ("gfc_set_model(): Bad model number");
-    }
+  mpfr_set_default_prec (mpfr_get_prec (x));
 }
 
 /* Calculate atan2 (y, x)
@@ -268,8 +176,7 @@ gfc_arith_init_1 (void)
   mpz_t r;
   int i;
 
-  gfc_set_model_kind (GFC_QP_KIND);
-
+  mpfr_set_default_prec (128);
   mpfr_init (a);
   mpz_init (r);
 
@@ -409,154 +316,6 @@ gfc_arith_done_1 (void)
 }
 
 
-/* Return default kinds.  */
-
-int
-gfc_default_integer_kind (void)
-{
-  return gfc_integer_kinds[gfc_option.i8 ? 1 : 0].kind;
-}
-
-int
-gfc_default_real_kind (void)
-{
-  return gfc_real_kinds[gfc_option.r8 ? 1 : 0].kind;
-}
-
-int
-gfc_default_double_kind (void)
-{
-  return gfc_real_kinds[1].kind;
-}
-
-int
-gfc_default_character_kind (void)
-{
-  return 1;
-}
-
-int
-gfc_default_logical_kind (void)
-{
-  return gfc_logical_kinds[gfc_option.i8 ? 1 : 0].kind;
-}
-
-int
-gfc_default_complex_kind (void)
-{
-  return gfc_default_real_kind ();
-}
-
-
-/* Make sure that a valid kind is present.  Returns an index into the
-   gfc_integer_kinds array, -1 if the kind is not present.  */
-
-static int
-validate_integer (int kind)
-{
-  int i;
-
-  for (i = 0;; i++)
-    {
-      if (gfc_integer_kinds[i].kind == 0)
-	{
-	  i = -1;
-	  break;
-	}
-      if (gfc_integer_kinds[i].kind == kind)
-	break;
-    }
-
-  return i;
-}
-
-
-static int
-validate_real (int kind)
-{
-  int i;
-
-  for (i = 0;; i++)
-    {
-      if (gfc_real_kinds[i].kind == 0)
-	{
-	  i = -1;
-	  break;
-	}
-      if (gfc_real_kinds[i].kind == kind)
-	break;
-    }
-
-  return i;
-}
-
-
-static int
-validate_logical (int kind)
-{
-  int i;
-
-  for (i = 0;; i++)
-    {
-      if (gfc_logical_kinds[i].kind == 0)
-	{
-	  i = -1;
-	  break;
-	}
-      if (gfc_logical_kinds[i].kind == kind)
-	break;
-    }
-
-  return i;
-}
-
-
-static int
-validate_character (int kind)
-{
-
-  if (kind == gfc_default_character_kind ())
-    return 0;
-  return -1;
-}
-
-
-/* Validate a kind given a basic type.  The return value is the same
-   for the child functions, with -1 indicating nonexistence of the
-   type.  */
-
-int
-gfc_validate_kind (bt type, int kind, bool may_fail)
-{
-  int rc;
-
-  switch (type)
-    {
-    case BT_REAL:		/* Fall through */
-    case BT_COMPLEX:
-      rc = validate_real (kind);
-      break;
-    case BT_INTEGER:
-      rc = validate_integer (kind);
-      break;
-    case BT_LOGICAL:
-      rc = validate_logical (kind);
-      break;
-    case BT_CHARACTER:
-      rc = validate_character (kind);
-      break;
-
-    default:
-      gfc_internal_error ("gfc_validate_kind(): Got bad type");
-    }
-
-  if (!may_fail && rc < 0)
-    gfc_internal_error ("gfc_validate_kind(): Got bad kind");
-
-  return rc;
-}
-
-
 /* Given an integer and a kind, make sure that the integer lies within
    the range of the kind.  Returns ARITH_OK or ARITH_OVERFLOW.  */