diff --git a/code/defstruct.lisp b/code/defstruct.lisp index e292772ca2034d01b5950145ad41ca651cf2bc23..aeb086402aaa6564672460b77158a5b2ce20bb69 100644 --- a/code/defstruct.lisp +++ b/code/defstruct.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.91 2003/08/06 19:01:18 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.92 2003/08/08 11:32:52 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -461,7 +461,10 @@ :report "Ignore the lock and continue") (unlock-package () :report "Disable package's lock then continue" - (setf (ext:package-lock pkg) nil)))) + (setf (ext:package-lock pkg) nil)) + (unlock-all () + :report "Unlock all packages, then continue" + (lisp::unlock-all-packages)))) (when (stringp (car slot-descriptions)) (setf (dd-doc defstruct) (pop slot-descriptions))) (dolist (slot slot-descriptions) diff --git a/code/exports.lisp b/code/exports.lisp index cc97655607fd9367480bf01a31e575ef2e690cda..38ac5bd070911a9f051034f0c465be4c068e1896 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.221 2003/08/06 19:00:13 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.222 2003/08/08 11:32:52 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -245,6 +245,7 @@ "UNIX-RMDIR" "UNIX-SCHED-YIELD" "UNIX-SELECT" "UNIX-SEND" "UNIX-SETPGID" "UNIX-SETPGRP" "UNIX-SETREGID" "UNIX-SETREUID" "UNIX-SETSOCKOPT" "UNIX-SOCKET" + "UNIX-SETUID" "UNIX-SETGID" "UNIX-STAT" "UNIX-SYMLINK" "UNIX-SYNC" "UNIX-TIMES" "UNIX-TRUNCATE" "UNIX-TTYNAME" "UNIX-UID" "UNIX-UNAME" "UNIX-UNLINK" "UNIX-UTIMES" "UNIX-WRITE" "WINSIZE" @@ -1223,7 +1224,7 @@ "OBJECT-SET-EVENT-HANDLER" "OLD-TRACE" "OLD-UNTRACE" "ONCE-ONLY" "OPEN-CLX-DISPLAY" "OPTIMIZE-INTERFACE" "PACKAGE-CHILDREN" "PACKAGE-PARENT" "PARSE-TIME" - "PACKAGE-LOCK" "PACKAGE-DEFINITION-LOCK" "WITHOUT-PACKAGE-LOCKS" + "PACKAGE-LOCK" "PACKAGE-DEFINITION-LOCK" "WITHOUT-PACKAGE-LOCKS" "UNLOCK-ALL-PACKAGES" "PRINT-DIRECTORY" "PRINT-HERALD" "PRINT-PRETTY-KEY" "PRINT-PRETTY-KEY-EVENT" "PROCESS-ALIVE-P" "PROCESS-CLOSE" "PROCESS-CORE-DUMPED" "PROCESS-ERROR" "PROCESS-EXIT-CODE" @@ -1590,8 +1591,10 @@ "WHO-REFERENCES" "WHO-BINDS" "WHO-SETS" - #+pcl "WHO-SUBCLASSES" - #+pcl "WHO-SUPERCLASSES" + "WHO-SUBCLASSES" + "WHO-SUPERCLASSES" + "WHO-SPECIALIZES" + "WHO-MACROEXPANDS" "MAKE-XREF-CONTEXT" "XREF-CONTEXT-NAME" "XREF-CONTEXT-FILE" diff --git a/code/macros.lisp b/code/macros.lisp index 3a225d7b0916dbbc4075a814afc663474b06ed2d..df041716d5102b424eb012e2821b5244b5647418 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.96 2003/07/17 17:48:32 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.97 2003/08/08 11:32:52 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -91,7 +91,10 @@ :report "Ignore the lock and continue") (unlock-package () :report "Disable the package's definition-lock then continue" - (setf (ext:package-definition-lock package) nil)))))))) + (setf (ext:package-definition-lock package) nil)) + (unlock-all () + :report "Unlock all packages, then continue" + (lisp::unlock-all-packages)))))))) (let ((whole (gensym "WHOLE-")) (environment (gensym "ENV-"))) (multiple-value-bind @@ -216,7 +219,10 @@ :report "Ignore the lock and continue") (unlock-package () :report "Disable package's definition-lock then continue" - (setf (ext:package-definition-lock (symbol-package name)) nil)))) + (setf (ext:package-definition-lock (symbol-package name)) nil)) + (unlock-all () + :report "Unlock all packages, then continue" + (lisp::unlock-all-packages)))) (let ((whole (gensym "WHOLE-"))) (multiple-value-bind (body local-decs doc) (parse-defmacro arglist whole body name 'deftype @@ -1858,7 +1864,7 @@ (handler-bind ((c::parse-unknown-type #'(lambda (c) (c::note-undefined-reference - (c::parse-unknown-type-specifier c) + (kernel:parse-unknown-type-specifier c) :type)))) (unwind-protect (multiple-value-prog1 diff --git a/code/package.lisp b/code/package.lisp index e1975e1b6bb5823bb3ad9d95be33b7f874b5b121..92e77b86f8ea4dee294be091e212b9f3f7c93ed0 100644 --- a/code/package.lisp +++ b/code/package.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.70 2003/06/18 09:23:10 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.71 2003/08/08 11:32:52 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -28,7 +28,8 @@ (in-package "EXTENSIONS") (export '(*keyword-package* *lisp-package* *default-package-use-list* map-apropos package-children package-parent - package-lock package-definition-lock without-package-locks)) + package-lock package-definition-lock without-package-locks + unlock-all-packages)) (in-package "KERNEL") (export '(%in-package old-in-package %defpackage)) @@ -162,6 +163,12 @@ (pushnew 'package-locks-init ext:*after-save-initializations*) +(defun unlock-all-packages () + (dolist (p (list-all-packages)) + (setf (package-definition-lock p) nil) + (setf (package-lock p) nil))) + + (defmacro without-package-locks (&body body) `(eval-when (:compile-toplevel :load-toplevel :execute) (let ((*enable-package-locked-errors* nil)) @@ -195,8 +202,11 @@ (continue () :report "Ignore the lock and continue") (unlock-package () - :report "Disable package's definition-lock then continue" - (setf (ext:package-definition-lock package) nil))))))))) + :report "Disable package's definition-lock, then continue" + (setf (ext:package-definition-lock package) nil)) + (unlock-all () + :report "Disable all package locks, then continue" + (unlock-all-packages))))))))) ;;; This magical variable is T during initialization so Use-Package's of packages @@ -1299,8 +1309,11 @@ (continue () :report "Ignore the lock and continue") (unlock-package () - :report "Unlock package then continue" - (setf (ext:package-lock package) nil))))) + :report "Unlock package, then continue" + (setf (ext:package-lock package) nil)) + (unlock-all () + :report "Unlock all packages, then continue" + (unlock-all-packages))))) (let ((symbol (make-symbol (subseq name 0 length)))) (%set-symbol-package symbol package) (cond ((eq package *keyword-package*) @@ -1380,7 +1393,10 @@ :report "Ignore the lock and continue") (unlock-package () :report "Disable package's lock then continue" - (setf (ext:package-lock package) nil))))) + (setf (ext:package-lock package) nil)) + (unlock-all () + :report "Unlock all packages, then continue" + (unlock-all-packages))))) ;; ;; If a name conflict is revealed, give use a chance to shadowing-import ;; one of the accessible symbols. @@ -1551,7 +1567,10 @@ :report "Ignore the lock and continue") (unlock-package () :report "Disable package's lock then continue" - (setf (ext:package-lock package) nil))))) + (setf (ext:package-lock package) nil)) + (unlock-all () + :report "Unlock all packages, then continue" + (unlock-all-packages))))) (dolist (sym (symbol-listify symbols)) (multiple-value-bind (s w) (find-symbol (symbol-name sym) package) (cond ((or (not w) (not (eq s sym)))