From 6e9a215f25bd85070870471db0e39d5dca885702 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Wed, 10 Jul 2002 16:16:00 +0000
Subject: [PATCH] From Eric Marsden:

 * (pcl:class-precedence-list (find-class 'null)) should have symbol
   occurring before list, as per CLHS.

 * minor changes to certain error conditions: eg trying to set
   DEFAULT-DIRECTORY to a non-existent directory should raise a
   condition of type FILE-ERROR. (Some of these changes are from
   Alexey Dejneka, via SBCL).

 * cleanup of some Hemlock-related symbols that shouldn't be exported
   when :no-hemlock is defined.
---
 code/array.lisp    |  4 ++--
 code/class.lisp    |  8 ++++----
 code/filesys.lisp  |  6 ++++--
 code/globals.lisp  |  8 ++++----
 code/hash-new.lisp |  9 +++++----
 code/lispinit.lisp | 10 +++++++---
 code/numbers.lisp  |  4 ++--
 code/rand.lisp     | 16 +++++++++++-----
 code/sysmacs.lisp  |  7 ++++++-
 9 files changed, 45 insertions(+), 27 deletions(-)

diff --git a/code/array.lisp b/code/array.lisp
index 986872923..ba7aac762 100644
--- a/code/array.lisp
+++ b/code/array.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/array.lisp,v 1.32 2001/11/21 22:45:36 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.33 2002/07/10 16:15:58 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -547,7 +547,7 @@
 	  (declare (ignore start end))
 	  (array-element-type array)))
        (t
-	(error "~S is not an array." array))))))
+        (error 'type-error :datum array :expected-type 'array))))))
 
 
 (defun array-rank (array)
diff --git a/code/class.lisp b/code/class.lisp
index 416073239..1f7a3d382 100644
--- a/code/class.lisp
+++ b/code/class.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/class.lisp,v 1.47 2001/12/06 23:24:42 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.48 2002/07/10 16:15:58 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -814,9 +814,9 @@
 		:inherits (list sequence mutable-sequence mutable-collection
 			   generic-sequence collection))
 	  (null :translation (member nil)
-		:inherits (list sequence mutable-sequence mutable-collection
-			   generic-sequence collection symbol)
-		:direct-superclasses (list symbol))
+		:inherits (symbol list sequence mutable-sequence mutable-collection
+			   generic-sequence collection)
+		:direct-superclasses (symbol list))
 
 	  (stream :state :read-only :depth 3 :inherits (instance)))))
 
diff --git a/code/filesys.lisp b/code/filesys.lisp
index f5c35b0ed..e7a2f5785 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.66 2002/02/19 15:48:25 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.67 2002/07/10 16:15:58 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1274,7 +1274,9 @@
 (defun %set-default-directory (new-val)
   (let ((namestring (unix-namestring new-val t)))
     (unless namestring
-      (error "~S doesn't exist." new-val))
+      (error 'simple-file-error
+             :format-control "~S doesn't exist."
+             :format-arguments (list new-val)))
     (multiple-value-bind (gr error)
 			 (unix:unix-chdir namestring)
       (if gr
diff --git a/code/globals.lisp b/code/globals.lisp
index 4f4e5591b..569e86578 100644
--- a/code/globals.lisp
+++ b/code/globals.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/globals.lisp,v 1.17 2001/07/08 17:37:54 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/globals.lisp,v 1.18 2002/07/10 16:15:59 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,16 +21,16 @@
 
 (declaim (special *keyword-package* *lisp-package* *package* *query-io*
 		  *terminal-io* *error-output* *trace-output* *debug-io*
-		  *standard-input* *standard-output* *hemlock-version*
+		  *standard-input* *standard-output*
 		  *evalhook* *applyhook* *command-line-switches*
-		  *command-switch-demons* ext::temporary-foreign-files
+		  *command-switch-demons*
 		  *display-event-handlers* original-lisp-environment
 		  *environment-list* *read-default-float-format*
 		  *read-suppress* *readtable* *print-base* *print-radix*
 		  *print-length* *print-level* *print-pretty* *print-escape*
 		  *print-case* *print-circle* *print-gensym* *print-array*
 		  defmacro-error-string defsetf-error-string
-		  std-lisp-readtable hi::*in-the-editor*
+		  std-lisp-readtable #-no-hemlock hi::*in-the-editor*
 		  debug::*in-the-debugger*
 		  conditions::*handler-clusters*
 		  conditions::*restart-clusters*
diff --git a/code/hash-new.lisp b/code/hash-new.lisp
index d4dd000da..e841cfaa9 100644
--- a/code/hash-new.lisp
+++ b/code/hash-new.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/hash-new.lisp,v 1.17 2001/03/30 11:01:56 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.18 2002/07/10 16:15:59 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -217,8 +217,9 @@
 	       (values 'equalp #'equalp #'equalp-hash))
 	      (t
 	       (dolist (info *hash-table-tests*
-			     (error "Unknown :TEST for MAKE-HASH-TABLE: ~S"
-				    test))
+			     (error 'simple-program-error
+                                    :format-control "Unknown :TEST for MAKE-HASH-TABLE: ~S"
+				    :format-arguments (list test)))
 		 (destructuring-bind
 		  (test-name test-fun hash-fun)
 		  info
@@ -230,7 +231,7 @@
 	     (length (if (<= scaled-size 37) 37 (almost-primify scaled-size))))
 	(declare (type index size+1 scaled-size length))
 	(when weak-p
-	  (format *debug-io* "* Creating unsupported weak-p hash table~%"))
+	  (format *debug-io* ";; Creating unsupported weak-p hash table~%"))
 	(let* ((index-vector
 		(make-array length :element-type '(unsigned-byte 32)
 			    :initial-element 0))
diff --git a/code/lispinit.lisp b/code/lispinit.lisp
index fde156949..b9264e7d9 100644
--- a/code/lispinit.lisp
+++ b/code/lispinit.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/lispinit.lisp,v 1.65 2001/07/12 20:10:52 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.66 2002/07/10 16:15:59 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -454,9 +454,13 @@
   be any non-negative, non-complex number."
   (when (or (not (realp n))
 	    (minusp n))
-    (error "Invalid argument to SLEEP: ~S.~%~
+    (error 'simple-type-error
+           :format-control
+           "Invalid argument to SLEEP: ~S.~%~
             Must be a non-negative, non-complex number."
-	   n))
+           :format-arguments (list n)
+           :datum n
+           :expected-type '(real 0)))
   (multiple-value-bind (sec usec)
     (if (integerp n)
 	(values n 0)
diff --git a/code/numbers.lisp b/code/numbers.lisp
index 06275f036..542673cf1 100644
--- a/code/numbers.lisp
+++ b/code/numbers.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/numbers.lisp,v 1.42 2002/06/19 15:08:55 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.43 2002/07/10 16:15:59 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1277,7 +1277,7 @@ significant bit of INTEGER is bit 0."
     (13 (boole 13 integer1 integer2))
     (14 (boole 14 integer1 integer2))
     (15 (boole 15 integer1 integer2))
-    (t (error "~S is not of type (mod 16)." op))))
+    (t (error 'type-error :datum op :expected-type '(mod 16)))))
 
 
 ;;;; GCD, LCM:
diff --git a/code/rand.lisp b/code/rand.lisp
index 80b03fe25..8237509a6 100644
--- a/code/rand.lisp
+++ b/code/rand.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/rand.lisp,v 1.10 1997/06/11 18:32:14 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand.lisp,v 1.11 2002/07/10 16:15:59 toy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -87,7 +87,11 @@
 	((random-state-p state) (copy-state state))
 	((eq state t) (setq rand-seed (get-universal-time))
 		      (make-random-object))
-	(t (error "Argument is not a RANDOM-STATE, T or NIL: ~S" state))))
+	(t (error 'simple-type-error
+                  :expected-type '(or null t (satisfies random-state-p))
+                  :datum state
+                  :format-control "Argument is not a RANDOM-STATE, T or NIL: ~S"
+                  :format-arguments (list state)))))
 
 
 ;;;; Random entries:
@@ -331,9 +335,11 @@
 	((eq state t)
 	 (setq rand-seed (mod (get-universal-time) 900000000))
 	 (make-random-object))
-	(t
-	 (error "Argument is not a RANDOM-STATE, T or NIL: ~S" state))))
-
+	(t (error 'simple-type-error
+                  :expected-type '(or null t (satisfies random-state-p))
+                  :datum state
+                  :format-control "Argument is not a RANDOM-STATE, T or NIL: ~S"
+                  :format-arguments (list state)))))
 
 
 ;;;; Random entries
diff --git a/code/sysmacs.lisp b/code/sysmacs.lisp
index 45e24b992..60c7b5289 100644
--- a/code/sysmacs.lisp
+++ b/code/sysmacs.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/sysmacs.lisp,v 1.24 2000/08/10 13:16:22 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.25 2002/07/10 16:16:00 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -67,6 +67,7 @@
   "Executes the forms in the body without doing a garbage collection."
   `(without-interrupts ,@body))
 
+#-no-hemlock
 (defmacro without-hemlock (&body body)
   `(progn
      (when (and hi::*in-the-editor* (null debug::*in-the-debugger*))
@@ -79,6 +80,10 @@
 		      (hi::window-hunk (hi::current-window)))))
 	 (funcall (hi::device-init device) device)))))
 
+#+no-hemlock
+(defmacro without-hemlock (&body body)
+  `(progn ,@body))
+
 
 
 ;;; Eof-Or-Lose is a useful macro that handles EOF.
-- 
GitLab