This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran] Front-end and library calls for large kinds
- From: FX Coudert <fxcoudert at gmail dot com>
- To: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- Cc: gfortran <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 26 Jun 2005 22:19:42 +0200
- Subject: Re: [gfortran] Front-end and library calls for large kinds
- References: <42BEC97D.7020901@gmail.com> <20050626160419.GA97941@troutmask.apl.washington.edu>
Wow. I've only started thinking about this problem.
Well, I've only started thinking about this yesterday ;-)
I've only glanced at the diff very quickly, but I
noticed that there is no ishift10 whereas you included
ishift16 (names could be spelled wrong here). Is this
intentional?
That's because ishftc is labeled with an integer kind. So the only
possible values would be 1, 2 (for which we do a conversion, see
trans-intrinsics.c, line 1895), 4, 8 (which were already present) and 16.
Anyway, I'd be glad if you looked at the patch. Updated version (I
messed up with HAVE_GFC_REAL_* and HAVE_GFC_COMPLEX_*; mk-kinds-h.sh
corrected to fix this). I added support for a few more functions in
libgfortran.
FX
Index: gcc/fortran/f95-lang.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/f95-lang.c,v
retrieving revision 1.37
diff -u -3 -p -r1.37 f95-lang.c
--- gcc/fortran/f95-lang.c 25 Jun 2005 00:40:34 -0000 1.37
+++ gcc/fortran/f95-lang.c 26 Jun 2005 20:13:29 -0000
@@ -726,6 +726,8 @@ gfc_define_builtin (const char * name,
#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+ gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
+ BUILT_IN_ ## code ## L, name "l", true); \
gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
BUILT_IN_ ## code, name, true); \
gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
@@ -768,17 +770,22 @@ gfc_init_builtin_functions (void)
{
tree mfunc_float[3];
tree mfunc_double[3];
+ tree mfunc_longdouble[3];
tree mfunc_cfloat[3];
tree mfunc_cdouble[3];
+ tree mfunc_clongdouble[3];
tree func_cfloat_float;
tree func_cdouble_double;
+ tree func_clongdouble_longdouble;
tree ftype;
tree tmp;
build_builtin_fntypes (mfunc_float, float_type_node);
build_builtin_fntypes (mfunc_double, double_type_node);
+ build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
+ build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
func_cfloat_float = build_function_type (float_type_node, tmp);
@@ -786,30 +793,45 @@ gfc_init_builtin_functions (void)
tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
func_cdouble_double = build_function_type (double_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
+ func_clongdouble_longdouble =
+ build_function_type (long_double_type_node, tmp);
+
#include "mathbuiltins.def"
/* We define these separately as the fortran versions have different
semantics (they return an integer type) */
+ gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
+ BUILT_IN_ROUNDL, "roundl", true);
gfc_define_builtin ("__builtin_round", mfunc_double[0],
BUILT_IN_ROUND, "round", true);
gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
BUILT_IN_ROUNDF, "roundf", true);
+
+ gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
+ BUILT_IN_TRUNCL, "truncl", true);
gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
BUILT_IN_TRUNC, "trunc", true);
gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
BUILT_IN_TRUNCF, "truncf", true);
+ gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
+ BUILT_IN_CABSL, "cabsl", true);
gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
BUILT_IN_CABS, "cabs", true);
gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
BUILT_IN_CABSF, "cabsf", true);
+ gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
+ BUILT_IN_COPYSIGNL, "copysignl", true);
gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
BUILT_IN_COPYSIGN, "copysign", true);
gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
BUILT_IN_COPYSIGNF, "copysignf", true);
/* These are used to implement the ** operator. */
+ gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
+ BUILT_IN_POWL, "powl", true);
gfc_define_builtin ("__builtin_pow", mfunc_double[1],
BUILT_IN_POW, "pow", true);
gfc_define_builtin ("__builtin_powf", mfunc_float[1],
Index: gcc/fortran/iresolve.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.36
diff -u -3 -p -r1.36 iresolve.c
--- gcc/fortran/iresolve.c 25 Jun 2005 00:40:35 -0000 1.36
+++ gcc/fortran/iresolve.c 26 Jun 2005 20:13:30 -0000
@@ -1159,7 +1159,8 @@ gfc_resolve_reshape (gfc_expr * f, gfc_e
{
case 4:
case 8:
- /* case 16: */
+ case 10:
+ case 16:
if (source->ts.type == BT_COMPLEX)
f->value.function.name =
gfc_get_string (PREFIX("reshape_%c%d"),
@@ -1476,6 +1477,8 @@ gfc_resolve_transpose (gfc_expr * f, gfc
{
case 4:
case 8:
+ case 10:
+ case 16:
switch (matrix->ts.type)
{
case BT_COMPLEX:
Index: gcc/fortran/trans-decl.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.62
diff -u -3 -p -r1.62 trans-decl.c
--- gcc/fortran/trans-decl.c 25 Jun 2005 00:40:36 -0000 1.62
+++ gcc/fortran/trans-decl.c 26 Jun 2005 20:13:31 -0000
@@ -94,10 +94,15 @@ tree gfor_fndecl_associated;
gfc_powdecl_list gfor_fndecl_math_powi[3][2];
tree gfor_fndecl_math_cpowf;
tree gfor_fndecl_math_cpow;
+tree gfor_fndecl_math_cpowl10;
+tree gfor_fndecl_math_cpowl16;
tree gfor_fndecl_math_ishftc4;
tree gfor_fndecl_math_ishftc8;
+tree gfor_fndecl_math_ishftc16;
tree gfor_fndecl_math_exponent4;
tree gfor_fndecl_math_exponent8;
+tree gfor_fndecl_math_exponent10;
+tree gfor_fndecl_math_exponent16;
/* String functions. */
@@ -1685,11 +1690,16 @@ gfc_build_intrinsic_function_decls (void
{
tree gfc_int4_type_node = gfc_get_int_type (4);
tree gfc_int8_type_node = gfc_get_int_type (8);
+ tree gfc_int16_type_node = gfc_get_int_type (16);
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree gfc_real4_type_node = gfc_get_real_type (4);
tree gfc_real8_type_node = gfc_get_real_type (8);
+ tree gfc_real10_type_node = gfc_get_real_type (10);
+ tree gfc_real16_type_node = gfc_get_real_type (16);
tree gfc_complex4_type_node = gfc_get_complex_type (4);
tree gfc_complex8_type_node = gfc_get_complex_type (8);
+ tree gfc_complex10_type_node = gfc_get_complex_type (10);
+ tree gfc_complex16_type_node = gfc_get_complex_type (16);
/* String functions. */
gfor_fndecl_copy_string =
@@ -1787,37 +1797,56 @@ gfc_build_intrinsic_function_decls (void
/* Power functions. */
{
- tree type;
- tree itype;
- int kind;
- int ikind;
- static int kinds[2] = {4, 8};
+ tree ctype, rtype, itype, jtype;
+ int rkind, ikind, jkind;
+#define NIKINDS 3
+#define NRKINDS 4
+ static int ikinds[NIKINDS] = {4, 8, 16};
+ static int rkinds[NRKINDS] = {4, 8, 10, 16};
char name[PREFIX_LEN + 10]; /* _gfortran_pow_?n_?n */
- for (ikind=0; ikind < 2; ikind++)
+ for (ikind=0; ikind < NIKINDS; ikind++)
{
- itype = gfc_get_int_type (kinds[ikind]);
- for (kind = 0; kind < 2; kind ++)
+ itype = gfc_get_int_type (ikinds[ikind]);
+
+ for (jkind=0; jkind < NIKINDS; jkind++)
+ {
+ jtype = gfc_get_int_type (ikinds[jkind]);
+ if (itype && jtype)
+ {
+ sprintf(name, PREFIX("pow_i%d_i%d"), ikinds[ikind],
+ ikinds[jkind]);
+ gfor_fndecl_math_powi[jkind][ikind].integer =
+ gfc_build_library_function_decl (get_identifier (name),
+ jtype, 2, jtype, itype);
+ }
+ }
+
+ for (rkind = 0; rkind < NRKINDS; rkind ++)
{
- type = gfc_get_int_type (kinds[kind]);
- sprintf(name, PREFIX("pow_i%d_i%d"), kinds[kind], kinds[ikind]);
- gfor_fndecl_math_powi[kind][ikind].integer =
- gfc_build_library_function_decl (get_identifier (name),
- type, 2, type, itype);
-
- type = gfc_get_real_type (kinds[kind]);
- sprintf(name, PREFIX("pow_r%d_i%d"), kinds[kind], kinds[ikind]);
- gfor_fndecl_math_powi[kind][ikind].real =
- gfc_build_library_function_decl (get_identifier (name),
- type, 2, type, itype);
-
- type = gfc_get_complex_type (kinds[kind]);
- sprintf(name, PREFIX("pow_c%d_i%d"), kinds[kind], kinds[ikind]);
- gfor_fndecl_math_powi[kind][ikind].cmplx =
- gfc_build_library_function_decl (get_identifier (name),
- type, 2, type, itype);
+ rtype = gfc_get_real_type (rkinds[rkind]);
+ if (rtype && itype)
+ {
+ sprintf(name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
+ ikinds[ikind]);
+ gfor_fndecl_math_powi[rkind][ikind].real =
+ gfc_build_library_function_decl (get_identifier (name),
+ rtype, 2, rtype, itype);
+ }
+
+ ctype = gfc_get_complex_type (rkinds[rkind]);
+ if (ctype && itype)
+ {
+ sprintf(name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
+ ikinds[ikind]);
+ gfor_fndecl_math_powi[rkind][ikind].cmplx =
+ gfc_build_library_function_decl (get_identifier (name),
+ ctype, 2,ctype, itype);
+ }
}
}
+#undef NIKINDS
+#undef NRKINDS
}
gfor_fndecl_math_cpowf =
@@ -1828,6 +1857,17 @@ gfc_build_intrinsic_function_decls (void
gfc_build_library_function_decl (get_identifier ("cpow"),
gfc_complex8_type_node,
1, gfc_complex8_type_node);
+ if (gfc_complex10_type_node)
+ gfor_fndecl_math_cpowl10 =
+ gfc_build_library_function_decl (get_identifier ("cpowl"),
+ gfc_complex10_type_node, 1,
+ gfc_complex10_type_node);
+ if (gfc_complex16_type_node)
+ gfor_fndecl_math_cpowl16 =
+ gfc_build_library_function_decl (get_identifier ("cpowl"),
+ gfc_complex16_type_node, 1,
+ gfc_complex16_type_node);
+
gfor_fndecl_math_ishftc4 =
gfc_build_library_function_decl (get_identifier (PREFIX("ishftc4")),
gfc_int4_type_node,
@@ -1838,6 +1878,14 @@ gfc_build_intrinsic_function_decls (void
gfc_int8_type_node,
3, gfc_int8_type_node,
gfc_int8_type_node, gfc_int8_type_node);
+ if (gfc_int16_type_node)
+ gfor_fndecl_math_ishftc16 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("ishftc16")),
+ gfc_int16_type_node, 3,
+ gfc_int16_type_node,
+ gfc_int16_type_node,
+ gfc_int16_type_node);
+
gfor_fndecl_math_exponent4 =
gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")),
gfc_int4_type_node,
@@ -1846,6 +1894,16 @@ gfc_build_intrinsic_function_decls (void
gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r8")),
gfc_int4_type_node,
1, gfc_real8_type_node);
+ if (gfc_real10_type_node)
+ gfor_fndecl_math_exponent10 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r10")),
+ gfc_int4_type_node, 1,
+ gfc_real10_type_node);
+ if (gfc_real16_type_node)
+ gfor_fndecl_math_exponent16 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r16")),
+ gfc_int4_type_node, 1,
+ gfc_real16_type_node);
/* Other functions. */
gfor_fndecl_size0 =
Index: gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.53
diff -u -3 -p -r1.53 trans-expr.c
--- gcc/fortran/trans-expr.c 25 Jun 2005 00:40:36 -0000 1.53
+++ gcc/fortran/trans-expr.c 26 Jun 2005 20:13:32 -0000
@@ -687,6 +687,10 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
ikind = 1;
break;
+ case 16:
+ ikind = 2;
+ break;
+
default:
gcc_unreachable ();
}
@@ -708,6 +712,14 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
kind = 1;
break;
+ case 10:
+ kind = 2;
+ break;
+
+ case 16:
+ kind = 3;
+ break;
+
default:
gcc_unreachable ();
}
@@ -740,6 +752,10 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
case 8:
fndecl = built_in_decls[BUILT_IN_POW];
break;
+ case 10:
+ case 16:
+ fndecl = built_in_decls[BUILT_IN_POWL];
+ break;
default:
gcc_unreachable ();
}
@@ -754,6 +770,12 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
case 8:
fndecl = gfor_fndecl_math_cpow;
break;
+ case 10:
+ fndecl = gfor_fndecl_math_cpowl10;
+ break;
+ case 16:
+ fndecl = gfor_fndecl_math_cpowl16;
+ break;
default:
gcc_unreachable ();
}
Index: gcc/fortran/trans-intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.52
diff -u -3 -p -r1.52 trans-intrinsic.c
--- gcc/fortran/trans-intrinsic.c 25 Jun 2005 00:40:36 -0000 1.52
+++ gcc/fortran/trans-intrinsic.c 26 Jun 2005 20:13:32 -0000
@@ -56,10 +56,12 @@ typedef struct gfc_intrinsic_map_t GTY((
don't currently do anything with them. */
enum built_in_function code4;
enum built_in_function code8;
+ enum built_in_function code10;
+ enum built_in_function code16;
/* True if the naming pattern is to prepend "c" for complex and
append "f" for kind=4. False if the naming pattern is to
- prepend "_gfortran_" and append "[rc][48]". */
+ prepend "_gfortran_" and append "[rc](4|8|10|16)". */
bool libm_name;
/* True if a complex version of the function exists. */
@@ -74,8 +76,12 @@ typedef struct gfc_intrinsic_map_t GTY((
/* Cache decls created for the various operand types. */
tree real4_decl;
tree real8_decl;
+ tree real10_decl;
+ tree real16_decl;
tree complex4_decl;
tree complex8_decl;
+ tree complex10_decl;
+ tree complex16_decl;
}
gfc_intrinsic_map_t;
@@ -83,8 +89,10 @@ gfc_intrinsic_map_t;
defines complex variants of all of the entries in mathbuiltins.def
except for atan2. */
#define BUILT_IN_FUNCTION(ID, NAME, HAVE_COMPLEX) \
- { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, true, \
- HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+ { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+ BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, true, \
+ HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
#define DEFINE_MATH_BUILTIN(id, name, argtype) \
BUILT_IN_FUNCTION (id, name, false)
@@ -94,12 +102,14 @@ gfc_intrinsic_map_t;
BUILT_IN_FUNCTION (id, name, true)
#define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \
- { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, true, HAVE_COMPLEX, true, \
- NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+ { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ true, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
#define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \
- { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, false, HAVE_COMPLEX, true, \
- NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+ { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
{
@@ -336,6 +346,11 @@ gfc_conv_intrinsic_aint (gfc_se * se, gf
case 8:
n = BUILT_IN_ROUND;
break;
+
+ case 10:
+ case 16:
+ n = BUILT_IN_ROUNDL;
+ break;
}
break;
@@ -349,6 +364,11 @@ gfc_conv_intrinsic_aint (gfc_se * se, gf
case 8:
n = BUILT_IN_TRUNC;
break;
+
+ case 10:
+ case 16:
+ n = BUILT_IN_TRUNCL;
+ break;
}
break;
@@ -473,6 +493,10 @@ gfc_build_intrinsic_lib_fndecls (void)
m->real4_decl = built_in_decls[m->code4];
if (m->code8 != END_BUILTINS)
m->real8_decl = built_in_decls[m->code8];
+ if (m->code10 != END_BUILTINS)
+ m->real10_decl = built_in_decls[m->code10];
+ if (m->code16 != END_BUILTINS)
+ m->real16_decl = built_in_decls[m->code16];
}
}
@@ -501,6 +525,12 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrin
case 8:
pdecl = &m->real8_decl;
break;
+ case 10:
+ pdecl = &m->real10_decl;
+ break;
+ case 16:
+ pdecl = &m->real16_decl;
+ break;
default:
gcc_unreachable ();
}
@@ -517,6 +547,12 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrin
case 8:
pdecl = &m->complex8_decl;
break;
+ case 10:
+ pdecl = &m->complex10_decl;
+ break;
+ case 16:
+ pdecl = &m->complex16_decl;
+ break;
default:
gcc_unreachable ();
}
@@ -529,7 +565,8 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrin
if (m->libm_name)
{
- gcc_assert (ts->kind == 4 || ts->kind == 8);
+ gcc_assert (ts->kind == 4 || ts->kind == 8 || ts->kind == 10
+ || ts->kind == 16);
snprintf (name, sizeof (name), "%s%s%s",
ts->type == BT_COMPLEX ? "c" : "",
m->name,
@@ -615,6 +652,12 @@ gfc_conv_intrinsic_exponent (gfc_se * se
case 8:
fndecl = gfor_fndecl_math_exponent8;
break;
+ case 10:
+ fndecl = gfor_fndecl_math_exponent10;
+ break;
+ case 16:
+ fndecl = gfor_fndecl_math_exponent16;
+ break;
default:
gcc_unreachable ();
}
@@ -735,6 +778,10 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc
case 8:
n = BUILT_IN_CABS;
break;
+ case 10:
+ case 16:
+ n = BUILT_IN_CABSL;
+ break;
default:
gcc_unreachable ();
}
@@ -897,6 +944,10 @@ gfc_conv_intrinsic_sign (gfc_se * se, gf
case 8:
tmp = built_in_decls[BUILT_IN_COPYSIGN];
break;
+ case 10:
+ case 16:
+ tmp = built_in_decls[BUILT_IN_COPYSIGNL];
+ break;
default:
gcc_unreachable ();
}
@@ -1862,6 +1913,9 @@ gfc_conv_intrinsic_ishftc (gfc_se * se,
case 8:
tmp = gfor_fndecl_math_ishftc8;
break;
+ case 16:
+ tmp = gfor_fndecl_math_ishftc16;
+ break;
default:
gcc_unreachable ();
}
Index: gcc/fortran/trans-types.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.48
diff -u -3 -p -r1.48 trans-types.c
--- gcc/fortran/trans-types.c 25 Jun 2005 00:40:36 -0000 1.48
+++ gcc/fortran/trans-types.c 26 Jun 2005 20:13:32 -0000
@@ -565,29 +565,29 @@ gfc_init_types (void)
tree
gfc_get_int_type (int kind)
{
- int index = gfc_validate_kind (BT_INTEGER, kind, false);
- return gfc_integer_types[index];
+ int index = gfc_validate_kind (BT_INTEGER, kind, true);
+ return index < 0 ? 0 : gfc_integer_types[index];
}
tree
gfc_get_real_type (int kind)
{
- int index = gfc_validate_kind (BT_REAL, kind, false);
- return gfc_real_types[index];
+ int index = gfc_validate_kind (BT_REAL, kind, true);
+ return index < 0 ? 0 : gfc_real_types[index];
}
tree
gfc_get_complex_type (int kind)
{
- int index = gfc_validate_kind (BT_COMPLEX, kind, false);
- return gfc_complex_types[index];
+ int index = gfc_validate_kind (BT_COMPLEX, kind, true);
+ return index < 0 ? 0 : gfc_complex_types[index];
}
tree
gfc_get_logical_type (int kind)
{
- int index = gfc_validate_kind (BT_LOGICAL, kind, false);
- return gfc_logical_types[index];
+ int index = gfc_validate_kind (BT_LOGICAL, kind, true);
+ return index < 0 ? 0 : gfc_logical_types[index];
}
/* Create a character type with the given kind and length. */
Index: gcc/fortran/trans.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.29
diff -u -3 -p -r1.29 trans.h
--- gcc/fortran/trans.h 25 Jun 2005 00:40:37 -0000 1.29
+++ gcc/fortran/trans.h 26 Jun 2005 20:13:32 -0000
@@ -476,10 +476,15 @@ gfc_powdecl_list;
extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[3][2];
extern GTY(()) tree gfor_fndecl_math_cpowf;
extern GTY(()) tree gfor_fndecl_math_cpow;
+extern GTY(()) tree gfor_fndecl_math_cpowl10;
+extern GTY(()) tree gfor_fndecl_math_cpowl16;
extern GTY(()) tree gfor_fndecl_math_ishftc4;
extern GTY(()) tree gfor_fndecl_math_ishftc8;
+extern GTY(()) tree gfor_fndecl_math_ishftc16;
extern GTY(()) tree gfor_fndecl_math_exponent4;
extern GTY(()) tree gfor_fndecl_math_exponent8;
+extern GTY(()) tree gfor_fndecl_math_exponent10;
+extern GTY(()) tree gfor_fndecl_math_exponent16;
/* String functions. */
extern GTY(()) tree gfor_fndecl_copy_string;
Index: libgfortran/Makefile.am
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.38
diff -u -3 -p -r1.38 Makefile.am
--- libgfortran/Makefile.am 24 Jun 2005 23:07:13 -0000 1.38
+++ libgfortran/Makefile.am 26 Jun 2005 20:14:50 -0000
@@ -256,33 +256,62 @@ generated/in_unpack_c8.c
i_exponent_c = \
generated/exponent_r4.c \
-generated/exponent_r8.c
+generated/exponent_r8.c \
+generated/exponent_r10.c \
+generated/exponent_r16.c
i_fraction_c = \
generated/fraction_r4.c \
-generated/fraction_r8.c
+generated/fraction_r8.c \
+generated/fraction_r10.c \
+generated/fraction_r16.c
i_nearest_c = \
generated/nearest_r4.c \
-generated/nearest_r8.c
+generated/nearest_r8.c \
+generated/nearest_r10.c \
+generated/nearest_r16.c
i_set_exponent_c = \
generated/set_exponent_r4.c \
-generated/set_exponent_r8.c
+generated/set_exponent_r8.c \
+generated/set_exponent_r10.c \
+generated/set_exponent_r16.c
i_pow_c = \
generated/pow_i4_i4.c \
generated/pow_i8_i4.c \
+generated/pow_i16_i4.c \
generated/pow_r4_i4.c \
generated/pow_r8_i4.c \
+generated/pow_r10_i4.c \
+generated/pow_r16_i4.c \
generated/pow_c4_i4.c \
generated/pow_c8_i4.c \
+generated/pow_c10_i4.c \
+generated/pow_c16_i4.c \
generated/pow_i4_i8.c \
generated/pow_i8_i8.c \
+generated/pow_i16_i8.c \
generated/pow_r4_i8.c \
generated/pow_r8_i8.c \
+generated/pow_r10_i8.c \
+generated/pow_r16_i8.c \
generated/pow_c4_i8.c \
-generated/pow_c8_i8.c
+generated/pow_c8_i8.c \
+generated/pow_c10_i8.c \
+generated/pow_c16_i8.c \
+generated/pow_i4_i16.c \
+generated/pow_i8_i16.c \
+generated/pow_i16_i16.c \
+generated/pow_r4_i16.c \
+generated/pow_r8_i16.c \
+generated/pow_r10_i16.c \
+generated/pow_r16_i16.c \
+generated/pow_c4_i16.c \
+generated/pow_c8_i16.c \
+generated/pow_c10_i16.c \
+generated/pow_c16_i16.c
m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
@@ -306,23 +335,35 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(
gfor_math_trig_c= \
generated/trig_c4.c \
-generated/trig_c8.c
+generated/trig_c8.c \
+generated/trig_c10.c \
+generated/trig_c16.c
gfor_math_exp_c= \
generated/exp_c4.c \
-generated/exp_c8.c
+generated/exp_c8.c \
+generated/exp_c10.c \
+generated/exp_c16.c
gfor_math_hyp_c= \
generated/hyp_c4.c \
-generated/hyp_c8.c
+generated/hyp_c8.c \
+generated/hyp_c10.c \
+generated/hyp_c16.c
gfor_math_trig_obj= \
trig_c4.lo \
-trig_c8.lo
+trig_c8.lo \
+trig_c10.lo \
+trig_c16.lo
gfor_math_exp_obj= \
exp_c4.lo \
-exp_c8.lo
+exp_c8.lo \
+exp_c10.lo \
+exp_c16.lo
gfor_math_hyp_obj= \
hyp_c4.lo \
-hyp_c8.lo
+hyp_c8.lo \
+hyp_c10.lo \
+hyp_c16.lo
# Machine generated specifics
gfor_built_specific_src= \
Index: libgfortran/mk-kinds-h.sh
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/mk-kinds-h.sh,v
retrieving revision 1.1
diff -u -3 -p -r1.1 mk-kinds-h.sh
--- libgfortran/mk-kinds-h.sh 23 Jun 2005 18:50:24 -0000 1.1
+++ libgfortran/mk-kinds-h.sh 26 Jun 2005 20:14:50 -0000
@@ -50,6 +50,7 @@ for k in $possible_real_kinds; do
echo "typedef ${ctype} GFC_REAL_${k};"
echo "typedef complex ${ctype} GFC_COMPLEX_${k};"
echo "#define HAVE_GFC_REAL_${k}"
+ echo "#define HAVE_GFC_COMPLEX_${k}"
fi
rm -f tmp$$.*
done
Index: libgfortran/m4/cexp.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/cexp.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 cexp.m4
--- libgfortran/m4/cexp.m4 12 Jun 2005 21:00:57 -0000 1.5
+++ libgfortran/m4/cexp.m4 26 Jun 2005 20:14:50 -0000
@@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_'complex_type`)'
+
/* z = a + ib */
/* Absolute value. */
real_type
@@ -144,3 +146,4 @@ csqrt`'q (complex_type z)
return v;
}
+#endif
Index: libgfortran/m4/chyp.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/chyp.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 chyp.m4
--- libgfortran/m4/chyp.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/chyp.m4 26 Jun 2005 20:14:50 -0000
@@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined(HAVE_'complex_type`) && defined(HAVE_'real_type`)'
+
/* Complex number z = a + ib. */
/* sinh(z) = sinh(a)cos(b) + icosh(a)sin(b) */
@@ -79,3 +81,4 @@ ctanh`'q (complex_type a)
return n / d;
}
+#endif
Index: libgfortran/m4/ctrig.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/ctrig.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 ctrig.m4
--- libgfortran/m4/ctrig.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/ctrig.m4 26 Jun 2005 20:14:50 -0000
@@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined (HAVE_'complex_type`)'
+
/* Complex number z = a + ib. */
/* sin(z) = sin(a)cosh(b) + icos(a)sinh(b) */
@@ -79,3 +81,4 @@ ctan`'q (complex_type a)
return n / d;
}
+#endif
Index: libgfortran/m4/exponent.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/exponent.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 exponent.m4
--- libgfortran/m4/exponent.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/exponent.m4 26 Jun 2005 20:14:50 -0000
@@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`)'
+
extern GFC_INTEGER_4 exponent_r`'kind (real_type s);
export_proto(exponent_r`'kind);
@@ -42,3 +44,5 @@ exponent_r`'kind (real_type s)
frexp`'q (s, &ret);
return ret;
}
+
+#endif
Index: libgfortran/m4/fraction.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/fraction.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 fraction.m4
--- libgfortran/m4/fraction.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/fraction.m4 26 Jun 2005 20:14:50 -0000
@@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`)'
+
extern real_type fraction_r`'kind (real_type s);
export_proto(fraction_r`'kind);
@@ -41,3 +43,5 @@ fraction_r`'kind (real_type s)
int dummy_exp;
return frexp`'q (s, &dummy_exp);
}
+
+#endif
Index: libgfortran/m4/mtype.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/mtype.m4,v
retrieving revision 1.2
diff -u -3 -p -r1.2 mtype.m4
--- libgfortran/m4/mtype.m4 13 May 2004 06:41:03 -0000 1.2
+++ libgfortran/m4/mtype.m4 26 Jun 2005 20:14:50 -0000
@@ -2,4 +2,4 @@ dnl Get type kind from filename.
define(kind,regexp(file, `_.\([0-9]+\).c$', `\1'))dnl
define(complex_type, `GFC_COMPLEX_'kind)dnl
define(real_type, `GFC_REAL_'kind)dnl
-define(q,ifelse(kind,4,f,ifelse(kind,8,`',`_'kind)))dnl
+define(q,ifelse(kind,4,f,ifelse(kind,8,`',ifelse(kind,10,l,ifelse(kind,16,l,`_'kind)))))dnl
Index: libgfortran/m4/nearest.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/nearest.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 nearest.m4
--- libgfortran/m4/nearest.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/nearest.m4 26 Jun 2005 20:14:50 -0000
@@ -33,6 +33,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`)'
+
extern real_type nearest_r`'kind (real_type s, real_type dir);
export_proto(nearest_r`'kind);
@@ -49,3 +51,5 @@ nearest_r`'kind (real_type s, real_type
else
return nextafter`'q (s, dir);
}
+
+#endif
Index: libgfortran/m4/pow.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/pow.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 pow.m4
--- libgfortran/m4/pow.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/pow.m4 26 Jun 2005 20:14:50 -0000
@@ -37,6 +37,8 @@ include(iparm.m4)dnl
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+`#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)'
+
rtype_name `pow_'rtype_code`_'atype_code (rtype_name a, atype_name b);
export_proto(pow_`'rtype_code`_'atype_code);
@@ -78,3 +80,5 @@ ifelse(rtype_letter,i,`dnl
}
return pow;
}
+
+#endif
Index: libgfortran/m4/set_exponent.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/set_exponent.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 set_exponent.m4
--- libgfortran/m4/set_exponent.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/set_exponent.m4 26 Jun 2005 20:14:51 -0000
@@ -32,6 +32,8 @@ Boston, MA 02111-1307, USA. */
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`)'
+
extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i);
export_proto(set_exponent_r`'kind);
@@ -41,3 +43,5 @@ set_exponent_r`'kind (real_type s, GFC_I
int dummy_exp;
return scalbn`'q (frexp`'q (s, &dummy_exp), i);
}
+
+#endif