r3060: *** empty log message ***

[uffi.git] / src / objects.lisp

diff --git a/src/objects.lisp b/src/objects.lisp
index 19cb002d94ea50f698bbfa5db24ce9bc9504dab8..c7fa563a2dcc717f15c622b1edfcefcdef900621 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.3 2002/10/14 07:08:49 kevin Exp $
+;;;; $Id: objects.lisp,v 1.4 2002/10/16 11:56:43 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -22,7 +22,7 @@
 (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))
@@ -39,7 +39,7 @@
 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))
@@ -51,7 +51,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
        `(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)
@@ -64,7 +64,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
        )))
 
 (defmacro free-foreign-object (obj)
-  #+cmu
+  #+(or cmu scl)
   `(alien:free-alien ,obj)
   #+sbcl
   `(sb-alien:free-alien ,obj)
@@ -79,14 +79,14 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (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 mcl) (declare (ignore type))
-  #+cmu `(alien:sap-alien (system:int-sap 0) (* ,(convert-from-uffi-type (eval type) :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
@@ -94,7 +94,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)))
+  #+(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))
@@ -104,8 +104,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 
 (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)
@@ -123,7 +123,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (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))
   
@@ -131,12 +131,12 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (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))
@@ -151,12 +151,12 @@ 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 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)))