From: Björn Lindqvist Date: Tue, 1 Sep 2015 12:40:32 +0000 (+0200) Subject: VM: always use undecorated names when loading ffi functions X-Git-Tag: unmaintained~1889 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=bc7f9ee669c46ac6890a5c5627ce5f26e721043a 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). --- diff --git a/Nmakefile b/Nmakefile index 9085867b0d..d7a5d26122 100644 --- a/Nmakefile +++ b/Nmakefile @@ -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 diff --git a/basis/compiler/cfg/builder/alien/alien-docs.factor b/basis/compiler/cfg/builder/alien/alien-docs.factor index fa22861bca..3586f654a9 100644 --- a/basis/compiler/cfg/builder/alien/alien-docs.factor +++ b/basis/compiler/cfg/builder/alien/alien-docs.factor @@ -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" diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index ff500fb809..ad75cd38b9 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -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 ; diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index d3e1dfbf5d..0e388f2407 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -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 ) diff --git a/vm/code_blocks.cpp b/vm/code_blocks.cpp index d3a2f88f4d..0eb1ed338f 100644 --- a/vm/code_blocks.cpp +++ b/vm/code_blocks.cpp @@ -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(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) { diff --git a/vm/ffi_test.def b/vm/ffi_test.def new file mode 100644 index 0000000000..7afa9a949c --- /dev/null +++ b/vm/ffi_test.def @@ -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