I've been toying with this patch for a week now, because I'm not sure
whether I should apply it. I think it's a step forward, but it doesn't
solve the whole problem, and might be premature.
What it does:
1. Defines Parrot_rewind_stack as a stub for a more general
implementation of stack rewinding.
2. Changes Continuation:invoke to use it. This makes closure
invocation run all actions in leaving contexts (a bug I would like to
see fixed).
3. Fixes two test cases in t/pmc/exception.t that appear to expect
actions to be thrown away when calling a closure. (Are these just
oversights, or does someone actually need the current behavior?)
4. Removes $TODO from another t/pmc/exception.t case that now
works.
5. Adds three cases to t/pmc/continuation.t, one showing that the
change works (probably redundant wrt the previous case, now that I think
of it), and two more showing its limitations.
Problems:
1. It doesn't invoke the actions in the right dynamic environment.
This is largely because "the current dynamic environment" is tied into
"the currently-executing sub", rather than being stored in the
interpreter and captured by continuations. But fixing that is a much
larger job, which (I assume) we are not yet ready to tackle.
2. Parrot_rewind_stack uses stack_height, which makes it linear in
the current stack depth, rather than linear in the number of entries
that must be traversed. This could be fixed with a bit more effort, but
is only a matter of efficiency.
Possible actions:
1. Apply now, and worry about doing it right when rewinding is
better defined.
2. Punt until then.
3. Start working on a more comprehensive fix.
Opinions?
-- Bob Rogers
http://rgrjr.dyndns.org/
Diffs between last version checked in and current workfile(s):
Index: include/parrot/sub.h
===================================================================
--- include/parrot/sub.h (revision 13593)
+++ include/parrot/sub.h (working copy)
@@ -151,6 +151,8 @@
PMC* Parrot_find_pad(Interp*, STRING *lex_name, parrot_context_t *);
PMC* parrot_new_closure(Interp*, PMC*);
+void Parrot_rewind_stack(Interp*, struct Stack_Chunk *, struct Stack_Chunk *);
+
#endif /* PARROT_SUB_H_GUARD */
/*
Index: src/sub.c
===================================================================
--- src/sub.c (revision 13593)
+++ src/sub.c (working copy)
@@ -481,8 +481,65 @@
#endif
return clos_pmc;
}
+
/*
+=item C<void
+Parrot_rewind_stack(Interp *, struct Stack_Chunk *from, struct Stack_Chunk
*(to>
+
+Given a C<from> control stack entry and a C<to> control stack entry, "rewind"
+the stack by popping from C<from> until a common entry is reached.
+
+[This is a stub for implementing stack rewinding semantics -- when we have a
+better idea of what we want. -- rgr, 22-Jul-06.]
+
+=cut
+
+*/
+
+void
+Parrot_rewind_stack(Interp* interpreter,
+ struct Stack_Chunk *from,
+ struct Stack_Chunk *to)
+{
+ size_t from_height = stack_height(interpreter, from);
+ size_t to_height = stack_height(interpreter, to);
+
+ /* Reduce the 'from' stack while it is greater than the 'to' stack. */
+ while (from_height > to_height) {
+ /*
+ * this automagically runs all pushed action handlers during pop - see
+ * the cleanup stuff in stack_pop.
+ */
+ (void)stack_pop(interpreter, &from, NULL, NO_STACK_ENTRY_TYPE);
+ from_height--;
+ }
+
+ /* Reduce both stack heights in parallel. */
+ if (from_height && from != to) {
+ /* This is either a coroutine, or somebody is using a closure to do a
+ coroutine-like transfer of control into the middle of a
+ computation. */
+ struct Stack_Chunk *below_to = to;
+ while (from_height && from != below_to) {
+ (void)stack_pop(interpreter, &from, NULL, NO_STACK_ENTRY_TYPE);
+ /*
+ * We don't want to stack_pop below_to, because that would call any
+ * actions it may have prematurely. So we reach under the hood to
+ * unwind it quietly.
+ */
+ below_to = below_to->prev;
+ from_height--;
+ }
+ }
+
+ /* [at this point, we should go back up the "to" stack from below_to..to,
+ but the semantics of upward motion are still being defined. -- rgr,
+ 26-Jul-06.] */
+}
+
+/*
+
=back
=head1 SEE ALSO
Index: src/pmc/continuation.pmc
===================================================================
--- src/pmc/continuation.pmc (revision 13593)
+++ src/pmc/continuation.pmc (working copy)
@@ -246,10 +246,13 @@
Parrot_full_sub_name(INTERP, sub));
}
caller_ctx = CONTEXT(INTERP->ctx);
+ ctx = cc->to_ctx;
+ Parrot_rewind_stack(INTERP, caller_ctx->control_stack,
+ ctx->control_stack);
/*
* set context
*/
- CONTEXT(INTERP->ctx) = ctx = cc->to_ctx;
+ CONTEXT(INTERP->ctx) = ctx;
INTERP->ctx.bp = ctx->bp;
INTERP->ctx.bp_ps = ctx->bp_ps;
if (cc->current_results) {
Index: t/pmc/exception.t
===================================================================
--- t/pmc/exception.t (revision 13593)
+++ t/pmc/exception.t (working copy)
@@ -433,11 +433,12 @@
.end
.sub action
- print "never\n"
+ print "unwind\n"
.end
CODE
main
foo
+unwind
back
OUTPUT
@@ -459,11 +460,12 @@
.end
.sub action
- print "never\n"
+ print "unwind\n"
.end
CODE
main
foo
+unwind
back
OUTPUT
@@ -486,10 +488,6 @@
1 2
OUTPUT
-{
-local $TODO = 'bug';
-
-## this is broken; continuation calling does not execute actions when
unwinding.
pir_output_is(<<'CODE', <<'OUTPUT', 'cleanup global: continuation');
.sub main :main
.local pmc outer, cont
@@ -547,9 +545,6 @@
Outer value
OUTPUT
-$TODO++; # suppress warning.
-}
-
pir_output_is(<<'CODE', <<'OUTPUT', 'cleanup global: throw');
.sub main :main
.local pmc outer
Index: t/pmc/continuation.t
===================================================================
--- t/pmc/continuation.t (revision 13593)
+++ t/pmc/continuation.t (working copy)
@@ -6,7 +6,8 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test;
+# remember to change the number of tests :-)
+use Parrot::Test tests => 4;
=head1 NAME
@@ -33,6 +34,176 @@
ok 1
OUT
+$TODO = "BUG: continuations don't preserve the control_stack.";
-# remember to change the number of tests :-)
-BEGIN { plan tests => 1; }
+pir_output_is(<<'CODE', <<'OUT', 'continuations preserve bsr/ret state.');
+## Here is a trace of execution, keyed by labels.
+## L1: bsr to rtn1
+## rtn1: create a continuation that directs us to L6, and (we expect) captures
+## captures the whole dynamic state, including the return address to L3.
+## L3: return back to main
+## L4: if we're here the first time, call rtn2
+## rtn2: call the continuation from that routine.
+## L6: print "Continuation called." and return, which should take us . . .
+## L3: here the second time, where we print "done." and exit.
+.sub test_control_cont :main
+L1:
+ .local int return_count
+ .local pmc cont
+ return_count = 0
+ bsr rtn1
+L3:
+ unless return_count goto L4
+ print "done.\n"
+ end
+L4:
+ inc return_count
+ bsr rtn2
+ print "Oops; shouldn't have returned from rtn2.\n"
+ end
+L6:
+ print "Continuation called.\n"
+ ret
+rtn1:
+ print "Taking continuation.\n"
+ cont = new .Continuation
+ set_addr cont, L6
+ ret
+rtn2:
+ print "Calling continuation.\n"
+ cont()
+ ret
+.end
+CODE
+Taking continuation.
+Calling continuation.
+Continuation called.
+done.
+OUT
+
+$TODO = '';
+
+pir_output_is(<<'CODE', <<'OUT', 'continuations call actions.');
+## the test_cont_action sub creates a continuation and passes it to _test_1
+## twice: the first time returns normally, the second time returns via the
+## continuation.
+.sub test_cont_action :main
+ ## debug 0x80
+ .local pmc cont
+ cont = new .Continuation
+ set_addr cont, continued
+ _test_1(4, cont)
+ _test_1("bar", cont)
+ print "oops; no "
+continued:
+ print "continuation called.\n"
+.end
+
+## set up C<pushaction> cleanup, and pass our arguments to _test_2.
+.sub _test_1
+ .param pmc arg1
+ .param pmc cont
+ print "_test_1\n"
+ .const .Sub $P43 = "___internal_test_1_0_"
+ pushaction $P43
+ $P50 = _test_2(arg1, cont)
+ print "got "
+ print $P50
+ print "\n"
+ .return ($P50)
+.end
+
+## cleanup sub used by _test_1, which just shows whether or not the action was
+## called at the right time.
+.sub ___internal_test_1_0_
+ .local pmc arg1
+ print "unwinding\n"
+ .return ()
+.end
+
+## return 3*n if n is an integer, else invoke the continuation.
+.sub _test_2
+ .param pmc n
+ .param pmc cont
+ typeof $I40, n
+ if $I40 != .Integer goto L3
+ $P44 = n_mul n, 3
+ .return ($P44)
+L3:
+ cont()
+.end
+CODE
+_test_1
+got 12
+unwinding
+_test_1
+unwinding
+continuation called.
+OUT
+
+local $TODO = 'action context is wrong when a closure is invoked';
+
+pir_output_like(<<'CODE', <<'OUT', 'continuation action context');
+## this makes sure that returning via the continuation causes the action to be
+## invoked in the right dynamic context (i.e. without the error handler).
+## [it currently doesn't work because changing the effective dynamic
environment
+## around an executing action is too hard right now. "will the real dynamic
+## environment please stand up?" -- rgr, 26-Jul-06.]
+.sub test_cont_action :main
+ .local pmc cont
+ cont = new .Continuation
+ set_addr cont, continued
+ _test_1("bar", cont)
+ print "oops; no "
+continued:
+ print "continuation called.\n"
+.end
+
+## set up C<pushaction> cleanup, and pass our arguments to _test_2.
+.sub _test_1
+ .param pmc arg1
+ .param pmc cont
+ print "_test_1\n"
+ .const .Sub $P43 = "___internal_test_1_0_"
+ pushaction $P43
+ $P50 = _test_2(arg1, cont)
+ print "got "
+ print $P50
+ print "\n"
+ .return ($P50)
+.end
+
+## cleanup sub used by _test_1, which just shows whether or not the action was
+## called at the right time.
+.sub ___internal_test_1_0_
+ .local pmc arg1
+ print "unwinding\n"
+ $P0 = new .Exception
+ $P0["_message"] = "something happened"
+ throw $P0
+.end
+
+## invoke the continuation within an error handler.
+.sub _test_2
+ .param pmc n
+ .param pmc cont
+ push_eh L3
+ cont()
+ print "oops"
+L3:
+ .local pmc exception
+ .get_results (exception, $S0)
+ print "Error: "
+ print exception
+ print "\n"
+.end
+CODE
+/\A_test_1
+unwinding
+something happened
+current instr/
+OUT
+
+$TODO = '';
+
+# end of tests.
End of diffs.
