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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,7 +13,7 @@ TUPLE: frame-required n ;
: frame-required ( n -- ) \ frame-required boa , ; : frame-required ( n -- ) \ frame-required boa , ;
: stack-frame-size ( code -- n ) : compute-stack-frame-size ( code -- n )
no-stack-frame [ no-stack-frame [
dup frame-required? [ n>> max ] [ drop ] if dup frame-required? [ n>> max ] [ drop ] if
] reduce ; ] reduce ;
@ -37,7 +37,7 @@ M: label fixup*
: if-stack-frame ( frame-size quot -- ) : if-stack-frame ( frame-size quot -- )
swap dup no-stack-frame = swap dup no-stack-frame =
[ 2drop ] [ stack-frame swap call ] if ; inline [ 2drop ] [ stack-frame-size swap call ] if ; inline
M: word fixup* M: word fixup*
{ {
@ -146,7 +146,7 @@ SYMBOL: literal-table
: fixup ( code -- literals relocation labels code ) : fixup ( code -- literals relocation labels code )
[ [
init-fixup init-fixup
dup stack-frame-size swap [ fixup* ] each drop dup compute-stack-frame-size swap [ fixup* ] each drop
literal-table get >array literal-table get >array
relocation-table get >byte-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 ; dup large-struct? [ heap-size ] [ drop 2 cells ] if ;
: alien-stack-frame ( params -- n ) : 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 ) : with-stack-frame ( params quot -- )
[ return>> return-size ] [ alien-stack-frame ] bi + ; swap alien-stack-frame [ size>> frame-required ] [ stack-frame set ] bi
: set-stack-frame ( n -- )
dup [ frame-required ] when* \ stack-frame set ;
: with-stack-frame ( n quot -- )
swap set-stack-frame
call call
f set-stack-frame ; inline stack-frame off ; inline
GENERIC: reg-size ( register-class -- n ) 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, #! parameters. If the C function is returning a structure,
#! the first parameter is an implicit target area pointer, #! the first parameter is an implicit target area pointer,
#! so we need to use a different offset. #! so we need to use a different offset.
return>> dup large-struct? return>> large-struct?
[ heap-size %prepare-box-struct cell ] [ drop 0 ] if ; [ %prepare-box-struct cell ] [ 0 ] if ;
: objects>registers ( params -- ) : objects>registers ( params -- )
#! Generate code for unboxing a list of C types, then #! 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 M: #alien-invoke generate-node
params>> params>>
dup alien-invoke-frame [ dup [
end-basic-block end-basic-block
%prepare-alien-invoke %prepare-alien-invoke
dup objects>registers dup objects>registers
@ -487,7 +486,7 @@ M: #alien-invoke generate-node
! #alien-indirect ! #alien-indirect
M: #alien-indirect generate-node M: #alien-indirect generate-node
params>> params>>
dup alien-invoke-frame [ dup [
! Flush registers ! Flush registers
end-basic-block end-basic-block
! Save registers for GC ! Save registers for GC
@ -553,7 +552,7 @@ TUPLE: callback-context ;
: callback-unwind ( params -- n ) : callback-unwind ( params -- n )
{ {
{ [ dup abi>> "stdcall" = ] [ alien-stack-frame ] } { [ dup abi>> "stdcall" = ] [ drop stack-frame get params>> ] }
{ [ dup return>> large-struct? ] [ drop 4 ] } { [ dup return>> large-struct? ] [ drop 4 ] }
[ drop 0 ] [ drop 0 ]
} cond ; } cond ;
@ -569,7 +568,7 @@ TUPLE: callback-context ;
dup xt>> dup [ dup xt>> dup [
init-templates init-templates
%prologue-later %prologue-later
dup alien-stack-frame [ dup [
[ registers>objects ] [ registers>objects ]
[ wrap-callback-quot %alien-callback ] [ wrap-callback-quot %alien-callback ]
[ %callback-return ] [ %callback-return ]

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

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel kernel.private math memory USING: accessors arrays generic kernel kernel.private math
namespaces make sequences layouts system hashtables classes memory namespaces make sequences layouts system hashtables
alien byte-arrays combinators words sets ; classes alien byte-arrays combinators words sets ;
IN: cpu.architecture IN: cpu.architecture
! Register classes ! Register classes
@ -33,10 +33,9 @@ GENERIC# load-literal 1 ( obj vreg -- )
HOOK: load-indirect cpu ( obj reg -- ) HOOK: load-indirect cpu ( obj reg -- )
HOOK: stack-frame cpu ( frame-size -- n ) HOOK: stack-frame-size cpu ( frame-size -- n )
: stack-frame* ( -- n ) TUPLE: stack-frame total-size size params return ;
\ stack-frame get stack-frame ;
! Set up caller stack frame ! Set up caller stack frame
HOOK: %prologue cpu ( n -- ) HOOK: %prologue cpu ( n -- )
@ -117,7 +116,7 @@ HOOK: %box cpu ( n reg-class func -- )
HOOK: %box-long-long cpu ( n 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 -- ) 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 - ; : xt-save ( n -- i ) 2 cells - ;
M: ppc stack-frame ( n -- i ) M: ppc stack-frame-size ( n -- i )
local@ factor-area-size + cell + 4 cells align ; local@ factor-area-size + 4 cells align ;
M: temp-reg v>operand drop 11 ; 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 -- ) M: stack-params %load-param-reg ( stack reg reg-class -- )
drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ; 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 -- ) M: stack-params %save-param-reg ( stack reg reg-class -- )
#! Funky. Read the parameter from the caller's stack frame. #! 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 4 1 rot cell + local@ LWZ
] when* r> f %alien-invoke ; ] when* r> f %alien-invoke ;
: struct-return@ ( size n -- n ) : struct-return@ ( n -- n )
[ local@ ] [ stack-frame* factor-area-size - swap - ] ?if ; [ stack-frame get params>> ] unless* local@ ;
M: ppc %prepare-box-struct ( size -- ) M: ppc %prepare-box-struct ( -- )
#! Compute target address for value struct return #! 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 ; 3 1 0 local@ STW ;
M: ppc %box-large-struct ( n c-type -- ) M: ppc %box-large-struct ( n c-type -- )
#! If n = f, then we're boxing a returned struct ! If n = f, then we're boxing a returned struct
heap-size
[ swap struct-return@ ] keep
! Compute destination address and load struct size ! 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 ! Call the function
"box_value_struct" f %alien-invoke ; "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? heap-size { 1 2 4 8 } member?
os { linux netbsd solaris } member? not and ; os { linux netbsd solaris } member? not and ;
: struct-return@ ( size n -- operand ) : struct-return@ ( n -- operand )
[ next-stack@ ] [ \ stack-frame get swap - stack@ ] ?if ; [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ;
! On x86, parameters are never passed in registers. ! On x86, parameters are never passed in registers.
M: int-regs return-reg drop EAX ; M: int-regs return-reg drop EAX ;
@ -63,10 +63,10 @@ M: float-regs store-return-reg
[ stack@ ] [ reg-size ] bi* FSTP ; [ stack@ ] [ reg-size ] bi* FSTP ;
: align-sub ( n -- ) : align-sub ( n -- )
dup 16 align swap - ESP swap SUB ; [ align-stack ] keep - decr-stack-reg ;
: align-add ( n -- ) : align-add ( n -- )
16 align ESP swap ADD ; align-stack incr-stack-reg ;
: with-aligned-stack ( n quot -- ) : with-aligned-stack ( n quot -- )
[ [ align-sub ] [ call ] bi* ] [ [ 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 -- ) M:: x86.32 %box-large-struct ( n c-type -- )
! Compute destination address ! Compute destination address
ECX c-type heap-size n struct-return@ LEA ECX n struct-return@ LEA
8 [ 8 [
! Push struct size ! Push struct size
c-type heap-size PUSH c-type heap-size PUSH
@ -123,9 +123,9 @@ M:: x86.32 %box-large-struct ( n c-type -- )
"box_value_struct" f %alien-invoke "box_value_struct" f %alien-invoke
] with-aligned-stack ; ] with-aligned-stack ;
M: x86.32 %prepare-box-struct ( size -- ) M: x86.32 %prepare-box-struct ( -- )
! Compute target address for value struct return ! Compute target address for value struct return
EAX swap f struct-return@ LEA EAX f struct-return@ LEA
! Store it as the first parameter ! Store it as the first parameter
0 stack@ EAX MOV ; 0 stack@ EAX MOV ;
@ -248,7 +248,7 @@ M: x86.32 %cleanup ( alien-node -- )
{ {
{ {
[ dup abi>> "stdcall" = ] [ dup abi>> "stdcall" = ]
[ alien-stack-frame ESP swap SUB ] [ drop ESP stack-frame get params>> SUB ]
} { } {
[ dup return>> large-struct? ] [ dup return>> large-struct? ]
[ drop EAX PUSH ] [ 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 "box_small_struct" f %alien-invoke
] with-return-regs ; ] with-return-regs ;
: struct-return@ ( size n -- n ) : struct-return@ ( n -- operand )
[ ] [ \ stack-frame get swap - ] ?if stack@ ; [ stack-frame get params>> ] unless* stack@ ;
M: x86.64 %box-large-struct ( n c-type -- ) M: x86.64 %box-large-struct ( n c-type -- )
! Struct size is parameter 2 ! Struct size is parameter 2
heap-size RSI swap heap-size MOV
RSI over MOV
! Compute destination address ! Compute destination address
RDI spin struct-return@ LEA RDI swap struct-return@ LEA
! Copy the struct from the C stack ! Copy the struct from the C stack
"box_value_struct" f %alien-invoke ; "box_value_struct" f %alien-invoke ;
M: x86.64 %prepare-box-struct ( size -- ) M: x86.64 %prepare-box-struct ( -- )
! Compute target address for value struct return, store it ! Compute target address for value struct return
! as the first parameter RAX f struct-return@ LEA
RAX swap f struct-return@ LEA ! Store it as the first parameter
0 stack@ RAX MOV ; 0 stack@ RAX MOV ;
M: x86.64 %prepare-var-args RAX RAX XOR ; 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 #! input values to callbacks; the callback has its own
#! stack frame set up, and we want to read the frame #! stack frame set up, and we want to read the frame
#! set up by the caller. #! set up by the caller.
stack-frame* + stack@ ; stack-frame get total-size>> + stack@ ;
: reg-stack ( n reg -- op ) swap cells neg [+] ; : 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: immediate load-literal v>operand swap v>operand MOV ;
M: x86 stack-frame ( n -- i ) : align-stack ( n -- n' )
3 cells + 16 align ; os macosx? [ 16 align ] when ;
M: x86 stack-frame-size ( n -- i )
3 cells + align-stack ;
M: x86 %save-word-xt ( -- ) M: x86 %save-word-xt ( -- )
temp-reg v>operand 0 MOV rc-absolute-cell rel-this ; 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 -- ) M: x86 %prologue ( n -- )
dup PUSH dup PUSH
temp-reg v>operand PUSH temp-reg v>operand PUSH
stack-reg swap 3 cells - SUB ; 3 cells - decr-stack-reg ;
M: x86 %epilogue ( n -- ) : incr-stack-reg ( n -- )
stack-reg swap cell - ADD ; dup 0 = [ ] [ stack-reg swap ADD ] if ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
HOOK: %alien-global cpu ( symbol dll register -- ) HOOK: %alien-global cpu ( symbol dll register -- )