From 62b6c13eaaefa20b790e10a28d292e1821cd4446 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Thu, 5 Jan 2006 11:17:58 +0000 Subject: [PATCH] 0.9.8.10: * bug fix: allow non-simple string symbol names (reported by Paul Dietz) --- NEWS | 2 ++ src/code/symbol.lisp | 5 ++++- src/compiler/fndb.lisp | 2 +- src/compiler/generic/objdef.lisp | 2 +- src/compiler/ir1opt.lisp | 3 +++ src/compiler/x86-64/alloc.lisp | 4 ++-- version.lisp-expr | 2 +- 7 files changed, 14 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 6027689..a152d46 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4