FFI rewrite part 2: use ##peek and ##replace instructions to access stack

basis/compiler/cfg/builder/alien/alien.factor

@@ -7,7 +7,8 @@ namespaces kernel strings libc quotations cpu.architecture
 compiler.alien compiler.utilities compiler.tree compiler.cfg
 compiler.cfg.builder compiler.cfg.builder.blocks
 compiler.cfg.instructions compiler.cfg.stack-frame
-compiler.cfg.stacks ;
+compiler.cfg.stacks compiler.cfg.registers
+compiler.cfg.hats ;
 FROM: compiler.errors => no-such-symbol no-such-library ;
 IN: compiler.cfg.builder.alien
 
@@ -78,9 +79,9 @@ M: reg-class reg-class-full?
     [ [ parameter-offsets ] keep ] dip 2reverse-each ; inline
 
 : prepare-unbox-parameters ( parameters -- offsets types indices )
-    [ parameter-offsets ] [ ] [ length iota <reversed> ] tri ;
+    [ length iota <reversed> ] [ parameter-offsets ] [ ] tri ;
 
-GENERIC: unbox-parameter ( n c-type -- )
+GENERIC: unbox-parameter ( src n c-type -- )
 
 M: c-type unbox-parameter
     [ rep>> ] [ unboxer>> ] bi ##unbox ;
@@ -95,7 +96,10 @@ M: struct-c-type unbox-parameter
     parameters>> swap
     '[
         prepare-unbox-parameters
-        [ ##pop-stack [ _ + ] dip base-type unbox-parameter ] 3each
+        [
+            [ <ds-loc> ^^peek ] [ _ + ] [ base-type ] tri*
+            unbox-parameter
+        ] 3each
     ]
     [ length neg ##inc-d ]
     bi ;
@@ -118,19 +122,19 @@ M: struct-c-type unbox-parameter
         \ ##load-param-reg move-parameters
     ] with-param-regs ;
 
-GENERIC: box-return ( c-type -- )
+GENERIC: box-return ( c-type -- dst )
 
 M: c-type box-return
-    [ f ] dip [ rep>> ] [ boxer>> ] bi ##box ;
+    [ f ] dip [ rep>> ] [ boxer>> ] bi ^^box ;
 
 M: long-long-type box-return
-    [ f ] dip boxer>> ##box-long-long ;
+    [ f ] dip boxer>> ^^box-long-long ;
 
 M: struct-c-type box-return
-    [ ##box-small-struct ] [ ##box-large-struct ] if-small-struct ;
+    [ ^^box-small-struct ] [ ^^box-large-struct ] if-small-struct ;
 
 : box-return* ( node -- )
-    return>> [ ] [ base-type box-return ##push-stack ] if-void ;
+    return>> [ ] [ base-type box-return 1 ##inc-d D 0 ##replace ] if-void ;
 
 GENERIC# dlsym-valid? 1 ( symbols dll -- ? )
 
@@ -200,41 +204,37 @@ M: #alien-invoke emit-node
 
 M: #alien-indirect emit-node
     [
-        ! Save alien at top of stack to temporary storage
+        D 0 ^^peek -1 ##inc-d ^^unbox-any-c-ptr
-        ##prepare-alien-indirect
+        {
-        ! Unbox parameters
+            [ drop objects>registers ]
-        dup objects>registers
+            [ nip ##alien-indirect ]
-        ! Call alien in temporary storage
+            [ drop ##cleanup ]
-        ##alien-indirect
+            [ drop box-return* ]
-        ! Box return value
+        } 2cleave
-        dup ##cleanup
-        box-return*
     ] emit-alien-node ;
 
 M: #alien-assembly emit-node
     [
-        ! Unbox parameters
+        [ objects>registers ]
-        dup objects>registers
+        [ quot>> ##alien-assembly ]
-        ! Generate assembly
+        [ box-return* ]
-        dup quot>> ##alien-assembly
+        tri
-        ! Box return value
-        box-return*
     ] emit-alien-node ;
 
-GENERIC: box-parameter ( n c-type -- )
+GENERIC: box-parameter ( n c-type -- dst )
 
 M: c-type box-parameter
-    [ rep>> ] [ boxer>> ] bi ##box ;
+    [ rep>> ] [ boxer>> ] bi ^^box ;
 
 M: long-long-type box-parameter
-    boxer>> ##box-long-long ;
+    boxer>> ^^box-long-long ;
 
 M: struct-c-type box-parameter
-    [ ##box-large-struct ] [ base-type box-parameter ] if-value-struct ;
+    [ ^^box-large-struct ] [ base-type box-parameter ] if-value-struct ;
 
 : box-parameters ( params -- )
     alien-parameters
-    [ base-type box-parameter ##push-context-stack ] each-parameter ;
+    [ base-type box-parameter next-vreg ##push-context-stack ] each-parameter ;
 
 : registers>objects ( node -- )
     ! Generate code for boxing input parameters in a callback.
@@ -260,7 +260,7 @@ M: struct-c-type box-parameter
      '[ _ _ do-callback ]
      >quotation ;
 
-GENERIC: unbox-return ( c-type -- )
+GENERIC: unbox-return ( src c-type -- )
 
 M: c-type unbox-return
     [ f ] dip [ rep>> ] [ unboxer>> ] bi ##unbox ;
@@ -280,10 +280,8 @@ M: #alien-callback emit-node
             [ wrap-callback-quot ##alien-callback ]
             [
                 alien-return [ ##end-callback ] [
-                    ##pop-context-stack
+                    [ ^^pop-context-stack ] dip
-                    ##to-nv
                     ##end-callback
-                    ##from-nv
                     base-type unbox-return
                 ] if-void
             ] tri

basis/compiler/cfg/instructions/instructions.factor

@@ -613,55 +613,61 @@ INSN: ##stack-frame
 literal: stack-frame ;
 
 INSN: ##box
+def: dst/tagged-rep
 literal: n rep boxer ;
 
 INSN: ##box-long-long
+def: dst/tagged-rep
 literal: n boxer ;
 
 INSN: ##box-small-struct
+def: dst/tagged-rep
 literal: c-type ;
 
 INSN: ##box-large-struct
+def: dst/tagged-rep
 literal: n c-type ;
 
 INSN: ##unbox
+use: src/tagged-rep
 literal: n rep unboxer ;
 
 INSN: ##unbox-long-long
+use: src/tagged-rep
 literal: n unboxer ;
 
 INSN: ##unbox-large-struct
+use: src/tagged-rep
 literal: n c-type ;
 
 INSN: ##unbox-small-struct
+use: src/tagged-rep
 literal: c-type ;
 
-INSN: ##pop-stack
+INSN: ##pop-context-stack
-literal: n ;
+def: dst/tagged-rep
-
+temp: temp/int-rep ;
-INSN: ##pop-context-stack ;
 
 INSN: ##prepare-box-struct ;
 
 INSN: ##load-param-reg
 literal: offset reg rep ;
 
-INSN: ##push-stack ;
-
 INSN: ##alien-invoke
 literal: symbols dll ;
 
 INSN: ##cleanup
 literal: params ;
 
-INSN: ##prepare-alien-indirect ;
+INSN: ##alien-indirect
-
+use: src/int-rep ;
-INSN: ##alien-indirect ;
 
 INSN: ##alien-assembly
 literal: quot ;
 
-INSN: ##push-context-stack ;
+INSN: ##push-context-stack
+use: src/tagged-rep
+temp: temp/int-rep ;
 
 INSN: ##save-param-reg
 literal: offset reg rep ;
@@ -673,10 +679,6 @@ literal: quot ;
 
 INSN: ##end-callback ;
 
-INSN: ##to-nv ;
-
-INSN: ##from-nv ;
-
 ! Control flow
 INSN: ##phi
 def: dst
@@ -812,7 +814,23 @@ UNION: ##write ##set-slot ##set-slot-imm ##set-vm-field ;
 UNION: clobber-insn
 ##call-gc
 ##unary-float-function
-##binary-float-function ;
+##binary-float-function
+##box
+##box-long-long
+##box-small-struct
+##box-large-struct
+##unbox
+##unbox-long-long
+##unbox-large-struct
+##unbox-small-struct
+##prepare-box-struct
+##load-param-reg
+##alien-invoke
+##alien-indirect
+##alien-assembly
+##save-param-reg
+##begin-callback
+##end-callback ;
 
 ! Instructions that have complex expansions and require that the
 ! output registers are not equal to any of the input registers

basis/compiler/codegen/codegen.factor

@@ -283,21 +283,16 @@ CODEGEN: ##unbox %unbox
 CODEGEN: ##unbox-long-long %unbox-long-long
 CODEGEN: ##unbox-large-struct %unbox-large-struct
 CODEGEN: ##unbox-small-struct %unbox-small-struct
-CODEGEN: ##pop-stack %pop-stack
 CODEGEN: ##pop-context-stack %pop-context-stack
 CODEGEN: ##prepare-box-struct %prepare-box-struct
 CODEGEN: ##load-param-reg %load-param-reg
-CODEGEN: ##push-stack %push-stack
 CODEGEN: ##alien-invoke %alien-invoke
 CODEGEN: ##cleanup %cleanup
-CODEGEN: ##prepare-alien-indirect %prepare-alien-indirect
 CODEGEN: ##alien-indirect %alien-indirect
 CODEGEN: ##push-context-stack %push-context-stack
 CODEGEN: ##save-param-reg %save-param-reg
 CODEGEN: ##begin-callback %begin-callback
 CODEGEN: ##alien-callback %alien-callback
 CODEGEN: ##end-callback %end-callback
-CODEGEN: ##to-nv %to-nv
-CODEGEN: ##from-nv %from-nv
 
 M: ##alien-assembly generate-insn quot>> call( -- ) ;

basis/compiler/tests/alien.factor

@@ -99,8 +99,6 @@ FUNCTION: TINY ffi_test_17 int x ;
 
 { 1 1 } [ indirect-test-1 ] must-infer-as
 
-[ B{ } indirect-test-1 ] [ { "kernel-error" 3 6 B{ } } = ] must-fail-with
-
 [ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
 
 : indirect-test-1' ( ptr -- )

basis/cpu/architecture/architecture.factor

@@ -553,48 +553,40 @@ HOOK: dummy-int-params? cpu ( -- ? )
 ! If t, all int parameters are shadowed by dummy FP parameters
 HOOK: dummy-fp-params? cpu ( -- ? )
 
-! Load a value (from the data stack in the ds register).
-! The value is then passed as a parameter to a VM to_*() function
-HOOK: %pop-stack cpu ( n -- )
-
 ! Store a value (to the data stack in the VM's current context)
 ! The value is passed to a VM to_*() function -- used for
 ! callback returns
-HOOK: %pop-context-stack cpu ( -- )
+HOOK: %pop-context-stack cpu ( dst temp -- )
-
-! Store a value (to the data stack in the ds register).
-! The value was returned from a VM from_*() function
-HOOK: %push-stack cpu ( -- )
 
 ! Store a value (to the data stack in the VM's current context)
 ! The value is returned from a VM from_*() function -- used for
 ! callback parameters
-HOOK: %push-context-stack cpu ( -- )
+HOOK: %push-context-stack cpu ( src temp -- )
 
 ! Call a function to convert a tagged pointer returned by
 ! %pop-stack or %pop-context-stack into a value that can be
 ! passed to a C function, or returned from a callback
-HOOK: %unbox cpu ( n rep func -- )
+HOOK: %unbox cpu ( src n rep func -- )
 
-HOOK: %unbox-long-long cpu ( n func -- )
+HOOK: %unbox-long-long cpu ( src n func -- )
 
-HOOK: %unbox-small-struct cpu ( c-type -- )
+HOOK: %unbox-small-struct cpu ( src c-type -- )
 
-HOOK: %unbox-large-struct cpu ( n c-type -- )
+HOOK: %unbox-large-struct cpu ( src n c-type -- )
 
 ! Call a function to convert a value into a tagged pointer,
 ! possibly allocating a bignum, float, or alien instance,
 ! which is then pushed on the data stack by %push-stack or
 ! %push-context-stack
-HOOK: %box cpu ( n rep func -- )
+HOOK: %box cpu ( dst n rep func -- )
 
-HOOK: %box-long-long cpu ( n func -- )
+HOOK: %box-long-long cpu ( dst n func -- )
 
 HOOK: %prepare-box-struct cpu ( -- )
 
-HOOK: %box-small-struct cpu ( c-type -- )
+HOOK: %box-small-struct cpu ( dst c-type -- )
 
-HOOK: %box-large-struct cpu ( n c-type -- )
+HOOK: %box-large-struct cpu ( dst n c-type -- )
 
 HOOK: %save-param-reg cpu ( stack reg rep -- )
 
@@ -604,19 +596,13 @@ HOOK: %restore-context cpu ( temp1 temp2 -- )
 
 HOOK: %save-context cpu ( temp1 temp2 -- )
 
-HOOK: %prepare-var-args cpu ( -- )
-
-M: object %prepare-var-args ;
-
 HOOK: %alien-invoke cpu ( function library -- )
 
 HOOK: %cleanup cpu ( params -- )
 
 M: object %cleanup ( params -- ) drop ;
 
-HOOK: %prepare-alien-indirect cpu ( -- )
+HOOK: %alien-indirect cpu ( src -- )
-
-HOOK: %alien-indirect cpu ( -- )
 
 HOOK: %begin-callback cpu ( -- )
 
@@ -624,10 +610,6 @@ HOOK: %alien-callback cpu ( quot -- )
 
 HOOK: %end-callback cpu ( -- )
 
-HOOK: %to-nv cpu ( -- )
-
-HOOK: %from-nv cpu ( -- )
-
 HOOK: stack-cleanup cpu ( params -- n )
 
 M: object stack-cleanup drop 0 ;

basis/cpu/x86/32/32.factor

@@ -151,11 +151,12 @@ M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
     #! parameter being passed to a callback from C.
     over [ [ local@ ] dip load-return-reg ] [ 2drop ] if ;
 
-M:: x86.32 %box ( n rep func -- )
+M:: x86.32 %box ( dst n rep func -- )
     n rep (%box)
     rep rep-size save-vm-ptr
     0 stack@ rep store-return-reg
-    func f %alien-invoke ;
+    func f %alien-invoke
+    dst EAX tagged-rep %copy ;
 
 : (%box-long-long) ( n -- )
     [
@@ -163,19 +164,21 @@ M:: x86.32 %box ( n rep func -- )
         EAX swap cell - next-stack@ MOV 
     ] when* ;
 
-M: x86.32 %box-long-long ( n func -- )
+M:: x86.32 %box-long-long ( dst n func -- )
-    [ (%box-long-long) ] dip
+    n (%box-long-long)
     8 save-vm-ptr
     4 stack@ EDX MOV
     0 stack@ EAX MOV
-    f %alien-invoke ;
+    func f %alien-invoke
+    dst EAX tagged-rep %copy ;
 
-M:: x86.32 %box-large-struct ( n c-type -- )
+M:: x86.32 %box-large-struct ( dst n c-type -- )
     EDX n struct-return@ LEA
     8 save-vm-ptr
     4 stack@ c-type heap-size MOV
     0 stack@ EDX MOV
-    "from_value_struct" f %alien-invoke ;
+    "from_value_struct" f %alien-invoke
+    dst EAX tagged-rep %copy ;
 
 M: x86.32 %prepare-box-struct ( -- )
     ! Compute target address for value struct return
@@ -183,38 +186,36 @@ M: x86.32 %prepare-box-struct ( -- )
     ! Store it as the first parameter
     0 local@ EAX MOV ;
 
-M: x86.32 %box-small-struct ( c-type -- )
+M: x86.32 %box-small-struct ( dst c-type -- )
     #! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
     12 save-vm-ptr
     8 stack@ swap heap-size MOV
     4 stack@ EDX MOV
     0 stack@ EAX MOV
-    "from_small_struct" f %alien-invoke ;
+    "from_small_struct" f %alien-invoke
+    dst EAX tagged-rep %copy ;
 
-M: x86.32 %pop-stack ( n -- )
+M:: x86.32 %pop-context-stack ( dst temp -- )
-    EAX swap ds-reg reg-stack MOV ;
+    temp %context
+    dst temp "datastack" context-field-offset [+] MOV
+    dst dst [] MOV
+    temp "datastack" context-field-offset [+] bootstrap-cell SUB ;
 
-M: x86.32 %pop-context-stack ( -- )
+: call-unbox-func ( src func -- )
-    temp-reg %context
+    EAX src tagged-rep %copy
-    EAX temp-reg "datastack" context-field-offset [+] MOV
-    EAX EAX [] MOV
-    temp-reg "datastack" context-field-offset [+] bootstrap-cell SUB ;
-
-: call-unbox-func ( func -- )
     4 save-vm-ptr
     0 stack@ EAX MOV
     f %alien-invoke ;
 
-M: x86.32 %unbox ( n rep func -- )
+M:: x86.32 %unbox ( src n rep func -- )
-    #! The value being unboxed must already be in EAX.
+    ! If n is f, we're unboxing a return value about to be
-    #! If n is f, we're unboxing a return value about to be
+    ! returned by the callback. Otherwise, we're unboxing
-    #! returned by the callback. Otherwise, we're unboxing
+    ! a parameter to a C function about to be called.
-    #! a parameter to a C function about to be called.
+    src func call-unbox-func
-    call-unbox-func
     ! Store the return value on the C stack
-    over [ [ local@ ] dip store-return-reg ] [ 2drop ] if ;
+    n [ n local@ rep store-return-reg ] when ;
 
-M: x86.32 %unbox-long-long ( n func -- )
+M:: x86.32 %unbox-long-long ( src n func -- )
     call-unbox-func
     ! Store the return value on the C stack
     [
@@ -222,33 +223,15 @@ M: x86.32 %unbox-long-long ( n func -- )
         [ 4 + local@ EDX MOV ] bi
     ] when* ;
 
-: %unbox-struct-1 ( -- )
+M: x86 %unbox-small-struct ( src size -- )
-    #! Alien must be in EAX.
+    [ "alien_offset" call-unbox-func ]
-    4 save-vm-ptr
+    [
-    0 stack@ EAX MOV
+        heap-size 4 > [ EDX EAX 4 [+] MOV ] when
-    "alien_offset" f %alien-invoke
+        EAX EAX [] MOV
-    ! Load first cell
+    ] bi* ;
-    EAX EAX [] MOV ;
 
-: %unbox-struct-2 ( -- )
+M:: x86.32 %unbox-large-struct ( src n c-type -- )
-    #! Alien must be in EAX.
+    EAX src tagged-rep %copy
-    4 save-vm-ptr
-    0 stack@ EAX MOV
-    "alien_offset" f %alien-invoke
-    ! Load second cell
-    EDX EAX 4 [+] MOV
-    ! Load first cell
-    EAX EAX [] MOV ;
-
-M: x86 %unbox-small-struct ( size -- )
-    #! Alien must be in EAX.
-    heap-size cell align cell /i {
-        { 1 [ %unbox-struct-1 ] }
-        { 2 [ %unbox-struct-2 ] }
-    } case ;
-
-M:: x86.32 %unbox-large-struct ( n c-type -- )
-    ! Alien must be in EAX.
     ! Compute destination address
     EDX n local@ LEA
     12 save-vm-ptr
@@ -257,16 +240,8 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
     0 stack@ EAX MOV
     "to_value_struct" f %alien-invoke ;
 
-M: x86.32 %prepare-alien-indirect ( -- )
+M: x86.32 %alien-indirect ( src -- )
-    EAX ds-reg [] MOV
+    ?spill-slot CALL ;
-    ds-reg 4 SUB
-    4 save-vm-ptr
-    0 stack@ EAX MOV
-    "pinned_alien_offset" f %alien-invoke
-    EBP EAX MOV ;
-
-M: x86.32 %alien-indirect ( -- )
-    EBP CALL ;
 
 M: x86.32 %begin-callback ( -- )
     0 save-vm-ptr
@@ -283,10 +258,6 @@ M: x86.32 %end-callback ( -- )
     0 save-vm-ptr
     "end_callback" f %alien-invoke ;
 
-M: x86.32 %to-nv ( -- ) 4 stack@ EAX MOV ;
-
-M: x86.32 %from-nv ( -- ) EAX 4 stack@ MOV ;
-
 GENERIC: float-function-param ( stack-slot dst src -- )
 
 M:: spill-slot float-function-param ( stack-slot dst src -- )

basis/cpu/x86/64/64.factor

@@ -117,16 +117,14 @@ M: x86.64 %load-param-reg [ swap param@ ] dip %copy ;
         call
     ] with-scope ; inline
 
-M: x86.64 %pop-stack ( n -- )
+M:: x86.64 %pop-context-stack ( dst temp -- )
-    param-reg-0 swap ds-reg reg-stack MOV ;
+    temp %context
+    dst temp "datastack" context-field-offset [+] MOV
+    dst dst [] MOV
+    temp "datastack" context-field-offset [+] bootstrap-cell SUB ;
 
-M: x86.64 %pop-context-stack ( -- )
+M:: x86.64 %unbox ( src n rep func -- )
-    temp-reg %context
+    param-reg-0 src tagged-rep %copy
-    param-reg-0 temp-reg "datastack" context-field-offset [+] MOV
-    param-reg-0 param-reg-0 [] MOV
-    temp-reg "datastack" context-field-offset [+] bootstrap-cell SUB ;
-
-M:: x86.64 %unbox ( n rep func -- )
     param-reg-1 %mov-vm-ptr
     ! Call the unboxer
     func f %alien-invoke
@@ -136,25 +134,25 @@ M:: x86.64 %unbox ( n rep func -- )
     n [ n rep reg-class-of return-reg rep %save-param-reg ] when ;
 
 : %unbox-struct-field ( rep i -- )
-    ! Alien must be in param-reg-0.
     R11 swap cells [+] swap reg-class-of {
         { int-regs [ int-regs get pop swap MOV ] }
         { float-regs [ float-regs get pop swap MOVSD ] }
     } case ;
 
-M: x86.64 %unbox-small-struct ( c-type -- )
+M:: x86.64 %unbox-small-struct ( src c-type -- )
-    ! Alien must be in param-reg-0.
+    param-reg-0 src tagged-rep %copy
     param-reg-1 %mov-vm-ptr
     "alien_offset" f %alien-invoke
     ! Move alien_offset() return value to R11 so that we don't
     ! clobber it.
     R11 RAX MOV
     [
-        flatten-struct-type [ %unbox-struct-field ] each-index
+        c-type flatten-struct-type
+        [ %unbox-struct-field ] each-index
     ] with-return-regs ;
 
-M:: x86.64 %unbox-large-struct ( n c-type -- )
+M:: x86.64 %unbox-large-struct ( src n c-type -- )
-    ! Source is in param-reg-0
+    param-reg-0 src tagged-rep %copy
     ! Load destination address into param-reg-1
     param-reg-1 n param@ LEA
     ! Load structure size into param-reg-2
@@ -169,7 +167,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
     [ ]
     tri %copy ;
 
-M:: x86.64 %box ( n rep func -- )
+M:: x86.64 %box ( dst n rep func -- )
     n [
         n
         0 rep reg-class-of cdecl param-reg
@@ -178,7 +176,8 @@ M:: x86.64 %box ( n rep func -- )
         rep load-return-value
     ] if
     rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
-    func f %alien-invoke ;
+    func f %alien-invoke
+    dst RAX tagged-rep %copy ;
 
 : box-struct-field@ ( i -- operand ) 1 + cells param@ ;
 
@@ -188,28 +187,30 @@ M:: x86.64 %box ( n rep func -- )
         { float-regs [ float-regs get pop MOVSD ] }
     } case ;
 
-M: x86.64 %box-small-struct ( c-type -- )
+M:: x86.64 %box-small-struct ( dst c-type -- )
     #! Box a <= 16-byte struct.
     [
-        [ flatten-struct-type [ %box-struct-field ] each-index ]
+        c-type flatten-struct-type [ %box-struct-field ] each-index
-        [ param-reg-2 swap heap-size MOV ] bi
+        param-reg-2 c-type heap-size MOV
         param-reg-0 0 box-struct-field@ MOV
         param-reg-1 1 box-struct-field@ MOV
         param-reg-3 %mov-vm-ptr
         "from_small_struct" f %alien-invoke
+        dst RAX tagged-rep %copy
     ] with-return-regs ;
 
 : struct-return@ ( n -- operand )
     [ stack-frame get params>> ] unless* param@ ;
 
-M: x86.64 %box-large-struct ( n c-type -- )
+M:: x86.64 %box-large-struct ( dst n c-type -- )
     ! Struct size is parameter 2
-    param-reg-1 swap heap-size MOV
+    param-reg-1 c-type heap-size MOV
     ! Compute destination address
-    param-reg-0 swap struct-return@ LEA
+    param-reg-0 n struct-return@ LEA
     param-reg-2 %mov-vm-ptr
     ! Copy the struct from the C stack
-    "from_value_struct" f %alien-invoke ;
+    "from_value_struct" f %alien-invoke
+    dst RAX tagged-rep %copy ;
 
 M: x86.64 %prepare-box-struct ( -- )
     ! Compute target address for value struct return
@@ -217,22 +218,13 @@ M: x86.64 %prepare-box-struct ( -- )
     ! Store it as the first parameter
     0 param@ RAX MOV ;
 
-M: x86.64 %prepare-var-args RAX RAX XOR ;
-
 M: x86.64 %alien-invoke
     R11 0 MOV
     rc-absolute-cell rel-dlsym
     R11 CALL ;
 
-M: x86.64 %prepare-alien-indirect ( -- )
+M: x86.64 %alien-indirect ( src -- )
-    param-reg-0 ds-reg [] MOV
+    ?spill-slot CALL ;
-    ds-reg 8 SUB
-    param-reg-1 %mov-vm-ptr
-    "pinned_alien_offset" f %alien-invoke
-    nv-reg RAX MOV ;
-
-M: x86.64 %alien-indirect ( -- )
-    nv-reg CALL ;
 
 M: x86.64 %begin-callback ( -- )
     param-reg-0 %mov-vm-ptr
@@ -249,10 +241,6 @@ M: x86.64 %end-callback ( -- )
     param-reg-0 %mov-vm-ptr
     "end_callback" f %alien-invoke ;
 
-M: x86.64 %to-nv ( -- ) nv-reg param-reg-0 MOV ;
-
-M: x86.64 %from-nv ( -- ) param-reg-0 nv-reg MOV ;
-
 : float-function-param ( i src -- )
     [ float-regs cdecl param-regs nth ] dip double-rep %copy ;
 

basis/cpu/x86/x86.factor

@@ -180,9 +180,11 @@ M: object copy-memory* copy-register* ;
 M: float-rep copy-memory* drop MOVSS ;
 M: double-rep copy-memory* drop MOVSD ;
 
+: ?spill-slot ( obj -- obj ) dup spill-slot? [ n>> spill@ ] when ;
+
 M: x86 %copy ( dst src rep -- )
     2over eq? [ 3drop ] [
-        [ [ dup spill-slot? [ n>> spill@ ] when ] bi@ ] dip
+        [ [ ?spill-slot ] bi@ ] dip
         2over [ register? ] both? [ copy-register* ] [ copy-memory* ] if
     ] if ;
 
@@ -502,15 +504,11 @@ M:: x86 %check-nursery-branch ( label size cc temp1 temp2 -- )
 M: x86 %alien-global ( dst symbol library -- )
     [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;    
 
-M: x86 %push-stack ( -- )
+M:: x86 %push-context-stack ( src temp -- )
-    ds-reg cell ADD
+    temp %context
-    ds-reg [] int-regs return-reg MOV ;
+    temp "datastack" context-field-offset [+] bootstrap-cell ADD
-
+    temp temp "datastack" context-field-offset [+] MOV
-M: x86 %push-context-stack ( -- )
+    temp [] src MOV ;
-    temp-reg %context
-    temp-reg "datastack" context-field-offset [+] bootstrap-cell ADD
-    temp-reg temp-reg "datastack" context-field-offset [+] MOV
-    temp-reg [] int-regs return-reg MOV ;
 
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 

basis/stack-checker/alien/alien.factor

@@ -20,9 +20,6 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
 : param-prep-quot ( params -- quot )
     parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
 
-: infer-params ( params -- )
-    param-prep-quot infer-quot-here ;
-
 : alien-stack ( params extra -- )
     over parameters>> length + consume-d >>in-d
     dup return>> void? 0 1 ? produce-d >>out-d
@@ -62,7 +59,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     ! Set ABI
     dup library>> library-abi >>abi
     ! Quotation which coerces parameters to required types
-    dup infer-params
+    dup param-prep-quot infer-quot-here
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-stack
     ! Add node to IR
@@ -76,10 +73,8 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     pop-abi
     pop-params
     pop-return
-    ! Quotation which coerces parameters to required types
+    ! Coerce parameters to required types
-    1 infer->r
+    dup param-prep-quot '[ _ [ >c-ptr ] bi* ] infer-quot-here
-    dup infer-params
-    1 infer-r>
     ! Magic #: consume the function pointer, too
     dup 1 alien-stack
     ! Add node to IR
@@ -95,7 +90,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     pop-params
     pop-return
     ! Quotation which coerces parameters to required types
-    dup infer-params
+    dup param-prep-quot infer-quot-here
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-stack
     ! Add node to IR