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

Cleaning up generator.registers

release
Slava Pestov 2007-09-27 21:23:24 -04:00
parent 480e6a8b2b
commit 118772b634
9 changed files with 72 additions and 104 deletions

2
core/compiler/test/intrinsics.factor
View File

@ -371,7 +371,7 @@ cell 8 = [
[ ] [ "b" get free ] unit-test
] when
[ t ] [ "hello world" malloc-char-string "s" set ] unit-test
[ ] [ "hello world" malloc-char-string "s" set ] unit-test
"s" get [
[ "hello world" ] [ "s" get <void*> [ { byte-array } declare *void* ] compile-1 alien>char-string ] unit-test

5
core/compiler/test/templates-early.factor
View File

@ -1,7 +1,8 @@
! Testing templates machinery without compiling anything
IN: temporary
USING: compiler generator generator.registers tools.test
namespaces sequences words kernel math effects ;
USING: compiler generator generator.registers
generator.registers.private tools.test namespaces sequences
words kernel math effects ;
[
[ ] [ init-templates ] unit-test

13
core/cpu/architecture/architecture.factor
View File

@ -79,17 +79,14 @@ HOOK: %inc-d compiler-backend ( n -- )
HOOK: %inc-r compiler-backend ( n -- )
! Load stack into vreg
GENERIC: (%peek) ( vreg loc reg-class -- )
: %peek ( vreg loc -- ) over (%peek) ;
HOOK: %peek compiler-backend ( vreg loc -- )
! Store vreg to stack
GENERIC: (%replace) ( vreg loc reg-class -- )
: %replace ( vreg loc -- ) over (%replace) ;
HOOK: %replace compiler-backend ( vreg loc -- )
! Move one vreg to another
HOOK: %move-int>int compiler-backend ( dst src -- )
HOOK: %move-int>float compiler-backend ( dst src -- )
HOOK: %move-float>int compiler-backend ( dst src -- )
! Box and unbox floats
HOOK: %unbox-float compiler-backend ( dst src -- )
HOOK: %box-float compiler-backend ( dst src -- )
! FFI stuff

7
core/cpu/ppc/allot/allot.factor
View File

@ -32,12 +32,7 @@ IN: cpu.ppc.allot
12 11 float tag-number ORI
f fresh-object ;
M: float-regs (%replace)
drop
swap v>operand %allot-float
12 swap loc>operand STW ;
M: ppc-backend %move-float>int ( dst src -- )
M: ppc-backend %box-float ( dst src -- )
[ v>operand ] 2apply %allot-float 12 MR ;
: %allot-bignum ( #digits -- )

18
core/cpu/ppc/architecture/architecture.factor
View File

@ -156,21 +156,13 @@ M: ppc-backend %return ( -- ) %epilogue-later BLR ;
M: ppc-backend %unwind drop %return ;
M: int-regs (%peek)
drop >r v>operand r> loc>operand LWZ ;
M: ppc-backend %peek ( vreg loc -- )
>r v>operand r> loc>operand LWZ ;
M: float-regs (%peek)
drop
11 swap loc>operand LWZ
v>operand 11 float-offset LFD ;
M: ppc-backend %replace
>r v>operand r> loc>operand STW ;
M: int-regs (%replace)
drop >r v>operand r> loc>operand STW ;
M: ppc-backend %move-int>int ( dst src -- )
[ v>operand ] 2apply MR ;
M: ppc-backend %move-int>float ( dst src -- )
M: ppc-backend %unbox-float ( dst src -- )
[ v>operand ] 2apply float-offset LFD ;
M: ppc-backend %inc-d ( n -- ) ds-reg dup rot cells ADDI ;

2
core/cpu/x86/allot/allot.factor
View File

@ -37,7 +37,7 @@ IN: cpu.x86.allot
temp-reg v>operand swap tag-number OR
temp-reg v>operand MOV ;
M: x86-backend %move-float>int ( dst src -- )
M: x86-backend %box-float ( dst src -- )
#! Only called by pentium4 backend, uses SSE2 instruction
#! dest is a loc or a vreg
float 16 [

9
core/cpu/x86/architecture/architecture.factor
View File

@ -121,15 +121,12 @@ M: x86-backend %call-dispatch ( word-table# -- )
M: x86-backend %jump-dispatch ( word-table# -- )
[ %epilogue-later JMP ] dispatch-template ;
M: x86-backend %move-int>int ( dst src -- )
[ v>operand ] 2apply MOV ;
M: x86-backend %move-int>float ( dst src -- )
M: x86-backend %unbox-float ( dst src -- )
[ v>operand ] 2apply float-offset [+] MOVSD ;
M: int-regs (%peek) drop %move-int>int ;
M: x86-backend %peek [ v>operand ] 2apply MOV ;
M: int-regs (%replace) drop swap %move-int>int ;
M: x86-backend %replace swap %peek ;
: (%inc) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;

7
core/cpu/x86/sse2/sse2.factor
View File

@ -6,13 +6,6 @@ namespaces sequences words generator generator.registers
cpu.architecture math.floats.private layouts quotations ;
IN: cpu.x86.sse2
M: float-regs (%peek)
drop
temp-reg swap %move-int>int
temp-reg %move-int>float ;
M: float-regs (%replace) drop swap %move-float>int ;
: define-float-op ( word op -- )
[ "x" operand "y" operand ] swap add H{
{ +input+ { { float "x" } { float "y" } } }

113
core/generator/registers/registers.factor
View File

@ -104,7 +104,7 @@ M: phantom-retainstack finalize-height
dup length swap phantom-locs ;
: (each-loc) ( phantom quot -- )
>r dup phantom-locs* r> 2each ; inline
>r dup phantom-locs* swap r> 2each ; inline
: each-loc ( quot -- )
>r phantom-d get r> phantom-r get over
@ -161,8 +161,6 @@ PRIVATE>
phantoms [ finalize-height ] 2apply ;
! Phantom stacks hold values, locs, and vregs
UNION: pseudo loc value ;
: live-vregs ( -- seq ) phantoms append [ vreg? ] subset ;
: live-loc? ( current actual -- ? )
@ -211,34 +209,6 @@ SYMBOL: fresh-objects
T{ float-regs f 8 } T{ int-regs } ? ;
! Copying vregs to stacks
: alloc-vreg ( spec -- vreg )
reg-spec>class free-vregs pop ;
: %move ( dst src -- )
2dup = [
2drop
] [
2dup [ delegate class ] 2apply 2array {
{ { int-regs int-regs } [ %move-int>int ] }
{ { float-regs int-regs } [ %move-int>float ] }
{ { int-regs float-regs } [ %move-float>int ] }
} case
] if ;
: vreg>vreg ( vreg spec -- vreg )
alloc-vreg dup rot %move ;
: value>int-vreg ( value spec -- vreg )
alloc-vreg [ >r value-literal r> load-literal ] keep ;
: value>float-vreg ( value spec -- vreg )
alloc-vreg [
>r value-literal temp-reg load-literal r> temp-reg %move
] keep ;
: loc>vreg ( loc spec -- vreg )
alloc-vreg [ swap %peek ] keep ;
: allocation
H{
{ { int-regs f } f }
@ -252,17 +222,25 @@ SYMBOL: fresh-objects
{ { loc float } T{ float-regs 8 f } }
} at ;
: alloc-vreg ( spec -- vreg )
reg-spec>class free-vregs pop ;
: value>float-vreg ( dst src -- )
value-literal temp-reg load-literal
temp-reg %unbox-float ;
: loc>float-vreg ( dst src -- )
temp-reg swap %peek
temp-reg %unbox-float ;
: transfer
{
{ { int-regs f } [ drop ] }
{ { int-regs float } [ vreg>vreg ] }
{ { float-regs f } [ vreg>vreg ] }
{ { float-regs float } [ drop ] }
{ { value f } [ value>int-vreg ] }
{ { int-regs float } [ %unbox-float ] }
{ { float-regs f } [ %box-float ] }
{ { value f } [ value-literal swap load-literal ] }
{ { value float } [ value>float-vreg ] }
{ { value value } [ drop ] }
{ { loc f } [ loc>vreg ] }
{ { loc float } [ loc>vreg ] }
{ { loc f } [ %peek ] }
{ { loc float } [ loc>float-vreg ] }
} case ;
GENERIC: template-lhs ( obj -- lhs )
@ -283,29 +261,47 @@ M: object template-rhs ;
swap template-lhs swap template-rhs 2array ;
: (lazy-load) ( value spec -- value )
2dup transfer-op transfer ;
2dup transfer-op dup allocation
! ( value spec transfer-op )
[
>r alloc-vreg dup rot r> transfer
] [
2drop
] if ;
: loc>loc ( fromloc toloc -- )
#! Move a value from a stack location to another stack
#! location.
temp-reg rot %peek
: float-vreg>loc ( dst src -- )
temp-reg swap %box-float
temp-reg swap %replace ;
: lazy-store ( src dest -- )
: value>loc ( src dst -- )
#! Move a literal to a stack location.
value-literal temp-reg load-literal
temp-reg swap %replace ;
: loc>loc ( dst src -- )
temp-reg swap %peek
temp-reg swap %replace ;
: (lazy-store) ( dst src -- )
dup template-lhs {
{ float-regs [ float-vreg>loc ] }
{ int-regs [ swap %replace ] }
{ value [ value>loc ] }
{ loc [ loc>loc ] }
} case ;
: lazy-store ( dst src live-locs -- )
#! Don't store a location to itself.
2dup = [
2drop
] [
>r \ live-locs get at dup vreg?
[ r> %replace ] [ r> loc>loc ] if
] if ;
>r 2dup = [ r> 3drop ] [ r> at (lazy-store) ] if ;
: do-shuffle ( hash -- )
dup assoc-empty? [
drop
] [
\ live-locs set
[ over loc? [ lazy-store ] [ 2drop ] if ] each-loc
[
>r dup loc?
[ r> lazy-store ] [ r> 3drop ] if
] curry each-loc
] if ;
: fast-shuffle ( locs -- )
@ -341,19 +337,16 @@ M: object template-rhs ;
live-locs dup fast-shuffle?
[ fast-shuffle ] [ slow-shuffle ] if ;
: value>loc ( literal toloc -- )
#! Move a literal to a stack location.
>r value-literal temp-reg load-literal
temp-reg r> %replace ;
: finalize-values ( -- )
#! Store any deferred literals to their final stack
#! locations.
[ over value? [ value>loc ] [ 2drop ] if ] each-loc ;
[ dup value? [ (lazy-store) ] [ 2drop ] if ] each-loc ;
UNION: pseudo loc value ;
: finalize-vregs ( -- )
#! Store any vregs to their final stack locations.
[ over pseudo? [ 2drop ] [ %replace ] if ] each-loc ;
[ dup pseudo? [ 2drop ] [ (lazy-store) ] if ] each-loc ;
: reusing-vregs ( quot -- )
#! Any vregs allocated by quot are released again.