compiler: new inline intrinsic for <displaced-alien> where the inputs have known types; value numbering now eliminates unnecessary allocation of displaced aliens if the result is immediately unboxed again

db4
Slava Pestov 2009-08-27 00:06:19 -05:00
parent 64990eb23d
commit f662e6403a
16 changed files with 239 additions and 22 deletions

View File

@ -21,6 +21,7 @@ M: ##slot temp-vregs temp>> 1array ;
M: ##set-slot temp-vregs temp>> 1array ;
M: ##string-nth temp-vregs temp>> 1array ;
M: ##set-string-nth-fast temp-vregs temp>> 1array ;
M: ##box-displaced-alien temp-vregs temp>> 1array ;
M: ##compare temp-vregs temp>> 1array ;
M: ##compare-imm temp-vregs temp>> 1array ;
M: ##compare-float temp-vregs temp>> 1array ;

View File

@ -51,6 +51,7 @@ IN: compiler.cfg.hats
: ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline
: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
: ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline
: ^^box-displaced-alien ( base displacement -- dst ) ^^r2 next-vreg ##box-displaced-alien ; inline
: ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline
: ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ;
: ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline

View File

@ -118,6 +118,7 @@ INSN: ##unbox-float < ##unary ;
INSN: ##unbox-any-c-ptr < ##unary/temp ;
INSN: ##box-float < ##unary/temp ;
INSN: ##box-alien < ##unary/temp ;
INSN: ##box-displaced-alien < ##binary temp ;
: ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
: ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;

View File

@ -1,11 +1,24 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences alien math classes.algebra fry
locals combinators cpu.architecture compiler.tree.propagation.info
compiler.cfg.hats compiler.cfg.stacks compiler.cfg.instructions
locals combinators combinators.short-circuit cpu.architecture
compiler.tree.propagation.info compiler.cfg.hats
compiler.cfg.stacks compiler.cfg.instructions
compiler.cfg.utilities compiler.cfg.builder.blocks ;
IN: compiler.cfg.intrinsics.alien
: emit-<displaced-alien>? ( node -- ? )
node-input-infos {
[ first class>> fixnum class<= ]
[ second class>> c-ptr class<= ]
} 1&& ;
: emit-<displaced-alien> ( node -- )
dup emit-<displaced-alien>?
[ drop 2inputs [ ^^untag-fixnum ] dip ^^box-displaced-alien ds-push ]
[ emit-primitive ]
if ;
: (prepare-alien-accessor-imm) ( class offset -- offset-vreg )
ds-drop [ ds-pop swap ^^unbox-c-ptr ] dip ^^add-imm ;

View File

@ -10,6 +10,8 @@ compiler.cfg.intrinsics.float
compiler.cfg.intrinsics.slots
compiler.cfg.intrinsics.misc
compiler.cfg.comparisons ;
QUALIFIED: alien
QUALIFIED: alien.accessors
QUALIFIED: kernel
QUALIFIED: arrays
QUALIFIED: byte-arrays
@ -20,7 +22,6 @@ QUALIFIED: classes.tuple.private
QUALIFIED: math.private
QUALIFIED: math.integers.private
QUALIFIED: math.libm
QUALIFIED: alien.accessors
IN: compiler.cfg.intrinsics
{
@ -54,6 +55,7 @@ IN: compiler.cfg.intrinsics
byte-arrays:<byte-array>
byte-arrays:(byte-array)
kernel:<wrapper>
alien:<displaced-alien>
alien.accessors:alien-unsigned-1
alien.accessors:set-alien-unsigned-1
alien.accessors:alien-signed-1
@ -144,6 +146,7 @@ IN: compiler.cfg.intrinsics
{ \ byte-arrays:<byte-array> [ emit-<byte-array> ] }
{ \ byte-arrays:(byte-array) [ emit-(byte-array) ] }
{ \ kernel:<wrapper> [ emit-simple-allot ] }
{ \ alien:<displaced-alien> [ emit-<displaced-alien> ] }
{ \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
{ \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
{ \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }

View File

@ -140,6 +140,9 @@ M: ##string-nth rename-insn-temps
M: ##set-string-nth-fast rename-insn-temps
TEMP-QUOT change-temp drop ;
M: ##box-displaced-alien rename-insn-temps
TEMP-QUOT change-temp drop ;
M: ##compare rename-insn-temps
TEMP-QUOT change-temp drop ;

View File

@ -25,6 +25,7 @@ M: ##slot temp-vreg-reps drop { int-rep } ;
M: ##set-slot temp-vreg-reps drop { int-rep } ;
M: ##string-nth temp-vreg-reps drop { int-rep } ;
M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ;
M: ##box-displaced-alien temp-vreg-reps drop { int-rep } ;
M: ##compare temp-vreg-reps drop { int-rep } ;
M: ##compare-imm temp-vreg-reps drop { int-rep } ;
M: ##compare-float temp-vreg-reps drop { int-rep } ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit arrays
fry kernel layouts math namespaces sequences cpu.architecture
math.bitwise math.order classes vectors
math.bitwise math.order classes vectors locals make
compiler.cfg
compiler.cfg.registers
compiler.cfg.comparisons
@ -350,3 +350,24 @@ M: ##shl rewrite \ ##shl-imm rewrite-arithmetic ;
M: ##shr rewrite \ ##shr-imm rewrite-arithmetic ;
M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ;
: box-displaced-alien? ( expr -- ? )
op>> \ ##box-displaced-alien eq? ;
! ##box-displaced-alien f 1 2 3
! ##unbox-any-c-ptr 4 1
! =>
! ##box-displaced-alien f 1 2 3
! ##unbox-any-c-ptr 5 3
! ##add 4 5 2
:: rewrite-unbox-displaced-alien ( insn expr -- insns )
[
next-vreg :> temp
temp expr in2>> vn>vreg insn temp>> ##unbox-any-c-ptr
insn dst>> temp expr in1>> vn>vreg ##add
] { } make ;
M: ##unbox-any-c-ptr rewrite
dup src>> vreg>expr dup box-displaced-alien?
[ rewrite-unbox-displaced-alien ] [ 2drop f ] if ;

View File

@ -87,6 +87,12 @@ M: unary-expr simplify*
[ 2drop f ]
} cond ; inline
: simplify-box-displaced-alien ( expr -- vn/expr/f )
>binary-expr< {
{ [ over expr-zero? ] [ nip ] }
[ 2drop f ]
} cond ;
M: binary-expr simplify*
dup op>> {
{ \ ##add [ simplify-add ] }
@ -107,6 +113,7 @@ M: binary-expr simplify*
{ \ ##sar-imm [ simplify-shr ] }
{ \ ##shl [ simplify-shl ] }
{ \ ##shl-imm [ simplify-shl ] }
{ \ ##box-displaced-alien [ simplify-box-displaced-alien ] }
[ 2drop f ]
} case ;

View File

@ -870,6 +870,63 @@ cell 8 = [
] unit-test
] when
! Displaced alien optimizations
3 vreg-counter set-global
[
{
T{ ##peek f 0 D 0 }
T{ ##load-immediate f 2 16 }
T{ ##box-displaced-alien f 1 2 0 }
T{ ##unbox-any-c-ptr f 4 0 }
T{ ##add-imm f 3 4 16 }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-immediate f 2 16 }
T{ ##box-displaced-alien f 1 2 0 }
T{ ##unbox-any-c-ptr f 3 1 }
} value-numbering-step
] unit-test
4 vreg-counter set-global
[
{
T{ ##box-alien f 0 1 }
T{ ##load-immediate f 2 16 }
T{ ##box-displaced-alien f 3 2 0 }
T{ ##copy f 5 1 any-rep }
T{ ##add-imm f 4 5 16 }
}
] [
{
T{ ##box-alien f 0 1 }
T{ ##load-immediate f 2 16 }
T{ ##box-displaced-alien f 3 2 0 }
T{ ##unbox-any-c-ptr f 4 3 }
} value-numbering-step
] unit-test
3 vreg-counter set-global
[
{
T{ ##peek f 0 D 0 }
T{ ##load-immediate f 2 0 }
T{ ##copy f 3 0 any-rep }
T{ ##replace f 3 D 1 }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-immediate f 2 0 }
T{ ##box-displaced-alien f 3 2 0 }
T{ ##replace f 3 D 1 }
} value-numbering-step
] unit-test
! Branch folding
[
{
@ -1301,3 +1358,4 @@ V{
] unit-test
[ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test

View File

@ -1,8 +1,9 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs kernel accessors
sorting sets sequences
sorting sets sequences arrays
cpu.architecture
sequences.deep
compiler.cfg
compiler.cfg.rpo
compiler.cfg.instructions
@ -32,10 +33,13 @@ M: insn process-instruction
dup rewrite
[ process-instruction ] [ ] ?if ;
M: array process-instruction
[ process-instruction ] map ;
: value-numbering-step ( insns -- insns' )
init-value-graph
init-expressions
[ process-instruction ] map ;
[ process-instruction ] map flatten ;
: value-numbering ( cfg -- cfg' )
[ value-numbering-step ] local-optimization

View File

@ -177,10 +177,13 @@ M: ##float>integer generate-insn dst/src %float>integer ;
M: ##copy generate-insn [ dst/src ] [ rep>> ] bi %copy ;
M: ##unbox-float generate-insn dst/src %unbox-float ;
M: ##unbox-float generate-insn dst/src %unbox-float ;
M: ##unbox-any-c-ptr generate-insn dst/src/temp %unbox-any-c-ptr ;
M: ##box-float generate-insn dst/src/temp %box-float ;
M: ##box-alien generate-insn dst/src/temp %box-alien ;
M: ##box-float generate-insn dst/src/temp %box-float ;
M: ##box-alien generate-insn dst/src/temp %box-alien ;
M: ##box-displaced-alien generate-insn
[ dst/src1/src2 ] [ temp>> ] bi %box-displaced-alien ;
M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ;
M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;

View File

@ -463,6 +463,54 @@ cell 8 = [
] compile-call
] unit-test
[ ALIEN: 123 ] [
123 [ <alien> ] compile-call
] unit-test
[ ALIEN: 123 ] [
123 [ { fixnum } declare <alien> ] compile-call
] unit-test
[ ALIEN: 123 ] [
[ 123 <alien> ] compile-call
] unit-test
[ f ] [
0 [ <alien> ] compile-call
] unit-test
[ f ] [
0 [ { fixnum } declare <alien> ] compile-call
] unit-test
[ f ] [
[ 0 <alien> ] compile-call
] unit-test
[ ALIEN: 321 ] [
0 ALIEN: 321 [ <displaced-alien> ] compile-call
] unit-test
[ ALIEN: 321 ] [
0 ALIEN: 321 [ { fixnum c-ptr } declare <displaced-alien> ] compile-call
] unit-test
[ ALIEN: 321 ] [
ALIEN: 321 [ 0 swap <displaced-alien> ] compile-call
] unit-test
[ B{ 0 1 2 3 4 } ] [
2 B{ 0 1 2 3 4 } <displaced-alien>
[ 1 swap <displaced-alien> ] compile-call
underlying>>
] unit-test
[ B{ 0 1 2 3 4 } ] [
2 B{ 0 1 2 3 4 } <displaced-alien>
[ 1 swap { c-ptr } declare <displaced-alien> ] compile-call
underlying>>
] unit-test
[
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
] must-fail

View File

@ -120,6 +120,7 @@ HOOK: %unbox-float cpu ( dst src -- )
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
HOOK: %box-float cpu ( dst src temp -- )
HOOK: %box-alien cpu ( dst src temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp -- )
HOOK: %alien-unsigned-1 cpu ( dst src -- )
HOOK: %alien-unsigned-2 cpu ( dst src -- )

View File

@ -315,23 +315,50 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- )
: alien@ ( n -- n' ) cells object tag-number - ;
:: %allot-alien ( dst base displacement temp -- )
dst 4 cells alien temp %allot
temp \ f tag-number %load-immediate
! Store expired slot
temp dst 1 alien@ STW
! Store underlying-alien slot
base dst 2 alien@ STW
! Store offset
displacement dst 3 alien@ STW ;
M:: ppc %box-alien ( dst src temp -- )
[
"f" define-label
dst \ f tag-number %load-immediate
0 src 0 CMPI
"f" get BEQ
dst 4 cells alien temp %allot
! Store offset
src dst 3 alien@ STW
! Store expired slot
temp \ f tag-number %load-immediate
temp dst 1 alien@ STW
! Store underlying-alien slot
temp dst 2 alien@ STW
dst temp src temp %allot-alien
"f" resolve-label
] with-scope ;
M:: ppc %box-displaced-alien ( dst displacement base temp -- )
[
"end" define-label
"ok" define-label
! If displacement is zero, return the base
dst base MR
0 displacement 0 CMPI
"end" get BEQ
! If base is already a displaced alien, unpack it
0 base \ f tag-number CMPI
"ok" get BEQ
temp base header-offset LWZ
0 temp alien type-number tag-fixnum CMPI
"ok" get BEQ
! displacement += base.displacement
temp base 3 alien@ LWZ
displacement displacement temp ADD
! base = base.base
base base 1 alien@ LWZ
"ok" resolve-label
dst base displacement temp %allot-alien
"end" resolve-label
] with-scope ;
M: ppc %alien-unsigned-1 0 LBZ ;
M: ppc %alien-unsigned-2 0 LHZ ;

View File

@ -255,17 +255,42 @@ M:: x86 %box-float ( dst src temp -- )
: alien@ ( reg n -- op ) cells alien tag-number - [+] ;
:: %allot-alien ( dst base displacement temp -- )
dst 4 cells alien temp %allot
dst 1 alien@ base MOV ! alien
dst 2 alien@ \ f tag-number MOV ! expired
dst 3 alien@ displacement MOV ! displacement
;
M:: x86 %box-alien ( dst src temp -- )
[
"end" define-label
dst \ f tag-number MOV
src 0 CMP
"end" get JE
dst 4 cells alien temp %allot
dst 1 alien@ \ f tag-number MOV
dst 2 alien@ \ f tag-number MOV
! Store src in alien-offset slot
dst 3 alien@ src MOV
dst \ f tag-number src temp %allot-alien
"end" resolve-label
] with-scope ;
M:: x86 %box-displaced-alien ( dst displacement base temp -- )
[
"end" define-label
"ok" define-label
! If displacement is zero, return the base
dst base MOV
displacement 0 CMP
"end" get JE
! If base is already a displaced alien, unpack it
base \ f tag-number CMP
"ok" get JE
base header-offset [+] alien type-number tag-fixnum CMP
"ok" get JNE
! displacement += base.displacement
displacement base 3 alien@ ADD
! base = base.base
base base 1 alien@ MOV
"ok" resolve-label
dst base displacement temp %allot-alien
"end" resolve-label
] with-scope ;