Skip to content

Commit

Permalink
Switch to new packfile API.
Browse files Browse the repository at this point in the history 
This splits the stage 'evalpmc' into two stages 'pbc' and 'init',
making --target=pbc work
  • Loading branch information
@gerdr
gerdr committed Feb 22, 2013
1 parent 688763c commit a93c7c8
Show file tree
Hide file tree
Showing 2 changed files with 46 additions and 24 deletions.
52 changes: 36 additions & 16 deletions src/HLL/Compiler.pm
View file
Expand Up @@ -23,7 +23,7 @@ class HLL::Compiler {

method BUILD() {
# Default stages.
@!stages := nqp::split(' ', 'start parse past post pir evalpmc');
@!stages := nqp::split(' ', 'start parse past post pir pbc init');

# Command options and usage.
@!cmdoptions := nqp::split(' ', 'e=s help|h target=s trace|t=s encoding=s output|o=s combine version|v show-config verbose-config|V stagestats=s? ll-exception rxtrace nqpevent=s profile profile-compile');
Expand Down Expand Up @@ -208,7 +208,8 @@ class HLL::Compiler {
%adverbs.update(%opts);
self.usage($program-name) if %adverbs<help> || %adverbs<h>;

if !nqp::existskey(%adverbs, 'precomp') && %adverbs<target> eq 'pir' {
if !nqp::existskey(%adverbs, 'precomp')
&& (%adverbs<target> eq 'pir' || %adverbs<target> eq 'pbc') {
%adverbs<precomp> := 1;
}

Expand All @@ -233,22 +234,29 @@ class HLL::Compiler {
$!user_progname := '-e';
my $?FILES := '-e';
$result := self.eval(%adverbs<e>, '-e', |@a, |%adverbs);
unless $target eq '' || $target eq 'pir' || %adverbs<output> {
self.dumper($result, $target, |%adverbs);
}
unless $target eq '' || $target eq 'pir' || $target eq 'pbc'
|| %adverbs<output> {
self.dumper($result, $target, |%adverbs);
}
}
elsif !@a { $result := self.interactive(|%adverbs) }
elsif %adverbs<combine> { $result := self.evalfiles(@a, |%adverbs) }
else { $result := self.evalfiles(@a[0], |@a, |%adverbs) }

if !nqp::isnull($result) && ($target eq 'pir' || %adverbs<output>) {
my $output := %adverbs<output>;
my $fh := ($output eq '' || $output eq '-')
?? pir::getinterp__P().stdout_handle()
!! pir::new__Ps('FileHandle').open($output, 'w');
self.panic("Cannot write to $output") unless $fh;
$fh.print($result);
$fh.close()
if !nqp::isnull($result) && $target ne '' {
if $target eq 'pbc' {
my $output := %adverbs<output>;
$result.write_to_file($output) if $output;
}
else {
my $output := %adverbs<output>;
my $fh := ($output eq '' || $output eq '-')
?? pir::getinterp__P().stdout_handle()
!! pir::new__Ps('FileHandle').open($output, 'w');
self.panic("Cannot write to $output") unless $fh;
$fh.print($result);
$fh.close();
}
}
CATCH {
$has_error := 1;
Expand Down Expand Up @@ -417,9 +425,21 @@ class HLL::Compiler {
self.pirbegin() ~ $source.pir()
}

method evalpmc($source, *%adverbs) {
my $compiler := nqp::getcomp('PIR');
$compiler($source)
method pbc($source, *%adverbs) {
pir::compreg__Ps('PIR').compile($source)
}

method init($source, *%adverbs) {
unless $source.is_initialized('init') {
for $source.subs_by_tag('init') -> $sub { $sub() }
$source.mark_initialized('init');
}

# FIXME: should use a custom tag
# changes to code generator still pending
#
# $source.single_sub_by_tag('mainline')
$source.first_sub_in_const_table()
}

method dumper($obj, $name, *%options) {
Expand Down
18 changes: 10 additions & 8 deletions src/NQP/World.pm
View file
Expand Up @@ -240,26 +240,28 @@ class NQP::World is HLL::World {
my $nqpcomp := nqp::getcomp('nqp');
my $post := $nqpcomp.post(QAST::CompUnit.new( :hll('nqp'), $past ));
my $pir := $nqpcomp.pir($post);
my $compiled := $nqpcomp.evalpmc($pir);
my $pbc := $nqpcomp.pbc($pir);
my $mainline := $nqpcomp.init($pbc);

# Fix up any code objects holding stubs with the real compiled thing.
my $c := nqp::elems($compiled);
my @all_subs := $pbc.all_subs();
my $c := nqp::elems(@all_subs);
my $i := 0;
while $i < $c {
my $subid := $compiled[$i].get_subid();
my $subid := @all_subs[$i].get_subid();
if nqp::existskey(%!code_objects_to_fix_up, $subid) {
# First, go over the code objects. Update the $!do, and the
# entry in the SC. Make sure the newly compiled code is marked
# as a static code ref.
my $static := %!code_objects_to_fix_up{$subid}.shift();
nqp::bindattr($static, %!code_object_types{$subid}, '$!do', $compiled[$i]);
nqp::bindattr($static, %!code_object_types{$subid}, '$!do', @all_subs[$i]);
nqp::bindattr($static, %!code_object_types{$subid}, '$!clone_callback', nqp::null());
for %!code_objects_to_fix_up{$subid} {
nqp::bindattr($_, %!code_object_types{$subid}, '$!do', nqp::clone($compiled[$i]));
nqp::bindattr($_, %!code_object_types{$subid}, '$!do', nqp::clone(@all_subs[$i]));
nqp::bindattr($_, %!code_object_types{$subid}, '$!clone_callback', nqp::null());
}
pir::setprop__vPsP($compiled[$i], 'STATIC_CODE_REF', $compiled[$i]);
self.update_root_code_ref(%!code_stub_sc_idx{$subid}, $compiled[$i]);
pir::setprop__vPsP(@all_subs[$i], 'STATIC_CODE_REF', @all_subs[$i]);
self.update_root_code_ref(%!code_stub_sc_idx{$subid}, @all_subs[$i]);

# Clear up the fixup statements.
my $fixup_stmts := %!code_object_fixup_list{$subid};
Expand All @@ -268,7 +270,7 @@ class NQP::World is HLL::World {
$i := $i + 1;
}

$compiled(|@args, |%named);
$mainline(|@args, |%named);
};

# Create code object, if we'll need one.
Expand Down

0 comments on commit a93c7c8

Please sign in to comment.