r2907: *** empty log message ***

diff --git a/src/aggregates.cl b/src/aggregates.cl
index bdc7704a1265f69f737cb5419810289eeedd523c..83a79951ddff7ebe67e52c4ae750a72ead393199 100644 (file)
--- a/src/aggregates.cl
+++ b/src/aggregates.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aggregates.cl,v 1.14 2002/09/30 07:51:01 kevin Exp $
+;;;; $Id: aggregates.cl,v 1.15 2002/09/30 08:50:00 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -67,18 +67,20 @@ of the enum-name name, separator-string, and field-name"
   `(ccl::def-foreign-type ,name-array (:array ,(convert-from-uffi-type type :array)))
   )
 
-(defun process-struct-fields (name fields)
+(defun process-struct-fields (name fields &optional (variant nil))
   (let (processed)
     (dolist (field fields)
-      (let ((field-name (car field))
-           (type (cadr field)))
-       (push (append (list field-name)
-                   (if (eq type :pointer-self)
-                       #+cmu `((* (alien:struct ,name)))
-                       #+mcl `((:* (:struct ,name)))
-                       #-(or cmu mcl) `((* ,name))
-                       `(,(convert-from-uffi-type type :struct))))
-                   processed)))
+      (let* ((field-name (car field))
+            (type (cadr field))
+            (def (append (list field-name)
+                         (if (eq type :pointer-self)
+                             #+cmu `((* (alien:struct ,name)))
+                             #+mcl `((:* (:struct ,name)))
+                             #-(or cmu mcl) `((* ,name))
+                             `(,(convert-from-uffi-type type :struct))))))
+       (if variant
+           (push (list def) processed)
+         (push def processed))))
     (nreverse processed)))
        
            
@@ -90,10 +92,11 @@ of the enum-name name, separator-string, and field-name"
   #+lispworks
   `(fli:define-c-struct ,name ,@(process-struct-fields name fields))
   #+(and mcl (not openmcl))
-  `(ccl:defrecord ,name ,@(process-struct-fields name fields nil))
+  `(ccl:defrecord ,name ,@(process-struct-fields name fields))
   #+openmcl
-  `(ccl::def-foreign-type nil 
-                         (:struct ,name ,@(process-struct-fields name fields nil)))
+  `(ccl::def-foreign-type
+    nil 
+    (:struct ,name ,@(process-struct-fields name fields)))
   )
 
 
@@ -184,5 +187,5 @@ of the enum-name name, separator-string, and field-name"
   `(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
   #+openmcl
   `(ccl::def-foreign-type nil 
-                         (:union ,name ,@(process-struct-fields name fields nil)))
+                         (:union ,name ,@(process-struct-fields name fields)))
 )

diff --git a/src/objects.cl b/src/objects.cl
index 35003012b961d6a7a938f5818478209f78b2b74d..6f1e8cec7aa695607d072775b65c24723046c486 100644 (file)
--- a/src/objects.cl
+++ b/src/objects.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: objects.cl,v 1.24 2002/09/30 07:51:01 kevin Exp $
+;;;; $Id: objects.cl,v 1.25 2002/09/30 08:50:00 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -19,6 +19,20 @@
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 (in-package :uffi)
 
+(defun size-of-foreign-type (type)
+  #+lispworks (fli:size-of type)
+  #+allegro (ff:sizeof-fobject type)
+  #+cmu  (alien:alien-size type)
+  #+clisp  (values (ffi:size-of type))
+  #+(and mcl (not openmcl))
+  (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
+  #+openmcl (ccl::%foreign-type-or-record-size type :bytes)
+  )
+
+
 (defmacro allocate-foreign-object (type &optional (size :unspecified))
   "Allocates an instance of TYPE. If size is specified, then allocate
 an array of TYPE with size SIZE. The TYPE parameter is evaluated."
@@ -62,20 +76,6 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   #+mcl   `(ccl:%null-ptr-p ,obj)
   )
 
-(defmacro size-of-foreign-type (type)
-  #+lispworks `(fli:size-of ,type)
-  #+allegro `(ff:sizeof-fobject ,type)
-  #+cmu   `(alien:alien-size ,type)
-  #+clisp   `(values (ffi:size-of ,type))
-  #+(and mcl (not openmcl))
-  `(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
-  #+opencml   `(ccl::%foreign-type-or-record-size ,type :bytes)
-  )
-
-
 (defmacro make-null-pointer (type)
   #+(or allegro cmu mcl) (declare (ignore type))
   
@@ -155,11 +155,6 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
     ,@body)
   )
 
-#+mcl
-(defmacro with-foreign-object ((var type) &rest body)
-  `(with-foreign-objects ((,var ,type)) 
-     ,@body))
-
 #-mcl
 (defmacro with-foreign-objects (bindings &rest body)
   (if bindings
@@ -181,3 +176,8 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
       (push (list (first spec) (* count (size-of-foreign-type type))) params))
     `(ccl:%stack-block ,params ,@body)))
                                 
+#+mcl
+(defmacro with-foreign-object ((var type) &rest body)
+  `(with-foreign-objects ((,var ,type)) 
+     ,@body))
+

diff --git a/src/primitives.cl b/src/primitives.cl
index 9a982be7bd46f8f690bd4f16ba4c4ccccb3d442a..0c35d8a48960caa2f647be4cb59a6798bf8a9964 100644 (file)
--- a/src/primitives.cl
+++ b/src/primitives.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.cl,v 1.24 2002/09/30 07:51:01 kevin Exp $
+;;;; $Id: primitives.cl,v 1.25 2002/09/30 08:50:00 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -74,13 +74,13 @@ supports takes advantage of this optimization."
   #+cmu `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
   #+sbcl `(sb-alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
   #+mcl
-  (let ((type (convert-from-uffi-type uffi-type :type)))
-    (unless (or (keywordp type) (consp type))
-      (setf type `(quote ,type)))
+  (let ((mcl-type (convert-from-uffi-type type :type)))
+    (unless (or (keywordp mcl-type) (consp mcl-type))
+      (setf mcl-type `(quote ,mcl-type)))
     #+(and mcl (not openmcl))
-    `(def-mcl-type ,(keyword name) ,type)
+    `(def-mcl-type ,(keyword name) ,mcl-type)
     #+openmcl
-    `(ccl::def-foreign-type ,(keyword name) ,type))  
+    `(ccl::def-foreign-type ,(keyword name) ,mcl-type))  
   )
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -190,7 +190,7 @@ supports takes advantage of this optimization."
       (:array . :c-array)))
 
 #+(and mcl (not openmcl))
-(defconstant +type-conversion-list+
+(setq +type-conversion-list+
      '((* . :pointer) (:void . :void)
        (:short . :short) (:unsigned-short . :unsigned-short)
        (:pointer-void . :pointer)
@@ -204,7 +204,7 @@ supports takes advantage of this optimization."
        (:array . :array)))
 
 #+openmcl
-(defconstant +type-conversion-list+
+(setq +type-conversion-list+
      '((* . :address) (:void . :void)
        (:short . :short) (:unsigned-short . :unsigned-short)
        (:pointer-void . :address)

diff --git a/src/strings.cl b/src/strings.cl
index b47b86310ea7e915b15455088955417526ab0149..e317017115b55e58eb86412bdedff9350d8a86a5 100644 (file)
--- a/src/strings.cl
+++ b/src/strings.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strings.cl,v 1.22 2002/09/30 07:51:01 kevin Exp $
+;;;; $Id: strings.cl,v 1.23 2002/09/30 08:50:00 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -24,7 +24,7 @@
     #+cmu nil
     #+allegro 0
     #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
-    #+mcl (ccl:%nul-ptr)
+    #+mcl (ccl:%null-ptr)
     #-(or cmu allegro lispworks mcl) nil
 )
 
@@ -85,9 +85,9 @@ that LW/CMU automatically converts strings from c-calls."
         ,@body)))
   #+mcl
   `(if (stringp ,lisp-string)
-     (ccl:with-cstrs ((,foreign-string ,lisp-string))
+     (ccl:with-cstrs ((,cstring ,lisp-string))
        ,@body)
-     (let ((,foreign-string +null-cstring-pointer+))
+     (let ((,cstring +null-cstring-pointer+))
        ,@body))
   )