Merge remote-tracking branch 'factorcode/master'

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 ;
 
 : <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 ;
 
@@ -61,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 ;
+    { [ os windows? ] [ "alien.libraries.windows" ] }
-
+    { [ os unix? ] [ "alien.libraries.unix" ] }
-M: unix >deployed-library-path
+} cond require >>
-    file-name "$ORIGIN" prepend-path ;
-
-M: macosx >deployed-library-path
-    file-name "@executable_path/../Frameworks" prepend-path ;
-
-PRIVATE>

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 ;
+

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 ;

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 -- )
+: check-dlsym ( symbols library -- )
-    dup dll-valid? [
+    {
-        dupd dlsym-valid?
+        { [ dup library-dll dll-valid? not ] [
-        [ drop ] [ cfg get word>> no-such-symbol ] if
+            [ library-dll dll-path ] [ dlerror>> ] bi
-    ] [ dll-path cfg get word>> no-such-library drop ] if ;
+            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 -- )

basis/compiler/errors/errors.factor

@@ -44,7 +44,7 @@ T{ error-type
 : <linkage-error> ( error word -- linkage-error )
     \ linkage-error <definition-error> ;
 
-: linkage-error ( error word class -- )
+: linkage-error ( name message word class -- )
     '[ _ boa ] dip <linkage-error> 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 ;

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,
+	stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
-		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> callstack(ctx->pop(),this);
+	data_root<callstack> stack(ctx->pop(),this);
 	data_root<quotation> 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);