alien.*: frontend varargs support! #1677

alien-invoke gets an extra parameter indicating if the call uses varargs
or not. In 99.9% of the cases, the parameter should be f, but is t if
varargs are indicated. E.g

: do-printf ( fmt d -- st ) int f "printf" { c-string double } t alien-invoke ;

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

@@ -87,7 +87,7 @@ $nl
 "In " { $link POSTPONE: TYPEDEF: } ", " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: STRUCT: } " definitions, pointer types can be created by suffixing " { $snippet "*" } " to a C type name. Outside of FFI definitions, a pointer C type can be created using the " { $link POSTPONE: pointer: } " syntax word:"
 { $unchecked-example "FUNCTION: int* foo ( char* bar ) ;" }
 { $unchecked-example ": foo ( bar -- int* )
-    pointer: int f \"foo\" { pointer: char } alien-invoke ;" } } ;
+    pointer: int f \"foo\" { pointer: char } f alien-invoke ;" } } ;
 
 ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
 "The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."

basis/alien/libraries/unix/unix.factor

@@ -3,7 +3,7 @@ io.pathnames system ;
 IN: alien.libraries.unix
 
 : (dlerror) ( -- string )
-    \ c-string f "dlerror" { } alien-invoke ; inline
+    \ c-string f "dlerror" { } f alien-invoke ; inline
 
 M: unix dlerror (dlerror) ;
 

basis/alien/parser/parser.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.enums alien.libraries
-arrays classes classes.parser combinators
-combinators.short-circuit compiler.units effects fry kernel
-lexer locals math namespaces parser sequences splitting
-vocabs.parser words ;
+arrays classes classes.parser combinators combinators.short-circuit
+compiler.units effects fry kernel lexer locals math namespaces parser
+sequences splitting vocabs.parser words ;
 IN: alien.parser
 
 SYMBOL: current-library
@@ -122,9 +121,6 @@ PRIVATE>
         scan-token
     ] until drop types names [ >array ] bi@ ;
 
-: function-quot ( return library function types -- quot )
-    '[ _ _ _ _ alien-invoke ] ;
-
 : function-effect ( names return -- effect )
     [ { } ] [ return-type-name 1array ] if-void <effect> ;
 
@@ -132,7 +128,7 @@ PRIVATE>
     create-word-in dup reset-generic ;
 
 :: (make-function) ( return function library types names -- quot effect )
-    return library function types function-quot
+    return library function types '[ _ _ _ _ f alien-invoke ]
     names return function-effect ;
 
 :: make-function ( return function library types names -- word quot effect )
@@ -157,7 +153,7 @@ PRIVATE>
 
 PREDICATE: alien-function-alias-word < word
     def>> {
-        [ length 5 = ]
+        [ length 6 = ]
         [ last \ alien-invoke eq? ]
     } 1&& ;
 

basis/cocoa/messages/messages.factor

@@ -12,7 +12,7 @@ IN: cocoa.messages
 SPECIALIZED-ARRAY: void*
 
 : make-sender ( signature function -- quot )
-    [ over first , f , , second , \ alien-invoke , ] [ ] make ;
+    [ over first , f , , second , f , \ alien-invoke , ] [ ] make ;
 
 : sender-stub-name ( signature -- str )
     first2 [ name>> ] [

basis/compiler/cfg/builder/builder-tests.factor

@@ -77,7 +77,7 @@ IN: compiler.cfg.builder.tests
     [ [ t ] loop ]
     [ [ dup ] loop ]
     [ [ 2 ] [ 3 throw ] if 4 ]
-    [ int f "malloc" { int } alien-invoke ]
+    [ int f "malloc" { int } f alien-invoke ]
     [ int { int } cdecl alien-indirect ]
     [ int { int } cdecl [ ] alien-callback ]
     [ swap - + * ]

basis/compiler/tests/alien.factor

@@ -136,13 +136,13 @@ unit-test
 [ stdcall ] [ "f-stdcall" lookup-library abi>> ] unit-test
 
 : ffi_test_18 ( w x y z -- int )
-    int "f-stdcall" "ffi_test_18" { int int int int }
+    int "f-stdcall" "ffi_test_18" { int int int int } f
     alien-invoke gc ;
 
 [ 25 ] [ 2 3 4 5 ffi_test_18 ] unit-test
 
 : ffi_test_19 ( x y z -- BAR )
-    BAR "f-stdcall" "ffi_test_19" { long long long }
+    BAR "f-stdcall" "ffi_test_19" { long long long } f
     alien-invoke gc ;
 
 [ 11 6 -7 ] [
@@ -150,9 +150,9 @@ unit-test
 ] unit-test
 
 : multi_ffi_test_18 ( w x y z w' x' y' z' -- int int )
-    [ int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke ]
+    [ int "f-stdcall" "ffi_test_18" { int int int int } f alien-invoke ]
     4 ndip
-    int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke
+    int "f-stdcall" "ffi_test_18" { int int int int } f alien-invoke
     gc ;
 
 [ 25 85 ] [ 2 3 4 5 6 7 8 9 multi_ffi_test_18 ] unit-test
@@ -181,7 +181,7 @@ FUNCTION: void ffi_test_20 ( double x1, double x2, double x3,
 : ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y )
     int
     "f-cdecl" "ffi_test_31"
-    { int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int }
+    { int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int } f
     alien-invoke gc 3 ;
 
 [ 861 3 ] [ 42 [ ] each-integer ffi_test_31 ] unit-test
@@ -189,7 +189,7 @@ FUNCTION: void ffi_test_20 ( double x1, double x2, double x3,
 : ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
     float
     "f-cdecl" "ffi_test_31_point_5"
-    { float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float }
+    { float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float } f
     alien-invoke ;
 
 [ 861.0 ] [ 42 [ >float ] each-integer ffi_test_31_point_5 ] unit-test
@@ -646,18 +646,18 @@ os windows? [
 [ fastcall ] [ "f-fastcall" lookup-library abi>> ] unit-test
 
 : ffi_test_49 ( x -- int )
-    int "f-fastcall" "ffi_test_49" { int }
+    int "f-fastcall" "ffi_test_49" { int } f
     alien-invoke gc ;
 : ffi_test_50 ( x y -- int )
-    int "f-fastcall" "ffi_test_50" { int int }
+    int "f-fastcall" "ffi_test_50" { int int } f
     alien-invoke gc ;
 : ffi_test_51 ( x y z -- int )
-    int "f-fastcall" "ffi_test_51" { int int int }
+    int "f-fastcall" "ffi_test_51" { int int int } f
     alien-invoke gc ;
 : multi_ffi_test_51 ( x y z x' y' z' -- int int )
-    [ int "f-fastcall" "ffi_test_51" { int int int } alien-invoke ]
+    [ int "f-fastcall" "ffi_test_51" { int int int } f alien-invoke ]
     3dip
-    int "f-fastcall" "ffi_test_51" { int int int } alien-invoke gc ;
+    int "f-fastcall" "ffi_test_51" { int int int } f alien-invoke gc ;
 
 [ 4 ] [ 3 ffi_test_49 ] unit-test
 [ 8 ] [ 3 4 ffi_test_50 ] unit-test
@@ -665,16 +665,16 @@ os windows? [
 [ 13 22 ] [ 3 4 5 6 7 8 multi_ffi_test_51 ] unit-test
 
 : ffi_test_52 ( x y z -- int )
-    int "f-fastcall" "ffi_test_52" { int float int }
+    int "f-fastcall" "ffi_test_52" { int float int } f
     alien-invoke gc ;
 : ffi_test_53 ( x y z w -- int )
-    int "f-fastcall" "ffi_test_53" { int float int int }
+    int "f-fastcall" "ffi_test_53" { int float int int } f
     alien-invoke gc ;
 : ffi_test_57 ( x y -- test-struct-11 )
-    test-struct-11 "f-fastcall" "ffi_test_57" { int int }
+    test-struct-11 "f-fastcall" "ffi_test_57" { int int } f
     alien-invoke gc ;
 : ffi_test_58 ( x y z -- test-struct-11 )
-    test-struct-11 "f-fastcall" "ffi_test_58" { int int int }
+    test-struct-11 "f-fastcall" "ffi_test_58" { int int int } f
     alien-invoke gc ;
 
 ! Make sure that large longlong/ulonglong are correctly dealt with
@@ -938,7 +938,7 @@ FUNCTION: void* bug1021_test_1 ( void* s, int x )
 FUNCTION-ALIAS: do-sum-ints2 int ffi_test_64 ( int n, int a, int b )
 FUNCTION-ALIAS: do-sum-ints3 int ffi_test_64 ( int n, int a, int b, int c )
 
-{ 30 60  } [
+{ 30 60 } [
     2 10 20 do-sum-ints2
     3 10 20 30 do-sum-ints3
 ] unit-test

basis/compiler/tests/codegen.factor

@@ -257,8 +257,8 @@ TUPLE: id obj ;
     { float } declare dup 0 =
     [ drop 1 ] [
         dup 0 >=
-        [ 2 double "libm" "pow" { double double } alien-invoke ]
-        [ -0.5 double "libm" "pow" { double double } alien-invoke ]
+        [ 2 double "libm" "pow" { double double } f alien-invoke ]
+        [ -0.5 double "libm" "pow" { double double } f alien-invoke ]
         if
     ] if ;
 
@@ -476,8 +476,8 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
 : gc-root-messup ( a -- b )
     dup [
         1024 (byte-array) 2array
-        10 void* "libc" "malloc" { ulong } alien-invoke
-        void "libc" "free" { void* } alien-invoke
+        10 void* "libc" "malloc" { ulong } f alien-invoke
+        void "libc" "free" { void* } f alien-invoke
     ] when ;
 
 [ ] [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test

basis/stack-checker/alien/alien.factor

@@ -41,27 +41,31 @@ TUPLE: alien-callback-params < alien-node-params
 : infer-return ( params -- )
     return-prep-quot infer-quot-here ;
 
-: pop-return ( params -- params )
-    pop-literal [ add-depends-on-c-type ] [ >>return ] bi ;
-
-: pop-library ( params -- params )
-    pop-literal >>library ;
+: pop-abi ( params -- params )
+    pop-literal >>abi ;
 
 : pop-function ( params -- params )
     pop-literal >>function ;
 
+: pop-library ( params -- params )
+    pop-literal >>library ;
+
 : pop-params ( params -- params )
     pop-literal [ [ add-depends-on-c-type ] each ] [ >>parameters ] bi ;
 
-: pop-abi ( params -- params )
-    pop-literal >>abi ;
-
 : pop-quot ( params -- params )
     pop-literal >>quot ;
 
+: pop-return ( params -- params )
+    pop-literal [ add-depends-on-c-type ] [ >>return ] bi ;
+
+: pop-varargs? ( params -- params )
+    pop-literal >>varargs? ;
+
 : infer-alien-invoke ( -- )
     alien-invoke-params new
     ! Compile-time parameters
+    pop-varargs?
     pop-params
     pop-function
     pop-library

basis/ui/backend/cocoa/views/views.factor

@@ -170,10 +170,10 @@ CLASS: FactorView < NSOpenGLView
         -> respondsToSelector: c-bool> [
 
             self SEL: setWantsBestResolutionOpenGLSurface: 1
-            void f "objc_msgSend" { id SEL char } alien-invoke
+            void f "objc_msgSend" { id SEL char } f alien-invoke
 
             self SEL: backingScaleFactor
-            double f "objc_msgSend" { id SEL } alien-invoke
+            double f "objc_msgSend" { id SEL } f alien-invoke
 
             dup 1.0 > [
                 gl-scale-factor set-global t retina? set-global
@@ -416,7 +416,7 @@ CLASS: FactorWindowDelegate < NSObject
         -> respondsToSelector: c-bool> [
 
             SEL: backingScaleFactor
-            double f "objc_msgSend" { id SEL } alien-invoke
+            double f "objc_msgSend" { id SEL } f alien-invoke
 
             [ [ 1.0 > ] keep f ? gl-scale-factor set-global ]
             [ 1.0 > retina? set-global ] bi

core/alien/alien-tests.factor

@@ -125,4 +125,4 @@ SYMBOL: foo
 ] unit-test
 
 [ void { } cdecl [ ] alien-assembly ] [ callsite-not-compiled? ] must-fail-with
-[ void f "flor" { } alien-invoke ] [ callsite-not-compiled? ] must-fail-with
+[ void f "flor" { } f alien-invoke ] [ callsite-not-compiled? ] must-fail-with

core/alien/alien.factor

@@ -94,7 +94,7 @@ ERROR: callsite-not-compiled word ;
 : alien-indirect ( args... funcptr return parameters abi -- return... )
     \ alien-indirect callsite-not-compiled ;
 
-: alien-invoke ( args... return library function parameters -- return... )
+: alien-invoke ( args... return library function parameters varargs? -- return... )
     \ alien-invoke callsite-not-compiled ;
 
 <PRIVATE

extra/alien/fortran/fortran-tests.factor

@@ -202,7 +202,7 @@ intel-unix-abi fortran-abi [
         ! [fortran-invoke]
         [
             c:void "funpack" "funtimes_"
-            { pointer: { c:char 12 } pointer: c:longlong pointer: c:float pointer: complex-float pointer: c:short c:long }
+            { pointer: { c:char 12 } pointer: c:longlong pointer: c:float pointer: complex-float pointer: c:short c:long } f
             alien-invoke
         ] 6 nkeep
         ! [fortran-results>]
@@ -227,7 +227,7 @@ intel-unix-abi fortran-abi [
             [ { [ drop ] } spread ]
         } 1 ncleave
         ! [fortran-invoke]
-        [ c:float "funpack" "fun_times_" { pointer: { c:float 0 } } alien-invoke ]
+        [ c:float "funpack" "fun_times_" { pointer: { c:float 0 } } f alien-invoke ]
         1 nkeep
         ! [fortran-results>]
         shuffle( reta aa -- reta aa )
@@ -245,7 +245,7 @@ intel-unix-abi fortran-abi [
         ! [fortran-invoke]
         [
             c:void "funpack" "fun_times_"
-            { pointer: complex-float pointer: { c:float 0 } }
+            { pointer: complex-float pointer: { c:float 0 } } f
             alien-invoke
         ] 2 nkeep
         ! [fortran-results>]
@@ -262,7 +262,7 @@ intel-unix-abi fortran-abi [
         ! [fortran-invoke]
         [
             c:void "funpack" "fun_times_"
-            { pointer: { c:char 20 } long }
+            { pointer: { c:char 20 } long } f
             alien-invoke
         ] 2 nkeep
         ! [fortran-results>]
@@ -288,7 +288,7 @@ intel-unix-abi fortran-abi [
         ! [fortran-invoke]
         [
             c:void "funpack" "fun_times_"
-            { pointer: { c:char 10 } long pointer: { c:char 20 } pointer: c:float pointer: { c:char 30 } c:long c:long }
+            { pointer: { c:char 10 } long pointer: { c:char 20 } pointer: c:float pointer: { c:char 30 } c:long c:long } f
             alien-invoke
         ] 7 nkeep
         ! [fortran-results>]

extra/alien/fortran/fortran.factor

@@ -329,8 +329,8 @@ M: character-type (<fortran-result>)
     return parameters fortran-sig>c-sig :> ( c-return c-parameters )
     function fortran-name>symbol-name :> c-function
     [args>args]
-    c-return library c-function c-parameters \ alien-invoke
-    5 [ ] nsequence
+    c-return library c-function c-parameters f \ alien-invoke
+    6 [ ] nsequence
     c-parameters length \ nkeep
     [ ] 3sequence ;
 

extra/fjsc/resources/bootstrap.factor

@@ -7,14 +7,14 @@ USE: kernel-internals
 
 : elements ( string -- result )
   ! Call JQuery's $ function
-  window { "result" } "" "$" { "string" } alien-invoke ;
-  
-: html ( string -- element ) 
+  window { "result" } "" "$" { "string" } f alien-invoke ;
+
+: html ( string -- element )
   ! Set the innerHTML of element using jQuery
-  { } "" "html" { "string" } alien-invoke ;
+  { } "" "html" { "string" } f alien-invoke ;
 
 : bind-event ( name element quot -- )
-  >function swap { } "" "with-variables" { "string" "function" } alien-invoke ;
+  >function swap { } "" "with-variables" { "string" "function" } f alien-invoke ;
 
 "scratchpad" set-in
 
@@ -31,9 +31,9 @@ USE: kernel-internals
       "Waiting for click on button" alert
       continue
     ] callcc0
-    drop "Click done!" alert 
+    drop "Click done!" alert
   ] callcc0 ;
-  
+
 : alert ( string -- )
   ! Display the string in an alert box
-  window { } "" "alert" { "string" } alien-invoke ;
+  window { } "" "alert" { "string" } f alien-invoke ;