X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsymbol.lisp;h=30e629e044aa30cd46cb190faa9605efc1ecafd0;hb=64ed946d513d0cd0508fea90cd3b44328e75df9a;hp=f4a7888042bf53641be6d75737a7e0f23d537444;hpb=62b6c13eaaefa20b790e10a28d292e1821cd4446;p=sbcl.git diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index f4a7888..30e629e 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -32,20 +32,37 @@ #!+sb-doc "Set SYMBOL's value cell to NEW-VALUE." (declare (type symbol symbol)) - (about-to-modify-symbol-value symbol) + (about-to-modify-symbol-value symbol 'set new-value) (%set-symbol-value symbol new-value)) (defun %set-symbol-value (symbol new-value) (%set-symbol-value symbol new-value)) +(defun symbol-global-value (symbol) + #!+sb-doc + "Return the SYMBOL's current global value. Identical to SYMBOL-VALUE, +in single-threaded builds: in multithreaded builds bound values are +distinct from the global value. Can also be SETF." + (declare (optimize (safety 1))) + (symbol-global-value symbol)) + +(defun set-symbol-global-value (symbol new-value) + (about-to-modify-symbol-value symbol 'set new-value) + (sb!kernel:%set-symbol-global-value symbol new-value)) + +(declaim (inline %makunbound)) +(defun %makunbound (symbol) + (%set-symbol-value symbol (%primitive sb!c:make-other-immediate-type + 0 sb!vm:unbound-marker-widetag))) + (defun makunbound (symbol) #!+sb-doc "Make SYMBOL unbound, removing any value it may currently have." (with-single-package-locked-error (:symbol symbol "unbinding the symbol ~A") - (set symbol - (%primitive sb!c:make-other-immediate-type - 0 - sb!vm:unbound-marker-widetag)) + (when (and (info :variable :always-bound symbol)) + (error "Can't make ~A variable unbound: ~S" 'always-bound symbol)) + (about-to-modify-symbol-value symbol 'makunbound) + (%makunbound symbol) symbol)) ;;; Return the built-in hash value for SYMBOL. @@ -247,7 +264,7 @@ (let ((new (etypecase old (index (1+ old)) (unsigned-byte (1+ old))))) - (declare (optimize (speed 3) (safety 0)(inhibit-warnings 3))) + (declare (optimize (speed 3) (safety 0) (inhibit-warnings 3))) (setq *gensym-counter* new))) (multiple-value-bind (prefix int) (etypecase thing @@ -256,9 +273,9 @@ (string (values (coerce thing 'simple-string) old))) (declare (simple-string prefix)) (make-symbol - (concatenate 'simple-string prefix - (the simple-string - (quick-integer-to-string int))))))) + (with-output-to-string (s) + (write-string prefix s) + (%output-integer-in-base int 10 s)))))) (defvar *gentemp-counter* 0) (declaim (type unsigned-byte *gentemp-counter*))