diff --git a/code/array.lisp b/code/array.lisp index 986872923d6fafaa1533abc9db5fcead5242b834..ba7aac762561b6e6eba2a1959b61992311d89de0 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 4160732399fadc098bad08fd2d7b6918279b2640..1f7a3d3820e74cd2c56c1673ff9232998908412a 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 f5c35b0ede877bfde761db19dc17609a31337286..e7a2f5785f6138ec5e2cb269f57541cb04f3ea48 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 4f4e5591bfe4afd533ef84c68b23dababd4680bd..569e865784d9e151e6f6e6471a803283db3493bd 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 d4dd000dae94e43644c6796ac14145bac1bcaf02..e841cfaa96c29e4affe43941624c0bc41946ee83 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 fde156949a8692a470c7f1c4172645ba23266a6d..b9264e7d93d4ae9bccc00467a1cdfade51fd720c 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 06275f036978da4edc772710c9963d837b809f41..542673cf1cfd56910629058e978e1403b1cb63b6 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 80b03fe250bd65774623d6fc36574caac15979bb..8237509a660330ead50c6f081e107572e48f51a0 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 45e24b9929ff3170f7d3572f6a5e8248182ebdef..60c7b528977be6479c88a7011a307ea42d3f1617 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.