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 9085867b0dcecc8b83d50feedee0d3c1ef9727f4..d7a5d26122e4f3342cc2f576d4b8bb3038dbba61 100644 (file)
--- 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 fa22861bca4f5066d1244eb1db3e84d259f7d695..3586f654a99fb9dfcb7d8a07ed835e5339a60dc4 100644 (file)
--- 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 ff500fb8097438bd97649ba3cf0d6630668fe233..ad75cd38b9603da73ed5822ae567744392ce6307 100644 (file)
--- 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 d3e1dfbf5d702f72533a0a2b71da2f9dc0e5c848..0e388f2407f78b98318f5c25c5d94ebfd48cbc4c 100755 (executable)
--- 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 d3a2f88f4d43f3392955a7971d7d59426154ba38..0eb1ed338f833b02ff7a8e10b55c2d98c633c861 100644 (file)
--- 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<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) {

diff --git a/vm/ffi_test.def b/vm/ffi_test.def
new file mode 100644 (file)
index 0000000..7afa9a9
--- /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