This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
revap types, step 1
- From: Richard Henderson <rth at redhat dot com>
- To: fortran at gcc dot gnu dot org
- Date: Wed, 25 Aug 2004 23:14:44 -0700
- Subject: revap types, step 1
This part only adjusts how we choose which kinds are available.
It does not adjust the types at all, so you can't actually use
these new kinds yet. But I thought the patch was getting large
again, and thought I'd stop.
Comments wrt the choosing of default kinds appreciated.
Ok?
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.
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 06:10:23 -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 06:10:23 -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 06:10:23 -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: 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 06:10:24 -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,344 ----
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;
+ int saw_i4 = -1, saw_i8 = -1;
+ int saw_r4 = -1, saw_r8 = -1, saw_r16 = -1;
+
+ 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 ();
+
+ bitsize = GET_MODE_BITSIZE (mode);
+ kind = bitsize / 8;
+
+ if (kind == 4)
+ saw_i4 = i_index;
+ if (kind == 8)
+ saw_i8 = i_index;
+
+ 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;
+
+ /* As a first approximation, let kind equal 8-bit byte size. Which
+ lets us get kind==4 for single-precision on 32-bit byte targets,
+ which is friendly for the programmer. Where we wish this to be
+ different is for the IEEE extended formats. There, size may equal
+ 16, but it's got 6 bytes of padding. */
+ kind = GET_MODE_BITSIZE (mode) / 8;
+ if (GET_MODE_PRECISION (mode) == 80)
+ kind = 12;
+
+ if (kind == 4)
+ saw_r4 = r_index;
+ if (kind == 8)
+ saw_r8 = r_index;
+ if (kind == 16)
+ saw_r16 = r_index;
+
+ /* 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 < 0)
+ abort (); /* warning, error, fatal? */
+ gfc_default_integer_kind_1 = 8;
+ }
+ else if (saw_i4 >= 0)
+ gfc_default_integer_kind_1 = 4;
+ else
+ abort (); /* choose? */
+
+ /* Choose the default real kind. Again, we choose 4 when possible. */
+ if (gfc_option.r8)
+ {
+ if (saw_r8 < 0)
+ abort (); /* warning, error, fatal? */
+ gfc_default_real_kind_1 = 8;
+ }
+ else if (saw_r4 >= 0)
+ gfc_default_real_kind_1 = 4;
+ else
+ gfc_default_real_kind_1 = gfc_real_kinds[0].kind;
+
+ /* Choose the default double kind. F2003 merely says that DOUBLE
+ PRECISION should be larger than REAL. Traditionally, DOUBLE
+ PRECISION is twice the size of REAL. We may or may not be able
+ to honor either of these constraints, but try our best. */
+ if (gfc_option.r8)
+ {
+ if (saw_r16 >= 0)
+ gfc_default_double_kind_1 = 16;
+ else
+ gfc_default_double_kind_1 = gfc_real_kinds[r_index-1].kind;
+ }
+ else if (saw_r8 >= 0)
+ gfc_default_double_kind_1 = 8;
+ else
+ gfc_default_double_kind_1 = gfc_real_kinds[r_index-1].kind;
+
+ /* 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
--- 428,433 ----
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 06:10:24 -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);