0.9.8.10:

  * bug fix: allow non-simple string symbol names (reported by Paul
    Dietz)

diff --git a/NEWS b/NEWS
index 6027689..a152d46 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes in sbcl-0.9.9 relative to sbcl-0.9.8:
     system has been added.  (thanks to Alastair Bridgewater)
   * fixed several bugs in and robustified the PPC FFI (including
     callbacks).  (thanks to Cyrus Harmon and Heiner Schwarte)
+  * bug fix: allow non-simple string symbol names (reported by Paul
+    Dietz)
   * optimization: faster implementation of EQUAL
   * fixed segfaults on x86 FreeBSD 7-current (thanks to NIIMI Satoshi)
 

diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp
index 39f89a7..f4a7888 100644 (file)
--- a/src/code/symbol.lisp
+++ b/src/code/symbol.lisp
@@ -88,7 +88,10 @@
 (defun make-symbol (string)
   #!+sb-doc
   "Make and return a new symbol with the STRING as its print name."
-  (make-symbol string))
+  (declare (type string string))
+  (%make-symbol (if (simple-string-p string)
+                    string
+                    (subseq string 0))))
 
 (defun get (symbol indicator &optional (default nil))
   #!+sb-doc

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index e330137..eb06b68 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -164,6 +164,7 @@
 (defknown get-properties (list list) (values t t list) (foldable flushable))
 (defknown symbol-name (symbol) simple-string (movable foldable flushable))
 (defknown make-symbol (string) symbol (flushable))
+(defknown %make-symbol (simple-string) symbol (flushable))
 (defknown copy-symbol (symbol &optional t) symbol (flushable))
 (defknown gensym (&optional (or string unsigned-byte)) symbol ())
 (defknown symbol-package (symbol) (or sb!xc:package null) (flushable))
@@ -1545,4 +1546,3 @@
   (values)
   ())
 (defknown style-warn (string &rest t) null ())
-

diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index 7ab3fc8..88dc800 100644 (file)
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -356,7 +356,7 @@
 
 (define-primitive-object (symbol :lowtag other-pointer-lowtag
                                  :widetag symbol-header-widetag
-                                 :alloc-trans make-symbol)
+                                 :alloc-trans %make-symbol)
 
   ;; Beware when changing this definition.  NIL-the-symbol is defined
   ;; using this layout, and NIL-the-end-of-list-marker is the cons

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 1102112..df05a08 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1879,3 +1879,6 @@
 
   (unless do-not-optimize
     (setf (node-reoptimize cast) nil)))
+
+(deftransform make-symbol ((string) (simple-string))
+  `(%make-symbol string))

diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp
index 457d4f7..bcc7a74 100644 (file)
--- a/src/compiler/x86-64/alloc.lisp
+++ b/src/compiler/x86-64/alloc.lisp
@@ -188,9 +188,9 @@
      (inst lea result (make-ea :byte :base result :disp lowtag))
      (storew header result 0 lowtag))))
 
-(define-vop (make-symbol)
+(define-vop (%make-symbol)
   (:policy :fast-safe)
-  (:translate make-symbol)
+  (:translate %make-symbol)
   (:args (name :scs (descriptor-reg) :to :eval))
   (:temporary (:sc unsigned-reg :from :eval) temp)
   (:results (result :scs (descriptor-reg) :from :argument))

diff --git a/version.lisp-expr b/version.lisp-expr
index 6d9f03e..3a61685 100644 (file)
--- 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".)
-"0.9.8.9"
+"0.9.8.10"