delete *FASL-SYMBOL-BUFFER*

  Instead allocate the right-sized string every time, and add
  :NO-COPY option to INTERN* and use it in AUX-FOP-INTERN to
  avoid copying when interning.

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index e45704e..9b69677 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -193,24 +193,24 @@
 ;;;; fops for loading symbols
 
 (defun aux-fop-intern (smallp package)
-  (let ((size (if smallp
-                  (read-byte-arg)
-                  (read-word-arg))))
-    (when (> size (length *fasl-symbol-buffer*))
-      (setq *fasl-symbol-buffer* (make-string (* size 2))))
-    (let ((buffer *fasl-symbol-buffer*))
-      #+sb-xc-host
-      (read-string-as-bytes *fasl-input-stream* buffer size)
-      #-sb-xc-host
-      (progn
-        #!+sb-unicode
-        (read-string-as-unsigned-byte-32 *fasl-input-stream* buffer size)
-        #!-sb-unicode
-        (read-string-as-bytes *fasl-input-stream* buffer size))
-      (push-fop-table (without-package-locks
-                        (intern* buffer
-                                 size
-                                 package))))))
+  (declare (optimize speed))
+  (let* ((size (if smallp
+                   (read-byte-arg)
+                   (read-word-arg)))
+         (buffer (make-string size)))
+    #+sb-xc-host
+    (read-string-as-bytes *fasl-input-stream* buffer size)
+    #-sb-xc-host
+    (progn
+      #!+sb-unicode
+      (read-string-as-unsigned-byte-32 *fasl-input-stream* buffer size)
+      #!-sb-unicode
+      (read-string-as-bytes *fasl-input-stream* buffer size))
+    (push-fop-table (without-package-locks
+                      (intern* buffer
+                               size
+                               package
+                               :no-copy t)))))
 
 (macrolet ((def (name code smallp package-form)
              `(define-fop (,name ,code)

diff --git a/src/code/load.lisp b/src/code/load.lisp
index dbbab95..8c82bf1 100644 (file)
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -388,10 +388,6 @@
 #!+sb-show
 (defvar *show-fops-p* nil)
 
-;; buffer for loading symbols
-(defvar *fasl-symbol-buffer*)
-(declaim (simple-string *fasl-symbol-buffer*))
-
 ;;;
 ;;; a helper function for LOAD-AS-FASL
 ;;;
@@ -441,7 +437,6 @@
   (maybe-announce-load stream verbose)
   (with-world-lock ()
     (let* ((*fasl-input-stream* stream)
-           (*fasl-symbol-buffer* (make-string 100))
            (*current-fop-table* (or (pop *free-fop-tables*) (make-array 1000)))
            (*current-fop-table-size* (length *current-fop-table*))
            (*fop-stack* (make-array 100 :fill-pointer 0 :adjustable t)))

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 87f1da1..354f64d 100644 (file)
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -776,7 +776,7 @@ implementation it is ~S." *default-package-use-list*)
 
 ;;; If the symbol named by the first LENGTH characters of NAME doesn't exist,
 ;;; then create it, special-casing the keyword package.
-(defun intern* (name length package)
+(defun intern* (name length package &key no-copy)
   (declare (simple-string name))
   (multiple-value-bind (symbol where) (find-symbol* name length package)
     (cond (where
@@ -790,7 +790,11 @@ implementation it is ~S." *default-package-use-list*)
              (setf (values symbol where) (find-symbol* name length package))
              (if where
                  (values symbol where)
-                 (let ((symbol-name (subseq name 0 length)))
+                 (let ((symbol-name (cond (no-copy
+                                           (aver (= (length name) length))
+                                           name)
+                                          (t
+                                           (subseq name 0 length)))))
                    (with-single-package-locked-error
                        (:package package "interning ~A" symbol-name)
                      (let ((symbol (make-symbol symbol-name)))