From 21460adf8bdfbbe46b657f9d8c57109c0ded790f Mon Sep 17 00:00:00 2001 From: Kevin Rosenberg Date: Mon, 8 Feb 2010 08:29:14 -0700 Subject: [PATCH] Version 1.8.3: patch from Stelian Ionescu --- ChangeLog | 6 ++++++ debian/changelog | 6 ++++++ src/libraries.lisp | 14 ++++++-------- src/strings.lisp | 45 +++++++++++++++++++++------------------------ uffi.asd | 3 ++- 5 files changed, 41 insertions(+), 33 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6da74a2..4fba654 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2010-02-08 Kevin Rosenberg + * Version 1.8.3 + * sql/strings.liap: Commit patch from Stelian Ionescu + with fixes for recent changes with i18n as well + as reworking how ignored variables are declared. + 2010-02-07 Kevin Rosenberg * Version 1.8.2 * src/i18n.lisp: Rename function to diff --git a/debian/changelog b/debian/changelog index 8337156..22cb98e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-uffi (1.8.3-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Mon, 08 Feb 2010 08:28:15 -0700 + cl-uffi (1.8.2-1) unstable; urgency=low * New upstream diff --git a/src/libraries.lisp b/src/libraries.lisp index f2ce922..578f3d6 100644 --- a/src/libraries.lisp +++ b/src/libraries.lisp @@ -74,12 +74,11 @@ library type if type is not specified." (defun load-foreign-library (filename &key module supporting-libraries force-load) - #+(or allegro openmcl digitool sbcl) (declare (ignore module supporting-libraries)) - #+(or cmu scl) (declare (ignore module)) - #+lispworks (declare (ignore supporting-libraries)) + (declare (ignorable module supporting-libraries)) (flet ((load-failure () (error "Unable to load foreign library \"~A\"." filename))) + (declare (ignorable #'load-failure)) (when (and filename (or (null (pathname-directory filename)) (probe-file filename))) (if (pathnamep filename) ;; ensure filename is a string to check if already loaded @@ -104,11 +103,10 @@ library type if type is not specified." (convert-supporting-libraries-to-string supporting-libraries)))) #+scl - (let ((type (pathname-type (parse-namestring filename)))) - (alien:load-foreign filename - :libraries - (convert-supporting-libraries-to-string - supporting-libraries))) + (alien:load-foreign filename + :libraries + (convert-supporting-libraries-to-string + supporting-libraries)) #+sbcl (handler-case (sb-alien::load-1-foreign filename) (sb-int:unsupported-operator (c) diff --git a/src/strings.lisp b/src/strings.lisp index eedc1b6..fc7a282 100644 --- a/src/strings.lisp +++ b/src/strings.lisp @@ -57,7 +57,7 @@ that LW/CMU automatically converts strings from c-calls." ) (defmacro free-cstring (obj) - #+(or cmu sbcl scl lispworks) (declare (ignore obj)) + (declare (ignorable obj)) #+allegro (let ((stored (gensym))) `(let ((,stored ,obj)) @@ -100,6 +100,7 @@ that LW/CMU automatically converts strings from c-calls." ;;; Foreign string functions (defun %convert-to-foreign-string (str foreign-encoding) + (declare (ignorable str foreign-encoding)) #+(or cmu scl) (etypecase str (null @@ -114,25 +115,25 @@ that LW/CMU automatically converts strings from c-calls." (dotimes (i size) (declare (fixnum i)) (setf (alien:deref storage i) - (char-code (char stored-obj i)))) - (setf (alien:deref storage size) 0)) - storage))) + (char-code (char str i)))) + (setf (alien:deref storage size) 0) + storage)))) #+(and sbcl (not sb-unicode)) - (etypecase stored-obj + (etypecase str (null (sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8)))) (string (locally (declare (optimize (speed 3) (safety 0))) - (let* ((size (length stored-obj)) + (let* ((size (length str)) (storage (sb-alien:make-alien (sb-alien:unsigned 8) (1+ size)))) (declare (fixnum i)) (setq storage (sb-alien:cast storage (* (sb-alien:unsigned 8)))) (dotimes (i size) (declare (fixnum i)) (setf (sb-alien:deref storage i) - (char-code (char stored-obj i)))) + (char-code (char str i)))) (setf (sb-alien:deref storage size) 0)) storage))) @@ -144,7 +145,7 @@ that LW/CMU automatically converts strings from c-calls." (locally (declare (optimize (speed 3) (safety 0))) (let* ((fe (or foreign-encoding *default-foreign-encoding*)) - (ife (when fe (implementation-foreign-encoding fe)))) + (ife (when fe (lookup-foreign-encoding fe)))) (if ife (let* ((octets (sb-ext:string-to-octets str :external-format ife)) (size (length octets)) @@ -166,7 +167,7 @@ that LW/CMU automatically converts strings from c-calls." (dotimes (i size) (declare (fixnum i)) (setf (sb-alien:deref storage i) - (char-code (char stored-obj i)))) + (char-code (char str i)))) (setf (sb-alien:deref storage size) 0) storage)))))) @@ -176,7 +177,7 @@ that LW/CMU automatically converts strings from c-calls." (locally (declare (optimize (speed 3) (safety 0))) (let* ((fe (or foreign-encoding *default-foreign-encoding*)) - (ife (when fe (implementation-foreign-encoding fe)))) + (ife (when fe (lookup-foreign-encoding fe)))) (if ife (let* ((octets (ccl:encode-string-to-octets str :external-format ife)) (size (length octets)) @@ -201,11 +202,11 @@ that LW/CMU automatically converts strings from c-calls." ptr)) #+(or allegro lispworks) - (declare (ignore str foreign-encoding)) - + nil ) (defmacro convert-to-foreign-string (obj &optional foreign-encoding) + (declare (ignorable foreign-encoding)) #+allegro (let ((stored (gensym "STR-")) (fe (gensym "FE-")) @@ -213,7 +214,7 @@ that LW/CMU automatically converts strings from c-calls." `(let* ((,stored ,obj) (,fe (or foreign-encoding *default-foreign-encoding*)) (,ife (when ,fe - (implementation-foreign-encoding ,fe)))) + (lookup-foreign-encoding ,fe)))) (cond ((null ,stored) 0) @@ -229,7 +230,7 @@ that LW/CMU automatically converts strings from c-calls." `(let* ((,stored ,obj) (,fe (or ,foreign-encoding *default-foreign-encoding*)) (,ife (when ,fe - (implementation-foreign-encoding ,fe)))) + (lookup-foreign-encoding ,fe)))) (cond ((null ,stored) +null-cstring-pointer+) @@ -239,7 +240,7 @@ that LW/CMU automatically converts strings from c-calls." (fli:convert-to-foreign-string ,stored :external-format ,ife))))) #+(or cmu scl sbcl digitool openmcl) - `(%convert-to-foreign-string ,obj (implementation-foreign-encoding + `(%convert-to-foreign-string ,obj (lookup-foreign-encoding (or ,foreign-encoding *default-foreign-encoding*))) ) @@ -249,6 +250,7 @@ that LW/CMU automatically converts strings from c-calls." length foreign-encoding (null-terminated-p t)) + (declare (ignorable length foreign-encoding null-terminated-p)) #+allegro (let ((stored-obj (gensym "STR-")) (fe (gensym "FE-")) @@ -257,7 +259,7 @@ that LW/CMU automatically converts strings from c-calls." (if (zerop ,stored-obj) nil (let* ((,fe (or ,foreign-encoding *default-foreign-encoding*)) - (,ife (when ,fe (implementation-foreign-encoding ,fe)))) + (,ife (when ,fe (lookup-foreign-encoding ,fe)))) (if ,ife (values (excl:native-to-string @@ -288,7 +290,7 @@ that LW/CMU automatically converts strings from c-calls." (if (fli:null-pointer-p ,stored-obj) nil (let* ((,fe (or ,foreign-encoding *default-foreign-encoding*)) - (,ife (when ,fe (implementation-foreign-encoding ,fe)))) + (,ife (when ,fe (lookup-foreign-encoding ,fe)))) (if ,ife (fli:convert-from-foreign-string ,stored-obj @@ -323,13 +325,11 @@ that LW/CMU automatically converts strings from c-calls." (if (null-pointer-p ,stored-obj) nil (let* ((,fe (or ,foreign-encoding *default-foreign-encoding*)) - (,ife (when ,fe (implementation-foreign-encoding ,fe)))) + (,ife (when ,fe (lookup-foreign-encoding ,fe)))) (sb-alien::c-string-to-string (sb-alien:alien-sap ,stored-obj) (or ,ife sb-impl::*default-external-format* :latin-1) 'character))))) - #+(or openmcl digitool) - (declare (ignore null-terminated-p)) #+(or openmcl digitool) (let ((stored-obj (gensym "STR-")) (fe (gensym "FE-"))) @@ -355,6 +355,7 @@ that LW/CMU automatically converts strings from c-calls." (defmacro allocate-foreign-string (size &key (unsigned t)) + (declare (ignorable unsigned)) #+ignore (let ((array-def (gensym))) `(let ((,array-def (list 'alien:array 'c-call:char ,size))) @@ -382,12 +383,8 @@ that LW/CMU automatically converts strings from c-calls." :char) :nelems ,size) #+allegro - (declare (ignore unsigned)) - #+allegro `(ff:allocate-fobject :char :c ,size) #+(or openmcl digitool) - (declare (ignore unsigned)) - #+(or openmcl digitool) `(new-ptr ,size) ) diff --git a/uffi.asd b/uffi.asd index 1ca66a9..d5bf7f7 100644 --- a/uffi.asd +++ b/uffi.asd @@ -33,7 +33,8 @@ #+(or openmcl digitool) (:file "readmacros-mcl" :depends-on ("package")) (:file "objects" :depends-on ("primitives")) (:file "aggregates" :depends-on ("primitives")) - (:file "strings" :depends-on ("primitives" "functions" "aggregates" "objects")) + (:file "strings" :depends-on ("primitives" "functions" "aggregates" "objects" + #+(or openmcl digitool) "readmacros-mcl")) (:file "functions" :depends-on ("primitives")) (:file "libraries" :depends-on ("package")) (:file "os" :depends-on ("package")))) -- 2.34.1