diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor index a8a0fceed7..70a02658d3 100644 --- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor +++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor @@ -6,19 +6,25 @@ compiler.cfg.rpo compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stack-frame ; IN: compiler.cfg.build-stack-frame +SYMBOL: local-allot + SYMBOL: frame-required? GENERIC: compute-stack-frame* ( insn -- ) +: frame-required ( -- ) frame-required? on ; + : request-stack-frame ( stack-frame -- ) - frame-required? on + frame-required stack-frame [ max-stack-frame ] change ; +M: ##local-allot compute-stack-frame* + local-allot get >>offset + size>> local-allot +@ ; + M: ##stack-frame compute-stack-frame* stack-frame>> request-stack-frame ; -: frame-required ( -- ) frame-required? on ; - : vm-frame-required ( -- ) frame-required stack-frame new vm-stack-space >>params request-stack-frame ; @@ -45,13 +51,18 @@ M: ##integer>float compute-stack-frame* M: insn compute-stack-frame* drop ; -: initial-stack-frame ( -- stack-frame ) - stack-frame new cfg get spill-area-size>> >>spill-area-size ; +: request-spill-area ( n -- ) + stack-frame new swap >>spill-area-size request-stack-frame ; + +: request-local-allot ( n -- ) + stack-frame new swap >>local-allot request-stack-frame ; : compute-stack-frame ( cfg -- ) - initial-stack-frame stack-frame set - [ spill-area-size>> 0 > frame-required? set ] + 0 local-allot set + stack-frame new stack-frame set + [ spill-area-size>> [ request-spill-area ] unless-zero ] [ [ instructions>> [ compute-stack-frame* ] each ] each-basic-block ] bi + local-allot get [ request-local-allot ] unless-zero stack-frame get dup stack-frame-size >>total-size drop ; : build-stack-frame ( cfg -- cfg ) diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 0b22c4d157..497810dcdd 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -21,11 +21,13 @@ IN: compiler.cfg.builder.alien ] [ length neg ##inc-d ] bi ; -: prepare-struct-caller ( vregs reps return -- vregs' reps' ) - large-struct? [ - [ ^^prepare-struct-caller prefix ] - [ int-rep struct-return-on-stack? 2array prefix ] bi* - ] when ; +: prepare-struct-caller ( vregs reps return -- vregs' reps' return-vreg/f ) + dup large-struct? [ + heap-size f ^^local-allot [ + '[ _ prefix ] + [ int-rep struct-return-on-stack? 2array prefix ] bi* + ] keep + ] [ drop f ] if ; : caller-parameter ( vreg rep on-stack? -- insn ) [ dup reg-class-of reg-class-full? ] dip or @@ -44,10 +46,12 @@ IN: compiler.cfg.builder.alien [ abi>> ] [ parameters>> ] [ return>> ] tri '[ _ unbox-parameters - _ prepare-struct-caller + _ prepare-struct-caller struct-return-area set (caller-parameters) stack-params get - ] with-param-regs ; + struct-return-area get + ] with-param-regs + struct-return-area set ; : box-return* ( node -- ) return>> [ ] [ base-type box-return 1 ##inc-d D 0 ##replace ] if-void ; @@ -79,10 +83,6 @@ M: array dlsym-valid? '[ _ dlsym ] any? ; [ library>> load-library ] bi 2dup check-dlsym ; -: return-size ( c-type -- n ) - ! Amount of space we reserve for a return value. - dup large-struct? [ heap-size ] [ drop 0 ] if ; - : alien-node-height ( params -- ) [ out-d>> length ] [ in-d>> length ] bi - adjust-d ; @@ -93,15 +93,13 @@ M: array dlsym-valid? '[ _ dlsym ] any? ; _ [ alien-node-height ] bi ] emit-trivial-block ; inline -: ( stack-size return -- stack-frame ) - stack-frame new - swap return-size >>return - swap >>params ; +: ( stack-size -- stack-frame ) + stack-frame new swap >>params ; : emit-stack-frame ( stack-size params -- ) - [ return>> ] [ abi>> ] bi - [ stack-cleanup ##cleanup ] - [ drop ##stack-frame ] 3bi ; + [ [ return>> ] [ abi>> ] bi stack-cleanup ##cleanup ] + [ drop ##stack-frame ] + 2bi ; M: #alien-invoke emit-node [ diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor index d23f64f750..a75632c0a8 100644 --- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor +++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor @@ -132,5 +132,5 @@ M: struct-c-type box-return [ dup return-struct-in-registers? [ load-return ] - [ [ ^^prepare-struct-caller ] dip explode-struct keys ] if + [ [ struct-return-area get ] dip explode-struct keys ] if ] keep box ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 9211b7f8cf..109c55e79b 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -654,8 +654,9 @@ INSN: ##load-stack-param def: dst literal: n rep ; -INSN: ##prepare-struct-caller -def: dst/int-rep ; +INSN: ##local-allot +def: dst/int-rep +literal: size offset ; INSN: ##box def: dst/tagged-rep diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor index f438cb9a7f..4ed192a21e 100644 --- a/basis/compiler/cfg/stack-frame/stack-frame.factor +++ b/basis/compiler/cfg/stack-frame/stack-frame.factor @@ -7,24 +7,24 @@ IN: compiler.cfg.stack-frame TUPLE: stack-frame { params integer } -{ return integer } +{ local-allot integer } { spill-area-size integer } { total-size integer } ; ! Stack frame utilities -: return-offset ( -- offset ) - stack-frame get params>> ; +: local-allot-offset ( n -- offset ) + stack-frame get params>> + ; : spill-offset ( n -- offset ) - stack-frame get [ params>> ] [ return>> ] bi + + ; + stack-frame get [ params>> ] [ local-allot>> ] bi + + ; : (stack-frame-size) ( stack-frame -- n ) - [ params>> ] [ return>> ] [ spill-area-size>> ] tri + + ; + [ params>> ] [ local-allot>> ] [ spill-area-size>> ] tri + + ; : max-stack-frame ( frame1 frame2 -- frame3 ) [ stack-frame new ] 2dip { [ [ params>> ] bi@ max >>params ] - [ [ return>> ] bi@ max >>return ] + [ [ local-allot>> ] bi@ max >>local-allot ] [ [ spill-area-size>> ] bi@ max >>spill-area-size ] } 2cleave ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index a88e1df723..0e30e828c3 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -290,7 +290,7 @@ CODEGEN: ##store-reg-param %store-reg-param CODEGEN: ##store-stack-param %store-stack-param CODEGEN: ##load-reg-param %load-reg-param CODEGEN: ##load-stack-param %load-stack-param -CODEGEN: ##prepare-struct-caller %prepare-struct-caller +CODEGEN: ##local-allot %local-allot CODEGEN: ##box %box CODEGEN: ##box-long-long %box-long-long CODEGEN: ##allot-byte-array %allot-byte-array diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index bb9adbf5ce..c3491f23bd 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -584,7 +584,7 @@ HOOK: %store-reg-param cpu ( src reg rep -- ) HOOK: %store-stack-param cpu ( src n rep -- ) -HOOK: %prepare-struct-caller cpu ( dst -- ) +HOOK: %local-allot cpu ( dst size offset -- ) ! Call a function to convert a value into a tagged pointer, ! possibly allocating a bignum, float, or alien instance, diff --git a/basis/cpu/x86/sse/sse.factor b/basis/cpu/x86/sse/sse.factor index a6e92ff0a0..f12c1df970 100644 --- a/basis/cpu/x86/sse/sse.factor +++ b/basis/cpu/x86/sse/sse.factor @@ -910,4 +910,7 @@ M: x86 %vector>scalar %copy ; M: x86 %scalar>vector %copy ; +enable-float-intrinsics +enable-float-functions enable-float-min/max +enable-fsqrt diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 2a115532fa..83711b7b5d 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -588,8 +588,8 @@ M:: x86 %store-stack-param ( src n rep -- ) M:: x86 %load-stack-param ( dst n rep -- ) dst n next-stack@ rep %copy ; -M: x86 %prepare-struct-caller ( dst -- ) - return-offset special-offset stack@ LEA ; +M: x86 %local-allot ( dst size offset -- ) + nip local-allot-offset special-offset stack@ LEA ; M: x86 %alien-indirect ( src -- ) ?spill-slot CALL ; @@ -693,10 +693,6 @@ M: x86 immediate-bitwise? ( n -- ? ) enable-min/max enable-log2 -enable-float-intrinsics -enable-float-functions -enable-fsqrt - : check-sse ( -- ) "Checking for multimedia extensions... " write flush [ { (sse-version) } compile ] with-optimizer diff --git a/basis/cpu/x86/x87/x87.factor b/basis/cpu/x86/x87/x87.factor index 0155aa7c32..8f267b4265 100644 --- a/basis/cpu/x86/x87/x87.factor +++ b/basis/cpu/x86/x87/x87.factor @@ -2,8 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types combinators kernel locals system namespaces compiler.codegen.fixup compiler.constants -compiler.cfg.comparisons cpu.architecture cpu.x86 -cpu.x86.assembler cpu.x86.assembler.operands ; +compiler.cfg.comparisons compiler.cfg.intrinsics +cpu.architecture cpu.x86 cpu.x86.assembler +cpu.x86.assembler.operands ; IN: cpu.x86.x87 ! x87 unit is only used if SSE2 is not available. @@ -96,3 +97,7 @@ M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- ) M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- ) [ [ FUCOMI ] compare-op ] (%compare-float-branch) ; + +enable-float-intrinsics +enable-float-functions +enable-fsqrt