diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor index e24105651a..b8466e023a 100755 --- a/basis/alien/libraries/libraries.factor +++ b/basis/alien/libraries/libraries.factor @@ -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 ; : ( 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 ; -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 >> diff --git a/basis/alien/libraries/unix/unix.factor b/basis/alien/libraries/unix/unix.factor index 8db779d013..84cea56041 100644 --- a/basis/alien/libraries/unix/unix.factor +++ b/basis/alien/libraries/unix/unix.factor @@ -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 ; + diff --git a/basis/alien/libraries/windows/windows.factor b/basis/alien/libraries/windows/windows.factor index 9a595c8a09..249bcff57a 100644 --- a/basis/alien/libraries/windows/windows.factor +++ b/basis/alien/libraries/windows/windows.factor @@ -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 ; diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 114d1deb3e..8c1a213fb8 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -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 -- )