Skip to content
Snippets Groups Projects
Commit ef58fd80 authored by toy's avatar toy
Browse files

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).
parent f8f7de2b
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
......@@ -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))
......
......@@ -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)))
......
......@@ -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*))
......
......@@ -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
......
......@@ -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
......
......@@ -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
;;;
......
......@@ -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)
......
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment