VM: always use undecorated names when loading ffi functions
For win32, Factor tries four different function names when loading stdcall and fastcall functions, in case decorated names are used in the dll. It seems to not be necessary because a dll meant for 3rd party use will always export undecorated names (http://blogs.msdn.com/b/oldnewthing/archive/2004/01/12/57833.aspx).db4
Björn Lindqvist
parent
da3de080ee
commit
bc7f9ee669
|
|
@ -116,7 +116,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
|
|||
rc $<
|
||||
|
||||
libfactor-ffi-test.dll: vm/ffi_test.obj
|
||||
link $(LINK_FLAGS) /out:libfactor-ffi-test.dll /dll vm/ffi_test.obj
|
||||
link $(LINK_FLAGS) /out:libfactor-ffi-test.dll /dll /def:vm\ffi_test.def vm/ffi_test.obj
|
||||
|
||||
factor.dll.lib: $(DLL_OBJS)
|
||||
link $(LINK_FLAGS) /implib:factor.dll.lib /out:factor.dll /dll $(DLL_OBJS)
|
||||
|
|
@ -160,6 +160,9 @@ clean:
|
|||
if exist factor.exe del factor.exe
|
||||
if exist factor.dll del factor.dll
|
||||
if exist factor.dll.lib del factor.dll.lib
|
||||
if exist libfactor-ffi-test.dll del libfactor-ffi-test.dll
|
||||
if exist libfactor-ffi-test.exp del libfactor-ffi-test.exp
|
||||
if exist libfactor-ffi-test.lib del libfactor-ffi-test.lib
|
||||
|
||||
.PHONY: all default x86-32 x86-64 x86-32-vista x86-64-vista clean
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: help.markup help.syntax literals make multiline sequences
|
||||
stack-checker.alien ;
|
||||
USING: alien alien.libraries compiler.cfg.builder help.markup
|
||||
help.syntax literals make multiline sequences stack-checker.alien
|
||||
strings ;
|
||||
IN: compiler.cfg.builder.alien
|
||||
|
||||
<<
|
||||
|
|
@ -16,11 +17,29 @@ USING: compiler.cfg.builder.alien make prettyprint ;
|
|||
;
|
||||
>>
|
||||
|
||||
HELP: caller-linkage
|
||||
{ $values
|
||||
{ "params" alien-node-params }
|
||||
{ "symbol" string }
|
||||
{ "dll" dll }
|
||||
}
|
||||
{ $description "This word gets the name and library to use when linking to a function in a dynamically loaded dll. It is assumed that the library exports the undecorated name, regardless of calling convention." } ;
|
||||
|
||||
HELP: caller-return
|
||||
{ $values { "params" alien-node-params } }
|
||||
{ $description "If the last alien call returns a value, then this word will emit an instruction to the current sequence being constructed by " { $link make } " that boxes it." }
|
||||
{ $examples { $unchecked-example $[ ex-caller-return ] } } ;
|
||||
|
||||
HELP: check-dlsym
|
||||
{ $values { "symbol" string } { "library" library } }
|
||||
{ $description "Checks that a symbol with the given name exists in the given library. Throws an error if not." } ;
|
||||
|
||||
HELP: unbox-parameters
|
||||
{ $values { "parameters" sequence } { "vregs" sequence } { "reps" sequence } }
|
||||
{ $description "Unboxes a sequence of parameters to send to an ffi function." } ;
|
||||
|
||||
ARTICLE: "compiler.cfg.builder.alien"
|
||||
"CFG node emitter for alien nodes"
|
||||
"The " { $vocab-link "compiler.cfg.builder.alien" } " vocab implements " { $link emit-node } " methods for alien nodes." ;
|
||||
|
||||
ABOUT: "compiler.cfg.builder.alien"
|
||||
|
|
|
|||
|
|
@ -59,38 +59,21 @@ IN: compiler.cfg.builder.alien
|
|||
[ stack-params get ] dip [ return>> ] [ abi>> ] bi stack-cleanup
|
||||
stack-params get ;
|
||||
|
||||
GENERIC# dlsym-valid? 1 ( symbols dll -- ? )
|
||||
|
||||
M: string dlsym-valid? dlsym ;
|
||||
|
||||
M: array dlsym-valid? '[ _ dlsym ] any? ;
|
||||
|
||||
: check-dlsym ( symbols library -- )
|
||||
: check-dlsym ( symbol library -- )
|
||||
{
|
||||
{ [ dup library-dll dll-valid? not ] [
|
||||
[ library-dll dll-path ] [ dlerror>> ] bi
|
||||
cfg get word>> no-such-library-error drop
|
||||
] }
|
||||
{ [ 2dup library-dll dlsym-valid? not ] [
|
||||
{ [ 2dup library-dll dlsym not ] [
|
||||
drop dlerror cfg get word>> no-such-symbol-error
|
||||
] }
|
||||
[ 2drop ]
|
||||
} cond ;
|
||||
|
||||
: decorated-symbol ( params -- symbols )
|
||||
[ function>> ] [ parameters>> [ stack-size ] map-sum number>string ] bi
|
||||
{
|
||||
[ drop ]
|
||||
[ "@" glue ]
|
||||
[ "@" glue "_" prepend ]
|
||||
[ "@" glue "@" prepend ]
|
||||
} 2cleave
|
||||
4array ;
|
||||
|
||||
: caller-linkage ( params -- symbols dll )
|
||||
[ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
|
||||
[ library>> lookup-library ]
|
||||
bi 2dup check-dlsym library-dll ;
|
||||
: caller-linkage ( params -- symbol dll )
|
||||
[ function>> ] [ library>> lookup-library ] bi
|
||||
2dup check-dlsym library-dll ;
|
||||
|
||||
: caller-return ( params -- )
|
||||
return>> [ ] [
|
||||
|
|
@ -186,10 +169,7 @@ M: #alien-assembly emit-node ( node -- )
|
|||
M: #alien-callback emit-node
|
||||
dup params>> xt>> dup
|
||||
[
|
||||
needs-frame-pointer
|
||||
|
||||
begin-word
|
||||
|
||||
needs-frame-pointer begin-word
|
||||
{
|
||||
[ params>> callee-parameters ##callback-inputs, ]
|
||||
[ params>> box-parameters ]
|
||||
|
|
@ -197,6 +177,5 @@ M: #alien-callback emit-node
|
|||
[ params>> emit-callback-return ]
|
||||
[ params>> callback-stack-cleanup ]
|
||||
} cleave
|
||||
|
||||
basic-block get [ end-word ] when
|
||||
] with-cfg-builder ;
|
||||
|
|
|
|||
|
|
@ -718,46 +718,32 @@ mingw? [
|
|||
: fastcall-struct-return-iii-indirect ( x y z ptr -- result )
|
||||
test-struct-11 { int int int } fastcall alien-indirect ;
|
||||
|
||||
: win32? ( -- ? ) os windows? cpu x86.32? and ;
|
||||
|
||||
[ 8 ] [
|
||||
3 4
|
||||
win32? [ &: @ffi_test_50@8 ] [ &: ffi_test_50 ] if
|
||||
fastcall-ii-indirect
|
||||
3 4 &: ffi_test_50 fastcall-ii-indirect
|
||||
] unit-test
|
||||
|
||||
[ 13 ] [
|
||||
3 4 5
|
||||
win32? [ &: @ffi_test_51@12 ] [ &: ffi_test_51 ] if
|
||||
fastcall-iii-indirect
|
||||
3 4 5 &: ffi_test_51 fastcall-iii-indirect
|
||||
] unit-test
|
||||
|
||||
mingw? [
|
||||
[ 13 ] [
|
||||
3 4.0 5
|
||||
win32? [ &: @ffi_test_52@12 ] [ &: ffi_test_52 ] if
|
||||
fastcall-ifi-indirect
|
||||
3 4.0 5 &: ffi_test_52 fastcall-ifi-indirect
|
||||
] unit-test
|
||||
|
||||
[ 19 ] [
|
||||
3 4.0 5 6
|
||||
win32? [ &: @ffi_test_53@16 ] [ &: ffi_test_53 ] if
|
||||
fastcall-ifii-indirect
|
||||
3 4.0 5 6 &: ffi_test_53 fastcall-ifii-indirect
|
||||
] unit-test
|
||||
] unless
|
||||
|
||||
[ S{ test-struct-11 f 7 -1 } ]
|
||||
[
|
||||
3 4
|
||||
win32? [ &: @ffi_test_57@8 ] [ &: ffi_test_57 ] if
|
||||
fastcall-struct-return-ii-indirect
|
||||
3 4 &: ffi_test_57 fastcall-struct-return-ii-indirect
|
||||
] unit-test
|
||||
|
||||
[ S{ test-struct-11 f 7 -3 } ]
|
||||
[
|
||||
3 4 7
|
||||
win32? [ &: @ffi_test_58@12 ] [ &: ffi_test_58 ] if
|
||||
fastcall-struct-return-iii-indirect
|
||||
3 4 7 &: ffi_test_58 fastcall-struct-return-iii-indirect
|
||||
] unit-test
|
||||
|
||||
: fastcall-ii-callback ( -- ptr )
|
||||
|
|
|
|||
|
|
@ -156,28 +156,11 @@ cell factor_vm::compute_dlsym_address(array* parameters,
|
|||
if (d != NULL && !d->handle)
|
||||
return undef;
|
||||
|
||||
cell type = TAG(symbol);
|
||||
if (type == BYTE_ARRAY_TYPE) {
|
||||
|
||||
symbol_char* name = alien_offset(symbol);
|
||||
cell sym = ffi_dlsym_raw(d, name);
|
||||
sym = toc ? FUNCTION_TOC_POINTER(sym) : FUNCTION_CODE_POINTER(sym);
|
||||
return sym ? sym : undef;
|
||||
|
||||
} else if (type == ARRAY_TYPE) {
|
||||
|
||||
array* names = untag<array>(symbol);
|
||||
for (cell i = 0; i < array_capacity(names); i++) {
|
||||
symbol_char* name = alien_offset(array_nth(names, i));
|
||||
cell sym = ffi_dlsym_raw(d, name);
|
||||
sym = toc ? FUNCTION_TOC_POINTER(sym) : FUNCTION_CODE_POINTER(sym);
|
||||
if (sym)
|
||||
return sym;
|
||||
}
|
||||
return undef;
|
||||
|
||||
}
|
||||
return -1;
|
||||
FACTOR_ASSERT(TAG(symbol) == BYTE_ARRAY_TYPE);
|
||||
symbol_char* name = alien_offset(symbol);
|
||||
cell sym = ffi_dlsym_raw(d, name);
|
||||
sym = toc ? FUNCTION_TOC_POINTER(sym) : FUNCTION_CODE_POINTER(sym);
|
||||
return sym ? sym : undef;
|
||||
}
|
||||
|
||||
cell factor_vm::compute_vm_address(cell arg) {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,14 @@
|
|||
EXPORTS
|
||||
ffi_test_0
|
||||
ffi_test_18
|
||||
ffi_test_19
|
||||
ffi_test_49
|
||||
ffi_test_50
|
||||
ffi_test_51
|
||||
ffi_test_52
|
||||
ffi_test_53
|
||||
ffi_test_54
|
||||
ffi_test_55
|
||||
ffi_test_56
|
||||
ffi_test_57
|
||||
ffi_test_58
|
||||
Loading…
Reference in New Issue