Changeset 5068

Timestamp:

Sep 2, 2006, 10:01:19 AM (18 years ago)

Author:

Gary Byers

Message:

Try to avoid things like %COPY-IVECTOR-TO-IVECTOR when strings are
involved.

File:

• trunk/ccl/lib/db-io.lisp (modified) (5 diffs)

trunk/ccl/lib/db-io.lisp

@@ -312 +312 @@
   (let* ((string (format nil "~s ~s ~d " "OpenMCL Interface File" (backend-name *target-backend*) *interface-abi-version*)))
     (%stack-block ((buf 512))
-      (%copy-ivector-to-ptr string 0 buf 0 (length string))
+      (%cstr-pointer string buf)
       (fid-write (cdbm-fid cdbm) buf 512))))
 
@@ -393 +393 @@
         (fid-read fid buf 512)
         (let* ((string (make-string 512)))
-          (%copy-ptr-to-ivector buf 0 string 0 512)
+          (dotimes (i 512)
+            (setf (schar string i) (%get-unsigned-byte buf i)))
           (with-input-from-string (s string)
             (let* ((sig (ignore-errors (read s)))
@@ -567 +568 @@
                (encoding (make-string encoding-len)))
           (declare (dynamic-extent encoding))
-          (%copy-ptr-to-ivector dptr (+ 2 name-len) encoding 0 encoding-len)
+          (%str-from-ptr (%inc-ptr dptr (+ 2 name-len)) encoding-len encoding)
           (cdb-free (pref datum :cdb-datum.data))
           (multiple-value-bind (args result)
@@ -635 +636 @@
   (let* ((dsize (+ 4 (length val))))
     (%stack-block ((valbuf dsize))
-      (%copy-ivector-to-ptr val 0 valbuf 4 (length val))
+      (dotimes (i (length val))
+        (setf (%get-unsigned-byte valbuf (the fixnum (+ 4 i)))
+              (%scharcode val i)))
       (setf (%get-long valbuf) class)
       (rletZ ((content :cdb-datum)
@@ -1435 +1438 @@
     (if (zerop n)
       (values nil (1+ p))
-      (let* ((pname (make-string n)))
-        (%copy-ptr-to-ivector buf (1+ p) pname 0 n)
+      (let* ((pname (%str-from-ptr (%inc-ptr buf (1+ p)) n)))
         (values (if verbatim pname (escape-foreign-name pname))
                 (+ p (1+ n)))))))