Index: /trunk/ccl/level-0/l0-aprims.lisp
===================================================================
--- /trunk/ccl/level-0/l0-aprims.lisp	(revision 6558)
+++ /trunk/ccl/level-0/l0-aprims.lisp	(revision 6559)
@@ -57,33 +57,39 @@
 
 (defun %cstr-pointer (string pointer &optional (nul-terminated t))
-  (multiple-value-bind (s o n) (dereference-base-string string)
-    (declare (fixnum o n))
-    (do* ((i 0 (1+ i))
-          (o o (1+ o)))
-         ((= i n))
-      (declare (fixnum i o))
-      (setf (%get-unsigned-byte pointer i)
-            (let* ((code (char-code (schar s o))))
-              (declare (type (mod #x110000) code))
-              (if (< code 256)
-                code
-                (char-code #\Sub)))))
-    (when nul-terminated
-      (setf (%get-byte pointer n) 0)))
-  nil)
+  (if (typep string 'simple-base-string)
+    (locally (declare (simple-base-string string)
+                      (optimize (speed 3) (safety 0)))
+      (let* ((n (length string)))
+        (declare (fixnum n))
+        (dotimes (i n)
+          (setf (%get-unsigned-byte pointer i)
+                (let* ((code (%scharcode string i)))
+                  (declare (type (mod #x110000) code))
+                  (if (< code 256)
+                    code
+                    (char-code #\Sub)))))
+        (when nul-terminated
+          (setf (%get-byte pointer n) 0)))
+      nil))
+  (%cstr-segment-pointer string pointer 0 (length string) nul-terminated))
 
-(defun %cstr-segment-pointer (string pointer start end)
+(defun %cstr-segment-pointer (string pointer start end &optional (nul-terminated t))
   (declare (fixnum start end))
   (let* ((n (- end start)))
     (multiple-value-bind (s o) (dereference-base-string string)
       (declare (fixnum o))
-          (do* ((i 0 (1+ i))
-          (o (the fixnum (+ o start)) (1+ o)))
-         ((= i n))
-      (declare (fixnum i o))
-      (setf (%get-unsigned-byte pointer i)
-            (logand #xff (char-code (schar s o)))))
-    (setf (%get-byte pointer n) 0)
-    nil)))
+      (do* ((i 0 (1+ i))
+            (o (the fixnum (+ o start)) (1+ o)))
+           ((= i n))
+        (declare (fixnum i o))
+        (setf (%get-unsigned-byte pointer i)
+              (let* ((code (char-code (schar s o))))
+                (declare (type (mod #x110000) code))
+                (if (< code 256)
+                  code
+                  (char-code #\Sub))))))
+    (when nul-terminated
+      (setf (%get-byte pointer n) 0))
+    nil))
 
 (defun string (thing)