From ef58fd80b75ca5c35f602f4539b299af27c1eae8 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Thu, 14 Nov 2002 16:54:38 +0000
Subject: [PATCH] From Eric Marsden:

The attached patch contains mostly trivial changes, including a few
spelling corrections, plus changes to the types of condition raised in
various cases. The only significant change, I believe, is

  - MAKE-DISPATCH-MACRO-CHARACTER no longer raises an error if the
    character already was defined to be a macro character; it
    overrides the previous definition (as per a suggestion from Drew
    McDermott on cmucl-help, dated 2002-09-22).
---
 code/byte-interp.lisp   |  4 ++--
 code/class.lisp         |  4 ++--
 code/describe.lisp      |  4 ++--
 code/package.lisp       |  7 +++++--
 code/reader.lisp        | 18 +++++++-----------
 code/signal.lisp        |  8 +-------
 compiler/macros.lisp    |  4 ++--
 compiler/main.lisp      | 18 ++++++++++++------
 compiler/new-assem.lisp |  4 ++--
 9 files changed, 35 insertions(+), 36 deletions(-)

diff --git a/code/byte-interp.lisp b/code/byte-interp.lisp
index 5dee51fa2..eb31b22d4 100644
--- a/code/byte-interp.lisp
+++ b/code/byte-interp.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/byte-interp.lisp,v 1.34 2002/07/29 13:56:22 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.35 2002/11/14 16:54:32 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -299,7 +299,7 @@
 ;;; This macro binds three magic variables.  When the debugger notices that
 ;;; these three variables are bound, it makes a byte-code frame out of the
 ;;; supplied information instead of a compiled frame.  We set each var in
-;;; addition to binding it so the compiler doens't optimize away the binding.
+;;; addition to binding it so the compiler doesn't optimize away the binding.
 ;;;
 (defmacro with-debugger-info ((component pc fp) &body body)
   `(let ((%byte-interp-component ,component)
diff --git a/code/class.lisp b/code/class.lisp
index 3e9a036a8..5aed16efa 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.50 2002/11/13 17:45:34 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.51 2002/11/14 16:54:32 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1185,7 +1185,7 @@
        (cond ((endp free-objs)
 	      (do-hash (obj info obj-info)
 		(unless (zerop (first info))
-		  (error "Topological sort failed due to constrain on ~S."
+		  (error "Topological sort failed due to constraint on ~S."
 			 obj)))
 	      (return (nreverse result)))
 	     ((endp (rest free-objs))
diff --git a/code/describe.lisp b/code/describe.lisp
index 8ea24a58b..25333b921 100644
--- a/code/describe.lisp
+++ b/code/describe.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/describe.lisp,v 1.36 2002/08/20 14:06:13 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.37 2002/11/14 16:54:33 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -395,7 +395,7 @@
 		(sap-int (eval (alien::heap-alien-info-sap-form info)))
 		(alien-internals:unparse-alien-type
 		 (alien::heap-alien-info-type info)))
-	(format t "~@<It's current value is ~3I~:_~S.~:>"
+	(format t "~@<Its current value is ~3I~:_~S.~:>"
 		(eval x))))
      ((eq kind :macro)
       (let ((expansion (info variable macro-expansion x)))
diff --git a/code/package.lisp b/code/package.lisp
index 3963fb0d1..271d2d4a4 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.59 2002/08/23 17:08:53 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.60 2002/11/14 16:54:33 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1091,7 +1091,10 @@
 	 (name (string name))
 	 (found (find-package name)))
     (unless (or (not found) (eq found package))
-      (error "A package named ~S already exists." name))
+      (error 'simple-package-error
+             :package name
+             :format-control "A package named ~S already exists."
+             :format-arguments (list name)))
     (remhash (package-%name package) *package-names*)
     (dolist (n (package-%nicknames package))
       (remhash n *package-names*))
diff --git a/code/reader.lisp b/code/reader.lisp
index 0d3280296..a468e0fcd 100644
--- a/code/reader.lisp
+++ b/code/reader.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/reader.lisp,v 1.32 2002/07/25 14:49:25 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.33 2002/11/14 16:54:35 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1364,13 +1364,9 @@
    flag is set to T, the char will be non-terminating.  Make-dispatch-
    macro-character returns T."
   (set-macro-character char #'read-dispatch-char non-terminating-p rt)
-  (let* ((dalist (dispatch-tables rt))
-	 (dtable (cdr (find char dalist :test #'char= :key #'car))))
-    (cond (dtable
-	   (error "Dispatch character already exists"))
-	  (t
-	   (setf (dispatch-tables rt)
-		 (push (cons char (make-char-dispatch-table)) dalist))))))
+  (let ((dalist (dispatch-tables rt)))
+    (setf (dispatch-tables rt)
+          (push (cons char (make-char-dispatch-table)) dalist))))
 
 (defun set-dispatch-macro-character
        (disp-char sub-char function &optional (rt *readtable*))
@@ -1380,7 +1376,7 @@
   ;;get the dispatch char for macro (error if not there), diddle
   ;;entry for sub-char.
   (when (digit-char-p sub-char)
-    (error "Sub-Char must not be a decimal digit: ~S" sub-char))
+    (simple-program-error "Sub-Char must not be a decimal digit: ~S" sub-char))
   (let* ((sub-char (char-upcase sub-char))
 	 (dpair (find disp-char (dispatch-tables rt)
 		      :test #'char= :key #'car)))
@@ -1388,7 +1384,7 @@
 	(setf (elt (the simple-vector (cdr dpair))
 		   (char-code sub-char))
 	      (coerce function 'function))
-	(error "~S is not a dispatch character." disp-char))))
+	(simple-program-error "~S is not a dispatch character." disp-char))))
 
 (defun get-dispatch-macro-character
        (disp-char sub-char &optional (rt *readtable*))
@@ -1402,7 +1398,7 @@
       (if dpair
 	  (elt (the simple-vector (cdr dpair))
 	       (char-code sub-char))
-	  (error "~S is not a dispatch char." disp-char)))))
+	  (simple-program-error "~S is not a dispatch character." disp-char)))))
 
 (defun read-dispatch-char (stream char)
   ;;read some digits
diff --git a/code/signal.lisp b/code/signal.lisp
index 898f304bc..31873084c 100644
--- a/code/signal.lisp
+++ b/code/signal.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/signal.lisp,v 1.33 2002/09/17 13:59:25 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.34 2002/11/14 16:54:35 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -145,12 +145,6 @@
   #+linux 10 "User defined signal 1")
 (def-unix-signal :SIGUSR2 #-(or hpux svr4 linux) 31 #+(or hpux svr4) 17
   #+linux 12 "User defined signal 2")
-;;; 
-;;; These are Mach Specific
-#+mach
-(def-unix-signal :SIGEMSG 30 "Mach Emergency message")
-#+mach
-(def-unix-signal :SIGMSG 31 "Mach message")
 
 ;;; SVR4 (or Solaris?) specific signals
 #+svr4
diff --git a/compiler/macros.lisp b/compiler/macros.lisp
index dc1827d5d..ec7153059 100644
--- a/compiler/macros.lisp
+++ b/compiler/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/compiler/macros.lisp,v 1.46 2001/03/13 16:52:17 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.47 2002/11/14 16:54:37 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -125,7 +125,7 @@
 ;;;
 (defun special-form-function (&rest stuff)
   (declare (ignore stuff))
-  (error "Can't funcall the SYMBOL-FUNCTION of special forms."))
+  (simple-program-error "Can't funcall the SYMBOL-FUNCTION of special forms."))
 
 ;;; CONVERT-CONDITION-INTO-COMPILER-ERROR  --  Internal
 ;;;
diff --git a/compiler/main.lisp b/compiler/main.lisp
index 65ed8282f..ed861cc60 100644
--- a/compiler/main.lisp
+++ b/compiler/main.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/compiler/main.lisp,v 1.127 2002/08/25 18:56:55 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.128 2002/11/14 16:54:37 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1593,7 +1593,7 @@
         Some object to be placed in the DEBUG-SOURCE-INFO.
   :Byte-Compile {T, NIL, :MAYBE}
         If true, then may compile to interpreted byte code."
-  (declare (type (member :lisp #+nil :dylan) language))
+  (declare (type (member :lisp) language))
   (let ((info (make-stream-source-info stream language))
 	(*backend* *native-backend*))
     (unwind-protect
@@ -1950,9 +1950,12 @@
 
   ;; Check INPUT-FILE
   (when (and (streamp input-file) (not (typep input-file 'file-stream)))
-    (error "The INPUT-FILE parameter is a ~S, which is an invalid value ~@
+    (error 'simple-type-error
+           :datum input-file
+           :expected-type 'file-stream
+           :format-control "The INPUT-FILE parameter is a ~S, which is an invalid value ~@
             to COMPILE-FILE-PATHNAME."
-	   (type-of input-file)))
+	   :format-arguments (list (type-of input-file))))
 
 
   (when (eq output-file t)
@@ -1961,9 +1964,12 @@
   ;; Same checks on OUTPUT-FILE.
   
   (when (and (streamp output-file) (not (typep output-file 'file-stream)))
-    (error "The OUTPUT-FILE parameter is a ~S, which is an invalid value ~@
+    (error 'simple-type-error
+           :datum output-file
+           :expected-type 'file-stream
+           :format-control "The OUTPUT-FILE parameter is a ~S, which is an invalid value ~@
             to COMPILE-FILE-PATHNAME."
-	   (type-of output-file)))
+	   :format-arguments (list (type-of output-file))))
 
   ;; Maybe these are too much.  CLHS says "might".
   (when (wild-pathname-p input-file)
diff --git a/compiler/new-assem.lisp b/compiler/new-assem.lisp
index 23fd366bd..8be49d018 100644
--- a/compiler/new-assem.lisp
+++ b/compiler/new-assem.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/compiler/new-assem.lisp,v 1.31 2002/10/07 14:31:06 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.32 2002/11/14 16:54:38 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -59,7 +59,7 @@
 
 ;;; ASSEMBLY-UNIT-BITS -- Number of bits in the minimum assembly unit,
 ;;; (also refered to as a ``byte'').  Hopefully, different instruction
-;;; sets won't require chainging this.
+;;; sets won't require changing this.
 ;;; 
 (defconstant assembly-unit-bits 8)
 
-- 
GitLab