Changeset 5064

Timestamp:

Sep 2, 2006, 9:57:41 AM (18 years ago)

Author:

Gary Byers

Message:

%COPY-U8-TO-STRING, %COPY-STRING-TO-U8: new, to avoid %COPY-IVECTOR-TO-IVECTOR
when strings are involved.

%STR-FROM-PTR: take dest string as optional arg, don't assume 8-bit chars.

%GET-CSTRING: change type decl, use %GET-UNSIGNED-BYTE.

File:

• trunk/ccl/level-0/l0-misc.lisp (modified) (2 diffs)

trunk/ccl/level-0/l0-misc.lisp

@@ -25 +25 @@
       (return tail))))
 
-
+(defun %copy-u8-to-string (u8-vector source-idx string dest-idx n)
+  (declare (optimize (speed 3) (safety 0))
+           (fixnum source-idx dest-idx n)
+           (type (simple-array (unsigned-byte 8) (*)) u8-vector)
+           (simple-base-string string))
+  (do* ((i 0 (1+ i)))
+       ((= i n) string)
+    (declare (fixnum i))
+    (setf (%scharcode string dest-idx) (aref u8-vector source-idx))
+    (incf source-idx)
+    (incf dest-idx)))
+
+(defun %copy-string-to-u8 (string source-idx u8-vector dest-idx n)
+  (declare (optimize (speed 3) (safety 0))
+           (fixnum source-idx dest-idx n)
+           (type (simple-array (unsigned-byte 8) (*)) u8-vector)
+           (simple-base-string string))
+  (do* ((i 0 (1+ i)))
+       ((= i n) u8-vector)
+    (declare (fixnum i))
+    (setf (aref u8-vector dest-idx) (%scharcode string source-idx))
+    (incf source-idx)
+    (incf dest-idx)))
+    
+        
 
 
@@ -348 +372 @@
      (uvsize seq))))
 
-(defun %str-from-ptr (pointer len)
-  (%copy-ptr-to-ivector pointer 0 (make-string len :element-type 'base-char) 0 len))
+(defun %str-from-ptr (pointer len &optional (dest (make-string len)))
+  (declare (fixnum len)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i len dest)
+    (setf (%scharcode dest i) (%get-unsigned-byte pointer i))))
 
 (defun %get-cstring (pointer)
   (do* ((end 0 (1+ end)))
-       ((zerop (the fixnum (%get-byte pointer end)))
+       ((zerop (the (unsigned-byte 8) (%get-unsigned-byte pointer end)))
         (%str-from-ptr pointer end))
     (declare (fixnum end))))