Working on optimizer

TODO.FACTOR.txt

@@ -54,7 +54,7 @@
 - code gc
 - compiled gc check slows things down
 - fix branch folding
-- remove branch splitting
+- new x86 write barrier
 
 + misc:
 

library/bootstrap/boot-stage1.factor

@@ -133,7 +133,6 @@ vectors words ;
         "/library/compiler/xt.factor"
         "/library/compiler/stack.factor"
         "/library/compiler/intrinsics.factor"
-        "/library/compiler/basic-blocks.factor"
         "/library/compiler/generator.factor"
         "/library/compiler/compiler.factor"
 

library/compiler/compiler.factor

@@ -7,7 +7,7 @@ sequences words ;
 : (compile) ( word -- )
     #! Should be called inside the with-compiler scope.
     dup word-def dataflow optimize linearize
-    [ split-blocks simplify generate ] hash-each ;
+    [ generate ] hash-each ;
 
 : inform-compile ( word -- ) "Compiling " write . flush ;
 
@@ -47,8 +47,6 @@ sequences words ;
     ] if ;
 
 \ dataflow profile
-\ optimize profile
 \ linearize profile
-\ split-blocks profile
-\ simplify profile
 \ generate profile
+\ optimize profile

library/compiler/generator.factor

@@ -12,14 +12,13 @@ GENERIC: generate-node ( vop -- )
     #! The %prologue node contains the maximum stack reserve of
     #! all VOPs. The precise meaning of stack reserve is
     #! platform-specific.
-    0 [ 0 [ stack-reserve max ] reduce max ] reduce
-    \ stack-reserve set ;
+    0 [ stack-reserve max ] reduce \ stack-reserve set ;
 
 : generate-code ( word linear -- length )
     compiled-offset >r
     compile-aligned
     swap save-xt
-    [ [ dup [ generate-node ] with-vop ] each ] each
+    [ dup [ generate-node ] with-vop ] each
     compile-aligned
     compiled-offset r> - ;
 

library/compiler/linearizer.factor

@@ -80,15 +80,15 @@ M: #label linearize* ( node -- next )
     dup node-successor #if?
     [ node-param "if-intrinsic" word-prop ] [ drop f ] if ;
 
-: linearize-if ( node label -- next )
+: linearize-if ( node label -- )
     <label> dup >r >r >r node-children first2 linearize-child
     r> r> %jump-label , %label , linearize-child r> %label ,
     iterate-next ;
 
-M: #call linearize* ( node -- )
+M: #call linearize* ( node -- next )
     dup if-intrinsic [
         >r <label> 2dup r> call
-        >r node-successor r> linearize-if
+        >r node-successor r> linearize-if node-successor
     ] [
         dup intrinsic
         [ call iterate-next ] [ node-param linearize-call ] if*

library/inference/dataflow.factor

@@ -63,7 +63,7 @@ C: #label make-node ;
 
 TUPLE: #entry ;
 C: #entry make-node ;
-: #entry ( -- node ) f param-node <#entry> ;
+: #entry ( -- node ) meta-d get clone in-node <#entry> ;
 
 TUPLE: #call ;
 C: #call make-node ;

library/inference/kill-literals.factor

@@ -75,8 +75,8 @@ M: #killable live-values* ( node -- seq ) drop { } ;
 
 ! #label
 M: #label live-values* ( node -- seq )
-    dup node-child node-in-d
-    >r collect-recursion r> add purge-invariants ;
+    dup node-child [ node-in-d ] 2apply 2array
+    purge-invariants ;
 
 ! branching
 UNION: #branch #if #dispatch ;

library/inference/known-words.factor

@@ -35,8 +35,8 @@ sequences strings vectors words prettyprint ;
     dup "infer-effect" word-prop consume/produce
     [ [ t ] [ f ] if ] infer-quot ;
 
-{ fixnum<= fixnum< fixnum>= fixnum> eq? }
-[ dup [ manual-branch ] curry "infer" set-word-prop ] each
+! { fixnum<= fixnum< fixnum>= fixnum> eq? }
+! [ dup [ manual-branch ] curry "infer" set-word-prop ] each
 
 ! Primitive combinators
 \ call [ [ general-list ] [ ] ] "infer-effect" set-word-prop

library/inference/optimizer.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer
-USING: compiler-backend generic hashtables inference kernel
+USING: compiler-backend generic hashtables inference io kernel
 lists math namespaces sequences vectors ;
 
 GENERIC: optimize-node* ( node -- node/t )
@@ -25,11 +25,12 @@ DEFER: optimize-node
         over set-node-successor r> r> r> or or
     ] [ r> ] if ;
 
-: optimize-1 ( dataflow -- dataflow ? )
-    dup kill-values dup infer-classes optimize-node ;
+: (optimize) ( dataflow n -- dataflow n ? )
+    >r dup kill-values dup infer-classes optimize-node r> swap
+    [ 1+ (optimize) ] when ;
 
 : optimize ( dataflow -- dataflow )
-    [ optimize-1 ] with-scope [ optimize ] when ;
+    1 (optimize) [ "! Optimizer passes: " % # ] "" make print ;
 
 : prune-if ( node quot -- successor/t )
     over >r call [ r> node-successor ] [ r> drop t ] if ;

library/inference/words.factor

@@ -97,7 +97,7 @@ M: #call-label collect-recursion* ( label node -- )
     dup f inline-block over recursive-label? [
         meta-d get >r
         drop join-values f inline-block apply-infer
-        r> over node-child set-node-in-d node,
+        r> over set-node-in-d node,
     ] [
         apply-infer node-child node-successor splice-node drop
     ] if ;