From a6e22347785e8ce3eaf13013cfc69d6aac9c8c0e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 16 Sep 2009 11:46:39 +0000 Subject: [PATCH] 1.0.31.12: use global lexicals for world-lock and finalizers *WORLD-LOCK* -> **WORLD-LOCK**. *FINALIZER-STORE* -> **FINALIZER-STORE**. *FINALIZER-STORE-LOCK* -> **FINALIZER-STORE-LOCK**. ...eating your own dogfood is good for you. --- src/code/cross-misc.lisp | 8 ++++++++ src/code/cross-thread.lisp | 3 +++ src/code/final.lisp | 18 +++++++++--------- src/code/load.lisp | 2 +- src/compiler/early-c.lisp | 6 +++--- version.lisp-expr | 2 +- 6 files changed, 25 insertions(+), 14 deletions(-) diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index 0e1e82e..597756a 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -39,6 +39,14 @@ (declare (ignore table)) `(progn ,@body)) +(defmacro defglobal (name value &rest doc) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter ,name + (if (boundp ',name) + (symbol-value ',name) + ,value) + ,@doc))) + ;;; The GENESIS function works with fasl code which would, in the ;;; target SBCL, work on ANSI-STREAMs (streams which aren't extended ;;; Gray streams). In ANSI Common Lisp, an ANSI-STREAM is just a diff --git a/src/code/cross-thread.lisp b/src/code/cross-thread.lisp index 461f02d..743357a 100644 --- a/src/code/cross-thread.lisp +++ b/src/code/cross-thread.lisp @@ -15,6 +15,9 @@ (declare (ignore name value)) nil) +#!+(and sb-lutex sb-thread) +(defun make-lutex () nil) + (defmacro with-mutex ((mutex) &body body) (declare (ignore mutex)) `(locally ,@body)) diff --git a/src/code/final.lisp b/src/code/final.lisp index 8b21939..fc807f4 100644 --- a/src/code/final.lisp +++ b/src/code/final.lisp @@ -11,13 +11,13 @@ (in-package "SB!IMPL") -(defvar *finalizer-store* nil) +(defglobal **finalizer-store** nil) -(defvar *finalizer-store-lock* +(defglobal **finalizer-store-lock** (sb!thread:make-mutex :name "Finalizer store lock.")) (defmacro with-finalizer-store-lock (&body body) - `(sb!thread::with-system-mutex (*finalizer-store-lock* :without-gcing t) + `(sb!thread::with-system-mutex (**finalizer-store-lock** :without-gcing t) ,@body)) (defun finalize (object function &key dont-save) @@ -70,13 +70,13 @@ Examples: (error "Cannot finalize NIL.")) (with-finalizer-store-lock (push (list (make-weak-pointer object) function dont-save) - *finalizer-store*)) + **finalizer-store**)) object) (defun deinit-finalizers () ;; remove :dont-save finalizers (with-finalizer-store-lock - (setf *finalizer-store* (delete-if #'third *finalizer-store*))) + (setf **finalizer-store** (delete-if #'third **finalizer-store**))) nil) (defun cancel-finalization (object) @@ -86,8 +86,8 @@ Examples: ;; run. (when object (with-finalizer-store-lock - (setf *finalizer-store* - (delete object *finalizer-store* + (setf **finalizer-store** + (delete object **finalizer-store** :key (lambda (list) (weak-pointer-value (car list)))))) object)) @@ -95,12 +95,12 @@ Examples: (defun run-pending-finalizers () (let (pending) (with-finalizer-store-lock - (setf *finalizer-store* + (setf **finalizer-store** (delete-if (lambda (list) (when (null (weak-pointer-value (car list))) (push (second list) pending) t)) - *finalizer-store*))) + **finalizer-store**))) ;; We want to run the finalizer bodies outside the lock in case ;; finalization of X causes finalization to be added for Y. (dolist (fun pending) diff --git a/src/code/load.lisp b/src/code/load.lisp index 00bfde7..97258b3 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -20,7 +20,7 @@ ;;;; here: certainly enough that I (dan, 2003.1.22) don't want to mess ;;;; around deciding how to thread-safetify it. So we use a Big Lock. ;;;; Because this code is mutually recursive with the compiler, we use -;;;; the *world-lock*. +;;;; the **WORLD-LOCK**. ;;;; miscellaneous load utilities diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 736056b..21f89b5 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -127,13 +127,13 @@ the stack without triggering overflow protection.") (!begin-collecting-cold-init-forms) ;;; This lock is seized in the compiler, and related areas -- like the ;;; classoid/layout/class system. -(defvar *world-lock*) +(defglobal **world-lock** nil) (!cold-init-forms - (setf *world-lock* (sb!thread:make-mutex :name "World Lock"))) + (setf **world-lock** (sb!thread:make-mutex :name "World Lock"))) (!defun-from-collected-cold-init-forms !world-lock-cold-init) (defmacro with-world-lock (() &body body) - `(sb!thread:with-recursive-lock (*world-lock*) + `(sb!thread:with-recursive-lock (**world-lock**) ,@body)) (declaim (type fixnum *compiler-sset-counter*)) diff --git a/version.lisp-expr b/version.lisp-expr index 10f5633..b2f1639 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.31.11" +"1.0.31.12" -- 1.7.10.4