mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-09 02:33:14 -08:00
Code Issues Projects Releases Packages Wiki Activity

New implementation of DEF-FOREIGN-VAR which can load shared libraries on demand (M. Goffioul)

Browse source
This commit is contained in:
jjgarcia 2005-10-04 13:48:34 +00:00
parent 6e02b093c5
commit 96fcaaf344
7 changed files with 68 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

1
msvc/ecl-threads.def
View file

@ -261,6 +261,7 @@ EXPORTS
; ffi.c
si_allocate_foreign_data
si_find_foreign_symbol
si_foreign_data_address
si_foreign_data_pointer
si_foreign_data_ref

1
msvc/ecl.def
View file

@ -261,6 +261,7 @@ EXPORTS
; ffi.c
si_allocate_foreign_data
si_find_foreign_symbol
si_foreign_data_address
si_foreign_data_pointer
si_foreign_data_ref

48
src/c/ffi.d
View file

@ -361,3 +361,51 @@ si_foreign_data_recast(cl_object f, cl_object size, cl_object tag)
f->foreign.tag = tag;
@(return f)
}
cl_object
ecl_library_get_or_open(cl_object filename)
{
cl_object libraries = cl_core.libraries;
int i;
for (i=0; i<libraries->vector.fillp; i++)
if (cl_stringE(2, libraries->vector.self.t[i]->cblock.name, filename) != Cnil)
return libraries->vector.self.t[i];
return ecl_library_open(filename);
}
cl_object
si_find_foreign_symbol(cl_object var, cl_object module, cl_object type, cl_object size)
{
cl_object block;
cl_object output;
void *sym;
#ifdef ECL_THREADS
mp_get_lock(1, symbol_value(@'mp::+load-compile-lock+'));
CL_UNWIND_PROTECT_BEGIN {
#endif
block = ecl_library_get_or_open(module);
if (block->cblock.handle == NULL) {
output = ecl_library_error(block);
goto OUTPUT;
}
sym = ecl_library_symbol(block, ecl_string_pointer_safe(var));
if (sym == NULL) {
output = ecl_library_error(block);
goto OUTPUT;
}
output = ecl_make_foreign_data(type, object_to_fixnum(size), sym);
OUTPUT:
#ifdef ECL_THREADS
(void)0; /* MSVC complains about missing ';' before '}' */
} CL_UNWIND_PROTECT_EXIT {
mp_giveup_lock(symbol_value(@'mp::+load-compile-lock+'));
} CL_UNWIND_PROTECT_END;
#endif
if (type_of(output) == t_foreign)
@(return output)
else
FEerror("FIND-FOREIGN-VAR: Could not load foreign variable ~S from modeul ~S (Error: ~S)", 3, var, module, output);
}

1
src/c/symbols_list.h
View file

@ -1429,6 +1429,7 @@ cl_symbols[] = {
#endif
{SYS_ "ALLOCATE-FOREIGN-DATA", SI_ORDINARY, si_allocate_foreign_data, 2, OBJNULL},
{SYS_ "FIND-FOREIGN-VAR", 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-POINTER", SI_ORDINARY, si_foreign_data_pointer, 4, OBJNULL},

1
src/c/symbols_list2.h
View file

@ -1429,6 +1429,7 @@ cl_symbols[] = {
#endif
{SYS_ "ALLOCATE-FOREIGN-DATA","si_allocate_foreign_data"},
{SYS_ "FIND-FOREIGN-VAR","si_find_foreign_symbol"},
{SYS_ "FOREIGN-DATA",NULL},
{SYS_ "FOREIGN-DATA-ADDRESS","si_foreign_data_address"},
{SYS_ "FOREIGN-DATA-POINTER","si_foreign_data_pointer"},

1
src/h/external.h
View file

@ -503,6 +503,7 @@ extern cl_object si_foreign_data_recast(cl_object f, cl_object size, cl_object t
extern cl_object si_free_foreign_data(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_find_foreign_symbol(cl_object var, cl_object module, cl_object type, cl_object size);
extern cl_object ecl_make_foreign_data(cl_object tag, cl_index size, void *data);
extern cl_object ecl_allocate_foreign_data(cl_object tag, cl_index size);

27
src/lsp/ffi.lsp
View file

@ -509,6 +509,9 @@
0 (max 0 (1- (* nargs 3))))))
(defmacro def-function (name args &key module (returning :void))
(cond ((and module (macro-function (find-symbol "DEF-LIB-FUNCTION" "FFI")))
`(def-lib-function ,name ,args :returning ,returning :module ,module))
(t
(multiple-value-bind (c-name lisp-name)
(lisp-to-c-name name)
(let* ((arguments (mapcar #'first args))
@ -532,31 +535,31 @@
(error "FFI can only handle C functions with up to 36 arguments"))
`(defun ,lisp-name (,@arguments)
,inline-form)
)))
)))))
(defmacro def-foreign-var (name type module)
(declare (ignore module))
;(declare (ignore module))
(multiple-value-bind (c-name lisp-name)
(lisp-to-c-name name)
(let* ((ffi-type (%convert-to-ffi-type type))
(can-deref (or (foreign-elt-type-p ffi-type)
(and (consp ffi-type)
(member (first ffi-type) '(* :array))))))
(member (first ffi-type) '(* :array)))))
(inline-form (cond (module
`(si::find-foreign-var ,c-name ,module ,type ,(size-of-foreign-type type)))
(t
`(c-inline () () :object
,(format nil "ecl_make_foreign_data(@~S, ~A, &~A)"
type (size-of-foreign-type type) c-name)
:side-effects t :one-liner t)))))
(if can-deref
`(progn
(put-sysprop ',lisp-name 'ffi-foreign-var
(c-inline () () :object
,(format nil "ecl_make_foreign_data(@~S, ~A, &~A)"
type (size-of-foreign-type type) c-name)
:side-effects t :one-liner t))
(put-sysprop ',lisp-name 'ffi-foreign-var ,inline-form)
(eval-when (:compile-toplevel :load-toplevel :execute)
(define-symbol-macro ,lisp-name
(ffi:deref-pointer (get-sysprop ',lisp-name 'ffi-foreign-var) ',type)
)))
`(defvar ,lisp-name (c-inline () () :object
,(format nil "ecl_make_foreign_data(@~S, ~A, &~A)"
type (size-of-foreign-type type) c-name)
:side-effects t :one-liner t)))
`(defvar ,lisp-name ,inline-form))
)))
(defun find-foreign-library (names directories &key drive-letters types)