Discussion:
[Patch, Fortran] No-op Patch - a.k.a. FINAL wrapper update
Tobias Burnus
2012-11-27 18:29:15 UTC
Permalink
Dear all,

effectively, this patch doesn't do anything. Except, it updates the –
deactivated – finalization wrapper.


Note: This patch does not include any code to actually call the
finalization wrapper. Nor is the modified code ever called in gfortran.
However, that patch paves the road to a proper finalization (and
polymorphic deallocation) support. When I mention below that I tested
the patch: That was with the larger but incomplete
final-2012-11-27-v2.diff patch, available at
https://userpage.physik.fu-berlin.de/~tburnus/final/ Note that the patch
there has known issues and does not incorporate all of Janus changes.


Changes relative to the trunk:

* Properly handles coarray components: Those may not be finalized for
intrinsic assignment; with this patch there is now a generated "IF"
condition to ensure this in the wrapper.

* While arrays arguments to the wrapper have to be contiguous, the new
version takes a "stride" argument which allows noncontiguity in the
lowest dimension. That is: One can pass a contiguous array directly to
the parent's finalizer even if it then isn't anymore contiguous (for the
parent type). If the finalizers are all elemental (or scalar), no
copy-in/copy-out is needed. However, if it is passed to an array final
subroutine, the array is packed using the following code:

if (stride == STORAGE_SIZE (array)/NUMERIC_STORAGE_SIZE
|| 0 == STORAGE_SIZE (array)) then
call final_rank3 (array)
else
block
type(t) :: tmp(shape (array))

do i = 0, size (array)-1
addr = transfer (c_loc (array), addr) + i * stride
call c_f_pointer (transfer (addr, cptr), ptr)

addr = transfer (c_loc (tmp), addr)
+ i * STORAGE_SIZE (array)/NUMERIC_STORAGE_SIZE
call c_f_pointer (transfer (addr, cptr), ptr2)
ptr2 = ptr
end do
call final_rank3 (tmp)
end block
end if


Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

PS: I don't know when I will have time to continue working on the patch.
The next steps from my side are: First, submit some smaller bits from
the final-2012-11-27-v2.diff patch, even if they will be unused.
Secondly, do some cleanup and fix a few issues and merge Janus' patch.
(My patch is based on the 2012-10-26 version of the patch, Janus' latest
patch was 2012-11-04.) At that point, one might consider enabling the
FINAL feature partially (e.g. only polymorphic deallocation by not
allowing FINAL) or fully.

PPS: The patch was successfully tested with the following test case (and
some small variations of it):

module m
type t
integer :: i
contains
final :: fini
end type t
type, extends(t) :: t2
integer :: j
contains
final :: fini2
end type t2
contains
subroutine fini(x)
! type(t), intent(in) :: x(:,:)
type(t), intent(inout) :: x(:,:)
print *, 'SHAPE:', shape(x)
print *, x
end subroutine fini
impure elemental subroutine fini2(x)
type(t2), intent(inout) :: x
print *, 'FINI2 - elemental: ', x%i
x%i = x%i+10*x%i
end subroutine fini2
end module m

use m
class(t2), allocatable :: x(:,:)
allocate(t2 :: x(2,3))
x(:,:)%i = reshape([1,2,3,4,5,6],[2,3])
print *, 'HELLO: ', x%i
deallocate(x)
end
Janus Weil
2012-11-29 22:51:19 UTC
Permalink
Hi Tobias,
effectively, this patch doesn't do anything. Except, it updates the –
deactivated – finalization wrapper.
Note: This patch does not include any code to actually call the finalization
wrapper. Nor is the modified code ever called in gfortran. However, that
patch paves the road to a proper finalization (and polymorphic deallocation)
support. When I mention below that I tested the patch: That was with the
larger but incomplete final-2012-11-27-v2.diff patch, available at
https://userpage.physik.fu-berlin.de/~tburnus/final/ Note that the patch
there has known issues and does not incorporate all of Janus changes.
one thing that I do not like about your patch is the modification of
"gfc_find_derived_vtab": You create two versions of it, one of which
creates the vtab if it does not exist, while the other version does
not do this. In short: I think this is not needed (it was removed in
my version of the FINAL patch). Or can you explain to me why this
would be necessary?

[Moreover, the problem is that your new "gfc_find_derived_vtab"
behaves different from the old one but has the same name, while your
new "gfc_get_derived_vtab" behaves like the old
"gfc_find_derived_vtab". Therefore, the places where you change the
behavior by keeping the call to "gfc_find_derived_vtab" are not
visible in the patch.]

Cheers,
Janus
Tobias Burnus
2012-11-30 00:32:37 UTC
Permalink
Post by Janus Weil
one thing that I do not like about your patch is the modification of
"gfc_find_derived_vtab": You create two versions of it, one of which
creates the vtab if it does not exist, while the other version does
not do this. [...] can you explain to me why this would be necessary?
Well, strictly speaking it is not necessary. However, I use it in the
to-be-submitted calling part of the patch:

else if (al->expr->ts.type == BT_DERIVED)
{
gfc_symbol *vtab = gfc_find_derived_vtab
(al->expr->ts.u.derived);
if (vtab)

Here, I do not want to force the generation of a vtab which wouldn't
otherwise exist. Otherwise, one had to at least guard it by checks for
nonextensible derived types (sequence, bind(C)).
Post by Janus Weil
[Moreover, the problem is that your new "gfc_find_derived_vtab"
behaves different from the old one but has the same name, while your
new "gfc_get_derived_vtab" behaves like the old "gfc_find_derived_vtab".
That's because of the bad choice of the current name. The other "find"
functions do not generate the symbol if it does not exist, the "get"
functions do. But otherwise I concur that changing the name is confusing.
Post by Janus Weil
Therefore, the places where you change the behavior by keeping the
call to "gfc_find_derived_vtab" are not visible in the patch.
That should not happen. When I created the patch, I first renamed all
existing versions, though it seems as if I there are currently three new
ones which the current patch misses.

However, if you insist on the current meaning, can you provide a good
name? Otherwise, I could use gfc_really_find_derived_vtab ;-)

Tobias
Janus Weil
2012-11-30 10:22:04 UTC
Permalink
Hi,
Post by Tobias Burnus
Post by Janus Weil
one thing that I do not like about your patch is the modification of
"gfc_find_derived_vtab": You create two versions of it, one of which creates
the vtab if it does not exist, while the other version does not do this.
[...] can you explain to me why this would be necessary?
Well, strictly speaking it is not necessary. However, I use it in the
else if (al->expr->ts.type == BT_DERIVED)
{
gfc_symbol *vtab = gfc_find_derived_vtab
(al->expr->ts.u.derived);
if (vtab)
Here, I do not want to force the generation of a vtab which wouldn't
otherwise exist. Otherwise, one had to at least guard it by checks for
nonextensible derived types (sequence, bind(C)).
I don't think it is a good idea to base the decision whether to call a
finalizer on the presence of a vtab. In my version of the patch I
introduced a routine 'gfc_is_finalizable' to perform this decision.
Post by Tobias Burnus
Post by Janus Weil
[Moreover, the problem is that your new "gfc_find_derived_vtab" behaves
different from the old one but has the same name, while your new
"gfc_get_derived_vtab" behaves like the old "gfc_find_derived_vtab".
That's because of the bad choice of the current name. The other "find"
functions do not generate the symbol if it does not exist, the "get"
functions do. But otherwise I concur that changing the name is confusing.
Post by Janus Weil
Therefore, the places where you change the behavior by keeping the call to
"gfc_find_derived_vtab" are not visible in the patch.
That should not happen. When I created the patch, I first renamed all
existing versions, though it seems as if I there are currently three new
ones which the current patch misses.
However, if you insist on the current meaning, can you provide a good name?
Otherwise, I could use gfc_really_find_derived_vtab ;-)
I do not oppose to renaming gfc_find_derived_vtab to
gfc_get_derived_vtab. My main point is that we do not need a variant
which only searches for the vtab but does not generate it.

Cheers,
Janus
Janus Weil
2012-11-30 10:31:37 UTC
Permalink
Post by Janus Weil
Hi,
Post by Tobias Burnus
Post by Janus Weil
one thing that I do not like about your patch is the modification of
"gfc_find_derived_vtab": You create two versions of it, one of which creates
the vtab if it does not exist, while the other version does not do this.
[...] can you explain to me why this would be necessary?
Well, strictly speaking it is not necessary. However, I use it in the
else if (al->expr->ts.type == BT_DERIVED)
{
gfc_symbol *vtab = gfc_find_derived_vtab
(al->expr->ts.u.derived);
if (vtab)
Here, I do not want to force the generation of a vtab which wouldn't
otherwise exist. Otherwise, one had to at least guard it by checks for
nonextensible derived types (sequence, bind(C)).
I don't think it is a good idea to base the decision whether to call a
finalizer on the presence of a vtab. In my version of the patch I
introduced a routine 'gfc_is_finalizable' to perform this decision.
Forgot to mention: My last version of the patch is available at

http://gcc.gnu.org/ml/fortran/2012-11/msg00009.html


Btw, one prerequisite for the implementation of finalization would be
to have the following bug fixed:

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55207

(which is about automatic deallocation in the main program).

Cheers,
Janus
Tobias Burnus
2012-11-30 10:55:34 UTC
Permalink
In my version of the patch I introduced a routine 'gfc_is_finalizable'
to perform this decision.
Okay. How about the following patch? It's the same without the renaming.

Build an regtested on x86-64-linux.*
OK for the trunk?

* * *

I will submit your gfc_is_finalizable together with some other auxiliary
changes after that patch has been accepted.

I know that even with the auxiliary functions added and the updated
finalization wrapper, it will take some work to get the remaining issues
fixed. I am not sure that the automatic deallocation in the main program
is really the most pressing issue with regards to finalization, but it
surely one of the items.

Tobias

* I really like the GCC Build farm.
Janus Weil
2012-12-02 22:53:46 UTC
Permalink
Hi Tobias,
Post by Tobias Burnus
In my version of the patch I introduced a routine 'gfc_is_finalizable' to
perform this decision.
Okay. How about the following patch? It's the same without the renaming.
Build an regtested on x86-64-linux.*
OK for the trunk?
Yes, looks ok to me. Thanks for the patch!

Cheers,
Janus
Bernhard Reutner-Fischer
2018-10-15 08:23:06 UTC
Permalink
If a finalization is not required we created a namespace containing
formal arguments for an internal interface definition but never used
any of these. So the whole sub_ns namespace was not wired up to the
program and consequently was never freed. The fix is to simply not
generate any finalization wrappers if we know that it will be unused.
Note that this reverts back to the original r190869
(8a96d64282ac534cb597f446f02ac5d0b13249cc) handling for this case
by reverting this specific part of r194075
(f1ee56b4be7cc3892e6ccc75d73033c129098e87) for PR fortran/37336.

Regtests cleanly, installed to the fortran-fe-stringpool branch, sent
here for reference and later inclusion.
I might plug a few more leaks in preparation of switching to hash-maps.
I fear that the leaks around interfaces are another candidate ;)

Should probably add a tag for the compile-time leak PR68800 shouldn't i.

valgrind summary for e.g.
gfortran.dg/abstract_type_3.f03 and gfortran.dg/abstract_type_4.f03
where ".orig" is pristine trunk and ".mine" contains this fix:

at3.orig.vg:LEAK SUMMARY:
at3.orig.vg- definitely lost: 8,460 bytes in 11 blocks
at3.orig.vg- indirectly lost: 13,288 bytes in 55 blocks
at3.orig.vg- possibly lost: 0 bytes in 0 blocks
at3.orig.vg- still reachable: 572,278 bytes in 2,142 blocks
at3.orig.vg- suppressed: 0 bytes in 0 blocks
at3.orig.vg-
at3.orig.vg-Use --track-origins=yes to see where uninitialised values come from
at3.orig.vg-ERROR SUMMARY: 38 errors from 33 contexts (suppressed: 0 from 0)
--
at3.mine.vg:LEAK SUMMARY:
at3.mine.vg- definitely lost: 344 bytes in 1 blocks
at3.mine.vg- indirectly lost: 7,192 bytes in 18 blocks
at3.mine.vg- possibly lost: 0 bytes in 0 blocks
at3.mine.vg- still reachable: 572,278 bytes in 2,142 blocks
at3.mine.vg- suppressed: 0 bytes in 0 blocks
at3.mine.vg-
at3.mine.vg-ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
at3.mine.vg-ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
at4.orig.vg:LEAK SUMMARY:
at4.orig.vg- definitely lost: 13,751 bytes in 12 blocks
at4.orig.vg- indirectly lost: 11,976 bytes in 60 blocks
at4.orig.vg- possibly lost: 0 bytes in 0 blocks
at4.orig.vg- still reachable: 572,278 bytes in 2,142 blocks
at4.orig.vg- suppressed: 0 bytes in 0 blocks
at4.orig.vg-
at4.orig.vg-Use --track-origins=yes to see where uninitialised values come from
at4.orig.vg-ERROR SUMMARY: 18 errors from 16 contexts (suppressed: 0 from 0)
--
at4.mine.vg:LEAK SUMMARY:
at4.mine.vg- definitely lost: 3,008 bytes in 3 blocks
at4.mine.vg- indirectly lost: 4,056 bytes in 11 blocks
at4.mine.vg- possibly lost: 0 bytes in 0 blocks
at4.mine.vg- still reachable: 572,278 bytes in 2,142 blocks
at4.mine.vg- suppressed: 0 bytes in 0 blocks
at4.mine.vg-
at4.mine.vg-ERROR SUMMARY: 3 errors from 3 contexts (suppressed: 0 from 0)
at4.mine.vg-ERROR SUMMARY: 3 errors from 3 contexts (suppressed: 0 from 0)

gcc/fortran/ChangeLog:

2018-10-12 Bernhard Reutner-Fischer <***@gcc.gnu.org>

* class.c (generate_finalization_wrapper): Do leak finalization
wrappers if they will not be used.
* expr.c (gfc_free_actual_arglist): Formatting fix.
* gfortran.h (gfc_free_symbol): Pass argument by reference.
(gfc_release_symbol): Likewise.
(gfc_free_namespace): Likewise.
* symbol.c (gfc_release_symbol): Adjust acordingly.
(free_components): Set procedure pointer components
of derived types to NULL after freeing.
(free_tb_tree): Likewise.
(gfc_free_symbol): Set sym to NULL after freeing.
(gfc_free_namespace): Set namespace to NULL after freeing.
---
gcc/fortran/class.c | 25 +++++++++----------------
gcc/fortran/expr.c | 2 +-
gcc/fortran/gfortran.h | 6 +++---
gcc/fortran/symbol.c | 19 ++++++++++---------
4 files changed, 23 insertions(+), 29 deletions(-)

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 69c95fc5dfa..e0bb381a55f 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -1533,7 +1533,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
gfc_code *last_code, *block;
const char *name;
bool finalizable_comp = false;
- bool expr_null_wrapper = false;
gfc_expr *ancestor_wrapper = NULL, *rank;
gfc_iterator *iter;

@@ -1561,13 +1560,17 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
}

/* No wrapper of the ancestor and no own FINAL subroutines and allocatable
- components: Return a NULL() expression; we defer this a bit to have have
+ components: Return a NULL() expression; we defer this a bit to have
an interface declaration. */
if ((!ancestor_wrapper || ancestor_wrapper->expr_type == EXPR_NULL)
&& !derived->attr.alloc_comp
&& (!derived->f2k_derived || !derived->f2k_derived->finalizers)
&& !has_finalizer_component (derived))
- expr_null_wrapper = true;
+ {
+ vtab_final->initializer = gfc_get_null_expr (NULL);
+ gcc_assert (vtab_final->ts.interface == NULL);
+ return;
+ }
else
/* Check whether there are new allocatable components. */
for (comp = derived->components; comp; comp = comp->next)
@@ -1581,7 +1584,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,

/* If there is no new finalizer and no new allocatable, return with
an expr to the ancestor's one. */
- if (!expr_null_wrapper && !finalizable_comp
+ if (!finalizable_comp
&& (!derived->f2k_derived || !derived->f2k_derived->finalizers))
{
gcc_assert (ancestor_wrapper && ancestor_wrapper->ref == NULL
@@ -1605,8 +1608,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
/* Set up the namespace. */
sub_ns = gfc_get_namespace (ns, 0);
sub_ns->sibling = ns->contained;
- if (!expr_null_wrapper)
- ns->contained = sub_ns;
+ ns->contained = sub_ns;
sub_ns->resolved = 1;

/* Set up the procedure symbol. */
@@ -1622,7 +1624,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
final->ts.kind = 4;
final->attr.artificial = 1;
final->attr.always_explicit = 1;
- final->attr.if_source = expr_null_wrapper ? IFSRC_IFBODY : IFSRC_DECL;
+ final->attr.if_source = IFSRC_DECL;
if (ns->proc_name->attr.flavor == FL_MODULE)
final->module = ns->proc_name->name;
gfc_set_sym_referenced (final);
@@ -1672,15 +1674,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
final->formal->next->next->sym = fini_coarray;
gfc_commit_symbol (fini_coarray);

- /* Return with a NULL() expression but with an interface which has
- the formal arguments. */
- if (expr_null_wrapper)
- {
- vtab_final->initializer = gfc_get_null_expr (NULL);
- vtab_final->ts.interface = final;
- return;
- }
-
/* Local variables. */

gfc_get_symbol (gfc_get_string ("%s", "idx"), sub_ns, &idx);
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index cc12e0a8402..3d744ec9641 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -533,7 +533,7 @@ gfc_free_actual_arglist (gfc_actual_arglist *a1)
{
a2 = a1->next;
if (a1->expr)
- gfc_free_expr (a1->expr);
+ gfc_free_expr (a1->expr);
free (a1);
a1 = a2;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4612835706b..3466c42132f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3032,8 +3032,8 @@ gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
const char *gfc_get_uop_from_name (const char*);
const char *gfc_get_name_from_uop (const char*);
-void gfc_free_symbol (gfc_symbol *);
-void gfc_release_symbol (gfc_symbol *);
+void gfc_free_symbol (gfc_symbol *&);
+void gfc_release_symbol (gfc_symbol *&);
gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
@@ -3058,7 +3058,7 @@ void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol *);
gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
-void gfc_free_namespace (gfc_namespace *);
+void gfc_free_namespace (gfc_namespace *&);

void gfc_symbol_init_2 (void);
void gfc_symbol_done_2 (void);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 09ad2bbf0cd..c99c106a0c0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2590,8 +2590,9 @@ free_components (gfc_component *p)
gfc_free_expr (p->kind_expr);
if (p->param_list)
gfc_free_actual_arglist (p->param_list);
- free (p->tb);

+ free (p->tb);
+ p->tb = NULL;
free (p);
}
}
@@ -3070,7 +3071,7 @@ set_symbol_common_block (gfc_symbol *sym, gfc_common_head *common_block)
/* Remove a gfc_symbol structure and everything it points to. */

void
-gfc_free_symbol (gfc_symbol *sym)
+gfc_free_symbol (gfc_symbol *&sym)
{

if (sym == NULL)
@@ -3078,8 +3079,6 @@ gfc_free_symbol (gfc_symbol *sym)

gfc_free_array_spec (sym->as);

- free_components (sym->components);
-
gfc_free_expr (sym->value);

gfc_free_namelist (sym->namelist);
@@ -3094,19 +3093,22 @@ gfc_free_symbol (gfc_symbol *sym)

gfc_free_namespace (sym->f2k_derived);

+ free_components (sym->components);
+
set_symbol_common_block (sym, NULL);

if (sym->param_list)
gfc_free_actual_arglist (sym->param_list);

free (sym);
+ sym = NULL;
}


/* Decrease the reference counter and free memory when we reach zero. */

void
-gfc_release_symbol (gfc_symbol *sym)
+gfc_release_symbol (gfc_symbol *&sym)
{
if (sym == NULL)
return;
@@ -3826,10 +3828,8 @@ free_tb_tree (gfc_symtree *t)

free_tb_tree (t->left);
free_tb_tree (t->right);
-
- /* TODO: Free type-bound procedure structs themselves; probably needs some
- sort of ref-counting mechanism. */
free (t->n.tb);
+ t->n.tb = NULL;
free (t);
}

@@ -4019,7 +4019,7 @@ free_entry_list (gfc_entry_list *el)
taken care of when a specific name is freed. */

void
-gfc_free_namespace (gfc_namespace *ns)
+gfc_free_namespace (gfc_namespace *&ns)
{
gfc_namespace *p, *q;
int i;
@@ -4057,6 +4057,7 @@ gfc_free_namespace (gfc_namespace *ns)
gfc_free_data (ns->data);
p = ns->contained;
free (ns);
+ ns = NULL;

/* Recursively free any contained namespaces. */
while (p != NULL)
--
2.19.1
Loading...