Author: leo
Date: Thu Sep 15 09:00:54 2005
New Revision: 9198
Modified:
branches/leo-ctx5/classes/exception_handler.pmc
branches/leo-ctx5/classes/retcontinuation.pmc
branches/leo-ctx5/languages/tcl/t/tcl_misc.t
branches/leo-ctx5/languages/tcl/tcl.pir
branches/leo-ctx5/src/inter_create.c
Log:
Fix GC bug related to exception_handler in leo-ctx5
* destroy of exception_handlers was inherited from continuation, which
decremented the ref_count of the context and free'd it (possibly)
* but an out-ofscope exception_handler doesn't imply that the context is gone
* this lead to reusage of still alive context structures, so that function
returns ended up in the wrong subroutine
* unTODO a tcl_misc test; add a 'puts ok' line - it succeeds
TODO investigate memory handling of EHs - especially when exception was thrown
Modified: branches/leo-ctx5/classes/exception_handler.pmc
==============================================================================
--- branches/leo-ctx5/classes/exception_handler.pmc (original)
+++ branches/leo-ctx5/classes/exception_handler.pmc Thu Sep 15 09:00:54 2005
@@ -48,6 +48,24 @@ Initializes the exception handler.
PObj_active_destroy_SET(SELF);
}
+ /*
+ * can't reuse Continuation's destroy yet -
+ * XXX fix ref_count handling for exception_handlers first
+ *
+ * An Exception_Handler is kind of a limited Continuation
+ * (can only call 'up the stack') Therefore we probably don't
+ * have to convert all RetContinuations to real Continuations
+ */
+
+ void destroy () {
+ struct Parrot_cont * cc = PMC_cont(SELF);
+ if (cc) {
+ if (cc->ctx_copy)
+ mem_sys_free(cc->ctx_copy);
+ mem_sys_free(cc);
+ PMC_cont(SELF) = NULL;
+ }
+ }
}
/*
Modified: branches/leo-ctx5/classes/retcontinuation.pmc
==============================================================================
--- branches/leo-ctx5/classes/retcontinuation.pmc (original)
+++ branches/leo-ctx5/classes/retcontinuation.pmc Thu Sep 15 09:00:54 2005
@@ -44,6 +44,18 @@ Initializes the continuation.
PObj_custom_mark_destroy_SETALL(SELF);
}
+ /*
+ * XXX when reusing SUPER.destroy() RetContinuations
+ * have to set ref_count initially to 1
+ */
+
+ void destroy () {
+ struct Parrot_cont * cc = PMC_cont(SELF);
+ if (cc) {
+ mem_sys_free(cc);
+ PMC_cont(SELF) = NULL;
+ }
+ }
/*
=item C<PMC* clone>
@@ -96,10 +108,12 @@ the frame pointer in the stack frame cac
/* debug print before context is switched */
if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) {
- PMC *sub = CONTEXT(cc->to_ctx)->current_sub;
+ PMC *to_sub = CONTEXT(cc->to_ctx)->current_sub;
+ PMC *from_sub = CONTEXT(cc->from_ctx)->current_sub;
- PIO_eprintf(INTERP, "# Back in sub '%Ss'\n",
- Parrot_full_sub_name(INTERP, sub));
+ PIO_eprintf(INTERP, "# Back in sub '%Ss' from '%Ss\n",
+ Parrot_full_sub_name(INTERP, to_sub),
+ Parrot_full_sub_name(INTERP, from_sub));
}
caller_regs = INTERP->ctx.bp;
INTERP->ctx = cc->to_ctx;
Modified: branches/leo-ctx5/languages/tcl/t/tcl_misc.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/tcl_misc.t (original)
+++ branches/leo-ctx5/languages/tcl/t/tcl_misc.t Thu Sep 15 09:00:54 2005
@@ -141,13 +141,12 @@ TCL
2
OUT
-TODO: {
- local $TODO = "GC (?) bug introduced in leo-ctx5: works fine if you
s/100/10/";
language_output_is("tcl",<<'TCL',<<'OUT',"GC bug?");
for {set i 1} {$i < 100} {incr i} {}
+ puts ok
TCL
+ok
OUT
-}
Modified: branches/leo-ctx5/languages/tcl/tcl.pir
==============================================================================
--- branches/leo-ctx5/languages/tcl/tcl.pir (original)
+++ branches/leo-ctx5/languages/tcl/tcl.pir Thu Sep 15 09:00:54 2005
@@ -1,7 +1,7 @@
#
# _main
#
-# Setup the information the interpreter needs to run,
+# Setup the information the interpreter needs to run,
# then parse and interpret the tcl code we were passed.
.HLL "Tcl", "tcl_group"
@@ -31,7 +31,7 @@
# If no file was specified, read from stdin.
- .local string input_line
+ .local string input_line
.local pmc STDIN,STDOUT
STDIN = getstdin
STDOUT = getstdout
@@ -56,7 +56,7 @@ input_loop:
print "\n"
goto input_loop
-open_file:
+open_file:
tcl_interactive = 0
filename = new String
filename = argv[1]
@@ -72,5 +72,5 @@ done:
realdone:
# don't fall off the end of main, it's rude.
end
-
+
.end
Modified: branches/leo-ctx5/src/inter_create.c
==============================================================================
--- branches/leo-ctx5/src/inter_create.c (original)
+++ branches/leo-ctx5/src/inter_create.c Thu Sep 15 09:00:54 2005
@@ -422,7 +422,7 @@ Parrot_free_context(Interp *interpreter,
* (turn CTX_LEAK_DEBUG on)
*
*/
- if (re_use || --CONTEXT(*ctxp)->ref_count <= 0) {
+ if (re_use || --CONTEXT(*ctxp)->ref_count == 0) {
free_list = (struct Parrot_Context *) interpreter->ctx_mem.free;
LVALUE_CAST(struct Parrot_Context *, interpreter->ctx_mem.free) =
ctxp->rctx;
