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

Compiler work

release
slava 2006-05-09 15:31:10 +00:00
parent 593165784b
commit da2fc4eaba
8 changed files with 60 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

@ -1,7 +1,6 @@
should fix in 0.82:
- clean up/rewrite register allocation
- moving between int and float vregs
- intrinsic fixnum>float float>fixnum
- amd64 %box-struct

26
library/compiler/generator/architecture.factor
View File

@ -1,6 +1,6 @@
IN: compiler
USING: generic kernel kernel-internals math memory namespaces
sequences ;
USING: arrays generic kernel kernel-internals math memory
namespaces sequences ;
! A scratch register for computations
TUPLE: vreg n ;
@ -69,6 +69,20 @@ DEFER: %peek ( vreg loc -- )
! Store vreg to stack
DEFER: %replace ( vreg loc -- )
! Move one vreg to another
DEFER: %move-int>int ( dst src -- )
DEFER: %move-int>float ( dst src -- )
: %move ( dst src -- )
2dup = [
2drop
] [
2dup [ delegate class ] 2apply 2array {
{ [ { int-regs int-regs } = ] [ %move-int>int ] }
{ [ { float-regs int-regs } = ] [ %move-int>float ] }
} cond
] if ;
! FFI stuff
DEFER: %unbox ( n reg-class func -- )
@ -84,14 +98,6 @@ DEFER: %alien-callback ( quot -- )
DEFER: %callback-value ( reg-class func -- )
! A few FFI operations have default implementations
: %cleanup ( n -- ) drop ;
: %stack>freg ( n reg reg-class -- ) 3drop ;
: %freg>stack ( n reg reg-class -- ) 3drop ;
! Some stuff probably not worth redefining in other backends
M: stack-params fastcall-regs drop 0 ;
GENERIC: reg-size ( register-class -- n )

2
library/compiler/generator/generator.factor
View File

@ -194,7 +194,7 @@ M: #dispatch generate-node ( node -- next )
UNION: immediate fixnum POSTPONE: f ;
: generate-push ( node -- )
>#push< dup literal-template
>#push< dup length f <array>
dup requested-vregs ensure-vregs
alloc-vregs [ [ load-literal ] 2each ] keep
phantom-d get phantom-append

30
library/compiler/generator/templates.factor
View File

@ -175,18 +175,20 @@ SYMBOL: phantom-r
compute-free-vregs free-vregs* swapd <= >r <= r> and
[ finalize-contents compute-free-vregs ] unless ;
: spec>vreg ( spec -- vreg )
dup integer? [ <int-vreg> ] [ reg-spec>class alloc-reg ] if ;
: (lazy-load) ( value spec -- value )
spec>vreg swap [
{
{ [ dup loc? ] [ %peek ] }
{ [ dup vreg? ] [ %move ] }
{ [ t ] [ 2drop ] }
} cond
] keep ;
: lazy-load ( values template -- template )
[
first2 >r over loc? [
over integer? [
>r <int-vreg> dup r> %peek
] [
stack>new-vreg
] if
] [
drop
] if r> 2array
] 2map ;
[ first2 >r (lazy-load) r> 2array ] 2map ;
: stack>vregs ( phantom template -- values )
[
@ -195,11 +197,7 @@ SYMBOL: phantom-r
] 2keep length neg swap adjust-phantom ;
: compatible-vreg? ( n vreg -- ? )
{
{ [ dup [ int-regs? ] is? ] [ vreg-n = ] }
{ [ dup [ float-regs? ] is? ] [ 2drop t ] }
{ [ t ] [ 2drop f ] }
} cond ;
dup [ int-regs? ] is? [ vreg-n = ] [ 2drop f ] if ;
: compatible-values? ( value template -- ? )
{

2
library/compiler/ppc/architecture.factor
View File

@ -176,3 +176,5 @@ M: stack-params freg>stack
"unnest_stacks" f %alien-invoke
! Restore return register
load-return ;
: %cleanup ( n -- ) drop ;

44
library/compiler/x86/architecture.factor
View File

@ -46,36 +46,13 @@ M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
: prepare-division CDQ ; inline
: fp-scratch ( -- vreg )
"fp-scratch" get [
T{ int-regs } alloc-reg dup "fp-scratch" set
] unless* ;
: unboxify-float ( obj vreg quot -- | quot: obj int-vreg )
#! The SSE2 code here will never be generated unless SSE2
#! intrinsics are loaded.
over [ float-regs? ] is? [
swap >r fp-scratch [ swap call ] keep
r> swap [ v>operand ] 2apply float-offset [+] MOVSD
] [
call
] if ; inline
: literal-template
#! All literals go into integer registers unless SSE2
#! intrinsics are loaded.
length f <array> ;
M: immediate load-literal ( literal vreg -- )
v>operand swap v>operand MOV ;
: load-indirect ( literal vreg -- )
M: object load-literal ( literal vreg -- )
v>operand swap add-literal [] MOV
rel-absolute-cell rel-address ;
M: object load-literal ( literal vreg -- )
[ load-indirect ] unboxify-float ;
: (%call) ( label -- label )
dup postpone-word dup primitive? [ address-operand ] when ;
@ -108,14 +85,21 @@ M: object load-literal ( literal vreg -- )
: %return ( -- ) %epilogue RET ;
: vreg-mov swap [ v>operand ] 2apply MOV ;
: %move-int>int ( dst src -- )
[ v>operand ] 2apply MOV ;
: %peek ( vreg loc -- )
swap [ vreg-mov ] unboxify-float ;
: %move-int>float ( dst src -- )
[ v>operand ] 2apply float-offset [+] MOVSD ;
GENERIC: (%peek) ( vreg loc reg-class -- )
M: int-regs (%peek) drop %move-int>int ;
: %peek ( vreg loc -- ) over (%peek) ;
GENERIC: (%replace) ( vreg loc reg-class -- )
M: int-regs (%replace) drop vreg-mov ;
M: int-regs (%replace) drop swap %move-int>int ;
: %replace ( vreg loc -- ) over (%replace) ;
@ -124,3 +108,7 @@ M: int-regs (%replace) drop vreg-mov ;
: %inc-d ( n -- ) ds-reg (%inc) ;
: %inc-r ( n -- ) cs-reg (%inc) ;
: %stack>freg ( n reg reg-class -- ) 3drop ;
: %freg>stack ( n reg reg-class -- ) 3drop ;

13
library/compiler/x86/intrinsics-sse2.factor
View File

@ -4,10 +4,15 @@ USING: alien arrays assembler generic kernel kernel-internals
lists math math-internals memory namespaces sequences words ;
IN: compiler
: literal-template
#! floats map to 'float' so we put float literals in float
#! vregs
[ class ] map ;
: fp-scratch ( -- vreg )
"fp-scratch" get [
T{ int-regs } alloc-reg dup "fp-scratch" set
] unless* ;
M: float-regs (%peek) ( vreg loc reg-class -- )
drop
fp-scratch swap %move-int>int
fp-scratch %move-int>float ;
: load-zone-ptr ( vreg -- )
#! Load pointer to start of zone array

2
library/test/compiler/templates.factor
View File

@ -31,6 +31,8 @@ unit-test
! Test literals in either side of a shuffle
[ 4 1 ] [ 1 [ [ 3 fixnum+ ] keep ] compile-1 ] unit-test
[ 2 ] [ 1 2 [ swap fixnum/i ] compile-1 ] unit-test
: foo ;
[ 4 4 ]