diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor index 37ac47307d..b8466e023a 100755 --- a/basis/alien/libraries/libraries.factor +++ b/basis/alien/libraries/libraries.factor @@ -2,7 +2,7 @@ ! 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 : dlopen ( path -- dll ) native-string>alien (dlopen) ; @@ -11,21 +11,28 @@ IN: alien.libraries : dlsym-raw ( name dll -- alien ) [ string>symbol ] dip (dlsym-raw) ; +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 ; @@ -61,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 new file mode 100644 index 0000000000..84cea56041 --- /dev/null +++ b/basis/alien/libraries/unix/unix.factor @@ -0,0 +1,15 @@ +USING: alien.c-types alien.libraries alien.syntax io.encodings.utf8 +io.pathnames system ; +IN: alien.libraries.unix + +FUNCTION-ALIAS: (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 new file mode 100644 index 0000000000..249bcff57a --- /dev/null +++ b/basis/alien/libraries/windows/windows.factor @@ -0,0 +1,8 @@ +USING: alien.libraries io.pathnames system windows.errors ; +IN: alien.libraries.windows + +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 d0a4d19723..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 ] [ 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 -- ) diff --git a/basis/compiler/errors/errors.factor b/basis/compiler/errors/errors.factor index 3881439fc0..3c00c5173e 100644 --- a/basis/compiler/errors/errors.factor +++ b/basis/compiler/errors/errors.factor @@ -44,7 +44,7 @@ T{ error-type : ( error word -- linkage-error ) \ linkage-error ; -: linkage-error ( error word class -- ) +: linkage-error ( name message word class -- ) '[ _ boa ] dip dup asset>> linkage-errors get set-at ; inline T{ error-type @@ -57,16 +57,16 @@ T{ error-type { fatal? f } } define-error-type -TUPLE: no-such-library name ; +TUPLE: no-such-library name message ; M: no-such-library summary drop "Library not found" ; -: no-such-library ( name word -- ) \ no-such-library linkage-error ; +: no-such-library ( name message word -- ) \ no-such-library linkage-error ; -TUPLE: no-such-symbol name ; +TUPLE: no-such-symbol name message ; M: no-such-symbol summary drop "Symbol not found" ; -: no-such-symbol ( name word -- ) \ no-such-symbol linkage-error ; +: no-such-symbol ( name message word -- ) \ no-such-symbol linkage-error ; -ERROR: not-compiled word error ; \ No newline at end of file +ERROR: not-compiled word error ; diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 5a7fbb8c03..a0bbae8709 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -129,8 +129,8 @@ void factor_vm::set_frame_offset(stack_frame *frame, cell offset) void factor_vm::scrub_return_address() { - stack_frame *frame = innermost_stack_frame(ctx->callstack_top, - ctx->callstack_bottom); + stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom, + ctx->callstack_top); set_frame_offset(frame,0); } @@ -214,15 +214,15 @@ void factor_vm::primitive_innermost_stack_frame_scan() void factor_vm::primitive_set_innermost_stack_frame_quot() { - data_root callstack(ctx->pop(),this); + data_root stack(ctx->pop(),this); data_root quot(ctx->pop(),this); - callstack.untag_check(this); + stack.untag_check(this); quot.untag_check(this); jit_compile_quot(quot.value(),true); - stack_frame *inner = innermost_stack_frame(callstack->bottom(), callstack->top()); + stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top()); cell offset = frame_offset(inner); inner->entry_point = quot->entry_point; set_frame_offset(inner,offset);