better FFI error reporting

darcs
erg 2006-10-18 21:16:37 +00:00
parent cdecc54db5
commit 72ba2c98c5
6 changed files with 18 additions and 9 deletions

View File

@ -1,6 +1,8 @@
- live search: timer delay would be nice - live search: timer delay would be nice
- help responder has no way to access { "foo" "bar" } - help responder has no way to access { "foo" "bar" }
- httpd search tools - httpd search tools
- condition rethrow restarts broken
- menus broken (right click, left click another word)
+ ui: + ui:

View File

@ -24,6 +24,10 @@ M: alien-invoke-error summary
: alien-invoke ( ... return library function parameters -- ... ) : alien-invoke ( ... return library function parameters -- ... )
pick pick <alien-invoke-error> throw ; pick pick <alien-invoke-error> throw ;
: ensure-dlsym ( node -- )
[ alien-invoke-dlsym dlsym drop ]
[ inference-warning ] recover ;
\ alien-invoke [ string object string object ] [ ] <effect> \ alien-invoke [ string object string object ] [ ] <effect>
"infer-effect" set-word-prop "infer-effect" set-word-prop
@ -33,7 +37,7 @@ M: alien-invoke-error summary
pop-literal nip over set-alien-invoke-function pop-literal nip over set-alien-invoke-function
pop-literal nip over set-alien-invoke-library pop-literal nip over set-alien-invoke-library
pop-literal nip over set-alien-invoke-return pop-literal nip over set-alien-invoke-return
dup alien-invoke-dlsym dlsym drop dup ensure-dlsym
alien-invoke-stack alien-invoke-stack
] "infer" set-word-prop ] "infer" set-word-prop

View File

@ -44,7 +44,7 @@ M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
#! so this is mostly a no-op. #! so this is mostly a no-op.
swap slip stack-reg swap ADD ; inline swap slip stack-reg swap ADD ; inline
: compile-c-call* ( symbol dll args -- operands ) : compile-c-call* ( symbol dll args -- )
dup length cells [ dup length cells [
<reversed> [ PUSH ] each %alien-invoke <reversed> [ PUSH ] each %alien-invoke
] with-aligned-stack ; ] with-aligned-stack ;

View File

@ -30,7 +30,9 @@ words definitions ;
"Cannot convert to C string: " write third . ; "Cannot convert to C string: " write third . ;
: ffi-error. ( obj -- ) : ffi-error. ( obj -- )
"FFI: " write third print ; "FFI: " write
dup third [ write ": " write ] when*
fourth print ;
: heap-scan-error. ( obj -- ) : heap-scan-error. ( obj -- )
"Cannot do next-object outside begin/end-scan" print drop ; "Cannot do next-object outside begin/end-scan" print drop ;

View File

@ -22,8 +22,8 @@ void ffi_dlopen(DLL *dll, bool error)
{ {
if(error) if(error)
{ {
general_error(ERROR_FFI,tag_object( general_error(ERROR_FFI,F,
from_char_string(dlerror())),F,true); tag_object(from_char_string(dlerror())),true);
} }
else else
dll->dll = NULL; dll->dll = NULL;
@ -42,8 +42,8 @@ void *ffi_dlsym(DLL *dll, F_STRING *symbol, bool error)
{ {
if(error) if(error)
{ {
general_error(ERROR_FFI,tag_object( general_error(ERROR_FFI,tag_object(symbol),
from_char_string(dlerror())),F,true); tag_object(from_char_string(dlerror())),true);
} }
return NULL; return NULL;

View File

@ -58,7 +58,7 @@ void ffi_dlopen (DLL *dll, bool error)
{ {
dll->dll = NULL; dll->dll = NULL;
if(error) if(error)
general_error(ERROR_FFI, tag_object(get_error_message()),F,true); general_error(ERROR_FFI, F, tag_object(get_error_message()),true);
else else
return; return;
} }
@ -74,7 +74,8 @@ void *ffi_dlsym (DLL *dll, F_STRING *symbol, bool error)
if (!sym) if (!sym)
{ {
if(error) if(error)
general_error(ERROR_FFI, tag_object(get_error_message()),F,true); general_error(ERROR_FFI, tag_object(symbol),
tag_object(get_error_message()),true);
else else
return NULL; return NULL;
} }