r2997: *** empty log message ***

[uffi.git] / src / objects.lisp

diff --git a/src/objects.lisp b/src/objects.lisp
index 5a9d21aea7694bbf39d01c480f7189b8f59a7cb0..7826f56c8bcd6f52d5806876fa9ada05cc8a827b 100644 (file)
--- a/src/objects.lisp
+++ b/src/objects.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: objects.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: objects.lisp,v 1.2 2002/10/14 01:51:15 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -23,6 +23,7 @@
   #+lispworks (fli:size-of type)
   #+allegro (ff:sizeof-fobject type)
   #+cmu  (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))
   (let ((mcl-type (ccl:find-mactype type nil t)))
@@ -40,6 +41,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
       (progn
        #+cmu
        `(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
@@ -50,6 +53,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
       (progn
        #+cmu
        `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
+       #+sbcl
+       `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
        #+lispworks
        `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
        #+allegro
@@ -61,6 +66,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (defmacro free-foreign-object (obj)
   #+cmu
   `(alien:free-alien ,obj)
+  #+sbcl
+  `(sb-alien:free-alien ,obj)
   #+lispworks
   `(fli:free-foreign-object ,obj)
   #+allegro
@@ -73,13 +80,14 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   #+lispworks `(fli:null-pointer-p ,obj)
   #+allegro `(zerop ,obj)
   #+cmu   `(alien:null-alien ,obj)
+  #+sbcl   `(sb-alien:null-alien ,obj)
   #+mcl   `(ccl:%null-ptr-p ,obj)
   )
 
 (defmacro make-null-pointer (type)
-  #+(or allegro cmu mcl) (declare (ignore type))
-  
+  #+(or allegro cmu sbcl mcl) (declare (ignore type))
   #+cmu `(system:int-sap 0)
+  #+sbcl `(sb-sys:int-sap 0)
   #+allegro 0
   #+lispworks `(fli:make-pointer :address 0 :type ,type)
   #+mcl `(ccl:%null-ptr)
@@ -87,6 +95,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 
 (defmacro char-array-to-pointer (obj)
   #+cmu `(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))
   #+allegro obj
@@ -95,8 +104,9 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 
 (defmacro deref-pointer (ptr type)
   "Returns a object pointed"
-  #+(or cmu lispworks) (declare (ignore type))
+  #+(or cmu sbcl lispworks) (declare (ignore type))
   #+cmu  `(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))
@@ -113,7 +123,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (defmacro ensure-char-character (obj)
   obj)
 
-#+(or allegro cmu openmcl)
+#+(or allegro cmu sbcl openmcl)
 (defmacro ensure-char-character (obj)
   `(code-char ,obj))
   
@@ -121,13 +131,15 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (defmacro ensure-char-integer (obj)
  `(char-code ,obj))
 
-#+(or allegro cmu openmcl)
+#+(or allegro cmu sbcl openmcl)
 (defmacro ensure-char-integer (obj)
   obj)
 
 (defmacro pointer-address (obj)
   #+cmu
   `(system:sap-int (alien:alien-sap ,obj))
+  #+sbcl
+  `(sb-sys:sap-int (sb-alien:alien-sap ,obj))
   #+lispworks
   `(fli:pointer-address ,obj)
   #+allegro
@@ -139,7 +151,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 ;; TYPE is evaluated.
 #-mcl
 (defmacro with-foreign-object ((var type) &rest body)
-  #-(or cmu lispworks) ; default version
+  #-(or cmu sbcl lispworks) ; default version
   `(let ((,var (allocate-foreign-object ,type)))
     (unwind-protect
         (progn ,@body)
@@ -149,6 +161,11 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
     `(alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate)))
        (let ((,var (alien:addr ,obj)))
         ,@body)))
+  #+sbcl
+  (let ((obj (gensym)))
+    `(sb-alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate)))
+       (let ((,var (sb-alien:addr ,obj)))
+        ,@body)))
   #+lispworks
   `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type
                                              (eval type) :allocate)))