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

compiler.cfg.linear-scan: fix partial sync point logic in case where dst == src, and clean up spilling code

db4
Slava Pestov 2009-09-27 19:28:20 -05:00
parent 91e63c0c6f
commit 705b4ab5c3
14 changed files with 76 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/compiler/cfg/instructions/instructions.factor
View File

@ -657,7 +657,8 @@ literal: label
def: dst/int-rep
use: src1/int-rep src2/int-rep ;
TUPLE: spill-slot n ; C: <spill-slot> spill-slot
TUPLE: spill-slot { n integer } ;
C: <spill-slot> spill-slot
INSN: _gc
temp: temp1 temp2
@ -667,11 +668,11 @@ literal: data-values tagged-values uninitialized-locs ;
! virtual registers
INSN: _spill
use: src
literal: rep n ;
literal: rep dst ;
INSN: _reload
def: dst
literal: rep n ;
literal: rep src ;
INSN: _spill-area-size
literal: n ;

10
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -34,11 +34,15 @@ IN: compiler.cfg.linear-scan.allocation
[ drop assign-blocked-register ]
} cond ;
: spill-at-sync-point ( live-interval n -- ? )
! If the live interval has a usage at 'n', don't spill it,
! since this means its being defined by the sync point
! instruction. Output t if this is the case.
2dup [ uses>> ] dip swap member? [ 2drop t ] [ spill f ] if ;
: handle-sync-point ( n -- )
[ active-intervals get values ] dip
[ '[ [ _ spill ] each ] each ]
[ drop [ delete-all ] each ]
2bi ;
'[ [ _ spill-at-sync-point ] filter-here ] each ;
:: handle-progress ( n sync? -- )
n {

7
basis/compiler/cfg/linear-scan/allocation/state/state.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators cpu.architecture fry heaps
kernel math math.order namespaces sequences vectors
compiler.cfg compiler.cfg.registers
compiler.cfg compiler.cfg.registers compiler.cfg.instructions
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.state
@ -118,7 +118,8 @@ SYMBOL: unhandled-intervals
: next-spill-slot ( rep -- n )
rep-size cfg get
[ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ;
[ swap [ align dup ] [ + ] bi ] change-spill-area-size drop
<spill-slot> ;
! Minheap of sync points which still need to be processed
SYMBOL: unhandled-sync-points
@ -126,7 +127,7 @@ SYMBOL: unhandled-sync-points
! Mapping from vregs to spill slots
SYMBOL: spill-slots
: vreg-spill-slot ( vreg -- n )
: vreg-spill-slot ( vreg -- spill-slot )
spill-slots get [ rep-of next-spill-slot ] cache ;
: init-allocator ( registers -- )

2
basis/compiler/cfg/linear-scan/assignment/assignment.factor
View File

@ -33,7 +33,7 @@ ERROR: bad-vreg vreg ;
: (vreg>reg) ( vreg pending -- reg )
! If a live vreg is not in the pending set, then it must
! have been spilled.
?at [ spill-slots get ?at [ <spill-slot> ] [ bad-vreg ] if ] unless ;
?at [ spill-slots get ?at [ ] [ bad-vreg ] if ] unless ;
: vreg>reg ( vreg -- reg )
pending-interval-assoc get (vreg>reg) ;

16
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
View File

@ -92,7 +92,7 @@ H{
{ end 2 }
{ uses V{ 0 1 } }
{ ranges V{ T{ live-range f 0 2 } } }
{ spill-to 0 }
{ spill-to T{ spill-slot f 0 } }
}
T{ live-interval
{ vreg 1 }
@ -100,7 +100,7 @@ H{
{ end 5 }
{ uses V{ 5 } }
{ ranges V{ T{ live-range f 5 5 } } }
{ reload-from 0 }
{ reload-from T{ spill-slot f 0 } }
}
] [
T{ live-interval
@ -119,7 +119,7 @@ H{
{ end 1 }
{ uses V{ 0 } }
{ ranges V{ T{ live-range f 0 1 } } }
{ spill-to 4 }
{ spill-to T{ spill-slot f 4 } }
}
T{ live-interval
{ vreg 2 }
@ -127,7 +127,7 @@ H{
{ end 5 }
{ uses V{ 1 5 } }
{ ranges V{ T{ live-range f 1 5 } } }
{ reload-from 4 }
{ reload-from T{ spill-slot f 4 } }
}
] [
T{ live-interval
@ -146,7 +146,7 @@ H{
{ end 1 }
{ uses V{ 0 } }
{ ranges V{ T{ live-range f 0 1 } } }
{ spill-to 8 }
{ spill-to T{ spill-slot f 8 } }
}
T{ live-interval
{ vreg 3 }
@ -154,7 +154,7 @@ H{
{ end 30 }
{ uses V{ 20 30 } }
{ ranges V{ T{ live-range f 20 30 } } }
{ reload-from 8 }
{ reload-from T{ spill-slot f 8 } }
}
] [
T{ live-interval
@ -1042,8 +1042,8 @@ V{
[ _spill ] [ 1 get instructions>> second class ] unit-test
[ _reload ] [ 4 get instructions>> 4 swap nth class ] unit-test
[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ n>> cell / ] map ] unit-test
[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> cell / ] map ] unit-test
[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ dst>> n>> cell / ] map ] unit-test
[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ src>> n>> cell / ] map ] unit-test
! Resolve pass should insert this
[ _reload ] [ 5 get predecessors>> first instructions>> first class ] unit-test

12
basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
View File

@ -17,7 +17,7 @@ IN: compiler.cfg.linear-scan.resolve.tests
[
{
T{ _reload { dst 1 } { rep int-rep } { n 0 } }
T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 0 } } }
}
] [
[
@ -27,7 +27,7 @@ IN: compiler.cfg.linear-scan.resolve.tests
[
{
T{ _spill { src 1 } { rep int-rep } { n 0 } }
T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 0 } } }
}
] [
[
@ -54,14 +54,14 @@ H{ } clone spill-temps set
{ { { 0 int-rep } { 1 int-rep } } { { 1 int-rep } { 0 int-rep } } }
mapping-instructions {
{
T{ _spill { src 0 } { rep int-rep } { n 8 } }
T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 8 } } }
T{ ##copy { dst 0 } { src 1 } { rep int-rep } }
T{ _reload { dst 1 } { rep int-rep } { n 8 } }
T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 8 } } }
}
{
T{ _spill { src 1 } { rep int-rep } { n 8 } }
T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 8 } } }
T{ ##copy { dst 1 } { src 0 } { rep int-rep } }
T{ _reload { dst 0 } { rep int-rep } { n 8 } }
T{ _reload { dst 0 } { rep int-rep } { src T{ spill-slot f 8 } } }
}
} member?
] unit-test

4
basis/compiler/cfg/linear-scan/resolve/resolve.factor
View File

@ -34,10 +34,10 @@ SYMBOL: spill-temps
] if ;
: memory->register ( from to -- )
swap [ first2 ] [ first n>> ] bi* _reload ;
swap [ first2 ] [ first ] bi* _reload ;
: register->memory ( from to -- )
[ first2 ] [ first n>> ] bi* _spill ;
[ first2 ] [ first ] bi* _spill ;
: temp->register ( from to -- )
nip [ first ] [ second ] [ second spill-temp ] tri _reload ;

4
basis/compiler/codegen/codegen.factor
View File

@ -240,7 +240,7 @@ CODEGEN: _reload %reload
GENERIC# save-gc-root 1 ( gc-root operand temp -- )
M:: spill-slot save-gc-root ( gc-root operand temp -- )
temp int-rep operand n>> %reload
temp int-rep operand %reload
gc-root temp %save-gc-root ;
M: object save-gc-root drop %save-gc-root ;
@ -253,7 +253,7 @@ GENERIC# load-gc-root 1 ( gc-root operand temp -- )
M:: spill-slot load-gc-root ( gc-root operand temp -- )
gc-root temp %load-gc-root
temp int-rep operand n>> %spill ;
temp int-rep operand %spill ;
M: object load-gc-root drop %load-gc-root ;

24
basis/compiler/tests/codegen.factor
View File

@ -1,9 +1,10 @@
USING: generalizations accessors arrays compiler kernel kernel.private
math hashtables.private math.private namespaces sequences tools.test
namespaces.private slots.private sequences.private byte-arrays alien
alien.accessors layouts words definitions compiler.units io
combinators vectors grouping make alien.c-types combinators.short-circuit
math.order math.libm math.parser alien.c-types ;
USING: generalizations accessors arrays compiler kernel
kernel.private math hashtables.private math.private namespaces
sequences tools.test namespaces.private slots.private
sequences.private byte-arrays alien alien.accessors layouts
words definitions compiler.units io combinators vectors grouping
make alien.c-types combinators.short-circuit math.order
math.libm math.parser math.functions ;
FROM: math => float ;
QUALIFIED: namespaces.private
IN: compiler.tests.codegen
@ -432,6 +433,7 @@ cell 4 = [
] compile-call
] unit-test
! Bug in CSSA construction
TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-only } ;
[ 2 ] [
@ -449,3 +451,13 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
] 2curry each-integer
] compile-call
] unit-test
! Bug in linear scan's partial sync point logic
[ t ] [
[ 1.0 100 [ fsin ] times 1.0 float+ ] compile-call
1.168852488727981 1.e-9 ~
] unit-test
[ 65537.0 ] [
[ 2.0 4 [ 2.0 fpow ] times 1.0 float+ ] compile-call
] unit-test

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

@ -311,8 +311,8 @@ HOOK: %compare-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 -- )
HOOK: %spill cpu ( src rep n -- )
HOOK: %reload cpu ( dst rep n -- )
HOOK: %spill cpu ( src rep dst -- )
HOOK: %reload cpu ( dst rep src -- )
HOOK: %loop-entry cpu ( -- )

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

@ -632,11 +632,11 @@ M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
{ stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
} case ;
M: ppc %spill ( src rep n -- )
swap [ spill@ ] dip store-to-frame ;
M: ppc %spill ( src rep dst -- )
swap [ n>> spill@ ] dip store-to-frame ;
M: ppc %reload ( dst rep n -- )
swap [ spill@ ] dip load-from-frame ;
M: ppc %reload ( dst rep src -- )
swap [ n>> spill@ ] dip load-from-frame ;
M: ppc %loop-entry ;

11
basis/cpu/x86/32/32.factor
View File

@ -282,11 +282,16 @@ M: x86.32 %callback-value ( ctype -- )
! Unbox EAX
unbox-return ;
:: float-function-param ( stack-slot dst src -- )
GENERIC: float-function-param ( stack-slot dst src -- )
M:: spill-slot float-function-param ( stack-slot dst src -- )
! We can clobber dst here since its going to contain the
! final result
dst src n>> spill@ MOVSD
stack-slot dst MOVSD ;
dst src double-rep %copy
stack-slot dst double-rep %copy ;
M: register float-function-param
nip double-rep %copy ;
: float-function-return ( reg -- )
ESP [] FSTPL

6
basis/cpu/x86/64/64.factor
View File

@ -218,8 +218,8 @@ M: x86.64 %callback-value ( ctype -- )
! Unbox former top of data stack to return registers
unbox-return ;
: float-function-param ( i spill-slot -- )
[ float-regs param-regs nth ] [ n>> spill@ ] bi* MOVSD ;
: float-function-param ( i src -- )
[ float-regs param-regs nth ] dip double-rep %copy ;
: float-function-return ( reg -- )
float-regs return-reg double-rep %copy ;
@ -230,6 +230,8 @@ M:: x86.64 %unary-float-function ( dst src func -- )
dst float-function-return ;
M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
! src1 might equal dst; otherwise it will be a spill slot
! src2 is always a spill slot
0 src1 float-function-param
1 src2 float-function-param
func f %alien-invoke

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

@ -135,7 +135,10 @@ M: double-2-rep copy-register* drop MOVUPD ;
M: vector-rep copy-register* drop MOVDQU ;
M: x86 %copy ( dst src rep -- )
2over eq? [ 3drop ] [ copy-register* ] if ;
2over eq? [ 3drop ] [
[ [ dup spill-slot? [ n>> spill@ ] when ] bi@ ] dip
copy-register*
] if ;
:: overflow-template ( label dst src1 src2 insn -- )
src1 src2 insn call
@ -937,11 +940,8 @@ M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
\ UCOMISD (%compare-float-branch) ;
M:: x86 %spill ( src rep n -- )
n spill@ src rep %copy ;
M:: x86 %reload ( dst rep n -- )
dst n spill@ rep %copy ;
M:: x86 %spill ( src rep dst -- ) dst src rep %copy ;
M:: x86 %reload ( dst rep src -- ) dst src rep %copy ;
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;