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