r2892: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index 7f2047c64201f5d1cd6bcfc974cc82409ea8932a..a013603d930335a40d69d975c1378fb4c2696ab5 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-uffi (0.8.6-1) unstable; urgency=low
+
+  * Fix :pointer-self for OpenMCL.
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sun, 29 Sep 2002 14:14:01 -0600
+
 cl-uffi (0.8.5-1) unstable; urgency=low
 
   * Add with-cstrings macro to mcl's source

diff --git a/src-main/aggregates.cl b/src-main/aggregates.cl
index 6a912cecca9529edb44464de8d2065baac912222..5e4e132840334d2ce91af7899a8077e6fbe9ab91 100644 (file)
--- a/src-main/aggregates.cl
+++ b/src-main/aggregates.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aggregates.cl,v 1.2 2002/09/20 06:03:36 kevin Exp $
+;;;; $Id: aggregates.cl,v 1.3 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -110,7 +110,7 @@ of the enum-name name, separator-string, and field-name"
   #+(or lispworks cmu) (declare (ignore type))
   #+cmu  `(alien:deref ,obj ,i)
   #+lispworks `(fli:dereference ,obj :index ,i)
-  #+allegro `(ff:fslot-value-typed ,(convert-from-uffi-type type :type) :c ,obj ,i)
+  #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
   )
 
 (defmacro def-union (name &rest fields)

diff --git a/src-main/libraries.cl b/src-main/libraries.cl
index c16cda2aee89e3ebe30f0058b64514032da004fc..0cf1e0c05c3a6b1933ae638b560b10d1b5f11bf1 100644 (file)
--- a/src-main/libraries.cl
+++ b/src-main/libraries.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: libraries.cl,v 1.2 2002/09/20 04:51:14 kevin Exp $
+;;;; $Id: libraries.cl,v 1.3 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -88,15 +88,15 @@ library type if type is not specified."
        (let ((type (pathname-type (parse-namestring filename))))
          (if (equal type "so")
              (sys::load-object-file filename)
-             (alien:load-foreign filename 
-                                 :libraries
-                                 (convert-supporting-libraries-to-string
-                                  supporting-libraries))))
-       
-       #+lispworks (fli:register-module module 
-                                        :real-name filename)
+           (alien:load-foreign filename 
+                               :libraries
+                               (convert-supporting-libraries-to-string
+                                supporting-libraries))))
+       #+lispworks (fli:register-module module :real-name filename)
        #+allegro (load filename)
-       
+       #+openmcl (ccl:open-shared-library filename)
+       #+(and mcl (not openmcl)) (ccl:add-to-shared-library-search-path filename t)
+              
        (push filename *loaded-libraries*)
        t)))
   )

diff --git a/src-main/primitives.cl b/src-main/primitives.cl
index 6fe54ba1d7e918f4a6401e190263aa2a36f4685c..05317700ef4ce48fab4c78997b8b493bcb18109a 100644 (file)
--- a/src-main/primitives.cl
+++ b/src-main/primitives.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.cl,v 1.1 2002/09/16 17:54:30 kevin Exp $
+;;;; $Id: primitives.cl,v 1.2 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -188,8 +188,22 @@ supports takes advantage of this optimization."
        (basic-convert-from-uffi-type :cstring-returning))
        (t
        (basic-convert-from-uffi-type type)))
-      (cons (convert-from-uffi-type (first type) context) 
-           (convert-from-uffi-type (rest type) context))))
+    (let ((sub-type (car type)))
+      (case sub-type
+       (cl:quote
+        (convert-from-uffi-type (cadr type) context))
+       (:struct-pointer
+        #+openmcl `(:* (:struct ,(convert-from-uffi-type (cadr type) :struct)))
+        #-openmcl `(* ,(convert-from-uffi-type (cadr type) :struct))
+        )
+       (:struct
+        #+openmcl `(:struct ,(convert-from-uffi-type (cadr type) :struct))
+        #-openmcl (convert-from-uffi-type (cadr type) :struct)
+        )
+       (t
+        (cons (convert-from-uffi-type (first type) context) 
+              (convert-from-uffi-type (rest type) context)))))))
+
 
 
 

diff --git a/src-mcl/aggregates.cl b/src-mcl/aggregates.cl
index b59615a31c17e370eb1ffd6617426d97d9359e86..428013c1bc5243372884fed1f2d9fc7b48894c29 100644 (file)
--- a/src-mcl/aggregates.cl
+++ b/src-mcl/aggregates.cl
@@ -7,7 +7,7 @@
 ;;;; Programmers:   Kevin M. Rosenberg and John DeSoi
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aggregates.cl,v 1.2 2002/09/20 04:51:14 kevin Exp $
+;;;; $Id: aggregates.cl,v 1.3 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and John DeSoi
@@ -56,7 +56,10 @@ of the enum-name name, separator-string, and field-name"
 
 
 (defmacro def-array-pointer (name-array type)
-  `(def-mcl-type ,name-array '(:array ,type)))
+  #-openmcl
+  `(def-mcl-type ,name-array '(:array ,type))
+  #+openmcl
+  `(ccl::def-foreign-type ,name-array (:array ,(convert-from-uffi-type type :array))))
 
 
 
@@ -100,10 +103,14 @@ of the enum-name name, separator-string, and field-name"
       (let* ((field-name (car field))
             (type (cadr field))
              (def  (append (list field-name)
-                   (if (eq type :pointer-self)
-                       #+cmu `((* (alien:struct ,name)))
-                       #-cmu `((* ,name))
-                       `(,(convert-from-uffi-type type :struct))))))
+                   (cond
+                     ((eq type :pointer-self)
+                      #+cmu `((* (alien:struct ,name)))
+                      #+openmcl `((:* (:struct ,name)))
+                      #-(or cmu openmcl) `((* ,name))
+                      )
+                     (t
+                      `(,(convert-from-uffi-type type :struct)))))))
         (if variant
           (push (list def) processed)
           (push def processed))))
@@ -166,4 +173,4 @@ of the enum-name name, separator-string, and field-name"
 (setf (get-slot-value s :struct :u1.s1) 5)
 (get-slot-value s :struct :u1.s1)
 
-|#
\ No newline at end of file
+|#

diff --git a/src-mcl/libraries.cl b/src-mcl/libraries.cl
index 8495d555aa4427132f2254af518573c9c63a440e..32265525a0915945d8e4c16770522c7ca23a841f 100644 (file)
--- a/src-mcl/libraries.cl
+++ b/src-mcl/libraries.cl
@@ -7,7 +7,7 @@
 ;;;; Programmers:   Kevin M. Rosenberg and John DeSoi
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: libraries.cl,v 1.3 2002/09/29 17:50:07 kevin Exp $
+;;;; $Id: libraries.cl,v 1.4 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and John DeSoi
@@ -25,11 +25,11 @@
 
 ;in MCL calling this more than once for the same library does not do anything
 #-openmcl
-(defmacro load-foreign-library (filename &key module supporting-libraries force-load)
+(defun load-foreign-library (filename &key module supporting-libraries force-load)
   (declare (ignore module supporting-libraries force-load))
   `(eval-when (:compile-toplevel :load-toplevel :execute)
-     (when (ccl:add-to-shared-library-search-path ,filename t) 
-       (pushnew ,filename *loaded-libraries*))))
+     (when (ccl:add-to-shared-library-search-path filename t) 
+       (pushnew filename *loaded-libraries*))))
 
 
 ; Note we are not dealing with OpenMCL's ability to close the library
@@ -37,7 +37,7 @@
 #+openmcl
 (defun load-foreign-library (filename &key module supporting-libraries force-load)
   (declare (ignore module supporting-libraries force-load))
-  `(let ((path (if (pathnamep ,filename) (namestring ,filename) ,filename)))
+  (let ((path (if (pathnamep filename) (namestring filename) filename)))
      (when (stringp path)
        (if (position path *loaded-libraries* :test #'string-equal)
          t

diff --git a/src-mcl/primitives.cl b/src-mcl/primitives.cl
index f78fd54b1104de4088fbd7836d2f6ce535ba3927..6cbe03eb2c72aed8b73581c338abc81200bef65c 100644 (file)
--- a/src-mcl/primitives.cl
+++ b/src-mcl/primitives.cl
@@ -7,7 +7,7 @@
 ;;;; Programmers:   Kevin M. Rosenberg and John DeSoi
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.cl,v 1.3 2002/09/20 13:05:59 kevin Exp $
+;;;; $Id: primitives.cl,v 1.4 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and John DeSoi
@@ -65,7 +65,7 @@ supports takes advantage of this optimization."
 
 (defmacro def-foreign-type (name uffi-type)
   (let ((type (convert-from-uffi-type uffi-type :type)))
-    (unless (keywordp type)
+    (unless (or (keywordp type) (consp type))
       (setf type `(quote ,type)))
     #-openmcl
     `(def-mcl-type ,(keyword name) ,type)
@@ -125,20 +125,33 @@ supports takes advantage of this optimization."
   "Converts from a uffi type to an implementation specific type"
   (if (atom type)
     (cond
-     #-openmcl
-     ((and (eq type :void) (eq context :return)) nil)
+     #-openmcl  ((and (eq type :void) (eq context :return)) nil)
      (t (basic-convert-from-uffi-type type)))
-    (if (eq (car type) 'cl:quote)
-      (%convert-from-uffi-type (cadr type) context)
-      (cons (%convert-from-uffi-type (first type) context) 
-            (%convert-from-uffi-type (rest type) context)))))
+    (let ((sub-type (car type)))
+      (case sub-type
+       (cl:quote
+        (%convert-from-uffi-type (cadr type) context))
+       (:struct-pointer
+        #+openmcl `(:* (:struct ,(convert-from-uffi-type (cadr type) :struct)))
+        #-openmcl `(,(convert-from-uffi-type (list '* (cadr type)) :struct))
+        )
+       (:struct
+        #+openmcl `(:struct ,(convert-from-uffi-type (cadr type) :struct))
+        #-openmcl `(,(convert-from-uffi-type (cadr type) :struct))
+        )
+       (t
+        (cons (%convert-from-uffi-type (first type) context) 
+              (%convert-from-uffi-type (rest type) context)))))))
 
 (defun convert-from-uffi-type (type context)
   (let ((result (%convert-from-uffi-type type context)))
     (cond
      ((atom result) result)
      #+openmcl
-     ((eq (car result) :address) :address)
+     ((eq (car result) :address)
+      (if (eq context :struct)
+         (append '(:*) (cdr result))
+       :address))
      #-openmcl
      ((and (eq (car result) :pointer) (eq context :allocation) :pointer))
      (t result))))