Add support for --optimize=[off|1|2|3]. The default is level 2. 'off'…

… will not even enter the optimizer, so it skips CHECK time could-never-work analysis. Classify inlining and compile-time multi selection as level 2 for now; block inlining gets level 3 initially but should drop to two in the not too distant future; it needs some more aggressive testing. We build the setting with --optimize=3.
rakudo · Oct 5, 2011 · fb111db · fb111db
1 parent a47b0cd
commit fb111db
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 10 deletions.
diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp
@@ -19,7 +19,7 @@ class Perl6::Compiler is HLL::Compiler {
     }
 
     method optimize($past, *%adverbs) {
-        %adverbs<optimize> eq '0' ??
+        %adverbs<optimize> eq 'off' ??
             $past !!
             Perl6::Optimizer.new.optimize($past, |%adverbs)
     }

diff --git a/src/Perl6/Optimizer.pm b/src/Perl6/Optimizer.pm
@@ -31,6 +31,10 @@ class Perl6::Optimizer {
         %!deadly := nqp::hash();
         %!worrying := nqp::hash();
 
+        # Work out optimization level.
+        my $*LEVEL := pir::exists(%adverbs, 'optimize') ??
+            +%adverbs<optimize> !! 2;
+
         # We'll start walking over UNIT (we wouldn't find it by going
         # over OUTER since we don't walk loadinits).
         my $unit := $past<UNIT>;
@@ -91,7 +95,9 @@ class Perl6::Optimizer {
             # do something in that case. However, it's non-trivial as
             # the static lexpad entries will need twiddling with.
             if +@sigsyms == 0 {
-                return self.inline_immediate_block($block, $outer);
+                if $*LEVEL >= 3 {
+                    return self.inline_immediate_block($block, $outer);
+                }
             }
         }
 
@@ -140,9 +146,11 @@ class Perl6::Optimizer {
                         if @ct_result[0] == 1 {
                             my $chosen := @ct_result[1];
                             if $op.pasttype eq 'chain' { $!chain_depth := $!chain_depth - 1 }
-                            return pir::can($chosen, 'inline_info') && $chosen.inline_info ne ''
-                                ?? self.inline_call($op, $chosen)
-                                !! self.call_ct_chosen_multi($op, $obj, $chosen);
+                            if $*LEVEL >= 2 {
+                                return pir::can($chosen, 'inline_info') && $chosen.inline_info ne ''
+                                    ?? self.inline_call($op, $chosen)
+                                    !! self.call_ct_chosen_multi($op, $obj, $chosen);
+                            }
                         }
                         elsif @ct_result[0] == -1 {
                             self.report_innevitable_dispatch_failure($op, @types, @flags, $obj);
@@ -151,7 +159,9 @@ class Perl6::Optimizer {
 
                     # Otherwise, inline the proto.
                     if $op.pasttype eq 'chain' { $!chain_depth := $!chain_depth - 1 }
-                    return self.inline_proto($op, $obj);
+                    if $*LEVEL >= 2 {
+                        return self.inline_proto($op, $obj);
+                    }
                 }
                 elsif pir::can($obj, 'signature') {
                     # It's an only; we can at least know the return type.
@@ -166,9 +176,11 @@ class Perl6::Optimizer {
                         if $ct_result == 1 {
                             if $op.pasttype eq 'chain' { $!chain_depth := $!chain_depth - 1 }
                             #say("# trial bind worked!");
-                            return pir::can($obj, 'inline_info') && $obj.inline_info ne ''
-                                ?? self.inline_call($op, $obj)
-                                !! $op;
+                            if $*LEVEL >= 2 {
+                                return pir::can($obj, 'inline_info') && $obj.inline_info ne ''
+                                    ?? self.inline_call($op, $obj)
+                                    !! $op;
+                            }
                         }
                         elsif $ct_result == -1 {
                             self.report_innevitable_dispatch_failure($op, @types, @flags, $obj);

diff --git a/tools/build/Makefile.in b/tools/build/Makefile.in
@@ -349,7 +349,7 @@ $(PERL6_M_PBC): $(NQP_EXE) $(DYNEXT_DYNPMC) $(DYNEXT_DYNOPS) $(METAMODEL_SOURCES
 
 $(SETTING): $(PERL6_M_PBC) $(PERL6_EXE) $(CORE_SOURCES)
 	$(PERL) $(GEN_CAT) $(CORE_SOURCES) > src/gen/CORE.setting
-	./$(PERL6_EXE) --setting=NULL --target=pir $(STAGESTATS) --output=$(SETTING_PIR) src/gen/CORE.setting
+	./$(PERL6_EXE) --setting=NULL --optimize=3 --target=pir $(STAGESTATS) --output=$(SETTING_PIR) src/gen/CORE.setting
 	$(PARROT) $(PARROT_ARGS) -o $(SETTING) $(SETTING_PIR)
 
 $(S_SETTING): $(PERL6_M_PBC) $(PERL6_EXE) $(SETTING)