;;;;
;;;; $Id$
;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2005 by Kevin M. Rosenberg
;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
(in-package #:uffi)
#+lispworks `((fli:define-c-typedef ,enum-name :int))
#+(or cmu scl) `((alien:def-alien-type ,enum-name alien:signed))
#+sbcl `((sb-alien:define-alien-type ,enum-name sb-alien:signed))
- #+(and mcl (not openmcl)) `((def-mcl-type ,enum-name :integer))
+ #+digitool `((def-mcl-type ,enum-name :integer))
#+openmcl `((ccl::def-foreign-type ,enum-name :int))
(nreverse constants)))
cmds))
#+sbcl
`(sb-alien:define-alien-type ,name-array
(* ,(convert-from-uffi-type type :array)))
- #+(and mcl (not openmcl))
+ #+digitool
`(def-mcl-type ,name-array '(:array ,type))
#+openmcl
`(ccl::def-foreign-type ,name-array (:array ,(convert-from-uffi-type type :array)))
(if (eq type :pointer-self)
#+(or cmu scl) `((* (alien:struct ,name)))
#+sbcl `((* (sb-alien:struct ,name)))
- #+mcl `((:* (:struct ,name)))
+ #+(or openmcl digitool) `((:* (:struct ,name)))
#+lispworks `((:pointer ,name))
- #-(or cmu sbcl scl mcl lispworks) `((* ,name))
+ #-(or cmu sbcl scl openmcl digitool lispworks) `((* ,name))
`(,(convert-from-uffi-type type :struct))))))
(if variant
(push (list def) processed)
`(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))
#+lispworks
`(fli:define-c-struct ,name ,@(process-struct-fields name fields))
- #+(and mcl (not openmcl))
+ #+digitool
`(ccl:defrecord ,name ,@(process-struct-fields name fields))
#+openmcl
`(ccl::def-foreign-type
`(alien:slot ,obj ,slot)
#+sbcl
`(sb-alien:slot ,obj ,slot)
- #+mcl
+ #+(or openmcl digitool)
`(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
)
-#+mcl
+#+(or openmcl digitool)
(defmacro set-slot-value (obj type slot value) ;use setf to set values
`(setf (ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot)))) ,value))
-#+mcl
+#+(or openmcl digitool)
(defsetf get-slot-value set-slot-value)
`(alien:slot ,obj ,slot)
#+sbcl
`(sb-alien:slot ,obj ,slot)
- #+(and mcl (not openmcl))
+ #+digitool
`(ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl:field-info ,type ,slot))))
#+openmcl
`(let ((field (ccl::%find-foreign-record-type-field ,type ,slot)))
;; below
(eval-when (:compile-toplevel :load-toplevel :execute)
;; so we could allow '(:array :long) or deref with other type like :long only
- #+mcl
+ #+(or openmcl digitool)
(defun array-type (type)
(let ((result type))
(when (listp type)
(ccl::%foreign-type-or-record local-type)
`(* ,i ,element-size-in-bits)
nil))
- #+(and mcl (not openmcl))
+ #+digitool
(let* ((array-type (array-type type))
(local-type (convert-from-uffi-type array-type :allocation))
(accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
))
; this expands to the %set-xx functions which has different params than %put-xx
-#+(and mcl (not openmcl))
+#+digitool
(defmacro deref-array-set (obj type i value)
(let* ((array-type (array-type type))
(local-type (convert-from-uffi-type array-type :allocation))
(* (the fixnum ,i) ,(size-of-foreign-type local-type))
,value)))
-#+(and mcl (not openmcl))
+#+digitool
(defsetf deref-array deref-array-set)
(defmacro def-union (name &rest fields)
`(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
#+sbcl
`(sb-alien:define-alien-type ,name (sb-alien:union ,name ,@(process-struct-fields name fields)))
- #+(and mcl (not openmcl))
+ #+digitool
`(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
#+openmcl
`(ccl::def-foreign-type nil