Created
July 27, 2010 23:15
-
-
Save jnthn/493036 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm | |
index 9857f75..305eb6d 100644 | |
--- a/src/Perl6/Actions.pm | |
+++ b/src/Perl6/Actions.pm | |
@@ -64,6 +64,18 @@ method comp_unit($/, $key?) { | |
return 1; | |
} | |
+ # XXX To work around the role outers bug, we need to fix up the | |
+ # contexts marked for re-capture. | |
+ $mainline.unshift(PAST::Op.new( | |
+ :inline(' $P0 = get_hll_global "@!recapture"', | |
+ ' recapture_loop:', | |
+ ' unless $P0 goto recapture_loop_end', | |
+ ' $P1 = shift $P0', | |
+ ' fixup_outer_ctx $P1', | |
+ ' goto recapture_loop', | |
+ ' recapture_loop_end:',) | |
+ )); | |
+ | |
$unit.loadinit.unshift( | |
PAST::Op.new( | |
:name('!UNIT_OUTER'), | |
diff --git a/src/Perl6/Compiler/Role.pm b/src/Perl6/Compiler/Role.pm | |
index 15d06ab..b45eeb9 100644 | |
--- a/src/Perl6/Compiler/Role.pm | |
+++ b/src/Perl6/Compiler/Role.pm | |
@@ -76,7 +76,7 @@ method finish($block) { | |
:pasttype('callmethod'), | |
:name('add_method'), | |
$meta_reg, $obj_reg, ~$_, | |
- PAST::Op.new( :pasttype('callmethod'), :name('clone'), %methods{~$_}<code_ref> ) | |
+ PAST::Op.new( :pasttype('callmethod'), :name('clone'), %methods{~$_}<code_ref> ) | |
)); | |
} | |
@@ -107,6 +107,23 @@ method finish($block) { | |
# Call compose to create the role object. | |
$decl.push(PAST::Op.new( :pasttype('callmethod'), :name('compose'), $meta_reg, $obj_reg )); | |
+ # XXX If it's our-scoped, we need to also save a reference to the current | |
+ # context since we need to fixup its outer_ctx later from the main program | |
+ # body. Complete band-aid that we should be able to kill in the not too | |
+ # distant future, but the bug is nasty. | |
+ if !$*SETTING_MODE && ($!scope eq 'our' || $!scope eq '') { | |
+ $decl.unshift(PAST::Op.new( | |
+ :inline(' $P0 = getinterp', | |
+ ' $P0 = $P0["context"]', | |
+ ' $P1 = get_hll_global "@!recapture"', | |
+ ' unless null $P1 goto got_recapture_list', | |
+ ' $P1 = root_new ["parrot";"ResizablePMCArray"]', | |
+ ' set_hll_global "@!recapture", $P1', | |
+ ' got_recapture_list:', | |
+ ' push $P1, $P0') | |
+ )); | |
+ } | |
+ | |
# We need the block to get the signature, or a default one, plus the | |
# decl code as a body. | |
my $sig := pir::defined__IP($!signature) ?? $!signature !! Perl6::Compiler::Signature.new(); | |
diff --git a/src/ops/perl6.ops b/src/ops/perl6.ops | |
index 0f5d315..7c68c0e 100644 | |
--- a/src/ops/perl6.ops | |
+++ b/src/ops/perl6.ops | |
@@ -10,6 +10,7 @@ BEGIN_OPS_PREAMBLE | |
#include "pmc_object.h" | |
#include "pmc_class.h" | |
#include "pmc_callcontext.h" | |
+#include "pmc_sub.h" | |
#include "../pmc/pmc_p6lowlevelsig.h" | |
#include "../binder/bind.h" | |
@@ -710,6 +711,27 @@ inline op find_method_null_ok(out PMC, in PMC, in STR) :base_core { | |
goto NEXT(); | |
} | |
+ | |
+/* | |
+ | |
+=item fixup_outer_ctx(inout PMC) | |
+ | |
+=cut | |
+ | |
+*/ | |
+inline op fixup_outer_ctx(inout PMC) :base_core { | |
+ PMC *cur_ctx = CURRENT_CONTEXT(interp); | |
+ if ($1->vtable->base_type == enum_class_CallContext) { | |
+ Parrot_pcc_set_outer_ctx(interp, $1, cur_ctx); | |
+ goto NEXT(); | |
+ } | |
+ else { | |
+ opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL, | |
+ EXCEPTION_INVALID_OPERATION, "fixup_outer_ctx only valid on a context"); | |
+ goto ADDRESS(handler); | |
+ } | |
+} | |
+ | |
/* | |
* Local variables: | |
* c-file-style: "parrot" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment