mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-10 11:12:58 -08:00
Fix callbacks with :VOID and :UNSIGNED-BYTE return type.
This commit is contained in:
parent
8d2c7cd69a
commit
893a514da4
2 changed files with 11 additions and 7 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue