compiler: on PPC, ANDI, ORI and XORI instructions take an unsigned 16-bit immediate...

diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor
index 8a86c984fe1ae4aae7980043ddbcb8b0186d674c..e1088a80ef980c9cc1cd7598ecfe1b9c808413b5 100644 (file)
--- a/basis/compiler/cfg/intrinsics/slots/slots.factor
+++ b/basis/compiler/cfg/intrinsics/slots/slots.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: layouts namespaces kernel accessors sequences
-classes.algebra locals compiler.tree.propagation.info
-compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers
+USING: layouts namespaces kernel accessors sequences math
+classes.algebra locals combinators cpu.architecture
+compiler.tree.propagation.info compiler.cfg.stacks
+compiler.cfg.hats compiler.cfg.registers
 compiler.cfg.instructions compiler.cfg.utilities
 compiler.cfg.builder.blocks compiler.constants ;
 IN: compiler.cfg.intrinsics.slots
@@ -22,11 +23,17 @@ IN: compiler.cfg.intrinsics.slots
     [ [ second literal>> ] [ first value-tag ] bi ] bi*
     ^^slot-imm ;
 
+: immediate-slot-offset? ( value-info -- ? )
+    literal>> {
+        { [ dup fixnum? ] [ tag-fixnum immediate-arithmetic? ] }
+        [ drop f ]
+    } cond ;
+
 : emit-slot ( node -- )
     dup node-input-infos
     dup first value-tag [
         nip
-        dup second value-info-small-fixnum?
+        dup second immediate-slot-offset?
         [ (emit-slot-imm) ] [ (emit-slot) ] if
         ds-push
     ] [ drop emit-primitive ] if ;
@@ -61,7 +68,7 @@ IN: compiler.cfg.intrinsics.slots
     dup node-input-infos
     dup second value-tag [
         nip
-        dup third value-info-small-fixnum?
+        dup third immediate-slot-offset?
         [ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
     ] [ drop emit-primitive ] if ;
 

diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
index 3842942a3b33c522e2e5ee1febab5a8824e7e7a7..bc228cb3b45a96ff95f19f5f34837bbdab190539 100755 (executable)
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -13,11 +13,18 @@ compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.simplify ;
 IN: compiler.cfg.value-numbering.rewrite
 
-: vreg-small-constant? ( vreg -- ? )
+: vreg-immediate-arithmetic? ( vreg -- ? )
     vreg>expr {
         [ constant-expr? ]
         [ value>> fixnum? ]
-        [ value>> small-enough? ]
+        [ value>> immediate-arithmetic? ]
+    } 1&& ;
+
+: vreg-immediate-bitwise? ( vreg -- ? )
+    vreg>expr {
+        [ constant-expr? ]
+        [ value>> fixnum? ]
+        [ value>> immediate-bitwise? ]
     } 1&& ;
 
 ! Outputs f to mean no change
@@ -174,8 +181,8 @@ M: ##compare-imm-branch rewrite
 
 M: ##compare-branch rewrite
     {
-        { [ dup src1>> vreg-small-constant? ] [ t >compare-imm-branch ] }
-        { [ dup src2>> vreg-small-constant? ] [ f >compare-imm-branch ] }
+        { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-imm-branch ] }
+        { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-imm-branch ] }
         { [ dup self-compare? ] [ rewrite-self-compare-branch ] }
         [ drop f ]
     } cond ;
@@ -205,8 +212,8 @@ M: ##compare-branch rewrite
 
 M: ##compare rewrite
     {
-        { [ dup src1>> vreg-small-constant? ] [ t >compare-imm ] }
-        { [ dup src2>> vreg-small-constant? ] [ f >compare-imm ] }
+        { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-imm ] }
+        { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-imm ] }
         { [ dup self-compare? ] [ rewrite-self-compare ] }
         [ drop f ]
     } cond ;
@@ -264,6 +271,19 @@ M: ##neg rewrite
 M: ##not rewrite
     maybe-unary-constant-fold ;
 
+: arithmetic-op? ( op -- ? )
+    {
+        ##add
+        ##add-imm
+        ##sub
+        ##sub-imm
+        ##mul
+        ##mul-imm
+    } memq? ;
+
+: immediate? ( value op -- ? )
+    arithmetic-op? [ immediate-arithmetic? ] [ immediate-bitwise? ] if ;
+
 : reassociate ( insn op -- insn )
     [
         {
@@ -273,7 +293,7 @@ M: ##not rewrite
             [ ]
         } cleave constant-fold*
     ] dip
-    over small-enough? [ new-insn ] [ 2drop 2drop f ] if ; inline
+    2dup immediate? [ new-insn ] [ 2drop 2drop f ] if ; inline
 
 M: ##add-imm rewrite
     {
@@ -283,7 +303,7 @@ M: ##add-imm rewrite
     } cond ;
 
 : sub-imm>add-imm ( insn -- insn' )
-    [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup small-enough?
+    [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup immediate-arithmetic?
     [ \ ##add-imm new-insn ] [ 3drop f ] if ;
 
 M: ##sub-imm rewrite
@@ -358,16 +378,20 @@ M: ##sar-imm rewrite
         [ swap ] when vreg>constant
     ] dip new-insn ; inline
 
+: vreg-immediate? ( vreg op -- ? )
+    arithmetic-op?
+    [ vreg-immediate-arithmetic? ] [ vreg-immediate-bitwise? ] if ;
+
 : rewrite-arithmetic ( insn op -- ? )
     {
-        { [ over src2>> vreg-small-constant? ] [ f insn>imm-insn ] }
+        { [ over src2>> over vreg-immediate? ] [ f insn>imm-insn ] }
         [ 2drop f ]
     } cond ; inline
 
 : rewrite-arithmetic-commutative ( insn op -- ? )
     {
-        { [ over src2>> vreg-small-constant? ] [ f insn>imm-insn ] }
-        { [ over src1>> vreg-small-constant? ] [ t insn>imm-insn ] }
+        { [ over src2>> over vreg-immediate? ] [ f insn>imm-insn ] }
+        { [ over src1>> over vreg-immediate? ] [ t insn>imm-insn ] }
         [ 2drop f ]
     } cond ; inline
 

diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index 24114e0ccbb9e46f9017b34f2f93474d5f30983f..6431ba1d9cea74a1b001b97d80c40cf6b416614d 100644 (file)
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -87,14 +87,17 @@ IN: compiler.tests.intrinsics
 [ 4 ] [ 12 7 [ fixnum-bitand ] compile-call ] unit-test
 [ 4 ] [ 12 [ 7 fixnum-bitand ] compile-call ] unit-test
 [ 4 ] [ [ 12 7 fixnum-bitand ] compile-call ] unit-test
+[ -16 ] [ -1 [ -16 fixnum-bitand ] compile-call ] unit-test
 
 [ 15 ] [ 12 7 [ fixnum-bitor ] compile-call ] unit-test
 [ 15 ] [ 12 [ 7 fixnum-bitor ] compile-call ] unit-test
 [ 15 ] [ [ 12 7 fixnum-bitor ] compile-call ] unit-test
+[ -1 ] [ -1 [ -16 fixnum-bitor ] compile-call ] unit-test
 
 [ 11 ] [ 12 7 [ fixnum-bitxor ] compile-call ] unit-test
 [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-call ] unit-test
 [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-call ] unit-test
+[ -16 ] [ -1 [ -16 fixnum-bitxor ] compile-call ] unit-test
 
 [ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
 [ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test

diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index 53b2109bbb336834d3123dd7d0570ac94fc6c9bb..9030914e340a657faf0c46393ac0b8c32560b1c3 100644 (file)
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -340,18 +340,3 @@ SYMBOL: value-infos
         dup in-d>> last node-value-info
         literal>> first immutable-tuple-class?
     ] [ drop f ] if ;
-
-: value-info-small-fixnum? ( value-info -- ? )
-    literal>> {
-        { [ dup fixnum? ] [ tag-fixnum small-enough? ] }
-        [ drop f ]
-    } cond ;
-
-: value-info-small-tagged? ( value-info -- ? )
-    dup literal?>> [
-        literal>> {
-            { [ dup fixnum? ] [ tag-fixnum small-enough? ] }
-            { [ dup not ] [ drop t ] }
-            [ drop f ]
-        } cond
-    ] [ drop f ] if ;

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index d5b84b70020ba95639fa99c5c99ebd9dd60a26cb..2f0bdbdcbff517ba367aa26bfac61e15315690bf 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -440,9 +440,13 @@ M: reg-class param-reg param-regs nth ;
 
 M: stack-params param-reg drop ;
 
-! Is this integer small enough to appear in value template
-! slots?
-HOOK: small-enough? cpu ( n -- ? )
+! Is this integer small enough to be an immediate operand for
+! %add-imm, %sub-imm, and %mul-imm?
+HOOK: immediate-arithmetic? cpu ( n -- ? )
+
+! Is this integer small enough to be an immediate operand for
+! %and-imm, %or-imm, and %xor-imm?
+HOOK: immediate-bitwise? cpu ( n -- ? )
 
 ! Is this structure small enough to be returned in registers?
 HOOK: return-struct-in-registers? cpu ( c-type -- ? )

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 48eaf54f46b7ccae92c2521ab5e402139a5708eb..02e1d7cb9405a356ceb875ff6662d90e75fafba8 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -681,7 +681,9 @@ M: ppc %callback-value ( ctype -- )
     ! Unbox former top of data stack to return registers
     unbox-return ;
 
-M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
+M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
+
+M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
 
 M: ppc return-struct-in-registers? ( c-type -- ? )
     c-type return-in-registers?>> ;

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 60d47b78ffc138a8a9849ee512b62f1f01411c1a..5db2641907b4c8d235c8e22821c6c278ae4a7489 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1337,7 +1337,10 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
 
 M: x86 value-struct? drop t ;
 
-M: x86 small-enough? ( n -- ? )
+M: x86 immediate-arithmetic? ( n -- ? )
+    HEX: -80000000 HEX: 7fffffff between? ;
+
+M: x86 immediate-bitwise? ( n -- ? )
     HEX: -80000000 HEX: 7fffffff between? ;
 
 : next-stack@ ( n -- operand )