<<
: 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" }
}
} ;
[ <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 )
[ [ 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 ;
: (flatten-int-type) ( type -- seq )
stack-size cell align cell /i void* c-type <repetition> ;
#! 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 ;
{ [ 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 }
! 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 -- arg' )
f f rot
double-rect-callback
- void { void* void* double-rect } "cdecl" alien-indirect
+ 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 ;
+: 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 int int int }
+ alien-invoke gc ;
+: ffi_test_54 ( x y -- int )
+ int "f-fastcall" "ffi_test_54" { test-struct-11 int }
+ alien-invoke gc ;
+: ffi_test_55 ( x y z -- int )
+ int "f-fastcall" "ffi_test_55" { test-struct-11 int int }
+ alien-invoke gc ;
+: ffi_test_56 ( x y z w -- int )
+ int "f-fastcall" "ffi_test_56" { test-struct-11 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 ] [ 3 4.0 5 ffi_test_52 ] unit-test
+[ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
+[ 13 ] [ 3 4 test-struct-11 <struct-boa> 5 ffi_test_54 ] unit-test
+[ 19 ] [ 3 4 test-struct-11 <struct-boa> 5 6 ffi_test_55 ] unit-test
+[ 26 ] [ 3 4 test-struct-11 <struct-boa> 5 6 7 ffi_test_56 ] 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?
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 ;
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
+USING: locals alien 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
compiler.codegen compiler.codegen.fixup
: 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 -- )
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? ;
+
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? ] [ drop ESP stack-frame get params>> SUB ] }
{ [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
[ drop ]
} cond ;
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 ;
"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 ;
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 ;
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
{ [ 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
{ [ 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
continuations.private ;
IN: alien
+SINGLETONS: stdcall thiscall fastcall cdecl mingw ;
+
+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;
+}
#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);
projects / factor.git / commitdiff