Commit 47942ff8 authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Get rid of some dead wood.

parent f0016946
......@@ -679,7 +679,7 @@ mk_si_release_ffi_area(MKCL)
}
struct mkcl_fficall *
mkcl_fficall_prepare(MKCL, mkcl_object return_type, mkcl_object arg_type, mkcl_object cc_type)
mkcl_fficall_prepare(MKCL, mkcl_object return_type, mkcl_object arg_type)
{
struct mkcl_fficall *fficall = env->fficall;
......@@ -691,14 +691,9 @@ mkcl_fficall_prepare(MKCL, mkcl_object return_type, mkcl_object arg_type, mkcl_o
fficall->buffer_sp = fficall->buffer;
fficall->registers = NULL;
fficall->output.pc = NULL;
/* fficall->cc = MKCL_FFI_CC_CDECL; */
/* fficall->cstring = mk_cl_Cnil; */
}
else
fficall->buffer_sp = fficall->buffer;
/* fficall->buffer_size = 0; */
/* fficall->cstring = mk_cl_Cnil; */
/* fficall->cc = mkcl_foreign_cc_code(env, cc_type); */
fficall->registers = mkcl_fficall_prepare_extra(env, fficall->registers);
return fficall;
}
......@@ -739,11 +734,13 @@ void mkcl_fficall_align16(MKCL)
fficall->buffer_sp = (char *) (((intptr_t) (fficall->buffer_sp + 0xF)) & ~((uintptr_t)0xF));
}
@(defun si::call-cfun (fun return_type arg_types args &optional (cc_type @':cdecl'))
mkcl_object mk_si_call_cfun(MKCL, mkcl_object fun, mkcl_object return_type, mkcl_object arg_types, mkcl_object args)
{
void *cfun = mkcl_foreign_raw_pointer(env, fun);
enum mkcl_ffi_tag return_type_tag = mkcl_foreign_type_code(env, return_type);
@
struct mkcl_fficall *fficall = mkcl_fficall_prepare(env, return_type, arg_types, cc_type);
struct mkcl_fficall *fficall = mkcl_fficall_prepare(env, return_type, arg_types);
mkcl_call_stack_check(env);
while (MKCL_CONSP(arg_types)) {
mkcl_object object;
......@@ -773,21 +770,19 @@ void mkcl_fficall_align16(MKCL)
fficall->buffer_sp = fficall->buffer;
@(return return_value);
}
@)
}
mkcl_object mk_si_make_dynamic_callback(MKCL, mkcl_object fun, mkcl_object sym, mkcl_object rtype, mkcl_object argtypes)
{
mkcl_call_stack_check(env);
@(defun si::make-dynamic-callback (fun sym rtype argtypes &optional (cctype @':cdecl'))
@
mkcl_object data = mk_cl_list(env, 3, fun, rtype, argtypes);
#if 0
void * ptr = mkcl_dynamic_callback_make(env, data, mkcl_foreign_cc_code(env, cctype));
#else
void * ptr = mkcl_dynamic_callback_make(env, data);
#endif
mkcl_object C_type = mk_cl_list(env, 2, @'*', @':void');
mkcl_object cbk = mkcl_make_foreign(env, C_type, sizeof(void *));
*((void **) cbk->foreign.data) = ptr;
mk_si_put_sysprop(env, sym, @':callback', MKCL_CONS(env, cbk, data));
@(return cbk);
@)
}
......@@ -838,8 +838,8 @@ extern "C" {
extern MKCL_API mkcl_object mk_si_load_foreign_module(MKCL, mkcl_object module);
extern MKCL_API mkcl_object mk_si_unload_foreign_module(MKCL, mkcl_object module);
extern MKCL_API mkcl_object mk_si_find_foreign_symbol(MKCL, mkcl_object var, mkcl_object module, mkcl_object type, mkcl_object size);
extern MKCL_API mkcl_object mk_si_call_cfun(MKCL, mkcl_narg, mkcl_object fun, mkcl_object return_type, mkcl_object arg_types, mkcl_object args, ...);
extern MKCL_API mkcl_object mk_si_make_dynamic_callback(MKCL, mkcl_narg, mkcl_object fun, mkcl_object sym, mkcl_object return_type, mkcl_object arg_types, ...);
extern MKCL_API mkcl_object mk_si_call_cfun(MKCL, mkcl_object fun, mkcl_object return_type, mkcl_object arg_types, mkcl_object args);
extern MKCL_API mkcl_object mk_si_make_dynamic_callback(MKCL, mkcl_object fun, mkcl_object sym, mkcl_object return_type, mkcl_object arg_types);
extern MKCL_API mkcl_object mk_si_trim_ffi_arguments_staging_area(MKCL);
extern MKCL_API mkcl_object mk_si_release_ffi_area(MKCL);
extern MKCL_API mkcl_object mk_si_pointer(MKCL, mkcl_object x);
......
......@@ -292,23 +292,10 @@ extern "C" {
long double ld;
};
#if 0
enum mkcl_ffi_calling_convention {
MKCL_FFI_CC_CDECL = 0,
MKCL_FFI_CC_STDCALL
};
/* Note that the order of enums declared in enum mkcl_ffi_calling_convention must
carefully match the content of mkcl_foreign_cc_table[]. JCB
*/
#endif
struct mkcl_fficall {
char *buffer_sp;
size_t buffer_size;
union mkcl_ffi_values output;
#if 0
enum mkcl_ffi_calling_convention cc;
#endif
struct mkcl_fficall_reg *registers;
char * buffer;
/* mkcl_object cstring; */
......@@ -316,7 +303,7 @@ extern "C" {
extern enum mkcl_ffi_tag mkcl_foreign_type_code(MKCL, mkcl_object type);
extern enum mkcl_ffi_calling_convention mkcl_foreign_cc_code(MKCL, mkcl_object cc_type);
extern struct mkcl_fficall * mkcl_fficall_prepare(MKCL, mkcl_object return_type, mkcl_object arg_types, mkcl_object cc_type);
extern struct mkcl_fficall * mkcl_fficall_prepare(MKCL, mkcl_object return_type, mkcl_object arg_types);
extern void mkcl_fficall_push_bytes(MKCL, void *data, size_t bytes);
extern void mkcl_fficall_push_int(MKCL, int word);
extern void mkcl_fficall_align4(MKCL);
......
......@@ -1539,7 +1539,7 @@ mkcl_symbol_initializer mkcl_root_symbols[] = {
{{SYS_ "*CODE-WALKER*", SI_SPECIAL, NULL, -1, MKCL_OBJNULL}},
{{SYS_ "CALL-CFUN", SI_ORDINARY, mk_si_call_cfun, -1, MKCL_OBJNULL}},
{{SYS_ "CALL-CFUN", SI_ORDINARY, mk_si_call_cfun, 4, MKCL_OBJNULL}},
{{KEY_ "CALLBACK", KEYWORD, NULL, -1, MKCL_OBJNULL}},
{{SYS_ "MAKE-DYNAMIC-CALLBACK", SI_ORDINARY, mk_si_make_dynamic_callback, -1, MKCL_OBJNULL}},
{{KEY_ "CDECL", KEYWORD, NULL, -1, MKCL_OBJNULL}},
......
......@@ -697,19 +697,19 @@
0 (max 0 (1- (* nargs 3)))))) ;; There is 3 characters per argument specifier. JCB
;;; FIXME! We should turn this into a closure generator that produces no code.
(defmacro def-lib-function (name args &key returning module (call :cdecl))
(defmacro def-lib-function (name args &key returning module)
(multiple-value-bind (c-name lisp-name) (map-name-from-c-to-lisp name)
(let* ((return-type (ffi::%convert-to-return-type returning))
(return-required (not (eq return-type :void)))
(argtypes (mapcar #'(lambda (a) (ffi::%convert-to-arg-type (second a))) args)))
`(let ((c-fun (si::find-foreign-symbol ',c-name ,module :pointer-void 0)))
(defun ,lisp-name ,(mapcar #'first args)
(si::call-cfun c-fun ',return-type ',argtypes (list ,@(mapcar #'first args)) ,call))))))
(si::call-cfun c-fun ',return-type ',argtypes (list ,@(mapcar #'first args))))))))
(defmacro def-function (name args &key module (returning :void) (call :cdecl))
(defmacro def-function (name args &key module (returning :void))
(when module
(return-from def-function
`(def-lib-function ,name ,args :returning ,returning :module ,module :call ,call)))
`(def-lib-function ,name ,args :returning ,returning :module ,module)))
(multiple-value-bind (c-name lisp-name)
(map-name-from-c-to-lisp name)
(let* ((arguments (mapcar #'first args))
......@@ -822,12 +822,12 @@
(multiple-value-bind (name call-type) (if (consp name)
(values-list name)
(values name :cdecl))
(declare (ignorable call-type))
;;(format t "~&Expanding macro defcallback on ~S.~%" name)
(let ((arg-types (mapcar #'second arg-desc))
(arg-names (mapcar #'first arg-desc)))
`(si::make-dynamic-callback
#'(si::lambda-block ,name ,arg-names ,@body)
',name ',ret-type ',arg-types ,call-type))))
#'(si::lambda-block ,name ,arg-names ,@body) ',name ',ret-type ',arg-types))))
(defun callback (name)
(let ((x (si::get-sysprop name :callback)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment