diff --git a/code/error.lisp b/code/error.lisp index 351a563fb2145c5a7c173783883be5beccfd86ff..fcb790b80ab50fe6e958cb36d37782f136b3eabb 100644 --- a/code/error.lisp +++ b/code/error.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/error.lisp,v 1.78 2003/10/26 12:48:23 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.79 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1010,6 +1010,7 @@ (define-condition simple-program-error (simple-condition program-error)()) (define-condition simple-parse-error (simple-condition parse-error)()) (define-condition simple-control-error (simple-condition control-error)()) +(define-condition simple-stream-error (simple-condition stream-error) ()) (define-condition simple-file-error (simple-condition file-error) () (:report diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 1b861c8e437b3eec9972852f090e748297996fa5..d49ca57ed04a7a5fea6ff6bb20e868e88420dff8 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.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/fd-stream.lisp,v 1.74 2003/11/05 16:47:18 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.75 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -217,8 +217,10 @@ (cond ((not count) (if (= errno unix:ewouldblock) (output-later stream base start end reuse-sap) - (error "While writing ~S: ~A" - stream (unix:get-unix-error-msg errno)))) + (error 'simple-stream-error + :stream stream + :format-control "while writing: ~A" + :format-arguments (list (unix:get-unix-error-msg errno))))) ((not (eql count length)) (output-later stream base (the index (+ start count)) end reuse-sap))))))) diff --git a/code/serve-event.lisp b/code/serve-event.lisp index ab7d5e1a35e585135eb016071c82a83966ceb29b..e892100b7092077d7adf88d4fcd466004ec816d9 100644 --- a/code/serve-event.lisp +++ b/code/serve-event.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/serve-event.lisp,v 1.25 2000/07/06 05:41:28 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.26 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -200,8 +200,8 @@ ;;; Search *descriptor-handlers* for any reference to fd, and nuke 'em. ;;; (defun invalidate-descriptor (fd) - "Remove any handers refering to fd. This should only be used when attempting - to recover from a detected inconsistancy." + "Remove any handers refering to FD. This should only be used when attempting + to recover from a detected inconsistency." (setf *descriptor-handlers* (delete fd *descriptor-handlers* :key #'handler-descriptor))) @@ -427,15 +427,14 @@ (:output (unix:fd-isset desc write-fds))) (unwind-protect (progn - ;; Doesn't work -- ACK - ;(setf (handler-active handler) t) + (setf (handler-active handler) t) (funcall (handler-function handler) desc)) (setf (handler-active handler) nil)) (ecase (handler-direction handler) (:input (unix:fd-clr desc read-fds)) (:output (unix:fd-clr desc write-fds))) - (setf result t))) - result))) + (setf result t)))) + result)) ); eval-when (compile eval) diff --git a/code/stream.lisp b/code/stream.lisp index 8a80947b3a9fc4603010f3b40dda787c7684d2b7..2fa36ddffb8532fa8bd3a10524ffc11c76b60606 100644 --- a/code/stream.lisp +++ b/code/stream.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/stream.lisp,v 1.67 2004/01/20 17:32:20 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.68 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2014,11 +2014,11 @@ POSITION: an INTEGER greater than or equal to zero, and less than or ;; Just catch some errors earlier than it would be necessary. (cond ((not (open-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open.")) ((not (input-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open for input.")) ((and seq (>= start end) 0)) @@ -2334,11 +2334,11 @@ SEQ: a proper SEQUENCE ;; Just catch some errors earlier than it would be necessary. (cond ((not (open-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open.")) ((not (output-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open for output.")) ((and seq (>= start end)) seq)