compiler: FFI is now slightly more efficient when unboxing parameters, only changes data stack height once

basis/compiler/alien/alien.factor

@@ -20,8 +20,7 @@ IN: compiler.alien
 : parameter-align ( n type -- n delta )
     [ c-type-stack-align align dup ] [ drop ] 2bi - ;
 
-: parameter-sizes ( types -- total offsets )
+: parameter-offsets ( types -- total offsets )
-    #! Compute stack frame locations.
     [
         0 [
             [ parameter-align drop dup , ] keep stack-size +

basis/compiler/cfg/builder/builder.factor

@@ -212,7 +212,7 @@ M: #terminate emit-node drop ##no-tco end-basic-block ;
     stack-frame new
         swap
         [ return>> return-size >>return ]
-        [ alien-parameters parameter-sizes drop >>params ] bi ;
+        [ alien-parameters parameter-offsets drop >>params ] bi ;
 
 : alien-node-height ( params -- )
     [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;

basis/compiler/codegen/codegen.factor

@@ -355,10 +355,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
     ] { } make ;
 
 : each-parameter ( parameters quot -- )
-    [ [ parameter-sizes nip ] keep ] dip 2each ; inline
+    [ [ parameter-offsets nip ] keep ] dip 2each ; inline
-
-: reverse-each-parameter ( parameters quot -- )
-    [ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline
 
 : reset-fastcall-counts ( -- )
     { int-regs float-regs stack-params } [ 0 swap set ] each ;
@@ -375,10 +372,17 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
     [ '[ alloc-parameter _ execute ] ]
     bi* each-parameter ; inline
 
+: reverse-each-parameter ( parameters quot -- )
+    [ [ parameter-offsets nip ] keep ] dip 2reverse-each ; inline
+
+: prepare-unbox-parameters ( parameters -- offsets types indices )
+    [ parameter-offsets nip ] [ ] [ length iota reverse ] tri ;
+
 : unbox-parameters ( offset node -- )
-    parameters>> [
+    parameters>> swap
-        %prepare-unbox [ over + ] dip unbox-parameter
+    '[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ]
-    ] reverse-each-parameter drop ;
+    [ length neg %inc-d ]
+    bi ;
 
 : prepare-box-struct ( node -- offset )
     #! Return offset on C stack where to store unboxed
@@ -410,7 +414,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
     ] if ;
 
 : stdcall-mangle ( symbol params -- symbol )
-    parameters>> parameter-sizes drop number>string "@" glue ;
+    parameters>> parameter-offsets drop number>string "@" glue ;
 
 : alien-invoke-dlsym ( params -- symbols dll )
     [ [ function>> dup ] keep stdcall-mangle 2array ]

basis/cpu/architecture/architecture.factor

@@ -463,7 +463,7 @@ HOOK: dummy-int-params? cpu ( -- ? )
 ! If t, all int parameters are shadowed by dummy FP parameters
 HOOK: dummy-fp-params? cpu ( -- ? )
 
-HOOK: %prepare-unbox cpu ( -- )
+HOOK: %prepare-unbox cpu ( n -- )
 
 HOOK: %unbox cpu ( n rep func -- )
 

basis/cpu/ppc/ppc.factor

@@ -577,10 +577,8 @@ M:: ppc %save-param-reg ( stack reg rep -- )
 M:: ppc %load-param-reg ( stack reg rep -- )
     reg stack local@ rep load-from-frame ;
 
-M: ppc %prepare-unbox ( -- )
+M: ppc %prepare-unbox ( n -- )
-    ! First parameter is top of stack
+    [ 3 ] dip <ds-loc> loc>operand LWZ ;
-    3 ds-reg 0 LWZ
-    ds-reg dup cell SUBI ;
 
 M: ppc %unbox ( n rep func -- )
     ! Value must be in r3

basis/cpu/x86/32/32.factor

@@ -151,9 +151,7 @@ M: x86.32 %box-small-struct ( c-type -- )
     "box_small_struct" f %alien-invoke ;
 
 M: x86.32 %prepare-unbox ( -- )
-    #! Move top of data stack to EAX.
+    EAX swap ds-reg reg-stack MOV ;
-    EAX ESI [] MOV
-    ESI 4 SUB ;
 
 : call-unbox-func ( func -- )
     4 save-vm-ptr
@@ -238,8 +236,7 @@ M: x86.32 %alien-callback ( quot -- )
     "c_to_factor" f %alien-invoke ;
 
 M: x86.32 %callback-value ( ctype -- )
-    ! Save top of data stack in non-volatile register
+    0 %prepare-unbox
-    %prepare-unbox
     4 stack@ EAX MOV
     0 save-vm-ptr
     ! Restore data/call/retain stacks

basis/cpu/x86/64/64.factor

@@ -84,10 +84,8 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ;
         call
     ] with-scope ; inline
 
-M: x86.64 %prepare-unbox ( -- )
+M: x86.64 %prepare-unbox ( n -- )
-    ! First parameter is top of stack
+    param-reg-1 swap ds-reg reg-stack MOV ;
-    param-reg-1 R14 [] MOV
-    R14 cell SUB ;
 
 M:: x86.64 %unbox ( n rep func -- )
     param-reg-2 %mov-vm-ptr
@@ -217,9 +215,7 @@ M: x86.64 %alien-callback ( quot -- )
     "c_to_factor" f %alien-invoke ;
 
 M: x86.64 %callback-value ( ctype -- )
-    ! Save top of data stack
+    0 %prepare-unbox
-    %prepare-unbox
-    ! Save top of data stack
     RSP 8 SUB
     param-reg-1 PUSH
     param-reg-1 %mov-vm-ptr