fixing bugs

diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor
index bfd9f671a81623c938faa2948e1afee08f5d9358..86f1bfa026cb47d5d23f4883f5238cfe430e308d 100644 (file)
--- a/library/compiler/intrinsics.factor
+++ b/library/compiler/intrinsics.factor
@@ -184,6 +184,8 @@ sequences words ;
 
 \ fixnum* intrinsic
 
+: slow-fixnum* \ %fixnum* 0 binary-op-reg ;
+
 \ fixnum* [
     ! Turn multiplication by a power of two into a left shift.
     node-peek dup literal? [
@@ -193,10 +195,10 @@ sequences words ;
             log2 0 <vreg> %fixnum<< ,
             0 0 %replace-d ,
         ] [
-            drop binary-op-reg
+            drop slow-fixnum*
         ] ifte
     ] [
-        drop binary-op-reg
+        drop slow-fixnum*
     ] ifte
 ] "linearizer" set-word-prop
 

diff --git a/library/compiler/simplifier.factor b/library/compiler/simplifier.factor
deleted file mode 100644 (file)
index 17623e7..0000000
--- a/library/compiler/simplifier.factor
+++ /dev/null
@@ -1,230 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: generic inference kernel lists math namespaces
-prettyprint strings words ;
-
-! A peephole optimizer operating on the linear IR.
-
-! The linear IR being simplified is stored in this variable.
-SYMBOL: simplifying
-
-GENERIC: simplify-node ( linear vop -- linear ? )
-
-! The next node following this node in terms of control flow, or
-! f if this is a conditional.
-GENERIC: next-logical ( linear vop -- linear )
-
-! No delegation.
-M: tuple simplify-node drop f ;
-
-: simplify-1 ( list -- list ? )
-    #! Return a new linear IR.
-     dup [
-         dup car simplify-node
-         [ uncons simplify-1 drop cons t ]
-         [ uncons simplify-1 >r cons r> ] ifte
-     ] [
-         f
-     ] ifte ;
-
-: simplify ( linear -- linear )
-    #! Keep simplifying until simplify-1 returns f.
-    [
-        dup simplifying set  simplify-1
-    ] with-scope  [ simplify ] when ;
-
-: label-called? ( label -- ? )
-    simplifying get [ calls-label? ] some-with? ;
-
-M: %label simplify-node ( linear vop -- linear ? )
-    vop-label label-called? [ f ] [ cdr t ] ifte ;
-
-: next-physical? ( linear class -- vop ? )
-    #! If the following op has given class, remove it and
-    #! return it.
-    over cdr dup [
-        car class = [ cdr car t ] [ f ] ifte
-    ] [
-        3drop f f
-    ] ifte ;
-
-M: %inc-d simplify-node ( linear vop -- linear ? )
-    #! %inc-d cancels a following %inc-d.
-    >r dup \ %inc-d next-physical? [
-        vop-literal r> vop-literal + dup 0 = [
-            drop cdr cdr f
-        ] [
-            %inc-d >r cdr cdr r> swons t
-        ] ifte
-    ] [
-        r> 2drop f
-    ] ifte ;
-
-: dead-load? ( linear vop -- ? )
-    #! Is the %replace-d followed by a %peek-d of the same
-    #! stack slot and vreg?
-    swap cdr car dup %peek-d? [
-        over vop-source over vop-dest = >r
-        swap vop-literal swap vop-literal = r> and
-    ] [
-        2drop f
-    ] ifte ;
-
-: dead-store? ( linear n -- ? )
-    #! Is the %replace-d followed by a %dec-d, so the stored
-    #! value is lost?
-    swap \ %inc-d next-physical? [
-        vop-literal + 0 <
-    ] [
-        2drop f
-    ] ifte ;
-
-M: %replace-d simplify-node ( linear vop -- linear ? )
-    2dup dead-load? [
-        drop uncons cdr cons t
-    ] [
-        2dup vop-literal dead-store? [
-            drop cdr t
-        ] [
-            drop f
-        ] ifte
-    ] ifte ;
-
-M: %immediate-d simplify-node ( linear vop -- linear ? )
-    over 0 dead-store? [ drop cdr t ] [ drop f ] ifte ;
-
-: pop? ( vop -- ? ) dup %inc-d? swap vop-literal -1 = and ;
-
-: can-fast-branch? ( linear -- ? )
-    unswons class fast-branch [
-        unswons pop? [ car %jump-t? ] [ drop f ] ifte
-    ] [
-        drop f
-    ] ifte ;
-
-: fast-branch-params ( linear -- src dest label linear )
-    uncons >r dup vop-source swap vop-dest r> cdr
-    uncons >r vop-label r> ;
-
-M: %fixnum<= simplify-node ( linear vop -- linear ? )
-    drop dup can-fast-branch? [
-        fast-branch-params >r
-        %jump-fixnum<= >r -1 %inc-d r>
-        r> cons cons t
-    ] [
-        f
-    ] ifte ;
-
-M: %eq? simplify-node ( linear vop -- linear ? )
-    drop dup can-fast-branch? [
-        fast-branch-params >r
-        %jump-eq? >r -1 %inc-d r>
-        r> cons cons t
-    ] [
-        f
-    ] ifte ;
-
-: find-label ( label -- rest )
-    simplifying get [
-        dup %label? [ vop-label = ] [ 2drop f ] ifte
-    ] some-with? ;
-
-M: %label next-logical ( linear vop -- linear )
-    drop cdr dup car next-logical ;
-
-M: %jump-label next-logical ( linear vop -- linear )
-    nip vop-label find-label cdr ;
-
-M: %target-label next-logical ( linear vop -- linear )
-    nip vop-label find-label cdr ;
-
-M: object next-logical ( linear vop -- linear )
-    drop ;
-
-: next-logical? ( op linear -- ? )
-    dup car next-logical dup [ car class = ] [ 2drop f ] ifte ;
-
-: reduce ( linear op new -- linear ? )
-    >r over cdr next-logical? [
-        dup car vop-label
-        r> execute swap cdr cons t
-    ] [
-        r> drop f
-    ] ifte ; inline
-
-M: %call simplify-node ( linear vop -- ? )
-    #! Tail call optimization.
-    drop \ %return \ %jump reduce ;
-
-M: %call-label simplify-node ( linear vop -- ? )
-    #! Tail call optimization.
-    drop \ %return \ %jump-label reduce ;
-
-: double-jump ( linear op2 op1 -- linear ? )
-    #! A jump to a jump is just a jump. If the next logical node
-    #! is a jump of type op1, replace the jump at the car of the
-    #! list with a jump of type op2.
-    pick next-logical? [
-        >r dup dup car next-logical car vop-label
-        r> execute swap cdr cons t
-    ] [
-        drop f
-    ] ifte ; inline
-
-: useless-jump ( linear -- linear ? )
-    #! A jump to a label immediately following is not needed.
-    dup car cdr find-label over cdr eq? [ cdr t ] [ f ] ifte ;
-
-: (dead-code) ( linear -- linear ? )
-    #! Remove all nodes until the next #label.
-    dup [
-        dup car %label? [
-            f
-        ] [
-            cdr (dead-code) t or
-        ] ifte
-    ] [
-        f
-    ] ifte ;
-
-: dead-code ( linear -- linear ? )
-    uncons (dead-code) >r cons r> ;
-
-M: %jump-label simplify-node ( linear vop -- linear ? )
-    drop
-    \ %return dup double-jump [
-        t
-    ] [
-        \ %jump-label dup double-jump [
-            t
-        ] [
-            \ %jump dup double-jump
-            ! [
-            !     t
-            ! ] [
-            !     useless-jump [
-            !         t
-            !     ] [
-            !         dead-code
-            !     ] ifte
-            ! ] ifte
-        ] ifte
-    ] ifte ;
-! 
-! #jump-label [
-!     [ #return #return double-jump ]
-!     [ #jump-label #jump-label double-jump ]
-!     [ #jump #jump double-jump ]
-!     [ useless-jump ]
-!     [ dead-code ]
-! ] "simplifiers" set-word-prop
-! 
-! #target-label [
-!     [ #target-label #jump-label double-jump ]
-! !   [ #target #jump double-jump ]
-! ] "simplifiers" set-word-prop
-! 
-! #jump [ [ dead-code ] ] "simplifiers" set-word-prop
-! #return [ [ dead-code ] ] "simplifiers" set-word-prop
-! #end-dispatch [ [ dead-code ] ] "simplifiers" set-word-prop