From 71bc8b09fc75083ea4bb2aee954abca1f1e1f214 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 29 May 2011 21:49:45 +0000 Subject: [PATCH] 1.0.48.31: WITH-LOCKED-SYSTEM-TABLE Instead of disabling interrupts in user code that needs WITH-LOCKED-HASH-TABLE, have a separate WITH-LOCKED-SYSTEM-TABLE that does so. Use it instead of WITH-LOCKED-HASH-TABLE for all internals. --- contrib/sb-introspect/introspect.lisp | 2 +- package-data-list.lisp-expr | 3 +++ src/code/class.lisp | 4 ++-- src/code/cross-misc.lisp | 4 ++++ src/code/debug-int.lisp | 2 +- src/code/dyncount.lisp | 2 +- src/code/early-extensions.lisp | 2 +- src/code/hash-table.lisp | 4 ++++ src/code/linkage-table.lisp | 2 +- src/code/ntrace.lisp | 2 +- src/code/target-package.lisp | 2 +- src/code/target-pathname.lisp | 2 +- src/pcl/defs.lisp | 2 +- src/pcl/dfun.lisp | 6 +++--- src/pcl/fngen.lisp | 4 ++-- src/pcl/init.lisp | 2 +- version.lisp-expr | 2 +- 17 files changed, 29 insertions(+), 18 deletions(-) diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp index 568e844..c7fc14f 100644 --- a/contrib/sb-introspect/introspect.lisp +++ b/contrib/sb-introspect/introspect.lisp @@ -902,7 +902,7 @@ Experimental: interface subject to change." (funcall fun part)))) (when ext (let ((table sb-pcl::*eql-specializer-table*)) - (call (sb-ext:with-locked-hash-table (table) + (call (sb-int:with-locked-system-table (table) (gethash object table))))) (etypecase object ((or bignum float sb-sys:system-area-pointer fixnum)) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 1dc2002..b77f7de 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -852,6 +852,9 @@ possibly temporariliy, because it might be used internally." ;; Stack allocation without any questions asked "TRULY-DYNAMIC-EXTENT" + ;; Like WITH-LOCKED-HASH-TABLE, but disabled interrupts + "WITH-LOCKED-SYSTEM-TABLE" + ;; generic set implementation "ADD-TO-XSET" "ALLOC-XSET" diff --git a/src/code/class.lisp b/src/code/class.lisp index 0db908d..38fbef0 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -705,7 +705,7 @@ (defun find-classoid-cell (name &key create errorp) (let ((table *classoid-cells*) (real-name (uncross name))) - (or (with-locked-hash-table (table) + (or (with-locked-system-table (table) (or (gethash real-name table) (when create (setf (gethash real-name table) (make-classoid-cell real-name))))) @@ -827,7 +827,7 @@ (defun insured-find-classoid (name predicate constructor) (declare (type function predicate constructor)) (let ((table *forward-referenced-layouts*)) - (with-locked-hash-table (table) + (with-locked-system-table (table) (let* ((old (find-classoid name nil)) (res (if (and old (funcall predicate old)) old diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index 597756a..70d6f35 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -39,6 +39,10 @@ (declare (ignore table)) `(progn ,@body)) +(defmacro with-locked-system-table ((table) &body body) + (declare (ignore table)) + `(progn ,@body)) + (defmacro defglobal (name value &rest doc) `(eval-when (:compile-toplevel :load-toplevel :execute) (defparameter ,name diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index b37c0c0..9b973c0 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -309,7 +309,7 @@ ;;; and retains roots to functions that might otherwise be collected. (defun make-compiled-debug-fun (compiler-debug-fun component) (let ((table *compiled-debug-funs*)) - (with-locked-hash-table (table) + (with-locked-system-table (table) (or (gethash compiler-debug-fun table) (setf (gethash compiler-debug-fun table) (%make-compiled-debug-fun compiler-debug-fun component)))))) diff --git a/src/code/dyncount.lisp b/src/code/dyncount.lisp index c9270dc..befac9f 100644 --- a/src/code/dyncount.lisp +++ b/src/code/dyncount.lisp @@ -37,7 +37,7 @@ comments from CMU CL: "Return a hash-table containing only the entries in Table1 whose key is not also a key in Table2." (declare (type hash-table table1 table2)) (let ((res (make-hash-table-like table1))) - (with-locked-hash-table (table2) + (with-locked-system-table (table2) (dohash ((k v) table1 :locked t) (unless (nth-value 1 (gethash k table2)) (setf (gethash k res) v)))) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index c589ab9..5f2aa46 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -461,7 +461,7 @@ ,@forms))))) `(let ((,n-table ,table)) ,(if locked - `(with-locked-hash-table (,n-table) + `(with-locked-system-table (,n-table) ,iter-form) iter-form)))))) diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index d72595c..933b390 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -144,6 +144,10 @@ unspecified." ;; Needless to say, this also excludes some internal bits, but ;; getting there is too much detail when "unspecified" says what ;; is important -- unpredictable, but harmless. + `(sb!thread::with-recursive-spinlock ((hash-table-spinlock ,hash-table)) + ,@body)) + +(defmacro-mundanely with-locked-system-table ((hash-table) &body body) `(sb!thread::with-recursive-system-spinlock ((hash-table-spinlock ,hash-table)) ,@body)) diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp index 6a4a70c..61e21b5 100644 --- a/src/code/linkage-table.lisp +++ b/src/code/linkage-table.lisp @@ -60,7 +60,7 @@ ;;; in the linkage table. (defun ensure-foreign-symbol-linkage (name datap) (/show0 "ensure-foreign-symbol-linkage") - (with-locked-hash-table (*linkage-info*) + (with-locked-system-table (*linkage-info*) (let ((info (or (gethash (cons name datap) *linkage-info*) (link-foreign-symbol name datap)))) (linkage-info-address info)))) diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 1d74e47..ec90233 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -660,7 +660,7 @@ are evaluated in the null environment." ((not fun) ;; Someone has FMAKUNBOUND it. (let ((table *traced-funs*)) - (with-locked-hash-table (table) + (with-locked-system-table (table) (maphash (lambda (fun info) (when (equal function-or-name (trace-info-what info)) (remhash fun table))) diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 3f9bb9a..4569a11 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -75,7 +75,7 @@ (defmacro with-package-names ((names &key) &body body) `(let ((,names *package-names*)) - (with-locked-hash-table (,names) + (with-locked-system-table (,names) ,@body))) ;;;; PACKAGE-HASHTABLE stuff diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index 52e81dc..ff023ee 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -1361,7 +1361,7 @@ unspecified elements into a completed to-pathname based on the to-wildname." ;;; a new one if necessary. (defun intern-logical-host (thing) (declare (values logical-host)) - (with-locked-hash-table (*logical-hosts*) + (with-locked-system-table (*logical-hosts*) (or (find-logical-host thing nil) (let* ((name (logical-word-or-lose thing)) (new (make-logical-host :name name))) diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 21f0eb8..e7e825d 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -595,7 +595,7 @@ (defun intern-eql-specializer (object) ;; Need to lock, so that two threads don't get non-EQ specializers ;; for an EQL object. - (with-locked-hash-table (*eql-specializer-table*) + (with-locked-system-table (*eql-specializer-table*) (or (gethash object *eql-specializer-table*) (setf (gethash object *eql-specializer-table*) (make-instance 'eql-specializer :object object))))) diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index be3c163..86019d2 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -1579,7 +1579,7 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 nil)) ;;; Not synchronized, as all the uses we have for it are multiple ones -;;; and need WITH-LOCKED-HASH-TABLE in any case. +;;; and need WITH-LOCKED-SYSTEM-TABLE in any case. ;;; ;;; FIXME: Is it really more efficient to store this stuff in a global ;;; table instead of having a slot in each method? @@ -1590,7 +1590,7 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (defun flush-effective-method-cache (generic-function) (let ((cache *effective-method-cache*)) - (with-locked-hash-table (cache) + (with-locked-system-table (cache) (dolist (method (generic-function-methods generic-function)) (remhash method cache))))) @@ -1615,7 +1615,7 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (call-no-applicable-method gf args))) (let* ((key (car methods)) (ht *effective-method-cache*) - (ht-value (with-locked-hash-table (ht) + (ht-value (with-locked-system-table (ht) (or (gethash key ht) (setf (gethash key ht) (cons nil nil)))))) (if (and (null (cdr methods)) all-applicable-p ; the most common case diff --git a/src/pcl/fngen.lisp b/src/pcl/fngen.lisp index 548974a..4df2a35 100644 --- a/src/pcl/fngen.lisp +++ b/src/pcl/fngen.lisp @@ -89,7 +89,7 @@ (defvar *fgens* (make-hash-table :test #'equal :synchronized t)) (defun ensure-fgen (test gensyms generator generator-lambda system) - (with-locked-hash-table (*fgens*) + (with-locked-system-table (*fgens*) (let ((old (lookup-fgen test))) (cond (old (setf (fgen-generator old) generator) @@ -164,7 +164,7 @@ (defmacro precompile-function-generators (&optional system) (let (collect) - (with-locked-hash-table (*fgens*) + (with-locked-system-table (*fgens*) (maphash (lambda (test fgen) (when (or (null (fgen-system fgen)) (eq (fgen-system fgen) system)) diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp index 8a7b123..5b6d913 100644 --- a/src/pcl/init.lisp +++ b/src/pcl/init.lisp @@ -66,7 +66,7 @@ (let ((type (slot-definition-type slotd))) (values (when (and (neq t type) (safe-p (slot-definition-class slotd))) - (with-locked-hash-table (**typecheck-cache**) + (with-locked-system-table (**typecheck-cache**) (or (gethash type **typecheck-cache**) (setf (gethash type **typecheck-cache**) (handler-bind (((or style-warning compiler-note) diff --git a/version.lisp-expr b/version.lisp-expr index deb1ff9..cb5efe2 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,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.48.30" +"1.0.48.31" -- 1.7.10.4