Author: pmichaud
Date: Thu Dec 18 15:38:19 2008
New Revision: 34090
Modified:
trunk/compilers/nqp/t/15-module.t
trunk/compilers/pct/src/PAST/Compiler.pir
trunk/compilers/pct/src/PAST/Node.pir
trunk/compilers/pct/src/PCT/HLLCompiler.pir
trunk/languages/perl6/perl6.pir
trunk/languages/perl6/src/builtins/eval.pir
trunk/languages/perl6/src/builtins/guts.pir
trunk/languages/perl6/src/parser/actions.pm
Log:
Merge Rakudo 'main' branch (refactor load/init/main) into trunk.
Modified: trunk/compilers/nqp/t/15-module.t
==============================================================================
--- trunk/compilers/nqp/t/15-module.t (original)
+++ trunk/compilers/nqp/t/15-module.t Thu Dec 18 15:38:19 2008
@@ -2,17 +2,17 @@
# check module
-say('1..1');
-
-our $value := 'ok 2';
+XYZ::sayfoo();
+XYZ::foo('ok 3');
+XYZ::sayfoo();
module XYZ {
- our $value := 'not ok 1';
+ our $value := 'ok 1';
sub foo($x) { $value := $x; }
sub sayfoo() { say($value); }
+ say('1..3');
+ sayfoo();
+ foo('ok 2');
}
-XYZ::foo('ok 1');
-XYZ::sayfoo();
-
Modified: trunk/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Compiler.pir (original)
+++ trunk/compilers/pct/src/PAST/Compiler.pir Thu Dec 18 15:38:19 2008
@@ -59,8 +59,6 @@
piropsig['isnull'] = 'IP'
piropsig['issame'] = 'IPP'
piropsig['istrue'] = 'IP'
- piropsig['newclosure'] = 'PP'
- piropsig['n_abs'] = 'PP'
piropsig['add'] = 'PP+'
piropsig['band'] = 'PPP'
piropsig['bnot'] = 'PP'
@@ -68,10 +66,13 @@
piropsig['concat'] = 'PP~'
piropsig['div'] = 'PP+'
piropsig['fdiv'] = 'PP+'
+ piropsig['find_name'] = 'P~'
piropsig['getprop'] = 'P~P'
piropsig['mod'] = 'PP+'
piropsig['mul'] = 'PP+'
+ piropsig['n_abs'] = 'PP'
piropsig['n_neg'] = 'PP'
+ piropsig['newclosure'] = 'PP'
piropsig['not'] = 'PP'
piropsig['shl'] = 'PP+'
piropsig['shr'] = 'PP+'
@@ -785,15 +786,13 @@
## determine the outer POST::Sub for the new one
.local pmc outerpost
outerpost = get_global '$?SUB'
- $P0 = node.'lexical'()
- if $P0 goto outer_block
- null $P0
- set_global '$?SUB', $P0
- goto outer_done
- outer_block:
- bpost.'outer'(outerpost)
set_global '$?SUB', bpost
+ .local int islexical
+ islexical = node.'lexical'()
+ unless islexical goto outer_done
+ bpost.'outer'(outerpost)
+
## add block setup code (cpost) to outer block if needed
if null outerpost goto outer_done
$I0 = index pirflags, ':anon'
@@ -933,6 +932,7 @@
$P0 = get_hll_global ['POST'], 'Ops'
bpost = $P0.'new'( bpost, 'node'=>node, 'result'=>blockreg)
bpost.'push_pirop'( blockref, 'result'=>blockreg )
+ unless islexical goto block_done
bpost.'push_pirop'('capture_lex', blockreg)
goto block_done
@@ -946,7 +946,9 @@
$P0 = get_hll_global ['POST'], 'Ops'
bpost = $P0.'new'(bpost, 'node'=>node, 'result'=>result)
bpost.'push_pirop'(blockref)
+ unless islexical goto block_immediate_capture_skip
bpost.'push_pirop'('capture_lex', blockreg)
+ block_immediate_capture_skip:
bpost.'push_pirop'('call', blockreg, arglist :flat, 'result'=>result)
block_done:
Modified: trunk/compilers/pct/src/PAST/Node.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Node.pir (original)
+++ trunk/compilers/pct/src/PAST/Node.pir Thu Dec 18 15:38:19 2008
@@ -606,10 +606,8 @@
=item lexical([flag])
-Get/set whether the block is a lexical block. A block
-with this attribute set to false is not lexically scoped
-inside of its parent, and will not act as an outer lexical
-scope for any nested blocks within it.
+Get/set whether the block is lexically nested within
+the block that contains it.
=cut
Modified: trunk/compilers/pct/src/PCT/HLLCompiler.pir
==============================================================================
--- trunk/compilers/pct/src/PCT/HLLCompiler.pir (original)
+++ trunk/compilers/pct/src/PCT/HLLCompiler.pir Thu Dec 18 15:38:19 2008
@@ -666,7 +666,7 @@
close ifh
goto iter_loop
iter_end:
- $P0 = self.'eval'(code, adverbs :flat :named)
+ $P0 = self.'eval'(code, args :flat, adverbs :flat :named)
if target == '' goto end
if target == 'pir' goto end
'_dumper'($P0, target)
@@ -755,7 +755,7 @@
unless args goto interactive
$I0 = adverbs['combine']
if $I0 goto combine
- $S0 = shift args
+ $S0 = args[0]
result = self.'evalfiles'($S0, args :flat, adverbs :flat :named)
goto save_output
combine:
Modified: trunk/languages/perl6/perl6.pir
==============================================================================
--- trunk/languages/perl6/perl6.pir (original)
+++ trunk/languages/perl6/perl6.pir Thu Dec 18 15:38:19 2008
@@ -158,20 +158,8 @@
.sub 'main' :main
.param pmc args_str
- ## Set up @*ARGS.
- .local pmc args
- args = '!SETUP_ARGS'(args_str, 0)
-
$P0 = compreg 'Perl6'
- $P1 = $P0.'command_line'(args, 'encoding'=>'utf8',
'transcode'=>'iso-8859-1')
-
- ## Now execute any MAIN sub.
- .local pmc main_sub, args
- main_sub = get_hll_global 'MAIN'
- if null main_sub goto no_main
- args = get_hll_global '@ARGS'
- main_sub(args :flat)
- no_main:
+ $P1 = $P0.'command_line'(args_str, 'encoding'=>'utf8',
'transcode'=>'iso-8859-1')
.include 'iterator.pasm'
.local pmc iter
Modified: trunk/languages/perl6/src/builtins/eval.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/eval.pir (original)
+++ trunk/languages/perl6/src/builtins/eval.pir Thu Dec 18 15:38:19 2008
@@ -40,6 +40,10 @@
.tailcall compiler.'evalfiles'(filename)
lang_parrot:
+ ## load_bytecode currently doesn't accept non-ascii filenames (TT #65)
+ ## so we'll force it to ascii for now.
+ $I0 = find_charset 'ascii'
+ filename = trans_charset filename, $I0
load_bytecode filename
.return (1)
.end
Modified: trunk/languages/perl6/src/builtins/guts.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/guts.pir (original)
+++ trunk/languages/perl6/src/builtins/guts.pir Thu Dec 18 15:38:19 2008
@@ -304,31 +304,35 @@
.end
-=item !SETUP_ARGS
-
-Sets up the @*ARGS global. We could possibly use the args pmc coming directly
-from Parrot, but currently Parrot provides it as a ResizableStringArray and we
-need Undefs for non-existent elements (RSA gives empty strings).
+=item !UNIT_START
=cut
-.sub '!SETUP_ARGS'
- .param pmc args_str
- .param int strip_program_name
- .local pmc args, it
- args = new 'List'
- it = iter args_str
- args_loop:
- unless it goto args_end
- $P0 = shift it
- push args, $P0
- goto args_loop
- args_end:
- unless strip_program_name goto done
+.sub '!UNIT_START'
+ .param pmc unitmain
+ .param pmc args
+
+ args = 'list'(args)
+ if args goto start_main
+ .tailcall unitmain()
+
+ start_main:
+ ## We're running as main program
+ ## Remove program argument (0) and set up @ARGS global
$P0 = shift args
- done:
+ args = args.'Array'()
set_hll_global '@ARGS', args
- .return (args)
+ ## run unitmain
+ .local pmc result, MAIN
+ result = unitmain()
+ ## if there's a MAIN sub in unitmain's namespace, run it also
+ $P0 = unitmain.'get_namespace'()
+ MAIN = $P0['MAIN']
+ if null MAIN goto done
+ args = get_hll_global '@ARGS'
+ result = MAIN(args :flat)
+ done:
+ .return (result)
.end
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Thu Dec 18 15:38:19 2008
@@ -7,32 +7,17 @@
my $past := $( $<statement_block> );
$past.blocktype('declaration');
declare_implicit_routine_vars($past);
-
- # Attach any initialization code.
- our $?INIT;
- if defined( $?INIT ) {
- $?INIT.unshift(
- PAST::Var.new(
- :name('$def'),
- :scope('lexical'),
- :isdecl(1)
- )
- );
- $?INIT.blocktype('declaration');
- $?INIT.pirflags(':init :load');
- $past.unshift( $?INIT );
- $?INIT := PAST::Block.new(); # For the next eval.
- }
+ $past.lexical(0);
# Make sure we have the interpinfo constants.
$past.unshift( PAST::Op.new( :inline('.include "interpinfo.pasm"') ) );
- # Set package.
+ # Set package for unit mainline
$past.unshift(set_package_magical());
- # Add code to load perl6.pbc if it's not already present
- my $loadinit := $past.loadinit();
- $loadinit.unshift(
+ # Create the unit's startup block.
+ my $main := PAST::Block.new( :pirflags(':main') );
+ $main.loadinit().push(
PAST::Op.new( :inline('$P0 = compreg "Perl6"',
'unless null $P0 goto have_perl6',
'load_bytecode "perl6.pbc"',
@@ -40,82 +25,34 @@
)
);
- # convert the last operation of the block into a .return op
- # so that :load block below isn't used as return value
- $past.push( PAST::Op.new( $past.pop(), :pirop('return') ) );
- # automatically invoke mainline on :load (but not :init)
- $past.push(
- PAST::Block.new(
+ # call the unit mainline, passing any arguments, and return
+ # the result. We force a tailcall here because we need a
+ # :load sub (below) to occur last in the generated output, but don't
+ # want it to be treated as the module's return value.
+ $main.push(
+ PAST::Op.new( :pirop('tailcall'),
+ PAST::Op.new( :pirop('find_name'), '!UNIT_START' ),
+ $past,
+ PAST::Var.new( :scope('parameter'), :name('@_'), :slurpy(1) )
+ )
+ );
+
+ # generate a :load sub that invokes this one, but does so _last_
+ # (e.g., at the end of a load_bytecode operation)
+ $main.push(
+ PAST::Block.new( :pirflags(':load'), :blocktype('declaration'),
PAST::Op.new(
- :inline(
- '$P0 = interpinfo .INTERPINFO_CURRENT_SUB',
- '$P0 = $P0."get_outer"()',
- '$P0()'
- )
- ),
- :pirflags(':load')
- )
- );
-
- # emit a :main block that acts as the entry point in pre-compiled scripts
- $past.push(
- PAST::Block.new(
- :pirflags(':main'),
- PAST::Op.new(
- :pasttype('call'),
- :name('!SETUP_ARGS'),
- PAST::Var.new(
- :name('args_str'),
- :scope('parameter')
- ),
- 1
- ),
- PAST::Op.new(
- :inline(
- '$P0 = interpinfo .INTERPINFO_CURRENT_SUB',
- '$P0 = $P0."get_outer"()',
- '$P0()'
- )
- ),
- PAST::Op.new(
- :pasttype('bind'),
- PAST::Var.new(
- :name('main_sub'),
- :scope('register'),
- :isdecl(1)
- ),
- PAST::Var.new(
- :name('MAIN'),
- :scope('package')
- )
- ),
- PAST::Op.new(
- :pasttype('unless'),
- PAST::Op.new(
- :pirop('isnull'),
- PAST::Var.new(
- :name('main_sub'),
- :scope('register')
- )
- ),
- PAST::Op.new(
- :pasttype('call'),
- PAST::Var.new(
- :name('main_sub'),
- :scope('register')
- ),
- PAST::Var.new(
- :name('@ARGS'),
- :scope('package'),
- :namespace(''),
- :flat(1)
- )
+ :inline( '.include "interpinfo.pasm"',
+ '$P0 = interpinfo .INTERPINFO_CURRENT_SUB',
+ '$P0 = $P0."get_outer"()',
+ '$P0()'
)
)
)
);
+ $main.push( PAST::Stmts.new() );
- make $past;
+ make $main;
}
@@ -387,33 +324,23 @@
method use_statement($/) {
my $name := ~$<name>;
my $past;
- if $name eq 'v6' || $name eq 'lib' {
- $past := PAST::Stmts.new( :node($/) );
- }
- else {
- $past := PAST::Op.new(
- PAST::Val.new( :value($name) ),
- :name('use'),
- :pasttype('call'),
- :node( $/ )
+ if $name ne 'v6' && $name ne 'lib' {
+ ## Create a loadinit node so the use module is loaded
+ ## when this module is loaded...
+ our $?BLOCK;
+ $?BLOCK.loadinit().push(
+ PAST::Op.new(
+ PAST::Val.new( :value($name) ),
+ :name('use'),
+ :pasttype('call'),
+ :node( $/ )
+ )
);
-
- # What we'd really like to do now is something like:
- # my $sub := PAST::Compiler.compile( $past );
- # $sub();
- # Which would include it at compile time. But for now, that breaks
- # pre-compiled PIR modules (we'd also need to emit something to load
- # modules from the pre-compiled PIR, somehow). But we can't just emit
- # a call straight into the output code, because then we load the
- # module too late to inherit from any classes in it. So for now we
- # stick the use call into $?INIT.
- our $?INIT;
- unless defined($?INIT) {
- $?INIT := PAST::Block.new();
- }
- $?INIT.push($past);
- $past := PAST::Stmts.new( :node($/) );
+ ## ...and load it immediately to get its BEGIN semantics
+ ## and symbols for the current compilation.
+ use($name);
}
+ $past := PAST::Stmts.new( :node($/) );
make $past;
}
@@ -754,8 +681,9 @@
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register'),
+ :isdecl(1)
),
PAST::Op.new(
:pasttype('call'),
@@ -767,8 +695,8 @@
:pasttype('call'),
:name('!keyword_has'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new( :value("$!" ~ $name) ),
# XXX Set declared type here, when we parse that.
@@ -781,8 +709,8 @@
:pasttype('callmethod'),
:name('add_method'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new( :value($name) ),
make_accessor($/, undef, "$!" ~ $name, 1, 'attribute')
@@ -794,8 +722,8 @@
:pasttype('callmethod'),
:name('add_method'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new( :value($_) ),
PAST::Block.new(
@@ -823,23 +751,24 @@
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register'),
+ :isdecl(1)
),
PAST::Op.new(
:pasttype('call'),
:name('!keyword_enum'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
)
)
),
PAST::Op.new(
:inline(' setprop %0, "enum", %1'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new(
:value(1),
@@ -855,8 +784,8 @@
:pasttype('callmethod'),
:name('add_vtable_override'),
PAST::Var.new(
- :scope('lexical'),
- :name('$def')
+ :scope('register'),
+ :name('def')
),
'invoke',
PAST::Block.new(
@@ -872,8 +801,8 @@
:pasttype('callmethod'),
:name('add_vtable_override'),
PAST::Var.new(
- :scope('lexical'),
- :name('$def')
+ :scope('register'),
+ :name('def')
),
'get_string',
PAST::Block.new(
@@ -893,8 +822,8 @@
:pasttype('callmethod'),
:name('add_vtable_override'),
PAST::Var.new(
- :scope('lexical'),
- :name('$def')
+ :scope('register'),
+ :name('def')
),
'get_integer',
PAST::Block.new(
@@ -914,8 +843,8 @@
:pasttype('callmethod'),
:name('add_vtable_override'),
PAST::Var.new(
- :scope('lexical'),
- :name('$def')
+ :scope('register'),
+ :name('def')
),
'get_number',
PAST::Block.new(
@@ -948,8 +877,8 @@
:pasttype('callmethod'),
:name('new'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new(
:value(%values{$_}),
@@ -976,14 +905,10 @@
# Assemble all that we build into a statement list and then place it
# into the init code.
- our $?INIT;
- unless defined( $?INIT ) {
- $?INIT := PAST::Block.new();
- }
- $?INIT.push(PAST::Stmts.new(
- $role_past,
- $class_past
- ));
+ our $?BLOCK;
+ my $loadinit := $?BLOCK.loadinit();
+ $loadinit.push($role_past);
+ $loadinit.push($class_past);
# Finally, since it's a decl, we don't have anything to emit at this
# point; just hand back empty statements block.
@@ -1710,8 +1635,8 @@
:name('trait_auxiliary:is'),
$superclass,
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
)
)
);
@@ -1731,8 +1656,8 @@
:pasttype('call'),
:name('!keyword_does'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
$role_name
)
@@ -1869,7 +1794,6 @@
our $?MODULE;
our $?NS;
our $?PACKAGE;
- our $?INIT;
my $name := $<name>;
if $key eq 'open' {
@@ -1885,8 +1809,9 @@
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register'),
+ :isdecl(1)
),
PAST::Op.new(
:pasttype('call'),
@@ -1905,8 +1830,9 @@
$class_def := PAST::Op.new(
:pasttype('bind'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register'),
+ :isdecl(1)
),
PAST::Op.new(
:pasttype('call'),
@@ -1931,8 +1857,9 @@
:node($/),
:pasttype('bind'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register'),
+ :isdecl(1)
),
PAST::Op.new(
:pasttype('callmethod'),
@@ -2001,8 +1928,8 @@
:namespace('Perl6Object')
),
PAST::Var.new(
- :scope('lexical'),
- :name('$def')
+ :scope('register'),
+ :name('def')
),
PAST::Val.new(
:value('Grammar'),
@@ -2013,10 +1940,8 @@
);
# Attatch grammar declaration to the init code.
- unless defined( $?INIT ) {
- $?INIT := PAST::Block.new();
- }
- $?INIT.push( $?GRAMMAR );
+ our $?BLOCK;
+ $?BLOCK.loadinit().push( $?GRAMMAR );
# Clear namespace.
$?NS := '';
@@ -2042,8 +1967,8 @@
:namespace('Perl6Object')
),
PAST::Var.new(
- :scope('lexical'),
- :name('$def')
+ :scope('register'),
+ :name('def')
),
PAST::Val.new(
:value('Any'),
@@ -2060,8 +1985,8 @@
$past.pirflags('');
$past.blocktype('immediate');
$past[0].push(PAST::Var.new(
- :name('$def'),
- :scope('lexical'),
+ :name('def'),
+ :scope('register'),
:isdecl(1)
));
}
@@ -2072,15 +1997,13 @@
# we want to put under this block so they get the correct
# namespace. If it's an anonymous class, everything goes into
# this block.
- unless defined( $?INIT ) {
- $?INIT := PAST::Block.new();
- }
for @( $?CLASS ) {
if $_.isa(PAST::Block) || !$name {
$past[0].push( $_ );
}
else {
- $?INIT.push( $_ );
+ our $?BLOCK;
+ $?BLOCK.loadinit().push( $_ );
}
}
}
@@ -2093,7 +2016,6 @@
method role_def($/, $key) {
our $?ROLE;
our $?NS;
- our $?INIT;
my $name := ~$<name>;
if $key eq 'open' {
@@ -2102,8 +2024,9 @@
PAST::Op.new(
:pasttype('bind'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register'),
+ :isdecl(1)
),
PAST::Op.new(
:pasttype('call'),
@@ -2129,15 +2052,13 @@
# Attatch role declaration to the init code, skipping blocks since
# those are accessors.
- unless defined( $?INIT ) {
- $?INIT := PAST::Block.new();
- }
for @( $?ROLE ) {
if $_.isa(PAST::Block) {
$past.push( $_ );
}
else {
- $?INIT.push( $_ );
+ our $?BLOCK;
+ $?BLOCK.loadinit().push( $_ );
}
}
@@ -2298,8 +2219,8 @@
:pasttype('call'),
:name('!keyword_has'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new( :value($name) ),
build_type($/<scoped><fulltypename>)
@@ -2312,8 +2233,8 @@
:pasttype('call'),
:name('!keyword_has'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new( :value($name) )
)
@@ -3046,8 +2967,8 @@
:pasttype('call'),
:name('!ADD_TO_WHENCE'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
$lhs.name(),
$rhs
@@ -3255,13 +3176,11 @@
)
);
- # Put this code in $?INIT, so the type is created early enough, then this
- # node results in an empty statement node.
- our $?INIT;
- unless defined($?INIT) {
- $?INIT := PAST::Block.new();
- }
- $?INIT.push($past);
+ # Put this code in loadinit, so the type is created early enough,
+ # then this node results in an empty statement node.
+ our $?BLOCK;
+ $?BLOCK.loadinit().push($past);
+
make PAST::Stmts.new();
}
@@ -3749,8 +3668,8 @@
:pasttype('callmethod'),
:name('add_method'),
PAST::Var.new(
- :name('$def'),
- :scope('lexical')
+ :name('def'),
+ :scope('register')
),
PAST::Val.new( :value($method.name()) ),
$new_method
