Skip to content

R
riscv-gcc-1
Commit b5a4419c by Francois-Xavier Coudert Committed by François-Xavier Coudert
Options

re PR fortran/33387 (Fortran front-end should translate intrinsics by calling… 

re PR fortran/33387 (Fortran front-end should translate intrinsics by calling C99 function instead of libgfortran functions)

	PR fortran/33387

	* trans.h: Remove prototypes for gfor_fndecl_math_exponent4,
	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
	gfor_fndecl_math_exponent16.
	* f95-lang.c (build_builtin_fntypes): Add new function types.
	(gfc_init_builtin_functions): Add new builtins for nextafter,
	frexp, ldexp, fabs, scalbn and inf.
	* iresolve.c (gfc_resolve_rrspacing): Don't add hidden arguments.
	(gfc_resolve_scale): Don't convert type of second argument.
	(gfc_resolve_set_exponent): Likewise.
	(gfc_resolve_size): Don't add hidden arguments.
	* trans-decl.c: Remove gfor_fndecl_math_exponent4,
	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
	gfor_fndecl_math_exponent16.
	* trans-intrinsic.c (gfc_intrinsic_map): Remove intrinsics
	for scalbn, fraction, nearest, rrspacing, set_exponent and
	spacing.
	(gfc_conv_intrinsic_exponent): Directly call frexp.
	(gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_nearest,
	gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing,
	gfc_conv_intrinsic_scale, gfc_conv_intrinsic_set_exponent): New
	functions.
	(gfc_conv_intrinsic_function): Use the new functions above.

From-SVN: r132713
parent 8bf6e270
Showing with 80 additions and 135 deletions
gcc/fortran/ChangeLog
2008-02-27 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33387
* trans.h: Remove prototypes for gfor_fndecl_math_exponent4,
gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
gfor_fndecl_math_exponent16.
* f95-lang.c (build_builtin_fntypes): Add new function types.
(gfc_init_builtin_functions): Add new builtins for nextafter,
frexp, ldexp, fabs, scalbn and inf.
* iresolve.c (gfc_resolve_rrspacing): Don't add hidden arguments.
(gfc_resolve_scale): Don't convert type of second argument.
(gfc_resolve_set_exponent): Likewise.
(gfc_resolve_size): Don't add hidden arguments.
* trans-decl.c: Remove gfor_fndecl_math_exponent4,
gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
gfor_fndecl_math_exponent16.
* trans-intrinsic.c (gfc_intrinsic_map): Remove intrinsics
for scalbn, fraction, nearest, rrspacing, set_exponent and
spacing.
(gfc_conv_intrinsic_exponent): Directly call frexp.
(gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_nearest,
gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing,
gfc_conv_intrinsic_scale, gfc_conv_intrinsic_set_exponent): New
functions.
(gfc_conv_intrinsic_function): Use the new functions above.
2008-02-26 Tobias Burnus <burnus@net-b.de>
PR fortran/35033
......
gcc/fortran/f95-lang.c
......@@ -756,6 +756,16 @@ build_builtin_fntypes (tree *fntype, tree type)
tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
tmp = tree_cons (NULL_TREE, type, tmp);
fntype[2] = build_function_type (type, tmp);
/* type (*) (void) */
fntype[3] = build_function_type (type, void_list_node);
/* type (*) (type, &int) */
tmp = tree_cons (NULL_TREE, type, void_list_node);
tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
fntype[4] = build_function_type (type, tmp);
/* type (*) (type, int) */
tmp = tree_cons (NULL_TREE, type, void_list_node);
tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
fntype[5] = build_function_type (type, tmp);
}
......@@ -806,12 +816,12 @@ gfc_init_builtin_functions (void)
ATTR_CONST_NOTHROW_LIST
};
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 mfunc_float[6];
tree mfunc_double[6];
tree mfunc_longdouble[6];
tree mfunc_cfloat[6];
tree mfunc_cdouble[6];
tree mfunc_clongdouble[6];
tree func_cfloat_float, func_float_cfloat;
tree func_cdouble_double, func_double_cdouble;
tree func_clongdouble_longdouble, func_longdouble_clongdouble;
......@@ -902,6 +912,34 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
BUILT_IN_COPYSIGNF, "copysignf", true);
gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
BUILT_IN_NEXTAFTERL, "nextafterl", true);
gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
BUILT_IN_NEXTAFTER, "nextafter", true);
gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
BUILT_IN_NEXTAFTERF, "nextafterf", true);
gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
BUILT_IN_FREXPL, "frexpl", false);
gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
BUILT_IN_FREXP, "frexp", false);
gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
BUILT_IN_FREXPF, "frexpf", false);
gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
BUILT_IN_FABSL, "fabsl", true);
gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
BUILT_IN_FABS, "fabs", true);
gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
BUILT_IN_FABSF, "fabsf", true);
gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5],
BUILT_IN_SCALBNL, "scalbnl", true);
gfc_define_builtin ("__builtin_scalbn", mfunc_double[5],
BUILT_IN_SCALBN, "scalbn", true);
gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5],
BUILT_IN_SCALBNF, "scalbnf", true);
gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
BUILT_IN_FMODL, "fmodl", true);
gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
......@@ -909,6 +947,13 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
BUILT_IN_FMODF, "fmodf", true);
gfc_define_builtin ("__builtin_infl", mfunc_longdouble[3],
BUILT_IN_INFL, "__builtin_infl", true);
gfc_define_builtin ("__builtin_inf", mfunc_double[3],
BUILT_IN_INF, "__builtin_inf", true);
gfc_define_builtin ("__builtin_inff", mfunc_float[3],
BUILT_IN_INFF, "__builtin_inff", true);
/* lround{f,,l} and llround{f,,l} */
type = tree_cons (NULL_TREE, float_type_node, void_list_node);
tmp = build_function_type (long_integer_type_node, type);
......
gcc/fortran/iresolve.c
......@@ -1853,47 +1853,15 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
void
gfc_resolve_rrspacing (gfc_expr *f, gfc_expr *x)
{
int k;
gfc_actual_arglist *prec;
f->ts = x->ts;
f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
/* Create a hidden argument to the library routines for rrspacing. This
hidden argument is the precision of x. */
k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
prec = gfc_get_actual_arglist ();
prec->name = "p";
prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
/* The library routine expects INTEGER(4). */
if (prec->expr->ts.kind != gfc_c_int_kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
gfc_convert_type (prec->expr, &ts, 2);
}
f->value.function.actual->next = prec;
}
void
gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i)
gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i ATTRIBUTE_UNUSED)
{
f->ts = x->ts;
/* The implementation calls scalbn which takes an int as the
second argument. */
if (i->ts.kind != gfc_c_int_kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
gfc_convert_type_warn (i, &ts, 2, 0);
}
f->value.function.name = gfc_get_string ("__scale_%d", x->ts.kind);
}
......@@ -1921,22 +1889,10 @@ gfc_resolve_secnds (gfc_expr *t1, gfc_expr *t0)
void
gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x, gfc_expr *i)
gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x,
gfc_expr *i ATTRIBUTE_UNUSED)
{
f->ts = x->ts;
/* The library implementation uses GFC_INTEGER_4 unconditionally,
convert type so we don't have to implement all possible
permutations. */
if (i->ts.kind != gfc_c_int_kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
gfc_convert_type_warn (i, &ts, 2, 0);
}
f->value.function.name = gfc_get_string ("__set_exponent_%d", x->ts.kind);
}
......@@ -2016,59 +1972,8 @@ gfc_resolve_size (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
void
gfc_resolve_spacing (gfc_expr *f, gfc_expr *x)
{
int k;
gfc_actual_arglist *prec, *tiny, *emin_1;
f->ts = x->ts;
f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
/* Create hidden arguments to the library routine for spacing. These
hidden arguments are tiny(x), min_exponent - 1, and the precision
of x. */
k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
tiny = gfc_get_actual_arglist ();
tiny->name = "tiny";
tiny->expr = gfc_get_expr ();
tiny->expr->expr_type = EXPR_CONSTANT;
tiny->expr->where = gfc_current_locus;
tiny->expr->ts.type = x->ts.type;
tiny->expr->ts.kind = x->ts.kind;
mpfr_init (tiny->expr->value.real);
mpfr_set (tiny->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
emin_1 = gfc_get_actual_arglist ();
emin_1->name = "emin";
emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1);
/* The library routine expects INTEGER(4). */
if (emin_1->expr->ts.kind != gfc_c_int_kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
gfc_convert_type (emin_1->expr, &ts, 2);
}
emin_1->next = tiny;
prec = gfc_get_actual_arglist ();
prec->name = "prec";
prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
/* The library routine expects INTEGER(4). */
if (prec->expr->ts.kind != gfc_c_int_kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
gfc_convert_type (prec->expr, &ts, 2);
}
prec->next = emin_1;
f->value.function.actual->next = prec;
}
......
gcc/fortran/trans-decl.c
......@@ -102,10 +102,6 @@ gfc_powdecl_list gfor_fndecl_math_powi[4][3];
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. */
......@@ -2010,10 +2006,6 @@ gfc_build_intrinsic_function_decls (void)
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);
/* String functions. */
gfor_fndecl_compare_string =
......@@ -2199,25 +2191,6 @@ gfc_build_intrinsic_function_decls (void)
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,
1, gfc_real4_type_node);
gfor_fndecl_math_exponent8 =
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);
/* BLAS functions. */
{
tree pint = build_pointer_type (integer_type_node);
......
gcc/fortran/trans.h
......@@ -529,10 +529,6 @@ extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
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;
/* BLAS functions. */
extern GTY(()) tree gfor_fndecl_sgemm;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment