steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Working on stack frame cleanup

db4
Slava Pestov 2008-10-05 21:30:29 -05:00
parent 46c3f0def1
commit d5112a0ced
5 changed files with 88 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/compiler/generator/generator.factor
View File

@ -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 ;

27
basis/cpu/ppc/architecture/architecture.factor
View File

@ -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

106
basis/cpu/x86/32/32.factor
View File

@ -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

32
basis/cpu/x86/64/64.factor
View File

@ -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 ;

14
basis/cpu/x86/architecture/architecture.factor
View File

@ -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