develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r34065 - in branches/main/languages/perl6: . src/builtins src/parser

From:
pmichaud
Date:
December 18, 2008 06:25
Subject:
[svn:parrot] r34065 - in branches/main/languages/perl6: . src/builtins src/parser
Message ID:
20081218142459.CC3C1CBA12@x12.develooper.com
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;
 }
 
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About