Skip to content

Commit

Permalink
Cleanup scope exit-handling
Browse files Browse the repository at this point in the history 
An optimization to handle a single LEAVEish phaser block, was broken.
This meant that all block exits that had any phaser, would take the
slow path.

Instead if a block contains *only* a single LEAVE phaser, a super fast
path is taken on exiting the block, without needing any hash lookups.
This e.g. reduces the overhead of Lock.protect by 20%.  And there are
4 of these for *every* startup of rakudo.

This commit changes / fixes the following:
- Block.$!phasers now either is not concrete (no phasers), contains
  a block (a single LEAVE phaser), or contains a hash with phasers (as
  before)
- the Block API for phasers remains the same, handling the new meanings
  of the $!phasers attribute transparently
- The add phaser handling code has been adapted to support the lone
  LEAVE phaser case
- the exit-handler only gets called if $!phasers is concrete: it
  now only has to check whether it is a hash (if not, take the fast
  path, directly executing what is in $!phasers).
- the slow exit-handler path also has a fast path for scopes that
  have leavish phasers, but no KEEP / UNDO phasers
- unnecessary deconting has been remove from the exit handler.
- the PhasersList class has been removed: it predated the IterationBuffer
  class, and it was basically just that.  Changing that, simplified
  HLLizing some Block phaser API calls
- the brittle handling of scopes by the "will" trait on variables, has
  been changed to dynamically search for the variable in question
  • Loading branch information
@lizmat
lizmat committed May 3, 2022
1 parent a84e168 commit dafa657
Show file tree
Hide file tree
Showing 12 changed files with 229 additions and 150 deletions.
28 changes: 15 additions & 13 deletions src/Perl6/Actions.nqp
View file
Expand Up @@ -2170,17 +2170,14 @@ class Perl6::Actions is HLL::Actions does STDActions {
if $*LABEL {
$loop.push(QAST::WVal.new( :value($world.find_single_symbol($*LABEL)), :named('label') ));
}
# Handle phasers.
my $code := $loop[1].ann('code_object');
my $block_type := $world.find_single_symbol_in_setting('Block');
my $phasers := nqp::getattr($code, $block_type, '$!phasers');
if !nqp::ishash($phasers) {
$loop[1] := pblock_immediate($loop[1]);
}
else {
# Handle any loopy phasers.
my $code := $loop[1].ann('code_object');
my $Block := $world.find_single_symbol_in_setting('Block');
my $phasers := nqp::getattr($code, $Block, '$!phasers');
if nqp::ishash($phasers) {
my $node := $loop.node;
if nqp::existskey($phasers, 'NEXT') {
my $phascode := $world.run_phasers_code($code, $loop[1], $block_type, 'NEXT');
my $phascode := $world.run_phasers_code($code, $loop[1], $Block, 'NEXT');
if +@($loop) == 2 {
$loop.push($phascode);
}
Expand All @@ -2203,9 +2200,12 @@ class Perl6::Actions is HLL::Actions does STDActions {
}
if nqp::existskey($phasers, 'LAST') {
$loop := QAST::Stmts.new(:$node, :resultchild(0), $loop,
$world.run_phasers_code: $code, $loop[1], $block_type, 'LAST');
$world.run_phasers_code: $code, $loop[1], $Block, 'LAST');
}
}
else { # no phasers or a lone LEAVE phaser
$loop[1] := pblock_immediate($loop[1]);
}
$loop
}

Expand Down Expand Up @@ -4405,8 +4405,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
method maybe_add_inlining_info($/, $code, $sig, $past, @params) {
# Cannot inline things with custom invocation handler or phasers.
return 0 if nqp::can($code, 'CALL-ME');
my $phasers := nqp::getattr($code,$*W.find_single_symbol_in_setting('Block'),'$!phasers');
return 0 unless !nqp::ishash($phasers) || !$phasers;

return 0 if nqp::isconcrete(nqp::getattr(
$code, $*W.find_single_symbol_in_setting('Block'), '$!phasers'
));

# Make sure the block has the common structure we expect
# (decls then statements).
Expand All @@ -4416,7 +4418,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
# them. No parameters also means no inlining.
return 0 unless @params;

my $world := $*W;
my $world := $*W;
my $Param := $world.find_single_symbol_in_setting('Parameter');
my @p_objs := nqp::getattr($sig, $world.find_single_symbol_in_setting('Signature'), '@!params');
my %arg_placeholders;
Expand Down
2 changes: 1 addition & 1 deletion src/Perl6/Optimizer.nqp
View file
Expand Up @@ -3895,7 +3895,7 @@ class Perl6::Optimizer {
?? nqp::getattr($code, $block, '$!phasers')
!! nqp::null();
if $count == 1
&& !nqp::ishash($phasers)
&& !nqp::isconcrete($phasers)
&& %range_bounds{$c2.name}($c2) -> @fls {
if $reverse {
my $tmp := @fls[0];
Expand Down
18 changes: 11 additions & 7 deletions src/Perl6/World.nqp
View file
Expand Up @@ -2739,23 +2739,24 @@ class Perl6::World is HLL::World {

# Adds any extra code needing for handling phasers.
method add_phasers_handling_code($code, $code_past) {
my $block_type := self.find_single_symbol_in_setting('Block');
if nqp::istype($code, $block_type) {
my %phasers := nqp::getattr($code, $block_type, '$!phasers');
if nqp::ishash(%phasers) {
my $Block := self.find_single_symbol_in_setting('Block');
if nqp::istype($code, $Block) {
my $phasers := nqp::getattr($code, $Block, '$!phasers');
if nqp::ishash($phasers) {
my %phasers := $phasers;
if nqp::existskey(%phasers, 'PRE') {
$code_past[0].push(QAST::Op.new( :op('p6setpre') ));
$code_past[0].push(self.run_phasers_code($code, $code_past, $block_type, 'PRE'));
$code_past[0].push(self.run_phasers_code($code, $code_past, $Block, 'PRE'));
$code_past[0].push(QAST::Op.new( :op('p6clearpre') ));
}
if nqp::existskey(%phasers, 'FIRST') {
$code_past[0].push(QAST::Op.new(
:op('if'),
QAST::Op.new( :op('p6takefirstflag') ),
self.run_phasers_code($code, $code_past, $block_type, 'FIRST')));
self.run_phasers_code($code, $code_past, $Block, 'FIRST')));
}
if nqp::existskey(%phasers, 'ENTER') {
$code_past[0].push(self.run_phasers_code($code, $code_past, $block_type, 'ENTER'));
$code_past[0].push(self.run_phasers_code($code, $code_past, $Block, 'ENTER'));
}
if nqp::existskey(%phasers, '!LEAVE-ORDER') || nqp::existskey(%phasers, 'POST') {
$code_past.has_exit_handler(1);
Expand All @@ -2771,6 +2772,9 @@ class Perl6::World is HLL::World {
));
}
}
elsif nqp::isconcrete($phasers) { # lone LEAVE phaser
$code_past.has_exit_handler(1);
}
}
}

Expand Down
158 changes: 89 additions & 69 deletions src/Perl6/bootstrap.c/BOOTSTRAP.nqp
View file
Expand Up @@ -2312,9 +2312,8 @@ BEGIN {
nqp::setcodeobj($do_cloned, $cloned);
#?if !jvm
my $phasers := nqp::getattr($dcself, Block, '$!phasers');
if nqp::isconcrete($phasers) {
$dcself."!clone_phasers"($cloned, $phasers);
}
$dcself."!clone_phasers"($cloned, $phasers)
if nqp::ishash($phasers);
#?endif
my $compstuff := nqp::getattr($dcself, Code, '@!compstuff');
unless nqp::isnull($compstuff) {
Expand Down Expand Up @@ -2383,10 +2382,10 @@ BEGIN {
#?endif
}));
Block.HOW.add_method(Block, '!capture_phasers', nqp::getstaticcode(sub ($self) {
my $dcself := nqp::decont($self);
my $dcself := nqp::decont($self);
#?if !jvm
my $phasers := nqp::getattr($dcself, Block, '$!phasers');
if nqp::isconcrete($phasers) {
my $phasers := nqp::getattr($dcself, Block, '$!phasers');
if nqp::ishash($phasers) {
my @next := nqp::atkey($phasers, 'NEXT');
if nqp::islist(@next) {
my int $i := -1;
Expand Down Expand Up @@ -4055,93 +4054,114 @@ nqp::sethllconfig('Raku', nqp::hash(
},
'exit_handler', -> $coderef, $resultish {
unless nqp::p6inpre() {
my %phasers :=
nqp::getattr(nqp::getcodeobj($coderef),Block,'$!phasers');
my @leaves := nqp::atkey(%phasers, '!LEAVE-ORDER');
my @posts := nqp::atkey(%phasers, 'POST');
my @exceptions;
unless nqp::isnull(@leaves) {

# only have a single LEAVEish phaser, so no frills needed
if nqp::elems(@leaves) == 1 && nqp::elems(%phasers) == 1 {
# when we get here, we assume the $!phasers attribut is concrete.
# if it is *not* a hash, it is a lone LEAVE phaser, the most
# commenly used phaser (in the core at least).
my $phasers := nqp::getattr(
nqp::getcodeobj($coderef),Block,'$!phasers'
);

# slow path here
if nqp::ishash($phasers) {
my @leaves := nqp::atkey($phasers, '!LEAVE-ORDER');
my @posts := nqp::atkey($phasers, 'POST');
my @exceptions;
unless nqp::isnull(@leaves) {
my @keeps := nqp::atkey($phasers, 'KEEP');
my @undos := nqp::atkey($phasers, 'UNDO');
my int $n := nqp::elems(@leaves);
my int $i := -1;

# fast leave path
if nqp::isnull(@leaves) && nqp::isnull(@undos) {
while ++$i < $n {
CATCH { nqp::push(@exceptions, $_) }
#?if jvm
nqp::decont(nqp::atpos(@leaves,0))();
nqp::atpos(@leaves, $i))();
#?endif
#?if !jvm
nqp::p6capturelexwhere(
nqp::decont(nqp::atpos(@leaves,0)).clone)();
nqp::p6capturelexwhere(
nqp::atpos(@leaves, $i).clone()
)();
#?endif
# don't bother to CATCH, there can only be one exception
}
}
}

# slow path here
else {
my @keeps := nqp::atkey(%phasers, 'KEEP');
my @undos := nqp::atkey(%phasers, 'UNDO');
my int $n := nqp::elems(@leaves);
my int $i := -1;
my int $run;
my $phaser;
while ++$i < $n {
$phaser := nqp::decont(nqp::atpos(@leaves, $i));
$run := 1;
unless nqp::isnull(@keeps) {
for @keeps {
if nqp::eqaddr(nqp::decont($_),$phaser) {
$run := !nqp::isnull($resultish) &&
nqp::isconcrete($resultish) &&
$resultish.defined;
last;
# slow leave paths
else {
my int $run;
my $phaser;
while ++$i < $n {
$phaser := nqp::atpos(@leaves, $i);
$run := 1;
unless nqp::isnull(@keeps) {
for @keeps {
if nqp::eqaddr($_,$phaser) {
$run := !nqp::isnull($resultish) &&
nqp::isconcrete($resultish) &&
$resultish.defined;
last;
}
}
}
}
unless nqp::isnull(@undos) {
for @undos {
if nqp::eqaddr(nqp::decont($_),$phaser) {
$run := nqp::isnull($resultish) ||
!nqp::isconcrete($resultish) ||
!$resultish.defined;
last;
unless nqp::isnull(@undos) {
for @undos {
if nqp::eqaddr($_,$phaser) {
$run := nqp::isnull($resultish) ||
!nqp::isconcrete($resultish) ||
!$resultish.defined;
last;
}
}
}
}
if $run {
if $run {
CATCH { nqp::push(@exceptions, $_) }
#?if jvm
$phaser();
$phaser();
#?endif
#?if !jvm
nqp::p6capturelexwhere($phaser.clone())();
nqp::p6capturelexwhere($phaser.clone())();
#?endif
CATCH { nqp::push(@exceptions, $_) }
}
}
}
}
}

unless nqp::isnull(@posts) {
my $value := nqp::ifnull($resultish,Mu);
my int $n := nqp::elems(@posts);
my int $i := -1;
while ++$i < $n {
unless nqp::isnull(@posts) {
my $value := nqp::ifnull($resultish,Mu);
my int $n := nqp::elems(@posts);
my int $i := -1;
while ++$i < $n {
#?if jvm
nqp::atpos(@posts, $i)($value);
nqp::atpos(@posts, $i)($value);
#?endif
#?if !jvm
nqp::p6capturelexwhere(nqp::atpos(@posts,$i).clone)($value);
nqp::p6capturelexwhere(nqp::atpos(@posts,$i).clone)($value);
#?endif
CATCH { nqp::push(@exceptions, $_); last; }
CATCH { nqp::push(@exceptions, $_); last; }
}
}
}

if @exceptions {
if nqp::elems(@exceptions) > 1 {
Perl6::Metamodel::Configuration.throw_or_die(
'X::PhaserExceptions',
"Multiple exceptions were thrown by LEAVE/POST phasers",
:exceptions(@exceptions)
);
if @exceptions {
nqp::elems(@exceptions) > 1
?? Perl6::Metamodel::Configuration.throw_or_die(
'X::PhaserExceptions',
"Multiple exceptions were thrown by LEAVE/POST phasers",
:exceptions(@exceptions)
)
!! nqp::rethrow(@exceptions[0]);
}
nqp::rethrow(@exceptions[0]);
}

# only have a lone LEAVE phaser, so no frills needed
# don't bother to CATCH, there can only be one exception
else {
#?if jvm
$phasers();
#?endif
#?if !jvm
nqp::p6capturelexwhere($phasers.clone)();
#?endif
}
}
},
Expand Down

0 comments on commit dafa657

Please sign in to comment.