Update of /project/cxml/cvsroot/cxml/runes In directory common-lisp.net:/tmp/cvs-serv4026/runes Modified Files: encodings-data.lisp encodings.lisp package.lisp xstream.lisp Log Message: encoding-fehler resignalisieren Date: Sun Nov 27 18:19:12 2005 Author: dlichteblau Index: cxml/runes/encodings-data.lisp diff -u cxml/runes/encodings-data.lisp:1.1.1.1 cxml/runes/encodings-data.lisp:1.2 --- cxml/runes/encodings-data.lisp:1.1.1.1 Sun Mar 13 19:02:27 2005 +++ cxml/runes/encodings-data.lisp Sun Nov 27 18:19:12 2005 @@ -1,4 +1,4 @@ -(in-package :encoding) +(in-package :runes-encoding) (progn (add-name :us-ascii "ANSI_X3.4-1968") Index: cxml/runes/encodings.lisp diff -u cxml/runes/encodings.lisp:1.1.1.1 cxml/runes/encodings.lisp:1.2 --- cxml/runes/encodings.lisp:1.1.1.1 Sun Mar 13 19:02:27 2005 +++ cxml/runes/encodings.lisp Sun Nov 27 18:19:12 2005 @@ -1,4 +1,9 @@ -(in-package :encoding) +(in-package :runes-encoding) + +(define-condition encoding-error (simple-error) ()) + +(defun xerror (fmt &rest args) + (error 'encoding-error :format-control fmt :format-arguments args)) ;;;; --------------------------------------------------------------------------- ;;;; Encoding names @@ -115,6 +120,9 @@ (let ((hi (aref in rptr)) (lo (aref in (%+ 1 rptr)))) (setf rptr (%+ 2 rptr)) + ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste + ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere + ;; Haelfte fehlt! (setf (aref out wptr) (logior (ash hi 8) lo)) (setf wptr (%+ 1 wptr)))) (values wptr rptr))) @@ -132,6 +140,9 @@ (let ((lo (aref in (%+ 0 rptr))) (hi (aref in (%+ 1 rptr)))) (setf rptr (%+ 2 rptr)) + ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste + ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere + ;; Haelfte fehlt! (setf (aref out wptr) (logior (ash hi 8) lo)) (setf wptr (%+ 1 wptr)))) (values wptr rptr))) @@ -147,13 +158,9 @@ byte0) (macrolet ((put (x) `((lambda (x) - (cond ((or (<= #xD800 x #xDBFF) - (<= #xDC00 x #xDFFF)) - (error "Encoding UTF-16 in UTF-8? : #x~x." x))) - '(unless (data-char-p x) - (error "#x~x is not a data character." x)) - ;;(fresh-line) - ;;(prin1 x) (princ "-> ") + (when (or (<= #xD800 x #xDBFF) + (<= #xDC00 x #xDFFF)) + (xerror "surrogate encoded in UTF-8: #x~x." x)) (cond ((%> x #xFFFF) (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10)) (aref out (%+ 1 wptr)) (%ior #xDC00 (%and x #x3FF))) @@ -196,7 +203,7 @@ (setf rptr (%+ rptr 1))) ((%<= #|#b10000000|# byte0 #b10111111) - (error "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0) + (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0) (setf rptr (%+ rptr 1))) ((%<= #|#b11000000|# byte0 #b11011111) @@ -260,7 +267,7 @@ (return)))) (t - (error "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) )) + (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) )) (values wptr rptr)) ) (defmethod encoding-p ((object (eql :utf-16-little-endian))) t) @@ -343,5 +350,4 @@ (defun find-charset (name) (or (gethash name *charsets*) - (error "There is no character set named ~S." name))) - + (xerror "There is no character set named ~S." name))) Index: cxml/runes/package.lisp diff -u cxml/runes/package.lisp:1.2 cxml/runes/package.lisp:1.3 --- cxml/runes/package.lisp:1.2 Fri Mar 25 19:16:56 2005 +++ cxml/runes/package.lisp Sun Nov 27 18:19:12 2005 @@ -61,8 +61,9 @@ #:set-to-full-speed #:xstream-name)) -(defpackage :encoding +(defpackage :runes-encoding (:use :cl :runes) (:export + #:encoding-error #:find-encoding #:decode-sequence)) Index: cxml/runes/xstream.lisp diff -u cxml/runes/xstream.lisp:1.2 cxml/runes/xstream.lisp:1.3 --- cxml/runes/xstream.lisp:1.2 Fri Mar 25 19:16:56 2005 +++ cxml/runes/xstream.lisp Sun Nov 27 18:19:12 2005 @@ -1,4 +1,4 @@ -;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: runes; readtable: runes; Encoding: utf-8; -*- +;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*- ;;; --------------------------------------------------------------------------- ;;; Title: Fast streams ;;; Created: 1999-07-17 @@ -66,9 +66,7 @@ ;; (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *fast* '(optimize (speed 3) (safety 0))) - ;;(defparameter *fast* '(optimize (speed 2) (safety 3))) - ) + (defparameter *fast* '(optimize (speed 3) (safety 0)))) ;; Let us first define fast fixnum arithmetric get rid of type ;; checks. (After all we know what we do here). @@ -277,10 +275,14 @@ :end2 (xstream-os-left-end input)) ;; then we take care that the buffer is large enough to carry at ;; least 100 bytes (a random number) + ;; + ;; david: was heisst da random? ich nehme an, dass 100 einfach + ;; ausreichend sein soll, um die laengste utf-8 bytesequenz oder die + ;; beiden utf-16 surrogates zu halten? dann ist 100 ja wohl dicke + ;; ausreichend und koennte in make-xstream ordentlich geprueft werden. + ;; oder was geht hier vor? (unless (>= (length (xstream-os-buffer input)) 100) - (error "You lost") - ;; todo: enlarge buffer - )) + (error "You lost"))) (setf n (read-octets (xstream-os-buffer input) (xstream-os-stream input) m (min (1- (length (xstream-os-buffer input))) @@ -292,7 +294,7 @@ :eof) (t (multiple-value-bind (fnw fnr) - (encoding:decode-sequence + (runes-encoding:decode-sequence (xstream-encoding input) (xstream-os-buffer input) 0 n (xstream-buffer input) 0 (1- (length (xstream-buffer input)))