Changeset 5118

Timestamp:

Sep 5, 2006, 4:09:30 AM (18 years ago)

Author:

Gary Byers

Message:

Various archaic string functions: don't assume 8-bit strings.

File:

• trunk/ccl/level-1/l1-aprims.lisp (modified) (4 diffs)

trunk/ccl/level-1/l1-aprims.lisp

@@ -419 +419 @@
       (setf (%get-byte s len) 0)
       (multiple-value-bind (data offset) (array-data-and-offset string)
-        (%copy-ivector-to-ptr data offset s 0 len)
+        (dotimes (i len s)
+          (setf (%get-unsigned-byte s i) (%scharcode data (+ offset i))))
         s))))
 
@@ -432 +433 @@
 
 (defun move-string-bytes (source dest off1 off2 n)
-  (%copy-ivector-to-ivector source off1 dest off2 n))
+  (declare (fixnum off1 off2 n)
+           (simple-base-string source dest)
+           (optimize (speed 3) (safety 0)))
+  (dotimes (i n dest)
+    (setf (schar dest off2) (schar source off1))
+    (incf off1)
+    (incf off2)))
 
 
@@ -465 +472 @@
         (when (%i< start 0)(error "Negative start"))
         (let ((new (make-string newlen)))
-          (%copy-ivector-to-ivector str (%i+ start strb) new 0 newlen)
-          new)))))
+          (do* ((i 0 (1+ i))
+                (pos (%i+ start strb) (1+ pos)))
+               ((= i newlen) new)
+            (declare (fixnum i pos))
+            (setf (schar new i) (schar str pos))))))))
 
 
@@ -510 +520 @@
       bit))
   
-  ; given uvector subtype - what is the corresponding element-type
+  ;; given uvector subtype - what is the corresponding element-type
   (defun element-subtype-type (subtype)
     (declare (fixnum subtype))