Changeset 5054

Timestamp:

Aug 28, 2006, 4:34:02 AM (18 years ago)

Author:

Gary Byers

Message:

New string stuff here, too.

File:

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

trunk/ccl/xdump/xfasload.lisp

@@ -796 +796 @@
 (defun %xload-fasl-vreadstr (s)
   (multiple-value-bind (str n new-p) (%fasl-vreadstr s)
+    (declare (fixnum n subtype))
+    (values (xload-save-string str n) str n new-p)))
+
+;;; Read a string from fasl file, save it to readonly-space.
+;;; (assumes variable-length encoding.)
+(defun %xload-fasl-nvreadstr (s)
+  (multiple-value-bind (str n new-p) (%fasl-nvreadstr s)
     (declare (fixnum n subtype))
     (values (xload-save-string str n) str n new-p)))
@@ -1148 +1155 @@
     (%epushval s sym)))
 
+(defun %xload-fasl-nvmake-symbol (s &optional idx)
+  (let* ((sym (xload-make-symbol (%xload-fasl-nvreadstr s))))
+    (when idx
+      (xload-ensure-binding-index sym))
+    (%epushval s sym)))
+
 
 
@@ -1170 +1183 @@
          (%epushval s symaddr))))))
 
+(defun %xload-fasl-nvintern (s package &optional idx)
+  (multiple-value-bind (str len new-p) (%fasl-nvreadstr s)
+    (without-interrupts
+     (multiple-value-bind (cursym access internal external) (%find-symbol str len package)
+       (unless access
+         (unless new-p (setq str (%fasl-copystr str len)))
+         (setq cursym (%add-symbol str package internal external)))
+       ;; cursym now exists in the load-time world; make sure that it exists
+       ;; (and is properly "interned" in the world we're making as well)
+       (let* ((symaddr (xload-copy-symbol cursym)))
+         (when idx
+           (xload-ensure-binding-index symaddr))
+         (%epushval s symaddr))))))
+
 
 (defxloadfaslop $fasl-vintern (s)
   (%xload-fasl-vintern s *package*))
 
+(defxloadfaslop $fasl-nvintern (s)
+  (%xload-fasl-nvintern s *package*))
+
 (defxloadfaslop $fasl-vintern-special (s)
   (%xload-fasl-vintern s *package* t))
+
+(defxloadfaslop $fasl-nvintern-special (s)
+  (%xload-fasl-nvintern s *package* t))
 
 (defxloadfaslop $fasl-vpkg-intern (s)
@@ -1182 +1215 @@
     (%xload-fasl-vintern s pkg)))
 
+(defxloadfaslop $fasl-nvpkg-intern (s)
+  (let* ((addr (%fasl-expr-preserve-epush  s))
+         (pkg (xload-addr->package addr)))
+    (%xload-fasl-nvintern s pkg)))
+
 (defxloadfaslop $fasl-vpkg-intern-special (s)
   (let* ((addr (%fasl-expr-preserve-epush  s))
          (pkg (xload-addr->package addr)))
     (%xload-fasl-vintern s pkg t)))
+
+(defxloadfaslop $fasl-nvpkg-intern-special (s)
+  (let* ((addr (%fasl-expr-preserve-epush  s))
+         (pkg (xload-addr->package addr)))
+    (%xload-fasl-nvintern s pkg t)))
 
 (defun %xload-fasl-vpackage (s)
@@ -1193 +1236 @@
                     (or p (%kernel-restart $XNOPKG (if new-p str (%fasl-copystr str len)))))))))
 
+(defun %xload-fasl-nvpackage (s)
+  (multiple-value-bind (str len new-p) (%fasl-nvreadstr s)
+    (let* ((p (%find-pkg str len)))
+      (%epushval s (xload-package->addr 
+                    (or p (%kernel-restart $XNOPKG (if new-p str (%fasl-copystr str len)))))))))
+
 
 (defxloadfaslop $fasl-vpkg (s)
   (%xload-fasl-vpackage s))
+
+(defxloadfaslop $fasl-nvpkg (s)
+  (%xload-fasl-nvpackage s))
 
 (defxloadfaslop $fasl-cons (s)