alien.libraries, compiler.cfg.builder.alien: if `dlopen` fails during `<library>`, call `dlerror` and store the error message in the library object; put the dlerror message in the linkage-error when a word from the library is compiled

db4
Joe Groff 2011-09-12 23:06:08 -07:00
parent b6e0f0180b
commit 5703e8d7a1
4 changed files with 43 additions and 34 deletions

View File

@ -2,39 +2,37 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.strings assocs io.backend
kernel namespaces destructors sequences strings
system io.pathnames fry ;
system io.pathnames fry combinators vocabs.loader ;
IN: alien.libraries
ERROR: unknown-dlsym-platform ;
<< {
{ [ os windows? ] [ "alien.libraries.windows" ] }
{ [ os unix? ] [ "alien.libraries.unix" ] }
[ unknown-dlsym-platform ]
} cond use-vocab >>
: dlopen ( path -- dll ) native-string>alien (dlopen) ;
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
: dlsym-raw ( name dll -- alien ) [ string>symbol ] dip (dlsym-raw) ;
: dlerror ( -- message/f ) (dlerror) ;
HOOK: dlerror os ( -- message/f )
SYMBOL: libraries
libraries [ H{ } clone ] initialize
TUPLE: library { path string } { abi abi initial: cdecl } dll ;
TUPLE: library { path string } { abi abi initial: cdecl } dll dlerror ;
ERROR: no-library name ;
: library ( name -- library ) libraries get at ;
: <library> ( path abi -- library )
over dup [ dlopen ] when \ library boa ;
over dup
[ dlopen dup dll-valid? [ f ] [ dlerror ] if ] [ f ] if
\ library boa ;
: library-dll ( library -- dll )
dup [ dll>> ] when ;
: load-library ( name -- dll )
library dup [ dll>> ] when ;
library library-dll ;
M: dll dispose dlclose ;
@ -70,17 +68,9 @@ deploy-libraries [ V{ } clone ] initialize
[ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
[ no-library ] if ;
<PRIVATE
HOOK: >deployed-library-path os ( path -- path' )
M: windows >deployed-library-path
file-name ;
M: unix >deployed-library-path
file-name "$ORIGIN" prepend-path ;
M: macosx >deployed-library-path
file-name "@executable_path/../Frameworks" prepend-path ;
PRIVATE>
<< {
{ [ os windows? ] [ "alien.libraries.windows" ] }
{ [ os unix? ] [ "alien.libraries.unix" ] }
} cond require >>

View File

@ -1,5 +1,15 @@
USING: alien.c-types alien.syntax io.encodings.utf8 ;
USING: alien.c-types alien.libraries alien.syntax io.encodings.utf8
io.pathnames system ;
IN: alien.libraries.unix
FUNCTION-ALIAS: (dlerror)
c-string[utf8] dlerror ( ) ;
c-string dlerror ( ) ;
M: unix dlerror (dlerror) ;
M: unix >deployed-library-path
file-name "$ORIGIN" prepend-path ;
M: macosx >deployed-library-path
file-name "@executable_path/../Frameworks" prepend-path ;

View File

@ -1,5 +1,8 @@
USING: windows.errors ;
USING: alien.libraries io.pathnames system windows.errors ;
IN: alien.libraries.windows
: (dlerror) ( -- message )
M: windows >deployed-library-path
file-name ;
M: windows dlerror ( -- message )
win32-error-string ;

View File

@ -67,11 +67,17 @@ M: string dlsym-valid? dlsym ;
M: array dlsym-valid? '[ _ dlsym ] any? ;
: check-dlsym ( symbols dll -- )
dup dll-valid? [
dupd dlsym-valid?
[ drop ] [ dlerror cfg get word>> no-such-symbol ] if
] [ dll-path "" cfg get word>> no-such-library drop ] if ;
: check-dlsym ( symbols library -- )
{
{ [ dup library-dll dll-valid? not ] [
[ library-dll dll-path ] [ dlerror>> ] bi
cfg get word>> no-such-library drop
] }
{ [ 2dup library-dll dlsym-valid? not ] [
drop dlerror cfg get word>> no-such-symbol
] }
[ 2drop ]
} cond ;
: decorated-symbol ( params -- symbols )
[ function>> ] [ parameters>> [ stack-size ] map-sum number>string ] bi
@ -85,7 +91,7 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
: caller-linkage ( params -- symbols dll )
[ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
[ library>> load-library ]
[ library>> library ]
bi 2dup check-dlsym ;
: caller-return ( params -- )