From 89c5e67daff0215420fb0998b8e20915ddea1437 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 7 Jan 2005 14:18:29 +0000 Subject: [PATCH] 0.8.18.17: 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. --- NEWS | 4 +++ package-data-list.lisp-expr | 3 +- src/code/error.lisp | 6 ++-- src/code/fd-stream.lisp | 67 +++++++++++++++++++++++++++++-------------- version.lisp-expr | 2 +- 5 files changed, 55 insertions(+), 27 deletions(-) diff --git a/NEWS b/NEWS index 74a3c78..1190b53 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,10 @@ changes in sbcl-0.8.19 relative to sbcl-0.8.18: 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. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 076bbe4..3fb6d76 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -795,8 +795,9 @@ retained, possibly temporariliy, because it might be used internally." ;; 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" + "ATTEMPT-RESYNC" "FORCE-END-OF-FILE" ;; bootstrapping magic, to make things happen both in ;; the cross-compilation host compiler's environment and diff --git a/src/code/error.lisp b/src/code/error.lisp index a0b0c2b..aae384b 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -89,7 +89,7 @@ (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) @@ -97,11 +97,11 @@ (:report (lambda (c s) (let ((stream (stream-error-stream c)) - (character (character-encoding-error-character c))) + (code (character-encoding-error-code c))) (format s "~@" stream ':external-format (stream-external-format stream) - (char-code character)))))) + code))))) (define-condition stream-decoding-error (stream-error character-decoding-error) () (:report diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 527474d..1f82f56 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -115,16 +115,16 @@ :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)) -(defun stream-encoding-error (stream character) +(defun stream-encoding-error (stream code) (error 'stream-encoding-error :stream stream - :character character)) + :code code)) ;;; 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 @@ -688,7 +688,19 @@ (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 @@ -696,7 +708,7 @@ character boundary and continue.~@:>")) (,resync-function ,stream-var) (setq ,retry-var t)) - (end-of-file () + (force-end-of-file () :report (lambda (stream) (format stream "~@")) @@ -1041,8 +1053,7 @@ *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)))) @@ -1111,12 +1122,12 @@ (sap (fd-stream-ibuf-sap stream))) (declare (type index head tail)) ;; Copy data from stream buffer into user's buffer. - (do () + (do ((size nil nil)) ((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)) @@ -1126,7 +1137,17 @@ (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 @@ -1134,7 +1155,7 @@ character boundary and continue.~@:>")) (,resync-function stream) (setf head (fd-stream-ibuf-head stream))) - (end-of-file () + (force-end-of-file () :report (lambda (stream) (format stream "~@")) (if eof-error-p @@ -1161,7 +1182,15 @@ (let ((byte (sap-ref-8 sap head))) ,in-expr)) (defun ,resync-function (stream) - ,resync-expr) + (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) @@ -1174,14 +1203,14 @@ (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) - (stream-encoding-error stream byte) + (stream-encoding-error stream bits) (setf (sap-ref-8 sap tail) bits)) (code-char byte)) @@ -1260,13 +1289,7 @@ (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)))))))) ;;;; utility functions (misc routines, etc) diff --git a/version.lisp-expr b/version.lisp-expr index 438ceb2..971ce00 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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".) -"0.8.18.16" +"0.8.18.17" -- 1.7.10.4