revap types, step 1
Richard Henderson
rth@redhat.com
Thu Aug 26 06:14:00 GMT 2004
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);
More information about the Fortran
mailing list