Remove old CVS $Id$ keyword

[uffi.git] / src / objects.lisp

diff --git a/src/objects.lisp b/src/objects.lisp
index 67c9bcbee0092a814c73a9ccabf24d5553f909ea..c9935b755dfa64867a27e4c6c1e155264b67daa0 100644 (file)
--- a/src/objects.lisp
+++ b/src/objects.lisp
@@ -7,9 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -25,8 +23,8 @@
     #+digitool
     (let ((mcl-type (ccl:find-mactype type nil t)))
       (if mcl-type
-         (ccl::mactype-record-size mcl-type)
-         (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
+          (ccl::mactype-record-size mcl-type)
+          (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
     #+openmcl (ccl::%foreign-type-or-record-size type :bytes)
     ))
 
@@ -35,29 +33,29 @@
 an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   (if (eq size :unspecified)
       (progn
-       #+(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)
-       #+(or openmcl digitool)
-       `(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
-       )
+        #+(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)
+        #+(or openmcl digitool)
+        `(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
+        )
       (progn
-       #+(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)
-       #+lispworks
-       `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
-       #+allegro
-       `(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
-       #+(or openmcl digitool)
-       `(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
-       )))
+        #+(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)
+        #+lispworks
+        `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
+        #+allegro
+        `(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
+        #+(or openmcl digitool)
+        `(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
+        )))
 
 (defmacro free-foreign-object (obj)
   #+(or cmu scl)
@@ -103,7 +101,7 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   #+(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))
+                                :address (fli:pointer-address ,obj))
   #+allegro obj
   #+(or openmcl digitool) obj
   )
@@ -139,8 +137,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   `(if (integerp ,obj) ,obj (char-code ,obj)))
 
 (defmacro ensure-char-storable (obj)
-  #+(or digitool (and lispworks (not lispworks5))) obj
-  #+(or allegro cmu lispworks5 openmcl sbcl scl)
+  #+(or digitool (and lispworks (not lispworks5) (not lispworks6))) obj
+  #+(or allegro cmu lispworks5 lispworks6 openmcl sbcl scl)
   `(char-code ,obj))
 
 (defmacro pointer-address (obj)
@@ -162,31 +160,31 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   #-(or cmu sbcl lispworks scl) ; default version
   `(let ((,var (allocate-foreign-object ,type)))
     (unwind-protect
-        (progn ,@body)
+         (progn ,@body)
       (free-foreign-object ,var)))
   #+(or cmu scl)
   (let ((obj (gensym))
-       (ctype (convert-from-uffi-type (eval type) :allocate)))
+        (ctype (convert-from-uffi-type (eval type) :allocate)))
     (if (and (consp ctype) (eq 'array (car ctype)))
-       `(alien:with-alien ((,obj ,ctype))
-         (let* ((,var ,obj))
-           ,@body))
-       `(alien:with-alien ((,obj ,ctype))
-         (let* ((,var (alien:addr ,obj)))
-           ,@body))))
+        `(alien:with-alien ((,obj ,ctype))
+          (let* ((,var ,obj))
+            ,@body))
+        `(alien:with-alien ((,obj ,ctype))
+          (let* ((,var (alien:addr ,obj)))
+            ,@body))))
   #+sbcl
   (let ((obj (gensym))
-       (ctype (convert-from-uffi-type (eval type) :allocate)))
+        (ctype (convert-from-uffi-type (eval type) :allocate)))
     (if (and (consp ctype) (eq 'array (car ctype)))
-       `(sb-alien:with-alien ((,obj ,ctype))
-         (let* ((,var ,obj))
-           ,@body))
-       `(sb-alien:with-alien ((,obj ,ctype))
-         (let* ((,var (sb-alien:addr ,obj)))
-           ,@body))))
+        `(sb-alien:with-alien ((,obj ,ctype))
+          (let* ((,var ,obj))
+            ,@body))
+        `(sb-alien:with-alien ((,obj ,ctype))
+          (let* ((,var (sb-alien:addr ,obj)))
+            ,@body))))
   #+lispworks
   `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type
-                                             (eval type) :allocate)))
+                                              (eval type) :allocate)))
     ,@body)
   )
 
@@ -194,8 +192,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 (defmacro with-foreign-objects (bindings &rest body)
   (if bindings
       `(with-foreign-object ,(car bindings)
-       (with-foreign-objects ,(cdr bindings)
-         ,@body))
+        (with-foreign-objects ,(cdr bindings)
+          ,@body))
       `(progn ,@body)))
 
 #+(or openmcl digitool)