(in-package #:uffi)
-#+mcl
+#+(or openmcl digitool)
(defvar *keyword-package* (find-package "KEYWORD"))
-#+mcl
+#+(or openmcl digitool)
; MCL and OpenMCL expect a lot of FFI elements to be keywords (e.g. struct field names in OpenMCL)
; So this provides a function to convert any quoted symbols to keywords.
(defun keyword (obj)
obj)))
; Wrapper for unexported function we have to use
-#+(and mcl (not openmcl))
+#+digitool
(defmacro def-mcl-type (name type)
`(ccl::def-mactype ,(keyword name) (ccl:find-mactype ,type)))
(defmacro def-type (name type)
"Generates a (deftype) statement for CL. Currently, only CMUCL
supports takes advantage of this optimization."
- #+(or lispworks allegro mcl cormanlisp) (declare (ignore type))
- #+(or lispworks allegro mcl cormanlisp) `(deftype ,name () t)
+ #+(or lispworks allegro openmcl digitool cormanlisp) (declare (ignore type))
+ #+(or lispworks allegro openmcl digitool cormanlisp) `(deftype ,name () t)
#+(or cmu scl)
`(deftype ,name () '(alien:alien ,(convert-from-uffi-type type :declare)))
#+sbcl
#+(or cmu scl) `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
#+sbcl `(sb-alien:define-alien-type ,name ,(convert-from-uffi-type type :type))
#+cormanlisp `(ct:defctype ,name ,(convert-from-uffi-type type :type))
- #+mcl
+ #+(or openmcl digitool)
(let ((mcl-type (convert-from-uffi-type type :type)))
(unless (or (keywordp mcl-type) (consp mcl-type))
(setf mcl-type `(quote ,mcl-type)))
- #+(and mcl (not openmcl))
+ #+digitool
`(def-mcl-type ,(keyword name) ,mcl-type)
#+openmcl
`(ccl::def-foreign-type ,(keyword name) ,mcl-type))
(:float . :float) (:double . :double)
(:array . :c-array)))
-#+(and mcl (not openmcl))
+#+digitool
(setq *type-conversion-list*
'((* . :pointer) (:void . :void)
(:short . :short) (:unsigned-short . :unsigned-short)
(let ((found-type (gethash type +type-conversion-hash+)))
(if found-type
found-type
- #-mcl type
- #+mcl (keyword type))))
+ #-(or openmcl digitool) type
+ #+(or openmcl digitool) (keyword type))))
(defun %convert-from-uffi-type (type context)
"Converts from a uffi type to an implementation specific type"
((and (eq context :return)
(eq type :cstring))
(basic-convert-from-uffi-type :cstring-returning))
- #+(and mcl (not openmcl))
+ #+digitool
((and (eq type :void) (eq context :return)) nil)
(t
(basic-convert-from-uffi-type type)))
(cl:quote
(convert-from-uffi-type (cadr type) context))
(:struct-pointer
- #+mcl `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
- #-mcl (%convert-from-uffi-type (list '* (cadr type)) :struct)
+ #+(or openmcl digitool) `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
+ #-(or openmcl digitool) (%convert-from-uffi-type (list '* (cadr type)) :struct)
)
(:struct
- #+mcl `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
- #-mcl (%convert-from-uffi-type (cadr type) :struct)
+ #+(or openmcl digitool) `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
+ #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :struct)
)
(:union
- #+mcl `(:union ,(%convert-from-uffi-type (cadr type) :union))
- #-mcl (%convert-from-uffi-type (cadr type) :union)
+ #+(or openmcl digitool) `(:union ,(%convert-from-uffi-type (cadr type) :union))
+ #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :union)
)
(t
(cons (%convert-from-uffi-type (first type) context)
(if (eq context :struct)
(append '(:*) (cdr result))
:address))
- #+(and mcl (not openmcl))
+ #+digitool
((and (eq (car result) :pointer) (eq context :allocation) :pointer))
(t result))))