[gfortran] Re: revap types, step 1

Richard Henderson rth@redhat.com
Thu Aug 26 23:14:00 GMT 2004


On Thu, Aug 26, 2004 at 10:26:42PM +0100, Paul Brook wrote:
> This sounds like the best course of action.

Ok, here's what I've checked in.  Changes are:

(1) If -r8, DOUBLE PRECISION is mapped to IEEE QUAD, if supported,
    else unchanged.

(2) If not -r8, DOUBLE PRECISION is asserted to be 2*REAL.  If no
    such type exists, we'll fatal_error.  I don't believe we have
    any such target at present, so I'm not going to worry about
    this further.

(3) Documentation for -r8 updated.

(4) KIND number for IEEE extended precision is now 10 instead of 12.
    See the rather large block comment containing the rationale.




r~



        * 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.

Index: arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.13
diff -c -p -d -r1.13 arith.c
*** arith.c	26 Aug 2004 06:07:50 -0000	1.13
--- arith.c	26 Aug 2004 22:17:38 -0000
*************** Software Foundation, 59 Temple Place - S
*** 26,107 ****
     and this file provides the interface.  */
  
  #include "config.h"
! 
! #include <string.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.  */
  
--- 26,35 ----
     and this file provides the interface.  */
  
  #include "config.h"
! #include "system.h"
  #include "gfortran.h"
  #include "arith.h"
  
  /* MPFR does not have a direct replacement for mpz_set_f() from GMP.
     It's easily implemented with a few calls though.  */
  
*************** gfc_mpfr_to_mpz (mpz_t z, mpfr_t x)
*** 128,147 ****
  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");
!     }
  }
  
  
--- 56,68 ----
  void
  gfc_set_model_kind (int kind)
  {
!   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);
  }
  
  
*************** gfc_set_model_kind (int kind)
*** 150,169 ****
  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");
!     }
  }
  
  /* Calculate atan2 (y, x)
--- 71,77 ----
  void
  gfc_set_model (mpfr_t x)
  {
!   mpfr_set_default_prec (mpfr_get_prec (x));
  }
  
  /* Calculate atan2 (y, x)
*************** gfc_arith_init_1 (void)
*** 268,275 ****
    mpz_t r;
    int i;
  
!   gfc_set_model_kind (GFC_QP_KIND);
! 
    mpfr_init (a);
    mpz_init (r);
  
--- 176,182 ----
    mpz_t r;
    int i;
  
!   mpfr_set_default_prec (128);
    mpfr_init (a);
    mpz_init (r);
  
*************** gfc_arith_done_1 (void)
*** 409,562 ****
  }
  
  
- /* 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.  */
  
--- 316,321 ----
Index: f95-lang.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/f95-lang.c,v
retrieving revision 1.14
diff -c -p -d -r1.14 f95-lang.c
*** f95-lang.c	25 Aug 2004 15:50:34 -0000	1.14
--- f95-lang.c	26 Aug 2004 22:17:39 -0000
*************** gfc_init_decl_processing (void)
*** 576,581 ****
--- 576,582 ----
    build_common_tree_nodes_2 (0);
  
    /* Set up F95 type nodes.  */
+   gfc_init_kinds ();
    gfc_init_types ();
  }
  
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.27
diff -c -p -d -r1.27 gfortran.h
*** gfortran.h	26 Aug 2004 06:07:51 -0000	1.27
--- gfortran.h	26 Aug 2004 22:17:39 -0000
*************** void gfc_get_errors (int *, int *);
*** 1504,1509 ****
--- 1504,1510 ----
  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: invoke.texi
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/invoke.texi,v
retrieving revision 1.4
diff -c -p -d -r1.4 invoke.texi
*** invoke.texi	4 Jul 2004 09:01:40 -0000	1.4
--- invoke.texi	26 Aug 2004 22:17:39 -0000
*************** Conform to the specified standard.  Allo
*** 242,250 ****
  @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}.
  
  @end table
  
--- 242,254 ----
  @item -i8
  @item -r8
  @item -d8
! 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: trans-types.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.17
diff -c -p -d -r1.17 trans-types.c
*** trans-types.c	25 Aug 2004 16:50:07 -0000	1.17
--- trans-types.c	26 Aug 2004 22:17:39 -0000
*************** Software Foundation, 59 Temple Place - S
*** 26,39 ****
  #include "system.h"
  #include "coretypes.h"
  #include "tree.h"
! #include <stdio.h>
  #include "ggc.h"
  #include "toplev.h"
- #include <assert.h>
  #include "gfortran.h"
  #include "trans.h"
  #include "trans-types.h"
  #include "trans-const.h"
  
  
  #if (GFC_MAX_DIMENSIONS < 10)
--- 26,41 ----
  #include "system.h"
  #include "coretypes.h"
  #include "tree.h"
! #include "tm.h"
! #include "target.h"
  #include "ggc.h"
  #include "toplev.h"
  #include "gfortran.h"
  #include "trans.h"
  #include "trans-types.h"
  #include "trans-const.h"
+ #include "real.h"
+ #include <assert.h>
  
  
  #if (GFC_MAX_DIMENSIONS < 10)
*************** static GTY(()) tree gfc_desc_dim_type = 
*** 59,64 ****
--- 61,359 ----
  
  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
*************** gfc_init_types (void)
*** 148,154 ****
    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
--- 443,448 ----
Index: trans-types.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.h,v
retrieving revision 1.4
diff -c -p -d -r1.4 trans-types.h
*** trans-types.h	25 Aug 2004 16:50:07 -0000	1.4
--- trans-types.h	26 Aug 2004 22:17:39 -0000
*************** extern GTY(()) tree pchar_type_node;
*** 105,110 ****
--- 105,111 ----
  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);



More information about the Gcc-patches mailing list