Version 1.8.3: patch from Stelian Ionescu

[uffi.git] / src / strings.lisp

diff --git a/src/strings.lisp b/src/strings.lisp
index eedc1b6e241b717df37af94ac2c94608c21ecbad..fc7a282628cd471a13ab2800192dc15cd18a4979 100644 (file)
--- 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)
   )