OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Richard Henderson 2004-08-26 15:19:23 -07:00 committed by Richard Henderson
parent 0b410f0b88
commit 5e8e542ff8
7 changed files with 345 additions and 257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/fortran/ChangeLog
View File

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

261
gcc/fortran/arith.c
View File

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

1
gcc/fortran/f95-lang.c
View File

@ -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 ();
}

1
gcc/fortran/gfortran.h
View File

@ -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);

10
gcc/fortran/invoke.texi
View File

@ -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

300
gcc/fortran/trans-types.c
View File

@ -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

1
gcc/fortran/trans-types.h
View File

@ -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);