This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran] Support for large kinds in front-end and library
- From: FX Coudert <fxcoudert at gmail dot com>
- To: gfortran <fortran at gcc dot gnu dot org>
- Cc: patch <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 28 Sep 2005 22:58:49 +0200
- Subject: Re: [gfortran] Support for large kinds in front-end and library
- References: <433AFA7A.8080800@gmail.com>
I built and regtested this patch on i686-linux, i386-freebsd,
sparc-solaris and alpha-linux. Testing on other platforms is welcome.
OK for mainline?
Guess what? I included an old version of the patch. Here is the
up-to-date patch. Sorry for the trouble.
FX
2005-08-04 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: /cvs/gcc/gcc/gcc/fortran/f95-lang.c,v
retrieving revision 1.39
diff -u -3 -p -r1.39 f95-lang.c
--- gcc/fortran/f95-lang.c 21 Aug 2005 15:28:23 -0000 1.39
+++ gcc/fortran/f95-lang.c 28 Sep 2005 20:45:23 -0000
@@ -718,6 +718,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], \
@@ -726,11 +728,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. */
@@ -760,17 +760,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);
@@ -778,30 +783,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: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.40
diff -u -3 -p -r1.40 iresolve.c
--- gcc/fortran/iresolve.c 22 Sep 2005 19:00:23 -0000 1.40
+++ gcc/fortran/iresolve.c 28 Sep 2005 20:45:23 -0000
@@ -1217,7 +1217,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"),
@@ -1538,6 +1539,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: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.69
diff -u -3 -p -r1.69 trans-decl.c
--- gcc/fortran/trans-decl.c 9 Sep 2005 06:00:25 -0000 1.69
+++ gcc/fortran/trans-decl.c 28 Sep 2005 20:45:23 -0000
@@ -94,13 +94,18 @@ tree gfor_fndecl_associated;
/* Math functions. Many other math functions are handled in
trans-intrinsic.c. */
-gfc_powdecl_list gfor_fndecl_math_powi[3][2];
+gfc_powdecl_list gfor_fndecl_math_powi[4][3];
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. */
@@ -1691,11 +1696,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 =
@@ -1793,37 +1803,56 @@ gfc_build_intrinsic_function_decls (void
/* Power functions. */
{
- tree type;
- tree itype;
- int kind;
- int ikind;
- static int kinds[2] = {4, 8};
- char name[PREFIX_LEN + 10]; /* _gfortran_pow_?n_?n */
+ 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 + 12]; /* _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 =
@@ -1834,6 +1863,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,
@@ -1843,7 +1883,15 @@ gfc_build_intrinsic_function_decls (void
gfc_build_library_function_decl (get_identifier (PREFIX("ishftc8")),
gfc_int8_type_node,
3, gfc_int8_type_node,
- gfc_int8_type_node, gfc_int8_type_node);
+ gfc_int4_type_node, gfc_int4_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_int4_type_node,
+ gfc_int4_type_node);
+
gfor_fndecl_math_exponent4 =
gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")),
gfc_int4_type_node,
@@ -1852,6 +1900,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: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.64
diff -u -3 -p -r1.64 trans-expr.c
--- gcc/fortran/trans-expr.c 13 Sep 2005 21:45:55 -0000 1.64
+++ gcc/fortran/trans-expr.c 28 Sep 2005 20:45:23 -0000
@@ -691,6 +691,10 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
ikind = 1;
break;
+ case 16:
+ ikind = 2;
+ break;
+
default:
gcc_unreachable ();
}
@@ -712,6 +716,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 ();
}
@@ -719,6 +731,8 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
switch (expr->value.op.op1->ts.type)
{
case BT_INTEGER:
+ if (kind == 3) /* Case 16 was not handled properly above. */
+ kind = 2;
fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
break;
@@ -744,6 +758,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 ();
}
@@ -758,6 +776,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: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.54
diff -u -3 -p -r1.54 trans-intrinsic.c
--- gcc/fortran/trans-intrinsic.c 13 Sep 2005 08:07:15 -0000 1.54
+++ gcc/fortran/trans-intrinsic.c 28 Sep 2005 20:45:23 -0000
@@ -52,14 +52,18 @@ typedef struct gfc_intrinsic_map_t GTY((
/* Enum value from the "language-independent", aka C-centric, part
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 +78,42 @@ 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},
+
+#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},
#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[] =
{
@@ -122,7 +136,6 @@ static GTY(()) gfc_intrinsic_map_t gfc_i
};
#undef DEFINE_MATH_BUILTIN
#undef DEFINE_MATH_BUILTIN_C
-#undef BUILT_IN_FUNCTION
#undef LIBM_FUNCTION
#undef LIBF_FUNCTION
@@ -336,6 +349,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 +367,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 +492,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 +536,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 +558,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 +576,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 +663,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 ();
}
@@ -734,6 +788,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 ();
}
@@ -896,6 +954,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 ();
}
@@ -1861,6 +1923,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: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.50
diff -u -3 -p -r1.50 trans-types.c
--- gcc/fortran/trans-types.c 29 Jul 2005 00:02:37 -0000 1.50
+++ gcc/fortran/trans-types.c 28 Sep 2005 20:45:24 -0000
@@ -566,29 +566,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: /cvs/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.35
diff -u -3 -p -r1.35 trans.h
--- gcc/fortran/trans.h 9 Sep 2005 06:34:07 -0000 1.35
+++ gcc/fortran/trans.h 28 Sep 2005 20:45:24 -0000
@@ -471,13 +471,18 @@ typedef struct gfc_powdecl_list GTY(())
}
gfc_powdecl_list;
-extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[3][2];
+extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
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-09-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 c99_protos.inc files.
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/count.m4, m4/cshift1.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: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.42
diff -u -3 -p -r1.42 Makefile.am
--- libgfortran/Makefile.am 25 Sep 2005 21:39:55 -0000 1.42
+++ libgfortran/Makefile.am 28 Sep 2005 20:45:24 -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,74 +432,135 @@ 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 c99_protos.inc
# 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
+# There are commented out due to a bug in the way the front-end
+# handles MOD
+#generated/_mod_r10.F90
+#generated/_mod_r16.F90
gfor_specific_src= \
$(gfor_built_specific_src) \
@@ -387,6 +580,12 @@ 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 > $@
+
+c99_protos.inc: $(srcdir)/c99_protos.h
+ grep '^#' < $(srcdir)/c99_protos.h > $@
+
selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
$(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
Index: libgfortran/libgfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/libgfortran.h,v
retrieving revision 1.33
diff -u -3 -p -r1.33 libgfortran.h
--- libgfortran/libgfortran.h 25 Sep 2005 21:39:57 -0000 1.33
+++ libgfortran/libgfortran.h 28 Sep 2005 20:45:24 -0000
@@ -211,8 +211,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
@@ -239,12 +250,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: /cvs/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 28 Sep 2005 20:45:24 -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/intrinsics/ishftc.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/intrinsics/ishftc.c,v
retrieving revision 1.7
diff -u -3 -p -r1.7 ishftc.c
--- libgfortran/intrinsics/ishftc.c 17 Aug 2005 02:48:53 -0000 1.7
+++ libgfortran/intrinsics/ishftc.c 28 Sep 2005 20:45:25 -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
Index: libgfortran/m4/all.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/all.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 all.m4
--- libgfortran/m4/all.m4 17 Aug 2005 02:49:03 -0000 1.4
+++ libgfortran/m4/all.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/any.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 any.m4
--- libgfortran/m4/any.m4 17 Aug 2005 02:49:03 -0000 1.4
+++ libgfortran/m4/any.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, 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/count.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/count.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 count.m4
--- libgfortran/m4/count.m4 17 Aug 2005 02:49:04 -0000 1.4
+++ libgfortran/m4/count.m4 28 Sep 2005 20:45:25 -0000
@@ -35,8 +35,12 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/cshift1.m4,v
retrieving revision 1.11
diff -u -3 -p -r1.11 cshift1.m4
--- libgfortran/m4/cshift1.m4 13 Sep 2005 07:15:00 -0000 1.11
+++ libgfortran/m4/cshift1.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static void
cshift1 (gfc_array_char * ret, const gfc_array_char * array,
const atype * h, const atype_name * pwhich, index_type size)
@@ -220,3 +222,5 @@ cshift1_`'atype_kind`'_char (gfc_array_c
{
cshift1 (ret, array, h, pwhich, array_length);
}
+
+#endif
Index: libgfortran/m4/dotprod.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/dotprod.m4,v
retrieving revision 1.7
diff -u -3 -p -r1.7 dotprod.m4
--- libgfortran/m4/dotprod.m4 17 Aug 2005 02:49:04 -0000 1.7
+++ libgfortran/m4/dotprod.m4 28 Sep 2005 20:45:25 -0000
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/dotprodc.m4,v
retrieving revision 1.7
diff -u -3 -p -r1.7 dotprodc.m4
--- libgfortran/m4/dotprodc.m4 17 Aug 2005 02:49:04 -0000 1.7
+++ libgfortran/m4/dotprodc.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/dotprodl.m4,v
retrieving revision 1.7
diff -u -3 -p -r1.7 dotprodl.m4
--- libgfortran/m4/dotprodl.m4 17 Aug 2005 02:49:04 -0000 1.7
+++ libgfortran/m4/dotprodl.m4 28 Sep 2005 20:45:25 -0000
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/eoshift1.m4,v
retrieving revision 1.14
diff -u -3 -p -r1.14 eoshift1.m4
--- libgfortran/m4/eoshift1.m4 13 Sep 2005 07:15:00 -0000 1.14
+++ libgfortran/m4/eoshift1.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static void
eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const atype *h,
const char *pbound, const atype_name *pwhich, index_type size,
@@ -246,3 +248,5 @@ eoshift1_`'atype_kind`'_char (gfc_array_
{
eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
}
+
+#endif
Index: libgfortran/m4/eoshift3.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/eoshift3.m4,v
retrieving revision 1.14
diff -u -3 -p -r1.14 eoshift3.m4
--- libgfortran/m4/eoshift3.m4 13 Sep 2005 07:15:00 -0000 1.14
+++ libgfortran/m4/eoshift3.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static void
eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const atype *h,
const gfc_array_char *bound, const atype_name *pwhich,
@@ -268,3 +270,5 @@ eoshift3_`'atype_kind`'_char (gfc_array_
{
eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
}
+
+#endif
Index: libgfortran/m4/exponent.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/exponent.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 exponent.m4
--- libgfortran/m4/exponent.m4 17 Aug 2005 02:49:05 -0000 1.5
+++ libgfortran/m4/exponent.m4 28 Sep 2005 20:45:25 -0000
@@ -27,11 +27,15 @@ You should have received a copy of the G
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
+
extern GFC_INTEGER_4 exponent_r`'kind (real_type s);
export_proto(exponent_r`'kind);
@@ -42,3 +46,5 @@ exponent_r`'kind (real_type s)
frexp`'q (s, &ret);
return ret;
}
+
+#endif
Index: libgfortran/m4/fraction.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/fraction.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 fraction.m4
--- libgfortran/m4/fraction.m4 17 Aug 2005 02:49:05 -0000 1.5
+++ libgfortran/m4/fraction.m4 28 Sep 2005 20:45:25 -0000
@@ -27,11 +27,15 @@ You should have received a copy of the G
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
+
extern real_type fraction_r`'kind (real_type s);
export_proto(fraction_r`'kind);
@@ -41,3 +45,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: /cvs/gcc/gcc/libgfortran/m4/in_pack.m4,v
retrieving revision 1.7
diff -u -3 -p -r1.7 in_pack.m4
--- libgfortran/m4/in_pack.m4 17 Aug 2005 02:49:05 -0000 1.7
+++ libgfortran/m4/in_pack.m4 28 Sep 2005 20:45:25 -0000
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/in_unpack.m4,v
retrieving revision 1.7
diff -u -3 -p -r1.7 in_unpack.m4
--- libgfortran/m4/in_unpack.m4 17 Aug 2005 02:49:05 -0000 1.7
+++ libgfortran/m4/in_unpack.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/matmul.m4,v
retrieving revision 1.15
diff -u -3 -p -r1.15 matmul.m4
--- libgfortran/m4/matmul.m4 17 Aug 2005 02:49:05 -0000 1.15
+++ libgfortran/m4/matmul.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/matmull.m4,v
retrieving revision 1.11
diff -u -3 -p -r1.11 matmull.m4
--- libgfortran/m4/matmull.m4 17 Aug 2005 02:49:05 -0000 1.11
+++ libgfortran/m4/matmull.m4 28 Sep 2005 20:45:25 -0000
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/maxloc0.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 maxloc0.m4
--- libgfortran/m4/maxloc0.m4 17 Aug 2005 02:49:05 -0000 1.5
+++ libgfortran/m4/maxloc0.m4 28 Sep 2005 20:45:25 -0000
@@ -38,6 +38,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/maxloc1.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 maxloc1.m4
--- libgfortran/m4/maxloc1.m4 17 Aug 2005 02:49:05 -0000 1.5
+++ libgfortran/m4/maxloc1.m4 28 Sep 2005 20:45:25 -0000
@@ -37,6 +37,9 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/maxval.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 maxval.m4
--- libgfortran/m4/maxval.m4 17 Aug 2005 02:49:06 -0000 1.5
+++ libgfortran/m4/maxval.m4 28 Sep 2005 20:45:25 -0000
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/minloc0.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 minloc0.m4
--- libgfortran/m4/minloc0.m4 17 Aug 2005 02:49:06 -0000 1.5
+++ libgfortran/m4/minloc0.m4 28 Sep 2005 20:45:25 -0000
@@ -38,6 +38,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/minloc1.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 minloc1.m4
--- libgfortran/m4/minloc1.m4 17 Aug 2005 02:49:06 -0000 1.5
+++ libgfortran/m4/minloc1.m4 28 Sep 2005 20:45:25 -0000
@@ -37,6 +37,9 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/minval.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 minval.m4
--- libgfortran/m4/minval.m4 17 Aug 2005 02:49:06 -0000 1.5
+++ libgfortran/m4/minval.m4 28 Sep 2005 20:45:25 -0000
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, 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: /cvs/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 28 Sep 2005 20:45:25 -0000
@@ -2,4 +2,5 @@ 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
+define(Q,translit(q,`a-z',`A-Z'))dnl
Index: libgfortran/m4/nearest.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/nearest.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 nearest.m4
--- libgfortran/m4/nearest.m4 17 Aug 2005 02:49:06 -0000 1.5
+++ libgfortran/m4/nearest.m4 28 Sep 2005 20:45:25 -0000
@@ -27,12 +27,16 @@ You should have received a copy of the G
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include <float.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_COPYSIGN'Q`) && defined (HAVE_NEXTAFTER'Q`)'
+
extern real_type nearest_r`'kind (real_type s, real_type dir);
export_proto(nearest_r`'kind);
@@ -49,3 +53,5 @@ nearest_r`'kind (real_type s, real_type
else
return nextafter`'q (s, dir);
}
+
+#endif
Index: libgfortran/m4/pow.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/pow.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 pow.m4
--- libgfortran/m4/pow.m4 17 Aug 2005 02:49:06 -0000 1.4
+++ libgfortran/m4/pow.m4 28 Sep 2005 20:45:25 -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: /cvs/gcc/gcc/libgfortran/m4/product.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 product.m4
--- libgfortran/m4/product.m4 17 Aug 2005 02:49:06 -0000 1.4
+++ libgfortran/m4/product.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/reshape.m4,v
retrieving revision 1.12
diff -u -3 -p -r1.12 reshape.m4
--- libgfortran/m4/reshape.m4 17 Aug 2005 02:49:06 -0000 1.12
+++ libgfortran/m4/reshape.m4 28 Sep 2005 20:45:25 -0000
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/set_exponent.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 set_exponent.m4
--- libgfortran/m4/set_exponent.m4 17 Aug 2005 02:49:06 -0000 1.5
+++ libgfortran/m4/set_exponent.m4 28 Sep 2005 20:45:25 -0000
@@ -27,11 +27,15 @@ You should have received a copy of the G
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)'
+
extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i);
export_proto(set_exponent_r`'kind);
@@ -41,3 +45,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: /cvs/gcc/gcc/libgfortran/m4/shape.m4,v
retrieving revision 1.7
diff -u -3 -p -r1.7 shape.m4
--- libgfortran/m4/shape.m4 17 Aug 2005 02:49:06 -0000 1.7
+++ libgfortran/m4/shape.m4 28 Sep 2005 20:45:25 -0000
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, 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: /cvs/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 28 Sep 2005 20:45:25 -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,35 @@ define(atype_name, get_typename(atype_le
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
define(function_name,`specific__'name`_'atype_code)dnl
+define(type,ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW)))))dnl
+define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl
+
+dnl A few specifics require a function other than their name, or
+dnl nothing. The list is currently:
+dnl - integer and logical specifics require no libm function
+dnl - AINT requires the trunc() family functions
+dnl - ANINT requires round()
+dnl - CONJG, DIM, SIGN require no libm function
+define(needed,ifelse(atype_letter,i,`none',ifelse(atype_letter,l,`none',ifelse(name,aint,trunc,ifelse(name,anint,round,ifelse(name,conjg,none,ifelse(name,dim,none,ifelse(name,sign,none,ifelse(name,abs,fabs,name)))))))))dnl
+define(prefix,ifelse(atype_letter,c,C,`'))dnl
+
+dnl Special case for fabs, for which the corresponding complex function
+dnl is not cfabs but cabs.
+define(NEEDED,translit(ifelse(prefix`'needed,`Cfabs',`abs',needed),`a-z',`A-Z'))dnl
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+`#if defined (HAVE_GFC_'type`_'atype_kind`)'
+ifelse(NEEDED,NONE,`',`#ifdef HAVE_'prefix`'NEEDED`'Q)
+
elemental function function_name (parm)
atype_name, intent (in) :: parm
atype_name :: function_name
function_name = name (parm)
end function
+
+ifelse(NEEDED,NONE,`',`#endif')
+#endif
Index: libgfortran/m4/specific2.m4
===================================================================
RCS file: /cvs/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 28 Sep 2005 20:45:25 -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,23 @@ define(atype_name, get_typename(atype_le
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
define(function_name,`specific__'name`_'atype_code)dnl
+define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.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`)'
+
+ifelse(name,atan2,`#ifdef HAVE_ATAN2'Q,)
+
elemental function function_name (p1, p2)
atype_name, intent (in) :: p1, p2
atype_name :: function_name
function_name = name (p1, p2)
end function
+
+ifelse(name,atan2,`#endif',)
+
+#endif
Index: libgfortran/m4/sum.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/sum.m4,v
retrieving revision 1.4
diff -u -3 -p -r1.4 sum.m4
--- libgfortran/m4/sum.m4 17 Aug 2005 02:49:06 -0000 1.4
+++ libgfortran/m4/sum.m4 28 Sep 2005 20:45:25 -0000
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, 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: /cvs/gcc/gcc/libgfortran/m4/transpose.m4,v
retrieving revision 1.12
diff -u -3 -p -r1.12 transpose.m4
--- libgfortran/m4/transpose.m4 17 Aug 2005 02:49:06 -0000 1.12
+++ libgfortran/m4/transpose.m4 28 Sep 2005 20:45:25 -0000
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, 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
2005-09-25 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.dg/large_real_kind_2.F90: New test.
* gfortran.dg/large_integer_kind_2.f90: New test.
! { 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