compiler.cfg: fuse ##load-integer/##load-reference into ##replace to form ##replace-imm

basis/compiler/cfg/instructions/instructions.factor

@@ -51,6 +51,9 @@ INSN: ##replace
 use: src/tagged-rep
 literal: loc ;
 
+INSN: ##replace-imm
+literal: src loc ;
+
 INSN: ##inc-d
 literal: n ;
 

basis/compiler/cfg/stacks/uninitialized/uninitialized.factor

@@ -33,14 +33,19 @@ M: ##inc-r visit-insn n>> rs-loc handle-inc ;
 
 ERROR: uninitialized-peek insn ;
 
-M: ##peek visit-insn
+: visit-peek ( ##peek -- )
     dup loc>> [ n>> ] [ class get ] bi ?nth 0 =
-    [ uninitialized-peek ] [ drop ] if ;
+    [ uninitialized-peek ] [ drop ] if ; inline
 
-M: ##replace visit-insn
+M: ##peek visit-insn visit-peek ;
+
+: visit-replace ( ##replace -- )
     loc>> [ n>> ] [ class get ] bi
     2dup length < [ [ 1 ] 2dip set-nth ] [ 2drop ] if ;
 
+M: ##replace visit-insn visit-replace ;
+M: ##replace-imm visit-insn visit-replace ;
+
 M: insn visit-insn drop ;
 
 : prepare ( pair -- )

basis/compiler/cfg/value-numbering/comparisons/comparisons.factor

@@ -17,13 +17,11 @@ IN: compiler.cfg.value-numbering.comparisons
 ! 3) Folding comparisons where both inputs are congruent
 ! 4) Converting compare instructions into compare-imm instructions
 
-UNION: literal-insn ##load-integer ##load-reference ;
-
 : fold-compare-imm? ( insn -- ? )
     src1>> vreg>insn literal-insn? ;
 
 : evaluate-compare-imm ( insn -- ? )
-    [ src1>> vreg>comparand ] [ src2>> ] [ cc>> ] tri
+    [ src1>> vreg>literal ] [ src2>> ] [ cc>> ] tri
     {
         { cc= [ eq? ] }
         { cc/= [ eq? not ] }
@@ -107,7 +105,7 @@ M: ##compare-integer-imm-branch rewrite
 
 : >compare-imm-branch ( insn swap? -- insn' )
     (>compare-imm-branch)
-    [ vreg>comparand ] dip
+    [ vreg>literal ] dip
     \ ##compare-imm-branch new-insn ; inline
 
 : >compare-integer-imm-branch ( insn swap? -- insn' )
@@ -143,7 +141,7 @@ M: ##compare-integer-branch rewrite
 
 : >compare-imm ( insn swap? -- insn' )
     (>compare-imm)
-    [ vreg>comparand ] dip
+    [ vreg>literal ] dip
     next-vreg \ ##compare-imm new-insn ; inline
 
 : >compare-integer-imm ( insn swap? -- insn' )

basis/compiler/cfg/value-numbering/misc/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/compiler/cfg/value-numbering/misc/misc.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors compiler.cfg.instructions
+compiler.cfg.value-numbering.graph
+compiler.cfg.value-numbering.rewrite cpu.architecture kernel ;
+IN: compiler.cfg.value-numbering.misc
+
+M: ##replace rewrite
+    object-immediates? [
+        [ loc>> ] [ src>> vreg>insn ] bi dup literal-insn?
+        [ insn>literal swap \ ##replace-imm new-insn ]
+        [ 2drop f ] if
+    ] [ drop f ] if ;

basis/compiler/cfg/value-numbering/rewrite/rewrite.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators combinators.short-circuit kernel layouts
+USING: accessors combinators combinators.short-circuit kernel
-cpu.architecture
+layouts math cpu.architecture
 compiler.cfg.instructions
 compiler.cfg.value-numbering.graph ;
 IN: compiler.cfg.value-numbering.rewrite
@@ -30,13 +30,15 @@ M: ##load-integer insn>integer val>> ;
         [ val>> immediate-bitwise? ]
     } 1&& ;
 
-GENERIC: insn>comparand ( expr -- n )
+UNION: literal-insn ##load-integer ##load-reference ;
 
-M: ##load-integer insn>comparand val>> tag-fixnum ;
+GENERIC: insn>literal ( insn -- n )
 
-M: ##load-reference insn>comparand obj>> ;
+M: ##load-integer insn>literal val>> >fixnum ;
 
-: vreg>comparand ( vreg -- n ) vreg>insn insn>comparand ; inline
+M: ##load-reference insn>literal obj>> ;
+
+: vreg>literal ( vreg -- n ) vreg>insn insn>literal ; inline
 
 : vreg-immediate-comparand? ( vreg -- ? )
     vreg>insn {

basis/compiler/cfg/value-numbering/value-numbering.factor

@@ -15,6 +15,7 @@ compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.math
 compiler.cfg.value-numbering.rewrite
 compiler.cfg.value-numbering.slots
+compiler.cfg.value-numbering.misc
 compiler.cfg.value-numbering.expressions ;
 IN: compiler.cfg.value-numbering
 

basis/compiler/codegen/codegen.factor

@@ -81,6 +81,7 @@ CODEGEN: ##load-double %load-double
 CODEGEN: ##load-vector %load-vector
 CODEGEN: ##peek %peek
 CODEGEN: ##replace %replace
+CODEGEN: ##replace-imm %replace-imm
 CODEGEN: ##inc-d %inc-d
 CODEGEN: ##inc-r %inc-r
 CODEGEN: ##call %call
@@ -193,7 +194,7 @@ CODEGEN: ##write-barrier-imm %write-barrier-imm
 CODEGEN: ##compare %compare
 CODEGEN: ##compare-imm %compare-imm
 CODEGEN: ##compare-integer %compare
-CODEGEN: ##compare-integer-imm %compare-imm
+CODEGEN: ##compare-integer-imm %compare-integer-imm
 CODEGEN: ##compare-float-ordered %compare-float-ordered
 CODEGEN: ##compare-float-unordered %compare-float-unordered
 CODEGEN: ##save-context %save-context
@@ -227,7 +228,7 @@ SYNTAX: CONDITIONAL:
 CONDITIONAL: ##compare-branch %compare-branch
 CONDITIONAL: ##compare-imm-branch %compare-imm-branch
 CONDITIONAL: ##compare-integer-branch %compare-branch
-CONDITIONAL: ##compare-integer-imm-branch %compare-imm-branch
+CONDITIONAL: ##compare-integer-imm-branch %compare-integer-imm-branch
 CONDITIONAL: ##compare-float-ordered-branch %compare-float-ordered-branch
 CONDITIONAL: ##compare-float-unordered-branch %compare-float-unordered-branch
 CONDITIONAL: ##test-vector-branch %test-vector-branch

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -221,12 +221,14 @@ generic-comparison-ops [
 ] "outputs" set-word-prop
 
 \ both-fixnums? [
-    [ class>> ] bi@ {
+    node-input-infos first2 [ class>> ] bi@ {
-        { [ 2dup [ fixnum classes-intersect? not ] either? ] [ f <literal-info> ] }
+        { [ 2dup [ fixnum classes-intersect? not ] either? ] [ [ 2drop f ] ] }
-        { [ 2dup [ fixnum class<= ] both? ] [ t <literal-info> ] }
+        { [ 2dup [ fixnum class<= ] both? ] [ [ 2drop t ] ] }
-        [ object-info ]
+        { [ dup fixnum class<= ] [ [ drop fixnum? ] ] }
+        { [ over fixnum class<= ] [ [ nip fixnum? ] ] }
+        [ f ]
     } cond 2nip
-] "outputs" set-word-prop
+] "custom-inlining" set-word-prop
 
 {
     { >fixnum fixnum }

basis/cpu/architecture/architecture.factor

@@ -229,6 +229,7 @@ HOOK: %load-vector cpu ( reg val rep -- )
 
 HOOK: %peek cpu ( vreg loc -- )
 HOOK: %replace cpu ( vreg loc -- )
+HOOK: %replace-imm cpu ( src loc -- )
 HOOK: %inc-d cpu ( n -- )
 HOOK: %inc-r cpu ( n -- )
 
@@ -472,11 +473,13 @@ HOOK: %epilogue cpu ( n -- )
 
 HOOK: %compare cpu ( dst temp cc src1 src2 -- )
 HOOK: %compare-imm cpu ( dst temp cc src1 src2 -- )
+HOOK: %compare-integer-imm cpu ( dst temp cc src1 src2 -- )
 HOOK: %compare-float-ordered cpu ( dst temp cc src1 src2 -- )
 HOOK: %compare-float-unordered cpu ( dst temp cc src1 src2 -- )
 
 HOOK: %compare-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
+HOOK: %compare-integer-imm-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-float-ordered-branch cpu ( label cc src1 src2 -- )
 HOOK: %compare-float-unordered-branch cpu ( label cc src1 src2 -- )
 

basis/cpu/x86/32/32.factor

@@ -24,11 +24,18 @@ M: x86.32 stack-reg ESP ;
 M: x86.32 frame-reg EBP ;
 M: x86.32 temp-reg ECX ;
 
-M: x86.32 immediate-comparand? ( n -- ? )
-    [ call-next-method ] [ word? ] bi or ;
-
 M: x86.32 object-immediates? ( -- ? ) t ;
 
+M: x86.32 immediate-comparand? ( obj -- ? ) drop t ;
+
+M: x86.32 %replace-imm ( src loc -- )
+    loc>operand swap
+    {
+        { [ dup not ] [ drop \ f type-number MOV ] }
+        { [ dup fixnum? ] [ tag-fixnum MOV ] }
+        [ [ HEX: ffffffff MOV ] dip rc-absolute rel-literal ]
+    } cond ;
+
 M: x86.32 %load-double ( dst val -- )
     [ 0 [] MOVSD ] dip rc-absolute rel-float ;
 

basis/cpu/x86/x86.factor

@@ -531,12 +531,18 @@ M:: x86 %compare ( dst src1 src2 cc temp -- )
 : (%compare-tagged) ( src1 src2 -- )
     [ HEX: ffffffff CMP ] dip rc-absolute rel-literal ;
 
+: (%compare-integer-imm) ( src1 src2 cc -- )
+    3dup use-test? [ 2drop dup TEST ] [ drop CMP ] if ;
+
+M:: x86 %compare-integer-imm ( dst src1 src2 cc temp -- )
+    src1 src2 cc (%compare-integer-imm)
+    dst cc temp %boolean ;
+
 : (%compare-imm) ( src1 src2 cc -- )
     {
-        { [ 3dup use-test? ] [ 2drop dup TEST ] }
+        { [ over fixnum? ] [ [ tag-fixnum ] dip (%compare-integer-imm) ] }
-        { [ over integer? ] [ drop CMP ] }
-        { [ over word? ] [ drop (%compare-tagged) ] }
         { [ over not ] [ 2drop \ f type-number CMP ] }
+        [ drop (%compare-tagged) ]
     } cond ;
 
 M:: x86 %compare-imm ( dst src1 src2 cc temp -- )
@@ -557,6 +563,10 @@ M:: x86 %compare-branch ( label src1 src2 cc -- )
     src1 src2 CMP
     label cc %branch ;
 
+M:: x86 %compare-integer-imm-branch ( label src1 src2 cc -- )
+    src1 src2 cc (%compare-integer-imm)
+    label cc %branch ;
+
 M:: x86 %compare-imm-branch ( label src1 src2 cc -- )
     src1 src2 cc (%compare-imm)
     label cc %branch ;