Author: leo
Date: Tue Jan 17 04:17:18 2006
New Revision: 11221
Modified:
trunk/compilers/imcc/pbc.c
trunk/include/parrot/sub.h
trunk/src/classes/closure.pmc
trunk/src/classes/sub.pmc
trunk/t/op/lexicals.t
Log:
lexicals - experimental support for autoclosing
* sub f ($x) { sub g () { print $x }; } f(10); g();
* this prints 10 now
* tests
Modified: trunk/compilers/imcc/pbc.c
==============================================================================
--- trunk/compilers/imcc/pbc.c (original)
+++ trunk/compilers/imcc/pbc.c Tue Jan 17 04:17:18 2006
@@ -594,6 +594,7 @@ find_outer(Interp *interpreter, IMC_Unit
for (s = globals.cs->first; s; s = s->next) {
sub = s->unit->instructions->r[0];
if (!strcmp(sub->name, unit->outer->name)) {
+ PObj_get_FLAGS(s->unit->sub_pmc) |= SUB_FLAG_IS_OUTER;
return s->unit->sub_pmc;
}
}
Modified: trunk/include/parrot/sub.h
==============================================================================
--- trunk/include/parrot/sub.h (original)
+++ trunk/include/parrot/sub.h Tue Jan 17 04:17:18 2006
@@ -24,6 +24,8 @@ typedef enum {
SUB_FLAG_CORO_FF = PObj_private0_FLAG,
SUB_FLAG_C_HANDLER = PObj_private0_FLAG,
+ SUB_FLAG_IS_OUTER = PObj_private1_FLAG,
+
SUB_FLAG_TAILCALL = PObj_private2_FLAG,
SUB_FLAG_GENERATOR = PObj_private3_FLAG,
Modified: trunk/src/classes/closure.pmc
==============================================================================
--- trunk/src/classes/closure.pmc (original)
+++ trunk/src/classes/closure.pmc Tue Jan 17 04:17:18 2006
@@ -77,27 +77,51 @@ Invokes the closure.
void* invoke (void* next) {
struct Parrot_sub * sub = PMC_sub(SELF);
+ PMC *cont, *outer_sub;
+
next = SUPER(next);
+ outer_sub = sub->outer_sub;
if (sub->outer_ctx) {
/* during newclosure, outer's ctx was stored in
* sub->outer_ctx
*/
sub->ctx->outer_ctx = sub->outer_ctx;
}
+ else if ((PObj_get_FLAGS(outer_sub) & SUB_FLAG_IS_OUTER &&
+ PMC_sub(outer_sub)->ctx)) {
+ /* the sub was invoked earlier - it still has the context
+ * due to the SUB_FLAG_IS_OUTER flag
+ */
+ sub->outer_ctx = sub->ctx->outer_ctx = PMC_sub(outer_sub)->ctx;
+ }
else {
/* closure is just invoked - located :outer's ctx */
parrot_context_t *caller = sub->ctx->caller_ctx;
while (caller) {
- if (caller->current_sub == sub->outer_sub) {
- sub->ctx->outer_ctx = caller;
- break;
+ if (caller->current_sub == outer_sub) {
+ cont = caller->current_cont;
+ cont->vtable =
Parrot_base_vtables[enum_class_Continuation];
+ sub->outer_ctx = sub->ctx->outer_ctx = caller;
+ caller->ref_count++;
+ return next;
}
caller = caller->caller_ctx;
}
- if (!caller)
- real_exception(interpreter, NULL, INVALID_OPERATION,
- ":outer '%Ss' not found",
- VTABLE_get_string(INTERP, sub->outer_sub));
+ if (!caller) {
+ /* outer has never been invoked, we fake a subroutine call
+ * which builds the LexPad and return immediately
+ * this will usually just lead to a Null PMC access
+ * exception
+ */
+ INTERP->current_cont = NEED_CONTINUATION;
+ (void)VTABLE_invoke(INTERP, sub->outer_sub, next);
+ caller = CONTEXT(INTERP->ctx);
+ cont = caller->current_cont;
+ cont->vtable = Parrot_base_vtables[enum_class_Continuation];
+ sub->outer_ctx = sub->ctx->outer_ctx = caller;
+ caller->ref_count++;
+ (void)VTABLE_invoke(INTERP, cont, next);
+ }
}
return next;
}
Modified: trunk/src/classes/sub.pmc
==============================================================================
--- trunk/src/classes/sub.pmc (original)
+++ trunk/src/classes/sub.pmc Tue Jan 17 04:17:18 2006
@@ -83,7 +83,8 @@ Initializes the subroutine.
/*
* Sub PMC's flags usage:
* - private0 ... Coroutine flip/flop - C exception handler
- * - private1 ... unused
+ * - private1 ... _IS_OUTER - have to preserve context
+ * as some other sub has :outer(this)
* - private2 ... tailcall invoked this Sub
* - private3 ... pythonic coroutine generator flag
* - private4 ... :main (nee @MAIN)
@@ -307,6 +308,11 @@ Invokes the subroutine.
* set context of the sub
*/
sub->ctx = context;
+ if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
+ /* don't destroy context */
+ ccont->vtable = Parrot_base_vtables[enum_class_Continuation];
+ context->ref_count++;
+ }
if (!PMC_IS_NULL(INTERP->current_object)) {
context->current_object = INTERP->current_object;
Modified: trunk/t/op/lexicals.t
==============================================================================
--- trunk/t/op/lexicals.t (original)
+++ trunk/t/op/lexicals.t Tue Jan 17 04:17:18 2006
@@ -955,13 +955,124 @@ pir_output_is(<<'CODE', <<'OUTPUT', 'pac
'&f'()
'&f'()
.end
+CODE
+2
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', 'package-scoped closure 3 - autoclose');
+# sub f ($x) {
+# sub g ($y) { $x + $y }; g($x);
+# }
+# f(10); # 20
+# g(100); # 110
+.sub '&f'
+ .param pmc x
+ .lex '$x', x
+ $P0 = '&g'(x)
+ .return ($P0)
+.end
+
+.sub '&g' :outer('&f')
+ .param pmc y
+ .lex '$y', y
+ .local pmc x
+ x = find_lex '$x'
+ $P0 = n_add x, y
+ .return ($P0)
+.end
+.sub '&main' :main :anon
+ $P0 = '&f'(10)
+ print $P0
+ print "\n"
+ $P0 = '&g'(100)
+ print $P0
+ print "\n"
+.end
CODE
-2
+20
+110
+OUTPUT
+
+pir_output_like(<<'CODE', <<'OUTPUT', 'package-scoped closure 4 - autoclose');
+# sub f ($x) {
+# sub g () { print $x };
+# }
+# g();
+.sub '&f'
+ .param pmc x
+ .lex '$x', x
+.end
+
+.sub '&g' :outer('&f')
+ .local pmc x
+ x = find_lex '$x'
+ print x
+.end
+
+.sub '&main' :main :anon
+ '&g'()
+ print "never\n"
+.end
+CODE
+/Null PMC access/
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', 'package-scoped closure 5 - autoclose');
+# sub f ($x) {
+# sub g () { print "$x\n" };
+# }
+# f(10);
+# g();
+.sub '&f'
+ .param pmc x
+ .lex '$x', x
+.end
+
+.sub '&g' :outer('&f')
+ .local pmc x
+ x = find_lex '$x'
+ print x
+ print "\n"
+.end
+
+.sub '&main' :main :anon
+ '&f'(10)
+ '&g'()
+.end
+CODE
+10
OUTPUT
+pir_output_is(<<'CODE', <<'OUTPUT', 'package-scoped closure 6 - autoclose');
+# sub f ($x) {
+# sub g () { print "$x\n" };
+# }
+# f(10);
+# f(20);
+# g();
+.sub '&f'
+ .param pmc x
+ .lex '$x', x
+.end
+
+.sub '&g' :outer('&f')
+ .local pmc x
+ x = find_lex '$x'
+ print x
+ print "\n"
+.end
+
+.sub '&main' :main :anon
+ '&f'(10)
+ '&f'(20)
+ '&g'()
+.end
+CODE
+20
+OUTPUT
## remember to change the number of tests :-)
-BEGIN { plan tests => 38; }
+BEGIN { plan tests => 42; }
