Author: pmichaud
Date: Thu Dec 18 06:24:58 2008
New Revision: 34065
Modified:
branches/main/languages/perl6/perl6.pir
branches/main/languages/perl6/src/builtins/guts.pir
branches/main/languages/perl6/src/parser/actions.pm
Log:
[rakudo]: Refactor MAIN and startup handling.
Still reports "dubious" on a few spectests -- investigating this now.
Modified: branches/main/languages/perl6/perl6.pir
==============================================================================
--- branches/main/languages/perl6/perl6.pir (original)
+++ branches/main/languages/perl6/perl6.pir Thu Dec 18 06:24:58 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: branches/main/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/main/languages/perl6/src/builtins/guts.pir (original)
+++ branches/main/languages/perl6/src/builtins/guts.pir Thu Dec 18 06:24:58 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: branches/main/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/main/languages/perl6/src/parser/actions.pm (original)
+++ branches/main/languages/perl6/src/parser/actions.pm Thu Dec 18 06:24:58 2008
@@ -7,16 +7,17 @@
my $past := $( $<statement_block> );
$past.blocktype('declaration');
declare_implicit_routine_vars($past);
+ $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"',
@@ -24,82 +25,33 @@
)
);
- # 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'),
+ :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"()',
+ '.tailcall $P0()'
)
)
)
);
- make $past;
+ make $main;
}
