diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index bf35d968af..1da75ac00e 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/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." diff --git a/basis/alien/libraries/unix/unix.factor b/basis/alien/libraries/unix/unix.factor index c0fd232caa..10944505fb 100644 --- a/basis/alien/libraries/unix/unix.factor +++ b/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) ; diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index a0c1bf7f52..0a813df47d 100755 --- a/basis/alien/parser/parser.factor +++ b/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 ; @@ -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&& ; diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 0b641b5c01..0324565e96 100644 --- a/basis/cocoa/messages/messages.factor +++ b/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>> ] [ diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 5600014195..e1647e378b 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/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 - + * ] diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 1d40f87336..4d8a37a71e 100755 --- a/basis/compiler/tests/alien.factor +++ b/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 diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 2e5ed643b2..cab83b89ac 100644 --- a/basis/compiler/tests/codegen.factor +++ b/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 diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index aa78632e0b..334fd160f1 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/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 diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 565c5acbaa..b4c594f7fc 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/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 diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor index 0732e877ed..d49ea4b890 100644 --- a/core/alien/alien-tests.factor +++ b/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 diff --git a/core/alien/alien.factor b/core/alien/alien.factor index b3f25ca953..9940151b61 100755 --- a/core/alien/alien.factor +++ b/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 ; ] @@ -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>] diff --git a/extra/alien/fortran/fortran.factor b/extra/alien/fortran/fortran.factor index 34405c6c87..4f0633b5d0 100755 --- a/extra/alien/fortran/fortran.factor +++ b/extra/alien/fortran/fortran.factor @@ -329,8 +329,8 @@ M: character-type () 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 ; diff --git a/extra/fjsc/resources/bootstrap.factor b/extra/fjsc/resources/bootstrap.factor index 0b7ec5f74a..9ad323a20a 100644 --- a/extra/fjsc/resources/bootstrap.factor +++ b/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 ;