From: Alastair Bridgewater <lisphacker@users.sourceforge.net>
Date: Sat, 3 Apr 2010 00:41:04 +0000 (+0000)
Subject: 1.0.37.27: Add new named-package FOPs for simpler package fasdumping.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d55ad026a3d69bcbd595a7a09763327977e46e0b;p=sbcl.git

1.0.37.27: Add new named-package FOPs for simpler package fasdumping.

 * A new cloned-fop pair, fop-named-package-save and
fop-small-named-package-save, taking an inlined string and doing the
package lookup, save to fasl-table, etc.

 * Defined in genesis as new clone-cold-fop pair, as genesis needs host
package objects in its fasl table.

 * Package references now dumped using the new fop pair, instead of
faffing about with switching between cold and normal loads, dumping the
package name, dumping a fop-package and dumping fop-pop.

 * Old fop-package retained for use by the fopcompiler.
---

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 6b2809d..a4d9331 100644
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -270,6 +270,18 @@
 
 (define-fop (fop-package 14)
   (find-undeleted-package-or-lose (pop-stack)))
+
+(define-cloned-fops (fop-named-package-save 156 :stackp nil)
+                    (fop-small-named-package-save 157)
+  (let* ((arg (clone-arg))
+         (package-name (make-string arg)))
+    #+sb-xc-host
+    (read-string-as-bytes *fasl-input-stream* package-name)
+    #-sb-xc-host
+    (#!-sb-unicode read-string-as-bytes
+     #!+sb-unicode read-string-as-unsigned-byte-32
+     *fasl-input-stream* package-name)
+    (push-fop-table (find-undeleted-package-or-lose package-name))))
 
 ;;;; fops for loading numbers
 
diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 52bddb4..0db369e 100644
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -620,21 +620,16 @@
   (declare (inline assoc))
   (cond ((cdr (assoc pkg (fasl-output-packages file) :test #'eq)))
         (t
-         (unless *cold-load-dump*
-           (dump-fop 'fop-normal-load file))
-         #+sb-xc-host
-         (dump-simple-base-string
-          (coerce (package-name pkg) 'simple-base-string)
-          file)
-         #-sb-xc-host
-         (#!+sb-unicode dump-simple-character-string
-          #!-sb-unicode dump-simple-base-string
-          (coerce (package-name pkg) '(simple-array character (*)))
-          file)
-         (dump-fop 'fop-package file)
-         (unless *cold-load-dump*
-           (dump-fop 'fop-maybe-cold-load file))
-         (let ((entry (dump-pop file)))
+         (let ((s (package-name pkg)))
+           (dump-fop* (length s) fop-small-named-package-save fop-named-package-save file)
+           #+sb-xc-host
+           (dump-base-chars-of-string (coerce s 'simple-base-string) file)
+           #-sb-xc-host
+           (#!+sb-unicode dump-characters-of-string
+            #!-sb-unicode dump-base-chars-of-string
+            (coerce s '(simple-array character (*))) file))
+         (let ((entry (fasl-output-table-free file)))
+           (incf (fasl-output-table-free file))
            (push (cons pkg entry) (fasl-output-packages file))
            entry))))
 
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index b148cee..de143e5 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2131,6 +2131,15 @@ core and return a descriptor to it."
     (let ((symbol-des (allocate-symbol name)))
       (push-fop-table symbol-des))))
 
+;;;; cold fops for loading packages
+
+(clone-cold-fop (fop-named-package-save :stackp nil)
+                (fop-small-named-package-save)
+  (let* ((size (clone-arg))
+         (name (make-string size)))
+    (read-string-as-bytes *fasl-input-stream* name)
+    (push-fop-table (find-package name))))
+
 ;;;; cold fops for loading lists
 
 ;;; Make a list of the top LENGTH things on the fop stack. The last
diff --git a/version.lisp-expr b/version.lisp-expr
index 20cd3fd..9f5533b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.26"
+"1.0.37.27"