[Sbcl-commits] master: Remove ~200KB of uninterned symbol names from the image.

[Douglas K. <sn...@us...>]

The branch "master" has been updated in SBCL:
       via  51d25137ef0cf404d1971a63db87e9e7158c9878 (commit)
      from  87318119bd57b893a6dce02009b80514cf2c2caa (commit)

- Log -----------------------------------------------------------------
commit 51d25137ef0cf404d1971a63db87e9e7158c9878
Author: Douglas Katzman <do...@go...>
Date:   Mon Apr 28 18:53:07 2014 -0400

    Remove ~200KB of uninterned symbol names from the image.
    
    First, DEFMACRO always names its WHOLE and ENVIRONMENT arguments the same
    by STRING= but using non-EQ symbols. This is subtly different from
    (LET ((whole '#:whole) (environment #':env)) ..) - because if for some
    reason that eludes me there is really an issue of inadvertent capture,
    the compile-time hygiene of macros is essentially unaltered by this patch.
    
    Second, genesis coalesces uninterned symbols whose names are STRING=.
    This is permissible not just for our own code, but I refrained from having
    the regular fasloader do this because I suspect that it might be suprising
    that uninterned symbols are coalesced across files. It's hard to tell what
    CLHS had in mind- it doesn't specify when objects have to be *dissimilar*.
---
 src/code/defmacro.lisp            |    3 ++-
 src/compiler/generic/genesis.lisp |    6 +++++-
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp
index 8977660..14cf5eb 100644
--- a/src/code/defmacro.lisp
+++ b/src/code/defmacro.lisp
@@ -31,7 +31,8 @@
     (when (special-operator-p name)
       (error "The special operator ~S can't be redefined as a macro."
              name))
-    (with-unique-names (whole environment)
+    (let ((whole (make-symbol ".WHOLE."))
+          (environment (make-symbol ".ENVIRONMENT.")))
       (multiple-value-bind (new-body local-decs doc)
           (parse-defmacro lambda-list whole body name 'defmacro
                           :environment environment)
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 1de0220..a51af3a 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2245,12 +2245,16 @@ core and return a descriptor to it."
                 (fop-keyword-small-symbol-save)
   (push-fop-table (cold-load-symbol (clone-arg) *keyword-package*)))
 
+(defvar *uninterned-symbol-table* (make-hash-table :test #'equal))
 (clone-cold-fop (fop-uninterned-symbol-save)
                 (fop-uninterned-small-symbol-save)
   (let* ((size (clone-arg))
          (name (make-string size)))
     (read-string-as-bytes *fasl-input-stream* name)
-    (let ((symbol-des (allocate-symbol name)))
+    (let ((symbol-des (gethash name *uninterned-symbol-table*)))
+      (unless symbol-des
+        (setf symbol-des (allocate-symbol name)
+              (gethash name *uninterned-symbol-table*) symbol-des))
       (push-fop-table symbol-des))))
 
 ;;;; cold fops for loading packages

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL