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 + +Given a C control stack entry and a C control stack entry, "rewind" +the stack by popping from C 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 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 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.