Merge Teemu Kalvas "several nice fixes to external format restarts"
sbcl-devel 2005-01-07
... not the extra exports, but some different exports instead;
... frob SIMPLE-DECODING-ERROR signature so that the octets
get reported correctly.
directories works correctly. (thanks to Artem V. Andreev)
* build fix: fixed the dependence on *LOAD-PATHNAME* and
*COMPILE-FILE-PATHNAME* being absolute pathnames.
directories works correctly. (thanks to Artem V. Andreev)
* build fix: fixed the dependence on *LOAD-PATHNAME* and
*COMPILE-FILE-PATHNAME* being absolute pathnames.
+ * fixed some bugs related to Unicode integration:
+ ** encoding and decoding errors are now much more robustly
+ handled; it should now be possible to recover even from invalid
+ input or output to the terminal. (thanks to Teemu Kalvas)
* fixed some bugs revealed by Paul Dietz' test suite:
** the FORMATTER-generated functions for ~V[ conditionals require
the correct number of arguments.
* fixed some bugs revealed by Paul Dietz' test suite:
** the FORMATTER-generated functions for ~V[ conditionals require
the correct number of arguments.
;; FIXME: potential SB!EXT exports
"CHARACTER-CODING-ERROR"
"CHARACTER-DECODING-ERROR" "CHARACTER-DECODING-ERROR-OCTETS"
;; FIXME: potential SB!EXT exports
"CHARACTER-CODING-ERROR"
"CHARACTER-DECODING-ERROR" "CHARACTER-DECODING-ERROR-OCTETS"
- "CHARACTER-ENCODING-ERROR" "CHARACTER-ENCODING-ERROR-CHARACTER"
+ "CHARACTER-ENCODING-ERROR" "CHARACTER-ENCODING-ERROR-CODE"
"STREAM-DECODING-ERROR" "STREAM-ENCODING-ERROR"
"STREAM-DECODING-ERROR" "STREAM-ENCODING-ERROR"
+ "ATTEMPT-RESYNC" "FORCE-END-OF-FILE"
;; bootstrapping magic, to make things happen both in
;; the cross-compilation host compiler's environment and
;; bootstrapping magic, to make things happen both in
;; the cross-compilation host compiler's environment and
(define-condition character-coding-error (error) ())
(define-condition character-encoding-error (character-coding-error)
(define-condition character-coding-error (error) ())
(define-condition character-encoding-error (character-coding-error)
- ((character :initarg :character :reader character-encoding-error-character)))
+ ((code :initarg :code :reader character-encoding-error-code)))
(define-condition character-decoding-error (character-coding-error)
((octets :initarg :octets :reader character-decoding-error-octets)))
(define-condition stream-encoding-error (stream-error character-encoding-error)
(define-condition character-decoding-error (character-coding-error)
((octets :initarg :octets :reader character-decoding-error-octets)))
(define-condition stream-encoding-error (stream-error character-encoding-error)
(:report
(lambda (c s)
(let ((stream (stream-error-stream c))
(:report
(lambda (c s)
(let ((stream (stream-error-stream c))
- (character (character-encoding-error-character c)))
+ (code (character-encoding-error-code c)))
(format s "~@<encoding error on stream ~S (~S ~S): ~2I~_~
the character with code ~D cannot be encoded.~@:>"
stream ':external-format (stream-external-format stream)
(format s "~@<encoding error on stream ~S (~S ~S): ~2I~_~
the character with code ~D cannot be encoded.~@:>"
stream ':external-format (stream-external-format stream)
- (char-code character))))))
(define-condition stream-decoding-error (stream-error character-decoding-error)
()
(:report
(define-condition stream-decoding-error (stream-error character-decoding-error)
()
(:report
:format-arguments
(list note-format (list pathname) (strerror errno))))
:format-arguments
(list note-format (list pathname) (strerror errno))))
-(defun stream-decoding-error (stream &rest octets)
+(defun stream-decoding-error (stream octets)
(error 'stream-decoding-error
:stream stream
;; FIXME: dunno how to get at OCTETS currently, or even if
;; that's the right thing to report.
:octets octets))
(error 'stream-decoding-error
:stream stream
;; FIXME: dunno how to get at OCTETS currently, or even if
;; that's the right thing to report.
:octets octets))
-(defun stream-encoding-error (stream character)
+(defun stream-encoding-error (stream code)
(error 'stream-encoding-error
:stream stream
(error 'stream-encoding-error
:stream stream
;;; This is called by the server when we can write to the given file
;;; descriptor. Attempt to write the data again. If it worked, remove
;;; This is called by the server when we can write to the given file
;;; descriptor. Attempt to write the data again. If it worked, remove
(setq size ,bytes)
(input-at-least ,stream-var size)
(setq ,element-var (locally ,@read-forms))))
(setq size ,bytes)
(input-at-least ,stream-var size)
(setq ,element-var (locally ,@read-forms))))
- (stream-decoding-error ,stream-var)))
+ (stream-decoding-error
+ ,stream-var
+ (if size
+ (loop for i from 0 below size
+ collect (sap-ref-8 (fd-stream-ibuf-sap
+ ,stream-var)
+ (+ (fd-stream-ibuf-head
+ ,stream-var)
+ i)))
+ (list (sap-ref-8 (fd-stream-ibuf-sap
+ ,stream-var)
+ (fd-stream-ibuf-head
+ ,stream-var)))))))
(attempt-resync ()
:report (lambda (stream)
(format stream
(attempt-resync ()
:report (lambda (stream)
(format stream
character boundary and continue.~@:>"))
(,resync-function ,stream-var)
(setq ,retry-var t))
character boundary and continue.~@:>"))
(,resync-function ,stream-var)
(setq ,retry-var t))
:report (lambda (stream)
(format stream
"~@<Force an end of file.~@:>"))
:report (lambda (stream)
(format stream
"~@<Force an end of file.~@:>"))
*external-formats*)))))
(defmacro define-external-format/variable-width (external-format out-size-expr
*external-formats*)))))
(defmacro define-external-format/variable-width (external-format out-size-expr
- out-expr in-size-expr in-expr
- resync-expr)
+ out-expr in-size-expr in-expr)
(let* ((name (first external-format))
(out-function (intern (let ((*print-case* :upcase))
(format nil "OUTPUT-BYTES/~A" name))))
(let* ((name (first external-format))
(out-function (intern (let ((*print-case* :upcase))
(format nil "OUTPUT-BYTES/~A" name))))
(sap (fd-stream-ibuf-sap stream)))
(declare (type index head tail))
;; Copy data from stream buffer into user's buffer.
(sap (fd-stream-ibuf-sap stream)))
(declare (type index head tail))
;; Copy data from stream buffer into user's buffer.
((or (= tail head) (= requested total-copied)))
(restart-case
(unless (block character-decode
((or (= tail head) (= requested total-copied)))
(restart-case
(unless (block character-decode
- (let* ((byte (sap-ref-8 sap head))
- (size ,in-size-expr))
+ (let ((byte (sap-ref-8 sap head)))
+ (setq size ,in-size-expr)
(when (> size (- tail head))
(return))
(setf (aref buffer (+ start total-copied))
(when (> size (- tail head))
(return))
(setf (aref buffer (+ start total-copied))
(setf (fd-stream-ibuf-head stream) head)
(if (plusp total-copied)
(return-from ,in-function total-copied)
(setf (fd-stream-ibuf-head stream) head)
(if (plusp total-copied)
(return-from ,in-function total-copied)
- (stream-decoding-error stream)))
+ (stream-decoding-error
+ stream
+ (if size
+ (loop for i from 0 below size
+ collect (sap-ref-8 (fd-stream-ibuf-sap
+ stream)
+ (+ (fd-stream-ibuf-head
+ stream)
+ i)))
+ (list (sap-ref-8 (fd-stream-ibuf-sap stream)
+ (fd-stream-ibuf-head stream)))))))
(attempt-resync ()
:report (lambda (stream)
(format stream
(attempt-resync ()
:report (lambda (stream)
(format stream
character boundary and continue.~@:>"))
(,resync-function stream)
(setf head (fd-stream-ibuf-head stream)))
character boundary and continue.~@:>"))
(,resync-function stream)
(setf head (fd-stream-ibuf-head stream)))
:report (lambda (stream)
(format stream "~@<Force an end of file.~@:>"))
(if eof-error-p
:report (lambda (stream)
(format stream "~@<Force an end of file.~@:>"))
(if eof-error-p
(let ((byte (sap-ref-8 sap head)))
,in-expr))
(defun ,resync-function (stream)
(let ((byte (sap-ref-8 sap head)))
,in-expr))
(defun ,resync-function (stream)
+ (loop (input-at-least stream 1)
+ (incf (fd-stream-ibuf-head stream))
+ (when (block character-decode
+ (let* ((sap (fd-stream-ibuf-sap stream))
+ (head (fd-stream-ibuf-head stream))
+ (byte (sap-ref-8 sap head))
+ (size ,in-size-expr))
+ ,in-expr))
+ (return))))
(setf *external-formats*
(cons '(,external-format ,in-function ,in-char-function ,out-function
,@(mapcar #'(lambda (buffering)
(setf *external-formats*
(cons '(,external-format ,in-function ,in-char-function ,out-function
,@(mapcar #'(lambda (buffering)
(define-external-format (:latin-1 :latin1 :iso-8859-1)
1
(if (>= bits 256)
(define-external-format (:latin-1 :latin1 :iso-8859-1)
1
(if (>= bits 256)
- (stream-encoding-error stream byte)
+ (stream-encoding-error stream bits)
(setf (sap-ref-8 sap tail) bits))
(code-char byte))
(define-external-format (:ascii :us-ascii :ansi_x3.4-1968)
1
(if (>= bits 128)
(setf (sap-ref-8 sap tail) bits))
(code-char byte))
(define-external-format (:ascii :us-ascii :ansi_x3.4-1968)
1
(if (>= bits 128)
- (stream-encoding-error stream byte)
+ (stream-encoding-error stream bits)
(setf (sap-ref-8 sap tail) bits))
(code-char byte))
(setf (sap-ref-8 sap tail) bits))
(code-char byte))
(return-from character-decode))
(dpb byte (byte 3 18)
(dpb byte2 (byte 6 12)
(return-from character-decode))
(dpb byte (byte 3 18)
(dpb byte2 (byte 6 12)
- (dpb byte3 (byte 6 6) byte4)))))))
- (loop (input-at-least stream 1)
- (let ((byte (sap-ref-8 (fd-stream-ibuf-sap stream)
- (fd-stream-ibuf-head stream))))
- (unless (<= #x80 byte #xc1)
- (return)))
- (incf (fd-stream-ibuf-head stream))))
+ (dpb byte3 (byte 6 6) byte4))))))))
\f
;;;; utility functions (misc routines, etc)
\f
;;;; utility functions (misc routines, etc)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)