From: Leopold Toetsch <[EMAIL PROTECTED]>
Date: Sun, 5 Feb 2006 02:21:19 +0100
On Feb 4, 2006, at 22:04, Bob Rogers wrote:
[detailed plan]
> Sound good? Unless I've missed something, this seems like a win
> across the board . . .
Sounds very good.
Unfortunately, I may not be the person to follow through on this. I've
spent the equivalent of a day on it, and am still very much stuck, so I
think I need to give up, at least for now. However, I would like to
submit the attached patch for review, which contains three good things
that I would like to salvage:
1. Closure still needs a destroy method, and having one is in fact
sufficient to reclaim contexts that would otherwise be lost.
2. In order to prove this (not to mention for debugging of
RetContinuation hackery), I added a fair amount of new CTX_LEAK_DEBUG
trace code, centralized it in interpreter.h, and put all of this output
under control of PARROT_CTX_DESTROY_DEBUG_FLAG so that it could be
turned on/off without recompiling.
3. While I was at it, I flushed most of the "#if CHUNKED_CTX_MEM"
code in src/register.c -- this code has serious bit-rot, and having two
implementations of Parrot_free_context et. al. tended to get in the way,
especially since M-. usually found the wrong one. (Though you could
argue that I didn't go far enough in flushing all of the CHUNKED_CTX_MEM
stuff . . .)
It is possible to show that Closure:destroy does something useful by
taking t/op/lexicals_28.pir (the 'closure 3' case), adding "debug 0x80"
as the first line in "main", and running it with and without the
src/pmc/closure.pmc hunk. I toyed with the idea of making a regression
test by adding some Perl postprocessing magic to make it less dependent
on build and version, thus:
[EMAIL PROTECTED]> ./parrot t/op/lexicals_28.pir 2>&1 | perl -pe
's/0x[\da-f]*/"0x#".($X{$&}||=++$n)."#"/ge'
[alloc ctx 0x#1#]
[alloc closure 0x#2#, outer_ctx 0x#1#, ref_count=2]
[invoke cont 0x#3#, to_ctx 0x#4#, from_ctx 0x#1# (refs 2)]
[alloc ctx 0x#5#]
[free ctx 0x#5# of sub 'anon']
8
[alloc ctx 0x#5#]
[alloc closure 0x#6#, outer_ctx 0x#5#, ref_count=2]
[invoke cont 0x#7#, to_ctx 0x#4#, from_ctx 0x#5# (refs 2)]
[alloc ctx 0x#8#]
[free ctx 0x#8# of sub 'anon']
23
[alloc ctx 0x#8#]
[free ctx 0x#8# of sub 'anon']
11
[alloc ctx 0x#8#]
[free ctx 0x#8# of sub 'anon']
27
[destroy closure 0x#6#, context 0x#5#]
[destroy cont 0x#7#, to_ctx 0x#4#, from_ctx 0x#5#]
[free ctx 0x#5# of sub 'foo']
[destroy closure 0x#2#, context 0x#1#]
[destroy cont 0x#3#, to_ctx 0x#4#, from_ctx 0x#1#]
[free ctx 0x#1# of sub 'foo']
[destroy closure 0x#9#, context (nil)]
[EMAIL PROTECTED]>
But even that seems too sensitive to internal changes, so I didn't take
it any further. At least this gives me a chance to provide a sample of
the output. (Thanks to Uri Guttman, whose tiny templater provided the
inspiration for the one-liner.)
In any case, I will wait a few days for comments before attempting to
commit any of this (as three separate changes). TIA,
-- Bob Rogers
http://rgrjr.dyndns.org/
Index: src/ops/core.ops
===================================================================
--- src/ops/core.ops (revision 11532)
+++ src/ops/core.ops (working copy)
@@ -548,6 +548,10 @@
if (PMC_cont(ccont)->address) {
/* else its from runops_fromc */
caller_ctx = PMC_cont(ccont)->to_ctx;
+ if (! caller_ctx) {
+ real_exception(interpreter, NULL, INVALID_OPERATION,
+ "null caller_ctx for ccont %p", ccont);
+ }
parrot_pass_args(interpreter, ctx, caller_ctx,
PARROT_OP_get_results_pc);
}
Index: src/register.c
===================================================================
--- src/register.c (revision 11532)
+++ src/register.c (working copy)
@@ -58,7 +58,9 @@
* The pointer C<ctx_mem.free> holds the next usable
* location. With (full) continuations the C<ctx_mem.free> pointer can't be
* moved below the C<ctx_mem.threshold>, which is the highest context pointer
- * of all avtive continuations.
+ * of all active continuations.
+ * [the code for this is incomplete; it had suffered some bit-rot and was
+ * getting in the way of maintaining the other case. -- rgr, 4-Feb-06.]
*
* TODO GC has to lower this threshold when collecting continuations.
*
@@ -89,55 +91,12 @@
*/
#if CHUNKED_CTX_MEM
-static void
-new_context_mem(Interp *interpreter, context_mem *ctx_mem)
-{
- ctx_mem->data = mem_sys_allocate(CTX_ALLOC_SIZE);
- ctx_mem->free = ctx_mem->data;
- ctx_mem->threshold = NULL;
- ctx_mem->prev = NULL;
-}
+#error "Deleted code removed."
+#endif
void
destroy_context(Interp *interpreter)
{
- context_mem *ctx_mem, *prev;
-
- mem_sys_free(interpreter->ctx_mem.data);
- for (ctx_mem = interpreter->ctx_mem.prev; ctx_mem; ) {
- prev = ctx_mem->prev;
- mem_sys_free(ctx_mem->data);
- mem_sys_free(ctx_mem);
- ctx_mem = prev;
- }
-}
-
-void
-create_initial_context(Interp *interpreter)
-{
- size_t to_alloc = sizeof(struct parrot_regs_t) + ALIGNED_CTX_SIZE;
- void *p;
- parrot_context_t *ctx;
-
- new_context_mem(interpreter, &interpreter->ctx_mem);
- p = interpreter->ctx_mem.free;
- CONTEXT(interpreter->ctx) = ctx = p;
- p = interpreter->ctx_mem.free + ALIGNED_CTX_SIZE;
- interpreter->ctx.bp = p;
- interpreter->ctx.bp_ps.regs_s = (STRING**) ((char*)p +
- offsetof(struct parrot_regs_t, string_reg.registers[0]));
- interpreter->ctx_mem.free += to_alloc;
- memset(ctx, 0, sizeof(struct Parrot_Context));
- ctx->bp = interpreter->ctx.bp;
- ctx->bp_ps = interpreter->ctx.bp_ps;
- ctx->prev = NULL;
-}
-
-#else
-
-void
-destroy_context(Interp *interpreter)
-{
int slot;
void *ptr, *next;
@@ -174,8 +133,6 @@
Parrot_alloc_context(interpreter, num_regs);
}
-#endif
-
/*
=item C<void parrot_gc_context(Interp *)>
@@ -290,112 +247,6 @@
clear_regs(interpreter, ctx);
}
-#if CHUNKED_CTX_MEM
-void
-Parrot_alloc_context(Interp *interpreter, INTVAL *n_regs_used)
-{
-
- parrot_context_t ctx;
- size_t used;
-
- /* for now still use 32 regs fixed chunks */
- size_t to_alloc = sizeof(struct parrot_regs_t) + ALIGNED_CTX_SIZE;
-
- used = interpreter->ctx_mem.free - interpreter->ctx_mem.data;
- if (used + to_alloc >= CTX_ALLOC_SIZE ) {
- /* trigger a DOD run to reuse ctx hel by dead continuations */
- if (interpreter->ctx_mem.threshold) {
- Parrot_do_dod_run(interpreter, DOD_trace_stack_FLAG);
- used = interpreter->ctx_mem.free - interpreter->ctx_mem.data;
- }
- if (used + to_alloc >= CTX_ALLOC_SIZE ) {
- context_mem *ctx_mem = mem_sys_allocate(sizeof(context_mem));
- memcpy(ctx_mem, &interpreter->ctx_mem, sizeof(context_mem));
- ctx_mem->prev = NULL;
- new_context_mem(interpreter, &interpreter->ctx_mem);
- interpreter->ctx_mem.prev = ctx_mem;
- }
- }
- ctx = interpreter->ctx;
- LVALUE_CAST(char *, interpreter->ctx.bp) =
- interpreter->ctx_mem.free + ALIGNED_CTX_SIZE;
- interpreter->ctx_mem.free += to_alloc;
- init_context(interpreter, ctx);
-}
-
-void
-Parrot_set_context_threshold(Interp * interpreter, parrot_context_t *ctxp)
-{
- char *used_ctx_mem;
- parrot_context_t ctx = *ctxp;
-
- used_ctx_mem = (char *)ctx.bp + sizeof(struct parrot_regs_t);
- if ((UINTVAL)used_ctx_mem > (UINTVAL)interpreter->ctx_mem.free)
- interpreter->ctx_mem.free = used_ctx_mem;
-}
-
-void
-Parrot_free_context(Interp *interpreter, parrot_context_t *ctxp, int re_use)
-{
-
- struct Parrot_Context *prev;
- size_t to_alloc = sizeof(struct parrot_regs_t) + ALIGNED_CTX_SIZE;
- parrot_context_t ctx = *ctxp;
- char *used_ctx_mem;
-
- prev = CONTEXT(ctx)->prev;
- if (!prev) {
- /* returning from main */
- return;
- }
- CONTEXT(ctx)->prev = NULL;
- used_ctx_mem = (char *)ctx.bp + sizeof(struct parrot_regs_t);
-
- /* if we are at the top end of memory
- * (e.g. return continuation was invoked)
- * then lower free
- */
- if (used_ctx_mem == interpreter->ctx_mem.free &&
- interpreter->ctx_mem.free > interpreter->ctx_mem.threshold) {
- interpreter->ctx_mem.free -= to_alloc;
- if (interpreter->ctx_mem.free == interpreter->ctx_mem.data) {
- /* reached lower end of context chunk */
- if (interpreter->ctx_mem.prev) {
- context_mem *ctx_mem = interpreter->ctx_mem.prev;
-#if 0
- /* TODO
- * can't do that yet
- * runops_fromc still fetches results after the
- * return continuation is invoked
- * XXX leak the register memory for now
- */
- mem_sys_free(interpreter->ctx_mem.data);
-#endif
- memcpy(&interpreter->ctx_mem, ctx_mem, sizeof(context_mem));
- mem_sys_free(ctx_mem);
- }
- }
- }
- if (!re_use) {
- /*
- * real continuation was GCed
- * mark this ctx area dead
- */
- if (interpreter->ctx_mem.threshold == used_ctx_mem) {
- /* if threshold is at the end of used memory, lower threshold */
- interpreter->ctx_mem.threshold -= to_alloc;
- }
- else {
- /* mark it dead by setting a uniq signature into the
- * prev pointer location
- */
- *(void**)&CONTEXT(ctx)->prev = (void*) 0xdeaddead;
- }
- }
-}
-
-#else
-
struct Parrot_Context *
Parrot_dup_context(Interp *interpreter, struct Parrot_Context *old)
{
@@ -467,7 +318,9 @@
ptr = mem_sys_allocate_zeroed(to_alloc);
}
#if CTX_LEAK_DEBUG
- fprintf(stderr, "alloc %p\n", ptr);
+ if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr, "[alloc ctx %p]\n", ptr);
+ }
#endif
CONTEXT(interpreter->ctx) = ctx = ptr;
ctx->regs_mem_size = reg_alloc;
@@ -502,10 +355,8 @@
if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
/* can't probably PIO_eprintf here */
parrot_sub_t doomed = PMC_sub(ctxp->current_sub);
- fprintf(stderr,
- "'ctx of sub '%s' is really dead "
- "now and not pining at all\n",
- (char*)doomed->name->strstart);
+ fprintf(stderr, "[free ctx %p of sub '%s']\n",
+ ctxp, (char*)doomed->name->strstart);
}
#endif
ptr = ctxp;
@@ -514,9 +365,6 @@
assert(slot < interpreter->ctx_mem.n_free_slots);
*(void **)ptr = interpreter->ctx_mem.free_list[slot];
interpreter->ctx_mem.free_list[slot] = ptr;
-#if CTX_LEAK_DEBUG
- fprintf(stderr, "free %p\n", ctxp);
-#endif
}
}
@@ -526,7 +374,6 @@
/* nothing to do */
}
-#endif
/*
=back
Index: src/debug.c
===================================================================
--- src/debug.c (revision 11532)
+++ src/debug.c (working copy)
@@ -2796,11 +2796,14 @@
/* backtrace: follow the continuation chain */
while (1) {
+ parrot_cont_t sub_cont;
sub = ctx->current_cont;
if (!sub)
break;
- str = Parrot_Context_infostr(interpreter,
- PMC_cont(sub)->to_ctx);
+ sub_cont = PMC_cont(sub);
+ if (!sub_cont)
+ break;
+ str = Parrot_Context_infostr(interpreter, sub_cont->to_ctx);
if (!str)
break;
Index: src/pmc/continuation.pmc
===================================================================
--- src/pmc/continuation.pmc (revision 11532)
+++ src/pmc/continuation.pmc (working copy)
@@ -102,6 +102,13 @@
void destroy () {
struct Parrot_cont * cc = PMC_cont(SELF);
if (cc) {
+#if CTX_LEAK_DEBUG
+ if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG))
{
+ fprintf(stderr,
+ "[destroy cont %p, to_ctx %p, from_ctx %p]\n",
+ SELF, cc->to_ctx, cc->from_ctx);
+ }
+#endif
if (cc->from_ctx)
Parrot_free_context(interpreter, cc->from_ctx, 0);
mem_sys_free(cc);
@@ -219,6 +226,18 @@
parrot_context_t *ctx;
opcode_t *pc;
+#if CTX_LEAK_DEBUG
+ if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr,
+ "[invoke cont %p, to_ctx %p, from_ctx %p (refs %d)]\n",
+ SELF, cc->to_ctx, cc->from_ctx,
+ (int) cc->from_ctx->ref_count);
+ }
+#endif
+ if (! cc->to_ctx) {
+ real_exception(interpreter, NULL, INVALID_OPERATION,
+ "Continuation invoked after deactivation.");
+ }
/* debug print before context is switched */
if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) {
PMC *sub = cc->to_ctx->current_sub;
Index: src/pmc/closure.pmc
===================================================================
--- src/pmc/closure.pmc (revision 11532)
+++ src/pmc/closure.pmc (working copy)
@@ -174,6 +174,32 @@
}
}
}
+
+/*
+
+=item C<void destroy()>
+
+Destroys the closure. This is necessary in order to reclaim the context.
+
+=cut
+
+*/
+
+ void destroy () {
+ struct Parrot_sub * sub = PMC_sub(SELF);
+#if CTX_LEAK_DEBUG
+ if (Interp_debug_TEST(INTERP, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr, "[destroy closure %p, context %p]\n",
+ SELF, sub->outer_ctx);
+ }
+#endif
+ if (sub->outer_ctx) {
+ Parrot_free_context(interpreter, sub->outer_ctx, 0);
+ sub->outer_ctx = NULL;
+ }
+ SUPER();
+ }
+
}
/*
Index: src/inter_create.c
===================================================================
--- src/inter_create.c (revision 11532)
+++ src/inter_create.c (working copy)
@@ -27,8 +27,6 @@
Interp interpre;
#endif
-#define CTX_LEAK_DEBUG 0
-
#define ATEXIT_DESTROY
/*
Index: src/sub.c
===================================================================
--- src/sub.c (revision 11532)
+++ src/sub.c (working copy)
@@ -125,7 +125,8 @@
new_continuation(Interp *interp, struct Parrot_cont *to)>
Returns a new C<Parrot_cont> to the context of C<to> with its own copy of the
-current interpreter context.
+current interpreter context. If C<to> is C<NULL>, then the C<to_ctx> is set
+to the current context.
=cut
@@ -454,6 +455,12 @@
clos->outer_ctx = ctx;
/* the closure refs now this context too */
ctx->ref_count++;
+#if CTX_LEAK_DEBUG
+ if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr, "[alloc closure %p, outer_ctx %p, ref_count=%d]\n",
+ clos_pmc, ctx, (int) ctx->ref_count);
+ }
+#endif
return clos_pmc;
}
/*
Index: include/parrot/interpreter.h
===================================================================
--- include/parrot/interpreter.h (revision 11532)
+++ include/parrot/interpreter.h (working copy)
@@ -169,6 +169,13 @@
INTVAL *regs_i;
} Regs_ni;
+/* If CTX_LEAK_DEBUG is enabled, then turning on PARROT_CTX_DESTROY_DEBUG_FLAG
+ will print tons of detail about when Parrot_Context structures are allocated
+ and deallocated to stderr. If CTX_LEAK_DEBUG is disabled, then all of the
+ relevant code is omitted, and PARROT_CTX_DESTROY_DEBUG_FLAG has no effect.
+ */
+#define CTX_LEAK_DEBUG 1
+
typedef struct Parrot_Context {
/* common header with Interp_Context */
struct Parrot_Context *unused1; /* placeholder */
