X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fstrings.lisp;h=430d8ab48d15c1b29c988108570867b41e487b89;hb=a63da5b764b6fa30e32fcda4ddac88de385c9d5b;hp=f6c6d9f016dd3f0b82d5c145b5852a9ec6e2bbb1;hpb=e6419ce97079be93787ea6b57a239be60ad9beca;p=uffi.git

diff --git a/src/strings.lisp b/src/strings.lisp
index f6c6d9f..430d8ab 100644
--- a/src/strings.lisp
+++ b/src/strings.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -144,7 +144,8 @@ that LW/CMU automatically converts strings from c-calls."
     (string
      (locally
          (declare (optimize (speed 3) (safety 0)))
-       (let* ((fe (or encoding *default-foreign-encoding*))
+       (let* ((fe (or encoding *default-foreign-encoding*
+                      sb-impl::*default-external-format*))
               (ife (when fe (lookup-foreign-encoding fe))))
          (if ife
              (let* ((octets (sb-ext:string-to-octets str :external-format ife))
@@ -154,7 +155,7 @@ that LW/CMU automatically converts strings from c-calls."
                (setq storage (sb-alien:cast storage (* (sb-alien:unsigned 8))))
                (dotimes (i size)
                  (declare (fixnum i))
-                 (setf (sb-alien:deref storage i) (svref octets i)))
+                 (setf (sb-alien:deref storage i) (aref octets i)))
                ;; terminate with 2 nulls, maybe needed for some encodings
                (setf (sb-alien:deref storage size) 0)
                (setf (sb-alien:deref storage (1+ size)) 0)
@@ -270,19 +271,24 @@ that LW/CMU automatically converts strings from c-calls."
                  (fast-native-to-string ,stored-obj ,length))))))
 
   #+lispworks
-  ;; FAST-NATIVE-TO-STRING (suprisingly) works just fine with UTF-8 multibyte character strings
+  #|
+  ;; FAST-NATIVE-TO-STRING (suprisingly) works just fine to make strings
+  ;; for formatted printing with Lispworks and UTF-8 multibyte character strings.
   ;; However, without knowledge of specific-encoding, the LENGTH call in FAST-NATIVE-TO-STRING
-  ;; may not be incorrect for some encodings/strings.
+  ;; will be be incorrect for some encodings/strings and strings consist of octets rather
+  ;; than wide characters
   ;; This is a stop-gap until get tech support on why the below fails.
   (let ((stored-obj (gensym "STR-")))
     `(let ((,stored-obj ,obj))
        (if (fli:null-pointer-p ,stored-obj)
            nil
            (fast-native-to-string ,stored-obj ,length))))
+  |#
+  #|
   ;; Below code doesn't work on tesing with LW 6.0 testing with a UTF-8 string.
   ;; fli:convert-from-foreign-string with :external-format of :UTF-8 doesn't
   ;; properly code multibyte characters.
-#|
+  |#
   (let ((stored-obj (gensym "STR-"))
         (fe (gensym "FE-"))
         (ife (gensym "IFE-")))
@@ -298,7 +304,6 @@ that LW/CMU automatically converts strings from c-calls."
                   :null-terminated-p ,null-terminated-p
                   :external-format (list ,ife :eol-style :lf))
                  (fast-native-to-string ,stored-obj ,length))))))
-|#
 
   #+(or cmu scl)
   (let ((stored-obj (gensym)))
@@ -389,12 +394,12 @@ that LW/CMU automatically converts strings from c-calls."
   )
 
 (defun foreign-string-length (foreign-string)
-  #+allegro `(ff:foreign-strlen ,foreign-string)
+  #+allegro (ff:foreign-strlen foreign-string)
   #-allegro
-  `(loop with size = 0
-    until (char= (deref-array ,foreign-string '(:array :unsigned-char) size) #\Null)
-    do (incf size)
-    finally return size))
+  (loop
+     for size from 0
+     until (zerop (deref-array foreign-string '(:array :unsigned-char) size))
+     finally (return size)))
 
 
 (defmacro with-foreign-string ((foreign-string lisp-string &optional encoding)