Working on stack frame cleanup
parent
46c3f0def1
commit
d5112a0ced
|
@ -296,16 +296,13 @@ M: #return-recursive generate-node
|
|||
|
||||
: return-size ( ctype -- n )
|
||||
#! Amount of space we reserve for a return value.
|
||||
dup large-struct? [ heap-size ] [ drop 0 ] if ;
|
||||
dup large-struct? [ heap-size ] [ drop 2 cells ] if ;
|
||||
|
||||
: alien-stack-frame ( params -- n )
|
||||
alien-parameters parameter-sizes drop ;
|
||||
|
||||
: alien-invoke-frame ( params -- n )
|
||||
#! Two cells for temporary storage, temp@ and on x86.64,
|
||||
#! small struct return value unpacking
|
||||
[ return>> return-size ] [ alien-stack-frame ] bi
|
||||
+ 2 cells + ;
|
||||
[ return>> return-size ] [ alien-stack-frame ] bi + ;
|
||||
|
||||
: set-stack-frame ( n -- )
|
||||
dup [ frame-required ] when* \ stack-frame set ;
|
||||
|
|
|
@ -44,7 +44,7 @@ IN: cpu.ppc.architecture
|
|||
: xt-save ( n -- i ) 2 cells - ;
|
||||
|
||||
M: ppc stack-frame ( n -- i )
|
||||
local@ factor-area-size + 4 cells align ;
|
||||
local@ factor-area-size + cell + 4 cells align ;
|
||||
|
||||
M: temp-reg v>operand drop 11 ;
|
||||
|
||||
|
@ -166,11 +166,13 @@ M: float-regs %load-param-reg >r 1 rot local@ r> LF ;
|
|||
M: stack-params %load-param-reg ( stack reg reg-class -- )
|
||||
drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ;
|
||||
|
||||
: next-param@ ( n -- x ) param@ stack-frame* + ;
|
||||
|
||||
M: stack-params %save-param-reg ( stack reg reg-class -- )
|
||||
#! Funky. Read the parameter from the caller's stack frame.
|
||||
#! This word is used in callbacks
|
||||
drop
|
||||
0 1 rot param@ stack-frame* + LWZ
|
||||
0 1 rot next-param@ LWZ
|
||||
0 1 rot local@ STW ;
|
||||
|
||||
M: ppc %prepare-unbox ( -- )
|
||||
|
@ -197,10 +199,8 @@ M: ppc %unbox-long-long ( n func -- )
|
|||
|
||||
M: ppc %unbox-large-struct ( n c-type -- )
|
||||
! Value must be in r3
|
||||
! Compute destination address
|
||||
4 1 roll local@ ADDI
|
||||
! Load struct size
|
||||
heap-size 5 LI
|
||||
! Compute destination address and load struct size
|
||||
[ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi*
|
||||
! Call the function
|
||||
"to_value_struct" f %alien-invoke ;
|
||||
|
||||
|
@ -218,9 +218,8 @@ M: ppc %box-long-long ( n func -- )
|
|||
4 1 rot cell + local@ LWZ
|
||||
] when* r> f %alien-invoke ;
|
||||
|
||||
: temp@ ( m -- n ) stack-frame* factor-area-size - swap - ;
|
||||
|
||||
: struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?if ;
|
||||
: struct-return@ ( size n -- n )
|
||||
[ local@ ] [ stack-frame* factor-area-size - swap - ] ?if ;
|
||||
|
||||
M: ppc %prepare-box-struct ( size -- )
|
||||
#! Compute target address for value struct return
|
||||
|
@ -231,10 +230,8 @@ M: ppc %box-large-struct ( n c-type -- )
|
|||
#! If n = f, then we're boxing a returned struct
|
||||
heap-size
|
||||
[ swap struct-return@ ] keep
|
||||
! Compute destination address
|
||||
3 1 roll ADDI
|
||||
! Load struct size
|
||||
4 LI
|
||||
! Compute destination address and load struct size
|
||||
[ 3 1 rot ADDI ] [ 4 LI ] bi*
|
||||
! Call the function
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
|
||||
|
@ -256,10 +253,10 @@ M: ppc %alien-callback ( quot -- )
|
|||
|
||||
M: ppc %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
3 1 cell temp@ STW ;
|
||||
3 11 MR ;
|
||||
|
||||
M: ppc %alien-indirect ( -- )
|
||||
11 1 cell temp@ LWZ (%call) ;
|
||||
(%call) ;
|
||||
|
||||
M: ppc %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
|
|
|
@ -1,13 +1,12 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types arrays cpu.x86.assembler
|
||||
USING: locals alien.c-types arrays cpu.x86.assembler
|
||||
cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
|
||||
cpu.architecture kernel kernel.private math namespaces sequences
|
||||
stack-checker.known-words
|
||||
compiler.generator.registers compiler.generator.fixup
|
||||
compiler.generator system layouts combinators
|
||||
command-line compiler compiler.units io vocabs.loader accessors
|
||||
init ;
|
||||
stack-checker.known-words compiler.generator.registers
|
||||
compiler.generator.fixup compiler.generator system layouts
|
||||
combinators command-line compiler compiler.units io
|
||||
vocabs.loader accessors init ;
|
||||
IN: cpu.x86.32
|
||||
|
||||
! We implement the FFI for Linux, OS X and Windows all at once.
|
||||
|
@ -18,7 +17,6 @@ IN: cpu.x86.32
|
|||
M: x86.32 ds-reg ESI ;
|
||||
M: x86.32 rs-reg EDI ;
|
||||
M: x86.32 stack-reg ESP ;
|
||||
M: x86.32 stack-save-reg EDX ;
|
||||
M: x86.32 temp-reg-1 EAX ;
|
||||
M: x86.32 temp-reg-2 ECX ;
|
||||
|
||||
|
@ -32,15 +30,20 @@ M: x86.32 struct-small-enough? ( size -- ? )
|
|||
heap-size { 1 2 4 8 } member?
|
||||
os { linux netbsd solaris } member? not and ;
|
||||
|
||||
: struct-return@ ( size n -- operand )
|
||||
[ next-stack@ ] [ \ stack-frame get swap - stack@ ] ?if ;
|
||||
|
||||
! On x86, parameters are never passed in registers.
|
||||
M: int-regs return-reg drop EAX ;
|
||||
M: int-regs param-regs drop { } ;
|
||||
M: int-regs vregs drop { EAX ECX EDX EBP } ;
|
||||
M: int-regs push-return-reg return-reg PUSH ;
|
||||
: load/store-int-return ( n reg-class -- src dst )
|
||||
return-reg stack-reg rot [+] ;
|
||||
M: int-regs load-return-reg load/store-int-return MOV ;
|
||||
M: int-regs store-return-reg load/store-int-return swap MOV ;
|
||||
|
||||
M: int-regs load-return-reg
|
||||
return-reg swap next-stack@ MOV ;
|
||||
|
||||
M: int-regs store-return-reg
|
||||
[ stack@ ] [ return-reg ] bi* MOV ;
|
||||
|
||||
M: float-regs param-regs drop { } ;
|
||||
M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
|
||||
|
@ -48,14 +51,16 @@ M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
|
|||
: FSTP ( operand size -- ) 4 = [ FSTPS ] [ FSTPL ] if ;
|
||||
|
||||
M: float-regs push-return-reg
|
||||
stack-reg swap reg-size [ SUB stack-reg [] ] keep FSTP ;
|
||||
stack-reg swap reg-size
|
||||
[ SUB ] [ [ [] ] dip FSTP ] 2bi ;
|
||||
|
||||
: FLD ( operand size -- ) 4 = [ FLDS ] [ FLDL ] if ;
|
||||
|
||||
: load/store-float-return ( n reg-class -- op size )
|
||||
[ stack@ ] [ reg-size ] bi* ;
|
||||
M: float-regs load-return-reg load/store-float-return FLD ;
|
||||
M: float-regs store-return-reg load/store-float-return FSTP ;
|
||||
M: float-regs load-return-reg
|
||||
[ next-stack@ ] [ reg-size ] bi* FLD ;
|
||||
|
||||
M: float-regs store-return-reg
|
||||
[ stack@ ] [ reg-size ] bi* FSTP ;
|
||||
|
||||
: align-sub ( n -- )
|
||||
dup 16 align swap - ESP swap SUB ;
|
||||
|
@ -64,7 +69,8 @@ M: float-regs store-return-reg load/store-float-return FSTP ;
|
|||
16 align ESP swap ADD ;
|
||||
|
||||
: with-aligned-stack ( n quot -- )
|
||||
swap dup align-sub slip align-add ; inline
|
||||
[ [ align-sub ] [ call ] bi* ]
|
||||
[ [ align-add ] [ drop ] bi* ] 2bi ; inline
|
||||
|
||||
M: x86.32 fixnum>slot@ 1 SHR ;
|
||||
|
||||
|
@ -77,57 +83,40 @@ M: object %load-param-reg 3drop ;
|
|||
|
||||
M: object %save-param-reg 3drop ;
|
||||
|
||||
: box@ ( n reg-class -- stack@ )
|
||||
#! Used for callbacks; we want to box the values given to
|
||||
#! us by the C function caller. Computes stack location of
|
||||
#! nth parameter; note that we must go back one more stack
|
||||
#! frame, since %box sets one up to call the one-arg boxer
|
||||
#! function. The size of this stack frame so far depends on
|
||||
#! the reg-class of the boxer's arg.
|
||||
reg-size neg + stack-frame* + 20 + ;
|
||||
|
||||
: (%box) ( n reg-class -- )
|
||||
#! If n is f, push the return register onto the stack; we
|
||||
#! are boxing a return value of a C function. If n is an
|
||||
#! integer, push [ESP+n] on the stack; we are boxing a
|
||||
#! parameter being passed to a callback from C.
|
||||
over [ [ box@ ] keep [ load-return-reg ] keep ] [ nip ] if
|
||||
push-return-reg ;
|
||||
over [ load-return-reg ] [ 2drop ] if ;
|
||||
|
||||
M: x86.32 %box ( n reg-class func -- )
|
||||
over reg-size [
|
||||
>r (%box) r> f %alien-invoke
|
||||
M:: x86.32 %box ( n reg-class func -- )
|
||||
n reg-class (%box)
|
||||
reg-class reg-size [
|
||||
reg-class push-return-reg
|
||||
func f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
: (%box-long-long) ( n -- )
|
||||
#! If n is f, push the return registers onto the stack; we
|
||||
#! are boxing a return value of a C function. If n is an
|
||||
#! integer, push [ESP+n]:[ESP+n+4] on the stack; we are
|
||||
#! boxing a parameter being passed to a callback from C.
|
||||
[
|
||||
int-regs box@
|
||||
EDX over stack@ MOV
|
||||
EAX swap cell - stack@ MOV
|
||||
] when*
|
||||
EDX PUSH
|
||||
EAX PUSH ;
|
||||
EDX over next-stack@ MOV
|
||||
EAX swap cell - next-stack@ MOV
|
||||
] when* ;
|
||||
|
||||
M: x86.32 %box-long-long ( n func -- )
|
||||
[ (%box-long-long) ] dip
|
||||
8 [
|
||||
[ (%box-long-long) ] [ f %alien-invoke ] bi*
|
||||
EDX PUSH
|
||||
EAX PUSH
|
||||
f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
: struct-return@ ( size n -- n )
|
||||
[ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ;
|
||||
|
||||
M: x86.32 %box-large-struct ( n c-type -- )
|
||||
M:: x86.32 %box-large-struct ( n c-type -- )
|
||||
! Compute destination address
|
||||
heap-size
|
||||
[ swap struct-return@ ] keep
|
||||
ECX ESP roll [+] LEA
|
||||
ECX c-type heap-size n struct-return@ LEA
|
||||
8 [
|
||||
! Push struct size
|
||||
PUSH
|
||||
c-type heap-size PUSH
|
||||
! Push destination address
|
||||
ECX PUSH
|
||||
! Copy the struct from the C stack
|
||||
|
@ -136,9 +125,9 @@ M: x86.32 %box-large-struct ( n c-type -- )
|
|||
|
||||
M: x86.32 %prepare-box-struct ( size -- )
|
||||
! Compute target address for value struct return
|
||||
EAX ESP rot f struct-return@ [+] LEA
|
||||
EAX swap f struct-return@ LEA
|
||||
! Store it as the first parameter
|
||||
ESP [] EAX MOV ;
|
||||
0 stack@ EAX MOV ;
|
||||
|
||||
M: x86.32 %box-small-struct ( c-type -- )
|
||||
#! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
|
||||
|
@ -207,13 +196,12 @@ M: x86 %unbox-small-struct ( size -- )
|
|||
} case ;
|
||||
|
||||
M: x86.32 %unbox-large-struct ( n c-type -- )
|
||||
#! Alien must be in EAX.
|
||||
heap-size
|
||||
! Alien must be in EAX.
|
||||
! Compute destination address
|
||||
ECX ESP roll [+] LEA
|
||||
ECX rot stack@ LEA
|
||||
12 [
|
||||
! Push struct size
|
||||
PUSH
|
||||
heap-size PUSH
|
||||
! Push destination address
|
||||
ECX PUSH
|
||||
! Push source address
|
||||
|
@ -224,10 +212,10 @@ M: x86.32 %unbox-large-struct ( n c-type -- )
|
|||
|
||||
M: x86.32 %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
cell temp@ EAX MOV ;
|
||||
EBP EAX MOV ;
|
||||
|
||||
M: x86.32 %alien-indirect ( -- )
|
||||
cell temp@ CALL ;
|
||||
EBP CALL ;
|
||||
|
||||
M: x86.32 %alien-callback ( quot -- )
|
||||
4 [
|
||||
|
@ -239,7 +227,7 @@ M: x86.32 %alien-callback ( quot -- )
|
|||
M: x86.32 %callback-value ( ctype -- )
|
||||
! Align C stack
|
||||
ESP 12 SUB
|
||||
! Save top of data stack
|
||||
! Save top of data stack in non-volatile register
|
||||
%prepare-unbox
|
||||
EAX PUSH
|
||||
! Restore data/call/retain stacks
|
||||
|
|
|
@ -12,7 +12,6 @@ IN: cpu.x86.64
|
|||
M: x86.64 ds-reg R14 ;
|
||||
M: x86.64 rs-reg R15 ;
|
||||
M: x86.64 stack-reg RSP ;
|
||||
M: x86.64 stack-save-reg RSI ;
|
||||
M: x86.64 temp-reg-1 RAX ;
|
||||
M: x86.64 temp-reg-2 RCX ;
|
||||
|
||||
|
@ -46,7 +45,9 @@ M: stack-params %load-param-reg
|
|||
r> stack@ R11 MOV ;
|
||||
|
||||
M: stack-params %save-param-reg
|
||||
>r stack-frame* + cell + swap r> %load-param-reg ;
|
||||
drop
|
||||
R11 swap next-stack@ MOV
|
||||
stack@ R11 MOV ;
|
||||
|
||||
: with-return-regs ( quot -- )
|
||||
[
|
||||
|
@ -121,7 +122,7 @@ M: x86.64 %unbox-large-struct ( n c-type -- )
|
|||
! Source is in RDI
|
||||
heap-size
|
||||
! Load destination address
|
||||
RSI RSP roll [+] LEA
|
||||
RSI rot stack@ LEA
|
||||
! Load structure size
|
||||
RDX swap MOV
|
||||
! Copy the struct to the C stack
|
||||
|
@ -145,7 +146,7 @@ M: x86.64 %box-long-long ( n func -- )
|
|||
M: x86.64 struct-small-enough? ( size -- ? )
|
||||
heap-size 2 cells <= ;
|
||||
|
||||
: box-struct-field@ ( i -- operand ) RSP swap 1+ cells [+] ;
|
||||
: box-struct-field@ ( i -- operand ) 1+ cells stack@ ;
|
||||
|
||||
: %box-struct-field ( c-type i -- )
|
||||
box-struct-field@ swap reg-class>> {
|
||||
|
@ -164,21 +165,22 @@ M: x86.64 %box-small-struct ( c-type -- )
|
|||
] with-return-regs ;
|
||||
|
||||
: struct-return@ ( size n -- n )
|
||||
[ ] [ \ stack-frame get swap - ] ?if ;
|
||||
[ ] [ \ stack-frame get swap - ] ?if stack@ ;
|
||||
|
||||
M: x86.64 %box-large-struct ( n c-type -- )
|
||||
! Struct size is parameter 2
|
||||
heap-size
|
||||
RSI over MOV
|
||||
! Compute destination address
|
||||
swap struct-return@ RDI RSP rot [+] LEA
|
||||
RDI spin struct-return@ LEA
|
||||
! Copy the struct from the C stack
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
|
||||
M: x86.64 %prepare-box-struct ( size -- )
|
||||
! Compute target address for value struct return
|
||||
RAX RSP rot f struct-return@ [+] LEA
|
||||
RSP 0 [+] RAX MOV ;
|
||||
! Compute target address for value struct return, store it
|
||||
! as the first parameter
|
||||
RAX swap f struct-return@ LEA
|
||||
0 stack@ RAX MOV ;
|
||||
|
||||
M: x86.64 %prepare-var-args RAX RAX XOR ;
|
||||
|
||||
|
@ -192,10 +194,10 @@ M: x86.64 %alien-invoke
|
|||
|
||||
M: x86.64 %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
cell temp@ RAX MOV ;
|
||||
RBP RAX MOV ;
|
||||
|
||||
M: x86.64 %alien-indirect ( -- )
|
||||
cell temp@ CALL ;
|
||||
RBP CALL ;
|
||||
|
||||
M: x86.64 %alien-callback ( quot -- )
|
||||
RDI load-indirect "c_to_factor" f %alien-invoke ;
|
||||
|
@ -203,12 +205,14 @@ M: x86.64 %alien-callback ( quot -- )
|
|||
M: x86.64 %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
%prepare-unbox
|
||||
! Put former top of data stack in RDI
|
||||
cell temp@ RDI MOV
|
||||
! Save top of data stack
|
||||
RSP 8 SUB
|
||||
RDI PUSH
|
||||
! Restore data/call/retain stacks
|
||||
"unnest_stacks" f %alien-invoke
|
||||
! Put former top of data stack in RDI
|
||||
RDI cell temp@ MOV
|
||||
RDI POP
|
||||
RSP 8 ADD
|
||||
! Unbox former top of data stack to return registers
|
||||
unbox-return ;
|
||||
|
||||
|
|
|
@ -10,10 +10,16 @@ IN: cpu.x86.architecture
|
|||
HOOK: ds-reg cpu ( -- reg )
|
||||
HOOK: rs-reg cpu ( -- reg )
|
||||
HOOK: stack-reg cpu ( -- reg )
|
||||
HOOK: stack-save-reg cpu ( -- reg )
|
||||
|
||||
: stack@ ( n -- op ) stack-reg swap [+] ;
|
||||
|
||||
: next-stack@ ( n -- operand )
|
||||
#! nth parameter from the next stack frame. Used to box
|
||||
#! input values to callbacks; the callback has its own
|
||||
#! stack frame set up, and we want to read the frame
|
||||
#! set up by the caller.
|
||||
stack-frame* + cell + stack@ ;
|
||||
|
||||
: reg-stack ( n reg -- op ) swap cells neg [+] ;
|
||||
|
||||
M: ds-loc v>operand n>> ds-reg reg-stack ;
|
||||
|
@ -32,8 +38,8 @@ M: float-regs %save-param-reg >r >r stack@ r> r> MOVSS/D ;
|
|||
M: float-regs %load-param-reg >r swap stack@ r> MOVSS/D ;
|
||||
|
||||
GENERIC: push-return-reg ( reg-class -- )
|
||||
GENERIC: load-return-reg ( stack@ reg-class -- )
|
||||
GENERIC: store-return-reg ( stack@ reg-class -- )
|
||||
GENERIC: load-return-reg ( n reg-class -- )
|
||||
GENERIC: store-return-reg ( n reg-class -- )
|
||||
|
||||
! Only used by inline allocation
|
||||
HOOK: temp-reg-1 cpu ( -- reg )
|
||||
|
@ -137,8 +143,6 @@ M: x86 small-enough? ( n -- ? )
|
|||
|
||||
: %tag-fixnum ( reg -- ) tag-bits get SHL ;
|
||||
|
||||
: temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
|
||||
|
||||
M: x86 %return ( -- ) 0 %unwind ;
|
||||
|
||||
! Alien intrinsics
|
||||
|
|
Loading…
Reference in New Issue