diff --git a/basis/compiler/generator/fixup/fixup.factor b/basis/compiler/generator/fixup/fixup.factor index ecc88a7a5e..e8bdc561b7 100644 --- a/basis/compiler/generator/fixup/fixup.factor +++ b/basis/compiler/generator/fixup/fixup.factor @@ -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 diff --git a/basis/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor index 2b398eaeea..22de9d3587 100644 --- a/basis/compiler/generator/generator.factor +++ b/basis/compiler/generator/generator.factor @@ -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 ] diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 63c52d1025..f22d4a2a90 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -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 -- ) diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor index aab104fa6e..357349193e 100644 --- a/basis/cpu/ppc/architecture/architecture.factor +++ b/basis/cpu/ppc/architecture/architecture.factor @@ -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 ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 1173b9e68e..dc891a8178 100644 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -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 ] diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 8c9762630b..5bcd733eaa 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -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 ; diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index ea54ef85af..d10397de3b 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -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 -- )