This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran,patch] Front-end and library support for large integerand real kinds
- From: FX Coudert <fxcoudert at gmail dot com>
- To: gfortran <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 19 Jul 2005 19:14:49 +0200
- Subject: [gfortran,patch] Front-end and library support for large integerand real kinds
This new round of patches adds support for integer(16), real(10) and
real(16) kinds in function calls. It is similar in design to the patch
proposed in http://gcc.gnu.org/ml/fortran/2005-06/msg00429.html, which
did not raise much comment. I splitted it up in 3 parts so that it is
easier to read:
* middle-end changes: this small patch has already been submitted on
the gcc list twice, but nobody reviewed it yet. Unfortunately, it is
necessary to support the complex log10 function.
* front-end: this is the difficult patch.
* library: mainly support for array functions. All generated files
should be deleted and then regenerated. The fortran generated files will
have a .F90 suffix (instead of .f90) since I used preprocessing to
compile code only for the supported kinds. A new include file
(kinds.inc) is used for that purpose.
Can someone review it? Or only part of it? I guess the front-end part is
more difficult and will need more care that the library part, since I am
not an expert in this area.
Thanks,
FX
2005-06-28 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* f95-lang.c (DO_DEFINE_MATH_BUILTIN): Add support for long
double builtin function.
(gfc_init_builtin_functions): Add mfunc_longdouble,
mfunc_clongdouble and func_clongdouble_longdouble trees. Build
them for round, trunc, cabs, copysign and pow functions.
* iresolve.c (gfc_resolve_reshape, gfc_resolve_transpose): Add
case for kind 10 and 16.
* trans-decl.c: Add trees for cpowl10, cpowl16, ishftc16,
exponent10 and exponent16.
(gfc_build_intrinsic_function_decls): Build nodes for int16,
real10, real16, complex10 and complex16 types. Build all possible
combinations for function _gfortran_pow_?n_?n. Build function
calls cpowl10, cpowl16, ishftc16, exponent10 and exponent16.
* trans-expr.c (gfc_conv_power_op): Add case for integer(16),
real(10) and real(16).
* trans-intrinsic.c: Add suppport for long double builtin
functions in BUILT_IN_FUNCTION, LIBM_FUNCTION and LIBF_FUNCTION
macros.
(gfc_conv_intrinsic_aint): Add case for integer(16), real(10) and
real(16) kinds.
(gfc_build_intrinsic_lib_fndecls): Add support for real10_decl
and real16_decl in library functions.
(gfc_get_intrinsic_lib_fndecl): Add cases for real and complex
kinds 10 and 16.
(gfc_conv_intrinsic_exponent): Add cases for real(10) and
real(16) kinds.
(gfc_conv_intrinsic_sign): Likewise.
(gfc_conv_intrinsic_ishftc): Add case for integer(16) kind.
* trans-types.c (gfc_get_int_type, gfc_get_real_type,
gfc_get_complex_type, gfc_get_logical_type): Doesn't error out in
the case of kinds not available.
* trans.h: Declare trees for cpowl10, cpowl16, ishftc16,
exponent10 and exponent16.
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 3 Jul 2005 02:20:21 -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], \
@@ -734,11 +736,9 @@ gfc_define_builtin (const char * name,
#define DEFINE_MATH_BUILTIN(code, name, argtype) \
DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
-/* The middle-end is missing builtins for some complex math functions, so
- we don't use them yet. */
#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
- DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
-/* DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)*/
+ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
+ DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
/* Create function types for builtin functions. */
@@ -768,17 +768,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 +791,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 3 Jul 2005 02:20:22 -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 3 Jul 2005 02:20:22 -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 3 Jul 2005 02:20:23 -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 3 Jul 2005 02:20:24 -0000
@@ -54,12 +54,18 @@ typedef struct gfc_intrinsic_map_t GTY((
of gcc, or END_BUILTINS of no such value set. */
/* ??? There are now complex variants in builtins.def, though we
don't currently do anything with them. */
- enum built_in_function code4;
- enum built_in_function code8;
+ enum built_in_function code_r4;
+ enum built_in_function code_r8;
+ enum built_in_function code_r10;
+ enum built_in_function code_r16;
+ enum built_in_function code_c4;
+ enum built_in_function code_c8;
+ enum built_in_function code_c10;
+ enum built_in_function code_c16;
/* 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,32 +80,44 @@ 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;
/* ??? The NARGS==1 hack here is based on the fact that (c99 at least)
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},
-
-#define DEFINE_MATH_BUILTIN(id, name, argtype) \
- BUILT_IN_FUNCTION (id, name, false)
-
-/* TODO: Use builtin function for complex intrinsics. */
-#define DEFINE_MATH_BUILTIN_C(id, name, argtype) \
- BUILT_IN_FUNCTION (id, name, true)
+#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) \
+ { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+ BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, 0, 0, 0, 0, true, \
+ false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+// BUILT_IN_FUNCTION (id, name, false)
+
+#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) \
+ { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+ BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, \
+ BUILT_IN_C ## ID, BUILT_IN_C ## ID ## L, BUILT_IN_C ## ID ## L, true, \
+ true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+// 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, \
+ 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, \
+ 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 +354,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 +372,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;
@@ -469,10 +497,22 @@ gfc_build_intrinsic_lib_fndecls (void)
/* Add GCC builtin functions. */
for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++)
{
- if (m->code4 != END_BUILTINS)
- m->real4_decl = built_in_decls[m->code4];
- if (m->code8 != END_BUILTINS)
- m->real8_decl = built_in_decls[m->code8];
+ if (m->code_r4 != END_BUILTINS)
+ m->real4_decl = built_in_decls[m->code_r4];
+ if (m->code_r8 != END_BUILTINS)
+ m->real8_decl = built_in_decls[m->code_r8];
+ if (m->code_r10 != END_BUILTINS)
+ m->real10_decl = built_in_decls[m->code_r10];
+ if (m->code_r16 != END_BUILTINS)
+ m->real16_decl = built_in_decls[m->code_r16];
+ if (m->code_c4 != END_BUILTINS)
+ m->complex4_decl = built_in_decls[m->code_c4];
+ if (m->code_c8 != END_BUILTINS)
+ m->complex8_decl = built_in_decls[m->code_c8];
+ if (m->code_c10 != END_BUILTINS)
+ m->complex10_decl = built_in_decls[m->code_c10];
+ if (m->code_c16 != END_BUILTINS)
+ m->complex16_decl = built_in_decls[m->code_c16];
}
}
@@ -501,6 +541,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 +563,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 +581,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 +668,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 +794,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 +960,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 +1929,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 3 Jul 2005 02:20:24 -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 3 Jul 2005 02:20:25 -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;
2005-06-28 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* Makefile.am: Add generated files for large real and integers
kinds. Add a rule to create the kinds.inc file. Use kinds.inc to
preprocess Fortran generated files.
* libgfortran.h: Add macro definitions for GFC_INTEGER_16_HUGE,
GFC_REAL_10_HUGE and GFC_REAL_16_HUGE. Add types gfc_array_i16,
gfc_array_r10, gfc_array_r16, gfc_array_c10, gfc_array_c16,
gfc_array_l16.
* mk-kinds-h.sh: Define macros HAVE_GFC_LOGICAL_* and
HAVE_GFC_COMPLEX_* when these types are available.
* intrinsics/ishftc.c (ishftc16): New function for GFC_INTEGER_16.
* m4/all.m4, m4/any.m4, m4/cexp.m4, m4/chyp.m4, m4/count.m4,
m4/cshift1.m4, m4/ctrig.m4, m4/dotprod.m4, m4/dotprodc.m4,
m4/dotprodl.m4, m4/eoshift1.m4, m4/eoshift3.m4, m4/exponent.m4,
m4/fraction.m4, m4/in_pack.m4, m4/in_unpack.m4, m4/matmul.m4,
m4/matmull.m4, m4/maxloc0.m4, m4/maxloc1.m4, m4/maxval.m4,
m4/minloc0.m4, m4/minloc1.m4, m4/minval.m4, m4/mtype.m4, m4/nearest.m4,
m4/pow.m4, m4/product.m4, m4/reshape.m4, m4/set_exponent.m4,
m4/shape.m4, m4/specific.m4, m4/specific2.m4, m4/sum.m4,
m4/transpose.m4: Protect generated functions with appropriate
"#if defined (HAVE_GFC_type_kind)" preprocessor directives.
* Makefile.in: Regenerate.
* all files in generated/: Regenerate.
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 3 Jul 2005 06:48:44 -0000
@@ -108,181 +108,313 @@ libgfortran.h
i_all_c= \
generated/all_l4.c \
-generated/all_l8.c
+generated/all_l8.c \
+generated/all_l16.c
i_any_c= \
generated/any_l4.c \
-generated/any_l8.c
+generated/any_l8.c \
+generated/any_l16.c
i_count_c= \
generated/count_4_l4.c \
generated/count_8_l4.c \
+generated/count_16_l4.c \
generated/count_4_l8.c \
-generated/count_8_l8.c
+generated/count_8_l8.c \
+generated/count_16_l8.c \
+generated/count_4_l16.c \
+generated/count_8_l16.c \
+generated/count_16_l16.c
i_maxloc0_c= \
generated/maxloc0_4_i4.c \
generated/maxloc0_8_i4.c \
+generated/maxloc0_16_i4.c \
generated/maxloc0_4_i8.c \
generated/maxloc0_8_i8.c \
+generated/maxloc0_16_i8.c \
+generated/maxloc0_4_i16.c \
+generated/maxloc0_8_i16.c \
+generated/maxloc0_16_i16.c \
generated/maxloc0_4_r4.c \
generated/maxloc0_8_r4.c \
+generated/maxloc0_16_r4.c \
generated/maxloc0_4_r8.c \
-generated/maxloc0_8_r8.c
+generated/maxloc0_8_r8.c \
+generated/maxloc0_16_r8.c \
+generated/maxloc0_4_r10.c \
+generated/maxloc0_8_r10.c \
+generated/maxloc0_16_r10.c \
+generated/maxloc0_4_r16.c \
+generated/maxloc0_8_r16.c \
+generated/maxloc0_16_r16.c
i_maxloc1_c= \
generated/maxloc1_4_i4.c \
generated/maxloc1_8_i4.c \
+generated/maxloc1_16_i4.c \
generated/maxloc1_4_i8.c \
generated/maxloc1_8_i8.c \
+generated/maxloc1_16_i8.c \
+generated/maxloc1_4_i16.c \
+generated/maxloc1_8_i16.c \
+generated/maxloc1_16_i16.c \
generated/maxloc1_4_r4.c \
generated/maxloc1_8_r4.c \
+generated/maxloc1_16_r4.c \
generated/maxloc1_4_r8.c \
-generated/maxloc1_8_r8.c
+generated/maxloc1_8_r8.c \
+generated/maxloc1_16_r8.c \
+generated/maxloc1_4_r10.c \
+generated/maxloc1_8_r10.c \
+generated/maxloc1_16_r10.c \
+generated/maxloc1_4_r16.c \
+generated/maxloc1_8_r16.c \
+generated/maxloc1_16_r16.c
i_maxval_c= \
generated/maxval_i4.c \
generated/maxval_i8.c \
+generated/maxval_i16.c \
generated/maxval_r4.c \
-generated/maxval_r8.c
+generated/maxval_r8.c \
+generated/maxval_r10.c \
+generated/maxval_r16.c
i_minloc0_c= \
generated/minloc0_4_i4.c \
generated/minloc0_8_i4.c \
+generated/minloc0_16_i4.c \
generated/minloc0_4_i8.c \
generated/minloc0_8_i8.c \
+generated/minloc0_16_i8.c \
+generated/minloc0_4_i16.c \
+generated/minloc0_8_i16.c \
+generated/minloc0_16_i16.c \
generated/minloc0_4_r4.c \
generated/minloc0_8_r4.c \
+generated/minloc0_16_r4.c \
generated/minloc0_4_r8.c \
-generated/minloc0_8_r8.c
+generated/minloc0_8_r8.c \
+generated/minloc0_16_r8.c \
+generated/minloc0_4_r10.c \
+generated/minloc0_8_r10.c \
+generated/minloc0_16_r10.c \
+generated/minloc0_4_r16.c \
+generated/minloc0_8_r16.c \
+generated/minloc0_16_r16.c
i_minloc1_c= \
generated/minloc1_4_i4.c \
generated/minloc1_8_i4.c \
+generated/minloc1_16_i4.c \
generated/minloc1_4_i8.c \
generated/minloc1_8_i8.c \
+generated/minloc1_16_i8.c \
+generated/minloc1_4_i16.c \
+generated/minloc1_8_i16.c \
+generated/minloc1_16_i16.c \
generated/minloc1_4_r4.c \
generated/minloc1_8_r4.c \
+generated/minloc1_16_r4.c \
generated/minloc1_4_r8.c \
-generated/minloc1_8_r8.c
+generated/minloc1_8_r8.c \
+generated/minloc1_16_r8.c \
+generated/minloc1_4_r10.c \
+generated/minloc1_8_r10.c \
+generated/minloc1_16_r10.c \
+generated/minloc1_4_r16.c \
+generated/minloc1_8_r16.c \
+generated/minloc1_16_r16.c
i_minval_c= \
generated/minval_i4.c \
generated/minval_i8.c \
+generated/minval_i16.c \
generated/minval_r4.c \
-generated/minval_r8.c
+generated/minval_r8.c \
+generated/minval_r10.c \
+generated/minval_r16.c
i_sum_c= \
generated/sum_i4.c \
generated/sum_i8.c \
+generated/sum_i16.c \
generated/sum_r4.c \
generated/sum_r8.c \
+generated/sum_r10.c \
+generated/sum_r16.c \
generated/sum_c4.c \
-generated/sum_c8.c
+generated/sum_c8.c \
+generated/sum_c10.c \
+generated/sum_c16.c
i_product_c= \
generated/product_i4.c \
generated/product_i8.c \
+generated/product_i16.c \
generated/product_r4.c \
generated/product_r8.c \
+generated/product_r10.c \
+generated/product_r16.c \
generated/product_c4.c \
-generated/product_c8.c
+generated/product_c8.c \
+generated/product_c10.c \
+generated/product_c16.c
i_dotprod_c= \
generated/dotprod_i4.c \
generated/dotprod_i8.c \
+generated/dotprod_i16.c \
generated/dotprod_r4.c \
-generated/dotprod_r8.c
+generated/dotprod_r8.c \
+generated/dotprod_r10.c \
+generated/dotprod_r16.c
i_dotprodl_c= \
generated/dotprod_l4.c \
-generated/dotprod_l8.c
+generated/dotprod_l8.c \
+generated/dotprod_l16.c
i_dotprodc_c= \
generated/dotprod_c4.c \
-generated/dotprod_c8.c
+generated/dotprod_c8.c \
+generated/dotprod_c10.c \
+generated/dotprod_c16.c
i_matmul_c= \
generated/matmul_i4.c \
generated/matmul_i8.c \
+generated/matmul_i16.c \
generated/matmul_r4.c \
generated/matmul_r8.c \
+generated/matmul_r10.c \
+generated/matmul_r16.c \
generated/matmul_c4.c \
-generated/matmul_c8.c
+generated/matmul_c8.c \
+generated/matmul_c10.c \
+generated/matmul_c16.c
i_matmull_c= \
generated/matmul_l4.c \
-generated/matmul_l8.c
+generated/matmul_l8.c \
+generated/matmul_l16.c
i_transpose_c= \
generated/transpose_i4.c \
generated/transpose_i8.c \
+generated/transpose_i16.c \
generated/transpose_c4.c \
-generated/transpose_c8.c
+generated/transpose_c8.c \
+generated/transpose_c10.c \
+generated/transpose_c16.c
i_shape_c= \
generated/shape_i4.c \
-generated/shape_i8.c
+generated/shape_i8.c \
+generated/shape_i16.c
i_reshape_c= \
generated/reshape_i4.c \
generated/reshape_i8.c \
+generated/reshape_i16.c \
generated/reshape_c4.c \
-generated/reshape_c8.c
+generated/reshape_c8.c \
+generated/reshape_c10.c \
+generated/reshape_c16.c
i_eoshift1_c= \
generated/eoshift1_4.c \
-generated/eoshift1_8.c
+generated/eoshift1_8.c \
+generated/eoshift1_16.c
i_eoshift3_c= \
generated/eoshift3_4.c \
-generated/eoshift3_8.c
+generated/eoshift3_8.c \
+generated/eoshift3_16.c
i_cshift1_c= \
generated/cshift1_4.c \
-generated/cshift1_8.c
+generated/cshift1_8.c \
+generated/cshift1_16.c
in_pack_c = \
generated/in_pack_i4.c \
generated/in_pack_i8.c \
+generated/in_pack_i16.c \
generated/in_pack_c4.c \
-generated/in_pack_c8.c
+generated/in_pack_c8.c \
+generated/in_pack_c10.c \
+generated/in_pack_c16.c
in_unpack_c = \
generated/in_unpack_i4.c \
generated/in_unpack_i8.c \
+generated/in_unpack_i16.c \
generated/in_unpack_c4.c \
-generated/in_unpack_c8.c
+generated/in_unpack_c8.c \
+generated/in_unpack_c10.c \
+generated/in_unpack_c16.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 \
@@ -300,96 +432,167 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
$(i_pow_c) \
- selected_int_kind.inc selected_real_kind.inc kinds.h
+ selected_int_kind.inc selected_real_kind.inc kinds.h kinds.inc
# We only use these if libm doesn't contain complex math functions.
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= \
-generated/_abs_c4.f90 \
-generated/_abs_c8.f90 \
-generated/_abs_i4.f90 \
-generated/_abs_i8.f90 \
-generated/_abs_r4.f90 \
-generated/_abs_r8.f90 \
-generated/_exp_r4.f90 \
-generated/_exp_r8.f90 \
-generated/_exp_c4.f90 \
-generated/_exp_c8.f90 \
-generated/_log_r4.f90 \
-generated/_log_r8.f90 \
-generated/_log_c4.f90 \
-generated/_log_c8.f90 \
-generated/_log10_r4.f90 \
-generated/_log10_r8.f90 \
-generated/_sqrt_r4.f90 \
-generated/_sqrt_r8.f90 \
-generated/_sqrt_c4.f90 \
-generated/_sqrt_c8.f90 \
-generated/_asin_r4.f90 \
-generated/_asin_r8.f90 \
-generated/_acos_r4.f90 \
-generated/_acos_r8.f90 \
-generated/_atan_r4.f90 \
-generated/_atan_r8.f90 \
-generated/_sin_r4.f90 \
-generated/_sin_r8.f90 \
-generated/_sin_c4.f90 \
-generated/_sin_c8.f90 \
-generated/_cos_r4.f90 \
-generated/_cos_r8.f90 \
-generated/_cos_c4.f90 \
-generated/_cos_c8.f90 \
-generated/_tan_r4.f90 \
-generated/_tan_r8.f90 \
-generated/_sinh_r4.f90 \
-generated/_sinh_r8.f90 \
-generated/_cosh_r4.f90 \
-generated/_cosh_r8.f90 \
-generated/_tanh_r4.f90 \
-generated/_tanh_r8.f90 \
-generated/_conjg_c4.f90 \
-generated/_conjg_c8.f90 \
-generated/_aint_r4.f90 \
-generated/_aint_r8.f90 \
-generated/_anint_r4.f90 \
-generated/_anint_r8.f90
+generated/_abs_c4.F90 \
+generated/_abs_c8.F90 \
+generated/_abs_c10.F90 \
+generated/_abs_c16.F90 \
+generated/_abs_i4.F90 \
+generated/_abs_i8.F90 \
+generated/_abs_i16.F90 \
+generated/_abs_r4.F90 \
+generated/_abs_r8.F90 \
+generated/_abs_r10.F90 \
+generated/_abs_r16.F90 \
+generated/_exp_r4.F90 \
+generated/_exp_r8.F90 \
+generated/_exp_r10.F90 \
+generated/_exp_r16.F90 \
+generated/_exp_c4.F90 \
+generated/_exp_c8.F90 \
+generated/_exp_c10.F90 \
+generated/_exp_c16.F90 \
+generated/_log_r4.F90 \
+generated/_log_r8.F90 \
+generated/_log_r10.F90 \
+generated/_log_r16.F90 \
+generated/_log_c4.F90 \
+generated/_log_c8.F90 \
+generated/_log_c10.F90 \
+generated/_log_c16.F90 \
+generated/_log10_r4.F90 \
+generated/_log10_r8.F90 \
+generated/_log10_r10.F90 \
+generated/_log10_r16.F90 \
+generated/_sqrt_r4.F90 \
+generated/_sqrt_r8.F90 \
+generated/_sqrt_r10.F90 \
+generated/_sqrt_r16.F90 \
+generated/_sqrt_c4.F90 \
+generated/_sqrt_c8.F90 \
+generated/_sqrt_c10.F90 \
+generated/_sqrt_c16.F90 \
+generated/_asin_r4.F90 \
+generated/_asin_r8.F90 \
+generated/_asin_r10.F90 \
+generated/_asin_r16.F90 \
+generated/_acos_r4.F90 \
+generated/_acos_r8.F90 \
+generated/_acos_r10.F90 \
+generated/_acos_r16.F90 \
+generated/_atan_r4.F90 \
+generated/_atan_r8.F90 \
+generated/_atan_r10.F90 \
+generated/_atan_r16.F90 \
+generated/_sin_r4.F90 \
+generated/_sin_r8.F90 \
+generated/_sin_r10.F90 \
+generated/_sin_r16.F90 \
+generated/_sin_c4.F90 \
+generated/_sin_c8.F90 \
+generated/_sin_c10.F90 \
+generated/_sin_c16.F90 \
+generated/_cos_r4.F90 \
+generated/_cos_r8.F90 \
+generated/_cos_r10.F90 \
+generated/_cos_r16.F90 \
+generated/_cos_c4.F90 \
+generated/_cos_c8.F90 \
+generated/_cos_c10.F90 \
+generated/_cos_c16.F90 \
+generated/_tan_r4.F90 \
+generated/_tan_r8.F90 \
+generated/_tan_r10.F90 \
+generated/_tan_r16.F90 \
+generated/_sinh_r4.F90 \
+generated/_sinh_r8.F90 \
+generated/_sinh_r10.F90 \
+generated/_sinh_r16.F90 \
+generated/_cosh_r4.F90 \
+generated/_cosh_r8.F90 \
+generated/_cosh_r10.F90 \
+generated/_cosh_r16.F90 \
+generated/_tanh_r4.F90 \
+generated/_tanh_r8.F90 \
+generated/_tanh_r10.F90 \
+generated/_tanh_r16.F90 \
+generated/_conjg_c4.F90 \
+generated/_conjg_c8.F90 \
+generated/_conjg_c10.F90 \
+generated/_conjg_c16.F90 \
+generated/_aint_r4.F90 \
+generated/_aint_r8.F90 \
+generated/_aint_r10.F90 \
+generated/_aint_r16.F90 \
+generated/_anint_r4.F90 \
+generated/_anint_r8.F90 \
+generated/_anint_r10.F90 \
+generated/_anint_r16.F90
gfor_built_specific2_src= \
-generated/_sign_i4.f90 \
-generated/_sign_i8.f90 \
-generated/_sign_r4.f90 \
-generated/_sign_r8.f90 \
-generated/_dim_i4.f90 \
-generated/_dim_i8.f90 \
-generated/_dim_r4.f90 \
-generated/_dim_r8.f90 \
-generated/_atan2_r4.f90 \
-generated/_atan2_r8.f90 \
-generated/_mod_i4.f90 \
-generated/_mod_i8.f90 \
-generated/_mod_r4.f90 \
-generated/_mod_r8.f90
+generated/_sign_i4.F90 \
+generated/_sign_i8.F90 \
+generated/_sign_i16.F90 \
+generated/_sign_r4.F90 \
+generated/_sign_r8.F90 \
+generated/_sign_r10.F90 \
+generated/_sign_r16.F90 \
+generated/_dim_i4.F90 \
+generated/_dim_i8.F90 \
+generated/_dim_i16.F90 \
+generated/_dim_r4.F90 \
+generated/_dim_r8.F90 \
+generated/_dim_r10.F90 \
+generated/_dim_r16.F90 \
+generated/_atan2_r4.F90 \
+generated/_atan2_r8.F90 \
+generated/_atan2_r10.F90 \
+generated/_atan2_r16.F90 \
+generated/_mod_i4.F90 \
+generated/_mod_i8.F90 \
+generated/_mod_i16.F90 \
+generated/_mod_r4.F90 \
+generated/_mod_r8.F90
+# This is commented out until a bug in mod is fixed
+#generated/_mod_r10.F90 \
+#generated/_mod_r16.F90
#specific intrinsics requiring manal code
#gfor_specific_c= \
intrinsics/_aimag.c \
@@ -423,6 +626,9 @@ I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@
+kinds.inc: kinds.h
+ grep '^#' < kinds.h > $@
+
selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
$(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
Index: libgfortran/libgfortran.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/libgfortran.h,v
retrieving revision 1.26
diff -u -3 -p -r1.26 libgfortran.h
--- libgfortran/libgfortran.h 23 Jun 2005 18:50:24 -0000 1.26
+++ libgfortran/libgfortran.h 3 Jul 2005 02:22:56 -0000
@@ -217,8 +217,19 @@ internal_proto(l8_to_l4_offset);
(GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
#define GFC_INTEGER_8_HUGE \
(GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
+#ifdef HAVE_GFC_INTEGER_16
+#define GFC_INTEGER_16_HUGE \
+ (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
+#endif
+
#define GFC_REAL_4_HUGE FLT_MAX
#define GFC_REAL_8_HUGE DBL_MAX
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_HUGE LDBL_MAX
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_HUGE LDBL_MAX
+#endif
#ifndef GFC_MAX_DIMENSIONS
#define GFC_MAX_DIMENSIONS 7
@@ -245,12 +256,30 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
+#ifdef HAVE_GFC_INTEGER_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
+#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
+#ifdef HAVE_GFC_REAL_10
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
+#endif
+#ifdef HAVE_GFC_REAL_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
+#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
+#ifdef HAVE_GFC_COMPLEX_10
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
+#endif
+#ifdef HAVE_GFC_COMPLEX_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
+#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
+#ifdef HAVE_GFC_LOGICAL_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
+#endif
#define GFC_DTYPE_RANK_MASK 0x07
#define GFC_DTYPE_TYPE_SHIFT 3
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 3 Jul 2005 02:22:56 -0000
@@ -24,6 +24,7 @@ for k in $possible_integer_kinds; do
echo "typedef ${prefix}int${s}_t GFC_INTEGER_${k};"
echo "typedef ${prefix}uint${s}_t GFC_UINTEGER_${k};"
echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
+ echo "#define HAVE_GFC_LOGICAL_${k}"
echo "#define HAVE_GFC_INTEGER_${k}"
fi
rm -f tmp$$.*
@@ -50,6 +51,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/all.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/all.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 all.m4
--- libgfortran/m4/all.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/all.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(1,
` /* Return true only if all the elements are set. */
result = 1;',
@@ -44,3 +47,4 @@ ARRAY_FUNCTION(1,
break;
}')
+#endif
Index: libgfortran/m4/any.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/any.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 any.m4
--- libgfortran/m4/any.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/any.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` result = 0;',
` /* Return true if any of the elements are set. */
@@ -44,3 +47,4 @@ ARRAY_FUNCTION(0,
break;
}')
+#endif
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 3 Jul 2005 02:22:57 -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 3 Jul 2005 02:22:57 -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/count.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/count.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 count.m4
--- libgfortran/m4/count.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/count.m4 3 Jul 2005 02:22:57 -0000
@@ -35,8 +35,12 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` result = 0;',
` if (*src)
result++;')
+#endif
Index: libgfortran/m4/cshift1.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/cshift1.m4,v
retrieving revision 1.8
diff -u -3 -p -r1.8 cshift1.m4
--- libgfortran/m4/cshift1.m4 25 Jun 2005 09:56:32 -0000 1.8
+++ libgfortran/m4/cshift1.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
void cshift1_`'atype_kind (gfc_array_char * ret,
const gfc_array_char * array,
const atype * h, const atype_name * pwhich);
@@ -202,3 +204,5 @@ cshift1_`'atype_kind (gfc_array_char * r
}
}
}
+
+#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 3 Jul 2005 02:22:57 -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/dotprod.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/dotprod.m4,v
retrieving revision 1.6
diff -u -3 -p -r1.6 dotprod.m4
--- libgfortran/m4/dotprod.m4 12 Jan 2005 21:27:31 -0000 1.6
+++ libgfortran/m4/dotprod.m4 3 Jul 2005 02:22:57 -0000
@@ -34,6 +34,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b);
@@ -75,3 +77,5 @@ sinclude(`dotprod_asm_'rtype_code`.m4')d
return res;
}
+
+#endif
Index: libgfortran/m4/dotprodc.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/dotprodc.m4,v
retrieving revision 1.6
diff -u -3 -p -r1.6 dotprodc.m4
--- libgfortran/m4/dotprodc.m4 12 Jan 2005 21:27:31 -0000 1.6
+++ libgfortran/m4/dotprodc.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b);
@@ -78,3 +80,5 @@ sinclude(`dotprod_asm_'rtype_code`.m4')d
return res;
}
+
+#endif
Index: libgfortran/m4/dotprodl.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/dotprodl.m4,v
retrieving revision 1.6
diff -u -3 -p -r1.6 dotprodl.m4
--- libgfortran/m4/dotprodl.m4 12 Jan 2005 21:27:31 -0000 1.6
+++ libgfortran/m4/dotprodl.m4 3 Jul 2005 02:22:57 -0000
@@ -34,6 +34,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
extern rtype_name dot_product_`'rtype_code (gfc_array_l4 *, gfc_array_l4 *);
export_proto(dot_product_`'rtype_code);
@@ -84,3 +86,5 @@ dot_product_`'rtype_code (gfc_array_l4 *
return 0;
}
+
+#endif
Index: libgfortran/m4/eoshift1.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/eoshift1.m4,v
retrieving revision 1.9
diff -u -3 -p -r1.9 eoshift1.m4
--- libgfortran/m4/eoshift1.m4 25 Jun 2005 09:56:32 -0000 1.9
+++ libgfortran/m4/eoshift1.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static const char zeros[16] =
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
@@ -219,3 +221,5 @@ eoshift1_`'atype_kind (gfc_array_char *r
}
}
}
+
+#endif
Index: libgfortran/m4/eoshift3.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/eoshift3.m4,v
retrieving revision 1.9
diff -u -3 -p -r1.9 eoshift3.m4
--- libgfortran/m4/eoshift3.m4 25 Jun 2005 09:56:32 -0000 1.9
+++ libgfortran/m4/eoshift3.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static const char zeros[16] =
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
@@ -231,3 +233,5 @@ eoshift3_`'atype_kind (gfc_array_char *r
}
}
}
+
+#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 3 Jul 2005 02:22:57 -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 3 Jul 2005 02:22:57 -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/in_pack.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/in_pack.m4,v
retrieving revision 1.6
diff -u -3 -p -r1.6 in_pack.m4
--- libgfortran/m4/in_pack.m4 11 Jun 2005 19:39:09 -0000 1.6
+++ libgfortran/m4/in_pack.m4 3 Jul 2005 02:22:57 -0000
@@ -34,6 +34,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
@@ -124,3 +126,4 @@ rtype_name *
return destptr;
}
+#endif
Index: libgfortran/m4/in_unpack.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/in_unpack.m4,v
retrieving revision 1.6
diff -u -3 -p -r1.6 in_unpack.m4
--- libgfortran/m4/in_unpack.m4 11 Jun 2005 19:39:09 -0000 1.6
+++ libgfortran/m4/in_unpack.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
dnl Only the kind (ie size) is used to name the function for integers,
dnl reals and logicals. For complex, it's c4 and c8.
void
@@ -112,3 +114,4 @@ void
}
}
+#endif
Index: libgfortran/m4/matmul.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/matmul.m4,v
retrieving revision 1.13
diff -u -3 -p -r1.13 matmul.m4
--- libgfortran/m4/matmul.m4 7 Jun 2005 20:46:12 -0000 1.13
+++ libgfortran/m4/matmul.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
@@ -217,3 +219,5 @@ sinclude(`matmul_asm_'rtype_code`.m4')dn
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
Index: libgfortran/m4/matmull.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/matmull.m4,v
retrieving revision 1.9
diff -u -3 -p -r1.9 matmull.m4
--- libgfortran/m4/matmull.m4 15 May 2005 15:37:06 -0000 1.9
+++ libgfortran/m4/matmull.m4 3 Jul 2005 02:22:57 -0000
@@ -34,6 +34,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
/* Dimensions: retarray(x,y) a(x, count) b(count,y).
Either a or b can be rank 1. In this case x or y is 1. */
@@ -192,3 +194,5 @@ sinclude(`matmul_asm_'rtype_code`.m4')dn
dest += rystride - (rxstride * xcount);
}
}
+
+#endif
Index: libgfortran/m4/maxloc0.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/maxloc0.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 maxloc0.m4
--- libgfortran/m4/maxloc0.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/maxloc0.m4 3 Jul 2005 02:22:57 -0000
@@ -38,6 +38,8 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(iforeach.m4)dnl
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
FOREACH_FUNCTION(
` atype_name maxval;
@@ -61,3 +63,5 @@ MASKED_FOREACH_FUNCTION(
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
+
+#endif
Index: libgfortran/m4/maxloc1.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/maxloc1.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 maxloc1.m4
--- libgfortran/m4/maxloc1.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/maxloc1.m4 3 Jul 2005 02:22:57 -0000
@@ -37,6 +37,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` atype_name maxval;
maxval = atype_min;
@@ -57,3 +60,4 @@ MASKED_ARRAY_FUNCTION(0,
result = (rtype_name)n + 1;
}')
+#endif
Index: libgfortran/m4/maxval.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/maxval.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 maxval.m4
--- libgfortran/m4/maxval.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/maxval.m4 3 Jul 2005 02:22:57 -0000
@@ -36,6 +36,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(atype_min,
` result = atype_min;',
` if (*src > result)
@@ -46,3 +49,4 @@ MASKED_ARRAY_FUNCTION(atype_min,
` if (*msrc && *src > result)
result = *src;')
+#endif
Index: libgfortran/m4/minloc0.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/minloc0.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 minloc0.m4
--- libgfortran/m4/minloc0.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/minloc0.m4 3 Jul 2005 02:22:57 -0000
@@ -38,6 +38,8 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(iforeach.m4)dnl
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
FOREACH_FUNCTION(
` atype_name minval;
@@ -61,3 +63,5 @@ MASKED_FOREACH_FUNCTION(
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
+
+#endif
Index: libgfortran/m4/minloc1.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/minloc1.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 minloc1.m4
--- libgfortran/m4/minloc1.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/minloc1.m4 3 Jul 2005 02:22:57 -0000
@@ -37,6 +37,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` atype_name minval;
minval = atype_max;
@@ -57,3 +60,4 @@ MASKED_ARRAY_FUNCTION(0,
result = (rtype_name)n + 1;
}')
+#endif
Index: libgfortran/m4/minval.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/minval.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 minval.m4
--- libgfortran/m4/minval.m4 12 Jan 2005 21:27:31 -0000 1.4
+++ libgfortran/m4/minval.m4 3 Jul 2005 02:22:57 -0000
@@ -36,6 +36,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(atype_max,
` result = atype_max;',
` if (*src < result)
@@ -46,3 +49,4 @@ MASKED_ARRAY_FUNCTION(atype_max,
` if (*msrc && *src < result)
result = *src;')
+#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 3 Jul 2005 02:22:57 -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 3 Jul 2005 02:22:57 -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 3 Jul 2005 02:22:57 -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/product.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/product.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 product.m4
--- libgfortran/m4/product.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/product.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(1,
` result = 1;',
` result *= *src;')
@@ -44,3 +47,4 @@ MASKED_ARRAY_FUNCTION(1,
` if (*msrc)
result *= *src;')
+#endif
Index: libgfortran/m4/reshape.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/reshape.m4,v
retrieving revision 1.10
diff -u -3 -p -r1.10 reshape.m4
--- libgfortran/m4/reshape.m4 9 Jun 2005 19:43:25 -0000 1.10
+++ libgfortran/m4/reshape.m4 3 Jul 2005 02:22:57 -0000
@@ -34,6 +34,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
@@ -258,3 +260,5 @@ reshape_`'rtype_ccode (rtype * ret, rtyp
}
}
}
+
+#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 3 Jul 2005 02:22:57 -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
Index: libgfortran/m4/shape.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/shape.m4,v
retrieving revision 1.6
diff -u -3 -p -r1.6 shape.m4
--- libgfortran/m4/shape.m4 12 Jan 2005 21:27:31 -0000 1.6
+++ libgfortran/m4/shape.m4 3 Jul 2005 02:22:57 -0000
@@ -34,6 +34,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
extern void shape_`'rtype_kind (rtype * ret, const rtype * array);
export_proto(shape_`'rtype_kind);
@@ -53,3 +55,5 @@ shape_`'rtype_kind (rtype * ret, const r
array->dim[n].ubound + 1 - array->dim[n].lbound;
}
}
+
+#endif
Index: libgfortran/m4/specific.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/specific.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 specific.m4
--- libgfortran/m4/specific.m4 18 May 2004 19:03:26 -0000 1.3
+++ libgfortran/m4/specific.m4 3 Jul 2005 02:22:57 -0000
@@ -1,5 +1,5 @@
include(head.m4)
-define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl
+define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl
define(atype_letter,substr(atype_code, 0, 1))dnl
define(atype_kind,substr(atype_code, 1))dnl
define(get_typename2, `$1 (kind=$2)')dnl
@@ -8,9 +8,15 @@ define(atype_name, get_typename(atype_le
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
define(function_name,`specific__'name`_'atype_code)dnl
+#include "kinds.inc"
+
+`#if defined (HAVE_GFC_'ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW))))`_'atype_kind`)'
+
elemental function function_name (parm)
atype_name, intent (in) :: parm
atype_name :: function_name
function_name = name (parm)
end function
+
+#endif
Index: libgfortran/m4/specific2.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/specific2.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 specific2.m4
--- libgfortran/m4/specific2.m4 18 May 2004 19:03:26 -0000 1.3
+++ libgfortran/m4/specific2.m4 3 Jul 2005 02:22:57 -0000
@@ -1,5 +1,5 @@
include(head.m4)
-define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl
+define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl
define(atype_letter,substr(atype_code, 0, 1))dnl
define(atype_kind,substr(atype_code, 1))dnl
define(get_typename2, `$1 (kind=$2)')dnl
@@ -8,9 +8,15 @@ define(atype_name, get_typename(atype_le
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
define(function_name,`specific__'name`_'atype_code)dnl
+#include "kinds.inc"
+
+`#if defined (HAVE_GFC_'ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW))))`_'atype_kind`)'
+
elemental function function_name (p1, p2)
atype_name, intent (in) :: p1, p2
atype_name :: function_name
function_name = name (p1, p2)
end function
+
+#endif
Index: libgfortran/m4/sum.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/sum.m4,v
retrieving revision 1.3
diff -u -3 -p -r1.3 sum.m4
--- libgfortran/m4/sum.m4 12 Jan 2005 21:27:31 -0000 1.3
+++ libgfortran/m4/sum.m4 3 Jul 2005 02:22:57 -0000
@@ -35,6 +35,9 @@ Boston, MA 02111-1307, USA. */
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` result = 0;',
` result += *src;')
@@ -43,3 +46,5 @@ MASKED_ARRAY_FUNCTION(0,
` result = 0;',
` if (*msrc)
result += *src;')
+
+#endif
Index: libgfortran/m4/transpose.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/m4/transpose.m4,v
retrieving revision 1.10
diff -u -3 -p -r1.10 transpose.m4
--- libgfortran/m4/transpose.m4 15 May 2005 12:44:41 -0000 1.10
+++ libgfortran/m4/transpose.m4 3 Jul 2005 02:22:57 -0000
@@ -33,6 +33,8 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
extern void transpose_`'rtype_code (rtype * ret, rtype * source);
export_proto(transpose_`'rtype_code);
@@ -97,3 +99,5 @@ transpose_`'rtype_code (rtype * ret, rty
rptr += rxstride - (rystride * xcount);
}
}
+
+#endif
Index: libgfortran/intrinsics/ishftc.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/intrinsics/ishftc.c,v
retrieving revision 1.6
diff -u -3 -p -r1.6 ishftc.c
--- libgfortran/intrinsics/ishftc.c 12 Jan 2005 21:27:30 -0000 1.6
+++ libgfortran/intrinsics/ishftc.c 19 Jul 2005 16:59:16 -0000
@@ -69,3 +69,25 @@ ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4
bits = i & ~mask;
return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
}
+
+#ifdef HAVE_GFC_INTEGER_16
+extern GFC_INTEGER_16 ishftc16 (GFC_INTEGER_16, GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(ishftc16);
+
+GFC_INTEGER_16
+ishftc16 (GFC_INTEGER_16 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
+{
+ GFC_INTEGER_16 mask;
+ GFC_UINTEGER_16 bits;
+
+ if (shift < 0)
+ shift = shift + size;
+
+ if (shift == 0 || shift == size)
+ return i;
+
+ mask = (~(GFC_INTEGER_16)0) << size;
+ bits = i & ~mask;
+ return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
+}
+#endif
2005-07-19 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* builtins.def: Add DEF_EXT_C99RES_BUILTIN to define builtins
that C99 reserve for future use. Use it to define clog10, clog10f
and clog10l.
Index: gcc/builtins.def
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/builtins.def,v
retrieving revision 1.105
diff -u -3 -p -r1.105 builtins.def
--- gcc/builtins.def 27 Jun 2005 12:17:18 -0000 1.105
+++ gcc/builtins.def 3 Jul 2005 02:44:06 -0000
@@ -119,6 +119,13 @@ Software Foundation, 51 Franklin Street,
DEF_BUILTIN (ENUM, "__builtin_" NAME, BUILT_IN_NORMAL, TYPE, TYPE, \
true, true, !flag_isoc99, ATTRS, TARGET_C99_FUNCTIONS, true)
+/* Builtin that C99 reserve the name for future use. We can still recognize
+ the builtin in C99 mode but we can't produce it implicitly. */
+#undef DEF_EXT_C99RES_BUILTIN
+#define DEF_EXT_C99RES_BUILTIN(ENUM, NAME, TYPE, ATTRS) \
+ DEF_BUILTIN (ENUM, "__builtin_" NAME, BUILT_IN_NORMAL, TYPE, TYPE, \
+ true, true, true, ATTRS, false, true)
+
/* Allocate the enum and the name for a builtin, but do not actually
define it here at all. */
#undef DEF_BUILTIN_STUB
@@ -436,6 +443,9 @@ DEF_C99_BUILTIN (BUILT_IN_CIMAGL,
DEF_C99_BUILTIN (BUILT_IN_CLOG, "clog", BT_FN_COMPLEX_DOUBLE_COMPLEX_DOUBLE, ATTR_MATHFN_FPROUNDING)
DEF_C99_BUILTIN (BUILT_IN_CLOGF, "clogf", BT_FN_COMPLEX_FLOAT_COMPLEX_FLOAT, ATTR_MATHFN_FPROUNDING)
DEF_C99_BUILTIN (BUILT_IN_CLOGL, "clogl", BT_FN_COMPLEX_LONGDOUBLE_COMPLEX_LONGDOUBLE, ATTR_MATHFN_FPROUNDING)
+DEF_EXT_C99RES_BUILTIN (BUILT_IN_CLOG10, "clog10", BT_FN_COMPLEX_DOUBLE_COMPLEX_DOUBLE, ATTR_MATHFN_FPROUNDING)
+DEF_EXT_C99RES_BUILTIN (BUILT_IN_CLOG10F, "clog10f", BT_FN_COMPLEX_FLOAT_COMPLEX_FLOAT, ATTR_MATHFN_FPROUNDING)
+DEF_EXT_C99RES_BUILTIN (BUILT_IN_CLOG10L, "clog10l", BT_FN_COMPLEX_LONGDOUBLE_COMPLEX_LONGDOUBLE, ATTR_MATHFN_FPROUNDING)
DEF_C99_BUILTIN (BUILT_IN_CONJ, "conj", BT_FN_COMPLEX_DOUBLE_COMPLEX_DOUBLE, ATTR_CONST_NOTHROW_LIST)
DEF_C99_BUILTIN (BUILT_IN_CONJF, "conjf", BT_FN_COMPLEX_FLOAT_COMPLEX_FLOAT, ATTR_CONST_NOTHROW_LIST)
DEF_C99_BUILTIN (BUILT_IN_CONJL, "conjl", BT_FN_COMPLEX_LONGDOUBLE_COMPLEX_LONGDOUBLE, ATTR_CONST_NOTHROW_LIST)
! { dg-do run }
! { dg-require-effective-target fortran_large_int }
! Testing library calls on large integer kinds (larger than kind=8)
implicit none
integer,parameter :: k = selected_int_kind (range (0_8) + 1)
integer(kind=k) :: i, j
integer(8) :: a, b
i = 0; j = 1; a = i; b = j
if (i ** j /= a ** b) call abort
end
! { dg-do run }
! { dg-require-effective-target fortran_large_real }
! Testing library calls on large real kinds (larger than kind=8)
implicit none
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(8),parameter :: eps = 1e-8
real(kind=k) :: x, x1
real(8) :: y, y1
complex(kind=k) :: z, z1
complex(8) :: w, w1
#define TEST_FUNCTION(func,val) \
x = val ;\
y = x ;\
x = func (x) ;\
y = func (y) ;\
if (abs((y - x) / y) > eps) call abort
#define CTEST_FUNCTION(func,valc) \
z = valc ;\
w = z ;\
z = func (z) ;\
w = func (w) ;\
if (abs((z - w) / w) > eps) call abort
TEST_FUNCTION(cos,17.456)
TEST_FUNCTION(sin,17.456)
TEST_FUNCTION(tan,1.456)
TEST_FUNCTION(cosh,-2.45)
TEST_FUNCTION(sinh,7.1)
TEST_FUNCTION(tanh,12.7)
TEST_FUNCTION(acos,0.78)
TEST_FUNCTION(asin,-0.24)
TEST_FUNCTION(atan,-17.123)
TEST_FUNCTION(acosh,0.2)
TEST_FUNCTION(asinh,0.3)
TEST_FUNCTION(atanh,0.4)
TEST_FUNCTION(exp,1.74)
TEST_FUNCTION(log,0.00178914)
TEST_FUNCTION(log10,123789.123)
TEST_FUNCTION(sqrt,789.1356)
TEST_FUNCTION(erf,1.45123231)
TEST_FUNCTION(erfc,-0.123789)
CTEST_FUNCTION(cos,(17.456,-1.123))
CTEST_FUNCTION(sin,(17.456,-7.6))
CTEST_FUNCTION(exp,(1.74,-1.01))
CTEST_FUNCTION(log,(0.00178914,-1.207))
CTEST_FUNCTION(sqrt,(789.1356,2.4))
#define TEST_POWER(val1,val2) \
x = val1 ; \
y = x ; \
x1 = val2 ; \
y1 = x1; \
if (abs((x**x1 - y**y1)/(y**y1)) > eps) call abort
#define CTEST_POWER(val1,val2) \
z = val1 ; \
w = z ; \
z1 = val2 ; \
w1 = z1; \
if (abs((z**z1 - w**w1)/(w**w1)) > eps) call abort
CTEST_POWER (1.0,1.0)
CTEST_POWER (1.0,5.4)
CTEST_POWER (1.0,-5.4)
CTEST_POWER (1.0,0.0)
CTEST_POWER (-1.0,1.0)
CTEST_POWER (-1.0,5.4)
CTEST_POWER (-1.0,-5.4)
CTEST_POWER (-1.0,0.0)
CTEST_POWER (0.0,1.0)
CTEST_POWER (0.0,5.4)
CTEST_POWER (0.0,-5.4)
CTEST_POWER (0.0,0.0)
CTEST_POWER (7.6,1.0)
CTEST_POWER (7.6,5.4)
CTEST_POWER (7.6,-5.4)
CTEST_POWER (7.6,0.0)
CTEST_POWER (-7.6,1.0)
CTEST_POWER (-7.6,5.4)
CTEST_POWER (-7.6,-5.4)
CTEST_POWER (-7.6,0.0)
CTEST_POWER ((10.78,123.213),(14.123,13279.5))
CTEST_POWER ((-10.78,123.213),(14.123,13279.5))
CTEST_POWER ((10.78,-123.213),(14.123,13279.5))
CTEST_POWER ((10.78,123.213),(-14.123,13279.5))
CTEST_POWER ((10.78,123.213),(14.123,-13279.5))
CTEST_POWER ((-10.78,-123.213),(14.123,13279.5))
CTEST_POWER ((-10.78,123.213),(-14.123,13279.5))
CTEST_POWER ((-10.78,123.213),(14.123,-13279.5))
CTEST_POWER ((10.78,-123.213),(-14.123,13279.5))
CTEST_POWER ((10.78,-123.213),(14.123,-13279.5))
CTEST_POWER ((10.78,123.213),(-14.123,-13279.5))
CTEST_POWER ((-10.78,-123.213),(-14.123,13279.5))
CTEST_POWER ((-10.78,-123.213),(14.123,-13279.5))
CTEST_POWER ((-10.78,123.213),(-14.123,-13279.5))
CTEST_POWER ((10.78,-123.213),(-14.123,-13279.5))
CTEST_POWER ((-10.78,-123.213),(-14.123,-13279.5))
end