From: Nikodemus Siivola Date: Thu, 12 Jul 2007 17:28:40 +0000 (+0000) Subject: 1.0.7.14: thread-safe INTERN, EXPORT, &co X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a556288505e2687ac333e1b0a8deebb13c76a60c;p=sbcl.git 1.0.7.14: thread-safe INTERN, EXPORT, &co * Modifications to packages grab a global lock. INTERN is the only real potential performance bottleneck here, but as long as the symbol already exists it doesn't need to get the lock. We need a global lock instead of a per-package lock because eg. (EXPORT 'FOO::BAR :FOO) and (INTERN "BAR" :ZOT) can conflict, even though they operate on different packages. Since races should be rare we use a spinlock to avoid making a system call for every release. Interrupt safety? Probably no. It's likely that you can wedge the package system into a bad state if you really try. --- diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp index 5cc7d3f..f32755b 100644 --- a/src/pcl/compiler-support.lisp +++ b/src/pcl/compiler-support.lisp @@ -98,3 +98,42 @@ new-value) (defsetf sb-pcl::random-documentation sb-pcl::set-random-documentation) + +;;;; SLOT-VALUE optimizations + +(defknown slot-value (t symbol) t (any)) +(defknown sb-pcl::set-slot-value (t symbol t) t (any)) + +(defun pcl-boot-state-complete-p () + (eq 'sb-pcl::complete sb-pcl::*boot-state*)) + +;;; These essentially duplicate what the compiler-macros in slots.lisp +;;; do, but catch more cases. We retain the compiler-macros since they +;;; can be used during the build, and because they catch common cases +;;; slightly more cheaply then the transforms. (Transforms add new +;;; lambdas, which requires more work by the compiler.) + +(deftransform slot-value ((object slot-name) * * :important t) + "optimize" + (let (c-slot-name) + (if (and (pcl-boot-state-complete-p) + (constant-lvar-p slot-name) + (setf c-slot-name (lvar-value slot-name)) + (sb-pcl::interned-symbol-p c-slot-name)) + `(sb-pcl::accessor-slot-value object ',c-slot-name) + (give-up-ir1-transform "Slot name is not constant.")))) + +(deftransform sb-pcl::set-slot-value ((object slot-name new-value) + (t symbol t) t + :important t + ;; see comment in the + ;; compiler-macro + :policy (< safety 3)) + "optimize" + (let (c-slot-name) + (if (and (pcl-boot-state-complete-p) + (constant-lvar-p slot-name) + (setf c-slot-name (lvar-value slot-name)) + (sb-pcl::interned-symbol-p c-slot-name)) + `(sb-pcl::accessor-set-slot-value object ',c-slot-name new-value) + (give-up-ir1-transform "Slot name is not constant.")))) diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp index 8abdb89..6bef614 100644 --- a/src/pcl/slots-boot.lisp +++ b/src/pcl/slots-boot.lisp @@ -56,9 +56,9 @@ (setf reader-specializers (mapcar #'find-class reader-specializers)) (setf writer-specializers (mapcar #'find-class writer-specializers)))) -(defmacro accessor-slot-value (object slot-name) - (aver (constantp slot-name)) - (let* ((slot-name (constant-form-value slot-name)) +(defmacro accessor-slot-value (object slot-name &environment env) + (aver (constantp slot-name env)) + (let* ((slot-name (constant-form-value slot-name env)) (reader-name (slot-reader-name slot-name))) `(let ((.ignore. (load-time-value (ensure-accessor 'reader ',reader-name ',slot-name)))) @@ -67,14 +67,14 @@ (funcall #',reader-name ,object))))) (defmacro accessor-set-slot-value (object slot-name new-value &environment env) - (aver (constantp slot-name)) + (aver (constantp slot-name env)) (setq object (macroexpand object env)) - (setq slot-name (macroexpand slot-name env)) - (let* ((slot-name (constant-form-value slot-name)) - (bindings (unless (or (constantp new-value) (atom new-value)) - (let ((object-var (gensym))) - (prog1 `((,object-var ,object)) - (setq object object-var))))) + (let* ((slot-name (constant-form-value slot-name env)) + (bind-object (unless (or (constantp new-value env) (atom new-value)) + (let* ((object-var (gensym)) + (bind `((,object-var ,object)))) + (setf object object-var) + bind))) (writer-name (slot-writer-name slot-name)) (form `(let ((.ignore. @@ -84,13 +84,13 @@ (declare (ignore .ignore.)) (funcall #',writer-name .new-value. ,object) .new-value.))) - (if bindings - `(let ,bindings ,form) + (if bind-object + `(let ,bind-object ,form) form))) -(defmacro accessor-slot-boundp (object slot-name) - (aver (constantp slot-name)) - (let* ((slot-name (constant-form-value slot-name)) +(defmacro accessor-slot-boundp (object slot-name &environment env) + (aver (constantp slot-name env)) + (let* ((slot-name (constant-form-value slot-name env)) (boundp-name (slot-boundp-name slot-name))) `(let ((.ignore. (load-time-value (ensure-accessor 'boundp ',boundp-name ',slot-name)))) diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp index aade5b2..b9ee309 100644 --- a/src/pcl/slots.lisp +++ b/src/pcl/slots.lisp @@ -88,9 +88,10 @@ (values (slot-missing class object slot-name 'slot-value)) (slot-value-using-class class object slot-definition)))) -(define-compiler-macro slot-value (&whole form object slot-name) - (if (and (constantp slot-name) - (interned-symbol-p (constant-form-value slot-name))) +(define-compiler-macro slot-value (&whole form object slot-name + &environment env) + (if (and (constantp slot-name env) + (interned-symbol-p (constant-form-value slot-name env))) `(accessor-slot-value ,object ,slot-name) form)) @@ -111,9 +112,9 @@ (set-slot-value object slot-name new-value)) (define-compiler-macro set-slot-value (&whole form object slot-name new-value - &environment env) - (if (and (constantp slot-name) - (interned-symbol-p (constant-form-value slot-name)) + &environment env) + (if (and (constantp slot-name env) + (interned-symbol-p (constant-form-value slot-name env)) ;; We can't use the ACCESSOR-SET-SLOT-VALUE path in safe ;; code, since it'll use the global automatically generated ;; accessor, which won't do typechecking. (SLOT-OBJECT @@ -132,9 +133,10 @@ (setf (gdefinition 'slot-boundp-normal) #'slot-boundp) -(define-compiler-macro slot-boundp (&whole form object slot-name) - (if (and (constantp slot-name) - (interned-symbol-p (constant-form-value slot-name))) +(define-compiler-macro slot-boundp (&whole form object slot-name + &environment env) + (if (and (constantp slot-name env) + (interned-symbol-p (constant-form-value slot-name env))) `(accessor-slot-boundp ,object ,slot-name) form)) @@ -389,3 +391,4 @@ (defmethod allocate-instance ((class built-in-class) &rest initargs) (declare (ignore initargs)) (error "Cannot allocate an instance of ~S." class)) ; So sayeth AMOP + diff --git a/version.lisp-expr b/version.lisp-expr index 7583589..5ba19b0 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".) -"1.0.7.15" +"1.0.7.16"