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

More stack frame refactoring

db4
Slava Pestov 2008-10-06 00:20:00 -05:00
parent b0d57ead86
commit 33d775890c
7 changed files with 63 additions and 60 deletions
basis
compiler/generator
cpu

6
basis/compiler/generator/fixup/fixup.factor
View File

@ -13,7 +13,7 @@ TUPLE: frame-required n ;
: frame-required ( n -- ) \ frame-required boa , ;
: stack-frame-size ( code -- n )
: compute-stack-frame-size ( code -- n )
no-stack-frame [
dup frame-required? [ n>> max ] [ drop ] if
] reduce ;
@ -37,7 +37,7 @@ M: label fixup*
: if-stack-frame ( frame-size quot -- )
swap dup no-stack-frame =
[ 2drop ] [ stack-frame swap call ] if ; inline
[ 2drop ] [ stack-frame-size swap call ] if ; inline
M: word fixup*
{
@ -146,7 +146,7 @@ SYMBOL: literal-table
: fixup ( code -- literals relocation labels code )
[
init-fixup
dup stack-frame-size swap [ fixup* ] each drop
dup compute-stack-frame-size swap [ fixup* ] each drop
literal-table get >array
relocation-table get >byte-array

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

@ -299,18 +299,17 @@ M: #return-recursive generate-node
dup large-struct? [ heap-size ] [ drop 2 cells ] if ;
: alien-stack-frame ( params -- n )
alien-parameters parameter-sizes drop ;
stack-frame new
swap
[ return>> return-size >>return ]
[ alien-parameters parameter-sizes drop >>params ] bi
dup [ params>> ] [ return>> ] bi + >>size
dup size>> stack-frame-size >>total-size ;
: alien-invoke-frame ( params -- n )
[ return>> return-size ] [ alien-stack-frame ] bi + ;
: set-stack-frame ( n -- )
dup [ frame-required ] when* \ stack-frame set ;
: with-stack-frame ( n quot -- )
swap set-stack-frame
: with-stack-frame ( params quot -- )
swap alien-stack-frame [ size>> frame-required ] [ stack-frame set ] bi
call
f set-stack-frame ; inline
stack-frame off ; inline
GENERIC: reg-size ( register-class -- n )
@ -413,8 +412,8 @@ M: long-long-type flatten-value-type ( type -- types )
#! parameters. If the C function is returning a structure,
#! the first parameter is an implicit target area pointer,
#! so we need to use a different offset.
return>> dup large-struct?
[ heap-size %prepare-box-struct cell ] [ drop 0 ] if ;
return>> large-struct?
[ %prepare-box-struct cell ] [ 0 ] if ;
: objects>registers ( params -- )
#! Generate code for unboxing a list of C types, then
@ -473,7 +472,7 @@ M: no-such-symbol compiler-error-type
M: #alien-invoke generate-node
params>>
dup alien-invoke-frame [
dup [
end-basic-block
%prepare-alien-invoke
dup objects>registers
@ -487,7 +486,7 @@ M: #alien-invoke generate-node
! #alien-indirect
M: #alien-indirect generate-node
params>>
dup alien-invoke-frame [
dup [
! Flush registers
end-basic-block
! Save registers for GC
@ -553,7 +552,7 @@ TUPLE: callback-context ;
: callback-unwind ( params -- n )
{
{ [ dup abi>> "stdcall" = ] [ alien-stack-frame ] }
{ [ dup abi>> "stdcall" = ] [ drop stack-frame get params>> ] }
{ [ dup return>> large-struct? ] [ drop 4 ] }
[ drop 0 ]
} cond ;
@ -569,7 +568,7 @@ TUPLE: callback-context ;
dup xt>> dup [
init-templates
%prologue-later
dup alien-stack-frame [
dup [
[ registers>objects ]
[ wrap-callback-quot %alien-callback ]
[ %callback-return ]

13
basis/cpu/architecture/architecture.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel kernel.private math memory
namespaces make sequences layouts system hashtables classes
alien byte-arrays combinators words sets ;
USING: accessors arrays generic kernel kernel.private math
memory namespaces make sequences layouts system hashtables
classes alien byte-arrays combinators words sets ;
IN: cpu.architecture
! Register classes
@ -33,10 +33,9 @@ GENERIC# load-literal 1 ( obj vreg -- )
HOOK: load-indirect cpu ( obj reg -- )
HOOK: stack-frame cpu ( frame-size -- n )
HOOK: stack-frame-size cpu ( frame-size -- n )
: stack-frame* ( -- n )
\ stack-frame get stack-frame ;
TUPLE: stack-frame total-size size params return ;
! Set up caller stack frame
HOOK: %prologue cpu ( n -- )
@ -117,7 +116,7 @@ HOOK: %box cpu ( n reg-class func -- )
HOOK: %box-long-long cpu ( n func -- )
HOOK: %prepare-box-struct cpu ( size -- )
HOOK: %prepare-box-struct cpu ( -- )
HOOK: %box-small-struct cpu ( c-type -- )

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

@ -43,8 +43,8 @@ IN: cpu.ppc.architecture
: xt-save ( n -- i ) 2 cells - ;
M: ppc stack-frame ( n -- i )
local@ factor-area-size + cell + 4 cells align ;
M: ppc stack-frame-size ( n -- i )
local@ factor-area-size + 4 cells align ;
M: temp-reg v>operand drop 11 ;
@ -166,7 +166,7 @@ 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* + ;
: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
M: stack-params %save-param-reg ( stack reg reg-class -- )
#! Funky. Read the parameter from the caller's stack frame.
@ -218,20 +218,18 @@ M: ppc %box-long-long ( n func -- )
4 1 rot cell + local@ LWZ
] when* r> f %alien-invoke ;
: struct-return@ ( size n -- n )
[ local@ ] [ stack-frame* factor-area-size - swap - ] ?if ;
: struct-return@ ( n -- n )
[ stack-frame get params>> ] unless* local@ ;
M: ppc %prepare-box-struct ( size -- )
M: ppc %prepare-box-struct ( -- )
#! Compute target address for value struct return
3 1 rot f struct-return@ ADDI
3 1 f struct-return@ ADDI
3 1 0 local@ STW ;
M: ppc %box-large-struct ( n c-type -- )
#! If n = f, then we're boxing a returned struct
heap-size
[ swap struct-return@ ] keep
! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size
[ 3 1 rot ADDI ] [ 4 LI ] bi*
[ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi*
! Call the function
"box_value_struct" f %alien-invoke ;

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

@ -30,8 +30,8 @@ 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 ;
: struct-return@ ( n -- operand )
[ next-stack@ ] [ stack-frame get params>> stack@ ] if* ;
! On x86, parameters are never passed in registers.
M: int-regs return-reg drop EAX ;
@ -63,10 +63,10 @@ M: float-regs store-return-reg
[ stack@ ] [ reg-size ] bi* FSTP ;
: align-sub ( n -- )
dup 16 align swap - ESP swap SUB ;
[ align-stack ] keep - decr-stack-reg ;
: align-add ( n -- )
16 align ESP swap ADD ;
align-stack incr-stack-reg ;
: with-aligned-stack ( n quot -- )
[ [ align-sub ] [ call ] bi* ]
@ -113,7 +113,7 @@ M: x86.32 %box-long-long ( n func -- )
M:: x86.32 %box-large-struct ( n c-type -- )
! Compute destination address
ECX c-type heap-size n struct-return@ LEA
ECX n struct-return@ LEA
8 [
! Push struct size
c-type heap-size PUSH
@ -123,9 +123,9 @@ M:: x86.32 %box-large-struct ( n c-type -- )
"box_value_struct" f %alien-invoke
] with-aligned-stack ;
M: x86.32 %prepare-box-struct ( size -- )
M: x86.32 %prepare-box-struct ( -- )
! Compute target address for value struct return
EAX swap f struct-return@ LEA
EAX f struct-return@ LEA
! Store it as the first parameter
0 stack@ EAX MOV ;
@ -248,7 +248,7 @@ M: x86.32 %cleanup ( alien-node -- )
{
{
[ dup abi>> "stdcall" = ]
[ alien-stack-frame ESP swap SUB ]
[ drop ESP stack-frame get params>> SUB ]
} {
[ dup return>> large-struct? ]
[ drop EAX PUSH ]

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

@ -164,22 +164,21 @@ M: x86.64 %box-small-struct ( c-type -- )
"box_small_struct" f %alien-invoke
] with-return-regs ;
: struct-return@ ( size n -- n )
[ ] [ \ stack-frame get swap - ] ?if stack@ ;
: struct-return@ ( n -- operand )
[ stack-frame get params>> ] unless* stack@ ;
M: x86.64 %box-large-struct ( n c-type -- )
! Struct size is parameter 2
heap-size
RSI over MOV
RSI swap heap-size MOV
! Compute destination address
RDI spin struct-return@ LEA
RDI swap 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, store it
! as the first parameter
RAX swap f struct-return@ LEA
M: x86.64 %prepare-box-struct ( -- )
! Compute target address for value struct return
RAX f struct-return@ LEA
! Store it as the first parameter
0 stack@ RAX MOV ;
M: x86.64 %prepare-var-args RAX RAX XOR ;

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

@ -18,7 +18,7 @@ HOOK: stack-reg cpu ( -- reg )
#! 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* + stack@ ;
stack-frame get total-size>> + stack@ ;
: reg-stack ( n reg -- op ) swap cells neg [+] ;
@ -51,19 +51,27 @@ HOOK: prepare-division cpu ( -- )
M: immediate load-literal v>operand swap v>operand MOV ;
M: x86 stack-frame ( n -- i )
3 cells + 16 align ;
: align-stack ( n -- n' )
os macosx? [ 16 align ] when ;
M: x86 stack-frame-size ( n -- i )
3 cells + align-stack ;
M: x86 %save-word-xt ( -- )
temp-reg v>operand 0 MOV rc-absolute-cell rel-this ;
: decr-stack-reg ( n -- )
dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
M: x86 %prologue ( n -- )
dup PUSH
temp-reg v>operand PUSH
stack-reg swap 3 cells - SUB ;
3 cells - decr-stack-reg ;
M: x86 %epilogue ( n -- )
stack-reg swap cell - ADD ;
: incr-stack-reg ( n -- )
dup 0 = [ ] [ stack-reg swap ADD ] if ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
HOOK: %alien-global cpu ( symbol dll register -- )