This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [fortran patch] Don't use TREE_LISTs for storing arguments to intrinsic functions
On Tue, May 08, 2007 at 11:37:54PM +0100, Lee Millward wrote:
>On 5/8/07, Brooks Moses <brooks.moses@codesourcery.com> wrote:
>>Right, okay, but I don't see how "formal" becoming NULL causes the loop to
>>terminate -- it's not part of the loop test, and the loop explictly allows
>>for continuing after it's become NULL. That's the part that I'm confused
>>about.
>
>I've tested a version of this patch without the "formal" variable in
>gfc_intrinsic_argument_list_length that passed testing successfully.
>Looking back through it now my mistake here was I made two minor
>changes to fix a bug and wrongly attributed the fix to this particular
>change when in fact it's completely useless, something I never noticed
>at the time. Apologies about that.
>
>I have a new version of the patch that incorporates the whitespace
>cleanup, removal of the NULL_TREE initialisation for single arguments
>as GCC no longer generates a warning for this and the other minor
>tweaks requested.
>
>Of those changes you asked for I was not able to move the declaration
>of "i" in gfc_conv_intrinsic_minmax to within the "for" loop as this
>generates a warning and breaks bootstrap. Another problem is there
>seems to be a difference in opinion between the callers of
>gfc_conv_intrinsic_function_args regarding the actual number of
>arguments in the expression, and the number the caller is interested
>in so the assertion in gfc_conv_intrinsic_function_args to check these
>match exactly fails for many testcases.
>
>To illustrate this take gfc_conv_intrinsic_aint for example which
>creates space for two arguments, here the code is only interested in
>the first argument, but making the change to only pass a single
>argument to gfc_conv_intrinsic_function_args with the new assertion
>will trigger failures in tests like aint_anint_1.f90. From what I'm
>able to determine the need for allowing two arguments here (and in
>gfc_conv_intrinsic_int) dates back to Fortran 77 where intrinsics like
>AINT and INT can optionally have a "kind" parameter.
>
>I've attached the updated patch for review that has been
>rebootstrapped and tested successfully. Same changelog as before.
>
>Is this version ok to apply?
A few further nitpicks below..
>
>Cheers,
>Lee.
>Index: trans-intrinsic.c
>===================================================================
>--- trans-intrinsic.c (revision 124520)
>+++ trans-intrinsic.c (working copy)
>@@ -164,19 +164,17 @@ real_compnt_info;
> enum rounding_mode { RND_ROUND, RND_TRUNC, RND_CEIL, RND_FLOOR };
>
> /* Evaluate the arguments to an intrinsic function. */
>-/* FIXME: This function and its callers should be rewritten so that it's
>- not necessary to cons up a list to hold the arguments. */
>
>-static tree
>-gfc_conv_intrinsic_function_args (gfc_se * se, gfc_expr * expr)
>+static void
>+gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
>+ tree *argarray, int nargs)
> {
> gfc_actual_arglist *actual;
> gfc_expr *e;
> gfc_intrinsic_arg *formal;
> gfc_se argse;
>- tree args;
>+ int curr_arg = 0;
unsigned ?
>
>- args = NULL_TREE;
> formal = expr->value.function.isym->formal;
>
> for (actual = expr->value.function.actual; actual; actual = actual->next,
>@@ -195,7 +193,8 @@ gfc_conv_intrinsic_function_args (gfc_se
> {
> gfc_conv_expr (&argse, e);
> gfc_conv_string_parameter (&argse);
>- args = gfc_chainon_list (args, argse.string_length);
>+ gcc_assert (curr_arg < nargs);
>+ argarray[curr_arg++] = argse.string_length;
> }
> else
> gfc_conv_expr_val (&argse, e);
>@@ -210,9 +209,32 @@ gfc_conv_intrinsic_function_args (gfc_se
>
> gfc_add_block_to_block (&se->pre, &argse.pre);
> gfc_add_block_to_block (&se->post, &argse.post);
>- args = gfc_chainon_list (args, argse.expr);
>+ gcc_assert (curr_arg < nargs);
>+ argarray[curr_arg++] = argse.expr;
>+ }
>+}
>+
>+/* Count the number of actual arguments to the intrinsic function EXPR
>+ including any "hidden" string length arguments. */
>+
>+static int
>+gfc_intrinsic_argument_list_length (gfc_expr *expr)
>+{
>+ int n = 0;
>+ gfc_actual_arglist *actual;
>+
>+ for (actual = expr->value.function.actual; actual; actual = actual->next)
>+ {
>+ if(!actual->expr)
space damaged; See also (whole file or just your diff):
$ egrep "[^[:space:]]\(" trans-intrinsic.c
>+ continue;
>+
>+ if (actual->expr->ts.type == BT_CHARACTER)
>+ n += 2;
>+ else
>+ n++;
Those two 'n' seem to use different spacing.
May i suggest to configure your editor to highlight those. E.g. vim:
$ grep c_space ~/.vimrc
let c_space_errors=1
> }
>- return args;
>+
>+ return n;
> }
>
>
>@@ -223,26 +245,25 @@ static void
> gfc_conv_intrinsic_conversion (gfc_se * se, gfc_expr * expr)
Perhaps also fix this whitespace damage while at it?
[snip]
>@@ -402,21 +423,20 @@ gfc_conv_intrinsic_aint (gfc_se * se, gf
>
> /* Evaluate the argument. */
> gcc_assert (expr->value.function.actual->expr);
>- arg = gfc_conv_intrinsic_function_args (se, expr);
>+ gfc_conv_intrinsic_function_args (se, expr, args, 2);
>
> /* Use a builtin function if one exists. */
> if (n != END_BUILTINS)
> {
> tmp = built_in_decls[n];
>- se->expr = build_function_call_expr (tmp, arg);
>+ se->expr = build_call_expr (tmp, 1, args[0]);
If build_function_call_expr is deprecated, maybe a comment to it's impl
should be added (to avoid the noise of marking it with attribute
deprecated)?
> return;
> }
>
> /* This code is probably redundant, but we'll keep it lying around just
> in case. */
> type = gfc_typenode_for_spec (&expr->ts);
>- arg = TREE_VALUE (arg);
>- arg = gfc_evaluate_now (arg, &se->pre);
>+ args[0] = gfc_evaluate_now (args[0], &se->pre);
I can't parse the description of gfc_evaluate_now() that reads "If the
an expression", just as a sidenote..
>
> /* Test if the value is too large to handle sensibly. */
> gfc_set_model_kind (kind);
>@@ -424,17 +444,17 @@ gfc_conv_intrinsic_aint (gfc_se * se, gf
> n = gfc_validate_kind (BT_INTEGER, kind, false);
> mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
> tmp = gfc_conv_mpfr_to_tree (huge, kind);
>- cond = build2 (LT_EXPR, boolean_type_node, arg, tmp);
>+ cond = build2 (LT_EXPR, boolean_type_node, args[0], tmp);
>
> mpfr_neg (huge, huge, GFC_RND_MODE);
> tmp = gfc_conv_mpfr_to_tree (huge, kind);
>- tmp = build2 (GT_EXPR, boolean_type_node, arg, tmp);
>+ tmp = build2 (GT_EXPR, boolean_type_node, args[0], tmp);
> cond = build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp);
> itype = gfc_get_int_type (kind);
>
>- tmp = build_fix_expr (&se->pre, arg, itype, op);
>+ tmp = build_fix_expr (&se->pre, args[0], itype, op);
Maybe automagically creating a temporary for itype by calling
gfc_get_int_type (kind) in place?
> tmp = convert (type, tmp);
>- se->expr = build3 (COND_EXPR, type, cond, tmp, arg);
>+ se->expr = build3 (COND_EXPR, type, cond, tmp, args[0]);
> mpfr_clear (huge);
> }
>
>@@ -445,33 +465,32 @@ static void
> gfc_conv_intrinsic_int (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
Perhaps also fix this whitespace damage while at it?
> {
> tree type;
>- tree arg;
>+ tree args[2];
>
> /* Evaluate the argument. */
> type = gfc_typenode_for_spec (&expr->ts);
> gcc_assert (expr->value.function.actual->expr);
>- arg = gfc_conv_intrinsic_function_args (se, expr);
>- arg = TREE_VALUE (arg);
>+ gfc_conv_intrinsic_function_args (se, expr, args, 2);
>
>- if (TREE_CODE (TREE_TYPE (arg)) == INTEGER_TYPE)
>+ if (TREE_CODE (TREE_TYPE (args[0])) == INTEGER_TYPE)
> {
> /* Conversion to a different integer kind. */
>- se->expr = convert (type, arg);
>+ se->expr = convert (type, args[0]);
> }
> else
> {
> /* Conversion from complex to non-complex involves taking the real
> component of the value. */
>- if (TREE_CODE (TREE_TYPE (arg)) == COMPLEX_TYPE
>+ if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE
> && expr->ts.type != BT_COMPLEX)
> {
> tree artype;
>
>- artype = TREE_TYPE (TREE_TYPE (arg));
>- arg = build1 (REALPART_EXPR, artype, arg);
>+ artype = TREE_TYPE (TREE_TYPE (args[0]));
>+ args[0] = build1 (REALPART_EXPR, artype, args[0]);
> }
>
>- se->expr = build_fix_expr (&se->pre, arg, type, op);
>+ se->expr = build_fix_expr (&se->pre, args[0], type, op);
> }
> }
>
>@@ -483,8 +502,7 @@ gfc_conv_intrinsic_imagpart (gfc_se * se
> {
> tree arg;
>
>- arg = gfc_conv_intrinsic_function_args (se, expr);
>- arg = TREE_VALUE (arg);
>+ gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
> se->expr = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (arg)), arg);
> }
>
>@@ -496,8 +514,7 @@ gfc_conv_intrinsic_conjg (gfc_se * se, g
> {
> tree arg;
>
>- arg = gfc_conv_intrinsic_function_args (se, expr);
>- arg = TREE_VALUE (arg);
>+ gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
> se->expr = build1 (CONJ_EXPR, TREE_TYPE (arg), arg);
> }
>
>@@ -647,8 +664,10 @@ static void
> gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
> {
> gfc_intrinsic_map_t *m;
>- tree args;
> tree fndecl;
>+ tree rettype;
>+ tree *args;
>+ int num_args;
unsigned ?
> gfc_generic_isym_id id;
>
> id = expr->value.function.isym->generic_id;
[]
>@@ -949,20 +971,23 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc
> static void
> gfc_conv_intrinsic_cmplx (gfc_se * se, gfc_expr * expr, int both)
> {
>- tree arg;
> tree real;
> tree imag;
> tree type;
>+ tree *args;
>+ int num_args;
unsigned ?
>+
>+ num_args = gfc_intrinsic_argument_list_length(expr);
>+ args = alloca (sizeof(tree) * num_args);
>
> type = gfc_typenode_for_spec (&expr->ts);
>- arg = gfc_conv_intrinsic_function_args (se, expr);
>- real = convert (TREE_TYPE (type), TREE_VALUE (arg));
>+ gfc_conv_intrinsic_function_args (se, expr, args, num_args);
>+ real = convert (TREE_TYPE (type), args[0]);
> if (both)
>- imag = convert (TREE_TYPE (type), TREE_VALUE (TREE_CHAIN (arg)));
>- else if (TREE_CODE (TREE_TYPE (TREE_VALUE (arg))) == COMPLEX_TYPE)
>+ imag = convert (TREE_TYPE (type), args[1]);
>+ else if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE)
> {
>- arg = TREE_VALUE (arg);
>- imag = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (arg)), arg);
>+ imag = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (args[0])), args[0]);
> imag = convert (TREE_TYPE (type), imag);
> }
> else
[]
>@@ -3378,17 +3386,16 @@ gfc_conv_intrinsic_trim (gfc_se * se, gf
> static void
> gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
> {
>- tree args, ncopies, dest, dlen, src, slen, ncopies_type;
>+ tree args[3], ncopies, dest, dlen, src, slen, ncopies_type;
> tree type, cond, tmp, count, exit_label, n, max, largest;
> stmtblock_t block, body;
> int i;
>
> /* Get the arguments. */
>- args = gfc_conv_intrinsic_function_args (se, expr);
>- slen = fold_convert (size_type_node, gfc_evaluate_now (TREE_VALUE (args),
>- &se->pre));
>- src = TREE_VALUE (TREE_CHAIN (args));
>- ncopies = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (args)));
>+ gfc_conv_intrinsic_function_args (se, expr, args, 3);
>+ slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre));
>+ src = args[1];
>+ ncopies = args[2];
> ncopies = gfc_evaluate_now (ncopies, &se->pre);
Perhaps spare the first assignment of ncopies and instead pass args[2] into
gfc_evaluate_now() ?
> ncopies_type = TREE_TYPE (ncopies);
>