steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2009-10-19 04:58:29 -05:00
parent 102af9badb
commit 2d5cdd19ec
7 changed files with 64 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/compiler/cfg/intrinsics/slots/slots.factor
View File

@ -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 ;

46
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
View File

@ -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

3
basis/compiler/tests/intrinsics.factor
View File

@ -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

15
basis/compiler/tree/propagation/info/info.factor
View File

@ -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 ;

10
basis/cpu/architecture/architecture.factor
View File

@ -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 -- ? )

4
basis/cpu/ppc/ppc.factor
View File

@ -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?>> ;

5
basis/cpu/x86/x86.factor
View File

@ -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 )