Skip to content

Commit

Permalink
Rework code generator to expose th.resultSlot to ANF, saves 7k lines …
Browse files Browse the repository at this point in the history 
…from CORE.cs
  • Loading branch information
@sorear
sorear committed Jul 25, 2010
1 parent f3424dd commit 40e8e9d
Show file tree
Hide file tree
Showing 2 changed files with 132 additions and 43 deletions.
161 changes: 119 additions & 42 deletions CgOp.pm
View file
Expand Up @@ -11,20 +11,49 @@ use warnings;

has zyg => (isa => 'ArrayRef', is => 'ro', default => sub { [] });
# filled in by cps_convert
has does_cps => (isa => 'Bool', is => 'rw');
# 0: returns on eval stack, can appear w/ non-empty
# 1: returns in resultSlot, cannot appear w/ non-empty
# 2: returns on eval stack, cannot appear w/ non-empty
has cps_type => (isa => 'Int', is => 'rw');

sub delayable { 0 }

no Moose;
__PACKAGE__->meta->make_immutable;
}

{
package CgOp::Let;
use Moose;
extends 'CgOp';

has name => (isa => 'Str', is => 'ro');

sub cps_convert {
my ($self) = @_;
my $doescps = 0;
for (@{ $self->zyg }) {
$_ = $_->cps_convert;
$doescps ||= $_->does_cps;
my ($self, $nv) = @_;
my ($head, @kids) = @{ $self->zyg };
$head = $head->cps_convert(1);
for my $i (0 .. $#kids) {
$kids[$i] = $kids[$i]->cps_convert($i == $#kids ? $nv : 0);
}
$self->does_cps($doescps);
$head = CgOp::Primitive->new(op => ['result'], zyg => [$head])
if $head->cps_type == 1;
$self->cps_type($kids[-1]->cps_type || 2);
@{ $self->zyg } = ($head, @kids);
$self;
}

sub delayable { 0 }
sub var_cg {
my ($self, $cg) = @_;
my ($head, @kids) = @{ $self->zyg };
$head->var_cg($cg);
$cg->push_let($self->name);
for (@kids) {
$_->var_cg($cg);
}
$cg->pop_let($self->name);
$cg->drop;
}

no Moose;
__PACKAGE__->meta->make_immutable;
Expand All @@ -35,6 +64,18 @@ use warnings;
use Moose;
extends 'CgOp';

sub cps_convert {
my ($self, $nv) = @_;
my $zyg = $self->zyg;
for (my $i = 0; $i < @$zyg; $i++) {
$zyg->[$i] = $zyg->[$i]->cps_convert($i == $#$zyg);
}
$self->cps_type(2);
$self->cps_type($zyg->[-1]->cps_type) if @$zyg;
$self->cps_type(2) if @$zyg > 1 && $self->cps_type == 0;
$self;
}

sub var_cg {
my ($self, $cg) = @_;
for (@{ $self->zyg }) {
Expand All @@ -56,42 +97,60 @@ use warnings;

my $tsn = 0;
sub cps_convert {
my ($self) = @_;
my @zyg = map { $_->cps_convert } @{ $self->zyg };
my @need_lift = map { $_->does_cps } @zyg;

# All temporaries generated before a lifted operation need to be
my $seen1;
for (reverse @need_lift) {
$seen1 ||= $_;
$_ ||= $seen1;
}

# Except for simple literals
for (0 .. $#zyg) {
$need_lift[$_] = 0 if $zyg[0]->delayable;
}
my ($self, $nv) = @_;
my @zyg = map { $_->cps_convert(1) } @{ $self->zyg };
my @zty = map { $_->cps_type } @zyg;

my @lifted;
my $cps = 0;
for (0 .. $#zyg) {
if ($need_lift[$_]) {
push @lifted, [ $tsn, $zyg[$_] ];
$zyg[$_] = CgOp::letvar("temp!$tsn");

for my $n (0 .. $#zyg) {
my $last_lift = 1;
for ($n + 1 .. $#zyg) {
if ($zty[$_]) {
$last_lift = 0;
}
}

if ((!$zty[$n] || $n == 0) && $last_lift) {
# This can be calculated on, and stay on, the stack
if ($zty[$n] == 1) {
$zyg[$n] = CgOp::Primitive->new(op => ['result'],
zyg => [$zyg[$n]]);
}
$cps = 1 if $zty[$n];
} elsif ($last_lift) {
# This must be calculated in a spill, but can stay in resultSlot
if ($zty[$n] != 1) {
$zyg[$n] = CgOp::Primitive->new(op => ['set_result'],
zyg => [$zyg[$n]]);
}
push @lifted, [ undef, $zyg[$n] ];
$zyg[$n] = CgOp::Primitive->new(op => ['result']);
} else { # !last_lift, so resultSlot is useless as is the stack
# must have a let-spill
if ($zty[$n] == 1) {
$zyg[$n] = CgOp::Primitive->new(op => ['result'],
zyg => [$zyg[$n]]);
}
push @lifted, [ $tsn, $zyg[$n] ];
$zyg[$n] = CgOp::letvar("temp!$tsn");
$tsn++;
$cps = 1;
}
}
@{ $self->zyg } = @zyg;

$cps ||= $self->is_cps_call;
$self->does_cps($cps);
my $cc = $self->is_cps_call;

for (reverse @lifted) {
$self = CgOp::letn("temp!" . $_->[0], $_->[1], $self);
$self->does_cps($cps);
if (defined $_->[0]) {
$self = CgOp::letn("temp!" . $_->[0], $_->[1], $self);
} else {
$self = CgOp::prog($_->[1], $self);
}
}

$self->cps_type($cc ? 1 : (!@lifted && !$cps) ? 0 : 2);

$self;
}

Expand All @@ -116,6 +175,21 @@ use warnings;
use Moose;
extends 'CgOp';

sub cps_convert {
my ($self, $nv) = @_;
$self->zyg->[0] = $self->zyg->[0]->cps_convert(1);
$self->zyg->[$_] = $self->zyg->[$_]->cps_convert($nv) for (1,2);

if ($nv) {
$self->zyg->[$_] = ($self->zyg->[$_]->cps_type == 1) ?
$self->zyg->[$_] : CgOp::Primitive->new(op => ['set_result'],
zyg => [$self->zyg->[$_]]) for (1,2);
}

$self->cps_type(1);
$self;
}

sub var_cg {
my ($self, $cg) = @_;
my ($check, $true, $false) = @{ $self->zyg };
Expand Down Expand Up @@ -143,6 +217,15 @@ use warnings;
has once => (is => 'ro', isa => 'Bool');
has until => (is => 'ro', isa => 'Bool');

sub cps_convert {
my ($self, $nv) = @_;
$self->zyg->[0] = $self->zyg->[0]->cps_convert(1);
$self->zyg->[1] = $self->zyg->[1]->cps_convert(0);

$self->cps_type(1);
$self;
}

sub var_cg {
my ($self, $cg) = @_;
my ($check, $body) = @{ $self->zyg };
Expand Down Expand Up @@ -231,7 +314,8 @@ use warnings;
}

sub varattr {
CgOp::Primitive->new(op => [ 'attr_var', $_[0] ], zyg => [ $_[1] ]);
CgOp::Primitive->new(op => [ 'attr_var', $_[0] ], zyg => [ $_[1] ],
is_cps_call => 1);
}

sub cast {
Expand Down Expand Up @@ -414,14 +498,7 @@ use warnings;

sub letn {
my ($name, $value, @stuff) = @_;
# XXX This violates the cardinal rule of prog (the item, if any, must
# be at the end) but in a safe (I think) way - pop_let can never cause
# a CPS call.
prog(
CgOp::Primitive->new(op => [ 'push_let', $name ],
zyg => [ $value ]),
@stuff,
sink(CgOp::Primitive->new(op => [ 'pop_let', $name ])));
CgOp::Let->new(name => $name, zyg => [ $value, @stuff ]);
}

sub pos {
Expand Down
14 changes: 13 additions & 1 deletion CodeGen.pm
View file
Expand Up @@ -110,6 +110,7 @@ use 5.010;
has savedepth => (isa => 'Int', is => 'rw', default => 0);
has numlabels => (isa => 'Int', is => 'rw', default => 1);
has stacktype => (isa => 'ArrayRef', is => 'ro', default => sub { [] });
has resulttype =>(isa => 'Maybe[Str]', is => 'rw', default => '');
has labelname => (isa => 'HashRef', is => 'ro', default => sub { +{} });
has lex2type => (isa => 'HashRef', is => 'ro', default => sub { +{} });
has buffer => (isa => 'ArrayRef', is => 'ro', default => sub { [] });
Expand Down Expand Up @@ -214,11 +215,22 @@ use 5.010;
$self->_emit("th.ip = $n");
$self->_emit("return $expr");
push @{ $self->buffer }, "case $n:\n";
$self->_push($rt, 'th.resultSlot') if defined $rt;
$self->resulttype($rt);
}

# These functions are usable from user code, but still depend on volatiles.

sub result {
my ($self) = @_;
$self->_push($self->resulttype, "th.resultSlot");
}

sub set_result {
my ($self) = @_;
$self->resulttype($self->stacktype->[-1]);
$self->_emit("th.resultSlot = " . $self->_pop);
}

sub push_let {
my ($self, $which) = @_;
my $var = "let!${which}!" . ($self->letdepths->{$which}++);
Expand Down

0 comments on commit 40e8e9d

Please sign in to comment.