arith.c: Include system.h, not real system headers.
* 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
This commit is contained in:
parent
0b410f0b88
commit
5e8e542ff8
7 changed files with 345 additions and 257 deletions
|
@ -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.
|
||||
|
|
|
@ -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. */
|
||||
|
||||
|
|
|
@ -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 ();
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
||||
#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
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Add table
Reference in a new issue