<<
: add-f2c-libraries ( -- )
- "I77" "libI77.so" "cdecl" add-library
- "F77" "libF77.so" "cdecl" add-library ;
+ "I77" "libI77.so" cdecl add-library
+ "F77" "libF77.so" cdecl add-library ;
os netbsd? [ add-f2c-libraries ] when
>>
[ "__" append ] [ "_" append ] if ;
HOOK: fortran-c-abi fortran-abi ( -- abi )
-M: f2c-abi fortran-c-abi "cdecl" ;
-M: g95-abi fortran-c-abi "cdecl" ;
-M: gfortran-abi fortran-c-abi "cdecl" ;
-M: intel-unix-abi fortran-c-abi "cdecl" ;
-M: intel-windows-abi fortran-c-abi "cdecl" ;
+M: f2c-abi fortran-c-abi cdecl ;
+M: g95-abi fortran-c-abi cdecl ;
+M: gfortran-abi fortran-c-abi cdecl ;
+M: intel-unix-abi fortran-c-abi cdecl ;
+M: intel-windows-abi fortran-c-abi cdecl ;
HOOK: real-functions-return-double? fortran-abi ( -- ? )
M: f2c-abi real-functions-return-double? t ;
HELP: <library>
{ $values
- { "path" "a pathname string" } { "abi" "the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
+ { "path" "a pathname string" } { "abi" "the ABI used by the library, either " { $link cdecl } " or " { $link stdcall } }
{ "library" library } }
{ $description "Opens a C library using the path and ABI parameters and outputs a library tuple." }
{ $notes "User code should use " { $link add-library } " so that the opened library is added to a global hashtable, " { $link libraries } "." } ;
{ $description "Looks up a library by its logical name. The library object is a hashtable with the following keys:"
{ $list
{ { $snippet "name" } " - the full path of the C library binary" }
- { { $snippet "abi" } " - the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
+ { { $snippet "abi" } " - the ABI used by the library, either " { $link cdecl } " or " { $link stdcall } }
{ { $snippet "dll" } " - an instance of the " { $link dll } " class; only set if the library is loaded" }
}
} ;
{ $description "Loads a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } ". If the library is already loaded, returns the existing handle." } ;
HELP: add-library
-{ $values { "name" string } { "path" string } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } }
+{ $values { "name" string } { "path" string } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } }
{ $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } " and the specified ABI. The logical library name can then be used by a " { $link POSTPONE: LIBRARY: } " form to specify the logical library for subsequent " { $link POSTPONE: FUNCTION: } " definitions." }
{ $notes "Because the entire source file is parsed before top-level forms are executed, " { $link add-library } " must be placed within a " { $snippet "<< ... >>" } " parse-time evaluation block."
$nl
{ $examples "Here is a typical usage of " { $link add-library } ":"
{ $code
"<< \"freetype\" {"
- " { [ os macosx? ] [ \"libfreetype.6.dylib\" \"cdecl\" add-library ] }"
- " { [ os windows? ] [ \"freetype6.dll\" \"cdecl\" add-library ] }"
+ " { [ os macosx? ] [ \"libfreetype.6.dylib\" cdecl add-library ] }"
+ " { [ os windows? ] [ \"freetype6.dll\" cdecl add-library ] }"
" [ drop ]"
"} cond >>"
}
[ <library> swap libraries get set-at ] 3bi ;
: library-abi ( library -- abi )
- library [ abi>> ] [ "cdecl" ] if* ;
+ library [ abi>> ] [ cdecl ] if* ;
SYMBOL: deploy-libraries
IN: alien.remote-control
: eval-callback ( -- callback )
- void* { c-string } "cdecl"
+ void* { c-string } cdecl
[ eval>string utf8 malloc-string ] alien-callback ;
: yield-callback ( -- callback )
- void { } "cdecl" [ yield ] alien-callback ;
+ void { } cdecl [ yield ] alien-callback ;
: sleep-callback ( -- callback )
- void { long } "cdecl" [ sleep ] alien-callback ;
+ void { long } cdecl [ sleep ] alien-callback ;
: ?callback ( word -- alien )
dup optimized? [ execute ] [ drop f ] if ; inline
IN: cairo.ffi
<< {
- { [ os winnt? ] [ "cairo" "libcairo-2.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "cairo" "/opt/local/lib/libcairo.dylib" "cdecl" add-library ] }
+ { [ os winnt? ] [ "cairo" "libcairo-2.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "cairo" "/opt/local/lib/libcairo.dylib" cdecl add-library ] }
{ [ os unix? ] [ ] }
} cond >>
TYPEDEF: void* cairo_destroy_func_t
: cairo-destroy-func ( quot -- callback )
- [ void { pointer: void } "cdecl" ] dip alien-callback ; inline
+ [ void { pointer: void } cdecl ] dip alien-callback ; inline
! See cairo.h for details
STRUCT: cairo_user_data_key_t
TYPEDEF: void* cairo_write_func_t
: cairo-write-func ( quot -- callback )
- [ cairo_status_t { pointer: void c-string int } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { pointer: void c-string int } cdecl ] dip alien-callback ; inline
TYPEDEF: void* cairo_read_func_t
: cairo-read-func ( quot -- callback )
- [ cairo_status_t { pointer: void c-string int } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { pointer: void c-string int } cdecl ] dip alien-callback ; inline
! Functions for manipulating state objects
FUNCTION: cairo_t*
: prepare-method ( ret types quot -- type imp )
[ [ encode-types ] 2keep ] dip
- '[ _ _ "cdecl" _ alien-callback ]
+ '[ _ _ cdecl _ alien-callback ]
(( -- callback )) define-temp ;
: prepare-methods ( methods -- methods )
: alien-parameters ( params -- seq )
dup parameters>>
- swap return>> large-struct? [ void* prefix ] when ;
+ swap return>> large-struct? [ struct-return-pointer-type prefix ] when ;
: alien-return ( params -- type )
return>> dup large-struct? [ drop void ] when ;
[ [ dup ] loop ]
[ [ 2 ] [ 3 throw ] if 4 ]
[ int f "malloc" { int } alien-invoke ]
- [ int { int } "cdecl" alien-indirect ]
- [ int { int } "cdecl" [ ] alien-callback ]
+ [ int { int } cdecl alien-indirect ]
+ [ int { int } cdecl [ ] alien-callback ]
[ swap - + * ]
[ swap slot ]
[ blahblah ]
M: double-rep next-fastcall-param
float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
-GENERIC: reg-class-full? ( reg-class -- ? )
+GENERIC# reg-class-full? 1 ( reg-class abi -- ? )
-M: stack-params reg-class-full? drop t ;
+M: stack-params reg-class-full? 2drop t ;
M: reg-class reg-class-full?
- [ get ] [ param-regs length ] bi >= ;
+ [ get ] swap '[ _ param-regs length ] bi >= ;
: alloc-stack-param ( rep -- n reg-class rep )
stack-params get
: alloc-fastcall-param ( rep -- n reg-class rep )
[ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
-: alloc-parameter ( parameter -- reg rep )
- c-type-rep dup reg-class-of reg-class-full?
+:: alloc-parameter ( parameter abi -- reg rep )
+ parameter c-type-rep dup reg-class-of abi reg-class-full?
[ alloc-stack-param ] [ alloc-fastcall-param ] if
- [ param-reg ] dip ;
+ [ abi param-reg ] dip ;
+
+SYMBOL: (stack-value)
+<< void* c-type clone \ (stack-value) define-primitive-type
+stack-params \ (stack-value) c-type (>>rep) >>
+
+: ((flatten-type)) ( type to-type -- seq )
+ [ stack-size cell align cell /i ] dip c-type <repetition> ; inline
: (flatten-int-type) ( type -- seq )
- stack-size cell align cell /i void* c-type <repetition> ;
+ void* ((flatten-type)) ;
+: (flatten-stack-type) ( type -- seq )
+ (stack-value) ((flatten-type)) ;
GENERIC: flatten-value-type ( type -- types )
#! Moves values from C stack to registers (if word is
#! %load-param-reg) and registers to C stack (if word is
#! %save-param-reg).
- [ alien-parameters flatten-value-types ]
- [ '[ alloc-parameter _ execute ] ]
+ [ [ alien-parameters flatten-value-types ] [ abi>> ] bi ]
+ [ '[ _ alloc-parameter _ execute ] ]
bi* each-parameter ; inline
: reverse-each-parameter ( parameters quot -- )
3array ;
: alien-invoke-dlsym ( params -- symbols dll )
- [ dup abi>> "stdcall" = [ stdcall-mangle ] [ function>> ] if ]
+ [ dup abi>> stdcall = [ stdcall-mangle ] [ function>> ] if ]
[ library>> load-library ]
bi 2dup check-dlsym ;
USING: accessors alien alien.c-types alien.libraries
alien.syntax arrays classes.struct combinators
-compiler continuations effects io io.backend io.pathnames
-io.streams.string kernel math memory namespaces
-namespaces.private parser quotations sequences
-specialized-arrays stack-checker stack-checker.errors
-system threads tools.test words alien.complex concurrency.promises ;
+compiler continuations effects generalizations io
+io.backend io.pathnames io.streams.string kernel
+math memory namespaces namespaces.private parser
+quotations sequences specialized-arrays stack-checker
+stack-checker.errors system threads tools.test words
+alien.complex concurrency.promises ;
FROM: alien.c-types => float short ;
+FROM: alien.private => fastcall ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char
IN: compiler.tests.alien
{ [ os unix? ] [ "libfactor-ffi-test.so" ] }
} cond append-path ;
-"f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
+"f-cdecl" libfactor-ffi-tests-path cdecl add-library
-"f-stdcall" libfactor-ffi-tests-path "stdcall" add-library
+"f-stdcall" libfactor-ffi-tests-path stdcall add-library
+
+"f-fastcall" libfactor-ffi-tests-path fastcall add-library
>>
LIBRARY: f-cdecl
[ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
: indirect-test-1 ( ptr -- result )
- int { } "cdecl" alien-indirect ;
+ int { } cdecl alien-indirect ;
{ 1 1 } [ indirect-test-1 ] must-infer-as
[ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
: indirect-test-1' ( ptr -- )
- int { } "cdecl" alien-indirect drop ;
+ int { } cdecl alien-indirect drop ;
{ 1 0 } [ indirect-test-1' ] must-infer-as
[ -1 indirect-test-1 ] must-fail
: indirect-test-2 ( x y ptr -- result )
- int { int int } "cdecl" alien-indirect gc ;
+ int { int int } cdecl alien-indirect gc ;
{ 3 1 } [ indirect-test-2 ] must-infer-as
unit-test
: indirect-test-3 ( a b c d ptr -- result )
- int { int int int int } "stdcall" alien-indirect
+ int { int int int int } stdcall alien-indirect
gc ;
[ f ] [ "f-stdcall" load-library f = ] unit-test
-[ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test
+[ stdcall ] [ "f-stdcall" library abi>> ] unit-test
: ffi_test_18 ( w x y z -- int )
int "f-stdcall" "ffi_test_18" { int int int int }
11 6 -7 ffi_test_19 [ x>> ] [ y>> ] [ z>> ] tri
] 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 ]
+ 4 ndip
+ int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke
+ gc ;
+
+[ 25 85 ] [ 2 3 4 5 6 7 8 9 multi_ffi_test_18 ] unit-test
+
FUNCTION: double ffi_test_6 float x float y ;
[ 6.0 ] [ 3.0 2.0 ffi_test_6 ] unit-test
[ "a" "b" ffi_test_6 ] must-fail
! Test callbacks
-: callback-1 ( -- callback ) void { } "cdecl" [ ] alien-callback ;
+: callback-1 ( -- callback ) void { } cdecl [ ] alien-callback ;
[ 0 1 ] [ [ callback-1 ] infer [ in>> length ] [ out>> length ] bi ] unit-test
[ t ] [ callback-1 alien? ] unit-test
-: callback_test_1 ( ptr -- ) void { } "cdecl" alien-indirect ;
+: callback_test_1 ( ptr -- ) void { } cdecl alien-indirect ;
[ ] [ callback-1 callback_test_1 ] unit-test
-: callback-2 ( -- callback ) void { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
+: callback-2 ( -- callback ) void { } cdecl [ [ 5 throw ] ignore-errors ] alien-callback ;
[ ] [ callback-2 callback_test_1 ] unit-test
-: callback-3 ( -- callback ) void { } "cdecl" [ 5 "x" set ] alien-callback ;
+: callback-3 ( -- callback ) void { } cdecl [ 5 "x" set ] alien-callback ;
[ t 3 5 ] [
[
] unit-test
: callback-5 ( -- callback )
- void { } "cdecl" [ gc ] alien-callback ;
+ void { } cdecl [ gc ] alien-callback ;
[ "testing" ] [
"testing" callback-5 callback_test_1
] unit-test
: callback-5b ( -- callback )
- void { } "cdecl" [ compact-gc ] alien-callback ;
+ void { } cdecl [ compact-gc ] alien-callback ;
[ "testing" ] [
"testing" callback-5b callback_test_1
] unit-test
: callback-6 ( -- callback )
- void { } "cdecl" [ [ continue ] callcc0 ] alien-callback ;
+ void { } cdecl [ [ continue ] callcc0 ] alien-callback ;
[ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
: callback-7 ( -- callback )
- void { } "cdecl" [ 1000000 sleep ] alien-callback ;
+ void { } cdecl [ 1000000 sleep ] alien-callback ;
[ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test
[ f ] [ namespace global eq? ] unit-test
: callback-8 ( -- callback )
- void { } "cdecl" [ [ ] in-thread yield ] alien-callback ;
+ void { } cdecl [ [ ] in-thread yield ] alien-callback ;
[ ] [ callback-8 callback_test_1 ] unit-test
: callback-9 ( -- callback )
- int { int int int } "cdecl" [
+ int { int int int } cdecl [
+ + 1 +
] alien-callback ;
} cleave ;
: double-rect-callback ( -- alien )
- void { void* void* double-rect } "cdecl"
+ void { void* void* double-rect } cdecl
[ "example" set-global 2drop ] alien-callback ;
-: double-rect-test ( arg callback -- arg' )
+: double-rect-test ( arg -- arg' )
[ f f ] 2dip
- void { void* void* double-rect } "cdecl" alien-indirect
+ double-rect-callback
+ void { void* void* double-rect } cdecl alien-indirect
"example" get-global ;
[ 1.0 2.0 3.0 4.0 ]
] unit-test
: callback-10 ( -- callback )
- test_struct_14 { double double } "cdecl"
+ test_struct_14 { double double } cdecl
[
test_struct_14 <struct>
swap >>x2
] alien-callback ;
: callback-10-test ( x1 x2 callback -- result )
- test_struct_14 { double double } "cdecl" alien-indirect ;
+ test_struct_14 { double double } cdecl alien-indirect ;
[ 1.0 2.0 ] [
1.0 2.0 callback-10 callback-10-test
] unit-test
: callback-11 ( -- callback )
- test-struct-12 { int double } "cdecl"
+ test-struct-12 { int double } cdecl
[
test-struct-12 <struct>
swap >>x
] alien-callback ;
: callback-11-test ( x1 x2 callback -- result )
- test-struct-12 { int double } "cdecl" alien-indirect ;
+ test-struct-12 { int double } cdecl alien-indirect ;
[ 1 2.0 ] [
1 2.0 callback-11 callback-11-test
[ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test
: callback-12 ( -- callback )
- test_struct_15 { float float } "cdecl"
+ test_struct_15 { float float } cdecl
[
test_struct_15 <struct>
swap >>y
] alien-callback ;
: callback-12-test ( x1 x2 callback -- result )
- test_struct_15 { float float } "cdecl" alien-indirect ;
+ test_struct_15 { float float } cdecl alien-indirect ;
[ 1.0 2.0 ] [
1.0 2.0 callback-12 callback-12-test [ x>> ] [ y>> ] bi
[ 1.0 2 ] [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test
: callback-13 ( -- callback )
- test_struct_16 { float int } "cdecl"
+ test_struct_16 { float int } cdecl
[
test_struct_16 <struct>
swap >>a
] alien-callback ;
: callback-13-test ( x1 x2 callback -- result )
- test_struct_16 { float int } "cdecl" alien-indirect ;
+ test_struct_16 { float int } cdecl alien-indirect ;
[ 1.0 2 ] [
1.0 2 callback-13 callback-13-test
! Test interaction between threads and callbacks
: thread-callback-1 ( -- callback )
- int { } "cdecl" [ yield 100 ] alien-callback ;
+ int { } cdecl [ yield 100 ] alien-callback ;
: thread-callback-2 ( -- callback )
- int { } "cdecl" [ yield 200 ] alien-callback ;
+ int { } cdecl [ yield 200 ] alien-callback ;
: thread-callback-invoker ( callback -- n )
- int { } "cdecl" alien-indirect ;
+ int { } cdecl alien-indirect ;
<promise> "p" set
[ thread-callback-1 thread-callback-invoker "p" get fulfill ] in-thread
[ 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 ;
+: assembly-test-1 ( -- ) void { } cdecl [ ] alien-assembly ;
[ ] [ assembly-test-1 ] unit-test
+
+[ f ] [ "f-fastcall" load-library f = ] unit-test
+[ fastcall ] [ "f-fastcall" library abi>> ] unit-test
+
+: ffi_test_49 ( x -- int )
+ int "f-fastcall" "ffi_test_49" { int }
+ alien-invoke gc ;
+: ffi_test_50 ( x y -- int )
+ int "f-fastcall" "ffi_test_50" { int int }
+ alien-invoke gc ;
+: ffi_test_51 ( x y z -- int )
+ int "f-fastcall" "ffi_test_51" { int int int }
+ 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 ]
+ 3dip
+ int "f-fastcall" "ffi_test_51" { int int int } alien-invoke gc ;
+
+[ 4 ] [ 3 ffi_test_49 ] unit-test
+[ 8 ] [ 3 4 ffi_test_50 ] unit-test
+[ 13 ] [ 3 4 5 ffi_test_51 ] unit-test
+[ 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 }
+ alien-invoke gc ;
+: ffi_test_53 ( x y z w -- int )
+ int "f-fastcall" "ffi_test_53" { int float int int }
+ alien-invoke gc ;
+: ffi_test_57 ( x y -- test-struct-11 )
+ test-struct-11 "f-fastcall" "ffi_test_57" { int int }
+ alien-invoke gc ;
+: ffi_test_58 ( x y z -- test-struct-11 )
+ test-struct-11 "f-fastcall" "ffi_test_58" { int int int }
+ alien-invoke gc ;
+
+[ 13 ] [ 3 4.0 5 ffi_test_52 ] unit-test
+[ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
+[ S{ test-struct-11 f 7 -1 } ] [ 3 4 ffi_test_57 ] unit-test
+[ S{ test-struct-11 f 7 -3 } ] [ 3 4 7 ffi_test_58 ] unit-test
+
+: fastcall-ii-indirect ( x y ptr -- result )
+ int { int int } fastcall alien-indirect ;
+: fastcall-iii-indirect ( x y z ptr -- result )
+ int { int int int } fastcall alien-indirect ;
+: fastcall-ifi-indirect ( x y z ptr -- result )
+ int { int float int } fastcall alien-indirect ;
+: fastcall-ifii-indirect ( x y z w ptr -- result )
+ int { int float int int } fastcall alien-indirect ;
+: fastcall-struct-return-ii-indirect ( x y ptr -- result )
+ test-struct-11 { int int } fastcall alien-indirect ;
+: fastcall-struct-return-iii-indirect ( x y z ptr -- result )
+ test-struct-11 { int int int } fastcall alien-indirect ;
+
+[ 8 ] [ 3 4 &: ffi_test_50 fastcall-ii-indirect ] unit-test
+[ 13 ] [ 3 4 5 &: ffi_test_51 fastcall-iii-indirect ] unit-test
+[ 13 ] [ 3 4.0 5 &: ffi_test_52 fastcall-ifi-indirect ] unit-test
+[ 19 ] [ 3 4.0 5 6 &: ffi_test_53 fastcall-ifii-indirect ] unit-test
+
+[ S{ test-struct-11 f 7 -1 } ]
+[ 3 4 &: ffi_test_57 fastcall-struct-return-ii-indirect ] unit-test
+
+[ S{ test-struct-11 f 7 -3 } ]
+[ 3 4 7 &: ffi_test_58 fastcall-struct-return-iii-indirect ] unit-test
+
+: fastcall-ii-callback ( -- ptr )
+ int { int int } fastcall [ + 1 + ] alien-callback ;
+: fastcall-iii-callback ( -- ptr )
+ int { int int int } fastcall [ + + 1 + ] alien-callback ;
+: fastcall-ifi-callback ( -- ptr )
+ int { int float int } fastcall
+ [ [ >integer ] dip + + 1 + ] alien-callback ;
+: fastcall-ifii-callback ( -- ptr )
+ int { int float int int } fastcall
+ [ [ >integer ] 2dip + + + 1 + ] alien-callback ;
+: fastcall-struct-return-ii-callback ( -- ptr )
+ test-struct-11 { int int } fastcall
+ [ [ + ] [ - ] 2bi test-struct-11 <struct-boa> ] alien-callback ;
+: fastcall-struct-return-iii-callback ( -- ptr )
+ test-struct-11 { int int int } fastcall
+ [ [ drop + ] [ - nip ] 3bi test-struct-11 <struct-boa> ] alien-callback ;
+
+[ 8 ] [ 3 4 fastcall-ii-callback fastcall-ii-indirect ] unit-test
+[ 13 ] [ 3 4 5 fastcall-iii-callback fastcall-iii-indirect ] unit-test
+[ 13 ] [ 3 4.0 5 fastcall-ifi-callback fastcall-ifi-indirect ] unit-test
+[ 19 ] [ 3 4.0 5 6 fastcall-ifii-callback fastcall-ifii-indirect ] unit-test
+
+[ S{ test-struct-11 f 7 -1 } ]
+[ 3 4 fastcall-struct-return-ii-callback fastcall-struct-return-ii-indirect ] unit-test
+
+[ S{ test-struct-11 f 7 -3 } ]
+[ 3 4 7 fastcall-struct-return-iii-callback fastcall-struct-return-iii-indirect ] unit-test
TYPEDEF: alien.c-types:int type-3
: callback ( -- ptr )
- type-3 { type-1 type-1 } "cdecl" [ + >integer ] alien-callback ;
+ type-3 { type-1 type-1 } cdecl [ + >integer ] alien-callback ;
TYPEDEF: alien.c-types:float type-2
: indirect ( x y ptr -- z )
- type-3 { type-2 type-2 } "cdecl" alien-indirect ;
+ type-3 { type-2 type-2 } cdecl alien-indirect ;
[ ] [
"USING: alien.c-types alien.syntax ;
{ [ os winnt? ] [ "zlib1.dll" ] }
{ [ os macosx? ] [ "libz.dylib" ] }
{ [ os unix? ] [ "libz.so" ] }
-} cond "cdecl" add-library >>
+} cond cdecl add-library >>
LIBRARY: zlib
[ fds>> [ enable-all-callbacks ] each ] bi ;
: timer-callback ( -- callback )
- void { CFRunLoopTimerRef void* } "cdecl"
+ void { CFRunLoopTimerRef void* } cdecl
[ 2drop reset-run-loop yield ] alien-callback ;
: init-thread-timer ( -- )
GENERIC: return-reg ( reg-class -- reg )
! Sequence of registers used for parameter passing in class
-GENERIC: param-regs ( reg-class -- regs )
+GENERIC# param-regs 1 ( reg-class abi -- regs )
-M: stack-params param-regs drop f ;
+M: stack-params param-regs 2drop f ;
-GENERIC: param-reg ( n reg-class -- reg )
+GENERIC# param-reg 1 ( n reg-class abi -- reg )
M: reg-class param-reg param-regs nth ;
-M: stack-params param-reg drop ;
+M: stack-params param-reg 2drop ;
! Is this integer small enough to be an immediate operand for
! %add-imm, %sub-imm, and %mul-imm?
! %and-imm, %or-imm, and %xor-imm?
HOOK: immediate-bitwise? cpu ( n -- ? )
+! What c-type describes the implicit struct return pointer for large structs?
+HOOK: struct-return-pointer-type cpu ( -- c-type )
+
! Is this structure small enough to be returned in registers?
HOOK: return-struct-in-registers? cpu ( c-type -- ? )
M: linux lr-save 1 cells ;
-M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ;
+M: float-regs param-regs 2drop { 1 2 3 4 5 6 7 8 } ;
M: ppc value-struct? drop f ;
M: macosx lr-save 2 cells ;
-M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
+M: float-regs param-regs 2drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
M: ppc value-struct? drop t ;
M: integer float-function-param* FMR ;
: float-function-param ( i src -- )
- [ float-regs param-regs nth ] dip float-function-param* ;
+ [ float-regs cdecl param-regs nth ] dip float-function-param* ;
: float-function-return ( reg -- )
float-regs return-reg double-rep %copy ;
M: ppc %loop-entry ;
M: int-regs return-reg drop 3 ;
-M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
+M: int-regs param-regs 2drop { 3 4 5 6 7 8 9 10 } ;
M: float-regs return-reg drop 1 ;
M:: ppc %save-param-reg ( stack reg rep -- )
! If the source is a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in
! freg #0.
- n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
+ n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
rep double-rep? 5 4 ? %load-vm-addr
func f %alien-invoke ;
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
+M: ppc struct-return-pointer-type void* ;
+
M: ppc return-struct-in-registers? ( c-type -- ? )
c-type return-in-registers?>> ;
USING: alien alien.c-types tools.test cpu.x86.assembler
cpu.x86.assembler.operands ;
-: assembly-test-1 ( -- x ) int { } "cdecl" [ EAX 3 MOV ] alien-assembly ;
+: assembly-test-1 ( -- x ) int { } cdecl [ EAX 3 MOV ] alien-assembly ;
[ 3 ] [ assembly-test-1 ] unit-test
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: locals alien.c-types alien.libraries alien.syntax arrays
-kernel fry math namespaces sequences system layouts io
-vocabs.loader accessors init combinators command-line make
-compiler compiler.units compiler.constants compiler.alien
+USING: locals alien alien.c-types alien.libraries alien.syntax
+arrays kernel fry math namespaces sequences system layouts io
+vocabs.loader accessors init classes.struct combinators command-line
+make compiler compiler.units compiler.constants compiler.alien
compiler.codegen compiler.codegen.fixup
compiler.cfg.instructions compiler.cfg.builder
compiler.cfg.intrinsics compiler.cfg.stack-frame
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
cpu.architecture vm ;
FROM: layouts => cell ;
+FROM: alien.private => fastcall ;
IN: cpu.x86.32
M: x86.32 machine-registers
M: x86.32 pic-tail-reg EDX ;
-M: x86.32 reserved-stack-space 4 cells ;
+M: x86.32 reserved-stack-space 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
: struct-return@ ( n -- operand )
[ next-stack@ ] [ stack-frame get params>> local@ ] if* ;
-! On x86, parameters are never passed in registers.
+! On x86, parameters are usually never passed in registers, except with Microsoft's
+! "thiscall" and "fastcall" abis
M: int-regs return-reg drop EAX ;
-M: int-regs param-regs drop { } ;
-M: float-regs param-regs drop { } ;
+M: float-regs param-regs 2drop { } ;
+
+M: int-regs param-regs
+ nip {
+ { thiscall [ { ECX } ] }
+ { fastcall [ { ECX EDX } ] }
+ [ drop { } ]
+ } case ;
GENERIC: load-return-reg ( src rep -- )
GENERIC: store-return-reg ( dst rep -- )
+M: stack-params load-return-reg drop EAX swap MOV ;
+M: stack-params store-return-reg drop EAX MOV ;
+
M: int-rep load-return-reg drop EAX swap MOV ;
M: int-rep store-return-reg drop EAX MOV ;
M: x86.32 %prepare-jump
pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here ;
-M: x86.32 %load-param-reg
- stack-params assert=
- [ [ EAX ] dip local@ MOV ] dip
- stack@ EAX MOV ;
+M: stack-params copy-register*
+ drop
+ {
+ { [ dup integer? ] [ EAX swap next-stack@ MOV EAX MOV ] }
+ { [ over integer? ] [ EAX swap MOV param@ EAX MOV ] }
+ } cond ;
+
+M: x86.32 %save-param-reg
+ dup stack-params? [ 3drop ] [ [ param@ ] 2dip %copy ] if ;
-M: x86.32 %save-param-reg 3drop ;
+M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
: (%box) ( n rep -- )
#! If n is f, push the return register onto the stack; we
func "libm" load-library %alien-invoke
dst float-function-return ;
-: stdcall? ( params -- ? )
- abi>> "stdcall" = ;
-
: funny-large-struct-return? ( params -- ? )
#! MINGW ABI incompatibility disaster
[ return>> large-struct? ]
- [ abi>> "mingw" = os windows? not or ]
+ [ abi>> mingw = os windows? not or ]
bi and ;
+: callee-cleanup? ( abi -- ? )
+ { stdcall fastcall thiscall } member? ;
+
+: stack-arg-size ( params -- n )
+ dup abi>> '[
+ alien-parameters flatten-value-types
+ [ _ alloc-parameter 2drop ] each
+ stack-params get
+ ] with-param-regs ;
+
M: x86.32 %cleanup ( params -- )
- #! a) If we just called an stdcall function in Windows, it
+ #! a) If we just called a stdcall function in Windows, it
#! cleaned up the stack frame for us. But we don't want that
#! so we 'undo' the cleanup since we do that in %epilogue.
#! b) If we just called a function returning a struct, we
#! have to fix ESP.
{
- { [ dup stdcall? ] [ drop ESP stack-frame get params>> SUB ] }
+ { [ dup abi>> callee-cleanup? ] [ stack-arg-size ESP swap SUB ] }
{ [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
[ drop ]
} cond ;
} cond ;
! Dreadful
-M: object flatten-value-type (flatten-int-type) ;
+M: object flatten-value-type (flatten-stack-type) ;
+M: struct-c-type flatten-value-type (flatten-stack-type) ;
+M: long-long-type flatten-value-type (flatten-stack-type) ;
+M: c-type flatten-value-type
+ dup rep>> int-rep? [ (flatten-int-type) ] [ (flatten-stack-type) ] if ;
+
+M: x86.32 struct-return-pointer-type (stack-value) ;
check-sse
cpu.x86.assembler cpu.x86.assembler.operands tools.test ;
IN: cpu.x86.64.tests
-: assembly-test-1 ( -- x ) int { } "cdecl" [ RAX 3 MOV ] alien-assembly ;
+: assembly-test-1 ( -- x ) int { } cdecl [ RAX 3 MOV ] alien-assembly ;
[ 3 ] [ assembly-test-1 ] unit-test
: assembly-test-2 ( a b -- x )
- int { int int } "cdecl" [
+ int { int int } cdecl [
param-reg-0 param-reg-1 ADD
int-regs return-reg param-reg-0 MOV
] alien-assembly ;
FROM: layouts => cell cells ;
IN: cpu.x86.64
-: param-reg-0 ( -- reg ) 0 int-regs param-reg ; inline
-: param-reg-1 ( -- reg ) 1 int-regs param-reg ; inline
-: param-reg-2 ( -- reg ) 2 int-regs param-reg ; inline
-: param-reg-3 ( -- reg ) 3 int-regs param-reg ; inline
+: param-reg-0 ( -- reg ) 0 int-regs cdecl param-reg ; inline
+: param-reg-1 ( -- reg ) 1 int-regs cdecl param-reg ; inline
+: param-reg-2 ( -- reg ) 2 int-regs cdecl param-reg ; inline
+: param-reg-3 ( -- reg ) 3 int-regs cdecl param-reg ; inline
M: x86.64 pic-tail-reg RBX ;
M: x86.64 %vm-field-ptr ( dst offset -- )
[ vm-reg ] dip [+] LEA ;
-: param@ ( n -- op ) reserved-stack-space + stack@ ;
-
M: x86.64 %prologue ( n -- )
temp-reg -7 [RIP+] LEA
dup PUSH
"to_value_struct" f %alien-invoke ;
: load-return-value ( rep -- )
- [ [ 0 ] dip reg-class-of param-reg ]
+ [ [ 0 ] dip reg-class-of cdecl param-reg ]
[ reg-class-of return-reg ]
[ ]
tri %copy ;
M:: x86.64 %box ( n rep func -- )
n [
n
- 0 rep reg-class-of param-reg
+ 0 rep reg-class-of cdecl param-reg
rep %load-param-reg
] [
rep load-return-value
unbox-return ;
: float-function-param ( i src -- )
- [ float-regs param-regs nth ] dip double-rep %copy ;
+ [ float-regs cdecl param-regs nth ] dip double-rep %copy ;
: float-function-return ( reg -- )
float-regs return-reg double-rep %copy ;
! Call GC
"inline_gc" f %alien-invoke ;
+M: x86.64 struct-return-pointer-type void* ;
+
! The result of reading 4 bytes from memory is a fixnum on
! x86-64.
enable-alien-4-intrinsics
IN: cpu.x86.64.unix
M: int-regs param-regs
- drop { RDI RSI RDX RCX R8 R9 } ;
+ 2drop { RDI RSI RDX RCX R8 R9 } ;
M: float-regs param-regs
- drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
+ 2drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
M: x86.64 reserved-stack-space 0 ;
-SYMBOL: (stack-value)
-! The ABI for passing structs by value is pretty great
-<< void* c-type clone \ (stack-value) define-primitive-type
-stack-params \ (stack-value) c-type (>>rep) >>
-
: struct-types&offset ( struct-type -- pairs )
fields>> [
[ type>> ] [ offset>> ] bi 2array
] map ;
: flatten-large-struct ( c-type -- seq )
- heap-size cell align
- cell /i \ (stack-value) c-type <repetition> ;
+ (flatten-stack-type) ;
: flatten-struct ( c-type -- seq )
dup heap-size 16 > [
cpu.x86.assembler.operands ;
IN: cpu.x86.64.winnt
-M: int-regs param-regs drop { RCX RDX R8 R9 } ;
+M: int-regs param-regs 2drop { RCX RDX R8 R9 } ;
-M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
+M: float-regs param-regs 2drop { XMM0 XMM1 XMM2 XMM3 } ;
M: x86.64 reserved-stack-space 4 cells ;
<PRIVATE
: (sse-version) ( -- n )
- int { } "cdecl" [
+ int { } cdecl [
"sse-42" define-label
"sse-41" define-label
"ssse-3" define-label
HOOK: instruction-count cpu ( -- n )
M: x86.32 instruction-count
- longlong { } "cdecl" [
+ longlong { } cdecl [
RDTSC
] alien-assembly ;
M: x86.64 instruction-count
- longlong { } "cdecl" [
+ longlong { } cdecl [
RAX 0 MOV
RDTSC
RDX 32 SHL
: gc-root@ ( n -- op ) gc-root-offset special@ ;
+: param@ ( n -- op ) reserved-stack-space + stack@ ;
+
: decr-stack-reg ( n -- )
dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
{ [ os winnt? ] [ "libpq.dll" ] }
{ [ os macosx? ] [ "libpq.dylib" ] }
{ [ os unix? ] [ "libpq.so" ] }
-} cond "cdecl" add-library >>
+} cond cdecl add-library >>
! ConnSatusType
CONSTANT: CONNECTION_OK HEX: 0
{ [ os winnt? ] [ "sqlite3.dll" ] }
{ [ os macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
{ [ os unix? ] [ "libsqlite3.so" ] }
- } cond "cdecl" add-library >>
+ } cond cdecl add-library >>
! Return values from sqlite functions
CONSTANT: SQLITE_OK 0 ! Successful result
<<
{
- { [ os winnt? ] [ "glib" "libglib-2.0-0.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "glib" "/opt/local/lib/libglib-2.0.0.dylib" "cdecl" add-library ] }
+ { [ os winnt? ] [ "glib" "libglib-2.0-0.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "glib" "/opt/local/lib/libglib-2.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ ] }
} cond
{
- { [ os winnt? ] [ "gobject" "libgobject-2.0-0.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "gobject" "/opt/local/lib/libgobject-2.0.0.dylib" "cdecl" add-library ] }
+ { [ os winnt? ] [ "gobject" "libgobject-2.0-0.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "gobject" "/opt/local/lib/libgobject-2.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ ] }
} cond
: file-descriptor-callback ( -- callback )
void { CFFileDescriptorRef CFOptionFlags void* }
- "cdecl" [
+ cdecl [
3drop
0 mx get kqueue-mx>> wait-for-events
reset-run-loop
] [ drop ] if ;
: password-callback ( -- alien )
- int { void* int bool void* } "cdecl"
+ int { void* int bool void* } cdecl
[| buf size rwflag password! |
password [ B{ 0 } password! ] unless
} cleave
int
{ SOCKET void* int PVOID DWORD LPDWORD void* }
- "stdcall" alien-indirect drop
+ stdcall alien-indirect drop
winsock-error-string [ throw ] when* ; inline
M: object establish-connection ( client-out remote -- )
IN: math.floats.env.x86.32
M: x86.32 get-sse-env
- void { void* } "cdecl" [
+ void { void* } cdecl [
EAX ESP [] MOV
EAX [] STMXCSR
] alien-assembly ;
M: x86.32 set-sse-env
- void { void* } "cdecl" [
+ void { void* } cdecl [
EAX ESP [] MOV
EAX [] LDMXCSR
] alien-assembly ;
M: x86.32 get-x87-env
- void { void* } "cdecl" [
+ void { void* } cdecl [
EAX ESP [] MOV
EAX [] FNSTSW
EAX 2 [+] FNSTCW
] alien-assembly ;
M: x86.32 set-x87-env
- void { void* } "cdecl" [
+ void { void* } cdecl [
EAX ESP [] MOV
FNCLEX
EAX 2 [+] FLDCW
IN: math.floats.env.x86.64
M: x86.64 get-sse-env
- void { void* } "cdecl" [
- int-regs param-regs first [] STMXCSR
+ void { void* } cdecl [
+ int-regs cdecl param-regs first [] STMXCSR
] alien-assembly ;
M: x86.64 set-sse-env
- void { void* } "cdecl" [
- int-regs param-regs first [] LDMXCSR
+ void { void* } cdecl [
+ int-regs cdecl param-regs first [] LDMXCSR
] alien-assembly ;
M: x86.64 get-x87-env
- void { void* } "cdecl" [
- int-regs param-regs first [] FNSTSW
- int-regs param-regs first 2 [+] FNSTCW
+ void { void* } cdecl [
+ int-regs cdecl param-regs first [] FNSTSW
+ int-regs cdecl param-regs first 2 [+] FNSTCW
] alien-assembly ;
M: x86.64 set-x87-env
- void { void* } "cdecl" [
+ void { void* } cdecl [
FNCLEX
- int-regs param-regs first 2 [+] FLDCW
+ int-regs cdecl param-regs first 2 [+] FLDCW
] alien-assembly ;
: gl-function-context ( -- context ) 0 ; inline
: gl-function-address ( name -- address ) f dlsym ; inline
-: gl-function-calling-convention ( -- str ) "cdecl" ; inline
+: gl-function-calling-convention ( -- str ) cdecl ; inline
: gl-function-context ( -- context ) glXGetCurrentContext ; inline
: gl-function-address ( name -- address ) glXGetProcAddressARB ; inline
-: gl-function-calling-convention ( -- str ) "cdecl" ; inline
+: gl-function-calling-convention ( -- str ) cdecl ; inline
: gl-function-context ( -- context ) wglGetCurrentContext ; inline
: gl-function-address ( name -- address ) wglGetProcAddress ; inline
-: gl-function-calling-convention ( -- str ) "stdcall" ; inline
+: gl-function-calling-convention ( -- str ) stdcall ; inline
{
{ [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os netbsd? ] [ ] }
- { [ os winnt? ] [ "libcrypto" "libeay32.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "libcrypto" "libcrypto.dylib" "cdecl" add-library ] }
- { [ os unix? ] [ "libcrypto" "libcrypto.so" "cdecl" add-library ] }
+ { [ os winnt? ] [ "libcrypto" "libeay32.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "libcrypto" "libcrypto.dylib" cdecl add-library ] }
+ { [ os unix? ] [ "libcrypto" "libcrypto.so" cdecl add-library ] }
} cond
>>
<< {
{ [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os netbsd? ] [ ] }
- { [ os winnt? ] [ "libssl" "ssleay32.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] }
- { [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] }
+ { [ os winnt? ] [ "libssl" "ssleay32.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "libssl" "libssl.dylib" cdecl add-library ] }
+ { [ os unix? ] [ "libssl" "libssl.so" cdecl add-library ] }
} cond >>
CONSTANT: X509_FILETYPE_PEM 1
IN: pango.cairo
<< {
- { [ os winnt? ] [ "pangocairo" "libpangocairo-1.0-0.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "pangocairo" "/opt/local/lib/libpangocairo-1.0.0.dylib" "cdecl" add-library ] }
+ { [ os winnt? ] [ "pangocairo" "libpangocairo-1.0-0.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "pangocairo" "/opt/local/lib/libpangocairo-1.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ ] }
} cond >>
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
<< {
- { [ os winnt? ] [ "pango" "libpango-1.0-0.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "pango" "/opt/local/lib/libpango-1.0.0.dylib" "cdecl" add-library ] }
+ { [ os winnt? ] [ "pango" "libpango-1.0-0.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "pango" "/opt/local/lib/libpango-1.0.0.dylib" cdecl add-library ] }
{ [ os unix? ] [ ] }
} cond >>
IN: tools.deploy.test.9
: callback-test ( -- callback )
- int { int } "cdecl" [ 1 + ] alien-callback ;
+ int { int } cdecl [ 1 + ] alien-callback ;
: indirect-test ( -- )
- 10 callback-test int { int } "cdecl" alien-indirect 11 assert= ;
+ 10 callback-test int { int } cdecl alien-indirect 11 assert= ;
MAIN: indirect-test
TR: tabs>spaces "\t" "\s" ;
+GENERIC: (>address) ( object -- n )
+
+M: integer (>address) ;
+M: alien (>address) alien-address ;
+
PRIVATE>
M: byte-array disassemble
2array disassemble
] with-destructors ;
-M: pair disassemble first2 disassemble* [ tabs>spaces print ] each ;
+M: pair disassemble first2 [ (>address) ] bi@ disassemble* [ tabs>spaces print ] each ;
M: word disassemble word-code 2array disassemble ;
{ [ os macosx? ] [ "libudis86.0.dylib" ] }
{ [ os unix? ] [ "libudis86.so.0" ] }
{ [ os winnt? ] [ "libudis86.dll" ] }
-} cond "cdecl" add-library
+} cond cdecl add-library
>>
LIBRARY: libudis86
[ ] [ \ + usage-profile. ] unit-test
-: callback-test ( -- callback ) void { } "cdecl" [ ] alien-callback ;
+: callback-test ( -- callback ) void { } cdecl [ ] alien-callback ;
-: indirect-test ( callback -- ) void { } "cdecl" alien-indirect ;
+: indirect-test ( callback -- ) void { } cdecl alien-indirect ;
: foobar ( -- ) ;
! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object )
- uint { void* uint long long } "stdcall" [
+ uint { void* uint long long } stdcall [
pick
trace-messages? get-global [ dup windows-message-name name>> print flush ] when
wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
FUNCTION: int utimes ( c-string path, timeval[2] times ) ;
FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
-"librt" "librt.so" "cdecl" add-library
+"librt" "librt.so" cdecl add-library
USING: alien sequences alien.libraries ;
{
- { "advapi32" "\\windows\\coredll.dll" "stdcall" }
- { "gdi32" "\\windows\\coredll.dll" "stdcall" }
- { "user32" "\\windows\\coredll.dll" "stdcall" }
- { "kernel32" "\\windows\\coredll.dll" "stdcall" }
- { "winsock" "\\windows\\ws2.dll" "stdcall" }
- { "mswsock" "\\windows\\ws2.dll" "stdcall" }
- { "libc" "\\windows\\coredll.dll" "stdcall" }
- { "libm" "\\windows\\coredll.dll" "stdcall" }
- ! { "gl" "libGLES_CM.dll" "stdcall" }
- ! { "glu" "libGLES_CM.dll" "stdcall" }
- { "ole32" "ole32.dll" "stdcall" }
+ { "advapi32" "\\windows\\coredll.dll" stdcall }
+ { "gdi32" "\\windows\\coredll.dll" stdcall }
+ { "user32" "\\windows\\coredll.dll" stdcall }
+ { "kernel32" "\\windows\\coredll.dll" stdcall }
+ { "winsock" "\\windows\\ws2.dll" stdcall }
+ { "mswsock" "\\windows\\ws2.dll" stdcall }
+ { "libc" "\\windows\\coredll.dll" stdcall }
+ { "libm" "\\windows\\coredll.dll" stdcall }
+ ! { "gl" "libGLES_CM.dll" stdcall }
+ ! { "glu" "libGLES_CM.dll" stdcall }
+ { "ole32" "ole32.dll" stdcall }
} [ first3 add-library ] each
[ 2nip length ] 3keep
'[
_ npick *void* _ cell * alien-cell _ _
- "stdcall" alien-indirect
+ stdcall alien-indirect
] ;
TUPLE: com-interface-definition word parent iid functions ;
] [
first2 (finish-thunk)
] bi*
- "stdcall" swap compile-alien-callback
+ stdcall swap compile-alien-callback
] 2map ;
: (make-callbacks) ( implementations -- sequence )
kernel math windows.types windows.ole32 ;
IN: windows.ddk.hid
-<< "hid" "hid.dll" "stdcall" add-library >>
+<< "hid" "hid.dll" stdcall add-library >>
LIBRARY: hid
TYPEDEF: LONG NTSTATUS
alien.c-types windows.errors windows.ole32 windows.advapi32 alien.libraries ;
IN: windows.ddk.setupapi
-<< "setupapi" "setupapi.dll" "stdcall" add-library >>
+<< "setupapi" "setupapi.dll" stdcall add-library >>
LIBRARY: setupapi
TYPEDEF: DWORDLONG SP_LOG_TOKEN
windows.types alien.libraries ;
IN: windows.ddk.winusb
-<< "winusb" "winusb.dll" "stdcall" add-library >>
+<< "winusb" "winusb.dll" stdcall add-library >>
LIBRARY: winusb
TYPEDEF: PVOID WINUSB_INTERFACE_HANDLE
: full-window-margins ( -- MARGINS )
-1 -1 -1 -1 <MARGINS> ; inline
-<< "dwmapi" "dwmapi.dll" "stdcall" add-library >>
+<< "dwmapi" "dwmapi.dll" stdcall add-library >>
LIBRARY: dwmapi
USING: alien sequences alien.libraries ;
{
- { "advapi32" "advapi32.dll" "stdcall" }
- { "dinput" "dinput8.dll" "stdcall" }
- { "gdi32" "gdi32.dll" "stdcall" }
- { "user32" "user32.dll" "stdcall" }
- { "kernel32" "kernel32.dll" "stdcall" }
- { "winsock" "ws2_32.dll" "stdcall" }
- { "mswsock" "mswsock.dll" "stdcall" }
- { "shell32" "shell32.dll" "stdcall" }
- { "libc" "msvcrt.dll" "cdecl" }
- { "libm" "msvcrt.dll" "cdecl" }
- { "gl" "opengl32.dll" "stdcall" }
- { "glu" "glu32.dll" "stdcall" }
- { "ole32" "ole32.dll" "stdcall" }
- { "usp10" "usp10.dll" "stdcall" }
- { "psapi" "psapi.dll" "stdcall" }
- { "xinput" "xinput1_3.dll" "stdcall" }
- { "dxgi" "dxgi.dll" "stdcall" }
- { "d2d1" "d2d1.dll" "stdcall" }
- { "d3d9" "d3d9.dll" "stdcall" }
- { "d3d10" "d3d10.dll" "stdcall" }
- { "d3d10_1" "d3d10_1.dll" "stdcall" }
- { "d3d11" "d3d11.dll" "stdcall" }
- { "d3dcompiler" "d3dcompiler_42.dll" "stdcall" }
- { "d3dcsx" "d3dcsx_42.dll" "stdcall" }
- { "d3dx9" "d3dx9_42.dll" "stdcall" }
- { "d3dx10" "d3dx10_42.dll" "stdcall" }
- { "d3dx11" "d3dx11_42.dll" "stdcall" }
- { "dwrite" "dwrite.dll" "stdcall" }
- { "x3daudio" "x3daudio1_6.dll" "stdcall" }
- { "xactengine" "xactengine3_5.dll" "stdcall" }
- { "xapofx" "xapofx1_3.dll" "stdcall" }
- { "xaudio2" "xaudio2_5.dll" "stdcall" }
+ { "advapi32" "advapi32.dll" stdcall }
+ { "dinput" "dinput8.dll" stdcall }
+ { "gdi32" "gdi32.dll" stdcall }
+ { "user32" "user32.dll" stdcall }
+ { "kernel32" "kernel32.dll" stdcall }
+ { "winsock" "ws2_32.dll" stdcall }
+ { "mswsock" "mswsock.dll" stdcall }
+ { "shell32" "shell32.dll" stdcall }
+ { "libc" "msvcrt.dll" cdecl }
+ { "libm" "msvcrt.dll" cdecl }
+ { "gl" "opengl32.dll" stdcall }
+ { "glu" "glu32.dll" stdcall }
+ { "ole32" "ole32.dll" stdcall }
+ { "usp10" "usp10.dll" stdcall }
+ { "psapi" "psapi.dll" stdcall }
+ { "xinput" "xinput1_3.dll" stdcall }
+ { "dxgi" "dxgi.dll" stdcall }
+ { "d2d1" "d2d1.dll" stdcall }
+ { "d3d9" "d3d9.dll" stdcall }
+ { "d3d10" "d3d10.dll" stdcall }
+ { "d3d10_1" "d3d10_1.dll" stdcall }
+ { "d3d11" "d3d11.dll" stdcall }
+ { "d3dcompiler" "d3dcompiler_42.dll" stdcall }
+ { "d3dcsx" "d3dcsx_42.dll" stdcall }
+ { "d3dx9" "d3dx9_42.dll" stdcall }
+ { "d3dx10" "d3dx10_42.dll" stdcall }
+ { "d3dx11" "d3dx11_42.dll" stdcall }
+ { "dwrite" "dwrite.dll" stdcall }
+ { "x3daudio" "x3daudio1_6.dll" stdcall }
+ { "xactengine" "xactengine3_5.dll" stdcall }
+ { "xapofx" "xapofx1_3.dll" stdcall }
+ { "xaudio2" "xaudio2_5.dll" stdcall }
} [ first3 add-library ] each
debugger parser io io.backend system alien.accessors
alien.libraries alien.c-types quotations kernel
sequences ;
+FROM: alien.private => fastcall ;
IN: alien
+HELP: cdecl
+{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that the standard C calling convention should be used, where the caller cleans up the stack frame after calling the function. This symbol only has meaning on 32-bit x86 platforms." } ;
+
+HELP: stdcall
+{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that the Windows API calling convention should be used, where the called function cleans up its own stack frame before returning to the caller. This symbol only has meaning on 32-bit x86 platforms." } ;
+
+HELP: fastcall
+{ $warning "In the current implementation this ABI only works for functions that take only integer and pointer arguments." }
+{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that the \"fast call\" calling convention should be used, where the first two integer or pointer arguments are passed in registers and the function cleans up its own stack frame before returning to the caller. This symbol only has meaning on 32-bit x86 platforms." } ;
+
+HELP: thiscall
+{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that Microsoft Visual C++ calling convention should be used, where the first argument (which must be a \"this\" pointer) is passed in a register and the function cleans up its own stack frame before returning to the caller. This symbol only has meaning on 32-bit x86 platforms." } ;
+
+{ cdecl stdcall fastcall thiscall } related-words
+
HELP: >c-ptr
{ $values { "obj" object } { "c-ptr" c-ptr } }
{ $contract "Outputs a pointer to the binary data of this object." } ;
} ;
HELP: alien-indirect
-{ $values { "args..." "zero or more objects passed to the C function" } { "funcptr" "a C function pointer" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "return..." "the return value of the function, if not " { $link void } } }
+{ $values { "args..." "zero or more objects passed to the C function" } { "funcptr" "a C function pointer" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } { "return..." "the return value of the function, if not " { $link void } } }
{ $description
"Invokes a C function pointer passed on the data stack. Input parameters are taken from the data stack following the function pointer, and the return value is pushed on the data stack after the function returns. A return type of " { $link void } " indicates that no value is to be expected."
}
} ;
HELP: alien-callback
-{ $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "quot" quotation } { "alien" alien } }
+{ $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } { "quot" quotation } { "alien" alien } }
{ $description
"Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller. A return type of " { $snippet "void" } " indicates that no value is to be returned."
$nl
"A simple example, showing a C function which returns the difference of two given integers:"
{ $code
": difference-callback ( -- alien )"
- " int { int int } \"cdecl\" [ - ] alien-callback ;"
+ " int { int int } cdecl [ - ] alien-callback ;"
}
}
{ $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ;
} ;
HELP: alien-assembly
-{ $values { "args..." "zero or more objects passed to the C function" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "quot" quotation } { "return..." "the return value of the function, if not " { $link void } } }
+{ $values { "args..." "zero or more objects passed to the C function" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } { "quot" quotation } { "return..." "the return value of the function, if not " { $link void } } }
{ $description
"Invokes arbitrary machine code, generated at compile-time by the quotation. Input parameters are taken from the data stack, and the return value is pushed on the data stack after the function returns. A return type of " { $link void } " indicates that no value is to be expected."
}
continuations.private ;
IN: alien
+SINGLETONS: stdcall thiscall cdecl mingw ;
+
+<PRIVATE
+SINGLETON: fastcall
+PRIVATE>
+
+UNION: abi stdcall thiscall fastcall cdecl mingw ;
+
PREDICATE: pinned-alien < alien underlying>> not ;
UNION: pinned-c-ptr pinned-alien POSTPONE: f ;
IN: benchmark.fib6\r
\r
: fib ( x -- y )\r
- int { int } "cdecl" [\r
+ int { int } cdecl [\r
dup 1 <= [ drop 1 ] [\r
1 - dup fib swap 1 - fib +\r
] if\r
] alien-callback\r
- int { int } "cdecl" alien-indirect ;\r
+ int { int } cdecl alien-indirect ;\r
\r
: fib-main ( -- ) 32 fib drop ;\r
\r
{ [ os windows? ] [ "chipmunk.dll" ] }
{ [ os macosx? ] [ "libchipmunk.dylib" ] }
{ [ os unix? ] [ "libchipmunk.so" ] }
-} cond "cdecl" add-library
+} cond cdecl add-library
"chipmunk" deploy-library
>>
{ [ os winnt? ] [ "libcurses.dll" ] }
{ [ os macosx? ] [ "libcurses.dylib" ] }
{ [ os unix? ] [ "libcurses.so" ] }
-} cond "cdecl" add-library >>
+} cond cdecl add-library >>
C-TYPE: WINDOW
C-TYPE: SCREEN
! (c)2010 Joe Groff bsd license
-USING: accessors cursors make math sequences sorting tools.test ;
+USING: accessors cursors kernel make math sequences sorting tools.test ;
FROM: cursors => each map assoc-each assoc>map ;
IN: cursors.tests
T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> 3 mod zero? ] -find
] unit-test
+[ T{ linear-cursor f 5 1 } ] [
+ T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> 6 = ] -find
+] unit-test
+
[ { 1 3 } ] [
[ T{ linear-cursor f 1 2 } T{ linear-cursor f 5 2 } [ value>> , ] -each ]
{ } make
IN: freetype
<< "freetype" {
- { [ os macosx? ] [ "/usr/X11R6/lib/libfreetype.6.dylib" "cdecl" add-library ] }
- { [ os windows? ] [ "freetype6.dll" "cdecl" add-library ] }
+ { [ os macosx? ] [ "/usr/X11R6/lib/libfreetype.6.dylib" cdecl add-library ] }
+ { [ os windows? ] [ "freetype6.dll" cdecl add-library ] }
{ [ t ] [ drop ] }
} cond >>
{ [ os windows? ] [ "libusb-1.0.dll" ] }
{ [ os macosx? ] [ "libusb-1.0.dylib" ] }
{ [ os unix? ] [ "libusb-1.0.so" ] }
- } cond "cdecl" add-library >>
+ } cond cdecl add-library >>
LIBRARY: libusb
: libusb_cpu_to_le16 ( x -- y )
{ [ os macosx? ] [ "/usr/local/lib/lib" ".dylib" surround ] }
{ [ os windows? ] [ ".dll" append ] }
{ [ os unix? ] [ "lib" ".so" surround ] }
- } cond "cdecl" add-library ;
+ } cond cdecl add-library ;
"LLVMSystem" add-llvm-library
"LLVMSupport" add-llvm-library
dup name>> function-pointer ,
dup return>> c-type ,
dup params>> [ second c-type ] map ,
- "cdecl" , \ alien-indirect ,
+ cdecl , \ alien-indirect ,
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
: install-module ( name -- )
{ [ os winnt? ] [ "ogg.dll" ] }
{ [ os macosx? ] [ "libogg.0.dylib" ] }
{ [ os unix? ] [ "libogg.so" ] }
-} cond "cdecl" add-library
+} cond cdecl add-library
"ogg" deploy-library
>>
{ [ os winnt? ] [ "theoradec.dll" ] }
{ [ os macosx? ] [ "libtheoradec.0.dylib" ] }
{ [ os unix? ] [ "libtheoradec.so" ] }
-} cond "cdecl" add-library
+} cond cdecl add-library
"theoraenc" {
{ [ os winnt? ] [ "theoraenc.dll" ] }
{ [ os macosx? ] [ "libtheoraenc.0.dylib" ] }
{ [ os unix? ] [ "libtheoraenc.so" ] }
-} cond "cdecl" add-library
+} cond cdecl add-library
>>
CONSTANT: TH-EFAULT -1
{ [ os winnt? ] [ "vorbis.dll" ] }
{ [ os macosx? ] [ "libvorbis.0.dylib" ] }
{ [ os unix? ] [ "libvorbis.so" ] }
-} cond "cdecl" add-library
+} cond cdecl add-library
"vorbis" deploy-library
>>
"/System/Library/Frameworks/OpenAL.framework/OpenAL"
] }
{ [ os unix? ] [ "libalut.so" ] }
- } cond "cdecl" add-library >>
+ } cond cdecl add-library >>
<< os macosx? [ "alut" deploy-library ] unless >>
"/System/Library/Frameworks/OpenAL.framework/OpenAL"
] }
{ [ os unix? ] [ "libopenal.so" ] }
- } cond "cdecl" add-library >>
+ } cond cdecl add-library >>
<< os macosx? [ "openal" deploy-library ] unless >>
{ [ os windows? ] [ "OpenCL.dll" ] }
{ [ os macosx? ] [ "/System/Library/Frameworks/OpenCL.framework/OpenCL" ] }
{ [ os unix? ] [ "libOpenCL.so" ] }
- } cond "stdcall" add-library >>
+ } cond stdcall add-library >>
LIBRARY: opencl
! cl_platform.h
os {
{ [ dup macosx? ] [ drop ] }
{ [ dup windows? ] [ drop ] }
- { [ dup unix? ] [ drop "glu" "libGLU.so.1" "cdecl" add-library ] }
+ { [ dup unix? ] [ drop "glu" "libGLU.so.1" cdecl add-library ] }
} cond
>>
{ [ os macosx? ] [ "/opt/local/lib/libtokyotyrant.dylib" ] }
{ [ os unix? ] [ "libtokyotyrant.so" ] }
{ [ os windows? ] [ "tokyotyrant.dll" ] }
-} cond "cdecl" add-library >>
+} cond cdecl add-library >>
LIBRARY: tokyotyrant
{ [ os macosx? ] [ "/opt/local/lib/libtokyocabinet.dylib" ] }
{ [ os unix? ] [ "libtokyocabinet.so" ] }
{ [ os windows? ] [ "tokyocabinet.dll" ] }
-} cond "cdecl" add-library >>
+} cond cdecl add-library >>
LIBRARY: tokyocabinet
: compile-c-library ( -- )
compile-library? [ compile-library ] when
- c-library get dup library-path "cdecl" add-library ;
+ c-library get dup library-path cdecl add-library ;
: define-c-function ( function types effect body -- )
[
IN: cryptlib.libcl
<< "libcl" {
- { [ win32? ] [ "cl32.dll" "stdcall" ] }
- { [ macosx? ] [ "libcl.dylib" "cdecl" ] }
- { [ unix? ] [ "libcl.so" "cdecl" ] }
+ { [ win32? ] [ "cl32.dll" stdcall ] }
+ { [ macosx? ] [ "libcl.dylib" cdecl ] }
+ { [ unix? ] [ "libcl.so" cdecl ] }
} cond add-library >>
! ===============================================
IN: db.mysql.ffi
<< "mysql" {
- { [ os winnt? ] [ "libmySQL.dll" "stdcall" ] }
- { [ os macosx? ] [ "libmysqlclient.14.dylib" "cdecl" ] }
- { [ os unix? ] [ "libmysqlclient.so.14" "cdecl" ] }
+ { [ os winnt? ] [ "libmySQL.dll" stdcall ] }
+ { [ os macosx? ] [ "libmysqlclient.14.dylib" cdecl ] }
+ { [ os unix? ] [ "libmysqlclient.so.14" cdecl ] }
} cond add-library >>
LIBRARY: mysql
] when ;
: (destroy-java-vm)
- "int" { "void*" } "cdecl" alien-indirect ;
+ "int" { "void*" } cdecl alien-indirect ;
: (attach-current-thread)
- "int" { "void*" "void*" "void*" } "cdecl" alien-indirect ;
+ "int" { "void*" "void*" "void*" } cdecl alien-indirect ;
: (detach-current-thread)
- "int" { "void*" } "cdecl" alien-indirect ;
+ "int" { "void*" } cdecl alien-indirect ;
: (get-env)
- "int" { "void*" "void*" "int" } "cdecl" alien-indirect ;
+ "int" { "void*" "void*" "int" } cdecl alien-indirect ;
: (attach-current-thread-as-daemon)
- "int" { "void*" "void*" "void*" } "cdecl" alien-indirect ;
+ "int" { "void*" "void*" "void*" } cdecl alien-indirect ;
: destroy-java-vm ( javavm -- int )
dup JavaVM-functions JNIInvokeInterface-DestroyJavaVM (destroy-java-vm) ;
: (get-version)
- "jint" { "JNIEnv*" } "cdecl" alien-indirect ;
+ "jint" { "JNIEnv*" } cdecl alien-indirect ;
: get-version ( jnienv -- int )
dup JNIEnv-functions JNINativeInterface-GetVersion (get-version) ;
: (find-class)
- "void*" { "JNINativeInterface*" "char*" } "cdecl" alien-indirect ;
+ "void*" { "JNINativeInterface*" "char*" } cdecl alien-indirect ;
: find-class ( name jnienv -- int )
dup swapd JNIEnv-functions JNINativeInterface-FindClass (find-class) ;
: (get-static-field-id)
- "void*" { "JNINativeInterface*" "void*" "char*" "char*" } "cdecl" alien-indirect ;
+ "void*" { "JNINativeInterface*" "void*" "char*" "char*" } cdecl alien-indirect ;
: get-static-field-id ( class name sig jnienv -- int )
dup >r >r 3array r> swap first3 r> JNIEnv-functions JNINativeInterface-GetStaticFieldID (get-static-field-id) ;
: (get-static-object-field)
- "void*" { "JNINativeInterface*" "void*" "void*" } "cdecl" alien-indirect ;
+ "void*" { "JNINativeInterface*" "void*" "void*" } cdecl alien-indirect ;
: get-static-object-field ( class id jnienv -- int )
dup >r >r 2array r> swap first2 r> JNIEnv-functions JNINativeInterface-GetStaticObjectField (get-static-object-field) ;
: (get-method-id)
- "void*" { "JNINativeInterface*" "void*" "char*" "char*" } "cdecl" alien-indirect ;
+ "void*" { "JNINativeInterface*" "void*" "char*" "char*" } cdecl alien-indirect ;
: get-method-id ( class name sig jnienv -- int )
dup >r >r 3array r> swap first3 r> JNIEnv-functions JNINativeInterface-GetMethodID (get-method-id) ;
: (new-string)
- "void*" { "JNINativeInterface*" "char*" "int" } "cdecl" alien-indirect ;
+ "void*" { "JNINativeInterface*" "char*" "int" } cdecl alien-indirect ;
: new-string ( str jnienv -- str )
dup >r >r dup length 2array r> swap first2 r> JNIEnv-functions JNINativeInterface-NewString (new-string) ;
: (call1)
- "void" { "JNINativeInterface*" "void*" "void*" "int" } "cdecl" alien-indirect ;
+ "void" { "JNINativeInterface*" "void*" "void*" "int" } cdecl alien-indirect ;
: call1 ( obj method-id jstr jnienv -- )
dup >r >r 3array r> swap first3 r> JNIEnv-functions JNINativeInterface-CallObjectMethod (call1) ;
IN: ldap.libldap
<< "libldap" {
- { [ win32? ] [ "libldap.dll" "stdcall" ] }
- { [ macosx? ] [ "libldap.dylib" "cdecl" ] }
- { [ unix? ] [ "libldap.so" "cdecl" ] }
+ { [ win32? ] [ "libldap.dll" stdcall ] }
+ { [ macosx? ] [ "libldap.dylib" cdecl ] }
+ { [ unix? ] [ "libldap.so" cdecl ] }
} cond add-library >>
: LDAP_VERSION1 1 ; inline
[ t ] [ f ]
[ { } ]
[ drop f ]
- [ "cdecl" ]
+ [ cdecl ]
[ first ] [ second ] [ third ] [ fourth ]
[ ">" write ] [ "/>" write ]
} ;
words math threads io.encodings.ascii ;
IN: odbc
-<< "odbc" "odbc32.dll" "stdcall" add-library >>
+<< "odbc" "odbc32.dll" stdcall add-library >>
LIBRARY: odbc
IN: oracle.liboci
"oci" {
- { [ os winnt? ] [ "oci.dll" "stdcall" ] }
- { [ os macosx? ] [ "$DYLD_LIBRARY_PATH/libclntsh.dylib" "cdecl" ] }
- { [ os unix? ] [ "$DYLD_LIBRARY_PATH/libclntsh.so.10.1" "cdecl" ] }
+ { [ os winnt? ] [ "oci.dll" stdcall ] }
+ { [ os macosx? ] [ "$DYLD_LIBRARY_PATH/libclntsh.dylib" cdecl ] }
+ { [ os unix? ] [ "$DYLD_LIBRARY_PATH/libclntsh.so.10.1" cdecl ] }
} cond add-library
! ===============================================
IN: pdf.libhpdf
<< "libhpdf" {
- { [ win32? ] [ "libhpdf.dll" "stdcall" ] }
- { [ macosx? ] [ "libhpdf.dylib" "cdecl" ] }
- { [ unix? ] [ "$LD_LIBRARY_PATH/libhpdf.so" "cdecl" ] }
+ { [ win32? ] [ "libhpdf.dll" stdcall ] }
+ { [ macosx? ] [ "libhpdf.dylib" cdecl ] }
+ { [ unix? ] [ "$LD_LIBRARY_PATH/libhpdf.so" cdecl ] }
} cond add-library >>
! compression mode
}
#endif
+
+FACTOR_FASTCALL(int) ffi_test_49(int x) { return x + 1; }
+FACTOR_FASTCALL(int) ffi_test_50(int x, int y) { return x + y + 1; }
+FACTOR_FASTCALL(int) ffi_test_51(int x, int y, int z) { return x + y + z + 1; }
+FACTOR_FASTCALL(int) ffi_test_52(int x, float y, int z) { return x + y + z + 1; }
+FACTOR_FASTCALL(int) ffi_test_53(int x, float y, int z, int w)
+{
+ return x + y + z + w + 1;
+}
+
+FACTOR_FASTCALL(int) ffi_test_54(struct test_struct_11 x, int y)
+{
+ return x.x + x.y + y + 1;
+}
+
+FACTOR_FASTCALL(int) ffi_test_55(struct test_struct_11 x, int y, int z)
+{
+ return x.x + x.y + y + z + 1;
+}
+
+FACTOR_FASTCALL(int) ffi_test_56(struct test_struct_11 x, int y, int z, int w)
+{
+ return x.x + x.y + y + z + w + 1;
+}
+
+FACTOR_FASTCALL(struct test_struct_11) ffi_test_57(int x, int y)
+{
+ struct test_struct_11 r = { x + y, x - y };
+ return r;
+}
+
+FACTOR_FASTCALL(struct test_struct_11) ffi_test_58(int x, int y, int z)
+{
+ struct test_struct_11 r = { x + y, y - z };
+ return r;
+}
#if defined(_MSC_VER)
#define FACTOR_STDCALL(return_type) return_type __stdcall
+ #define FACTOR_FASTCALL(return_type) return_type __fastcall
#elif defined(i386) || defined(__i386) || defined(__i386__)
#define FACTOR_STDCALL(return_type) __attribute__((stdcall)) return_type
+ #define FACTOR_FASTCALL(return_type) __attribute__((fastcall)) return_type
#else
#define FACTOR_STDCALL(return_type) return_type
+ #define FACTOR_FASTCALL(return_type) return_type
#endif
#if defined(__APPLE__)
FACTOR_EXPORT short ffi_test_48(struct bool_field_test x);
#endif
+
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_49(int x);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_50(int x, int y);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_51(int x, int y, int z);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_52(int x, float y, int z);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_53(int x, float y, int z, int w);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_54(struct test_struct_11 x, int y);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_55(struct test_struct_11 x, int y, int z);
+FACTOR_EXPORT FACTOR_FASTCALL(int) ffi_test_56(struct test_struct_11 x, int y, int z, int w);
+FACTOR_EXPORT FACTOR_FASTCALL(struct test_struct_11) ffi_test_57(int x, int y);
+FACTOR_EXPORT FACTOR_FASTCALL(struct test_struct_11) ffi_test_58(int x, int y, int z);
projects / factor.git / commitdiff