Re: *ping* [patch, fortran, 4.9] Dependency and string length calculation improvements
Hi Tobias, Talking about dependencies, I wonder whether you would be interested implementing the function bool gfc_simply_noncontiguous (gfc_expr *); or something similarly named. If you will work on it, please tell me - Sounds interesting. I'll give it a shot. Thomas
Re: *ping* [patch, fortran, 4.9] Dependency and string length calculation improvements
Le 28/03/2013 18:48, Tobias Burnus a écrit : > Talking about dependencies, I wonder whether you would be interested > implementing the function >bool gfc_simply_noncontiguous (gfc_expr *); > or something similarly named. > > It should return true, if the expression is known to be noncontiguous. I suggest having instead a single function returning a two bit integer, one bit for contiguous, one for noncontiguous. Mikael
Re: *ping* [patch, fortran, 4.9] Dependency and string length calculation improvements
Thomas Koenig wrote:
below is a patch which improves dependency checking for array
assignments and calculation of string lengths.
Talking about dependencies, I wonder whether you would be interested
implementing the function
bool gfc_simply_noncontiguous (gfc_expr *);
or something similarly named.
It should return true, if the expression is known to be noncontiguous.
Such a function has many uses:
- Diagnostic to reject invalid code such as "contiguous_ptr =>
noncontiguous_target",* passing a noncontiguous expression to c_loc, and
possibly more
- Compile-time simplification for the IS_CONTIGUOUS intrinsic (not yet
implemented)
- If we pass a noncontiguous array to a contiguous dummy argument (i.e.
assumed-size, explicit-size or contiguous attribute), there is the check
if(new_array != old_array) { unpack(old_array,new_array);free(new_array)
}. If one knows that the array is noncontiguous, the
"if(new_array!=old_array) check could be removed (missed optimization)
- Potentially some more uses
Additionally, gfc_simply_noncontiguous has some bugs (both false
positive and false negative) - especially for BT_CLASS and for
ref-array/ref-substring handling (esp. when combined).
Actually, for
type t
integer i
end type t
type(t) :: foo(5)
is_contiguous(foo(:)%i), it depends on the aligning. (I think one needs
to call gfc_target_expr_size for "foo(:)" and compare it with the
storage size of foo(1)%i.) Of course, if there multiple components,
foo(:)%i is obviously noncontiguous. (For gfc_simply_contiguous, see the
Fortran standard for the exact definition of "simply contiguous", which
should be used with strict==true).
If you will work on it, please tell me - otherwise, I might start to
work on it. (It is not on top of my agenda, but for Fortran 2008's
IS_CONTIGUOUS() and for diagnostic reasons, I like to have it.)
* * *
But now, a bit belated, to your patch.
On 25.03.2013 16:43, Thomas Koenig wrote:
OK for trunk?
OK - except for the following three minor coding convention nits.
+}
+/* Return the difference between two expressions. Integer expressions of
Two empty lines before the comment.
+}
+
/* Returns 1 if the two ranges are the same and 0 if they are not (or if the
This time only one empty line is missing.
- mpz_clear (tmp);
+ mpz_clear (tmp); /* gfc_dep_difference returned true, so tmp was
initialized. */
I am not sure whether the comment is needed - but if you want to keep
it: The line is too long ;-)
Tobias
* Example for that
pointer, contiguous :: ptr
target :: tgt(5)
ptr => tgt(::2)
Re: *ping* [patch, fortran, 4.9] Dependency and string length calculation improvements
I wrote: Ping**2? I'd like to get these patches committed, if possible, to clear up my trees a little bit :-) Thomas *ping* Slightly updated patch below, with a better test case as suggested by Dominique. OK for trunk? 2013-03-16 Thomas Koenig PR fortran/45159 * gfortran.h (gfc_dep_difference): Add prototype. * dependency.c (discard_nops): New function. (gfc_dep_difference): New function. (check_section_vs_section): Use gfc_dep_difference to calculate the difference of starting indices. * trans-expr.c (gfc_conv_substring): Use gfc_dep_difference to calculate the length of substrings where possible. 2013-03-16 Thomas Koenig PR fortran/45159 * gfortran.dg/string_length_2.f90: New test. * gfortran.dg/dependency_41.f90: New test.
*ping* [patch, fortran, 4.9] Dependency and string length calculation improvements
*ping*
Slightly updated patch below, with a better test case as suggested
by Dominique.
OK for trunk?
2013-03-16 Thomas Koenig
PR fortran/45159
* gfortran.h (gfc_dep_difference): Add prototype.
* dependency.c (discard_nops): New function.
(gfc_dep_difference): New function.
(check_section_vs_section): Use gfc_dep_difference
to calculate the difference of starting indices.
* trans-expr.c (gfc_conv_substring): Use
gfc_dep_difference to calculate the length of
substrings where possible.
2013-03-16 Thomas Koenig
PR fortran/45159
* gfortran.dg/string_length_2.f90: New test.
* gfortran.dg/dependency_41.f90: New test.
Index: gfortran.h
===
--- gfortran.h (Revision 196574)
+++ gfortran.h (Arbeitskopie)
@@ -2959,6 +2959,7 @@ gfc_namespace* gfc_build_block_ns (gfc_namespace *
/* dependency.c */
int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
/* check.c */
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
Index: dependency.c
===
--- dependency.c (Revision 196574)
+++ dependency.c (Arbeitskopie)
@@ -500,7 +500,270 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
}
}
+/* Helper function to look through parens and unary plus. */
+static gfc_expr*
+discard_nops (gfc_expr *e)
+{
+
+ while (e && e->expr_type == EXPR_OP
+ && (e->value.op.op == INTRINSIC_UPLUS
+ || e->value.op.op == INTRINSIC_PARENTHESES))
+e = e->value.op.op1;
+
+ return e;
+}
+/* Return the difference between two expressions. Integer expressions of
+ the form
+
+ X + constant, X - constant and constant + X
+
+ are handled. Return true on success, false on failure. result is assumed
+ to be uninitialized on entry, and will be initialized on success.
+*/
+
+bool
+gfc_dep_difference (gfc_expr *e1, gfc_expr *e2, mpz_t *result)
+{
+ gfc_expr *e1_op1, *e1_op2, *e2_op1, *e2_op2;
+
+ if (e1 == NULL || e2 == NULL)
+return false;
+
+ if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
+return false;
+
+ e1 = discard_nops (e1);
+ e2 = discard_nops (e2);
+
+ /* Inizialize tentatively, clear if we don't return anything. */
+ mpz_init (*result);
+
+ /* Case 1: c1 - c2 = c1 - c2, trivially. */
+
+ if (e1->expr_type == EXPR_CONSTANT && e2->expr_type == EXPR_CONSTANT)
+{
+ mpz_sub (*result, e1->value.integer, e2->value.integer);
+ return true;
+}
+
+ if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
+{
+ e1_op1 = discard_nops (e1->value.op.op1);
+ e1_op2 = discard_nops (e1->value.op.op2);
+
+ /* Case 2: (X + c1) - X = c1. */
+ if (e1_op2->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op1, e2) == 0)
+ {
+ mpz_set (*result, e1_op2->value.integer);
+ return true;
+ }
+
+ /* Case 3: (c1 + X) - X = c1. */
+ if (e1_op1->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op2, e2) == 0)
+ {
+ mpz_set (*result, e1_op1->value.integer);
+ return true;
+ }
+
+ if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+ {
+ e2_op1 = discard_nops (e2->value.op.op1);
+ e2_op2 = discard_nops (e2->value.op.op2);
+
+ if (e1_op2->expr_type == EXPR_CONSTANT)
+ {
+ /* Case 4: X + c1 - (X + c2) = c1 - c2. */
+ if (e2_op2->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
+ {
+ mpz_sub (*result, e1_op2->value.integer,
+ e2_op2->value.integer);
+ return true;
+ }
+ /* Case 5: X + c1 - (c2 + X) = c1 - c2. */
+ if (e2_op1->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
+ {
+ mpz_sub (*result, e1_op2->value.integer,
+ e2_op1->value.integer);
+ return true;
+ }
+ }
+ else if (e1_op1->expr_type == EXPR_CONSTANT)
+ {
+ /* Case 6: c1 + X - (X + c2) = c1 - c2. */
+ if (e2_op2->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
+ {
+ mpz_sub (*result, e1_op1->value.integer,
+ e2_op2->value.integer);
+ return true;
+ }
+ /* Case 7: c1 + X - (c2 + X) = c1 - c2. */
+ if (e2_op1->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
+ {
+ mpz_sub (*result, e1_op1->value.integer,
+ e2_op1->value.integer);
+ return true;
+ }
+ }
+ }
+
+ if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+ {
+ e2_op1 = discard_nops (e2->value.op.op1);
+ e2_op2 = discard_nops (e2->value.op.op2);
+
+ if (e1_op2->expr_type == EXPR_CONSTANT)
+ {
+ /* Case 8: X + c1 - (X - c2) = c1 + c2. */
+ if (e2_op2->expr_type == EXPR_CONSTANT
+ && gfc_dep_compare_expr (e1_op1, e2_op1) ==
