FFI rewrite part 1: split up ##alien-invoke and friends into smaller instructions

basis/alien/arrays/arrays.factor

@@ -22,17 +22,11 @@ M: array c-type-align first c-type-align ;
 
 M: array c-type-align-first first c-type-align-first ;
 
-M: array unbox-parameter drop void* unbox-parameter ;
+M: array base-type drop void* base-type ;
-
-M: array unbox-return drop void* unbox-return ;
-
-M: array box-parameter drop void* box-parameter ;
-
-M: array box-return drop void* box-return ;
 
 M: array stack-size drop void* stack-size ;
 
-M: array flatten-c-type drop { int-rep } ;
+M: array flatten-c-type drop void* flatten-c-type ;
 
 PREDICATE: string-type < pair
     first2 [ c-string = ] [ word? ] bi* and ;
@@ -43,35 +37,19 @@ M: string-type c-type-class drop object ;
 
 M: string-type c-type-boxed-class drop object ;
 
-M: string-type heap-size
+M: string-type heap-size drop void* heap-size ;
-    drop void* heap-size ;
 
-M: string-type c-type-align
+M: string-type c-type-align drop void* c-type-align ;
-    drop void* c-type-align ;
 
-M: string-type c-type-align-first
+M: string-type c-type-align-first drop void* c-type-align-first ;
-    drop void* c-type-align-first ;
 
-M: string-type unbox-parameter
+M: string-type base-type drop void* base-type ;
-    drop void* unbox-parameter ;
 
-M: string-type unbox-return
+M: string-type stack-size drop void* stack-size ;
-    drop void* unbox-return ;
 
-M: string-type box-parameter
+M: string-type c-type-rep drop int-rep ;
-    drop void* box-parameter ;
 
-M: string-type box-return
+M: string-type flatten-c-type drop void* flatten-c-type ;
-    drop void* box-return ;
-
-M: string-type stack-size
-    drop void* stack-size ;
-
-M: string-type c-type-rep
-    drop int-rep ;
-
-M: string-type flatten-c-type
-    drop { int-rep } ;
 
 M: string-type c-type-boxer-quot
     second dup binary =

basis/alien/c-types/c-types-docs.factor

@@ -43,21 +43,6 @@ HELP: c-setter
 { $description "Outputs a quotation which writes values of this C type to a C structure." }
 { $errors "Throws an error if the type does not exist." } ;
 
-HELP: box-parameter
-{ $values { "n" math:integer } { "c-type" "a C type" } }
-{ $description "Generates code for converting a C value stored at  offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
-{ $notes "This is an internal word used by the compiler when compiling callbacks." } ;
-
-HELP: box-return
-{ $values { "c-type" "a C type" } }
-{ $description "Generates code for converting a C value stored in return registers into a Factor object to be pushed on the data stack." }
-{ $notes "This is an internal word used by the compiler when compiling alien calls." } ;
-
-HELP: unbox-return
-{ $values { "c-type" "a C type" } }
-{ $description "Generates code for converting a Factor value on the data stack into a C value to be stored in the return registers." }
-{ $notes "This is an internal word used by the compiler when compiling callbacks." } ;
-
 HELP: define-deref
 { $values { "c-type" "a C type" } }
 { $description "Defines a word " { $snippet "*name" } " with stack effect " { $snippet "( c-ptr -- value )" } " for reading a value with C type " { $snippet "name" } " stored at an alien pointer." }

basis/alien/c-types/c-types.factor

@@ -111,27 +111,11 @@ GENERIC: c-type-align-first ( name -- n )
 
 M: abstract-c-type c-type-align-first align-first>> ;
 
-: c-type-box ( n c-type -- )
+GENERIC: base-type ( c-type -- c-type )
-    [ rep>> ] [ boxer>> ] bi %box ;
 
-: c-type-unbox ( n c-type -- )
+M: c-type-name base-type c-type ;
-    [ rep>> ] [ unboxer>> ] bi %unbox ;
 
-GENERIC: box-parameter ( n c-type -- )
+M: c-type base-type ;
-
-M: c-type box-parameter c-type-box ;
-
-GENERIC: box-return ( c-type -- )
-
-M: c-type box-return f swap c-type-box ;
-
-GENERIC: unbox-parameter ( n c-type -- )
-
-M: c-type unbox-parameter c-type-unbox ;
-
-GENERIC: unbox-return ( c-type -- )
-
-M: c-type unbox-return f swap c-type-unbox ;
 
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
@@ -179,10 +163,7 @@ PROTOCOL: c-type-protocol
     c-type-setter
     c-type-align
     c-type-align-first
-    box-parameter
+    base-type
-    box-return
-    unbox-parameter
-    unbox-return
     heap-size
     stack-size
     flatten-c-type ;
@@ -204,18 +185,6 @@ TUPLE: long-long-type < c-type ;
 : <long-long-type> ( -- c-type )
     long-long-type new ;
 
-M: long-long-type unbox-parameter ( n c-type -- )
-    unboxer>> %unbox-long-long ;
-
-M: long-long-type unbox-return ( c-type -- )
-    f swap unbox-parameter ;
-
-M: long-long-type box-parameter ( n c-type -- )
-    boxer>> %box-long-long ;
-
-M: long-long-type box-return ( c-type -- )
-    f swap box-parameter ;
-
 M: long-long-type flatten-c-type
     int-rep (flatten-c-type) ;
 

basis/bootstrap/compiler/compiler.factor

@@ -117,6 +117,8 @@ gc
 
     " done" print flush
 
+    "alien.syntax" require
+    "alien.complex" require
     "io.streams.byte-array.fast" require
 
 ] unless

basis/bootstrap/help/help.factor

@@ -6,12 +6,10 @@ IN: bootstrap.help
 : load-help ( -- )
     "help.lint" require
     "help.vocabs" require
-    "alien.syntax" require
-    "compiler" require
 
     t load-help? set-global
 
-    [ vocab ] load-vocab-hook [
+    [ dup vocab [ ] [ no-vocab ] ?if ] load-vocab-hook [
         dictionary get values
         [ docs-loaded?>> not ] filter
         [ load-docs ] each

basis/calendar/calendar-docs.factor

@@ -8,7 +8,7 @@ HELP: duration
 { $description "A duration is a period of time years, months, days, hours, minutes, and seconds.  All duration slots can store " { $link real } " numbers. Compare two durations with the " { $link <=> } " word." } ;
 
 HELP: timestamp
-{ $description "A timestamp is a date and a time with a timezone offset.  Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } ". Compare two duarionts with the " { $link <=> } " word." } ;
+{ $description "A timestamp is a date and a time with a timezone offset.  Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } ". Compare two durations with the " { $link <=> } " word." } ;
 
 { timestamp duration } related-words
 

basis/classes/struct/struct.factor

@@ -169,20 +169,10 @@ M: struct-c-type c-type ;
 : if-value-struct ( ctype true false -- )
     [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
 
-M: struct-c-type unbox-parameter
-    [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
-
-M: struct-c-type box-parameter
-    [ %box-large-struct ] [ box-parameter ] if-value-struct ;
-
 : if-small-struct ( c-type true false -- ? )
     [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
 
-M: struct-c-type unbox-return
+M: struct-c-type base-type ;
-    [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
-
-M: struct-c-type box-return
-    [ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
 
 M: struct-c-type stack-size
     [ heap-size cell align ] [ stack-size ] if-value-struct ;

basis/compiler/cfg/block-joining/block-joining.factor

@@ -10,9 +10,9 @@ IN: compiler.cfg.block-joining
 ! before stack analysis.
 : join-block? ( bb -- ? )
     {
-        [ kill-block? not ]
+        [ kill-block?>> not ]
         [ predecessors>> length 1 = ]
-        [ predecessor kill-block? not ]
+        [ predecessor kill-block?>> not ]
         [ predecessor successors>> length 1 = ]
         [ [ predecessor ] keep back-edge? not ]
     } 1&& ;

basis/compiler/cfg/branch-splitting/branch-splitting.factor

@@ -1,9 +1,10 @@
-! Copyright (C) 2009 Doug Coleman, Slava Pestov.
+! Copyright (C) 2009, 2010 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit kernel math math.order
+USING: accessors combinators combinators.short-circuit kernel
-sequences assocs namespaces vectors fry arrays splitting
+math math.order sequences assocs namespaces vectors fry arrays
-compiler.cfg.def-use compiler.cfg compiler.cfg.rpo compiler.cfg.predecessors
+splitting compiler.cfg.def-use compiler.cfg compiler.cfg.rpo
-compiler.cfg.renaming compiler.cfg.instructions compiler.cfg.utilities ;
+compiler.cfg.predecessors compiler.cfg.renaming
+compiler.cfg.instructions compiler.cfg.utilities ;
 IN: compiler.cfg.branch-splitting
 
 : clone-instructions ( insns -- insns' )
@@ -15,10 +16,12 @@ IN: compiler.cfg.branch-splitting
     ! 'back-edge?' work.
     <basic-block>
         swap
+        {
             [ instructions>> clone-instructions >>instructions ]
             [ successors>> clone >>successors ]
+            [ kill-block?>> >>kill-block? ]
             [ number>> >>number ]
-        tri ;
+        } cleave ;
 
 : new-blocks ( bb -- copies )
     dup predecessors>> [

basis/compiler/cfg/build-stack-frame/build-stack-frame.factor

@@ -14,13 +14,7 @@ GENERIC: compute-stack-frame* ( insn -- )
     frame-required? on
     stack-frame [ max-stack-frame ] change ;
 
-UNION: stack-frame-insn
+M: ##stack-frame compute-stack-frame*
-    ##alien-invoke
-    ##alien-indirect
-    ##alien-assembly
-    ##alien-callback ;
-
-M: stack-frame-insn compute-stack-frame*
     stack-frame>> request-stack-frame ;
 
 M: ##call compute-stack-frame* drop frame-required? on ;

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

@@ -0,0 +1,293 @@
+! Copyright (C) 2008, 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays layouts math math.order math.parser
+combinators fry sequences locals alien alien.private
+alien.strings alien.c-types alien.libraries classes.struct
+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 ;
+FROM: compiler.errors => no-such-symbol no-such-library ;
+IN: compiler.cfg.builder.alien
+
+GENERIC: next-fastcall-param ( rep -- )
+
+: ?dummy-stack-params ( rep -- )
+    dummy-stack-params? [ rep-size cell align stack-params +@ ] [ drop ] if ;
+
+: ?dummy-int-params ( rep -- )
+    dummy-int-params? [ rep-size cell /i 1 max int-regs +@ ] [ drop ] if ;
+
+: ?dummy-fp-params ( rep -- )
+    drop dummy-fp-params? [ float-regs inc ] when ;
+
+M: int-rep next-fastcall-param
+    int-regs inc [ ?dummy-stack-params ] [ ?dummy-fp-params ] bi ;
+
+M: float-rep next-fastcall-param
+    float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
+
+M: double-rep next-fastcall-param
+    float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
+
+GENERIC# reg-class-full? 1 ( reg-class abi -- ? )
+
+M: stack-params reg-class-full? 2drop t ;
+
+M: reg-class reg-class-full?
+    [ get ] swap '[ _ param-regs length ] bi >= ;
+
+: alloc-stack-param ( rep -- n reg-class rep )
+    stack-params get
+    [ rep-size cell align stack-params +@ ] dip
+    stack-params dup ;
+
+: alloc-fastcall-param ( rep -- n reg-class rep )
+    [ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
+
+:: alloc-parameter ( rep abi -- reg rep )
+    rep dup reg-class-of abi reg-class-full?
+    [ alloc-stack-param ] [ alloc-fastcall-param ] if
+    [ abi param-reg ] dip ;
+
+: reset-fastcall-counts ( -- )
+    { int-regs float-regs stack-params } [ 0 swap set ] each ;
+
+: with-param-regs ( quot -- )
+    #! In quot you can call alloc-parameter
+    [ reset-fastcall-counts call ] with-scope ; inline
+
+:: move-parameters ( params word -- )
+    #! Moves values from C stack to registers (if word is
+    #! ##load-param-reg) and registers to C stack (if word is
+    #! ##save-param-reg).
+    0 params alien-parameters flatten-c-types [
+        [ params abi>> alloc-parameter word execute( offset reg rep -- ) ]
+        [ rep-size cell align + ]
+        2bi
+    ] each drop ; inline
+
+: parameter-offsets ( types -- offsets )
+    0 [ stack-size + ] accumulate nip ;
+
+: each-parameter ( parameters quot -- )
+    [ [ parameter-offsets ] keep ] dip 2each ; inline
+
+: reverse-each-parameter ( parameters quot -- )
+    [ [ parameter-offsets ] keep ] dip 2reverse-each ; inline
+
+: prepare-unbox-parameters ( parameters -- offsets types indices )
+    [ parameter-offsets ] [ ] [ length iota <reversed> ] tri ;
+
+GENERIC: unbox-parameter ( n c-type -- )
+
+M: c-type unbox-parameter
+    [ rep>> ] [ unboxer>> ] bi ##unbox ;
+
+M: long-long-type unbox-parameter
+    unboxer>> ##unbox-long-long ;
+
+M: struct-c-type unbox-parameter
+    [ ##unbox-large-struct ] [ base-type unbox-parameter ] if-value-struct ;
+
+: unbox-parameters ( offset node -- )
+    parameters>> swap
+    '[
+        prepare-unbox-parameters
+        [ ##pop-stack [ _ + ] dip base-type unbox-parameter ] 3each
+    ]
+    [ length neg ##inc-d ]
+    bi ;
+
+: prepare-box-struct ( node -- offset )
+    #! Return offset on C stack where to store unboxed
+    #! 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>> large-struct?
+    [ ##prepare-box-struct cell ] [ 0 ] if ;
+
+: objects>registers ( params -- )
+    #! Generate code for unboxing a list of C types, then
+    #! generate code for moving these parameters to registers on
+    #! architectures where parameters are passed in registers.
+    [
+        [ prepare-box-struct ] keep
+        [ unbox-parameters ] keep
+        \ ##load-param-reg move-parameters
+    ] with-param-regs ;
+
+GENERIC: box-return ( c-type -- )
+
+M: c-type box-return
+    [ f ] dip [ rep>> ] [ boxer>> ] bi ##box ;
+
+M: long-long-type box-return
+    [ f ] dip boxer>> ##box-long-long ;
+
+M: struct-c-type box-return
+    [ ##box-small-struct ] [ ##box-large-struct ] if-small-struct ;
+
+: box-return* ( node -- )
+    return>> [ ] [ base-type box-return ##push-stack ] if-void ;
+
+GENERIC# dlsym-valid? 1 ( symbols dll -- ? )
+
+M: string dlsym-valid? dlsym ;
+
+M: array dlsym-valid? '[ _ dlsym ] any? ;
+
+: check-dlsym ( symbols dll -- )
+    dup dll-valid? [
+        dupd dlsym-valid?
+        [ drop ] [ cfg get word>> no-such-symbol ] if
+    ] [ dll-path cfg get word>> no-such-library drop ] if ;
+
+: decorated-symbol ( params -- symbols )
+    [ function>> ] [ parameters>> [ stack-size ] map-sum number>string ] bi
+    {
+        [ drop ]
+        [ "@" glue ]
+        [ "@" glue "_" prepend ]
+        [ "@" glue "@" prepend ]
+    } 2cleave
+    4array ;
+
+: alien-invoke-dlsym ( params -- symbols dll )
+    [ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
+    [ library>> load-library ]
+    bi 2dup check-dlsym ;
+
+: return-size ( ctype -- n )
+    #! Amount of space we reserve for a return value.
+    {
+        { [ dup c-struct? not ] [ drop 0 ] }
+        { [ dup large-struct? not ] [ drop 2 cells ] }
+        [ heap-size ]
+    } cond ;
+
+: <alien-stack-frame> ( params -- stack-frame )
+    stack-frame new
+        swap
+        [ return>> return-size >>return ]
+        [ alien-parameters [ stack-size ] map-sum >>params ] bi
+        t >>calls-vm? ;
+
+: alien-node-height ( params -- )
+    [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
+
+: emit-alien-node ( node quot -- )
+    '[
+        make-kill-block
+        params>>
+        [ <alien-stack-frame> ##stack-frame ]
+        _
+        [ alien-node-height ]
+        tri
+    ] emit-trivial-block ; inline
+
+M: #alien-invoke emit-node
+    [
+        ! Unbox parameters
+        dup objects>registers
+        ! Call function
+        dup alien-invoke-dlsym ##alien-invoke
+        ! Box return value
+        dup ##cleanup
+        box-return*
+    ] emit-alien-node ;
+
+M: #alien-indirect emit-node
+    [
+        ! Save alien at top of stack to temporary storage
+        ##prepare-alien-indirect
+        ! Unbox parameters
+        dup objects>registers
+        ! Call alien in temporary storage
+        ##alien-indirect
+        ! Box return value
+        dup ##cleanup
+        box-return*
+    ] emit-alien-node ;
+
+M: #alien-assembly emit-node
+    [
+        ! Unbox parameters
+        dup objects>registers
+        ! Generate assembly
+        dup quot>> ##alien-assembly
+        ! Box return value
+        box-return*
+    ] emit-alien-node ;
+
+GENERIC: box-parameter ( n c-type -- )
+
+M: c-type box-parameter
+    [ rep>> ] [ boxer>> ] bi ##box ;
+
+M: long-long-type box-parameter
+    boxer>> ##box-long-long ;
+
+M: struct-c-type box-parameter
+    [ ##box-large-struct ] [ base-type box-parameter ] if-value-struct ;
+
+: box-parameters ( params -- )
+    alien-parameters
+    [ base-type box-parameter ##push-context-stack ] each-parameter ;
+
+: registers>objects ( node -- )
+    ! Generate code for boxing input parameters in a callback.
+    [
+        dup \ ##save-param-reg move-parameters
+        ##begin-callback
+        box-parameters
+    ] with-param-regs ;
+
+: callback-return-quot ( ctype -- quot )
+    return>> {
+        { [ dup void? ] [ drop [ ] ] }
+        { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
+        [ c-type c-type-unboxer-quot ]
+    } cond ;
+
+: callback-prep-quot ( params -- quot )
+    parameters>> [ c-type c-type-boxer-quot ] map spread>quot ;
+
+: wrap-callback-quot ( params -- quot )
+    [ callback-prep-quot ] [ quot>> ] [ callback-return-quot ] tri 3append
+     yield-hook get
+     '[ _ _ do-callback ]
+     >quotation ;
+
+GENERIC: unbox-return ( c-type -- )
+
+M: c-type unbox-return
+    [ f ] dip [ rep>> ] [ unboxer>> ] bi ##unbox ;
+
+M: long-long-type unbox-return
+    [ f ] dip unboxer>> ##unbox-long-long ;
+
+M: struct-c-type unbox-return
+    [ ##unbox-small-struct ] [ ##unbox-large-struct ] if-small-struct ;
+
+M: #alien-callback emit-node
+    dup params>> xt>> dup
+    [
+        ##prologue
+        [
+            [ registers>objects ]
+            [ wrap-callback-quot ##alien-callback ]
+            [
+                alien-return [ ##end-callback ] [
+                    ##pop-context-stack
+                    ##to-nv
+                    ##end-callback
+                    ##from-nv
+                    base-type unbox-return
+                ] if-void
+            ] tri
+        ] emit-alien-node
+        ##epilogue
+        ##return
+    ] with-cfg-builder ;

basis/compiler/cfg/builder/blocks/blocks.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays fry kernel make math namespaces sequences
 compiler.cfg compiler.cfg.instructions compiler.cfg.stacks
@@ -31,6 +31,9 @@ IN: compiler.cfg.builder.blocks
     call
     ##branch begin-basic-block ; inline
 
+: make-kill-block ( -- )
+    basic-block get t >>kill-block? drop ;
+
 : call-height ( #call -- n )
     [ out-d>> length ] [ in-d>> length ] bi - ;
 
@@ -38,6 +41,7 @@ IN: compiler.cfg.builder.blocks
     [
         [ word>> ##call ]
         [ call-height adjust-d ] bi
+        make-kill-block
     ] emit-trivial-block ;
 
 : begin-branch ( -- ) clone-current-height (begin-basic-block) ;
@@ -66,7 +70,7 @@ IN: compiler.cfg.builder.blocks
     [ ] find nip [ second current-height set ] [ end-basic-block ] if* ;
 
 : emit-conditional ( branches -- )
-    ! branchies is a sequence of pairs as above
+    ! branches is a sequence of pairs as above
     end-basic-block
     [ merge-heights begin-basic-block ]
     [ set-successors ]

basis/compiler/cfg/builder/builder.factor

@@ -57,6 +57,7 @@ GENERIC: emit-node ( node -- )
     [ basic-block get [ emit-node ] [ drop ] if ] each ;
 
 : begin-word ( -- )
+    make-kill-block
     ##prologue
     ##branch
     begin-basic-block ;
@@ -82,8 +83,12 @@ GENERIC: emit-node ( node -- )
 : emit-call ( word height -- )
     over loops get key?
     [ drop loops get at emit-loop-call ]
-    [ [ [ ##call ] [ adjust-d ] bi* ] emit-trivial-block ]
+    [
-    if ;
+        [
+            [ ##call ] [ adjust-d ] bi*
+            make-kill-block
+        ] emit-trivial-block
+    ] if ;
 
 ! #recursive
 : recursive-height ( #recursive -- n )
@@ -195,7 +200,11 @@ M: #shuffle emit-node
 
 ! #return
 : emit-return ( -- )
-    ##branch begin-basic-block ##epilogue ##return ;
+    ##branch
+    begin-basic-block
+    make-kill-block
+    ##epilogue
+    ##return ;
 
 M: #return emit-node drop emit-return ;
 
@@ -205,49 +214,6 @@ M: #return-recursive emit-node
 ! #terminate
 M: #terminate emit-node drop ##no-tco end-basic-block ;
 
-! FFI
-: return-size ( ctype -- n )
-    #! Amount of space we reserve for a return value.
-    {
-        { [ dup c-struct? not ] [ drop 0 ] }
-        { [ dup large-struct? not ] [ drop 2 cells ] }
-        [ heap-size ]
-    } cond ;
-
-: <alien-stack-frame> ( params -- stack-frame )
-    stack-frame new
-        swap
-        [ return>> return-size >>return ]
-        [ alien-parameters [ stack-size ] map-sum >>params ] bi
-        t >>calls-vm? ;
-
-: alien-node-height ( params -- )
-    [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
-
-: emit-alien-node ( node quot -- )
-    [
-        [ params>> dup dup <alien-stack-frame> ] dip call
-        alien-node-height
-    ] emit-trivial-block ; inline
-
-M: #alien-invoke emit-node
-    [ ##alien-invoke ] emit-alien-node ;
-
-M: #alien-indirect emit-node
-    [ ##alien-indirect ] emit-alien-node ;
-
-M: #alien-assembly emit-node
-    [ ##alien-assembly ] emit-alien-node ;
-
-M: #alien-callback emit-node
-    dup params>> xt>> dup
-    [
-        ##prologue
-        [ ##alien-callback ] emit-alien-node
-        ##epilogue
-        ##return
-    ] with-cfg-builder ;
-
 ! No-op nodes
 M: #introduce emit-node drop ;
 

basis/compiler/cfg/cfg.factor

@@ -9,6 +9,7 @@ number
 { instructions vector }
 { successors vector }
 { predecessors vector }
+{ kill-block? boolean }
 { unlikely? boolean } ;
 
 : <basic-block> ( -- bb )

basis/compiler/cfg/checker/checker.factor

@@ -7,50 +7,11 @@ compiler.cfg.utilities compiler.cfg.finalization
 compiler.utilities ;
 IN: compiler.cfg.checker
 
-! Check invariants
-
-ERROR: bad-kill-block bb ;
-
-: check-kill-block ( bb -- )
-    dup instructions>> dup penultimate ##epilogue? [
-        {
-            [ length 2 = ]
-            [ last { [ ##return? ] [ ##jump? ] } 1|| ]
-        } 1&&
-    ] [ last ##branch? ] if
-    [ drop ] [ bad-kill-block ] if ;
-
-ERROR: last-insn-not-a-jump bb ;
-
-: check-last-instruction ( bb -- )
-    dup instructions>> last {
-        [ ##branch? ]
-        [ ##dispatch? ]
-        [ conditional-branch-insn? ]
-        [ ##no-tco? ]
-    } 1|| [ drop ] [ last-insn-not-a-jump ] if ;
-
-ERROR: bad-kill-insn bb ;
-
-: check-kill-instructions ( bb -- )
-    dup instructions>> [ kill-vreg-insn? ] any?
-    [ bad-kill-insn ] [ drop ] if ;
-
-: check-normal-block ( bb -- )
-    [ check-last-instruction ]
-    [ check-kill-instructions ]
-    bi ;
-
 ERROR: bad-successors ;
 
 : check-successors ( bb -- )
     dup successors>> [ predecessors>> member-eq? ] with all?
     [ bad-successors ] unless ;
 
-: check-basic-block ( bb -- )
-    [ dup kill-block? [ check-kill-block ] [ check-normal-block ] if ]
-    [ check-successors ]
-    bi ;
-
 : check-cfg ( cfg -- )
-    [ check-basic-block ] each-basic-block ;
+    [ check-successors ] each-basic-block ;

basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor

@@ -18,27 +18,21 @@ MIXIN: dataflow-analysis
 : <dfa-worklist> ( cfg dfa -- queue )
     block-order <hashed-dlist> [ push-all-front ] keep ;
 
-GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
+:: compute-in-set ( bb out-sets dfa -- set )
-
-M: kill-block compute-in-set 3drop f ;
-
-M:: basic-block compute-in-set ( bb out-sets dfa -- set )
     ! Only consider initialized sets.
+    bb kill-block?>> [ f ] [
         bb dfa predecessors
         [ out-sets key? ] filter
         [ out-sets at ] map
-    bb dfa join-sets ;
+        bb dfa join-sets
+    ] if ;
 
 :: update-in-set ( bb in-sets out-sets dfa -- ? )
     bb out-sets dfa compute-in-set
     bb in-sets maybe-set-at ; inline
 
-GENERIC# compute-out-set 2 ( bb out-sets dfa -- set )
+:: compute-out-set ( bb in-sets dfa -- set )
-
+    bb kill-block?>> [ f ] [ bb in-sets at bb dfa transfer-set ] if ;
-M: kill-block compute-out-set 3drop f ;
-
-M:: basic-block compute-out-set ( bb in-sets dfa -- set )
-    bb in-sets at bb dfa transfer-set ;
 
 :: update-out-set ( bb in-sets out-sets dfa -- ? )
     bb in-sets dfa compute-out-set

basis/compiler/cfg/instructions/instructions.factor

@@ -609,17 +609,73 @@ use: src/tagged-rep
 literal: offset ;
 
 ! FFI
-INSN: ##alien-invoke
+INSN: ##stack-frame
-literal: params stack-frame ;
+literal: stack-frame ;
 
-INSN: ##alien-indirect
+INSN: ##box
-literal: params stack-frame ;
+literal: n rep boxer ;
+
+INSN: ##box-long-long
+literal: n boxer ;
+
+INSN: ##box-small-struct
+literal: c-type ;
+
+INSN: ##box-large-struct
+literal: n c-type ;
+
+INSN: ##unbox
+literal: n rep unboxer ;
+
+INSN: ##unbox-long-long
+literal: n unboxer ;
+
+INSN: ##unbox-large-struct
+literal: n c-type ;
+
+INSN: ##unbox-small-struct
+literal: c-type ;
+
+INSN: ##pop-stack
+literal: n ;
+
+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 ;
 
 INSN: ##alien-assembly
-literal: params stack-frame ;
+literal: quot ;
+
+INSN: ##push-context-stack ;
+
+INSN: ##save-param-reg
+literal: offset reg rep ;
+
+INSN: ##begin-callback ;
 
 INSN: ##alien-callback
-literal: params stack-frame ;
+literal: quot ;
+
+INSN: ##end-callback ;
+
+INSN: ##to-nv ;
+
+INSN: ##from-nv ;
 
 ! Control flow
 INSN: ##phi
@@ -758,15 +814,6 @@ UNION: clobber-insn
 ##unary-float-function
 ##binary-float-function ;
 
-! Instructions that kill all live vregs
-UNION: kill-vreg-insn
-##call
-##prologue
-##epilogue
-##alien-invoke
-##alien-indirect
-##alien-callback ;
-
 ! Instructions that have complex expansions and require that the
 ! output registers are not equal to any of the input registers
 UNION: def-is-use-insn

basis/compiler/cfg/intrinsics/fixnum/fixnum.factor

@@ -51,7 +51,11 @@ IN: compiler.cfg.intrinsics.fixnum
     [ ds-drop ds-drop ds-push ] with-branch ;
 
 : emit-overflow-case ( word -- final-bb )
-    [ ##call -1 adjust-d ] with-branch ;
+    [
+        ##call
+        -1 adjust-d
+        make-kill-block
+    ] with-branch ;
 
 : emit-fixnum-overflow-op ( quot word -- )
     ! Inputs to the final instruction need to be copied because

basis/compiler/cfg/representations/rewrite/rewrite.factor

@@ -90,15 +90,14 @@ M: ##copy conversions-for-insn , ;
 M: insn conversions-for-insn , ;
 
 : conversions-for-block ( bb -- )
-    dup kill-block? [ drop ] [
     [
         [
-                H{ } clone alternatives set
+            alternatives get clear-assoc
             [ conversions-for-insn ] each
         ] V{ } make
-        ] change-instructions drop
+    ] change-instructions drop ;
-    ] if ;
 
 : insert-conversions ( cfg -- )
+    H{ } clone alternatives set
     V{ } clone renaming-set set
     [ conversions-for-block ] each-basic-block ;

basis/compiler/cfg/rpo/rpo.factor

@@ -36,8 +36,10 @@ SYMBOL: visited
     [ reverse-post-order ] dip each ; inline
 
 : optimize-basic-block ( bb quot -- )
-    [ drop basic-block set ]
+    over kill-block?>> [ 2drop ] [
-    [ change-instructions drop ] 2bi ; inline
+        over basic-block set
+        change-instructions drop
+    ] if ; inline
 
 : simple-optimization ( ... cfg quot: ( ... insns -- ... insns' ) -- ... )
     '[ _ optimize-basic-block ] each-basic-block ; inline

basis/compiler/cfg/scheduling/scheduling.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2009, 2010 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs compiler.cfg.def-use
+USING: accessors arrays assocs fry kernel locals make math
-compiler.cfg.dependence compiler.cfg.instructions
+namespaces sequences sets combinators.short-circuit
-compiler.cfg.liveness compiler.cfg.rpo cpu.architecture fry
+compiler.cfg.def-use compiler.cfg.dependence
-kernel locals make math namespaces sequences sets ;
+compiler.cfg.instructions compiler.cfg.liveness compiler.cfg.rpo
+cpu.architecture ;
 IN: compiler.cfg.scheduling
 
 ! Instruction scheduling to reduce register pressure, from:
@@ -128,7 +129,6 @@ ERROR: definition-after-usage vreg old-bb new-bb ;
 
 : schedule-instructions ( cfg -- cfg' )
     dup [
-        dup might-spill?
+        dup { [ kill-block?>> not ] [ might-spill? ] } 1&&
-        [ schedule-block ]
+        [ schedule-block ] [ drop ] if
-        [ drop ] if
     ] each-basic-block ;

basis/compiler/cfg/stacks/finalize/finalize.factor

@@ -43,7 +43,7 @@ ERROR: bad-peek dst loc ;
 : visit-edge ( from to -- )
     ! If both blocks are subroutine calls, don't bother
     ! computing anything.
-    2dup [ kill-block? ] both? [ 2drop ] [
+    2dup [ kill-block?>> ] both? [ 2drop ] [
         2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ##branch ] V{ } make
         [ 2drop ] [ insert-basic-block ] if-empty
     ] if ;

basis/compiler/cfg/utilities/utilities.factor

@@ -6,12 +6,6 @@ sets vectors fry arrays compiler.cfg compiler.cfg.instructions
 compiler.cfg.rpo compiler.utilities ;
 IN: compiler.cfg.utilities
 
-PREDICATE: kill-block < basic-block
-    instructions>> {
-        [ length 2 >= ]
-        [ penultimate kill-vreg-insn? ]
-    } 1&& ;
-
 : back-edge? ( from to -- ? )
     [ number>> ] bi@ >= ;
 

basis/compiler/codegen/alien/alien.factor

@@ -1,207 +0,0 @@
-! Copyright (C) 2008, 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.complex alien.c-types
-alien.libraries alien.private alien.strings arrays
-classes.struct combinators compiler.alien
-compiler.cfg.instructions compiler.codegen
-compiler.codegen.fixup compiler.errors compiler.utilities
-cpu.architecture fry kernel layouts libc locals make math
-math.order math.parser namespaces quotations sequences strings
-system ;
-FROM: compiler.errors => no-such-symbol ;
-IN: compiler.codegen.alien
-
-! ##alien-invoke
-GENERIC: next-fastcall-param ( rep -- )
-
-: ?dummy-stack-params ( rep -- )
-    dummy-stack-params? [ rep-size cell align stack-params +@ ] [ drop ] if ;
-
-: ?dummy-int-params ( rep -- )
-    dummy-int-params? [ rep-size cell /i 1 max int-regs +@ ] [ drop ] if ;
-
-: ?dummy-fp-params ( rep -- )
-    drop dummy-fp-params? [ float-regs inc ] when ;
-
-M: int-rep next-fastcall-param
-    int-regs inc [ ?dummy-stack-params ] [ ?dummy-fp-params ] bi ;
-
-M: float-rep next-fastcall-param
-    float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
-
-M: double-rep next-fastcall-param
-    float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
-
-GENERIC# reg-class-full? 1 ( reg-class abi -- ? )
-
-M: stack-params reg-class-full? 2drop t ;
-
-M: reg-class reg-class-full?
-    [ get ] swap '[ _ param-regs length ] bi >= ;
-
-: alloc-stack-param ( rep -- n reg-class rep )
-    stack-params get
-    [ rep-size cell align stack-params +@ ] dip
-    stack-params dup ;
-
-: alloc-fastcall-param ( rep -- n reg-class rep )
-    [ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
-
-:: alloc-parameter ( rep abi -- reg rep )
-    rep dup reg-class-of abi reg-class-full?
-    [ alloc-stack-param ] [ alloc-fastcall-param ] if
-    [ abi param-reg ] dip ;
-
-: reset-fastcall-counts ( -- )
-    { int-regs float-regs stack-params } [ 0 swap set ] each ;
-
-: with-param-regs ( quot -- )
-    #! In quot you can call alloc-parameter
-    [ reset-fastcall-counts call ] with-scope ; inline
-
-:: move-parameters ( params word -- )
-    #! Moves values from C stack to registers (if word is
-    #! %load-param-reg) and registers to C stack (if word is
-    #! %save-param-reg).
-    0 params alien-parameters flatten-c-types [
-        [ params abi>> alloc-parameter word execute( offset reg rep -- ) ]
-        [ rep-size cell align + ]
-        2bi
-    ] each drop ; inline
-
-: parameter-offsets ( types -- offsets )
-    0 [ stack-size + ] accumulate nip ;
-
-: each-parameter ( parameters quot -- )
-    [ [ parameter-offsets ] keep ] dip 2each ; inline
-
-: reverse-each-parameter ( parameters quot -- )
-    [ [ parameter-offsets ] keep ] dip 2reverse-each ; inline
-
-: prepare-unbox-parameters ( parameters -- offsets types indices )
-    [ parameter-offsets ] [ ] [ length iota <reversed> ] tri ;
-
-: unbox-parameters ( offset node -- )
-    parameters>> swap
-    '[ prepare-unbox-parameters [ %pop-stack [ _ + ] dip unbox-parameter ] 3each ]
-    [ length neg %inc-d ]
-    bi ;
-
-: prepare-box-struct ( node -- offset )
-    #! Return offset on C stack where to store unboxed
-    #! 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>> large-struct?
-    [ %prepare-box-struct cell ] [ 0 ] if ;
-
-: objects>registers ( params -- )
-    #! Generate code for unboxing a list of C types, then
-    #! generate code for moving these parameters to registers on
-    #! architectures where parameters are passed in registers.
-    [
-        [ prepare-box-struct ] keep
-        [ unbox-parameters ] keep
-        \ %load-param-reg move-parameters
-    ] with-param-regs ;
-
-: box-return* ( node -- )
-    return>> [ ] [ box-return %push-stack ] if-void ;
-
-GENERIC# dlsym-valid? 1 ( symbols dll -- ? )
-
-M: string dlsym-valid? dlsym ;
-
-M: array dlsym-valid? '[ _ dlsym ] any? ;
-
-: check-dlsym ( symbols dll -- )
-    dup dll-valid? [
-        dupd dlsym-valid?
-        [ drop ] [ compiling-word get no-such-symbol ] if
-    ] [
-        dll-path compiling-word get no-such-library drop
-    ] if ;
-
-: decorated-symbol ( params -- symbols )
-    [ function>> ] [ parameters>> [ stack-size ] map-sum number>string ] bi
-    {
-        [ drop ]
-        [ "@" glue ]
-        [ "@" glue "_" prepend ]
-        [ "@" glue "@" prepend ]
-    } 2cleave
-    4array ;
-
-: alien-invoke-dlsym ( params -- symbols dll )
-    [ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
-    [ library>> load-library ]
-    bi 2dup check-dlsym ;
-
-M: ##alien-invoke generate-insn
-    params>>
-    ! Unbox parameters
-    dup objects>registers
-    %prepare-var-args
-    ! Call function
-    dup alien-invoke-dlsym %alien-invoke
-    ! Box return value
-    dup %cleanup
-    box-return* ;
-
-M: ##alien-assembly generate-insn
-    params>>
-    ! Unbox parameters
-    dup objects>registers
-    %prepare-var-args
-    ! Generate assembly
-    dup quot>> call( -- )
-    ! Box return value
-    box-return* ;
-
-! ##alien-indirect
-M: ##alien-indirect generate-insn
-    params>>
-    ! Save alien at top of stack to temporary storage
-    %prepare-alien-indirect
-    ! Unbox parameters
-    dup objects>registers
-    %prepare-var-args
-    ! Call alien in temporary storage
-    %alien-indirect
-    ! Box return value
-    dup %cleanup
-    box-return* ;
-
-! ##alien-callback
-: box-parameters ( params -- )
-    alien-parameters [ box-parameter %push-context-stack ] each-parameter ;
-
-: registers>objects ( node -- )
-    ! Generate code for boxing input parameters in a callback.
-    [
-        dup \ %save-param-reg move-parameters
-        %begin-callback
-        box-parameters
-    ] with-param-regs ;
-
-: callback-return-quot ( ctype -- quot )
-    return>> {
-        { [ dup void? ] [ drop [ ] ] }
-        { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
-        [ c-type c-type-unboxer-quot ]
-    } cond ;
-
-: callback-prep-quot ( params -- quot )
-    parameters>> [ c-type c-type-boxer-quot ] map spread>quot ;
-
-: wrap-callback-quot ( params -- quot )
-    [ callback-prep-quot ] [ quot>> ] [ callback-return-quot ] tri 3append
-     yield-hook get
-     '[ _ _ do-callback ]
-     >quotation ;
-
-M: ##alien-callback generate-insn
-    params>>
-    [ registers>objects ]
-    [ wrap-callback-quot %alien-callback ]
-    [ alien-return [ %end-callback ] [ %end-callback-value ] if-void ] tri ;

basis/compiler/codegen/alien/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

basis/compiler/codegen/codegen.factor

@@ -91,6 +91,8 @@ M: ##dispatch generate-insn
 ! Special cases
 M: ##no-tco generate-insn drop ;
 
+M: ##stack-frame generate-insn drop ;
+
 M: ##prologue generate-insn
     drop
     cfg get stack-frame>>
@@ -251,6 +253,7 @@ CODEGEN: ##call-gc %call-gc
 CODEGEN: ##spill %spill
 CODEGEN: ##reload %reload
 
+! Conditional branches
 <<
 
 SYNTAX: CONDITIONAL:
@@ -270,3 +273,31 @@ CONDITIONAL: ##check-nursery-branch %check-nursery-branch
 CONDITIONAL: ##fixnum-add %fixnum-add
 CONDITIONAL: ##fixnum-sub %fixnum-sub
 CONDITIONAL: ##fixnum-mul %fixnum-mul
+
+! FFI
+CODEGEN: ##box %box
+CODEGEN: ##box-long-long %box-long-long
+CODEGEN: ##box-large-struct %box-large-struct
+CODEGEN: ##box-small-struct %box-small-struct
+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/compiler.factor

@@ -15,11 +15,11 @@ compiler.tree.optimizer
 
 compiler.cfg
 compiler.cfg.builder
+compiler.cfg.builder.alien
 compiler.cfg.optimizer
 compiler.cfg.finalization
 
-compiler.codegen
+compiler.codegen ;
-compiler.codegen.alien ;
 IN: compiler
 
 SYMBOL: compiled

basis/compiler/tests/alien.factor

@@ -610,11 +610,6 @@ FUNCTION: short ffi_test_48 ( bool-field-test x ) ;
 [ 200 ] [ thread-callback-2 thread-callback-invoker ] unit-test
 [ 100 ] [ "p" get ?promise ] unit-test
 
-! Regression: calling an undefined function would raise a protection fault
-FUNCTION: void this_does_not_exist ( ) ;
-
-[ this_does_not_exist ] [ { "kernel-error" 9 f f } = ] must-fail-with
-
 ! More alien-assembly tests are in cpu.* vocabs
 : assembly-test-1 ( -- ) void { } cdecl [ ] alien-assembly ;
 

basis/compiler/tests/linkage-errors.factor

@@ -0,0 +1,21 @@
+USING: tools.test namespaces assocs alien.syntax kernel
+compiler.errors accessors alien ;
+FROM: alien.libraries => add-library ;
+IN: compiler.tests.linkage-errors
+
+! Regression: calling an undefined function would raise a protection fault
+FUNCTION: void this_does_not_exist ( ) ;
+
+[ this_does_not_exist ] [ { "kernel-error" 9 f f } = ] must-fail-with
+
+[ T{ no-such-symbol { name "this_does_not_exist" } } ]
+[ \ this_does_not_exist linkage-errors get at error>> ] unit-test
+
+<< "no_such_library" "no_such_library" cdecl add-library >>
+
+LIBRARY: no_such_library
+
+FUNCTION: void no_such_function ( ) ;
+
+[ T{ no-such-library { name "no_such_library" } } ]
+[ \ no_such_function linkage-errors get at error>> ] unit-test

basis/cpu/architecture/architecture.factor

@@ -624,7 +624,9 @@ HOOK: %alien-callback cpu ( quot -- )
 
 HOOK: %end-callback cpu ( -- )
 
-HOOK: %end-callback-value cpu ( c-type -- )
+HOOK: %to-nv cpu ( -- )
+
+HOOK: %from-nv cpu ( -- )
 
 HOOK: stack-cleanup cpu ( params -- n )
 

basis/cpu/ppc/ppc.factor

@@ -836,14 +836,9 @@ M: ppc %end-callback ( -- )
     3 %load-vm-addr
     "end_callback" f %alien-invoke ;
 
-M: ppc %end-callback-value ( ctype -- )
+M: ppc %to-nv ( -- ) 16 3 MR ;
-    ! Save top of data stack
+
-    16 ds-reg 0 LWZ
+M: ppc %from-nv ( -- ) 3 16 MR ;
-    %end-callback
-    ! Restore top of data stack
-    3 16 MR
-    ! Unbox former top of data stack to return registers
-    unbox-return ;
 
 M: ppc %unbox-small-struct ( size -- )
     heap-size cell align cell /i {

basis/cpu/x86/32/32.factor

@@ -283,14 +283,9 @@ M: x86.32 %end-callback ( -- )
     0 save-vm-ptr
     "end_callback" f %alien-invoke ;
 
-M: x86.32 %end-callback-value ( ctype -- )
+M: x86.32 %to-nv ( -- ) 4 stack@ EAX MOV ;
-    %pop-context-stack
+
-    4 stack@ EAX MOV
+M: x86.32 %from-nv ( -- ) EAX 4 stack@ MOV ;
-    %end-callback
-    ! Place former top of data stack back in EAX
-    EAX 4 stack@ MOV
-    ! Unbox EAX
-    unbox-return ;
 
 GENERIC: float-function-param ( stack-slot dst src -- )
 

basis/cpu/x86/64/64.factor

@@ -249,13 +249,9 @@ M: x86.64 %end-callback ( -- )
     param-reg-0 %mov-vm-ptr
     "end_callback" f %alien-invoke ;
 
-M: x86.64 %end-callback-value ( ctype -- )
+M: x86.64 %to-nv ( -- ) nv-reg param-reg-0 MOV ;
-    %pop-context-stack
+
-    nv-reg param-reg-0 MOV
+M: x86.64 %from-nv ( -- ) param-reg-0 nv-reg MOV ;
-    %end-callback
-    param-reg-0 nv-reg MOV
-    ! Unbox former top of data stack to return registers
-    unbox-return ;
 
 : float-function-param ( i src -- )
     [ float-regs cdecl param-regs nth ] dip double-rep %copy ;