Working on stack frame cleanup

basis/compiler/generator/generator.factor

@@ -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,
+    [ return>> return-size ] [ alien-stack-frame ] bi + ;
-    #! small struct return value unpacking
-    [ return>> return-size ] [ alien-stack-frame ] bi
-    + 2 cells + ;
 
 : set-stack-frame ( n -- )
     dup [ frame-required ] when* \ stack-frame set ;

basis/cpu/ppc/architecture/architecture.factor

@@ -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
+    ! Compute destination address and load struct size
-    4 1 roll local@ ADDI
+    [ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi*
-    ! Load struct size
-    heap-size 5 LI
     ! 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@ ] [ stack-frame* factor-area-size - swap - ] ?if ;
-: struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?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
+    ! Compute destination address and load struct size
-    3 1 roll ADDI
+    [ 3 1 rot ADDI ] [ 4 LI ] bi*
-    ! Load struct size
-    4 LI
     ! 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

basis/cpu/x86/32/32.factor

@@ -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
+stack-checker.known-words compiler.generator.registers
-compiler.generator.registers compiler.generator.fixup
+compiler.generator.fixup compiler.generator system layouts
-compiler.generator system layouts combinators
+combinators command-line compiler compiler.units io
-command-line compiler compiler.units io vocabs.loader accessors
+vocabs.loader accessors init ;
-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
-M: int-regs load-return-reg load/store-int-return MOV ;
+    return-reg swap next-stack@ MOV ;
-M: int-regs store-return-reg load/store-int-return swap 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 )
+M: float-regs load-return-reg
-    [ stack@ ] [ reg-size ] bi* ;
+    [ next-stack@ ] [ reg-size ] bi* FLD ;
-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 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
+    over [ load-return-reg ] [ 2drop ] if ;
-    push-return-reg ;
 
-M: x86.32 %box ( n reg-class func -- )
+M:: x86.32 %box ( n reg-class func -- )
-    over reg-size [
+    n reg-class (%box)
-        >r (%box) r> f %alien-invoke
+    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 next-stack@ MOV
-        EDX over stack@ MOV
+        EAX swap cell - next-stack@ MOV 
-        EAX swap cell - stack@ MOV 
+    ] when* ;
-    ] when*
-    EDX PUSH
-    EAX PUSH ;
 
 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 )
+M:: x86.32 %box-large-struct ( n c-type -- )
-    [ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ;
-
-M: x86.32 %box-large-struct ( n c-type -- )
     ! Compute destination address
-    heap-size
+    ECX c-type heap-size n struct-return@ LEA
-    [ swap struct-return@ ] keep
-    ECX ESP roll [+] 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.
+    ! Alien must be in EAX.
-    heap-size
     ! 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

basis/cpu/x86/64/64.factor

@@ -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
+    ! Compute target address for value struct return, store it
-    RAX RSP rot f struct-return@ [+] LEA
+    ! as the first parameter
-    RSP 0 [+] RAX MOV ;
+    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
+    ! Save top of data stack
-    cell temp@ RDI MOV
+    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 ;
 

basis/cpu/x86/architecture/architecture.factor

@@ -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: load-return-reg ( n reg-class -- )
-GENERIC: store-return-reg ( stack@ 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