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

cmpcbk: improve +foreign-elt-type-codes+

Browse source 
- move the constant and a function foreign-elt-type-code to the top
- re-align the constant data
- fix the feature reader conditionals (they were misplaced)
- add reader conditionals for complex floats
This commit is contained in:
Daniel Kochmański 2019-11-27 12:00:41 +01:00
parent 241f3ed172
commit 83ec2c86c7
1 changed files with 36 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

76
src/cmp/cmpcbk.lsp
View file

@ -15,6 +15,42 @@
(in-package "COMPILER")
(defconstant +foreign-elt-type-codes+
'( (:char . "ECL_FFI_CHAR")
(:unsigned-char . "ECL_FFI_UNSIGNED_CHAR")
(:byte . "ECL_FFI_BYTE")
(:unsigned-byte . "ECL_FFI_UNSIGNED_BYTE")
(:short . "ECL_FFI_SHORT")
(:unsigned-short . "ECL_FFI_UNSIGNED_SHORT")
(:int . "ECL_FFI_INT")
(:unsigned-int . "ECL_FFI_UNSIGNED_INT")
(:long . "ECL_FFI_LONG")
(:unsigned-long . "ECL_FFI_UNSIGNED_LONG")
#+:uint16-t (:int16-t . "ECL_FFI_INT16_T")
#+:uint16-t (:uint16-t . "ECL_FFI_UINT16_T")
#+:uint32-t (:int32-t . "ECL_FFI_INT32_T")
#+:uint32-t (:uint32-t . "ECL_FFI_UINT32_T")
#+:uint64-t (:int64-t . "ECL_FFI_INT64_T")
#+:uint64-t (:uint64-t . "ECL_FFI_UINT64_T")
#+:long-long (:long-long . "ECL_FFI_LONG_LONG")
#+:long-long (:unsigned-long-long . "ECL_FFI_UNSIGNED_LONG_LONG")
(:pointer-void . "ECL_FFI_POINTER_VOID")
(:cstring . "ECL_FFI_CSTRING")
(:object . "ECL_FFI_OBJECT")
(:float . "ECL_FFI_FLOAT")
(:double . "ECL_FFI_DOUBLE")
(:long-double . "ECL_FFI_LONG_DOUBLE")
#+complex-float (:csfloat . "ECL_FFI_CSFLOAT")
#+complex-float (:cdfloat . "ECL_FFI_CDFLOAT")
#+complex-float (:clfloat . "ECL_FFI_CLFLOAT")
(:void . "ECL_FFI_VOID")))
(defun foreign-elt-type-code (type)
(let ((x (assoc type +foreign-elt-type-codes+)))
(unless x
(cmperr "~a is not a valid elementary FFI type" type))
(cdr x)))
(defun c1-defcallback (args)
(destructuring-bind (name return-type arg-list &rest body)
args
@ -45,46 +81,6 @@
,(format nil "ecl_make_foreign_data(@':pointer-void,0,(void*)~a)" c-name)
:one-liner t)))))))
(defconstant +foreign-elt-type-codes+
'((:char . "ECL_FFI_CHAR")
(:unsigned-char . "ECL_FFI_UNSIGNED_CHAR")
(:byte . "ECL_FFI_BYTE")
(:unsigned-byte . "ECL_FFI_UNSIGNED_BYTE")
(:short . "ECL_FFI_SHORT")
(:unsigned-short . "ECL_FFI_UNSIGNED_SHORT")
(:int . "ECL_FFI_INT")
(:unsigned-int . "ECL_FFI_UNSIGNED_INT")
(:long . "ECL_FFI_LONG")
(:unsigned-long . "ECL_FFI_UNSIGNED_LONG")
#+:uint16-t #+:uint16-t
(:int16-t . "ECL_FFI_INT16_T")
(:uint16-t . "ECL_FFI_UINT16_T")
#+:uint32-t #+:uint32-t
(:int32-t . "ECL_FFI_INT32_T")
(:uint32-t . "ECL_FFI_UINT32_T")
#+:uint64-t #+:uint64-t
(:int64-t . "ECL_FFI_INT64_T")
(:uint64-t . "ECL_FFI_UINT64_T")
#+:long-long #+:long-long
(:long-long . "ECL_FFI_LONG_LONG")
(:unsigned-long-long . "ECL_FFI_UNSIGNED_LONG_LONG")
(:pointer-void . "ECL_FFI_POINTER_VOID")
(:cstring . "ECL_FFI_CSTRING")
(:object . "ECL_FFI_OBJECT")
(:float . "ECL_FFI_FLOAT")
(:double . "ECL_FFI_DOUBLE")
(:long-double . "ECL_FFI_LONG_DOUBLE")
;; complex floats
(:csfloat . "ECL_FFI_CSFLOAT")
(:cdfloat . "ECL_FFI_CDFLOAT")
(:clfloat . "ECL_FFI_CLFLOAT")
(:void . "ECL_FFI_VOID")))
(defun foreign-elt-type-code (type)
(let ((x (assoc type +foreign-elt-type-codes+)))
(unless x
(cmperr "~a is not a valid elementary FFI type" type))
(cdr x)))
(defun t3-defcallback (lisp-name c-name c-name-constant return-type
arg-types arg-type-constants call-type &aux (return-p t))