steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

alien.libraries: add remove-library word, fix dlclose and dll-valid? VM primitives

db4
Slava Pestov 2009-07-09 06:51:31 -05:00
parent 15c7499ef5
commit baff251d1e
3 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/alien/libraries/libraries-tests.factor Normal file
View File

@ -0,0 +1,10 @@
IN: alien.libraries.tests
USING: alien.libraries alien.syntax tools.test kernel ;
[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
[ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
[ ] [ "doesnotexist" dlopen dlclose ] unit-test
[ "fdasfsf" dll-valid? drop ] must-fail

4
core/alien/alien-tests.factor
View File

@ -71,10 +71,6 @@ cell 8 = [
[ "( displaced alien )" ] [ 0 B{ 1 2 3 } <displaced-alien> unparse ] unit-test [ "( displaced alien )" ] [ 0 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
[ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
SYMBOL: initialize-test SYMBOL: initialize-test
f initialize-test set-global f initialize-test set-global

11
vm/alien.cpp
View File

@ -134,20 +134,21 @@ PRIMITIVE(dlsym)
box_alien(ffi_dlsym(NULL,sym)); box_alien(ffi_dlsym(NULL,sym));
else else
{ {
tagged<dll> d = library.as<dll>(); dll *d = untag_check<dll>(library.value());
d.untag_check();
if(d->dll == NULL) if(d->dll == NULL)
dpush(F); dpush(F);
else else
box_alien(ffi_dlsym(d.untagged(),sym)); box_alien(ffi_dlsym(d,sym));
} }
} }
/* close a native library handle */ /* close a native library handle */
PRIMITIVE(dlclose) PRIMITIVE(dlclose)
{ {
ffi_dlclose(untag_check<dll>(dpop())); dll *d = untag_check<dll>(dpop());
if(d->dll != NULL)
ffi_dlclose(d);
} }
PRIMITIVE(dll_validp) PRIMITIVE(dll_validp)
@ -156,7 +157,7 @@ PRIMITIVE(dll_validp)
if(library == F) if(library == F)
dpush(T); dpush(T);
else else
dpush(tagged<dll>(library)->dll == NULL ? F : T); dpush(untag_check<dll>(library)->dll == NULL ? F : T);
} }
/* gets the address of an object representing a C pointer */ /* gets the address of an object representing a C pointer */