Fix callbacks with :VOID and :UNSIGNED-BYTE return type.

This commit is contained in:
goffioul 2005-10-24 09:29:13 +00:00
parent 8d2c7cd69a
commit 893a514da4
2 changed files with 11 additions and 7 deletions

View file

@ -68,8 +68,10 @@
(cdr x)))
(defun t3-defcallback (lisp-name c-name c-name-constant return-type
arg-types arg-type-constants call-type)
arg-types arg-type-constants call-type &aux (return-p t))
(cond ((ffi::foreign-elt-type-p return-type))
((member return-type '(nil :void))
(setf return-p nil))
((and (consp return-type)
(member (first return-type) '(* array)))
(setf return-type :pointer-void))
@ -92,7 +94,8 @@
(setf comma ",")))
(wt ")")
(wt-nl1 "{")
(wt-nl return-type-name " output;")
(when return-p
(wt-nl return-type-name " output;"))
(wt-nl "cl_object aux;")
(loop for n from 0
and type in arg-types
@ -106,9 +109,10 @@
(wt-nl "aux = cl_apply_from_stack(" (length arg-types)
",ecl_fdefinition(" c-name-constant "));")
(wt-nl "cl_stack_pop_n(" (length arg-types) ");")
(wt-nl "ecl_foreign_data_set_elt(&output,"
(foreign-elt-type-code return-type) ",aux);")
(wt-nl "return output;")
(when return-p
(wt-nl "ecl_foreign_data_set_elt(&output,"
(foreign-elt-type-code return-type) ",aux);")
(wt-nl "return output;"))
(wt-nl1 "}")))
(put-sysprop 'FFI:DEFCALLBACK 'C1 #'c1-defcallback)

View file

@ -18,8 +18,8 @@
(defconstant +representation-types+
'(;; These types can be used by ECL to unbox data
;; They are sorted from the most specific, to the least specific one.
:byte ((signed-byte 8) "byte")
:unsigned-byte ((unsigned-byte 8) "unsigned byte")
:byte ((signed-byte 8) "int8_t")
:unsigned-byte ((unsigned-byte 8) "uint8_t")
:fixnum (fixnum "cl_fixnum")
:int ((integer #.si:c-int-min #.si:c-int-max) "int")
:unsigned-int ((integer 0 #.si:c-uint-max) "unsigned int")