Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
A workaround for the role outer scopes bug. It's not perfect, and it'…
…s certainly not the real fix, but it avoids the issue and saves us an awkward FAQ.
  • Loading branch information
jnthn committed Jul 27, 2010
1 parent ac8a2ae commit 7f5c22f
Show file tree
Hide file tree
Showing 3 changed files with 52 additions and 1 deletion.
12 changes: 12 additions & 0 deletions src/Perl6/Actions.pm
Expand Up @@ -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'),
Expand Down
19 changes: 18 additions & 1 deletion src/Perl6/Compiler/Role.pm
Expand Up @@ -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> )
));
}

Expand Down Expand Up @@ -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();
Expand Down
22 changes: 22 additions & 0 deletions src/ops/perl6.ops
Expand Up @@ -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"

Expand Down Expand Up @@ -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"
Expand Down

0 comments on commit 7f5c22f

Please sign in to comment.