X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=9facae75116e51ceaa19b7cdc757de4b3ade2e3a;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=63bb972342afa1a8ec2621be49a2f5d94dbe76cc;hpb=95a6db7329b91dd90d165dd4057b9b5098d34aa2;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 63bb972..9facae7 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -11,7 +11,6 @@
 ;;;; files for more information.
 
 (in-package "SB!INT")
-
 
 ;;;; DO-related stuff which needs to be visible on the cross-compilation host
 
@@ -94,6 +93,37 @@
   (let ((*package* *keyword-package*))
     (apply #'symbolicate things)))
 
+;;; Access *PACKAGE* in a way which lets us recover if someone has
+;;; done something silly like (SETF *PACKAGE* :CL-USER). (Such an
+;;; assignment is undefined behavior, so it's sort of reasonable for it
+;;; to cause the system to go totally insane afterwards, but it's
+;;; a fairly easy mistake to make, so let's try to recover gracefully
+;;; instead.)
+(defun sane-package ()
+  (let ((maybe-package *package*))
+    (cond ((and (packagep maybe-package)
+		;; For good measure, we also catch the problem of
+		;; *PACKAGE* being bound to a deleted package.
+		;; Technically, this is not undefined behavior in itself,
+		;; but it will immediately lead to undefined to behavior,
+		;; since almost any operation on a deleted package is
+		;; undefined.
+		(package-name maybe-package))
+	   maybe-package)
+	  (t
+	   ;; We're in the undefined behavior zone. First, munge the
+	   ;; system back into a defined state.
+	   (let ((really-package (find-package :cl-user)))
+	     (setf *package* really-package)
+	     ;; Then complain.
+	     (error 'simple-type-error
+		    :datum maybe-package
+		    :expected-type 'package
+		    :format-control
+		    "~S can't be a ~S:~%  ~S has been reset to ~S"
+		    :format-arguments (list '*package* (type-of maybe-package)
+					    '*package* really-package)))))))
+
 ;;; Give names to elements of a numeric sequence.
 (defmacro defenum ((&key (prefix "") (suffix "") (start 0) (step 1))
 		   &rest identifiers)