OSDN Git Service

* arith.c: Include system.h, not real system headers.
authorrth <rth@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 26 Aug 2004 22:19:23 +0000 (22:19 +0000)
committerrth <rth@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 26 Aug 2004 22:19:23 +0000 (22:19 +0000)
        (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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@86637 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/arith.c
gcc/fortran/f95-lang.c
gcc/fortran/gfortran.h
gcc/fortran/invoke.texi
gcc/fortran/trans-types.c
gcc/fortran/trans-types.h

index 6ab8f19..d1f9195 100644 (file)
@@ -1,3 +1,31 @@
+2004-08-26  Richard Henderson  <rth@redhat.com>
+
+        * 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.
+
 2004-08-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
        * check.c (gfc_check_atan2): New function.
index ec19682..85f5138 100644 (file)
@@ -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.  */
 
index 77950e9..673e208 100644 (file)
@@ -576,6 +576,7 @@ gfc_init_decl_processing (void)
   build_common_tree_nodes_2 (0);
 
   /* Set up F95 type nodes.  */
+  gfc_init_kinds ();
   gfc_init_types ();
 }
 
index d9da805..31dc784 100644 (file)
@@ -1504,6 +1504,7 @@ void gfc_get_errors (int *, int *);
 void gfc_arith_init_1 (void);
 void gfc_arith_done_1 (void);
 
+/* trans-types.c */
 /* FIXME: These should go to symbol.c, really...  */
 int gfc_default_integer_kind (void);
 int gfc_default_real_kind (void);
index 08ce462..845b10d 100644 (file)
@@ -242,9 +242,13 @@ Conform to the specified standard.  Allowed values for @var{std} are
 @item -i8
 @item -r8
 @item -d8
-The @option{-i8} and @option{-j8} options set the default INTEGER and REAL
-kinds to KIND=8.  The @option{-d8} option is equivalent to specifying
-both @option{-i8} and @option{-r8}.
+The @option{-i8} and @option{-r8} options set the default @code{INTEGER}
+and @code{REAL} kinds to @code{KIND=8}.  The @option{-d8} option is
+equivalent to specifying both @option{-i8} and @option{-r8}.
+
+When @option{-r8} is specified, the @code{DOUBLE PRECISION} kind is set
+to @code{KIND=16} if the target supports a 16 byte floating point format.
+If no such format exists, the @code{DOUBLE PRECISION} kind is unchanged.
 
 @end table
 
index e88842d..b9bb474 100644 (file)
@@ -26,14 +26,16 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
-#include <stdio.h>
+#include "tm.h"
+#include "target.h"
 #include "ggc.h"
 #include "toplev.h"
-#include <assert.h>
 #include "gfortran.h"
 #include "trans.h"
 #include "trans-types.h"
 #include "trans-const.h"
+#include "real.h"
+#include <assert.h>
 \f
 
 #if (GFC_MAX_DIMENSIONS < 10)
@@ -59,6 +61,299 @@ static GTY(()) tree gfc_desc_dim_type = NULL;
 
 static GTY(()) tree gfc_max_array_element_size;
 
+/* 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.  */
+
+#define MAX_INT_KINDS 5
+gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS + 1];
+gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS + 1];
+
+#define MAX_REAL_KINDS 4
+gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1];
+
+/* 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;
+
+/* The default kinds of the various types.  */
+
+static int gfc_default_integer_kind_1;
+static int gfc_default_real_kind_1;
+static int gfc_default_double_kind_1;
+static int gfc_default_character_kind_1;
+static int gfc_default_logical_kind_1;
+static int gfc_default_complex_kind_1;
+
+/* Query the target to determine which machine modes are available for
+   computation.  Choose KIND numbers for them.  */
+
+void
+gfc_init_kinds (void)
+{
+  enum machine_mode mode;
+  int i_index, r_index;
+  bool saw_i4 = false, saw_i8 = false;
+  bool saw_r4 = false, saw_r8 = false, saw_r16 = false;
+
+  for (i_index = 0, mode = MIN_MODE_INT; mode <= MAX_MODE_INT; mode++)
+    {
+      int kind, bitsize;
+
+      if (!targetm.scalar_mode_supported_p (mode))
+       continue;
+
+      if (i_index == MAX_INT_KINDS)
+       abort ();
+
+      /* Let the kind equal the bit size divided by 8.  This insulates the
+        programmer from the underlying byte size.  */
+      bitsize = GET_MODE_BITSIZE (mode);
+      kind = bitsize / 8;
+
+      if (kind == 4)
+       saw_i4 = true;
+      if (kind == 8)
+       saw_i8 = true;
+
+      gfc_integer_kinds[i_index].kind = kind;
+      gfc_integer_kinds[i_index].radix = 2;
+      gfc_integer_kinds[i_index].digits = bitsize - 1;
+      gfc_integer_kinds[i_index].bit_size = bitsize;
+
+      gfc_logical_kinds[i_index].kind = kind;
+      gfc_logical_kinds[i_index].bit_size = bitsize;
+
+      i_index += 1;
+    }
+
+  for (r_index = 0, mode = MIN_MODE_FLOAT; mode <= MAX_MODE_FLOAT; mode++)
+    {
+      const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+      int kind;
+
+      if (fmt == NULL)
+       continue;
+      if (!targetm.scalar_mode_supported_p (mode))
+       continue;
+
+      /* Let the kind equal the precision divided by 8, rounding up.  Again,
+        this insulates the programmer from the underlying byte size.
+
+        Also, it effectively deals with IEEE extended formats.  There, the
+        total size of the type may equal 16, but it's got 6 bytes of padding
+        and the increased size can get in the way of a real IEEE quad format
+        which may also be supported by the target.
+
+        We round up so as to handle IA-64 __floatreg (RFmode), which is an
+        82 bit type.  Not to be confused with __float80 (XFmode), which is
+        an 80 bit type also supported by IA-64.  So XFmode should come out
+        to be kind=10, and RFmode should come out to be kind=11.  Egads.  */
+
+      kind = (GET_MODE_PRECISION (mode) + 7) / 8;
+
+      if (kind == 4)
+       saw_r4 = true;
+      if (kind == 8)
+       saw_r8 = true;
+      if (kind == 16)
+       saw_r16 = true;
+
+      /* Careful we don't stumble a wierd internal mode.  */
+      if (r_index > 0 && gfc_real_kinds[r_index-1].kind == kind)
+       abort ();
+      /* Or have too many modes for the allocated space.  */
+      if (r_index == MAX_REAL_KINDS)
+       abort ();
+
+      gfc_real_kinds[r_index].kind = kind;
+      gfc_real_kinds[r_index].radix = fmt->b;
+      gfc_real_kinds[r_index].digits = fmt->p;
+      gfc_real_kinds[r_index].min_exponent = fmt->emin;
+      gfc_real_kinds[r_index].max_exponent = fmt->emax;
+      r_index += 1;
+    }
+
+  /* Choose the default integer kind.  We choose 4 unless the user
+     directs us otherwise.  */
+  if (gfc_option.i8)
+    {
+      if (!saw_i8)
+       fatal_error ("integer kind=8 not available for -i8 option");
+      gfc_default_integer_kind_1 = 8;
+    }
+  else if (saw_i4)
+    gfc_default_integer_kind_1 = 4;
+  else
+    gfc_default_integer_kind_1 = gfc_integer_kinds[i_index - 1].kind;
+
+  /* Choose the default real kind.  Again, we choose 4 when possible.  */
+  if (gfc_option.r8)
+    {
+      if (!saw_r8)
+       fatal_error ("real kind=8 not available for -r8 option");
+      gfc_default_real_kind_1 = 8;
+    }
+  else if (saw_r4)
+    gfc_default_real_kind_1 = 4;
+  else
+    gfc_default_real_kind_1 = gfc_real_kinds[0].kind;
+
+  /* Choose the default double kind.  If -r8 is specified, we use kind=16,
+     if it's available, otherwise we do not change anything.  */
+  if (gfc_option.r8 && saw_r16)
+    gfc_default_double_kind_1 = 16;
+  else if (saw_r4 && saw_r8)
+    gfc_default_double_kind_1 = 8;
+  else
+    {
+      /* F95 14.6.3.1: A nonpointer scalar object of type double precision
+        real ... occupies two contiguous numeric storage units.
+
+        Therefore we must be supplied a kind twice as large as we chose
+        for single precision.  There are loopholes, in that double
+        precision must *occupy* two storage units, though it doesn't have
+        to *use* two storage units.  Which means that you can make this
+        kind artificially wide by padding it.  But at present there are
+        no GCC targets for which a two-word type does not exist, so we
+        just let gfc_validate_kind abort and tell us if something breaks.  */
+
+      gfc_default_double_kind_1
+       = gfc_validate_kind (BT_REAL, gfc_default_real_kind_1 * 2, false);
+    }
+
+  /* The default logical kind is constrained to be the same as the
+     default integer kind.  Similarly with complex and real.  */
+  gfc_default_logical_kind_1 = gfc_default_integer_kind_1;
+  gfc_default_complex_kind_1 = gfc_default_real_kind_1;
+
+  /* Choose the smallest integer kind for our default character.  */
+  gfc_default_character_kind_1 = gfc_integer_kinds[0].kind;
+
+  /* Choose the integer kind the same size as "void*" for our index kind.  */
+  gfc_index_integer_kind = POINTER_SIZE / 8;
+}
+
+/* ??? These functions should go away in favor of direct access to
+   the relevant variables.  */
+
+int
+gfc_default_integer_kind (void)
+{
+  return gfc_default_integer_kind_1;
+}
+
+int
+gfc_default_real_kind (void)
+{
+  return gfc_default_real_kind_1;
+}
+
+int
+gfc_default_double_kind (void)
+{
+  return gfc_default_double_kind_1;
+}
+
+int
+gfc_default_character_kind (void)
+{
+  return gfc_default_character_kind_1;
+}
+
+int
+gfc_default_logical_kind (void)
+{
+  return gfc_default_logical_kind_1;
+}
+
+int
+gfc_default_complex_kind (void)
+{
+  return gfc_default_complex_kind_1;
+}
+
+/* Make sure that a valid kind is present.  Returns an index into the
+   associated kinds array, -1 if the kind is not present.  */
+
+static int
+validate_integer (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+static int
+validate_real (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (gfc_real_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+static int
+validate_logical (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_logical_kinds[i].kind; i++)
+    if (gfc_logical_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+static int
+validate_character (int kind)
+{
+  return kind == gfc_default_character_kind_1 ? 0 : -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.  If MAY_FAIL is false, then -1 is never returned, and we ICE.  */
+
+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 (rc < 0 && !may_fail)
+    gfc_internal_error ("gfc_validate_kind(): Got bad kind");
+
+  return rc;
+}
+
+
 /* Create the backend type nodes. We map them to their
    equivalent C type, at least for now.  We also give
    names to the types here, and we push them in the
@@ -148,7 +443,6 @@ gfc_init_types (void)
   ppvoid_type_node = build_pointer_type (pvoid_type_node);
   pchar_type_node = build_pointer_type (gfc_character1_type_node);
 
-  gfc_index_integer_kind = TYPE_PRECISION (long_unsigned_type_node) / 8;
   gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
 
   /* The maximum array element size that can be handled is determined
index ebab5a1..4a6e59d 100644 (file)
@@ -105,6 +105,7 @@ extern GTY(()) tree pchar_type_node;
 void gfc_convert_function_code (gfc_namespace *);
 
 /* trans-types.c */
+void gfc_init_kinds (void);
 void gfc_init_types (void);
 
 tree gfc_get_int_type (int);