X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-grovel%2Fforeign-glue.lisp;h=a35d72c15e2dc24d4b70e49b1b86d2ae2b29dab3;hb=6b8baeece6cf870e3f979a9f09c32985c64c04de;hp=1a4b9e5014b2e442464b08ce0c8e14558194f208;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/contrib/sb-grovel/foreign-glue.lisp b/contrib/sb-grovel/foreign-glue.lisp
index 1a4b9e5..a35d72c 100644
--- a/contrib/sb-grovel/foreign-glue.lisp
+++ b/contrib/sb-grovel/foreign-glue.lisp
@@ -280,11 +280,14 @@ deeply nested structures."
 (defun (setf c-string->lisp-string) (new-string alien &optional limit)
   (declare (string new-string))
   (let* ((upper-bound (or limit (1+ (length new-string))))
-         (last-elt (min (1- upper-bound) (length new-string))))
-    (loop for i upfrom 0 below last-elt
-          for char across new-string
-          do (setf (deref alien i) (char-code char)))
-    (setf (deref alien last-elt) 0)
+         (last-elt (min (1- upper-bound) (length new-string)))
+         (octets (sb-ext:string-to-octets new-string :end last-elt
+                                          :null-terminate t))
+         (alien-pointer (cast alien (* unsigned-char))))
+    (declare (cl:type (simple-array (unsigned-byte 8) (*)) octets))
+    (declare (cl:type sb-int:index last-elt))
+    (loop for i from 0 to last-elt
+          do (setf (deref alien-pointer i) (aref octets i)))
     (subseq new-string 0 last-elt)))
 
 (defgeneric accessors-for (struct-name element path))