diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor index 49f883cf91..ac370698a2 100644 --- a/library/compiler/generator/templates.factor +++ b/library/compiler/generator/templates.factor @@ -103,14 +103,10 @@ SYMBOL: phantom-r phantoms [ finalize-height ] 2apply ; : stack>new-vreg ( loc spec -- vreg ) - reg-spec>class alloc-reg [ swap %peek ] keep ; + spec>vreg [ swap %peek ] keep ; : vreg>stack ( value loc -- ) - over loc? [ - 2drop - ] [ - over [ %replace ] [ 2drop ] if - ] if ; + over loc? over not or [ 2drop ] [ %replace ] if ; : vregs>stack ( phantom -- ) [ @@ -144,11 +140,9 @@ SYMBOL: phantom-r : finalize-contents ( -- ) phantoms 2dup flush-locs [ vregs>stack ] 2apply ; -: end-basic-block ( -- ) - finalize-contents finalize-heights ; +: end-basic-block ( -- ) finalize-contents finalize-heights ; -: used-vregs ( -- seq ) - phantoms append [ vreg? ] subset ; +: used-vregs ( -- seq ) phantoms append [ vreg? ] subset ; : (compute-free-vregs) ( used class -- vector ) dup vregs length reverse [ swap ] map-with diff @@ -160,17 +154,17 @@ SYMBOL: phantom-r [ 2dup (compute-free-vregs) ] map>hash \ free-vregs set drop ; -: additional-vregs# ( seq seq -- n ) +: additional-vregs ( seq seq -- n ) 2array phantoms 2array [ [ length ] map ] 2apply v- 0 [ 0 max + ] reduce ; -: free-vregs* ( -- int# float# ) +: free-vregs# ( -- int# float# ) T{ int-regs } free-vregs length phantoms [ [ loc? ] subset length ] 2apply + - T{ float-regs f 8 } free-vregs length ; : ensure-vregs ( int# float# -- ) - compute-free-vregs free-vregs* swapd <= >r <= r> and + compute-free-vregs free-vregs# swapd <= >r <= r> and [ finalize-contents compute-free-vregs ] unless ; : (lazy-load) ( spec value -- value ) @@ -191,7 +185,8 @@ SYMBOL: phantom-r : compatible-values? ( value template -- ? ) { { [ over loc? ] [ 2drop t ] } - { [ dup { f float } memq? ] [ 2drop t ] } + { [ dup not ] [ drop [ float-regs? ] is? not ] } + { [ dup float eq? ] [ 2drop t ] } { [ dup integer? ] [ swap compatible-vreg? ] } } cond ; @@ -251,7 +246,7 @@ SYMBOL: +clobber dup length swap [ float eq? ] subset length [ - ] keep ; : guess-vregs ( -- int# float# ) - +input get { } additional-vregs# + +input get { } additional-vregs +scratch get [ first ] map requested-vregs >r + r> ; : alloc-scratch ( -- ) diff --git a/library/test/compiler/float.factor b/library/test/compiler/float.factor index 01ab401f9d..49cb4b51b5 100644 --- a/library/test/compiler/float.factor +++ b/library/test/compiler/float.factor @@ -1,10 +1,12 @@ IN: temporary -USING: compiler kernel memory math math-internals test ; +USING: compiler kernel kernel-internals memory math +math-internals test ; [ 5.0 ] [ [ 5.0 ] compile-1 full-gc full-gc full-gc ] unit-test [ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-1 ] unit-test [ 1 2 3 4.0 ] [ [ 1 2 3 4.0 ] compile-1 ] unit-test +[ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-1 ] unit-test [ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-1 ] unit-test [ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-1 ] unit-test