diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index f0bcd888df..9420a213ff 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -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 diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor index 3a3f7f3649..98d2e84a62 100644 --- a/library/compiler/generator/architecture.factor +++ b/library/compiler/generator/architecture.factor @@ -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 ) diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor index 7776637345..910acf2532 100644 --- a/library/compiler/generator/generator.factor +++ b/library/compiler/generator/generator.factor @@ -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 dup requested-vregs ensure-vregs alloc-vregs [ [ load-literal ] 2each ] keep phantom-d get phantom-append diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor index 2a4b290588..ca61addff8 100644 --- a/library/compiler/generator/templates.factor +++ b/library/compiler/generator/templates.factor @@ -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? [ ] [ 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 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 -- ? ) { diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor index 412c8281d9..7e44856f60 100644 --- a/library/compiler/ppc/architecture.factor +++ b/library/compiler/ppc/architecture.factor @@ -176,3 +176,5 @@ M: stack-params freg>stack "unnest_stacks" f %alien-invoke ! Restore return register load-return ; + +: %cleanup ( n -- ) drop ; diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor index 1a3c030224..f5c798cf37 100644 --- a/library/compiler/x86/architecture.factor +++ b/library/compiler/x86/architecture.factor @@ -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 ; - 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 ; diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor index e6cd8e33fb..60ab472423 100644 --- a/library/compiler/x86/intrinsics-sse2.factor +++ b/library/compiler/x86/intrinsics-sse2.factor @@ -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 diff --git a/library/test/compiler/templates.factor b/library/test/compiler/templates.factor index 650f1d02f3..3f6d84a1dd 100644 --- a/library/test/compiler/templates.factor +++ b/library/test/compiler/templates.factor @@ -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 ]