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 ;
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 )
]
[ 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
[ 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 ;
[ 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 ;
_ [ alien-node-height ] bi
] emit-trivial-block ; inline
-: <alien-stack-frame> ( stack-size return -- stack-frame )
- stack-frame new
- swap return-size >>return
- swap >>params ;
+: <alien-stack-frame> ( stack-size -- stack-frame )
+ stack-frame new swap >>params ;
: emit-stack-frame ( stack-size params -- )
- [ return>> ] [ abi>> ] bi
- [ stack-cleanup ##cleanup ]
- [ drop <alien-stack-frame> ##stack-frame ] 3bi ;
+ [ [ return>> ] [ abi>> ] bi stack-cleanup ##cleanup ]
+ [ drop <alien-stack-frame> ##stack-frame ]
+ 2bi ;
M: #alien-invoke emit-node
[
[
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 ;
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
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 ;
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
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,
M: x86 %scalar>vector %copy ;
+enable-float-intrinsics
+enable-float-functions
enable-float-min/max
+enable-fsqrt
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 ;
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
! 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.
M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
[ [ FUCOMI ] compare-op ] (%compare-float-branch) ;
+
+enable-float-intrinsics
+enable-float-functions
+enable-fsqrt