mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 05:43:19 -08:00
Code Issues Projects Releases Packages Wiki Activity

Move FOREIGN-ELT-TYPE-P into ffi.d, because the list of types in ffi.lsp had become obsolete and difficult to maintain.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-04-26 14:17:47 +02:00
parent 23d8509f6d
commit 5b2a69c7ed
5 changed files with 42 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

39
src/c/ffi.d
View file

@ -333,6 +333,20 @@ si_foreign_data_tag(cl_object f)
@(return f->foreign.tag);
}
cl_object
si_foreign_data_equal(cl_object f1, cl_object f2)
{
if (ecl_unlikely(!ECL_FOREIGN_DATA_P(f1))) {
FEwrong_type_only_arg(@[si::foreign-data-address], f1,
@[si::foreign-data]);
}
if (ecl_unlikely(!ECL_FOREIGN_DATA_P(f2))) {
FEwrong_type_only_arg(@[si::foreign-data-address], f2,
@[si::foreign-data]);
}
@(return ((f1->foreign.data == f2->foreign.data)? Ct : Cnil))
}
cl_object
si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize,
cl_object tag)
@ -397,16 +411,25 @@ si_foreign_data_set(cl_object f, cl_object andx, cl_object value)
@(return value)
}
enum ecl_ffi_tag
ecl_foreign_type_code(cl_object type)
static int
foreign_type_code(cl_object type)
{
int i;
for (i = 0; i <= ECL_FFI_VOID; i++) {
if (type == ecl_foreign_type_table[i])
return (enum ecl_ffi_tag)i;
return i;
}
FEerror("~A does not denote an elementary foreign type.", 1, type);
return ECL_FFI_VOID;
return -1;
}
enum ecl_ffi_tag
ecl_foreign_type_code(cl_object type)
{
int i = foreign_type_code(type);
if (ecl_unlikely(i < 0)) {
FEerror("~A does not denote an elementary foreign type.", 1, type);
}
return (enum ecl_ffi_tag)i;
}
#ifdef HAVE_LIBFFI
@ -630,6 +653,12 @@ si_size_of_foreign_elt_type(cl_object type)
@(return MAKE_FIXNUM(ecl_foreign_type_size[tag]))
}
cl_object
si_foreign_elt_type_p(cl_object type)
{
@(return ((foreign_type_code(type) < 0)? Cnil : Ct))
}
cl_object
si_null_pointer_p(cl_object f)
{

2
src/c/symbols_list.h
View file

@ -1400,6 +1400,7 @@ cl_symbols[] = {
{SYS_ "FIND-FOREIGN-SYMBOL", SI_ORDINARY, si_find_foreign_symbol, 4, OBJNULL},
{SYS_ "FOREIGN-DATA", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "FOREIGN-DATA-ADDRESS", SI_ORDINARY, si_foreign_data_address, 1, OBJNULL},
{SYS_ "FOREIGN-DATA-EQUAL", SI_ORDINARY, si_foreign_data_equal, 2, OBJNULL},
{SYS_ "FOREIGN-DATA-P", SI_ORDINARY, si_foreign_data_p, 1, OBJNULL},
{SYS_ "FOREIGN-DATA-POINTER", SI_ORDINARY, si_foreign_data_pointer, 4, OBJNULL},
{SYS_ "FOREIGN-DATA-RECAST", SI_ORDINARY, si_foreign_data_recast, 3, OBJNULL},
@ -1408,6 +1409,7 @@ cl_symbols[] = {
{SYS_ "FOREIGN-DATA-SET", SI_ORDINARY, si_foreign_data_set, 3, OBJNULL},
{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_ "FOREIGN-ELT-TYPE-P", SI_ORDINARY, si_foreign_elt_type_p, 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},

2
src/c/symbols_list2.h
View file

@ -1400,6 +1400,7 @@ cl_symbols[] = {
{SYS_ "FIND-FOREIGN-SYMBOL","si_find_foreign_symbol"},
{SYS_ "FOREIGN-DATA",NULL},
{SYS_ "FOREIGN-DATA-ADDRESS","si_foreign_data_address"},
{SYS_ "FOREIGN-DATA-EQUAL","si_foreign_data_equal"},
{SYS_ "FOREIGN-DATA-P","si_foreign_data_p"},
{SYS_ "FOREIGN-DATA-POINTER","si_foreign_data_pointer"},
{SYS_ "FOREIGN-DATA-RECAST","si_foreign_data_recast"},
@ -1408,6 +1409,7 @@ cl_symbols[] = {
{SYS_ "FOREIGN-DATA-SET","si_foreign_data_set"},
{SYS_ "FOREIGN-DATA-SET-ELT","si_foreign_data_set_elt"},
{SYS_ "FOREIGN-DATA-TAG","si_foreign_data_tag"},
{SYS_ "FOREIGN-ELT-TYPE-P","si_foreign_elt_type_p"},
{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"},

2
src/h/external.h
View file

@ -590,8 +590,10 @@ extern ECL_API cl_object _ecl_link_call(cl_object sym, cl_objectfn *pLK, cl_obje
/* ffi.c */
extern ECL_API cl_object si_allocate_foreign_data(cl_object tag, cl_object size);
extern ECL_API cl_object si_foreign_elt_type_p(cl_object f);
extern ECL_API cl_object si_foreign_data_p(cl_object f);
extern ECL_API cl_object si_foreign_data_address(cl_object f);
extern ECL_API cl_object si_foreign_data_equal(cl_object f1, cl_object f2);
extern ECL_API cl_object si_foreign_data_pointer(cl_object f, cl_object ndx, cl_object size, cl_object tag);
extern ECL_API cl_object si_foreign_data_ref(cl_object f, cl_object ndx, cl_object size, cl_object tag);
extern ECL_API cl_object si_foreign_data_ref_elt(cl_object f, cl_object ndx, cl_object tag);

15
src/lsp/ffi.lsp
View file

@ -36,7 +36,8 @@
"*USE-DFFI*"
)
(:import-from "SYS" "NULL-POINTER-P" "GET-SYSPROP" "PUT-SYSPROP"))
(:import-from "SYS" "NULL-POINTER-P" "GET-SYSPROP" "PUT-SYSPROP"
"FOREIGN-ELT-TYPE-P"))
(in-package "FFI")
@ -58,18 +59,6 @@
(defvar *use-dffi* t)
(defun foreign-elt-type-p (name)
(and (symbolp name)
(member name '(:byte :unsigned-byte :short :unsigned-short
:int :unsigned-int :char :unsigned-char
:long :unsigned-long :pointer-void :object
:float :double :cstring
:int8-t #+uint16-t :int16-t
#+uint32-t :int32-t #+uint64-t :int64-t
:uint8-t #+uint16-t :uint16-t
#+uint32-t :uint32-t #+uint64-t :uint64-t)
:test 'eq)))
(defmacro def-foreign-type (name definition)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (gethash ',name ffi::*ffi-types*) ',definition)))