Changeset 5126

Timestamp:

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

Author:

Gary Byers

Message:

Deal with 32-bit lisp strings.

File:

• trunk/ccl/xdump/xfasload.lisp (modified) (6 diffs)

trunk/ccl/xdump/xfasload.lisp

@@ -63 +63 @@
 (defparameter *xload-target-fulltag-for-symbols* nil)
 (defparameter *xload-target-fulltag-for-functions* nil)
+(defparameter *xload-target-char-code-limit* nil)
 
 
@@ -148 +149 @@
           (if (arch::target-function-tag-is-subtag arch)
             (arch::target-fulltag-misc arch)
-            (arch::target-function-tag arch)))))
+            (arch::target-function-tag arch)))
+    (setq *xload-target-char-code-limit*
+          (arch::target-char-code-limit arch))))
 
 
@@ -785 +788 @@
   (let* ((subtag (type-keyword-code :simple-string)))
     (multiple-value-bind (addr v offset) (xload-make-ivector *xload-readonly-space* subtag n)
-      (do* ((p (+ offset *xload-target-misc-data-offset*)
-               (1+ p))
-              (i 0 (1+ i)))
-             ((= i n) str)
-          (declare (fixnum i p))
-          (setf (u8-ref v p) (char-code (schar str i))))
+      (case *xload-target-char-code-limit*
+        (256 (do* ((p (+ offset *xload-target-misc-data-offset*)
+                      (1+ p))
+                   (i 0 (1+ i)))
+                  ((= i n) str)
+               (declare (fixnum i p))
+               (setf (u8-ref v p) (char-code (schar str i)))))
+        (t
+         (do* ((p (+ offset *xload-target-misc-data-offset*)
+                      (+ p 4))
+                   (i 0 (1+ i)))
+                  ((= i n) str)
+               (declare (fixnum i p))
+               (setf (u32-ref v p) (char-code (schar str i))))))
         addr)))
 
@@ -911 +922 @@
 
 (defun xload-get-string (address)
-    (multiple-value-bind (v o) (xload-lookup-address address)
-      (let* ((header (natural-ref v (+ o *xload-target-misc-header-offset*)))
-             (len (ash header (- target::num-subtag-bits)))
-             (str (make-string len))
-             (p (+ o *xload-target-misc-data-offset*)))
-        (dotimes (i len str)
-          (setf (schar str i) (code-char (u8-ref v (+ p i))))))))
+  (multiple-value-bind (v o) (xload-lookup-address address)
+    (let* ((header (natural-ref v (+ o *xload-target-misc-header-offset*)))
+           (len (ash header (- target::num-subtag-bits)))
+           (str (make-string len))
+           (p (+ o *xload-target-misc-data-offset*)))
+      (case *xload-target-char-code-limit*
+        (256
+         (dotimes (i len str)
+           (setf (schar str i) (code-char (u8-ref v (+ p i))))))
+        (t
+         (dotimes (i len str)
+           (setf (schar str i) (code-char (u32-ref v (+ p (* i 4)))))))))))
 
                
@@ -1111 +1127 @@
     (multiple-value-bind (str v o) (xload-make-ivector *xload-readonly-space* :simple-string n)
       (%epushval s str)
-      (dotimes (i n)
-        (setf (u8-ref v (+ o i *xload-target-misc-data-offset*))
-              (%fasl-read-count s)))
+      (case *xload-target-char-code-limit*
+        (256
+         (dotimes (i n)
+           (setf (u8-ref v (+ o i *xload-target-misc-data-offset*))
+                 (%fasl-read-count s))))
+        (t
+         (dotimes (i n)
+           (setf (u32-ref v (+ o (* i 4) *xload-target-misc-data-offset*))
+                 (%fasl-read-count s)))))
       str)))
 
@@ -1720 +1742 @@
             (*xload-target-use-code-vectors* *xload-target-use-code-vectors*)
             (*xload-target-fulltag-for-symbols* *xload-target-fulltag-for-symbols*)
-            (*xload-target-fulltag-for-functions* *xload-target-fulltag-for-functions*))
+            (*xload-target-fulltag-for-functions* *xload-target-fulltag-for-functions*)
+            (*xload-target-char-code-limit* *xload-target-char-code-limit*))
        (setup-xload-target-parameters)
        (let* ((*load-verbose* t)