From 2d5cdd19ec5d5ee17a521afd0723cf749d814aee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 04:58:29 -0500 Subject: [PATCH] compiler: on PPC, ANDI, ORI and XORI instructions take an unsigned 16-bit immediate, unlike ADDI, SUBI and MULLI which take a signed 16-bit immediate. The code generator was not aware of this, and so for example '[ >fixnum -16 bitand ]' would generate incorrect code. Split up small-enough? hook into immediate-arithmetic? and immediate-bitwise? and update value numbering to be aware of this. Fixes classes.struct bitfields test failure --- .../cfg/intrinsics/slots/slots.factor | 17 +++++-- .../value-numbering/rewrite/rewrite.factor | 46 ++++++++++++++----- basis/compiler/tests/intrinsics.factor | 3 ++ .../tree/propagation/info/info.factor | 15 ------ basis/cpu/architecture/architecture.factor | 10 ++-- basis/cpu/ppc/ppc.factor | 4 +- basis/cpu/x86/x86.factor | 5 +- 7 files changed, 64 insertions(+), 36 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index 8a86c984fe..e1088a80ef 100644 --- 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 3842942a3b..bc228cb3b4 100755 --- 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 24114e0ccb..6431ba1d9c 100644 --- 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 53b2109bbb..9030914e34 100644 --- 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 d5b84b7002..2f0bdbdcbf 100644 --- 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 48eaf54f46..02e1d7cb94 100644 --- 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 60d47b78ff..5db2641907 100644 --- 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 )