Tease out symbol name and library in undefined_symbol() handler, for friendlier errors when calling an unresolved C function name. Fixes #93

basis/compiler/tests/linkage-errors.factor

@@ -1,12 +1,18 @@
 USING: tools.test namespaces assocs alien.syntax kernel
-compiler.errors accessors alien alien.c-types ;
+compiler.errors accessors alien alien.c-types alien.strings
-FROM: alien.libraries => add-library ;
+debugger literals ;
+FROM: alien.libraries => add-library load-library ;
 IN: compiler.tests.linkage-errors
 
 ! Regression: calling an undefined function would raise a protection fault
 FUNCTION: void this_does_not_exist ( ) ;
 
-[ this_does_not_exist ] [ { "kernel-error" 9 f f } = ] must-fail-with
+[ this_does_not_exist ] try
+
+[ this_does_not_exist ] [
+    { "kernel-error" 9 $[ "this_does_not_exist" string>symbol ] f }
+    =
+] must-fail-with
 
 [ T{ no-such-symbol { name "this_does_not_exist" } } ]
 [ \ this_does_not_exist linkage-errors get at error>> ] unit-test
@@ -17,5 +23,16 @@ LIBRARY: no_such_library
 
 FUNCTION: void no_such_function ( ) ;
 
+[ no_such_function ] try
+
+[ no_such_function ] [
+    {
+        "kernel-error" 9
+        $[ "no_such_function" string>symbol ]
+        $[ "no_such_library" load-library ]
+    }
+    =
+] must-fail-with
+
 [ T{ no-such-library { name "no_such_library" } } ]
 [ \ no_such_function linkage-errors get at error>> ] unit-test

basis/debugger/debugger.factor

@@ -1,15 +1,16 @@
-! Copyright (C) 2004, 2010 Slava Pestov.
+! Copyright (C) 2004, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: slots arrays definitions generic hashtables summary io
+USING: alien.strings slots arrays definitions generic hashtables
-kernel math namespaces make prettyprint prettyprint.config
+summary io kernel math namespaces make prettyprint
-sequences assocs sequences.private strings io.styles
+prettyprint.config sequences assocs sequences.private strings
-io.pathnames vectors words system splitting math.parser
+io.styles io.pathnames vectors words system splitting
-classes.mixin classes.tuple continuations continuations.private
+math.parser classes.mixin classes.tuple continuations
-combinators generic.math classes.builtin classes compiler.units
+continuations.private combinators generic.math classes.builtin
-generic.standard generic.single vocabs init kernel.private
+classes compiler.units generic.standard generic.single vocabs
-io.encodings accessors math.order destructors source-files
+init kernel.private io.encodings accessors math.order
-parser classes.tuple.parser effects.parser lexer generic.parser
+destructors source-files parser classes.tuple.parser
-strings.parser vocabs.loader vocabs.parser source-files.errors ;
+effects.parser lexer generic.parser strings.parser vocabs.loader
+vocabs.parser source-files.errors ;
 IN: debugger
 
 GENERIC: error-help ( error -- topic )
@@ -107,8 +108,9 @@ HOOK: signal-error. os ( obj -- )
     "FFI error" print drop ;
 
 : undefined-symbol-error. ( obj -- )
-    "The image refers to a library or symbol that was not found at load time"
+    "Cannot resolve C library function" print
-    print drop ;
+    "Symbol: " write dup third symbol>string print
+    "Library: " write fourth . ;
 
 : stack-underflow. ( obj name -- )
     write " stack underflow" print drop ;

core/alien/strings/strings.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2010 Slava Pestov.
+! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays sequences kernel kernel.private accessors math
 alien.accessors byte-arrays io io.encodings io.encodings.utf8
@@ -51,19 +51,14 @@ M: windows native-string-encoding utf16n ;
 : dll-path ( dll -- string )
     path>> alien>native-string ;
 
-HOOK: string>symbol* os ( str/seq -- alien )
+GENERIC: string>symbol ( str/seq -- alien )
 
-M: winnt string>symbol* utf8 string>alien ;
+M: string string>symbol utf8 string>alien ;
 
-M: wince string>symbol* utf16n string>alien ;
+M: sequence string>symbol [ utf8 string>alien ] map ;
 
-M: unix string>symbol* utf8 string>alien ;
+: symbol>string ( alien -- str )
-
+    utf8 alien>string ;
-GENERIC: string>symbol ( str -- alien )
-
-M: string string>symbol string>symbol* ;
-
-M: sequence string>symbol [ string>symbol* ] map ;
 
 [
      8 special-object utf8 alien>string string>cpu \ cpu set-global

vm/alien.cpp

@@ -160,7 +160,6 @@ void factor_vm::primitive_dlsym_raw()
 		ctx->push(allot_alien(ffi_dlsym_raw(NULL,sym)));
 }
 
-
 /* close a native library handle */
 void factor_vm::primitive_dlclose()
 {

vm/callstack.cpp

@@ -129,13 +129,8 @@ void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
 
 void factor_vm::scrub_return_address()
 {
-	stack_frame *top = ctx->callstack_top;
+	stack_frame *frame = innermost_stack_frame(ctx->callstack_top,
-	stack_frame *bottom = ctx->callstack_bottom;
+		ctx->callstack_bottom);
-	stack_frame *frame = bottom - 1;
-
-	while(frame >= top && frame_successor(frame) >= top)
-		frame = frame_successor(frame);
-
 	set_frame_offset(frame,0);
 }
 
@@ -191,10 +186,8 @@ void factor_vm::primitive_callstack_to_array()
 	ctx->push(accum.frames.elements.value());
 }
 
-stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
+stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
 {
-	stack_frame *top = stack->top();
-	stack_frame *bottom = stack->bottom();
 	stack_frame *frame = bottom - 1;
 
 	while(frame >= top && frame_successor(frame) >= top)
@@ -207,13 +200,15 @@ stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
 Used by the single stepper. */
 void factor_vm::primitive_innermost_stack_frame_executing()
 {
-	stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
+	callstack *stack = untag_check<callstack>(ctx->pop());
+	stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 	ctx->push(frame_executing_quot(frame));
 }
 
 void factor_vm::primitive_innermost_stack_frame_scan()
 {
-	stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
+	callstack *stack = untag_check<callstack>(ctx->pop());
+	stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 	ctx->push(frame_scan(frame));
 }
 
@@ -227,7 +222,7 @@ void factor_vm::primitive_set_innermost_stack_frame_quot()
 
 	jit_compile_quot(quot.value(),true);
 
-	stack_frame *inner = innermost_stack_frame(callstack.untagged());
+	stack_frame *inner = innermost_stack_frame(callstack->bottom(), callstack->top());
 	cell offset = frame_offset(inner);
 	inner->entry_point = quot->entry_point;
 	set_frame_offset(inner,offset);

vm/code_blocks.cpp

@@ -140,23 +140,11 @@ void factor_vm::update_word_references(code_block *compiled, bool reset_inline_c
 	}
 }
 
-/* References to undefined symbols are patched up to call this function on
-image load */
-void factor_vm::undefined_symbol()
-{
-	general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object);
-}
-
-void undefined_symbol()
-{
-	return current_vm()->undefined_symbol();
-}
-
 /* Look up an external library symbol referenced by a compiled code block */
-cell factor_vm::compute_dlsym_address(array *literals, cell index)
+cell factor_vm::compute_dlsym_address(array *parameters, cell index)
 {
-	cell symbol = array_nth(literals,index);
+	cell symbol = array_nth(parameters,index);
-	cell library = array_nth(literals,index + 1);
+	cell library = array_nth(parameters,index + 1);
 
 	dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 
@@ -197,10 +185,10 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index)
 }
 
 #ifdef FACTOR_PPC
-cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
+cell factor_vm::compute_dlsym_toc_address(array *parameters, cell index)
 {
-	cell symbol = array_nth(literals,index);
+	cell symbol = array_nth(parameters,index);
-	cell library = array_nth(literals,index + 1);
+	cell library = array_nth(parameters,index + 1);
 
 	dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 
@@ -240,7 +228,6 @@ cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
 }
 #endif
 
-
 cell factor_vm::compute_vm_address(cell arg)
 {
 	return (cell)this + untag_fixnum(arg);
@@ -248,9 +235,9 @@ cell factor_vm::compute_vm_address(cell arg)
 
 void factor_vm::store_external_address(instruction_operand op)
 {
-	code_block *compiled = op.parent_code_block();
+	code_block *compiled = op.compiled;
 	array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
-	cell index = op.parameter_index();
+	cell index = op.index;
 
 	switch(op.rel_type())
 	{
@@ -327,7 +314,7 @@ struct initial_code_block_visitor {
 			op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
 			break;
 		case RT_HERE:
-			op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
+			op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.compiled));
 			break;
 		case RT_UNTAGGED:
 			op.store_value(untag_fixnum(next_literal()));
@@ -451,4 +438,49 @@ code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell lab
 	return compiled;
 }
 
+/* Find the RT_DLSYM relocation nearest to the given return address. */
+struct find_symbol_at_address_visitor {
+	factor_vm *parent;
+	cell return_address;
+	cell symbol;
+	cell library;
+
+	find_symbol_at_address_visitor(factor_vm *parent_, cell return_address_) :
+		parent(parent_), return_address(return_address_),
+		symbol(false_object), library(false_object) { }
+
+	void operator()(instruction_operand op)
+	{
+		if(op.rel_type() == RT_DLSYM && op.pointer < return_address)
+		{
+			code_block *compiled = op.compiled;
+			array *parameters = untag<array>(compiled->parameters);
+			cell index = op.index;
+			symbol = array_nth(parameters,index);
+			library = array_nth(parameters,index + 1);
+		}
+	}
+};
+
+/* References to undefined symbols are patched up to call this function on
+image load. It finds the symbol and library, and throws an error. */
+void factor_vm::undefined_symbol()
+{
+	stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
+		ctx->callstack_top);
+	code_block *compiled = frame_code(frame);
+	cell return_address = (cell)FRAME_RETURN_ADDRESS(frame, this);
+	find_symbol_at_address_visitor visitor(this, return_address);
+	compiled->each_instruction_operand(visitor);
+	if (!to_boolean(visitor.symbol))
+		critical_error("Can't find RT_DLSYM at return address", return_address);
+	else
+		general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library);
+}
+
+void undefined_symbol()
+{
+	return current_vm()->undefined_symbol();
+}
+
 }

vm/code_blocks.hpp

@@ -83,4 +83,5 @@ struct code_block
 	}
 };
 
+VM_C_API void undefined_symbol(void);
 }

vm/image.cpp

@@ -160,7 +160,7 @@ struct startup_code_block_relocation_visitor {
 
 	void operator()(instruction_operand op)
 	{
-		code_block *compiled = op.parent_code_block();
+		code_block *compiled = op.compiled;
 		cell old_offset = op.rel_offset() + (cell)compiled->entry_point() - fixup.code_offset;
 
 		switch(op.rel_type())

vm/instruction_operands.hpp

@@ -143,16 +143,6 @@ struct instruction_operand {
 		return rel.rel_offset();
 	}
 
-	cell parameter_index()
-	{
-		return index;
-	}
-
-	code_block *parent_code_block()
-	{
-		return compiled;
-	}
-
 	fixnum load_value_2_2();
 	fixnum load_value_2_2_2_2();
 	fixnum load_value_masked(cell mask, cell bits, cell shift);

vm/vm.hpp

@@ -593,7 +593,7 @@ struct factor_vm
 	void set_frame_offset(stack_frame *frame, cell offset);
 	void scrub_return_address();
 	void primitive_callstack_to_array();
-	stack_frame *innermost_stack_frame(callstack *stack);
+	stack_frame *innermost_stack_frame(stack_frame *bottom, stack_frame *top);
 	void primitive_innermost_stack_frame_executing();
 	void primitive_innermost_stack_frame_scan();
 	void primitive_set_innermost_stack_frame_quot();