1 ;;;; Package (locking) related macros needed on the target before most
2 ;;;; of the package machinery is available.
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
13 (in-package "SB!IMPL")
15 ;;; Unbound outside package lock context, inside either list of
16 ;;; packages for which locks are ignored, T when locks for
17 ;;; all packages are ignored, and :invalid outside package-lock
18 ;;; context. FIXME: This needs to be rebound for each thread.
19 (!defvar
*ignored-package-locks
* :invalid
)
21 ;; This proclamation avoids a ton of style warnings due to so many calls
22 ;; that get cross-compiled prior to compiling "target-package.lisp"
23 (declaim (ftype (sfunction ((or symbol list
) &optional
(or string function
) &rest t
) t
)
24 assert-symbol-home-package-unlocked
))
26 (defmacro with-single-package-locked-error
((&optional kind thing
&rest format
)
28 #!-sb-package-locks
(declare (ignore kind thing format
))
32 (with-unique-names (topmost)
34 ;; /show was fairly useless here because it printed "/foo-ing ~A"
35 ;; without any clue as to what the interesting THING was.
36 ;; It could be handy for debugging package locks in bootstrap code,
37 ;; but if package locks work fine, it's just way too much noise.
38 (/noshow0
,(first format
))
40 ;; We use assignment and conditional restoration instead of
41 ;; dynamic binding because we want the ignored locks
42 ;; to propagate to the topmost context.
43 (when (eq :invalid
*ignored-package-locks
*)
44 (setf *ignored-package-locks
* nil
50 `((assert-symbol-home-package-unlocked ,thing
,@format
)))
52 `((assert-package-unlocked
53 (find-undeleted-package-or-lose ,thing
) ,@format
)))
58 (setf *ignored-package-locks
* :invalid
)))))))
60 (defmacro without-package-locks
(&body body
)
62 "Ignores all runtime package lock violations during the execution of
63 body. Body can begin with declarations."
64 `(let (#!+sb-package-locks
(*ignored-package-locks
* t
))