* 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
+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.
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. */
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);
}
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)
mpz_t r;
int i;
- gfc_set_model_kind (GFC_QP_KIND);
-
+ mpfr_set_default_prec (128);
mpfr_init (a);
mpz_init (r);
}
-/* 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. */
build_common_tree_nodes_2 (0);
/* Set up F95 type nodes. */
+ gfc_init_kinds ();
gfc_init_types ();
}
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);
@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
#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)
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
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
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);
projects / gcc.git / commitdiff