;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: objects.lisp,v 1.2 2002/10/14 01:51:15 kevin Exp $
+;;;; $Id: objects.lisp,v 1.6 2002/11/23 18:01:57 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(defun size-of-foreign-type (type)
#+lispworks (fli:size-of type)
#+allegro (ff:sizeof-fobject type)
- #+cmu (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes
+ #+(or cmu scl) (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes
#+sbcl (ash (eval `(sb-alien:alien-size ,type)) -3) ;; convert from bits to bytes
#+clisp (values (ffi:size-of type))
#+(and mcl (not openmcl))
an array of TYPE with size SIZE. The TYPE parameter is evaluated."
(if (eq size :unspecified)
(progn
- #+cmu
+ #+(or cmu scl)
`(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
#+sbcl
`(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
#+lispworks
`(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
#+allegro
- `(ff:allocate-fobject ,(convert-from-uffi-type type :allocate) :c)
+ `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
#+mcl
`(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
)
(progn
- #+cmu
+ #+(or cmu scl)
`(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
#+sbcl
`(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
)))
(defmacro free-foreign-object (obj)
- #+cmu
+ #+(or cmu scl)
`(alien:free-alien ,obj)
#+sbcl
`(sb-alien:free-alien ,obj)
(defmacro null-pointer-p (obj)
#+lispworks `(fli:null-pointer-p ,obj)
#+allegro `(zerop ,obj)
- #+cmu `(alien:null-alien ,obj)
+ #+(or cmu scl) `(alien:null-alien ,obj)
#+sbcl `(sb-alien:null-alien ,obj)
#+mcl `(ccl:%null-ptr-p ,obj)
)
(defmacro make-null-pointer (type)
- #+(or allegro cmu sbcl mcl) (declare (ignore type))
- #+cmu `(system:int-sap 0)
- #+sbcl `(sb-sys:int-sap 0)
+ #+(or allegro mcl) (declare (ignore type))
+ #+(or cmu scl) `(alien:sap-alien (system:int-sap 0) (* ,(convert-from-uffi-type (eval type) :type)))
+ #+sbcl `(sb-alien:sap-alien (sb-sys:int-sap 0) (* ,(convert-from-uffi-type (eval type) :type)))
+ #+lispworks `(fli:make-pointer :address 0 :type (quote ,(convert-from-uffi-type (eval type) :type)))
#+allegro 0
- #+lispworks `(fli:make-pointer :address 0 :type ,type)
#+mcl `(ccl:%null-ptr)
)
(defmacro char-array-to-pointer (obj)
- #+cmu `(alien:cast ,obj (* (alien:unsigned 8)))
+ #+(or cmu scl) `(alien:cast ,obj (* (alien:unsigned 8)))
#+sbcl `(sb-alien:cast ,obj (* (sb-alien:unsigned 8)))
#+lispworks `(fli:make-pointer :type '(:unsigned :char)
:address (fli:pointer-address ,obj))
(defmacro deref-pointer (ptr type)
"Returns a object pointed"
- #+(or cmu sbcl lispworks) (declare (ignore type))
- #+cmu `(alien:deref ,ptr)
+ #+(or cmu sbcl lispworks scl) (declare (ignore type))
+ #+(or cmu scl) `(alien:deref ,ptr)
#+sbcl `(sb-alien:deref ,ptr)
#+lispworks `(fli:dereference ,ptr)
- #+allegro `(ff:fslot-value-typed ,(convert-from-uffi-type type :deref) :c ,ptr)
- #+mcl `(ccl:pref ,ptr ,(convert-from-uffi-type type :deref))
+ #+allegro `(ff:fslot-value-typed (convert-from-uffi-type ,type :deref) :c ,ptr)
+ #+mcl `(ccl:pref ,ptr (convert-from-uffi-type ,type :deref))
)
#+mcl
(defmacro ensure-char-character (obj)
obj)
-#+(or allegro cmu sbcl openmcl)
+#+(or allegro cmu sbcl scl openmcl)
(defmacro ensure-char-character (obj)
`(code-char ,obj))
(defmacro ensure-char-integer (obj)
`(char-code ,obj))
-#+(or allegro cmu sbcl openmcl)
+#+(or allegro cmu sbcl scl openmcl)
(defmacro ensure-char-integer (obj)
obj)
(defmacro pointer-address (obj)
- #+cmu
+ #+(or cmu scl)
`(system:sap-int (alien:alien-sap ,obj))
#+sbcl
`(sb-sys:sap-int (sb-alien:alien-sap ,obj))
;; TYPE is evaluated.
#-mcl
(defmacro with-foreign-object ((var type) &rest body)
- #-(or cmu sbcl lispworks) ; default version
+ #-(or cmu sbcl lispworks scl) ; default version
`(let ((,var (allocate-foreign-object ,type)))
(unwind-protect
(progn ,@body)
(free-foreign-object ,var)))
- #+cmu
+ #+(or cmu scl)
(let ((obj (gensym)))
`(alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate)))
(let ((,var (alien:addr ,obj)))