factor: trim using lists

[factor.git] / extra / compiler / cfg / gvn / alien / alien.factor

diff --git a/extra/compiler/cfg/gvn/alien/alien.factor b/extra/compiler/cfg/gvn/alien/alien.factor
index 4f57e0f51040b2d319f6c0515a7671bcff68b155..51c644209222405322828d3eec710e82de0e12e6 100644 (file)
--- a/extra/compiler/cfg/gvn/alien/alien.factor
+++ b/extra/compiler/cfg/gvn/alien/alien.factor
@@ -1,16 +1,10 @@
-! Copyright (C) 2010 Slava Pestov.
+! Copyright (C) 2010 Slava Pestov, 2011 Alex Vondrak
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators combinators.short-circuit fry
-kernel make math sequences
-cpu.architecture
-compiler.cfg.hats
-compiler.cfg.utilities
-compiler.cfg.registers
-compiler.cfg.instructions
-compiler.cfg.gvn.math
-compiler.cfg.gvn.graph
-compiler.cfg.gvn.avail
-compiler.cfg.gvn.rewrite ;
+USING: accessors combinators combinators.short-circuit
+compiler.cfg.gvn.avail compiler.cfg.gvn.graph
+compiler.cfg.gvn.math compiler.cfg.gvn.rewrite compiler.cfg.hats
+compiler.cfg.instructions compiler.cfg.utilities
+cpu.architecture kernel make math namespaces sequences ;
 IN: compiler.cfg.gvn.alien
 
 M: ##box-displaced-alien rewrite
@@ -27,12 +21,14 @@ M: ##box-displaced-alien rewrite
 : rewrite-unbox-alien ( insn box-insn -- insn )
     [ dst>> ] [ src>> ] bi* <copy> ;
 
+! XXX  next-vreg makes vregs>vns change on every iteration
+! (hidden in ^^unbox-c-ptr)
 : rewrite-unbox-displaced-alien ( insn box-insn -- insns )
     [
         [ dst>> ]
         [ [ base>> ] [ base-class>> ] [ displacement>> ] tri ] bi*
         [ ^^unbox-c-ptr ] dip
-        ##add
+        ##add,
     ] { } make ;
 
 : rewrite-unbox-any-c-ptr ( insn -- insn/f )
@@ -43,7 +39,12 @@ M: ##box-displaced-alien rewrite
             [ rewrite-unbox-alien ]
         }
         {
-            [ dup [ ##box-displaced-alien? ] with-available-uses? ]
+            ! [ dup [ ##box-displaced-alien? ] with-available-uses? ]
+            [
+                final-iteration? get [
+                    dup [ ##box-displaced-alien? ] with-available-uses?
+                ] [ f ] if
+            ]
             [ rewrite-unbox-displaced-alien ]
         }
         [ 2drop f ]
@@ -92,8 +93,8 @@ M: ##store-memory-imm alien-insn-value src>> ;
 
 GENERIC: new-alien-insn ( value base displacement scale offset rep c-type insn -- insn )
 
-M: ##load-memory-imm new-alien-insn drop \ ##load-memory new-insn ;
-M: ##store-memory-imm new-alien-insn drop \ ##store-memory new-insn ;
+M: ##load-memory-imm new-alien-insn drop ##load-memory new-insn ;
+M: ##store-memory-imm new-alien-insn drop ##store-memory new-insn ;
 
 : fuse-displacement ( insn -- insn' )
     {