From 9fead1fa1dc1cd65a3c803518b2a56cae2624d2d Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 30 Sep 2002 01:57:32 +0000 Subject: [PATCH] r2892: *** empty log message *** --- debian/changelog | 6 ++++++ src-main/aggregates.cl | 4 ++-- src-main/libraries.cl | 18 +++++++++--------- src-main/primitives.cl | 20 +++++++++++++++++--- src-mcl/aggregates.cl | 21 ++++++++++++++------- src-mcl/libraries.cl | 10 +++++----- src-mcl/primitives.cl | 31 ++++++++++++++++++++++--------- 7 files changed, 75 insertions(+), 35 deletions(-) diff --git a/debian/changelog b/debian/changelog index 7f2047c..a013603 100644 --- 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 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 6a912ce..5e4e132 100644 --- 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 c16cda2..0cf1e0c 100644 --- 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 6fe54ba..0531770 100644 --- 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 b59615a..428013c 100644 --- 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 8495d55..3226552 100644 --- 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 f78fd54..6cbe03e 100644 --- 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)))) -- 2.34.1