Create foreign objects pointing to the data in a lisp array (M. Goffioul)

This commit is contained in:
jgarcia 2006-03-21 09:06:33 +00:00
parent 5b8bc60363
commit 353e7121b1
4 changed files with 22 additions and 0 deletions

View file

@ -133,6 +133,25 @@ si_free_foreign_data(cl_object f)
f->foreign.data = NULL;
}
cl_object
si_make_foreign_data_from_array(cl_object array)
{
cl_object tag = Cnil;
if (type_of(array) != t_array && type_of(array) != t_vector) {
FEwrong_type_argument(@'array', array);
}
switch (array->array.elttype) {
case aet_sf: tag = @':float'; break;
case aet_lf: tag = @':double'; break;
case aet_fix: tag = @':int'; break;
case aet_index: tag = @':unsigned-int'; break;
default:
FEerror("Cannot make foreign object from array with element type ~S.", 1, ecl_elttype_to_symbol(array->array.elttype));
break;
}
@(return ecl_make_foreign_data(tag, 0, array->array.self.ch));
}
cl_object
si_foreign_data_address(cl_object f)
{

View file

@ -1435,6 +1435,7 @@ cl_symbols[] = {
{SYS_ "FOREIGN-DATA-SET-ELT", SI_ORDINARY, si_foreign_data_set_elt, 4, OBJNULL},
{SYS_ "FOREIGN-DATA-TAG", SI_ORDINARY, si_foreign_data_tag, 1, OBJNULL},
{SYS_ "FREE-FOREIGN-DATA", SI_ORDINARY, si_free_foreign_data, 1, OBJNULL},
{SYS_ "MAKE-FOREIGN-DATA-FROM-ARRAY", SI_ORDINARY, si_make_foreign_data_from_array, 1, OBJNULL},
{SYS_ "LOAD-FOREIGN-MODULE", SI_ORDINARY, si_load_foreign_module, 1, OBJNULL},
{SYS_ "NULL-POINTER-P", SI_ORDINARY, si_null_pointer_p, 1, OBJNULL},
{SYS_ "SIZE-OF-FOREIGN-ELT-TYPE", SI_ORDINARY, si_size_of_foreign_elt_type, 1, OBJNULL},

View file

@ -1435,6 +1435,7 @@ cl_symbols[] = {
{SYS_ "FOREIGN-DATA-SET-ELT","si_foreign_data_set_elt"},
{SYS_ "FOREIGN-DATA-TAG","si_foreign_data_tag"},
{SYS_ "FREE-FOREIGN-DATA","si_free_foreign_data"},
{SYS_ "MAKE-FOREIGN-DATA-FROM-ARRAY","si_make_foreign_data_from_array"},
{SYS_ "LOAD-FOREIGN-MODULE","si_load_foreign_module"},
{SYS_ "NULL-POINTER-P","si_null_pointer_p"},
{SYS_ "SIZE-OF-FOREIGN-ELT-TYPE","si_size_of_foreign_elt_type"},

View file

@ -497,6 +497,7 @@ extern cl_object si_foreign_data_set_elt(cl_object f, cl_object ndx, cl_object t
extern cl_object si_foreign_data_tag(cl_object x);
extern cl_object si_foreign_data_recast(cl_object f, cl_object size, cl_object tag);
extern cl_object si_free_foreign_data(cl_object x);
extern cl_object si_make_foreign_data_from_array(cl_object x);
extern cl_object si_null_pointer_p(cl_object f);
extern cl_object si_size_of_foreign_elt_type(cl_object tag);
extern cl_object si_load_foreign_module(cl_object module);