flexi-streams-cvs May 2008

flexi-streams-cvs@common-lisp.net

2 participants
61 discussions

[flexi-streams-cvs] r51 - tags/flexi-streams-0.15.3
by eweitz＠common-lisp.net 23 May '08

23 May '08

Author: eweitz Date: Fri May 23 11:00:39 2008 New Revision: 51 Added: tags/flexi-streams-0.15.3/ - copied from r50, trunk/ Log: Tag for reference

1 0

[flexi-streams-cvs] r50 - in trunk: . doc
by eweitz＠common-lisp.net 23 May '08

23 May '08

Author: eweitz Date: Fri May 23 11:00:03 2008 New Revision: 50 Added: trunk/lw-char-stream.lisp Removed: trunk/lw-binary-stream.lisp Modified: trunk/CHANGELOG trunk/doc/index.html trunk/flexi-streams.asd trunk/input.lisp trunk/output.lisp Log: Update to 0.15.3 Modified: trunk/CHANGELOG ============================================================================== --- trunk/CHANGELOG (original) +++ trunk/CHANGELOG Fri May 23 11:00:03 2008 @@ -1,3 +1,16 @@ +Version 0.15.3 +2008-05-23 +Avoid CHANGE-CLASS on LispWorks if possible + +Version 0.15.2 +2008-05-22 +Remove debugging remnants (d'ooh!) + +Version 0.15.1 +2008-05-21 +Direct access to underlying stream in case of binary sequence operations +More tests + Version 0.15.0 2008-05-21 Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner) Modified: trunk/doc/index.html ============================================================================== --- trunk/doc/index.html (original) +++ trunk/doc/index.html Fri May 23 11:00:03 2008 @@ -224,7 +224,7 @@ FLEXI-STREAMS together with this documentation can be downloaded from <a href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The -current version is 0.15.0. +current version is 0.15.3. Before you install FLEXI-STREAMS you first need to install the <a @@ -1060,7 +1060,7 @@ his work on making FLEXI-STREAMS faster. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.108 2008/05/21 11:53:08 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.111 2008/05/23 14:56:47 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: trunk/flexi-streams.asd ============================================================================== --- trunk/flexi-streams.asd (original) +++ trunk/flexi-streams.asd Fri May 23 11:00:03 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.65 2008/05/21 11:53:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.69 2008/05/23 14:56:46 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -35,7 +35,7 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "0.15.0" + :version "0.15.3" :serial t :components ((:file "packages") (:file "mapping") @@ -51,7 +51,7 @@ (:file "decode") (:file "in-memory") (:file "stream") - #+:lispworks (:file "lw-binary-stream") + #+:lispworks (:file "lw-char-stream") (:file "output") (:file "input") (:file "io") Modified: trunk/input.lisp ============================================================================== --- trunk/input.lisp (original) +++ trunk/input.lisp Fri May 23 11:00:03 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.70 2008/05/21 00:18:35 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.75 2008/05/23 14:43:09 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -55,9 +55,8 @@ #+:lispworks (defmethod read-byte* ((flexi-input-stream flexi-input-stream)) - "Reads one byte \(octet) from the underlying stream of -FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not -empty)." + "Reads one byte \(octet) from the underlying \(binary) stream of +FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)." (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) @@ -71,20 +70,14 @@ (return-from read-byte* nil)) (incf position) (or (pop octet-stack) - ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all - ;; bivalent streams in LispWorks - (let* ((buffer (make-array 1 :element-type 'octet)) - (new-position (read-sequence buffer stream))) - (cond ((zerop new-position) - (decf position) nil) - (t (aref buffer 0))))))) + (read-byte stream nil nil) + (progn (decf position) nil)))) #+:lispworks -(defmethod read-byte* ((flexi-input-stream flexi-binary-input-stream)) +(defmethod read-byte* ((flexi-input-stream flexi-char-input-stream)) "Reads one byte \(octet) from the underlying stream of FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty). -Optimized version \(only needed for LispWorks) in case the underlying -stream is binary." +Only used for LispWorks bivalent streams which aren't binary." (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) @@ -98,8 +91,13 @@ (return-from read-byte* nil)) (incf position) (or (pop octet-stack) - (read-byte stream nil nil) - (progn (decf position) nil)))) + ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all + ;; bivalent streams in LispWorks + (let* ((buffer (make-array 1 :element-type 'octet)) + (new-position (read-sequence buffer stream))) + (cond ((zerop new-position) + (decf position) nil) + (t (aref buffer 0))))))) (defmethod stream-clear-input ((flexi-input-stream flexi-input-stream)) "Calls the corresponding method for the underlying input stream @@ -201,7 +199,7 @@ based on the element type of the sequence \(which takes precedence) and the element type of the stream. What you'll really get might also depend on your Lisp. Some of the implementations are more picky than -others - see for example FLEXI-STREAMS-TEST:READ-SEQUENCE-TEST." +others - see for example FLEXI-STREAMS-TEST::SEQUENCE-TEST." (declare #.*standard-optimize-settings*) (declare (fixnum start end)) (with-accessors ((position flexi-stream-position) @@ -213,21 +211,37 @@ (element-type flexi-stream-element-type) (stream flexi-stream-stream)) flexi-input-stream + (when (>= start end) + (return-from stream-read-sequence start)) + (when (or (subtypep (etypecase sequence + (vector (array-element-type sequence)) + (list t)) + 'integer) + (and (not (stringp sequence)) + (type-equal element-type 'octet))) + ;; if binary data is requested, just read from the underlying + ;; stream directly and skip the rest (but flush octet stack + ;; first) + (let ((index start)) + (declare (fixnum index)) + (when octet-stack + (replace sequence octet-stack :start1 start :end1 end) + (let ((octets-flushed (min (length octet-stack) (- end start)))) + (incf index octets-flushed) + (setq octet-stack (nthcdr octets-flushed octet-stack)))) + (setq index (read-sequence sequence stream :start index :end end)) + (when (> index start) + (setq last-char-code nil + last-octet (elt sequence (1- index)))) + (return-from stream-read-sequence index))) (let* (buffer (buffer-pos 0) (buffer-end 0) (index start) - ;; whether we will deliver characters and thus the number - ;; of octets to read might not be equal to the number of - ;; sequence elements to fill - (want-chars-p (or (stringp sequence) - (and (vectorp sequence) - (not (subtypep (array-element-type sequence) 'integer))) - (not (type-equal element-type 'octet)))) ;; whether we will later be able to rewind the stream if ;; needed (to get rid of unused octets in the buffer) - (can-rewind-p (and want-chars-p (maybe-rewind stream 0))) - (factor (if want-chars-p (encoding-factor external-format) 1)) + (can-rewind-p (maybe-rewind stream 0)) + (factor (encoding-factor external-format)) (integer-factor (floor factor)) ;; it's an interesting question whether it makes sense ;; performance-wise to make RESERVE significantly bigger @@ -237,7 +251,7 @@ ((not can-rewind-p) (* 2 integer-factor)) (t (ceiling (* (- factor integer-factor) (- end start))))))) (declare (fixnum buffer-pos buffer-end index integer-factor reserve) - (boolean want-chars-p can-rewind-p)) + (boolean can-rewind-p)) (flet ((compute-fill-amount () "Computes the amount of octets we can savely read into the buffer without violating the stream's bound \(if there is one) and @@ -293,23 +307,17 @@ (unread-char% char flexi-input-stream))) (declare (dynamic-extent (function next-octet) (function unreader))) (let ((*current-unreader* #'unreader)) - (macrolet ((iterate (octetp set-place) + (macrolet ((iterate (set-place) "A very unhygienic macro to implement the actual iteration through the sequence including housekeeping for the -flexi stream. If OCTETP is true, we put octets into the stream, -otherwise characters. SET-PLACE is the place \(using the index INDEX) -used to access the sequence." +flexi stream. SET-PLACE is the place \(using the index INDEX) used to +access the sequence." `(flet ((leave () "This is the function used to abort the LOOP iteration below." (when (> index start) - ;; if something was read at all, - ;; update LAST-OCTET and - ;; LAST-CHAR-CODE accordingly - (setq ,(if octetp 'last-char-code 'last-octet) - nil - ,(if octetp 'last-octet 'last-char-code) - ,(sublis '((index . (1- index))) set-place))) + (setq last-octet nil + last-char-code ,(sublis '((index . (1- index))) set-place))) (return-from stream-read-sequence index))) (loop (when (>= index end) @@ -327,28 +335,15 @@ (push (aref (the (array octet *) buffer) buffer-end) octet-stack))))) (leave)) - (let ((next-thing ,(if octetp - '(next-octet) - '(octets-to-char-code external-format #'next-octet)))) - (unless next-thing (leave)) - (setf ,set-place ,(if octetp 'next-thing '(code-char next-thing))) + (let ((next-char-code (octets-to-char-code external-format #'next-octet))) + (unless next-char-code + (leave)) + (setf ,set-place (code-char next-char-code)) (incf index)))))) (etypecase sequence - (string (iterate nil (char sequence index))) - (array - (let ((array-element-type (array-element-type sequence))) - (cond ((type-equal array-element-type 'octet) - (iterate t (aref (the (array octet *) sequence) index))) - ((or (subtypep array-element-type 'integer) - (type-equal element-type 'octet)) - (iterate t (aref sequence index))) - (t - (iterate nil (aref sequence index)))))) - (list - (cond ((type-equal element-type 'octet) - (iterate t (nth index sequence))) - (t - (iterate nil (nth index sequence))))))))))))) + (string (iterate (char sequence index))) + (array (iterate (aref sequence index))) + (list (iterate (nth index sequence))))))))))) (defmethod stream-unread-char ((stream flexi-input-stream) char) "Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM. Added: trunk/lw-char-stream.lisp ============================================================================== --- (empty file) +++ trunk/lw-char-stream.lisp Fri May 23 11:00:03 2008 @@ -0,0 +1,77 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/lw-char-stream.lisp,v 1.1 2008/05/23 14:43:09 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defclass flexi-char-output-stream (flexi-output-stream) + () + (:documentation "This class is for output streams where the +underlying stream is bivalent but not binary. It exists solely for +the purpose of optimizing output to binary streams on LispWorks. See +WRITE-BYTE*.")) + +(defclass flexi-char-input-stream (flexi-input-stream) + () + (:documentation "This class is for input streams where the +underlying stream is bivalent but not binary. It exists solely for +the purpose of optimizing input to binary streams on LispWorks. See +READ-BYTE*.")) + +(defclass flexi-char-io-stream (flexi-char-input-stream flexi-char-output-stream flexi-io-stream) + () + (:documentation "This class is for bidirectional streams where the +underlying stream is bivalent but not binary. It exists solely for +the purpose of optimizing input and output from/to binary streams on +LispWorks. See READ-BYTE* and WRITE-BYTE*.")) + +(defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs) + "Might change the class of FLEXI-STREAM for optimization purposes. +Only needed for LispWorks." + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) + (with-accessors ((stream flexi-stream-stream)) + flexi-stream + (unless (subtypep (stream-element-type stream) 'octet) + (change-class flexi-stream + (typecase flexi-stream + (flexi-io-stream 'flexi-char-io-stream) + (otherwise 'flexi-char-output-stream)))))) + +(defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs) + "Might change the class of FLEXI-STREAM for optimization purposes. +Only needed for LispWorks." + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) + (with-accessors ((stream flexi-stream-stream)) + flexi-stream + (unless (subtypep (stream-element-type stream) 'octet) + (change-class flexi-stream + (typecase flexi-stream + (flexi-io-stream 'flexi-char-io-stream) + (otherwise 'flexi-char-input-stream)))))) Modified: trunk/output.lisp ============================================================================== --- trunk/output.lisp (original) +++ trunk/output.lisp Fri May 23 11:00:03 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.60 2008/05/21 01:26:43 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.63 2008/05/23 14:43:09 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -44,6 +44,15 @@ #+:lispworks (defmethod write-byte* (byte (flexi-output-stream flexi-output-stream)) (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + flexi-output-stream + (write-byte byte stream))) + +#+:lispworks +(defmethod write-byte* (byte (flexi-output-stream flexi-char-output-stream)) + "This method is only used for LispWorks bivalent streams which +aren't binary." + (declare #.*standard-optimize-settings*) ;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all ;; bivalent streams in LispWorks (4.4.6) (with-accessors ((stream flexi-stream-stream)) @@ -53,15 +62,6 @@ stream) byte)) -#+:lispworks -(defmethod write-byte* (byte (flexi-output-stream flexi-binary-output-stream)) - "Optimized version \(only needed for LispWorks) in case the -underlying stream is binary." - (declare #.*standard-optimize-settings*) - (with-accessors ((stream flexi-stream-stream)) - flexi-output-stream - (write-byte byte stream))) - (defmethod stream-write-char ((stream flexi-output-stream) char) (declare #.*standard-optimize-settings*) (with-accessors ((external-format flexi-stream-external-format)) @@ -142,15 +142,18 @@ (external-format flexi-stream-external-format) (stream flexi-stream-stream)) stream + (when (>= start end) + (return-from stream-write-sequence sequence)) + (when (and (vectorp sequence) + (subtypep (array-element-type sequence) 'integer)) + ;; if this is pure binary output, just send all the stuff to the + ;; underlying stream directly and skip the rest + (setq column nil) + (return-from stream-write-sequence + (write-sequence sequence stream :start start :end end))) (let* ((octet-seen-p nil) (buffer-pos 0) - ;; whether we might receive characters and thus the number - ;; of octets to output might not be equal to the number of - ;; sequence elements to write - (chars-p (or (listp sequence) - (and (vectorp sequence) - (not (subtypep (array-element-type sequence) 'integer))))) - (factor (if chars-p (encoding-factor external-format) 1)) + (factor (encoding-factor external-format)) (buffer-size (min +buffer-size+ (ceiling (* factor (- end start))))) (buffer (make-octet-buffer buffer-size))) (declare (fixnum buffer-pos buffer-size) @@ -178,28 +181,20 @@ (write-octet object)) (character (write-character object))))) (declare (dynamic-extent (function write-octet))) - (macrolet ((iterate (octets-p output-form) + (macrolet ((iterate (output-form) "An unhygienic macro to implement the actual iteration through SEQUENCE. OUTPUT-FORM is the form to retrieve one -sequence element and put its octet representation into the buffer. -OCTETS-P is true if we know in advance that we will send octets." - `(progn - ,@(if octets-p '((setq octet-seen-p t))) - (loop for index of-type fixnum from start below end - do ,output-form - finally (when (plusp buffer-pos) - (flush-buffer)))))) +sequence element and put its octet representation into the buffer." + `(loop for index of-type fixnum from start below end + do ,output-form + finally (when (plusp buffer-pos) + (flush-buffer))))) (etypecase sequence - (string (iterate nil (write-character (char sequence index)))) - (array - (let ((array-element-type (array-element-type sequence))) - (cond ((type-equal array-element-type 'octet) - (iterate t (write-octet (aref (the (array octet *) sequence) index)))) - ((subtypep array-element-type 'integer) - (iterate t (write-octet (aref sequence index)))) - (t (iterate nil (write-object (aref sequence index))))))) - (list (iterate nil (write-object (nth index sequence))))) - ;; update the column slot, setting if to NIL if we sent octets + (string (iterate (write-character (char sequence index)))) + (array (iterate (write-object (aref sequence index)))) + (list (iterate (write-object (nth index sequence))))) + ;; update the column slot, setting it to NIL if we sent + ;; octets (setq column (cond (octet-seen-p nil) (t (let ((last-newline-pos (position #\Newline sequence @@ -208,8 +203,7 @@ :end end :from-end t))) (cond (last-newline-pos (- end last-newline-pos 1)) - (column (+ column (- end start)))))))))))) - + (column (+ column (- end start)))))))))))) sequence) (defmethod stream-write-string ((stream flexi-output-stream) string

1 0

[flexi-streams-cvs] r49 - branches/edi
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Wed May 21 11:12:49 2008 New Revision: 49 Removed: branches/edi/ Log: Cleanup

1 0

[flexi-streams-cvs] r48 - tags/flexi-streams-0.14.0
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Wed May 21 10:50:48 2008 New Revision: 48 Added: tags/flexi-streams-0.14.0/ - copied from r1, trunk/ Log: Tag for reference

1 0

[flexi-streams-cvs] r47 - tags/flexi-streams-0.15.0
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Wed May 21 10:50:03 2008 New Revision: 47 Added: tags/flexi-streams-0.15.0/ - copied from r46, trunk/ Log: Tag for reference

1 0

[flexi-streams-cvs] r46 - tags
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Wed May 21 10:49:58 2008 New Revision: 46 Added: tags/ Log: Tags dir

1 0

[flexi-streams-cvs] r45 - in trunk: . doc test
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Wed May 21 08:00:42 2008 New Revision: 45 Added: trunk/decode.lisp (contents, props changed) trunk/encode.lisp (contents, props changed) trunk/io.lisp (contents, props changed) trunk/mapping.lisp (contents, props changed) Modified: trunk/CHANGELOG trunk/ascii.lisp trunk/code-pages.lisp trunk/doc/index.html trunk/external-format.lisp trunk/flexi-streams.asd trunk/in-memory.lisp trunk/input.lisp trunk/iso-8859.lisp trunk/koi8-r.lisp trunk/lw-binary-stream.lisp trunk/output.lisp trunk/packages.lisp trunk/specials.lisp trunk/stream.lisp trunk/strings.lisp trunk/test/packages.lisp trunk/test/test.lisp trunk/util.lisp Log: Version 0.15.0, update from branch Modified: trunk/CHANGELOG ============================================================================== --- trunk/CHANGELOG (original) +++ trunk/CHANGELOG Wed May 21 08:00:42 2008 @@ -1,3 +1,7 @@ +Version 0.15.0 +2008-05-21 +Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner) + Version 0.14.0 2007-12-30 Some fixes for LispWorks (when the underlying stream is a character stream) Modified: trunk/ascii.lisp ============================================================================== --- trunk/ascii.lisp (original) +++ trunk/ascii.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.7 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.9 2008/05/18 21:32:15 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -29,7 +29,8 @@ (in-package :flexi-streams) -(defvar +ascii-table+ - #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533) +(defconstant +ascii-table+ + ;; currently not used, but we leave it in here just in case... + (make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533)) "An array enumerating the character codes for the US-ASCII encoding.") Modified: trunk/code-pages.lisp ============================================================================== --- trunk/code-pages.lisp (original) +++ trunk/code-pages.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.5 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.7 2008/05/18 21:32:15 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -31,32 +31,32 @@ ;;; the following code was auto-generated with LWW -(defvar +code-page-tables+ - '((437 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (720 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 233 226 132 224 134 231 234 235 232 239 238 141 142 143 144 1617 1618 244 164 1600 251 249 1569 1570 1571 1572 163 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1590 1591 1592 1593 1594 1601 181 1602 1603 1604 1605 1606 1607 1608 1609 1610 8801 1611 1612 1613 1614 1615 1616 8776 176 8729 183 8730 8319 178 9632 160)) - (737 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 931 932 933 934 935 936 937 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 965 966 967 968 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 969 940 941 942 970 943 972 973 971 974 902 904 905 906 908 910 911 177 8805 8804 938 939 247 8776 176 8729 183 8730 8319 178 9632 160)) - (775 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 262 252 233 257 228 291 229 263 322 275 342 343 299 377 196 197 201 230 198 333 246 290 162 346 347 214 220 248 163 216 215 164 256 298 243 379 380 378 8221 166 169 174 172 189 188 321 171 187 9617 9618 9619 9474 9508 260 268 280 278 9571 9553 9559 9565 302 352 9488 9492 9524 9516 9500 9472 9532 370 362 9562 9556 9577 9574 9568 9552 9580 381 261 269 281 279 303 353 371 363 382 9496 9484 9608 9604 9612 9616 9600 211 223 332 323 245 213 181 324 310 311 315 316 326 274 325 8217 173 177 8220 190 182 167 247 8222 176 8729 183 185 179 178 9632 160)) - (850 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 215 402 225 237 243 250 241 209 170 186 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 240 208 202 203 200 305 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 254 222 218 219 217 253 221 175 180 173 177 8215 190 182 167 247 184 176 168 183 185 179 178 9632 160)) - (852 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 367 263 231 322 235 336 337 238 377 196 262 201 313 314 244 246 317 318 346 347 214 220 356 357 321 215 269 225 237 243 250 260 261 381 382 280 281 172 378 268 351 171 187 9617 9618 9619 9474 9508 193 194 282 350 9571 9553 9559 9565 379 380 9488 9492 9524 9516 9500 9472 9532 258 259 9562 9556 9577 9574 9568 9552 9580 164 273 272 270 203 271 327 205 206 283 9496 9484 9608 9604 354 366 9600 211 223 212 323 324 328 352 353 340 218 341 368 253 221 355 180 173 733 731 711 728 167 247 184 176 168 729 369 344 345 9632 160)) - (855 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1106 1026 1107 1027 1105 1025 1108 1028 1109 1029 1110 1030 1111 1031 1112 1032 1113 1033 1114 1034 1115 1035 1116 1036 1118 1038 1119 1039 1102 1070 1098 1066 1072 1040 1073 1041 1094 1062 1076 1044 1077 1045 1092 1060 1075 1043 171 187 9617 9618 9619 9474 9508 1093 1061 1080 1048 9571 9553 9559 9565 1081 1049 9488 9492 9524 9516 9500 9472 9532 1082 1050 9562 9556 9577 9574 9568 9552 9580 164 1083 1051 1084 1052 1085 1053 1086 1054 1087 9496 9484 9608 9604 1055 1103 9600 1071 1088 1056 1089 1057 1090 1058 1091 1059 1078 1046 1074 1042 1100 1068 8470 173 1099 1067 1079 1047 1096 1064 1101 1069 1097 1065 1095 1063 167 9632 160)) - (857 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 305 196 197 201 230 198 244 246 242 251 249 304 214 220 248 163 216 350 351 225 237 243 250 241 209 286 287 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 186 170 202 203 200 65533 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 65533 215 218 219 217 236 255 175 180 173 177 65533 190 182 167 247 184 176 168 183 185 179 178 9632 160)) - (860 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 227 224 193 231 234 202 232 205 212 236 195 194 201 192 200 244 245 242 218 249 204 213 220 162 163 217 8359 211 225 237 243 250 241 209 170 186 191 210 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (861 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 208 240 222 196 197 201 230 198 244 246 254 251 221 253 214 220 248 163 216 8359 402 225 237 243 250 193 205 211 218 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (862 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (863 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 194 224 182 231 234 235 232 239 238 8215 192 167 201 200 202 244 203 207 251 249 164 212 220 162 163 217 219 402 166 180 243 250 168 184 179 175 206 8976 172 189 188 190 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (864 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 176 183 8729 8730 9618 9472 9474 9532 9508 9516 9500 9524 9488 9484 9492 9496 946 8734 966 177 189 188 8776 171 187 65271 65272 155 156 65275 65276 159 160 173 65154 163 164 65156 65533 65533 65166 65167 65173 65177 1548 65181 65185 65189 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 65233 1563 65201 65205 65209 1567 162 65152 65153 65155 65157 65226 65163 65165 65169 65171 65175 65179 65183 65187 65191 65193 65195 65197 65199 65203 65207 65211 65215 65217 65221 65227 65231 166 172 247 215 65225 1600 65235 65239 65243 65247 65251 65255 65259 65261 65263 65267 65213 65228 65230 65229 65249 65149 1617 65253 65257 65260 65264 65266 65232 65237 65269 65270 65245 65241 65265 9632 65533)) - (865 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 164 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)) - (866 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1025 1105 1028 1108 1031 1111 1038 1118 176 8729 183 8730 8470 164 9632 160)) - (869 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 902 135 183 172 166 8216 8217 904 8213 905 906 938 908 147 148 910 939 169 911 178 179 940 163 941 942 943 970 912 972 973 913 914 915 916 917 918 919 189 920 921 171 187 9617 9618 9619 9474 9508 922 923 924 925 9571 9553 9559 9565 926 927 9488 9492 9524 9516 9500 9472 9532 928 929 9562 9556 9577 9574 9568 9552 9580 931 932 933 934 935 936 937 945 946 947 9496 9484 9608 9604 948 949 9600 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 900 173 177 965 966 967 167 968 901 176 168 969 971 944 974 9632 160)) - (1250 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 352 8249 346 356 381 377 144 8216 8217 8220 8221 8226 8211 8212 152 8482 353 8250 347 357 382 378 160 711 728 321 164 260 166 167 168 169 350 171 172 173 174 379 176 177 731 322 180 181 182 183 184 261 351 187 317 733 318 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729)) - (1251 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1026 1027 8218 1107 8222 8230 8224 8225 8364 8240 1033 8249 1034 1036 1035 1039 1106 8216 8217 8220 8221 8226 8211 8212 152 8482 1113 8250 1114 1116 1115 1119 160 1038 1118 1032 164 1168 166 167 1025 169 1028 171 172 173 174 1031 176 177 1030 1110 1169 181 182 183 1105 8470 1108 187 1112 1029 1109 1111 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103)) - (1252 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 381 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 382 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) - (1253 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 136 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 157 158 159 160 901 902 163 164 165 166 167 168 169 65533 171 172 173 174 8213 176 177 178 179 900 181 182 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533)) - (1254 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255)) - (1255 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 156 157 158 159 160 161 162 163 8362 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 191 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1520 1521 1522 1523 1524 65533 65533 65533 65533 65533 65533 65533 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533)) - (1256 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 1662 8218 402 8222 8230 8224 8225 710 8240 1657 8249 338 1670 1688 1672 1711 8216 8217 8220 8221 8226 8211 8212 1705 8482 1681 8250 339 8204 8205 1722 160 1548 162 163 164 165 166 167 168 169 1726 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 1563 187 188 189 190 1567 1729 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 215 1591 1592 1593 1594 1600 1601 1602 1603 224 1604 226 1605 1606 1607 1608 231 232 233 234 235 1609 1610 238 239 1611 1612 1613 1614 244 1615 1616 247 1617 249 1618 251 252 8206 8207 1746)) - (1257 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 138 8249 140 168 711 184 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 175 731 159 160 65533 162 163 164 65533 166 167 216 169 342 171 172 173 174 198 176 177 178 179 180 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 729)) - (1258 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 258 196 197 198 199 200 201 202 203 768 205 206 207 272 209 777 211 212 416 214 215 216 217 218 219 220 431 771 223 224 225 226 259 228 229 230 231 232 233 234 235 769 237 238 239 273 241 803 243 244 417 246 247 248 249 250 251 252 432 8363 255))) +(defconstant +code-page-tables+ + `((437 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (720 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 233 226 132 224 134 231 234 235 232 239 238 141 142 143 144 1617 1618 244 164 1600 251 249 1569 1570 1571 1572 163 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1590 1591 1592 1593 1594 1601 181 1602 1603 1604 1605 1606 1607 1608 1609 1610 8801 1611 1612 1613 1614 1615 1616 8776 176 8729 183 8730 8319 178 9632 160))) + (737 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 931 932 933 934 935 936 937 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 965 966 967 968 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 969 940 941 942 970 943 972 973 971 974 902 904 905 906 908 910 911 177 8805 8804 938 939 247 8776 176 8729 183 8730 8319 178 9632 160))) + (775 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 262 252 233 257 228 291 229 263 322 275 342 343 299 377 196 197 201 230 198 333 246 290 162 346 347 214 220 248 163 216 215 164 256 298 243 379 380 378 8221 166 169 174 172 189 188 321 171 187 9617 9618 9619 9474 9508 260 268 280 278 9571 9553 9559 9565 302 352 9488 9492 9524 9516 9500 9472 9532 370 362 9562 9556 9577 9574 9568 9552 9580 381 261 269 281 279 303 353 371 363 382 9496 9484 9608 9604 9612 9616 9600 211 223 332 323 245 213 181 324 310 311 315 316 326 274 325 8217 173 177 8220 190 182 167 247 8222 176 8729 183 185 179 178 9632 160))) + (850 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 215 402 225 237 243 250 241 209 170 186 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 240 208 202 203 200 305 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 254 222 218 219 217 253 221 175 180 173 177 8215 190 182 167 247 184 176 168 183 185 179 178 9632 160))) + (852 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 367 263 231 322 235 336 337 238 377 196 262 201 313 314 244 246 317 318 346 347 214 220 356 357 321 215 269 225 237 243 250 260 261 381 382 280 281 172 378 268 351 171 187 9617 9618 9619 9474 9508 193 194 282 350 9571 9553 9559 9565 379 380 9488 9492 9524 9516 9500 9472 9532 258 259 9562 9556 9577 9574 9568 9552 9580 164 273 272 270 203 271 327 205 206 283 9496 9484 9608 9604 354 366 9600 211 223 212 323 324 328 352 353 340 218 341 368 253 221 355 180 173 733 731 711 728 167 247 184 176 168 729 369 344 345 9632 160))) + (855 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1106 1026 1107 1027 1105 1025 1108 1028 1109 1029 1110 1030 1111 1031 1112 1032 1113 1033 1114 1034 1115 1035 1116 1036 1118 1038 1119 1039 1102 1070 1098 1066 1072 1040 1073 1041 1094 1062 1076 1044 1077 1045 1092 1060 1075 1043 171 187 9617 9618 9619 9474 9508 1093 1061 1080 1048 9571 9553 9559 9565 1081 1049 9488 9492 9524 9516 9500 9472 9532 1082 1050 9562 9556 9577 9574 9568 9552 9580 164 1083 1051 1084 1052 1085 1053 1086 1054 1087 9496 9484 9608 9604 1055 1103 9600 1071 1088 1056 1089 1057 1090 1058 1091 1059 1078 1046 1074 1042 1100 1068 8470 173 1099 1067 1079 1047 1096 1064 1101 1069 1097 1065 1095 1063 167 9632 160))) + (857 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 305 196 197 201 230 198 244 246 242 251 249 304 214 220 248 163 216 350 351 225 237 243 250 241 209 286 287 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 186 170 202 203 200 65533 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 65533 215 218 219 217 236 255 175 180 173 177 65533 190 182 167 247 184 176 168 183 185 179 178 9632 160))) + (860 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 227 224 193 231 234 202 232 205 212 236 195 194 201 192 200 244 245 242 218 249 204 213 220 162 163 217 8359 211 225 237 243 250 241 209 170 186 191 210 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (861 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 208 240 222 196 197 201 230 198 244 246 254 251 221 253 214 220 248 163 216 8359 402 225 237 243 250 193 205 211 218 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (862 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (863 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 194 224 182 231 234 235 232 239 238 8215 192 167 201 200 202 244 203 207 251 249 164 212 220 162 163 217 219 402 166 180 243 250 168 184 179 175 206 8976 172 189 188 190 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (864 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 176 183 8729 8730 9618 9472 9474 9532 9508 9516 9500 9524 9488 9484 9492 9496 946 8734 966 177 189 188 8776 171 187 65271 65272 155 156 65275 65276 159 160 173 65154 163 164 65156 65533 65533 65166 65167 65173 65177 1548 65181 65185 65189 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 65233 1563 65201 65205 65209 1567 162 65152 65153 65155 65157 65226 65163 65165 65169 65171 65175 65179 65183 65187 65191 65193 65195 65197 65199 65203 65207 65211 65215 65217 65221 65227 65231 166 172 247 215 65225 1600 65235 65239 65243 65247 65251 65255 65259 65261 65263 65267 65213 65228 65230 65229 65249 65149 1617 65253 65257 65260 65264 65266 65232 65237 65269 65270 65245 65241 65265 9632 65533))) + (865 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 164 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160))) + (866 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1025 1105 1028 1108 1031 1111 1038 1118 176 8729 183 8730 8470 164 9632 160))) + (869 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 902 135 183 172 166 8216 8217 904 8213 905 906 938 908 147 148 910 939 169 911 178 179 940 163 941 942 943 970 912 972 973 913 914 915 916 917 918 919 189 920 921 171 187 9617 9618 9619 9474 9508 922 923 924 925 9571 9553 9559 9565 926 927 9488 9492 9524 9516 9500 9472 9532 928 929 9562 9556 9577 9574 9568 9552 9580 931 932 933 934 935 936 937 945 946 947 9496 9484 9608 9604 948 949 9600 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 900 173 177 965 966 967 167 968 901 176 168 969 971 944 974 9632 160))) + (1250 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 352 8249 346 356 381 377 144 8216 8217 8220 8221 8226 8211 8212 152 8482 353 8250 347 357 382 378 160 711 728 321 164 260 166 167 168 169 350 171 172 173 174 379 176 177 731 322 180 181 182 183 184 261 351 187 317 733 318 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729))) + (1251 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1026 1027 8218 1107 8222 8230 8224 8225 8364 8240 1033 8249 1034 1036 1035 1039 1106 8216 8217 8220 8221 8226 8211 8212 152 8482 1113 8250 1114 1116 1115 1119 160 1038 1118 1032 164 1168 166 167 1025 169 1028 171 172 173 174 1031 176 177 1030 1110 1169 181 182 183 1105 8470 1108 187 1112 1029 1109 1111 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103))) + (1252 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 381 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 382 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))) + (1253 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 136 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 157 158 159 160 901 902 163 164 165 166 167 168 169 65533 171 172 173 174 8213 176 177 178 179 900 181 182 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533))) + (1254 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255))) + (1255 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 156 157 158 159 160 161 162 163 8362 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 191 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1520 1521 1522 1523 1524 65533 65533 65533 65533 65533 65533 65533 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533))) + (1256 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 1662 8218 402 8222 8230 8224 8225 710 8240 1657 8249 338 1670 1688 1672 1711 8216 8217 8220 8221 8226 8211 8212 1705 8482 1681 8250 339 8204 8205 1722 160 1548 162 163 164 165 166 167 168 169 1726 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 1563 187 188 189 190 1567 1729 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 215 1591 1592 1593 1594 1600 1601 1602 1603 224 1604 226 1605 1606 1607 1608 231 232 233 234 235 1609 1610 238 239 1611 1612 1613 1614 244 1615 1616 247 1617 249 1618 251 252 8206 8207 1746))) + (1257 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 138 8249 140 168 711 184 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 175 731 159 160 65533 162 163 164 65533 166 167 216 169 342 171 172 173 174 198 176 177 178 179 180 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 729))) + (1258 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 258 196 197 198 199 200 201 202 203 768 205 206 207 272 209 777 211 212 416 214 215 216 217 218 219 220 431 771 223 224 225 226 259 228 229 230 231 232 233 234 235 769 237 238 239 273 241 803 243 244 417 246 247 248 249 250 251 252 432 8363 255)))) "A list of 8-bit Windows code pages where each element is a cons with the car being the ID of the code page and the cdr being a vector enumerating the corresponding character codes.") Added: trunk/decode.lisp ============================================================================== --- (empty file) +++ trunk/decode.lisp Wed May 21 08:00:42 2008 @@ -0,0 +1,266 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.16 2008/05/20 23:01:50 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defun recover-from-encoding-error (external-format format-control &rest format-args) + "Helper function used by OCTETS-TO-CHAR-CODE below to deal with +encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and returns +its character code in this case. Otherwise signals an +EXTERNAL-FORMAT-ENCODING-ERROR as determined by the arguments to this +function and provides a corresponding USE-VALUE restart." + (when *substitution-char* + (return-from recover-from-encoding-error (char-code *substitution-char*))) + (restart-case + (apply #'signal-encoding-error external-format format-control format-args) + (use-value (char) + :report "Specify a character to be used instead." + :interactive (lambda () + (loop + (format *query-io* "Type a character: ") + (let ((line (read-line *query-io*))) + (when (= 1 (length line)) + (return (list (char line 0))))))) + (char-code char)))) + +(defgeneric octets-to-char-code (format reader) + (declare #.*standard-optimize-settings*) + (:documentation "Converts a sequence of octets to a character code +\(which is returned, or NIL in case of EOF) using the external format +FORMAT. The sequence is obtained by calling the function \(which must +be a functional object) READER with no arguments which should return +one octet per call. In the case of EOF, READER should return NIL. + +The special variable *CURRENT-UNREADER* must be bound correctly +whenever this function is called.")) + +(defmethod octets-to-char-code ((format flexi-latin-1-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (funcall reader)) + +(defmethod octets-to-char-code ((format flexi-ascii-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (when-let (octet (funcall reader)) + (if (> (the octet octet) 127) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) + octet))) + +(defmethod octets-to-char-code ((format flexi-8-bit-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (with-accessors ((decoding-table external-format-decoding-table)) + format + (when-let (octet (funcall reader)) + (let ((char-code (aref (the (simple-array char-code-integer *) decoding-table) + (the octet octet)))) + (if (or (null char-code) + (= (the char-code-integer char-code) 65533)) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) + char-code))))) + +(defmethod octets-to-char-code ((format flexi-utf-8-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (let (first-octet-seen) + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error format + "End of data while in UTF-8 sequence."))) + (t (return-from octets-to-char-code nil)))) + (setq first-octet-seen t)))) + (let ((octet (read-next-byte))) + (declare (type octet octet)) + (multiple-value-bind (start count) + (cond ((not (logbitp 7 octet)) + (values octet 0)) + ((= #b11000000 (logand octet #b11100000)) + (values (logand octet #b00011111) 1)) + ((= #b11100000 (logand octet #b11110000)) + (values (logand octet #b00001111) 2)) + ((= #b11110000 (logand octet #b11111000)) + (values (logand octet #b00000111) 3)) + ((= #b11111000 (logand octet #b11111100)) + (values (logand octet #b00000011) 4)) + ((= #b11111100 (logand octet #b11111110)) + (values (logand octet #b00000001) 5)) + (t (return-from octets-to-char-code + (recover-from-encoding-error format + "Unexpected value #x~X at start of UTF-8 sequence." + octet)))) + (declare (fixnum count)) + ;; note that we currently don't check for "overlong" + ;; sequences or other illegal values + (loop for result of-type code-point + = start then (+ (ash result 6) + (logand octet #b111111)) + repeat count + for octet of-type octet = (read-next-byte) + unless (= #b10000000 (logand octet #b11000000)) + do (return-from octets-to-char-code + (recover-from-encoding-error format + "Unexpected value #x~X in UTF-8 sequence." octet)) + finally (return result))))))) + +(defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (let (first-octet-seen) + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error format + "End of data while in UTF-16 sequence."))) + (t (return-from octets-to-char-code nil)))) + (setq first-octet-seen t)))) + (flet ((read-next-word () + (+ (the octet (read-next-byte)) + (ash (the octet (read-next-byte)) 8)))) + (declare (inline read-next-word)) + (let ((word (read-next-word))) + (declare (type (unsigned-byte 16) word)) + (cond ((<= #xd800 word #xdfff) + (let ((next-word (read-next-word))) + (declare (type (unsigned-byte 16) next-word)) + (unless (<= #xdc00 next-word #xdfff) + (return-from octets-to-char-code + (recover-from-encoding-error format + "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) + (+ (ash (logand #b1111111111 word) 10) + (logand #b1111111111 next-word) + #x10000))) + (t word))))))) + +(defmethod octets-to-char-code ((format flexi-utf-16-be-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (let (first-octet-seen) + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error format + "End of data while in UTF-16 sequence."))) + (t (return-from octets-to-char-code nil)))) + (setq first-octet-seen t)))) + (flet ((read-next-word () + (+ (ash (the octet (read-next-byte)) 8) + (the octet (read-next-byte))))) + (declare (inline read-next-word)) + (let ((word (read-next-word))) + (declare (type (unsigned-byte 16) word)) + (cond ((<= #xd800 word #xdfff) + (let ((next-word (read-next-word))) + (declare (type (unsigned-byte 16) next-word)) + (unless (<= #xdc00 next-word #xdfff) + (return-from octets-to-char-code + (recover-from-encoding-error format + "Unexpected UTF-16 word #x~X following #x~X." + next-word word))) + (+ (ash (logand #b1111111111 word) 10) + (logand #b1111111111 next-word) + #x10000))) + (t word))))))) + +(defmethod octets-to-char-code ((format flexi-utf-32-le-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (let (first-octet-seen) + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error format + "End of data while in UTF-32 sequence."))) + (t (return-from octets-to-char-code nil)))) + (setq first-octet-seen t)))) + (loop for count of-type fixnum from 0 to 24 by 8 + for octet of-type octet = (read-next-byte) + sum (ash octet count))))) + +(defmethod octets-to-char-code ((format flexi-utf-32-be-format) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function reader)) + (let (first-octet-seen) + (declare (boolean first-octet-seen)) + (macrolet ((read-next-byte () + '(prog1 + (or (funcall reader) + (cond (first-octet-seen + (return-from octets-to-char-code + (recover-from-encoding-error format + "End of data while in UTF-32 sequence."))) + (t (return-from octets-to-char-code nil)))) + (setq first-octet-seen t)))) + (loop for count of-type fixnum from 24 downto 0 by 8 + for octet of-type octet = (read-next-byte) + sum (ash octet count))))) + +(defmethod octets-to-char-code ((format flexi-cr-mixin) reader) + (declare #.*fixnum-optimize-settings*) + (declare (ignore reader)) + (let ((char-code (call-next-method))) + (case char-code + (#.(char-code #\Return) #.(char-code #\Newline)) + (otherwise char-code)))) + +(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader) + (declare #.*fixnum-optimize-settings*) + (declare (function *current-unreader*)) + (declare (ignore reader)) + (let ((char-code (call-next-method))) + (case char-code + (#.(char-code #\Return) + (let ((next-char-code (call-next-method))) + (case next-char-code + (#.(char-code #\Linefeed) #.(char-code #\Newline)) + ;; we saw a CR but no LF afterwards, but then the data + ;; ended, so we just return #\Return + ((nil) #.(char-code #\Return)) + ;; if the character we peeked at wasn't a + ;; linefeed character we unread its constituents + (otherwise (funcall *current-unreader* (code-char next-char-code)) + char-code)))) + (otherwise char-code)))) + Modified: trunk/doc/index.html ============================================================================== --- trunk/doc/index.html (original) +++ trunk/doc/index.html Wed May 21 08:00:42 2008 @@ -56,7 +56,6 @@ <ol> <li><a href="#example">Example usage</a> <li><a href="#install">Download and installation</a> - <li><a href="#backward-compatibility">Backward compatibility with version 0.10.3 and before</a> <li><a href="#mail">Support and mailing lists</a> <li><a href="#dictionary">The FLEXI-STREAMS dictionary</a> <ol> @@ -70,6 +69,7 @@ <li><a href="#external-format-equal"><code>external-format-equal</code></a> <li><a href="#*default-eol-style*"><code>*default-eol-style*</code></a> <li><a href="#*default-little-endian*"><code>*default-little-endian*</code></a> + <li><a href="#external-format-encoding-error"><code>external-format-encoding-error</code></a> </ol> <li><a href="#flexi-streams">Flexi streams</a> <ol> @@ -89,11 +89,9 @@ <li><a href="#*substitution-char*"><code>*substitution-char*</code></a> <li><a href="#octet"><code>octet</code></a> <li><a href="#flexi-stream-error"><code>flexi-stream-error</code></a> - <li><a href="#flexi-stream-encoding-error"><code>flexi-stream-encoding-error</code></a> + <li><a href="#flexi-stream-out-of-sync-error"><code>flexi-stream-out-of-sync-error</code></a> <li><a href="#flexi-stream-element-type-error"><code>flexi-stream-element-type-error</code></a> <li><a href="#flexi-stream-element-type-error-element-type"><code>flexi-stream-element-type-error-element-type</code></a> - <li><a href="#flexi-stream-position-spec-error"><code>flexi-stream-position-spec-error</code></a> - <li><a href="#flexi-stream-position-spec-error-position-spec"><code>flexi-stream-position-spec-error-position-spec</code></a> </ol> <li><a href="#in-memory">In-memory streams</a> <ol> @@ -110,11 +108,14 @@ <li><a href="#with-output-to-sequence"><code>with-output-to-sequence</code></a> <li><a href="#in-memory-stream-error"><code>in-memory-stream-error</code></a> <li><a href="#in-memory-stream-closed-error"><code>in-memory-stream-closed-error</code></a> + <li><a href="#in-memory-stream-position-spec-error"><code>in-memory-stream-position-spec-error</code></a> + <li><a href="#in-memory-stream-position-spec-error-position-spec"><code>in-memory-stream-position-spec-error-position-spec</code></a> </ol> <li><a href="#strings">Strings</a> <ol> <li><a href="#string-to-octets"><code>string-to-octets</code></a> <li><a href="#octets-to-string"><code>octets-to-string</code></a> + <li><a href="#octet-length"><code>octet-length</code></a> </ol> </ol> <li><a href="#position">File positions</a> @@ -197,7 +198,9 @@ For more examples see the source code -of <a +of +<a href="http://mr-co.de/projects/cl-rfc2047/">CL-RFC2047</a>, +<a href="http://weitz.de/drakma/">Drakma</a>, <a href="http://weitz.de/chunga/">Chunga</a>, or <a href="http://weitz.de/cl-wbxml/">CL-WBXML</a>. @@ -221,7 +224,7 @@ FLEXI-STREAMS together with this documentation can be downloaded from <a href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The -current version is 0.14.0. +current version is 0.15.0. Before you install FLEXI-STREAMS you first need to install the <a @@ -256,27 +259,6 @@ href="http://arcanes.fr.eu.org/~pierre/2007/02/weitz/">http://arcanes.fr.eu.org/~pierre/2007/02/weitz/</a> thanks to Pierre Thierry. - -   -<h3><a name="backward-compatibility" class=none> -Backward compatibility with version 0.10.3 and before</a></h3> - -Two special variables used in flexi-streams 0.10.3 and before were removed - -<code>*PROVIDE-USE-VALUE-RESTART*</code> and <code>*USE-REPLACEMENT-CHAR*</code>. - - -The code now behaves as if -<code>*PROVIDE-USE-VALUE-RESTART*</code> is always <code>T</code>. -Instead of <code>*USE-REPLACEMENT-CHAR*</code>, you can use -<a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> or -invoke -a <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> -restart</a> -when a <a -href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> -is signalled. -   <h3><a name="mail" class=none>Support and mailing lists</a></h3> For questions, bug reports, feature requests, improvements, or patches @@ -489,8 +471,8 @@ CL-USER 5 > (make-external-format :ucs-2be) #<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CRLF :LITTLE-ENDIAN NIL) 2067DBE4> -CL-USER 6 > (make-external-format :ucs-2be :eol-style :br) -#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :BR :LITTLE-ENDIAN NIL) 206B54AC> +CL-USER 6 > (make-external-format :ucs-2be :eol-style :cr) +#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CR :LITTLE-ENDIAN NIL) 206B54AC> </pre> </blockquote> @@ -542,6 +524,32 @@ The default value for the <code>little-endian</code> keyword argument of <a href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>. Its initial value corresponds to the endianess of the platform FLEXI-STREAMS is used on as revealed by the <code>:LITTLE-ENDIAN</code> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/24_ab.htm">feature</a>. </blockquote> + [Condition] + <a class=none name="external-format-error">external-format-error</a> + +<blockquote> +All errors related to <a href="#external-formats">external formats</a> are of this type. +There's a slot for the external format which can be accessed with <a href="#external-format-error-external-format"><code>EXTERNAL-FORMAT-ERROR-EXTERNAL-FORMAT</code></a>. +</blockquote> + + [Reader] + <a class=none name="external-format-error-external-format">external-format-error-external-format condition => external-format</a> + +<blockquote> If <code>condition</code> is of +type <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>, +this function will return the associated external format. Note that +there are errors which happen during the creation of external formats +where this method returns <code>NIL</code>. +</blockquote> + + [Condition] + <a class=none name="external-format-encoding-error">external-format-encoding-error</a> + +<blockquote> +All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> +restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> is a subtype of <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>. +</blockquote> + <h4><a name="flexi-streams" class=none>Flexi streams</a></h4> Flexi streams are the core of the FLEXI-STREAMS library. You @@ -736,7 +744,7 @@ <blockquote> If this value is not NIL, it should be a character which is used (as if by a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> restart</a>) whenever during reading an error of -type <a href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> would have been signalled otherwise. +type <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> would have been signalled otherwise. <pre> CL-USER 1 > (defun foo () @@ -770,7 +778,7 @@ "xy" T -CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#flexi-stream-encoding-error" class=noborder>flexi-stream-encoding-error</a> (lambda (condition) +CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#external-format-encoding-error" class=noborder>external-format-encoding-error</a> (lambda (condition) (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm" class=noborder>use-value</a> #\-)))) (foo)) "--" @@ -798,11 +806,12 @@ </blockquote> [Condition] - <a class=none name="flexi-stream-encoding-error">flexi-stream-encoding-error</a> + <a class=none name="flexi-stream-out-of-sync-error">flexi-stream-out-of-sync-error</a> -<blockquote> -All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> -restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#flexi-encodingstream-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a>. +<blockquote> This can happen if you're trying to write to +an <a href="#flexi-io-stream">IO stream</a> which had prior to that +"looked ahead" while reading and now can't "rewind" to the octet where +you should be. </blockquote> [Condition] @@ -819,26 +828,6 @@ If <code>condition</code> is of type <a href="#flexi-stream-element-type-error"><code>FLEXI-STREAM-ELEMENT-TYPE-ERROR</code></a>, this function will return the offending element type. </blockquote> - [Condition] - <a class=none name="flexi-stream-position-spec-error">flexi-stream-position-spec-error</a> - -<blockquote> Errors of this type are signalled if an erroneous -position spec is used in conjunction -with <a href="#position"><code>FILE-POSITION</code></a>. This is a -subtype -of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a> -and has an additional slot for the position spec which can be accessed -with <a -href="#flexi-stream-position-spec-error-position-spec"><code>FLEXI-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>. -</blockquote> - - [Reader] - <a class=none name="flexi-stream-position-spec-error-position-spec">flexi-stream-position-spec-error-position-spec condition => position-spec</a> - -<blockquote> -If <code>condition</code> is of type <a href="#flexi-stream-position-spec-error"><code>FLEXI-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec. -</blockquote> - <h4><a name="in-memory" class=none>In-memory streams</a></h4> The library also provides in-memory binary streams which are modeled after <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_stg_st.htm">string streams</a> and behave very similar only that they deal with <a href="#octet">octets</a> instead of characters and the underlying data structure is not a string but either a list or a vector. These streams can obviously be used as the underlying streams for <a href="#flexi-streams">flexi streams</a>. @@ -965,6 +954,25 @@ An error of this type is signalled if one tries to read from or write to an <a href="#in-memory">in-memory stream</a> which had already been closed. This is a subtype of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a>. </blockquote> + [Condition] + <a class=none name="in-memory-stream-position-spec-error">in-memory-stream-position-spec-error</a> + +<blockquote> Errors of this type are signalled if an erroneous +position spec is used in conjunction +with <a href="#position"><code>FILE-POSITION</code></a>. This is a +subtype +of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a> +and has an additional slot for the position spec which can be accessed +with <a href="#in-memory-stream-position-spec-error-position-spec"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>. +</blockquote> + + [Reader] + <a class=none name="in-memory-stream-position-spec-error-position-spec">in-memory-stream-position-spec-error-position-spec condition => position-spec</a> + +<blockquote> +If <code>condition</code> is of type <a href="#in-memory-stream-position-spec-error"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec. +</blockquote> + <h4><a name="strings" class=none>Strings</a></h4> This section collects a few convenience functions for strings conversions: @@ -975,29 +983,42 @@ <blockquote> Converts the Lisp string <code>string</code> from <code>start</code> to <code>end</code> to an array of -<a href="#octet">octets</a> corresponding to the <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for +<a href="#octet">octets</a> corresponding to the <a href="#external-formats">external +format</a> designated by <code>external-format</code>. The defaults for <code>start</code> and <code>end</code> -are <code>0</code> and <code>NIL</code> (meaning the length of the -vector). The default for <code>external-format</code> is the -value of -evaluating <code>(<a -href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code> +are <code>0</code> and the length of the string. The default +for <code>external-format</code> is <code>:LATIN1</code>. </blockquote> [Function] - <a class=none name="octets-to-string">octets-to-string vector <tt>&key</tt> external-format start end => string</a> + <a class=none name="octets-to-string">octets-to-string sequence <tt>&key</tt> external-format start end => string</a> + +<blockquote> Converts the Lisp +sequence <code>sequence</code> of <a href="#octet">octets</a> +from <code>start</code> to <code>end</code> to string +using the <a href="#external-formats">external format</a> designated +by <code>external-format</code>. The defaults for +<code>start</code> and <code>end</code> +are <code>0</code> and the length of the sequence. The default +for <code>external-format</code> is <code>:LATIN1</code>. +</blockquote> + + [Function] + <a class=none name="octet-length">octet-length string <tt>&key</tt> external-format start end => length-or-nil</a> + +<blockquote> -<blockquote> Converts the Lisp vector <code>vector</code> -of <a href="#octet">octets</a> from <code>start</code> -to <code>end</code> to string using -the <a href="#external-formats">external -format</a> <code>external-format</code>. The defaults for +Returns the length of the substring of <code>string</code> from <code>start</code> to <code>end</code> in +<a href="#octet">octets</a> if encoded using +the <a href="#external-formats">external format</a> designated +by <code>external-format</code>. Might return <code>NIL</code> +if there's no efficient way to compute the length without iterating +through the whole string. +The defaults for <code>start</code> and <code>end</code> -are <code>0</code> and the length of the vector. The default -for <code>external-format</code> is the value of -evaluating <code>(<a -href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code> +are <code>0</code> and the length of the sequence. The default +for <code>external-format</code> is <code>:LATIN1</code>. </blockquote>   <h3><a class=none name="position">File positions</a></h3> @@ -1034,10 +1055,12 @@ Thanks to David Lichteblau for numerous portability patches. Thanks to Igor Plekhov for the KOI8-R code. Thanks to Anton Vodonosov for -numerous patches and additions. +numerous patches and additions. Thanks +to <a href="http://netzhansa.blogspot.com/">Hans Hübner</a> for +his work on making FLEXI-STREAMS faster. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.98 2007/12/29 23:15:27 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.108 2008/05/21 11:53:08 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Added: trunk/encode.lisp ============================================================================== --- (empty file) +++ trunk/encode.lisp Wed May 21 08:00:42 2008 @@ -0,0 +1,159 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.12 2008/05/20 23:01:50 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defgeneric char-to-octets (format char writer) + (declare #.*standard-optimize-settings*) + (:documentation "Converts the character CHAR to a sequence of octets +using the external format FORMAT. The conversion is performed by +calling the unary function \(which must be a functional object) WRITER +repeatedly each octet. The return value of this function is +unspecified.")) + +(defmethod char-to-octets ((format flexi-latin-1-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (let ((octet (char-code char))) + (when (> octet 255) + (signal-encoding-error format "~S (code ~A) is not a LATIN-1 character." char octet)) + (funcall writer octet))) + +(defmethod char-to-octets ((format flexi-ascii-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (let ((octet (char-code char))) + (when (> octet 127) + (signal-encoding-error format "~S (code ~A) is not an ASCII character." char octet)) + (funcall writer octet))) + +(defmethod char-to-octets ((format flexi-8-bit-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (with-accessors ((encoding-hash external-format-encoding-hash)) + format + (let ((octet (gethash (char-code char) encoding-hash))) + (unless octet + (signal-encoding-error format "~S (code ~A) is not in this encoding." char octet)) + (funcall writer octet)))) + +(defmethod char-to-octets ((format flexi-utf-8-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (let ((char-code (char-code char))) + (tagbody + (cond ((< char-code #x80) + (funcall writer char-code) + (go zero)) + ((< char-code #x800) + (funcall writer (logior #b11000000 (ldb (byte 5 6) char-code))) + (go one)) + ((< char-code #x10000) + (funcall writer (logior #b11100000 (ldb (byte 4 12) char-code))) + (go two)) + ((< char-code #x200000) + (funcall writer (logior #b11110000 (ldb (byte 3 18) char-code))) + (go three)) + ((< char-code #x4000000) + (funcall writer (logior #b11111000 (ldb (byte 2 24) char-code))) + (go four)) + (t (funcall writer (if (logbitp 30 char-code) #b11111101 #b11111100)))) + (funcall writer (logior #b10000000 (ldb (byte 6 24) char-code))) + four + (funcall writer (logior #b10000000 (ldb (byte 6 18) char-code))) + three + (funcall writer (logior #b10000000 (ldb (byte 6 12) char-code))) + two + (funcall writer (logior #b10000000 (ldb (byte 6 6) char-code))) + one + (funcall writer (logior #b10000000 (ldb (byte 6 0) char-code))) + zero))) + +(defmethod char-to-octets ((format flexi-utf-16-le-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (flet ((write-word (word) + (funcall writer (ldb (byte 8 0) word)) + (funcall writer (ldb (byte 8 8) word)))) + (declare (inline write-word)) + (let ((char-code (char-code char))) + (declare (type char-code-integer char-code)) + (cond ((< char-code #x10000) + (write-word char-code)) + (t (decf char-code #x10000) + (write-word (logior #xd800 (ldb (byte 10 10) char-code))) + (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) + +(defmethod char-to-octets ((format flexi-utf-16-be-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (flet ((write-word (word) + (funcall writer (ldb (byte 8 8) word)) + (funcall writer (ldb (byte 8 0) word)))) + (declare (inline write-word)) + (let ((char-code (char-code char))) + (declare (type char-code-integer char-code)) + (cond ((< char-code #x10000) + (write-word char-code)) + (t (decf char-code #x10000) + (write-word (logior #xd800 (ldb (byte 10 10) char-code))) + (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) + +(defmethod char-to-octets ((format flexi-utf-32-le-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (let ((char-code (char-code char))) + (funcall writer (ldb (byte 8 0) char-code)) + (funcall writer (ldb (byte 8 8) char-code)) + (funcall writer (ldb (byte 8 16) char-code)) + (funcall writer (ldb (byte 8 24) char-code)))) + +(defmethod char-to-octets ((format flexi-utf-32-be-format) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char) (function writer)) + (let ((char-code (char-code char))) + (funcall writer (ldb (byte 8 24) char-code)) + (funcall writer (ldb (byte 8 16) char-code)) + (funcall writer (ldb (byte 8 8) char-code)) + (funcall writer (ldb (byte 8 0) char-code)))) + +(defmethod char-to-octets ((format flexi-cr-mixin) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char)) + (if (char= char #\Newline) + (call-next-method format #\Return writer) + (call-next-method))) + +(defmethod char-to-octets ((format flexi-crlf-mixin) char writer) + (declare #.*fixnum-optimize-settings*) + (declare (character char)) + (cond ((char= char #\Newline) + (call-next-method format #\Return writer) + (call-next-method format #\Linefeed writer)) + (t (call-next-method)))) Modified: trunk/external-format.lisp ============================================================================== --- trunk/external-format.lisp (original) +++ trunk/external-format.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.11 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.21 2008/05/20 23:44:45 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -52,15 +52,243 @@ a #\Newline will be translated - one of the keywords :CR, :LF, or :CRLF.")) (:documentation "EXTERNAL-FORMAT objects are used to denote -encodings for flexi streams.")) +encodings for flexi streams or for the string functions defined in +strings.lisp.")) (defmethod make-load-form ((thing external-format) &optional environment) "Defines a way to reconstruct external formats. Needed for OpenMCL." (make-load-form-saving-slots thing :environment environment)) +(defclass flexi-cr-mixin () + () + (:documentation "A mixin for external-formats where the end-of-line +designator is #\Return.")) + +(defclass flexi-crlf-mixin () + () + (:documentation "A mixin for external-formats where the end-of-line +designator is the sequence #\Return #\Linefeed.")) + +(defclass flexi-8-bit-format (external-format) + ((encoding-hash :accessor external-format-encoding-hash) + (decoding-table :accessor external-format-decoding-table)) + (:documentation "The class for all flexi streams which use an 8-bit +encoding and thus need additional slots for the encoding/decoding +tables.")) + +(defclass flexi-cr-8-bit-format (flexi-cr-mixin flexi-8-bit-format) + () + (:documentation "Special class for external formats which use an +8-bit encoding /and/ have #\Return as the line-end character.")) + +(defclass flexi-crlf-8-bit-format (flexi-crlf-mixin flexi-8-bit-format) + () + (:documentation "Special class for external formats which use an +8-bit encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) + +(defclass flexi-ascii-format (flexi-8-bit-format) + () + (:documentation "Special class for external formats which use the +US-ASCII encoding.")) + +(defclass flexi-cr-ascii-format (flexi-cr-mixin flexi-ascii-format) + () + (:documentation "Special class for external formats which use the +US-ASCII encoding /and/ have #\Return as the line-end character.")) + +(defclass flexi-crlf-ascii-format (flexi-crlf-mixin flexi-ascii-format) + () + (:documentation "Special class for external formats which use the +US-ASCII encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) + +(defclass flexi-latin-1-format (flexi-8-bit-format) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding.")) + +(defclass flexi-cr-latin-1-format (flexi-cr-mixin flexi-latin-1-format) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding /and/ have #\Return as the line-end character.")) + +(defclass flexi-crlf-latin-1-format (flexi-crlf-mixin flexi-latin-1-format) + () + (:documentation "Special class for external formats which use the +ISO-8859-1 encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) + +(defclass flexi-utf-32-format (external-format) + () + (:documentation "Abstract class for external formats which use the +UTF-32 encoding.")) + +(defclass flexi-utf-32-le-format (flexi-utf-32-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering.")) + +(defclass flexi-cr-utf-32-le-format (flexi-cr-mixin flexi-utf-32-le-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering /and/ have #\Return +as the line-end character.")) + +(defclass flexi-crlf-utf-32-le-format (flexi-crlf-mixin flexi-utf-32-le-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with little-endian byte ordering /and/ have the +sequence #\Return #\Linefeed as the line-end character.")) + +(defclass flexi-utf-32-be-format (flexi-utf-32-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with big-endian byte ordering.")) + +(defclass flexi-cr-utf-32-be-format (flexi-cr-mixin flexi-utf-32-be-format) + () + (:documentation "Special class for external formats which use the +UTF-32 encoding with big-endian byte ordering /and/ have #\Return as +the line-end character.")) + +(defclass flexi-crlf-utf-32-be-format (flexi-crlf-mixin flexi-utf-32-be-format) + () + (:documentation "Special class for external formats which use the +the UTF-32 encoding with big-endian byte ordering /and/ have the +sequence #\Return #\Linefeed as the line-end character.")) + +(defclass flexi-utf-16-format (external-format) + () + (:documentation "Abstract class for external formats which use the +UTF-16 encoding.")) + +(defclass flexi-utf-16-le-format (flexi-utf-16-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering.")) + +(defclass flexi-cr-utf-16-le-format (flexi-cr-mixin flexi-utf-16-le-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering /and/ have #\Return +as the line-end character.")) + +(defclass flexi-crlf-utf-16-le-format (flexi-crlf-mixin flexi-utf-16-le-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with little-endian byte ordering /and/ have the +sequence #\Return #\Linefeed as the line-end character.")) + +(defclass flexi-utf-16-be-format (flexi-utf-16-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering.")) + +(defclass flexi-cr-utf-16-be-format (flexi-cr-mixin flexi-utf-16-be-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering /and/ have #\Return as +the line-end character.")) + +(defclass flexi-crlf-utf-16-be-format (flexi-crlf-mixin flexi-utf-16-be-format) + () + (:documentation "Special class for external formats which use the +UTF-16 encoding with big-endian byte ordering /and/ have the sequence +#\Return #\Linefeed as the line-end character.")) + +(defclass flexi-utf-8-format (external-format) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding.")) + +(defclass flexi-cr-utf-8-format (flexi-cr-mixin flexi-utf-8-format) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding /and/ have #\Return as the line-end character.")) + +(defclass flexi-crlf-utf-8-format (flexi-crlf-mixin flexi-utf-8-format) + () + (:documentation "Special class for external formats which use the +UTF-8 encoding /and/ have the sequence #\Return #\Linefeed as the +line-end character.")) + +(defmethod initialize-instance :after ((external-format flexi-8-bit-format) &rest initargs) + "Sets the fixed encoding/decoding tables for this particular +external format." + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) + (with-accessors ((encoding-hash external-format-encoding-hash) + (decoding-table external-format-decoding-table) + (name external-format-name) + (id external-format-id)) + external-format + (multiple-value-setq (encoding-hash decoding-table) + (cond ((ascii-name-p name) + (values +ascii-hash+ +ascii-table+)) + ((koi8-r-name-p name) + (values +koi8-r-hash+ +koi8-r-table+)) + ((iso-8859-name-p name) + (values (cdr (assoc name +iso-8859-hashes+ :test #'eq)) + (cdr (assoc name +iso-8859-tables+ :test #'eq)))) + ((code-page-name-p name) + (values (cdr (assoc id +code-page-hashes+)) + (cdr (assoc id +code-page-tables+)))))))) + +(defun external-format-class-name (real-name &key eol-style little-endian id) + "Given the initargs for a general external format returns the name +\(a symbol) of the most specific subclass matching these arguments." + (declare #.*standard-optimize-settings*) + (declare (ignore id)) + (cond ((ascii-name-p real-name) + (ecase eol-style + (:lf 'flexi-ascii-format) + (:cr 'flexi-cr-ascii-format) + (:crlf 'flexi-crlf-ascii-format))) + ((eq real-name :iso-8859-1) + (ecase eol-style + (:lf 'flexi-latin-1-format) + (:cr 'flexi-cr-latin-1-format) + (:crlf 'flexi-crlf-latin-1-format))) + ((or (koi8-r-name-p real-name) + (iso-8859-name-p real-name) + (code-page-name-p real-name)) + (ecase eol-style + (:lf 'flexi-8-bit-format) + (:cr 'flexi-cr-8-bit-format) + (:crlf 'flexi-crlf-8-bit-format))) + (t (ecase real-name + (:utf-8 (ecase eol-style + (:lf 'flexi-utf-8-format) + (:cr 'flexi-cr-utf-8-format) + (:crlf 'flexi-crlf-utf-8-format))) + (:utf-16 (ecase eol-style + (:lf (if little-endian + 'flexi-utf-16-le-format + 'flexi-utf-16-be-format)) + (:cr (if little-endian + 'flexi-cr-utf-16-le-format + 'flexi-cr-utf-16-be-format)) + (:crlf (if little-endian + 'flexi-crlf-utf-16-le-format + 'flexi-crlf-utf-16-be-format)))) + (:utf-32 (ecase eol-style + (:lf (if little-endian + 'flexi-utf-32-le-format + 'flexi-utf-32-be-format)) + (:cr (if little-endian + 'flexi-cr-utf-32-le-format + 'flexi-cr-utf-32-be-format)) + (:crlf (if little-endian + 'flexi-crlf-utf-32-le-format + 'flexi-crlf-utf-32-be-format)))))))) + (defun make-external-format% (name &key (little-endian *default-little-endian*) - id eol-style) - "Used internally by MAKE-EXTERNAL-FORMAT." + id eol-style) + "Used internally by MAKE-EXTERNAL-FORMAT to default some of the +keywords arguments and to determine the right subclass of +EXTERNAL-FORMAT." + (declare #.*standard-optimize-settings*) (let* ((real-name (normalize-external-format-name name)) (initargs (cond ((or (iso-8859-name-p real-name) @@ -69,12 +297,14 @@ (list :eol-style (or eol-style *default-eol-style*))) ((code-page-name-p real-name) (list :id (or (known-code-page-id-p id) - (error "Unknown code page ID ~S" id)) + (error 'external-format-error + :format-control "Unknown code page ID ~S" + :format-arguments (list id))) ;; default EOL style for Windows code pages is :CRLF :eol-style (or eol-style :crlf))) (t (list :eol-style (or eol-style *default-eol-style*) :little-endian little-endian))))) - (apply #'make-instance 'external-format + (apply #'make-instance (apply #'external-format-class-name real-name initargs) :name real-name initargs))) @@ -87,6 +317,8 @@ encodings, EOL-STYLE is one of the keywords :CR, :LF, or :CRLF which denote the end-of-line character \(sequence), ID is the ID of a Windows code page \(and ignored for other encodings)." + (declare #.*standard-optimize-settings*) + ;; the keyword arguments are only there for arglist display in the IDE (declare (ignore id little-endian)) (let ((shortcut-args (cdr (assoc name +shortcut-map+)))) (cond (shortcut-args @@ -94,10 +326,20 @@ (append shortcut-args `(:eol-style ,eol-style)))) (t (apply #'make-external-format% name args))))) + +(defun maybe-convert-external-format (external-format) + "Given an external format designator \(a keyword, a list, or an +EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT +object." + (declare #.*standard-optimize-settings*) + (typecase external-format + (symbol (make-external-format external-format)) + (list (apply #'make-external-format external-format)) + (otherwise external-format))) (defun external-format-equal (ef1 ef2) - "Checks whether two EXTERNAL-FORMAT objects denote the same -encoding." + "Checks whether two EXTERNAL-FORMAT objects denote the same encoding." + (declare #.*standard-optimize-settings*) (let* ((name1 (external-format-name ef1)) (code-page-name-p (code-page-name-p name1))) ;; they must habe the same canonical name @@ -121,10 +363,10 @@ (defun normalize-external-format (external-format) "Returns a list which is a `normalized' representation of the -external format EXTERNAL-FORMAT. Used internally by -PRINT-OBJECT, for example. Basically, the result is argument -list that can be fed back to MAKE-EXTERNAL-FORMAT to create an -equivalent object." +external format EXTERNAL-FORMAT. Used internally by PRINT-OBJECT, for +example. Basically, the result is an argument list that can be fed +back to MAKE-EXTERNAL-FORMAT to create an equivalent object." + (declare #.*standard-optimize-settings*) (let ((name (external-format-name external-format)) (eol-style (external-format-eol-style external-format))) (cond ((or (ascii-name-p name) @@ -144,4 +386,47 @@ "How an EXTERNAL-FORMAT object is rendered. Uses NORMALIZE-EXTERNAL-FORMAT." (print-unreadable-object (object stream :type t :identity t) - (prin1 (normalize-external-format object) stream))) \ No newline at end of file + (prin1 (normalize-external-format object) stream))) + +(defgeneric encoding-factor (format) + (:documentation "Given an external format FORMAT, returns a factor +which denotes the octets to characters ratio to expect when +encoding/decoding. If the returned value is an integer, the factor is +assumed to be exact. If it is a \(double) float, the factor is +supposed to be based on heuristics and usually not exact. + +This factor is used in string.lisp.") + (declare #.*standard-optimize-settings*)) + +(defmethod encoding-factor ((format flexi-8-bit-format)) + (declare #.*standard-optimize-settings*) + ;; 8-bit encodings map octets to characters in an exact one-to-one + ;; fashion + 1) + +(defmethod encoding-factor ((format flexi-utf-8-format)) + (declare #.*standard-optimize-settings*) + ;; UTF-8 characters can be anything from one to six octets, but we + ;; assume that the "overhead" is only about 5 percent - this + ;; estimate is obviously very much dependant on the content + 1.05d0) + +(defmethod encoding-factor ((format flexi-utf-16-format)) + (declare #.*standard-optimize-settings*) + ;; usually one character maps to two octets, but characters with + ;; code points above #x10000 map to four octets - we assume that we + ;; usually don't see these characters but of course have to return a + ;; float + 2.0d0) + +(defmethod encoding-factor ((format flexi-utf-32-format)) + (declare #.*standard-optimize-settings*) + ;; UTF-32 always matches every character to four octets + 4) + +(defmethod encoding-factor ((format flexi-crlf-mixin)) + (declare #.*standard-optimize-settings*) + ;; if the sequence #\Return #\Linefeed is the line-end marker, this + ;; obviously makes encodings potentially longer and definitely makes + ;; the estimate unexact + (* 1.02d0 (call-next-method))) Modified: trunk/flexi-streams.asd ============================================================================== --- trunk/flexi-streams.asd (original) +++ trunk/flexi-streams.asd Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.58 2007/12/29 23:15:26 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.65 2008/05/21 11:53:07 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -35,21 +35,26 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "0.14.0" + :version "0.15.0" :serial t :components ((:file "packages") - (:file "ascii") - (:file "koi8-r") + (:file "mapping") + (:file "ascii") + (:file "koi8-r") (:file "iso-8859") (:file "code-pages") (:file "specials") (:file "util") + (:file "conditions") (:file "external-format") + (:file "encode") + (:file "decode") (:file "in-memory") (:file "stream") #+:lispworks (:file "lw-binary-stream") (:file "output") (:file "input") + (:file "io") (:file "strings")) :depends-on (:trivial-gray-streams)) Modified: trunk/in-memory.lisp ============================================================================== --- trunk/in-memory.lisp (original) +++ trunk/in-memory.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.26 2007/12/29 21:17:05 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.31 2008/05/19 07:57:07 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -104,179 +104,197 @@ (:documentation "A binary output stream that writes its data to an associated vector.")) -(define-condition in-memory-stream-error (stream-error) - () - (:documentation "Superclass for all errors related to -IN-MEMORY streams.")) - -(define-condition in-memory-stream-closed-error (in-memory-stream-error) - () - (:report (lambda (condition stream) - (format stream "~S is closed." - (stream-error-stream condition)))) - (:documentation "An error that is signalled when someone is trying -to read from or write to a closed IN-MEMORY stream.")) - #+:cmu (defmethod open-stream-p ((stream in-memory-stream)) "Returns a true value if STREAM is open. See ANSI standard." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (in-memory-stream-open-p stream)) #+:cmu (defmethod close ((stream in-memory-stream) &key abort) "Closes the stream STREAM. See ANSI standard." - (declare (ignore abort) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore abort)) (prog1 (in-memory-stream-open-p stream) (setf (in-memory-stream-open-p stream) nil))) (defmethod check-if-open ((stream in-memory-stream)) "Checks if STREAM is open and signals an error otherwise." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (unless (open-stream-p stream) (error 'in-memory-stream-closed-error :stream stream))) (defmethod stream-element-type ((stream in-memory-stream)) "The element type is always OCTET by definition." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) 'octet) (defmethod transform-octet ((stream in-memory-stream) octet) "Applies the transformer of STREAM to octet and returns the result." + (declare #.*standard-optimize-settings*) (funcall (or (in-memory-stream-transformer stream) #'identity) octet)) (defmethod stream-read-byte ((stream list-input-stream)) "Reads one byte by simply popping it off of the top of the list." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (transform-octet stream (or (pop (list-stream-list stream)) - (return-from stream-read-byte :eof)))) + (with-accessors ((list list-stream-list)) + stream + (transform-octet stream (or (pop list) (return-from stream-read-byte :eof))))) (defmethod stream-listen ((stream list-input-stream)) "Checks whether list is not empty." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (list-stream-list stream)) + (with-accessors ((list list-stream-list)) + stream + list)) (defmethod stream-read-sequence ((stream list-input-stream) sequence start end &key) "Repeatedly pops elements from the list until it's empty." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop for index from start below end - while (list-stream-list stream) - do (setf (elt sequence index) - (pop (list-stream-list stream))) - finally (return index))) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((list list-stream-list)) + stream + (loop for index of-type fixnum from start below end + while list + do (setf (elt sequence index) (pop list)) + finally (return index)))) (defmethod stream-read-byte ((stream vector-input-stream)) "Reads one byte and increments INDEX pointer unless we're beyond END pointer." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (let ((index (vector-stream-index stream))) - (cond ((< index (vector-stream-end stream)) - (incf (vector-stream-index stream)) - (transform-octet stream (aref (vector-stream-vector stream) index))) - (t :eof)))) + (with-accessors ((index vector-stream-index) + (end vector-stream-end) + (vector vector-stream-vector)) + stream + (let ((current-index index)) + (declare (fixnum current-index)) + (cond ((< current-index (the fixnum end)) + (incf (the fixnum index)) + (transform-octet stream (aref vector current-index))) + (t :eof))))) (defmethod stream-listen ((stream vector-input-stream)) "Checking whether INDEX is beyond END." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (< (vector-stream-index stream) (vector-stream-end stream))) + (with-accessors ((index vector-stream-index) + (end vector-stream-end)) + stream + (< (the fixnum index) (the fixnum end)))) (defmethod stream-read-sequence ((stream vector-input-stream) sequence start end &key) "Traverses both sequences in parallel until the end of one of them is reached." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop with vector-end of-type (integer 0 #.array-dimension-limit) = (vector-stream-end stream) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (loop with vector-end of-type fixnum = (vector-stream-end stream) with vector = (vector-stream-vector stream) - for index from start below end - for vector-index of-type (integer 0 #.array-dimension-limit) = (vector-stream-index stream) + for index of-type fixnum from start below end + for vector-index of-type fixnum = (vector-stream-index stream) while (< vector-index vector-end) do (setf (elt sequence index) (aref vector vector-index)) - (incf (vector-stream-index stream)) + (incf (the fixnum (vector-stream-index stream))) finally (return index))) (defmethod stream-write-byte ((stream vector-output-stream) byte) "Writes a byte \(octet) by extending the underlying vector." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (vector-push-extend (transform-octet stream byte) - (vector-stream-vector stream))) + (with-accessors ((vector vector-stream-vector)) + stream + (vector-push-extend (transform-octet stream byte) vector))) (defmethod stream-write-sequence ((stream vector-output-stream) sequence start end &key) "Just calls VECTOR-PUSH-EXTEND repeatedly." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop with vector = (vector-stream-vector stream) - for index from start below end - do (vector-push-extend (elt sequence index) vector)) - sequence) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((vector vector-stream-vector)) + stream + (loop for index of-type fixnum from start below end + do (vector-push-extend (elt sequence index) vector)) + sequence)) (defmethod stream-file-position ((stream vector-input-stream)) "Simply returns the index into the underlying vector." - (declare (optimize speed)) - (vector-stream-index stream)) + (declare #.*standard-optimize-settings*) + (with-accessors ((index vector-stream-index)) + stream + index)) (defmethod (setf stream-file-position) (position-spec (stream vector-input-stream)) "Sets the index into the underlying vector if POSITION-SPEC is acceptable." - (declare (optimize speed)) - (setf (vector-stream-index stream) - (case position-spec - (:start 0) - (:end (vector-stream-end stream)) - (otherwise - (unless (integerp position-spec) - (error 'flexi-stream-position-spec-error - :format-control "Unknown file position designator: ~S." - :format-arguments (list position-spec) - :position-spec position-spec)) - (unless (<= 0 position-spec (vector-stream-end stream)) - (error 'flexi-stream-position-spec-error - :format-control "File position designator ~S is out of bounds." - :format-arguments (list position-spec) - :position-spec position-spec)) - position-spec))) - position-spec) - -(defmethod stream-file-position ((stream vector-output-stream)) - "Simply returns the fill pointer of the underlying vector." - (declare (optimize speed)) - (fill-pointer (vector-stream-vector stream))) - -(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream)) - "Sets the fill pointer underlying vector if POSITION-SPEC is -acceptable. Adjusts the vector if necessary." - (declare (optimize speed)) - (let* ((vector (vector-stream-vector stream)) - (total-size (array-total-size vector)) - (new-fill-pointer + (declare #.*standard-optimize-settings*) + (with-accessors ((index vector-stream-index) + (end vector-stream-end)) + stream + (setq index (case position-spec (:start 0) - (:end - (warn "File position designator :END doesn't really make sense for an output stream.") - total-size) + (:end end) (otherwise (unless (integerp position-spec) - (error 'flexi-stream-position-spec-error + (error 'in-memory-stream-position-spec-error :format-control "Unknown file position designator: ~S." :format-arguments (list position-spec) + :stream stream :position-spec position-spec)) - (unless (<= 0 position-spec array-total-size-limit) - (error 'flexi-stream-position-spec-error + (unless (<= 0 position-spec end) + (error 'in-memory-stream-position-spec-error :format-control "File position designator ~S is out of bounds." :format-arguments (list position-spec) + :stream stream :position-spec position-spec)) - position-spec)))) - (when (> new-fill-pointer total-size) - (adjust-array vector new-fill-pointer)) - (setf (fill-pointer vector) new-fill-pointer) + position-spec))) position-spec)) +(defmethod stream-file-position ((stream vector-output-stream)) + "Simply returns the fill pointer of the underlying vector." + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (fill-pointer vector))) + +(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream)) + "Sets the fill pointer underlying vector if POSITION-SPEC is +acceptable. Adjusts the vector if necessary." + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (let* ((total-size (array-total-size vector)) + (new-fill-pointer + (case position-spec + (:start 0) + (:end + (warn "File position designator :END doesn't really make sense for an output stream.") + total-size) + (otherwise + (unless (integerp position-spec) + (error 'in-memory-stream-position-spec-error + :format-control "Unknown file position designator: ~S." + :format-arguments (list position-spec) + :stream stream + :position-spec position-spec)) + (unless (<= 0 position-spec array-total-size-limit) + (error 'in-memory-stream-position-spec-error + :format-control "File position designator ~S is out of bounds." + :format-arguments (list position-spec) + :stream stream + :position-spec position-spec)) + position-spec)))) + (declare (fixnum total-size new-fill-pointer)) + (when (> new-fill-pointer total-size) + (adjust-array vector new-fill-pointer)) + (setf (fill-pointer vector) new-fill-pointer) + position-spec))) + (defmethod make-in-memory-input-stream ((vector vector) &key (start 0) (end (length vector)) transformer) @@ -284,7 +302,7 @@ octets in the subsequence of VECTOR bounded by START and END. Each octet returned will be transformed in turn by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'vector-input-stream :vector vector :index start @@ -298,7 +316,7 @@ octets in the subsequence of LIST bounded by START and END. Each octet returned will be transformed in turn by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'list-input-stream :list (subseq list start end) :transformer transformer)) @@ -306,7 +324,7 @@ (defun make-output-vector (&key (element-type 'octet)) "Creates and returns an array which can be used as the underlying vector for a VECTOR-OUTPUT-STREAM." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-array 0 :adjustable t :fill-pointer 0 :element-type element-type)) @@ -317,7 +335,7 @@ that contains the octes that were actually output. The octets stored will each be transformed by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'vector-output-stream :vector (make-output-vector :element-type element-type) :transformer transformer)) @@ -329,19 +347,23 @@ been output since the last call to GET-OUTPUT-STREAM-SEQUENCE or since the creation of the stream, whichever occurred most recently. If AS-LIST is true the return value is coerced to a list." - (declare (optimize speed)) - (prog1 - (if as-list - (coerce (vector-stream-vector stream) 'list) - (vector-stream-vector stream)) - (setf (vector-stream-vector stream) - (make-output-vector)))) + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (prog1 + (if as-list + (coerce vector 'list) + vector) + (setq vector + (make-output-vector))))) (defmethod output-stream-sequence-length ((stream in-memory-output-stream)) "Returns the current length of the underlying vector of the IN-MEMORY output stream STREAM." (declare (optimize speed)) - (length (the (simple-array * (*)) (vector-stream-vector stream)))) + (with-accessors ((vector vector-stream-vector)) + stream + (length (the (simple-array * (*)) vector)))) (defmacro with-input-from-sequence ((var sequence &key start end transformer) &body body) @@ -382,14 +404,3 @@ ,@body (get-output-stream-sequence ,var :as-list ,as-list)) (when ,var (close ,var))))) - -(declaim (inline translate-char)) -(defun translate-char (char-code external-format) - "Returns a list of octets which correspond to the -representation of the character with character code CHAR-CODE -when sent to a flexi stream with external format EXTERNAL-FORMAT. -Used internally by UNREAD-CHAR%. See also STRING-TO-OCTETS." - (declare (optimize speed)) - (with-output-to-sequence (list :as-list t) - (let ((stream (make-flexi-stream list :external-format external-format))) - (write-char (code-char char-code) stream)))) \ No newline at end of file Modified: trunk/input.lisp ============================================================================== --- trunk/input.lisp (original) +++ trunk/input.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.51 2007/12/29 22:58:43 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.70 2008/05/21 00:18:35 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -34,7 +34,7 @@ "Reads one byte \(octet) from the underlying stream of FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; we're using S instead of STREAM here because of an ;; issue with SBCL: ;; <http://article.gmane.org/gmane.lisp.steel-bank.general/1386> @@ -58,7 +58,7 @@ "Reads one byte \(octet) from the underlying stream of FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) (octet-stack flexi-stream-octet-stack) @@ -85,7 +85,7 @@ FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty). Optimized version \(only needed for LispWorks) in case the underlying stream is binary." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) (octet-stack flexi-stream-octet-stack) @@ -104,7 +104,7 @@ (defmethod stream-clear-input ((flexi-input-stream flexi-input-stream)) "Calls the corresponding method for the underlying input stream and also clears the value of the OCTET-STACK slot." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; note that we don't reset the POSITION slot (with-accessors ((octet-stack flexi-stream-octet-stack) (stream flexi-stream-stream)) @@ -116,12 +116,14 @@ "Calls the corresponding method for the underlying input stream but first checks if \(old) input is available in the OCTET-STACK slot." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) (octet-stack flexi-stream-octet-stack) (stream flexi-stream-stream)) flexi-input-stream + (declare (integer position) + (type (or null integer) bound)) (when (and bound (>= position bound)) (return-from stream-listen nil)) @@ -129,7 +131,7 @@ (defmethod stream-read-byte ((stream flexi-input-stream)) "Reads one byte \(octet) from the underlying stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; set LAST-CHAR-CODE slot to NIL because we can't UNREAD-CHAR after ;; this operation (with-accessors ((last-char-code flexi-stream-last-char-code) @@ -140,397 +142,220 @@ (setq last-octet octet) (or octet :eof)))) -(defgeneric unread-char% (char-code flexi-input-stream) - (:documentation "Used internally to put a character denoted by the -character code CHAR-CODE which was already read back on the stream. -Uses the OCTET-STACK slot and decrements the POSITION slot -accordingly.")) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-input-stream)) - "The default method which is un-optimized and uses TRANSLATE-CHAR to -figure out which octets to put on the octet stack." - (declare (optimize speed) (inline translate-char)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack) - (external-format flexi-stream-external-format)) - flexi-input-stream - (declare (integer position)) - (let ((octets-read (translate-char char-code external-format))) - (decf position (length octets-read)) - (setq octet-stack (append octets-read octet-stack))))) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-latin-1-input-stream)) - "For ISO-8859-1 we can simply put the character code itself on the -octet stack." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack)) - flexi-input-stream - (declare (integer position)) - (decf position) - (push char-code octet-stack))) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-ascii-input-stream)) - "For ASCII we can simply put the character code itself on the octet -stack." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack)) - flexi-input-stream - (declare (integer position)) - (decf position) - (push char-code octet-stack))) - -(defmethod unread-char% (char-code (flexi-input-stream flexi-8-bit-input-stream)) - "For 8-bit encodings we just have to put one octet on the octet -stack which we can look up in the encoding hash." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack) - (encoding-hash flexi-stream-encoding-hash)) - flexi-input-stream - (declare (integer position)) - (decf position) - (push (gethash char-code encoding-hash) octet-stack))) - -(defmethod unread-char% ((char-code (eql #.(char-code #\Newline))) - (flexi-input-stream flexi-cr-8-bit-input-stream)) - "A kind of `safety net' for the optimized 8-bit versions of -UNREAD-CHAR% which checks for the single case where more than one -octet has to be put on the octet stack." - (declare (optimize speed)) - (with-accessors ((position flexi-stream-position) - (octet-stack flexi-stream-octet-stack) - (external-format flexi-stream-external-format)) - flexi-input-stream - (declare (integer position)) - ;; note that below we use the knowledge that in all 8-bit encodings - ;; #\Return and #\Linefeed are mapped to the same octets - (case (external-format-eol-style external-format) - (:crlf - (decf position 2) - (push #.(char-code #\Linefeed) octet-stack) - (push #.(char-code #\Return) octet-stack)) - (otherwise - (decf position) - (push #.(char-code #\Return) octet-stack))))) - -#+:lispworks -(defmethod unread-char% ((char-code (eql #.(char-code #\Newline))) - (flexi-input-stream flexi-binary-cr-8-bit-input-stream)) - "A kind of `safety net' for the optimized 8-bit versions of -UNREAD-CHAR% which checks for the single case where more than one -octet has to be put on the octet stack. - -This method \(identical to the one defined directly above) exists only -for LispWorks' \"binary\" streams and must be there due to the -slightly clunky class hierarchy." - (declare (optimize speed)) +(defun unread-char% (char flexi-input-stream) + "Used internally to put a character CHAR which was already read back +on the stream. Uses the OCTET-STACK slot and decrements the POSITION +slot accordingly." + (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (octet-stack flexi-stream-octet-stack) (external-format flexi-stream-external-format)) flexi-input-stream - (declare (integer position)) - ;; note that below we use the knowledge that in all 8-bit encodings - ;; #\Return and #\Linefeed are mapped to the same octets - (case (external-format-eol-style external-format) - (:crlf - (decf position 2) - (push #.(char-code #\Linefeed) octet-stack) - (push #.(char-code #\Return) octet-stack)) - (otherwise - (decf position) - (push #.(char-code #\Return) octet-stack))))) - -(defmacro define-char-reader ((stream-var stream-class) &body body) - "Helper macro to define methods for STREAM-READ-CHAR. Defines a -method for the class STREAM-CLASS using the variable STREAM-VAR and -the code body BODY wrapped with some standard code common to all -methods defined here. The return value of BODY is a character code. -In case of encoding problems, BODY must return the value returned by -\(RECOVER-FROM-ENCODING-ERROR ...)." - (with-unique-names (char-code body-fn) - `(defmethod stream-read-char ((,stream-var ,stream-class)) - "This method was generated with the DEFINE-CHAR-READER macro." - (declare (optimize speed)) - ;; note that we do nothing for the :LF EOL style because we - ;; assume that #\Newline is the same as #\Linefeed in all - ;; Lisps which will use this library - (with-accessors ((last-octet flexi-stream-last-octet) - (last-char-code flexi-stream-last-char-code)) - ,stream-var - ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after - ;; this operation - (setq last-octet nil) - (let ((,char-code - (flet ((,body-fn () ,@body)) - (declare (inline ,body-fn) (dynamic-extent (function ,body-fn))) - (,body-fn)))) - ;; remember this character and the current external format - ;; for UNREAD-CHAR - (setq last-char-code ,char-code) - (or (code-char ,char-code) ,char-code)))))) - -(defun recover-from-encoding-error (flexi-stream format-control &rest format-args) - "Helper function used by the STREAM-READ-CHAR methods below to deal -with encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and -returns its character code in this case. Otherwise signals a -FLEXI-STREAM-ENCODING-ERROR as determined by the arguments to this -function and provides a corresponding USE-VALUE restart." - (when *substitution-char* - (return-from recover-from-encoding-error (char-code *substitution-char*))) - (restart-case - (apply #'signal-encoding-error flexi-stream format-control format-args) - (use-value (char) - :report "Specify a character to be used instead." - :interactive (lambda () - (loop - (format *query-io* "Type a character: ") - (let ((line (read-line *query-io*))) - (when (= 1 (length line)) - (return (list (char line 0))))))) - (char-code char)))) - -(define-char-reader (stream flexi-latin-1-input-stream) - (or (read-byte* stream) - (return-from stream-read-char :eof))) - -(define-char-reader (stream flexi-ascii-input-stream) - (let ((octet (or (read-byte* stream) - (return-from stream-read-char :eof)))) - (declare (type octet octet)) - (if (> octet 127) - (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) - octet))) - -(define-char-reader (stream flexi-8-bit-input-stream) - (with-accessors ((encoding-table flexi-stream-encoding-table)) + (let ((counter 0) octets-reversed) + (declare (integer position) + (fixnum counter)) + (flet ((writer (octet) + (incf counter) + (push octet octets-reversed))) + (declare (dynamic-extent (function writer))) + (char-to-octets external-format char #'writer) + (decf position counter) + (setq octet-stack (nreconc octets-reversed octet-stack)))))) + +(defmethod stream-read-char ((stream flexi-input-stream)) + (declare #.*standard-optimize-settings*) + ;; note that we do nothing for the :LF EOL style because we assume + ;; that #\Newline is the same as #\Linefeed in all Lisps which will + ;; use this library + (with-accessors ((external-format flexi-stream-external-format) + (last-octet flexi-stream-last-octet) + (last-char-code flexi-stream-last-char-code)) stream - (let* ((octet (or (read-byte* stream) - (return-from stream-read-char :eof))) - (char-code (aref (the (simple-array * *) encoding-table) octet))) - (declare (type octet octet)) - (if (or (null char-code) - (= char-code 65533)) - (recover-from-encoding-error stream "No character which corresponds to octet #x~X." octet) - char-code)))) - -(define-char-reader (stream flexi-utf-8-input-stream) - (block body - (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-8 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (let ((octet (read-next-byte))) - (declare (type octet octet)) - (multiple-value-bind (start count) - (cond ((zerop (logand octet #b10000000)) - (values octet 0)) - ((= #b11000000 (logand octet #b11100000)) - (values (logand octet #b00011111) 1)) - ((= #b11100000 (logand octet #b11110000)) - (values (logand octet #b00001111) 2)) - ((= #b11110000 (logand octet #b11111000)) - (values (logand octet #b00000111) 3)) - ((= #b11111000 (logand octet #b11111100)) - (values (logand octet #b00000011) 4)) - ((= #b11111100 (logand octet #b11111110)) - (values (logand octet #b00000001) 5)) - (t (return-from body - (recover-from-encoding-error stream - "Unexpected value #x~X at start of UTF-8 sequence." - octet)))) - ;; note that we currently don't check for "overlong" - ;; sequences or other illegal values - (loop for result of-type (unsigned-byte 32) - = start then (+ (ash result 6) - (logand octet #b111111)) - repeat count - for octet of-type octet = (read-next-byte) - unless (= #b10000000 (logand octet #b11000000)) - do (return-from body - (recover-from-encoding-error stream - "Unexpected value #x~X in UTF-8 sequence." octet)) - finally (return result)))))))) - -(define-char-reader (stream flexi-utf-16-le-input-stream) - (block body - (let (first-octet-seen) - (labels ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-16 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t))) - (read-next-word () - (+ (the octet (read-next-byte)) - (ash (the octet (read-next-byte)) 8)))) - (declare (inline read-next-byte read-next-word) - (dynamic-extent (function read-next-byte) (function read-next-word))) - (let ((word (read-next-word))) - (cond ((<= #xd800 word #xdfff) - (let ((next-word (read-next-word))) - (unless (<= #xdc00 next-word #xdfff) - (return-from body - (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." - next-word word))) - (+ (ash (logand #b1111111111 word) 10) - (logand #b1111111111 next-word) - #x10000))) - (t word))))))) - -(define-char-reader (stream flexi-utf-16-be-input-stream) - (block body - (let (first-octet-seen) - (labels ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-16 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t))) - (read-next-word () - (+ (ash (the octet (read-next-byte)) 8) - (the octet (read-next-byte))))) - (let ((word (read-next-word))) - (cond ((<= #xd800 word #xdfff) - (let ((next-word (read-next-word))) - (unless (<= #xdc00 next-word #xdfff) - (return-from body - (recover-from-encoding-error stream "Unexpected UTF-16 word #x~X following #x~X." - next-word word))) - (+ (ash (logand #b1111111111 word) 10) - (logand #b1111111111 next-word) - #x10000))) - (t word))))))) - -(define-char-reader (stream flexi-utf-32-le-input-stream) - (block body - (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-32 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (loop for count from 0 to 24 by 8 - for octet of-type octet = (read-next-byte) - sum (ash octet count)))))) - -(define-char-reader (stream flexi-utf-32-be-input-stream) - (block body - (let (first-octet-seen) - (flet ((read-next-byte () - (prog1 - (or (read-byte* stream) - (cond (first-octet-seen - (return-from body - (recover-from-encoding-error stream - "End of file while in UTF-32 sequence."))) - (t (return-from stream-read-char :eof)))) - (setq first-octet-seen t)))) - (declare (inline read-next-byte) (dynamic-extent (function read-next-byte))) - (loop for count from 24 downto 0 by 8 - for octet of-type octet = (read-next-byte) - sum (ash octet count)))))) - -(defmethod stream-read-char ((stream flexi-cr-mixin)) - "The `base' method for all streams which need end-of-line -conversion. Uses CALL-NEXT-METHOD to do the actual work of -reading one or more characters from the stream." - (declare (optimize speed)) - (let ((char (call-next-method))) - (when (eq char :eof) - (return-from stream-read-char :eof)) - (with-accessors ((external-format flexi-stream-external-format) - (last-char-code flexi-stream-last-char-code)) - stream - (when (eql char #\Return) - (case (external-format-eol-style external-format) - (:cr (setq char #\Newline - last-char-code #.(char-code #\Newline))) - ;; in the case :CRLF we have to look ahead one character - (:crlf (let ((next-char (call-next-method))) - (case next-char - (#\Linefeed - (setq char #\Newline - last-char-code #.(char-code #\Newline))) - (:eof) - ;; if the character we peeked at wasn't a - ;; linefeed character we push its - ;; constituents back onto our internal - ;; octet stack - (otherwise (unread-char% (char-code next-char) stream))))))) - char))) + ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after + ;; this operation + (setq last-octet nil) + (flet ((reader () + (read-byte* stream)) + (unreader (char) + (unread-char% char stream))) + (declare (dynamic-extent (function reader) (function unreader))) + (let* ((*current-unreader* #'unreader) + (char-code (or (octets-to-char-code external-format #'reader) + (return-from stream-read-char :eof)))) + ;; remember this character and its char code for UNREAD-CHAR + (setq last-char-code char-code) + (or (code-char char-code) char-code))))) (defmethod stream-read-char-no-hang ((stream flexi-input-stream)) "Reads one character if the underlying stream has at least one octet available." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; note that this may block for non-8-bit encodings - I think ;; there's no easy way to handle this correctly (and (stream-listen stream) (stream-read-char stream))) (defmethod stream-read-sequence ((flexi-input-stream flexi-input-stream) sequence start end &key) - "Reads enough input from STREAM to fill SEQUENCE from START to END. -If SEQUENCE is an array which can store octets we use READ-SEQUENCE to -fill it in one fell swoop, otherwise we iterate using -STREAM-READ-CHAR." - (declare (optimize speed) - (type (integer 0 *) start end)) - (with-accessors ((last-char-code flexi-stream-last-char-code) + "An optimized version which uses a buffer underneath. The function +can deliver characters as well as octets and it decides what to do +based on the element type of the sequence \(which takes precedence) +and the element type of the stream. What you'll really get might also +depend on your Lisp. Some of the implementations are more picky than +others - see for example FLEXI-STREAMS-TEST:READ-SEQUENCE-TEST." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((position flexi-stream-position) + (bound flexi-stream-bound) + (octet-stack flexi-stream-octet-stack) + (external-format flexi-stream-external-format) (last-octet flexi-stream-last-octet) - (stream flexi-stream-stream) - (position flexi-stream-position) - (octet-stack flexi-stream-octet-stack)) + (last-char-code flexi-stream-last-char-code) + (element-type flexi-stream-element-type) + (stream flexi-stream-stream)) flexi-input-stream - (declare (integer position)) - (cond ((and (arrayp sequence) - (subtypep 'octet (array-element-type sequence))) - (setf last-char-code nil) - (let ((cursor start)) - (loop with stack = octet-stack - for continuep = (< cursor end) - for octet = (and continuep (pop stack)) - while octet - do (setf (aref sequence cursor) (the octet octet)) - (incf cursor)) - (let ((index - (read-sequence sequence stream :start cursor :end end))) - (incf position (- index start)) - (when (> index start) - (setq last-octet (aref sequence (1- index)))) - index))) - (t - (loop for index from start below end - for element = (stream-read-char flexi-input-stream) - until (eq element :eof) - do (setf (elt sequence index) element) - finally (return index)))))) + (let* (buffer + (buffer-pos 0) + (buffer-end 0) + (index start) + ;; whether we will deliver characters and thus the number + ;; of octets to read might not be equal to the number of + ;; sequence elements to fill + (want-chars-p (or (stringp sequence) + (and (vectorp sequence) + (not (subtypep (array-element-type sequence) 'integer))) + (not (type-equal element-type 'octet)))) + ;; whether we will later be able to rewind the stream if + ;; needed (to get rid of unused octets in the buffer) + (can-rewind-p (and want-chars-p (maybe-rewind stream 0))) + (factor (if want-chars-p (encoding-factor external-format) 1)) + (integer-factor (floor factor)) + ;; it's an interesting question whether it makes sense + ;; performance-wise to make RESERVE significantly bigger + ;; (and thus put potentially a lot more octets into + ;; OCTET-STACK), especially for UTF-8 + (reserve (cond ((not (floatp factor)) 0) + ((not can-rewind-p) (* 2 integer-factor)) + (t (ceiling (* (- factor integer-factor) (- end start))))))) + (declare (fixnum buffer-pos buffer-end index integer-factor reserve) + (boolean want-chars-p can-rewind-p)) + (flet ((compute-fill-amount () + "Computes the amount of octets we can savely read into +the buffer without violating the stream's bound \(if there is one) and +without potentially reading much more than we need \(unless we can +rewind afterwards)." + (let ((minimum (min (the fixnum (+ (the fixnum (* integer-factor + (the fixnum (- end index)))) + reserve)) + +buffer-size+))) + (cond (bound (min minimum (- bound position))) + (t minimum)))) + (fill-buffer (end) + "Tries to fill the buffer from BUFFER-POS to END and +returns NIL if the buffer doesn't contain any new data." + ;; put data from octet stack into buffer if there is any + (loop + (when (>= buffer-pos end) + (return)) + (let ((next-octet (pop octet-stack))) + (cond (next-octet + (setf (aref (the (array octet *) buffer) buffer-pos) (the octet next-octet)) + (incf buffer-pos)) + (t (return))))) + (setq buffer-end (read-sequence buffer stream + :start buffer-pos + :end end)) + ;; BUFFER-POS is only greater than zero if the buffer + ;; already contains unread data from the octet stack + ;; (see below), so we test for ZEROP here and do /not/ + ;; compare with BUFFER-POS + (unless (zerop buffer-end) + (incf position buffer-end)))) + (let ((minimum (compute-fill-amount))) + (declare (fixnum minimum)) + (setq buffer (make-octet-buffer minimum)) + ;; fill buffer for the first time or return immediately if + ;; we don't succeed + (unless (fill-buffer minimum) + (return-from stream-read-sequence start))) + (setq buffer-pos 0) + (flet ((next-octet () + "Returns the next octet from the buffer and fills it +if it is exhausted. Returns NIL if there's no more data on the +stream." + (when (>= buffer-pos buffer-end) + (setq buffer-pos 0) + (unless (fill-buffer (compute-fill-amount)) + (return-from next-octet))) + (prog1 + (aref (the (array octet *) buffer) buffer-pos) + (incf buffer-pos))) + (unreader (char) + (unread-char% char flexi-input-stream))) + (declare (dynamic-extent (function next-octet) (function unreader))) + (let ((*current-unreader* #'unreader)) + (macrolet ((iterate (octetp set-place) + "A very unhygienic macro to implement the +actual iteration through the sequence including housekeeping for the +flexi stream. If OCTETP is true, we put octets into the stream, +otherwise characters. SET-PLACE is the place \(using the index INDEX) +used to access the sequence." + `(flet ((leave () + "This is the function used to abort +the LOOP iteration below." + (when (> index start) + ;; if something was read at all, + ;; update LAST-OCTET and + ;; LAST-CHAR-CODE accordingly + (setq ,(if octetp 'last-char-code 'last-octet) + nil + ,(if octetp 'last-octet 'last-char-code) + ,(sublis '((index . (1- index))) set-place))) + (return-from stream-read-sequence index))) + (loop + (when (>= index end) + ;; check if there are octets in the + ;; buffer we didn't use - see + ;; COMPUTE-FILL-AMOUNT above + (let ((rest (- buffer-end buffer-pos))) + (when (plusp rest) + (or (and can-rewind-p + (maybe-rewind stream rest)) + (loop + (when (>= buffer-pos buffer-end) + (return)) + (decf buffer-end) + (push (aref (the (array octet *) buffer) buffer-end) + octet-stack))))) + (leave)) + (let ((next-thing ,(if octetp + '(next-octet) + '(octets-to-char-code external-format #'next-octet)))) + (unless next-thing (leave)) + (setf ,set-place ,(if octetp 'next-thing '(code-char next-thing))) + (incf index)))))) + (etypecase sequence + (string (iterate nil (char sequence index))) + (array + (let ((array-element-type (array-element-type sequence))) + (cond ((type-equal array-element-type 'octet) + (iterate t (aref (the (array octet *) sequence) index))) + ((or (subtypep array-element-type 'integer) + (type-equal element-type 'octet)) + (iterate t (aref sequence index))) + (t + (iterate nil (aref sequence index)))))) + (list + (cond ((type-equal element-type 'octet) + (iterate t (nth index sequence))) + (t + (iterate nil (nth index sequence))))))))))))) (defmethod stream-unread-char ((stream flexi-input-stream) char) "Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM. Makes sure CHAR will only be unread if it was the last character read and if it was read with the same encoding that's currently being used by the stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((last-char-code flexi-stream-last-char-code)) stream (unless last-char-code @@ -540,7 +365,7 @@ (error 'flexi-stream-simple-error :format-control "Last character read (~S) was different from ~S." :format-arguments (list (code-char last-char-code) char))) - (unread-char% last-char-code stream) + (unread-char% char stream) (setq last-char-code nil) nil)) @@ -548,7 +373,7 @@ "Similar to UNREAD-CHAR in that it `unreads' the last octet from STREAM. Note that you can only call UNREAD-BYTE after a corresponding READ-BYTE." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((last-octet flexi-stream-last-octet) (octet-stack flexi-stream-octet-stack) (position flexi-stream-position)) @@ -573,7 +398,7 @@ not 0 is returned, if PEEK-TYPE is an octet, the next octet which equals PEEK-TYPE is returned. EOF-ERROR-P and EOF-VALUE are interpreted as usual." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (loop for octet = (read-byte flexi-input-stream eof-error-p eof-value) until (cond ((null peek-type)) ((eql octet eof-value)) Added: trunk/io.lisp ============================================================================== --- (empty file) +++ trunk/io.lisp Wed May 21 08:00:42 2008 @@ -0,0 +1,110 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/io.lisp,v 1.2 2008/05/20 23:44:45 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defmethod reset-input-state ((flexi-io-stream flexi-io-stream)) + "This method is used to clear any state associated with previous +input before output is attempted on the stream. It can fail if the +octet stack is not empty and the stream can't be `rewound'." + (declare #.*standard-optimize-settings*) + (with-accessors ((last-char-code flexi-stream-last-char-code) + (last-octet flexi-stream-last-octet) + (octet-stack flexi-stream-octet-stack) + (stream flexi-stream-stream)) + flexi-io-stream + (when octet-stack + (unless (maybe-rewind stream (length octet-stack)) + (error 'flexi-stream-out-of-sync-error + :stream flexi-io-stream)) + (setq octet-stack nil)) + (setq last-octet nil + last-char-code nil))) + +(defmethod stream-write-byte :before ((stream flexi-io-stream) byte) + (declare #.*standard-optimize-settings*) + (declare (ignore byte)) + (reset-input-state stream)) + +(defmethod stream-write-char :before ((stream flexi-io-stream) char) + (declare #.*standard-optimize-settings*) + (declare (ignore char)) + (reset-input-state stream)) + +(defmethod stream-write-sequence :before ((stream flexi-io-stream) sequence start end &key) + (declare #.*standard-optimize-settings*) + (declare (ignore sequence start end)) + (reset-input-state stream)) + +(defmethod stream-clear-output :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-input-state stream)) + +(defmethod reset-output-state ((flexi-io-stream flexi-io-stream)) + "This method is used to clear any state associated with previous +output before the stream is used for input." + (declare #.*standard-optimize-settings*) + (with-accessors ((column flexi-stream-column)) + flexi-io-stream + (setq column nil))) + +(defmethod stream-read-byte :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-output-state stream)) + +(defmethod stream-read-char :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-output-state stream)) + +(defmethod stream-read-sequence :before ((stream flexi-io-stream) sequence start end &key) + (declare #.*standard-optimize-settings*) + (declare (ignore sequence start end)) + (reset-output-state stream)) + +(defmethod stream-unread-char :before ((stream flexi-io-stream) char) + (declare #.*standard-optimize-settings*) + (declare (ignore char)) + (reset-output-state stream)) + +(defmethod unread-byte :before (byte (stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (declare (ignore byte)) + (reset-output-state stream)) + +(defmethod stream-clear-input :before ((stream flexi-io-stream)) + (declare #.*standard-optimize-settings*) + (reset-output-state stream)) + +(defmethod write-byte* :after (byte (stream flexi-io-stream)) + "Keep POSITION slot up to date even when performing output." + (declare #.*standard-optimize-settings*) + (declare (ignore byte)) + (with-accessors ((position flexi-stream-position)) + stream + (incf position))) \ No newline at end of file Modified: trunk/iso-8859.lisp ============================================================================== --- trunk/iso-8859.lisp (original) +++ trunk/iso-8859.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.5 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.7 2008/05/18 21:32:15 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -32,22 +32,22 @@ ;;; the following code was auto-generated from files which can be ;;; found at <ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/> -(defvar +iso-8859-tables+ - '((:iso-8859-1 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) - (:iso-8859-2 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 728 321 164 317 346 167 168 352 350 356 377 173 381 379 176 261 731 322 180 318 347 711 184 353 351 357 378 733 382 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729)) - (:iso-8859-3 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 294 728 163 164 65533 292 167 168 304 350 286 308 173 65533 379 176 295 178 179 180 181 293 183 184 305 351 287 309 189 65533 380 192 193 194 65533 196 266 264 199 200 201 202 203 204 205 206 207 65533 209 210 211 212 288 214 215 284 217 218 219 220 364 348 223 224 225 226 65533 228 267 265 231 232 233 234 235 236 237 238 239 65533 241 242 243 244 289 246 247 285 249 250 251 252 365 349 729)) - (:iso-8859-4 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 312 342 164 296 315 167 168 352 274 290 358 173 381 175 176 261 731 343 180 297 316 711 184 353 275 291 359 330 382 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 298 272 325 332 310 212 213 214 215 216 370 218 219 220 360 362 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 299 273 326 333 311 244 245 246 247 248 371 250 251 252 361 363 729)) - (:iso-8859-5 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 173 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 8470 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 167 1118 1119)) - (:iso-8859-6 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 65533 65533 164 65533 65533 65533 65533 65533 65533 65533 1548 173 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 1563 65533 65533 65533 1567 65533 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 65533 65533 65533 65533 65533 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533)) - (:iso-8859-7 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8216 8217 163 8364 8367 166 167 168 169 890 171 172 173 65533 8213 176 177 178 179 900 901 902 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533)) - (:iso-8859-8 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 162 163 164 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 8215 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533)) - (:iso-8859-9 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255)) - (:iso-8859-10 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 274 290 298 296 310 167 315 272 352 358 381 173 362 330 176 261 275 291 299 297 311 183 316 273 353 359 382 8213 363 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 207 208 325 332 211 212 213 214 360 216 370 218 219 220 221 222 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 239 240 326 333 243 244 245 246 361 248 371 250 251 252 253 254 312)) - (:iso-8859-11 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 65533 65533 65533 65533 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 65533 65533 65533 65533)) - (:iso-8859-13 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8221 162 163 164 8222 166 167 216 169 342 171 172 173 174 198 176 177 178 179 8220 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 8217)) - (:iso-8859-14 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 7682 7683 163 266 267 7690 167 7808 169 7810 7691 7922 173 174 376 7710 7711 288 289 7744 7745 182 7766 7809 7767 7811 7776 7923 7812 7813 7777 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 372 209 210 211 212 213 214 7786 216 217 218 219 220 221 374 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 373 241 242 243 244 245 246 7787 248 249 250 251 252 253 375 255)) - (:iso-8859-15 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 8364 165 352 167 353 169 170 171 172 173 174 175 176 177 178 179 381 181 182 183 382 185 186 187 338 339 376 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) - (:iso-8859-16 . #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 261 321 8364 8222 352 167 353 169 536 171 377 173 378 379 176 177 268 322 381 8221 182 183 382 269 537 187 338 339 376 380 192 193 194 258 196 262 198 199 200 201 202 203 204 205 206 207 272 323 210 211 212 336 214 346 368 217 218 219 220 280 538 223 224 225 226 259 228 263 230 231 232 233 234 235 236 237 238 239 273 324 242 243 244 337 246 347 369 249 250 251 252 281 539 255))) +(defconstant +iso-8859-tables+ + `((:iso-8859-1 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))) + (:iso-8859-2 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 728 321 164 317 346 167 168 352 350 356 377 173 381 379 176 261 731 322 180 318 347 711 184 353 351 357 378 733 382 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729))) + (:iso-8859-3 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 294 728 163 164 65533 292 167 168 304 350 286 308 173 65533 379 176 295 178 179 180 181 293 183 184 305 351 287 309 189 65533 380 192 193 194 65533 196 266 264 199 200 201 202 203 204 205 206 207 65533 209 210 211 212 288 214 215 284 217 218 219 220 364 348 223 224 225 226 65533 228 267 265 231 232 233 234 235 236 237 238 239 65533 241 242 243 244 289 246 247 285 249 250 251 252 365 349 729))) + (:iso-8859-4 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 312 342 164 296 315 167 168 352 274 290 358 173 381 175 176 261 731 343 180 297 316 711 184 353 275 291 359 330 382 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 298 272 325 332 310 212 213 214 215 216 370 218 219 220 360 362 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 299 273 326 333 311 244 245 246 247 248 371 250 251 252 361 363 729))) + (:iso-8859-5 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 173 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 8470 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 167 1118 1119))) + (:iso-8859-6 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 65533 65533 164 65533 65533 65533 65533 65533 65533 65533 1548 173 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 1563 65533 65533 65533 1567 65533 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 65533 65533 65533 65533 65533 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533))) + (:iso-8859-7 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8216 8217 163 8364 8367 166 167 168 169 890 171 172 173 65533 8213 176 177 178 179 900 901 902 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533))) + (:iso-8859-8 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 162 163 164 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 8215 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533))) + (:iso-8859-9 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255))) + (:iso-8859-10 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 274 290 298 296 310 167 315 272 352 358 381 173 362 330 176 261 275 291 299 297 311 183 316 273 353 359 382 8213 363 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 207 208 325 332 211 212 213 214 360 216 370 218 219 220 221 222 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 239 240 326 333 243 244 245 246 361 248 371 250 251 252 253 254 312))) + (:iso-8859-11 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 65533 65533 65533 65533 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 65533 65533 65533 65533))) + (:iso-8859-13 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8221 162 163 164 8222 166 167 216 169 342 171 172 173 174 198 176 177 178 179 8220 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 8217))) + (:iso-8859-14 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 7682 7683 163 266 267 7690 167 7808 169 7810 7691 7922 173 174 376 7710 7711 288 289 7744 7745 182 7766 7809 7767 7811 7776 7923 7812 7813 7777 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 372 209 210 211 212 213 214 7786 216 217 218 219 220 221 374 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 373 241 242 243 244 245 246 7787 248 249 250 251 252 253 375 255))) + (:iso-8859-15 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 8364 165 352 167 353 169 170 171 172 173 174 175 176 177 178 179 381 181 182 183 382 185 186 187 338 339 376 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))) + (:iso-8859-16 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 261 321 8364 8222 352 167 353 169 536 171 377 173 378 379 176 177 268 322 381 8221 182 183 382 269 537 187 338 339 376 380 192 193 194 258 196 262 198 199 200 201 202 203 204 205 206 207 272 323 210 211 212 336 214 346 368 217 218 219 220 280 538 223 224 225 226 259 228 263 230 231 232 233 234 235 236 237 238 239 273 324 242 243 244 337 246 347 369 249 250 251 252 281 539 255)))) "A list of the ISO-8859 encodings where each element is a cons with the car being a keyword denoting the encoding and the cdr being a vector enumerating the corresponding character codes.") Modified: trunk/koi8-r.lisp ============================================================================== --- trunk/koi8-r.lisp (original) +++ trunk/koi8-r.lisp Wed May 21 08:00:42 2008 @@ -1,6 +1,36 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/koi8-r.lisp,v 1.2 2008/05/18 21:32:15 edi Exp $ + +;;; Copyright (c) 2006, Igor Plekhov. All rights reserved. +;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + (in-package :flexi-streams) ;; http://unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT -(defvar +koi8-r-table+ - #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 9472 9474 9484 9488 9492 9496 9500 9508 9516 9524 9532 9600 9604 9608 9612 9616 9617 9618 9619 8992 9632 8729 8730 8776 8804 8805 160 8993 176 178 183 247 9552 9553 9554 1105 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 1025 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 169 1102 1072 1073 1094 1076 1077 1092 1075 1093 1080 1081 1082 1083 1084 1085 1086 1087 1103 1088 1089 1090 1091 1078 1074 1100 1099 1079 1096 1101 1097 1095 1098 1070 1040 1041 1062 1044 1045 1060 1043 1061 1048 1049 1050 1051 1052 1053 1054 1055 1071 1056 1057 1058 1059 1046 1042 1068 1067 1047 1064 1069 1065 1063 1066) +(defconstant +koi8-r-table+ + (make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 9472 9474 9484 9488 9492 9496 9500 9508 9516 9524 9532 9600 9604 9608 9612 9616 9617 9618 9619 8992 9632 8729 8730 8776 8804 8805 160 8993 176 178 183 247 9552 9553 9554 1105 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 1025 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 169 1102 1072 1073 1094 1076 1077 1092 1075 1093 1080 1081 1082 1083 1084 1085 1086 1087 1103 1088 1089 1090 1091 1078 1074 1100 1099 1079 1096 1101 1097 1095 1098 1070 1040 1041 1062 1044 1045 1060 1043 1061 1048 1049 1050 1051 1052 1053 1054 1055 1071 1056 1057 1058 1059 1046 1042 1068 1067 1047 1064 1069 1065 1063 1066)) "An array enumerating the character codes for the KOI8-R encoding.") Modified: trunk/lw-binary-stream.lisp ============================================================================== --- trunk/lw-binary-stream.lisp (original) +++ trunk/lw-binary-stream.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.10 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.14 2008/05/18 23:13:59 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -48,394 +48,28 @@ optimizing input and output on LispWorks. See READ-BYTE* and WRITE-BYTE*.")) -(defclass flexi-binary-8-bit-input-stream (flexi-8-bit-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-8-BIT-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-input-stream (flexi-cr-mixin flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-input-stream (flexi-ascii-input-stream flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-ASCII-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-input-stream (flexi-cr-mixin flexi-binary-ascii-input-stream) - () - (:documentation "Like FLEXI-CR-ASCII-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-input-stream (flexi-latin-1-input-stream flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-LATIN-1-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-input-stream (flexi-cr-mixin flexi-binary-latin-1-input-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-input-stream (flexi-utf-32-le-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-input-stream (flexi-cr-mixin flexi-binary-utf-32-le-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-input-stream (flexi-utf-32-be-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-input-stream (flexi-cr-mixin flexi-binary-utf-32-be-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-input-stream (flexi-utf-16-le-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-input-stream (flexi-cr-mixin flexi-binary-utf-16-le-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-input-stream (flexi-utf-16-be-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-input-stream (flexi-cr-mixin flexi-binary-utf-16-be-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-input-stream (flexi-utf-8-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-8-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-input-stream (flexi-cr-mixin flexi-binary-utf-8-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-8-bit-output-stream (flexi-8-bit-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-8-BIT-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-output-stream (flexi-cr-mixin flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-output-stream (flexi-ascii-output-stream flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-ASCII-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-output-stream (flexi-cr-mixin flexi-binary-ascii-output-stream) - () - (:documentation "Like FLEXI-CR-ASCII-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-output-stream (flexi-latin-1-output-stream flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-LATIN-1-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-output-stream (flexi-cr-mixin flexi-binary-latin-1-output-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-output-stream (flexi-utf-32-le-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-output-stream (flexi-cr-mixin flexi-binary-utf-32-le-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-output-stream (flexi-utf-32-be-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-output-stream (flexi-cr-mixin flexi-binary-utf-32-be-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-output-stream (flexi-utf-16-le-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-output-stream (flexi-cr-mixin flexi-binary-utf-16-le-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-output-stream (flexi-utf-16-be-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-output-stream (flexi-cr-mixin flexi-binary-utf-16-be-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-output-stream (flexi-utf-8-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-8-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-output-stream (flexi-cr-mixin flexi-binary-utf-8-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-8-bit-io-stream (flexi-binary-io-stream flexi-8-bit-io-stream) - () - (:documentation "Like FLEXI-8-BIT-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-io-stream (flexi-cr-mixin flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-io-stream (flexi-ascii-io-stream flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-ASCII-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-io-stream (flexi-cr-mixin flexi-binary-ascii-io-stream) - () - (:documentation "Like FLEXI-CR-ASCII-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-io-stream (flexi-latin-1-io-stream flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-LATIN-1-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-io-stream (flexi-cr-mixin flexi-binary-latin-1-io-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-io-stream (flexi-utf-32-le-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-io-stream (flexi-cr-mixin flexi-binary-utf-32-le-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-io-stream (flexi-utf-32-be-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-io-stream (flexi-cr-mixin flexi-binary-utf-32-be-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-io-stream (flexi-utf-16-le-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-io-stream (flexi-cr-mixin flexi-binary-utf-16-le-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-io-stream (flexi-utf-16-be-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-io-stream (flexi-cr-mixin flexi-binary-utf-16-be-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-io-stream (flexi-utf-8-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-io-stream (flexi-cr-mixin flexi-binary-utf-8-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defmethod set-class ((stream flexi-binary-input-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-binary-cr-ascii-input-stream - 'flexi-binary-ascii-input-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-binary-cr-latin-1-input-stream - 'flexi-binary-latin-1-input-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-binary-cr-8-bit-input-stream - 'flexi-binary-8-bit-input-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-binary-cr-utf-8-input-stream - 'flexi-binary-utf-8-input-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-16-le-input-stream - 'flexi-binary-cr-utf-16-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-16-le-input-stream - 'flexi-binary-utf-16-be-input-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-32-le-input-stream - 'flexi-binary-cr-utf-32-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-32-le-input-stream - 'flexi-binary-utf-32-be-input-stream)))))))))) - -(defmethod set-class ((stream flexi-binary-output-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-binary-cr-ascii-output-stream - 'flexi-binary-ascii-output-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-binary-cr-latin-1-output-stream - 'flexi-binary-latin-1-output-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-binary-cr-8-bit-output-stream - 'flexi-binary-8-bit-output-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-binary-cr-utf-8-output-stream - 'flexi-binary-utf-8-output-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-16-le-output-stream - 'flexi-binary-cr-utf-16-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-16-le-output-stream - 'flexi-binary-utf-16-be-output-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-32-le-output-stream - 'flexi-binary-cr-utf-32-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-32-le-output-stream - 'flexi-binary-utf-32-be-output-stream)))))))))) - -(defmethod set-class ((stream flexi-binary-io-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-binary-cr-ascii-io-stream - 'flexi-binary-ascii-io-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-binary-cr-latin-1-io-stream - 'flexi-binary-latin-1-io-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-binary-cr-8-bit-io-stream - 'flexi-binary-8-bit-io-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-binary-cr-utf-8-io-stream - 'flexi-binary-utf-8-io-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-16-le-io-stream - 'flexi-binary-cr-utf-16-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-16-le-io-stream - 'flexi-binary-utf-16-be-io-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-binary-cr-utf-32-le-io-stream - 'flexi-binary-cr-utf-32-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-binary-utf-32-le-io-stream - 'flexi-binary-utf-32-be-io-stream)))))))))) - - (defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. Only needed for LispWorks." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((stream flexi-stream-stream)) flexi-stream (when (subtypep (stream-element-type stream) 'octet) (change-class flexi-stream (typecase flexi-stream (flexi-io-stream 'flexi-binary-io-stream) - (otherwise 'flexi-binary-output-stream))) - (set-class flexi-stream)))) + (otherwise 'flexi-binary-output-stream)))))) (defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. Only needed for LispWorks." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((stream flexi-stream-stream)) flexi-stream (when (subtypep (stream-element-type stream) 'octet) (change-class flexi-stream (typecase flexi-stream (flexi-io-stream 'flexi-binary-io-stream) - (otherwise 'flexi-binary-input-stream))) - (set-class flexi-stream)))) + (otherwise 'flexi-binary-input-stream)))))) Added: trunk/mapping.lisp ============================================================================== --- (empty file) +++ trunk/mapping.lisp Wed May 21 08:00:42 2008 @@ -0,0 +1,74 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.2 2008/05/20 21:15:45 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(deftype octet () + "A shortcut for \(UNSIGNED-BYTE 8)." + '(unsigned-byte 8)) + +(deftype char* () + "Convenience shortcut to paper over the difference between LispWorks +and the other Lisps." + #+:lispworks 'lw:simple-char + #-:lispworks 'character) + +(deftype char-code-integer () + "The subtype of integers which can be returned by the function CHAR-CODE." + '(integer 0 #.(1- char-code-limit))) + +(deftype code-point () + "The subtype of integers that's just big enough to hold all Unicode +codepoints. + +See for example <http://unicode.org/glossary/#C>." + '(mod #x110000)) + +(defmacro defconstant (name value &optional doc) + "Make sure VALUE is evaluated only once \(to appease SBCL)." + `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) + ,@(when doc (list doc)))) + +(defun invert-table (table) + "`Inverts' an array which maps octets to character codes to a hash +table which maps character codes to octets." + (let ((hash (make-hash-table))) + (loop for octet from 0 + for char-code across table + unless (= char-code 65533) + do (setf (gethash char-code hash) octet)) + hash)) + +(defun make-decoding-table (list) + "Creates and returns an array which contains the elements in the +list LIST and has an element type that's suitable for character +codes." + (make-array (length list) + :element-type 'char-code-integer + :initial-contents list)) \ No newline at end of file Modified: trunk/output.lisp ============================================================================== --- trunk/output.lisp (original) +++ trunk/output.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.44 2007/12/29 22:23:23 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.60 2008/05/21 01:26:43 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -29,173 +29,50 @@ (in-package :flexi-streams) -(defgeneric write-byte* (byte sink) +(defgeneric write-byte* (byte stream) + (declare #.*standard-optimize-settings*) (:documentation "Writes one byte \(octet) to the underlying stream -of SINK \(if SINK is a flexi stream) or adds the byte to the end of -SINK \(if SINK is an array with a fill pointer).")) +STREAM.")) #-:lispworks -(defmethod write-byte* (byte (sink flexi-output-stream)) - (declare (optimize speed)) +(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) - sink + flexi-output-stream (write-byte byte stream))) #+:lispworks -(defmethod write-byte* (byte (sink flexi-output-stream)) - (declare (optimize speed)) +(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream)) + (declare #.*standard-optimize-settings*) ;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all ;; bivalent streams in LispWorks (4.4.6) (with-accessors ((stream flexi-stream-stream)) - sink + flexi-output-stream (write-sequence (make-array 1 :element-type 'octet :initial-element byte) stream) byte)) #+:lispworks -(defmethod write-byte* (byte (sink flexi-binary-output-stream)) +(defmethod write-byte* (byte (flexi-output-stream flexi-binary-output-stream)) "Optimized version \(only needed for LispWorks) in case the underlying stream is binary." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) - sink + flexi-output-stream (write-byte byte stream))) -(defmethod write-byte* (byte (sink array)) - (declare (optimize speed)) - (vector-push byte sink)) - -(defgeneric char-to-octets (stream char sink) - (:documentation "Converts the character CHAR to sequence of octets -and sends this sequence to SINK. STREAM will always be a flexi stream -which is used to determine how the character should be converted. -This function does all the work for STREAM-WRITE-CHAR in which case -SINK is the same as STREAM. It is also used in the implementation of -STREAM-WRITE-SEQUENCE below.")) - (defmethod stream-write-char ((stream flexi-output-stream) char) - (declare (optimize speed)) - (char-to-octets stream char stream)) - -(defmethod char-to-octets ((stream flexi-latin-1-output-stream) char sink) - (declare (optimize speed)) - (let ((octet (char-code char))) - (when (> octet 255) - (signal-encoding-error stream "~S is not a LATIN-1 character." char)) - (write-byte* octet sink)) - char) - -(defmethod char-to-octets ((stream flexi-ascii-output-stream) char sink) - (declare (optimize speed)) - (let ((octet (char-code char))) - (when (> octet 127) - (signal-encoding-error stream "~S is not an ASCII character." char)) - (write-byte* octet sink)) - char) - -(defmethod char-to-octets ((stream flexi-8-bit-output-stream) char sink) - (declare (optimize speed)) - (with-accessors ((encoding-hash flexi-stream-encoding-hash)) - stream - (let ((octet (gethash (char-code char) encoding-hash))) - (unless octet - (signal-encoding-error stream "~S is not in this encoding." char)) - (write-byte* octet sink)) - char)) - -(defmethod char-to-octets ((stream flexi-utf-8-output-stream) char sink) - (declare (optimize speed)) - (let ((char-code (char-code char))) - (tagbody - (cond ((< char-code #x80) - (write-byte* char-code sink) - (go zero)) - ((< char-code #x800) - (write-byte* (logior #b11000000 (ldb (byte 5 6) char-code)) sink) - (go one)) - ((< char-code #x10000) - (write-byte* (logior #b11100000 (ldb (byte 4 12) char-code)) sink) - (go two)) - ((< char-code #x200000) - (write-byte* (logior #b11110000 (ldb (byte 3 18) char-code)) sink) - (go three)) - ((< char-code #x4000000) - (write-byte* (logior #b11111000 (ldb (byte 2 24) char-code)) sink) - (go four)) - (t (write-byte* (logior #b11111100 (ldb (byte 1 30) char-code)) sink))) - (write-byte* (logior #b10000000 (ldb (byte 6 24) char-code)) sink) - four - (write-byte* (logior #b10000000 (ldb (byte 6 18) char-code)) sink) - three - (write-byte* (logior #b10000000 (ldb (byte 6 12) char-code)) sink) - two - (write-byte* (logior #b10000000 (ldb (byte 6 6) char-code)) sink) - one - (write-byte* (logior #b10000000 (ldb (byte 6 0) char-code)) sink) - zero)) - char) - -(defmethod char-to-octets ((stream flexi-utf-16-le-output-stream) char sink) - (declare (optimize speed)) - (flet ((write-word (word) - (write-byte* (ldb (byte 8 0) word) sink) - (write-byte* (ldb (byte 8 8) word) sink))) - (declare (inline write-word) (dynamic-extent (function write-word))) - (let ((char-code (char-code char))) - (cond ((< char-code #x10000) - (write-word char-code)) - (t (decf char-code #x10000) - (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) - char) - -(defmethod char-to-octets ((stream flexi-utf-16-be-output-stream) char sink) - (declare (optimize speed)) - (flet ((write-word (word) - (write-byte* (ldb (byte 8 8) word) sink) - (write-byte* (ldb (byte 8 0) word) sink))) - (declare (inline write-word) (dynamic-extent (function write-word))) - (let ((char-code (char-code char))) - (cond ((< char-code #x10000) - (write-word char-code)) - (t (decf char-code #x10000) - (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))) - char) - -(defmethod char-to-octets ((stream flexi-utf-32-le-output-stream) char sink) - (declare (optimize speed)) - (loop with char-code = (char-code char) - for position in '(0 8 16 24) do - (write-byte* (ldb (byte 8 position) char-code) sink)) - char) - -(defmethod char-to-octets ((stream flexi-utf-32-be-output-stream) char sink) - (declare (optimize speed)) - (loop with char-code = (char-code char) - for position in '(24 16 8 0) do - (write-byte* (ldb (byte 8 position) char-code) sink)) - char) - -(defmethod char-to-octets ((stream flexi-cr-mixin) char sink) - "The `base' method for all streams which need end-of-line -conversion. Uses CALL-NEXT-METHOD to do the actual work of sending -one or more characters to SINK." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((external-format flexi-stream-external-format)) stream - (case char - (#\Newline - (case (external-format-eol-style external-format) - (:cr (call-next-method stream #\Return sink)) - (:crlf (call-next-method stream #\Return sink) - (call-next-method stream #\Linefeed sink)))) - (otherwise (call-next-method))) - char)) + (flet ((writer (octet) + (write-byte* octet stream))) + (declare (dynamic-extent (function writer))) + (char-to-octets external-format char #'writer)))) (defmethod stream-write-char :after ((stream flexi-output-stream) char) - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; update the column unless we're in the middle of the line and ;; the current value is NIL (with-accessors ((column flexi-stream-column)) @@ -206,7 +83,7 @@ (defmethod stream-clear-output ((flexi-output-stream flexi-output-stream)) "Simply calls the corresponding method for the underlying output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) flexi-output-stream (clear-output stream))) @@ -214,7 +91,7 @@ (defmethod stream-finish-output ((flexi-output-stream flexi-output-stream)) "Simply calls the corresponding method for the underlying output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) flexi-output-stream (finish-output stream))) @@ -222,7 +99,7 @@ (defmethod stream-force-output ((flexi-output-stream flexi-output-stream)) "Simply calls the corresponding method for the underlying output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) flexi-output-stream (force-output stream))) @@ -230,14 +107,14 @@ (defmethod stream-line-column ((flexi-output-stream flexi-output-stream)) "Returns the column stored in the COLUMN slot of the FLEXI-OUTPUT-STREAM object STREAM." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((column flexi-stream-column)) flexi-output-stream column)) (defmethod stream-write-byte ((flexi-output-stream flexi-output-stream) byte) "Writes a byte \(octet) to the underlying stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((column flexi-stream-column)) flexi-output-stream ;; set column to NIL because we don't know how to handle binary @@ -248,69 +125,95 @@ #+:allegro (defmethod stream-terpri ((stream flexi-output-stream)) "Writes a #\Newline character to the underlying stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) ;; needed for AllegroCL - grrr... (stream-write-char stream #\Newline)) -(defmethod stream-write-sequence ((flexi-output-stream flexi-output-stream) sequence start end &key) - "Writes all elements of the sequence SEQUENCE from START to END -to the underlying stream. The elements can be either octets or -characters. Characters are output according to the current -encoding \(external format) of the FLEXI-OUTPUT-STREAM object -STREAM." - (declare (optimize speed) - (type (integer 0 *) start end)) - (with-accessors ((stream flexi-stream-stream) - (column flexi-stream-column)) - flexi-output-stream - (cond ((and (arrayp sequence) - (subtypep (array-element-type sequence) 'octet)) - ;; set column to NIL because we don't know how to handle binary - ;; output mixed with character output - (setq column nil) - (write-sequence sequence stream :start start :end end)) - (t (loop for index from start below end - for element = (elt sequence index) - when (characterp element) do - (stream-write-char flexi-output-stream element) - else do - (stream-write-byte flexi-output-stream element)) - sequence)))) - -(defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key) - "Optimized method for the cases where SEQUENCE is a string. Fills -an internal buffer and uses repeated calls to WRITE-SEQUENCE to write -to the underlying stream." - (declare (optimize speed) - (type (integer 0 *) start end)) - ;; don't use this optimized method for bivalent character streams on - ;; LispWorks, as it currently gets confused by the fill pointer - #+:lispworks - (unless (typep stream 'flexi-binary-output-stream) - (return-from stream-write-sequence - (call-next-method))) - (let* ((buffer (make-array (+ +buffer-size+ 20) - :element-type '(unsigned-byte 8) - :fill-pointer 0)) - (last-newline-pos (position #\Newline sequence - :test #'char= - :start start - :end end - :from-end t))) - (loop for index from start below end - do (char-to-octets stream (aref sequence index) buffer) - when (>= (fill-pointer buffer) +buffer-size+) do - (write-sequence buffer (flexi-stream-stream stream)) - (setf (fill-pointer buffer) 0) - finally (when (>= (fill-pointer buffer) 0) - (write-sequence buffer (flexi-stream-stream stream)))) - (setf (flexi-stream-column stream) - (cond (last-newline-pos (- end last-newline-pos 1)) - ((flexi-stream-column stream) - (+ (flexi-stream-column stream) (- end start)))))) +(defmethod stream-write-sequence ((stream flexi-output-stream) sequence start end &key) + "An optimized version which uses a buffer underneath. The function +can accepts characters as well as octets and it decides what to do +based on the element type of the sequence \(if possible) or on the +individual elements, i.e. you can mix characters and octets in +SEQUENCE if you want. Whether that really works might also depend on +your Lisp, some of the implementations are more picky than others." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((column flexi-stream-column) + (external-format flexi-stream-external-format) + (stream flexi-stream-stream)) + stream + (let* ((octet-seen-p nil) + (buffer-pos 0) + ;; whether we might receive characters and thus the number + ;; of octets to output might not be equal to the number of + ;; sequence elements to write + (chars-p (or (listp sequence) + (and (vectorp sequence) + (not (subtypep (array-element-type sequence) 'integer))))) + (factor (if chars-p (encoding-factor external-format) 1)) + (buffer-size (min +buffer-size+ (ceiling (* factor (- end start))))) + (buffer (make-octet-buffer buffer-size))) + (declare (fixnum buffer-pos buffer-size) + (boolean octet-seen-p) + (type (array octet *) buffer)) + (labels ((flush-buffer () + "Sends all octets in BUFFER to the underlying stream." + (write-sequence buffer stream :end buffer-pos) + (setq buffer-pos 0)) + (write-octet (octet) + "Adds one octet to the buffer and flush it if necessary." + (declare (octet octet)) + (when (>= buffer-pos buffer-size) + (flush-buffer)) + (setf (aref buffer buffer-pos) octet) + (incf buffer-pos)) + (write-character (char) + "Adds the octets representing the character CHAR to the buffer." + (char-to-octets external-format char #'write-octet)) + (write-object (object) + "Dispatches to WRITE-OCTET or WRITE-CHARACTER +depending on the type of OBJECT." + (etypecase object + (octet (setq octet-seen-p t) + (write-octet object)) + (character (write-character object))))) + (declare (dynamic-extent (function write-octet))) + (macrolet ((iterate (octets-p output-form) + "An unhygienic macro to implement the actual +iteration through SEQUENCE. OUTPUT-FORM is the form to retrieve one +sequence element and put its octet representation into the buffer. +OCTETS-P is true if we know in advance that we will send octets." + `(progn + ,@(if octets-p '((setq octet-seen-p t))) + (loop for index of-type fixnum from start below end + do ,output-form + finally (when (plusp buffer-pos) + (flush-buffer)))))) + (etypecase sequence + (string (iterate nil (write-character (char sequence index)))) + (array + (let ((array-element-type (array-element-type sequence))) + (cond ((type-equal array-element-type 'octet) + (iterate t (write-octet (aref (the (array octet *) sequence) index)))) + ((subtypep array-element-type 'integer) + (iterate t (write-octet (aref sequence index)))) + (t (iterate nil (write-object (aref sequence index))))))) + (list (iterate nil (write-object (nth index sequence))))) + ;; update the column slot, setting if to NIL if we sent octets + (setq column + (cond (octet-seen-p nil) + (t (let ((last-newline-pos (position #\Newline sequence + :test #'char= + :start start + :end end + :from-end t))) + (cond (last-newline-pos (- end last-newline-pos 1)) + (column (+ column (- end start)))))))))))) + sequence) (defmethod stream-write-string ((stream flexi-output-stream) string &optional (start 0) (end (length string))) "Simply hands over to the optimized method for STREAM-WRITE-SEQUENCE." + (declare #.*standard-optimize-settings*) (stream-write-sequence stream string start (or end (length string)))) Modified: trunk/packages.lisp ============================================================================== --- trunk/packages.lisp (original) +++ trunk/packages.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.30 2007/10/11 20:23:53 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.35 2008/05/21 01:43:43 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -34,13 +34,16 @@ (defpackage :flexi-streams (:use :cl :trivial-gray-streams) - (:nicknames :flex) - #+:lispworks - (:shadow :with-accessors) + (:nicknames :flex) + (:shadow #+:lispworks :with-accessors + :defconstant) (:export :*default-eol-style* :*default-little-endian* :*substitution-char* :external-format-eol-style + :external-format-error + :external-format-error-external-format + :external-format-encoding-error :external-format-equal :external-format-id :external-format-little-endian @@ -50,21 +53,21 @@ :flexi-io-stream :flexi-stream :flexi-stream-bound + :flexi-stream-column :flexi-stream-external-format - :flexi-stream-encoding-error :flexi-stream-element-type :flexi-stream-element-type-error :flexi-stream-element-type-error-element-type :flexi-stream-error - :flexi-stream-column + :flexi-stream-out-of-sync-error :flexi-stream-position - :flexi-stream-position-spec-error - :flexi-stream-position-spec-error-position-spec :flexi-stream-stream :get-output-stream-sequence :in-memory-stream :in-memory-stream-closed-error :in-memory-stream-error + :in-memory-stream-position-spec-error + :in-memory-stream-position-spec-error-position-spec :in-memory-input-stream :in-memory-output-stream :list-stream @@ -73,6 +76,7 @@ :make-in-memory-output-stream :make-flexi-stream :octet + :octet-length :octets-to-string :output-stream-sequence-length :peek-byte Modified: trunk/specials.lisp ============================================================================== --- trunk/specials.lisp (original) +++ trunk/specials.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.25 2007/12/29 21:17:06 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.32 2008/05/20 23:01:51 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -29,9 +29,32 @@ (in-package :flexi-streams) -(deftype octet () - "A shortcut for \(UNSIGNED-BYTE 8)." - '(unsigned-byte 8)) +(defvar *standard-optimize-settings* + '(optimize + speed + (safety 0) + (space 0) + (debug 1) + (compilation-speed 0)) + "The standard optimize settings used by most declaration expressions.") + +(defvar *fixnum-optimize-settings* + '(optimize + speed + (safety 0) + (space 0) + (debug 1) + (compilation-speed 0) + #+:lispworks (hcl:fixnum-safety 0)) + "Like *STANDARD-OPTIMIZE-SETTINGS*, but \(on LispWorks) with all +arithmetic being fixnum arithmetic.") + +(defvar *current-unreader* nil + "A unary function which might be called to `unread' a character +\(i.e. the sequence of octets it represents). + +Used by the function OCTETS-TO-CHAR-CODE and must always be bound to a +suitable functional object when this function is called.") (defvar +name-map+ '((:utf8 . :utf-8) @@ -129,38 +152,28 @@ \(as if by a USE-VALUE restart) whenever during reading an error of type FLEXI-STREAM-ENCODING-ERROR would have been signalled otherwise.") -(defun invert-table (table) - "`Inverts' an array which maps octets to character codes to a -hash tables which maps character codes to octets." - (let ((hash (make-hash-table))) - (loop for octet from 0 - for char-code across table - unless (= char-code 65533) - do (setf (gethash char-code hash) octet)) - hash)) - -(defvar +iso-8859-hashes+ +(defconstant +iso-8859-hashes+ (loop for (name . table) in +iso-8859-tables+ collect (cons name (invert-table table))) "An alist which maps names for ISO-8859 encodings to hash tables which map character codes to the corresponding octets.") -(defvar +code-page-hashes+ +(defconstant +code-page-hashes+ (loop for (id . table) in +code-page-tables+ collect (cons id (invert-table table))) "An alist which maps IDs of Windows code pages to hash tables which map character codes to the corresponding octets.") -(defvar +ascii-hash+ (invert-table +ascii-table+) +(defconstant +ascii-hash+ (invert-table +ascii-table+) "A hash table which maps US-ASCII character codes to the corresponding octets.") -(defvar +koi8-r-hash+ (invert-table +koi8-r-table+) +(defconstant +koi8-r-hash+ (invert-table +koi8-r-table+) "A hash table which maps KOI8-R character codes to the corresponding octets.") (defconstant +buffer-size+ 8192 - "Size of buffers used for internal purposes.") + "Default size for buffers used for internal purposes.") (pushnew :flexi-streams *features*) Modified: trunk/stream.lisp ============================================================================== --- trunk/stream.lisp (original) +++ trunk/stream.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.53 2007/12/29 22:26:04 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.61 2008/05/19 22:32:56 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -40,7 +40,7 @@ :accessor flexi-stream-external-format :documentation "The encoding currently used by this stream. Can be changed on the fly.") - (element-type :initform #+:lispworks 'lw:simple-char #-:lispworks 'character + (element-type :initform 'char* :initarg :element-type :accessor flexi-stream-element-type :documentation "The element type of this stream.")) @@ -49,59 +49,11 @@ allow for multi-octet external formats. FLEXI-STREAM itself is a mixin and should not be instantiated.")) -(define-condition flexi-stream-error (stream-error) - () - (:documentation "Superclass for all errors related to -flexi streams.")) - -(define-condition flexi-stream-simple-error (flexi-stream-error simple-condition) - () - (:documentation "Like FLEXI-STREAM-ERROR but with formatting -capabilities.")) - -(define-condition flexi-stream-element-type-error (flexi-stream-error) - ((element-type :initarg :element-type - :reader flexi-stream-element-type-error-element-type)) - (:report (lambda (condition stream) - (format stream "Element type ~S not allowed." - (flexi-stream-element-type-error-element-type condition)))) - (:documentation "Errors of this type are signalled if the flexi -stream has a wrong element type.")) - -(define-condition flexi-stream-encoding-error (flexi-stream-simple-error) - () - (:documentation "Errors of this type are signalled if there is an -encoding problem.")) - -(define-condition flexi-stream-position-spec-error (flexi-stream-simple-error) - ((position-spec :initarg :position-spec - :reader flexi-stream-position-spec-error-position-spec)) - (:documentation "Errors of this type are signalled if an -erroneous position spec is used in conjunction with -FILE-POSITION.")) - -(defun signal-encoding-error (flexi-stream format-control &rest format-args) - "Convenience function similar to ERROR to signal conditions of type -FLEXI-STREAM-ENCODING-ERROR." - (error 'flexi-stream-encoding-error - :format-control format-control - :format-arguments format-args - :stream flexi-stream)) - -(defun maybe-convert-external-format (external-format) - "Given an external format designator \(a keyword, a list, or an -EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT -object." - (typecase external-format - (symbol (make-external-format external-format)) - (list (apply #'make-external-format external-format)) - (otherwise external-format))) - (defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs) "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain reasonable values." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((external-format flexi-stream-external-format) (element-type flexi-stream-element-type)) flexi-stream @@ -110,19 +62,19 @@ (error 'flexi-stream-element-type-error :element-type element-type :stream flexi-stream)) - (setq external-format (maybe-convert-external-format external-format))) - ;; set actual class and maybe contents of 8-bit encoding slots - (set-class flexi-stream)) + (setq external-format (maybe-convert-external-format external-format)))) (defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream)) "Converts the new value to an EXTERNAL-FORMAT object if necessary." + (declare #.*standard-optimize-settings*) (call-next-method (maybe-convert-external-format new-value) flexi-stream)) (defmethod (setf flexi-stream-element-type) :before (new-value (flexi-stream flexi-stream)) "Checks whether the new value makes sense before it is set." + (declare #.*standard-optimize-settings*) (unless (or (subtypep new-value 'character) - (subtypep new-value 'octet)) + (type-equal new-value 'octet)) (error 'flexi-stream-element-type-error :element-type new-value :stream flexi-stream))) @@ -130,13 +82,15 @@ (defmethod stream-element-type ((stream flexi-stream)) "Returns the element type that was provided by the creator of the stream." - (declare (optimize speed)) - (flexi-stream-element-type stream)) + (declare #.*standard-optimize-settings*) + (with-accessors ((element-type flexi-stream-element-type)) + stream + element-type)) (defmethod close ((stream flexi-stream) &key abort) "Closes the flexi stream by closing the underlying `real' stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) stream (cond ((open-stream-p stream) @@ -145,19 +99,24 @@ (defmethod open-stream-p ((stream flexi-stream)) "A flexi stream is open if its underlying stream is open." - (declare (optimize speed)) - (open-stream-p (flexi-stream-stream stream))) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (open-stream-p stream))) (defmethod stream-file-position ((stream flexi-stream)) "Dispatch to method for underlying stream." - (declare (optimize speed)) - (stream-file-position (flexi-stream-stream stream))) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (stream-file-position stream))) (defmethod (setf stream-file-position) (position-spec (stream flexi-stream)) "Dispatch to method for underlying stream." - (declare (optimize speed)) - (setf (stream-file-position (flexi-stream-stream stream)) - position-spec)) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (setf (stream-file-position stream) position-spec))) (defclass flexi-output-stream (flexi-stream fundamental-binary-output-stream fundamental-character-output-stream) @@ -173,7 +132,7 @@ #+:cmu (defmethod input-stream-p ((stream flexi-output-stream)) "Explicitly states whether this is an input stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) nil) (defclass flexi-input-stream (flexi-stream fundamental-binary-input-stream @@ -216,7 +175,7 @@ #+:cmu (defmethod output-stream-p ((stream flexi-input-stream)) "Explicitly states whether this is an output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) nil) (defclass flexi-io-stream (flexi-input-stream flexi-output-stream) @@ -226,471 +185,16 @@ MAKE-INSTANCE to create a new FLEXI-IO-STREAM but use MAKE-FLEXI-STREAM instead.")) -(defclass flexi-cr-mixin () - () - (:documentation "A mixin for flexi streams which need -end-of-line conversion, i.e. for those where the end-of-line -designator is /not/ the single character #\Linefeed.")) - -(defclass flexi-8-bit-stream (flexi-stream) - ((encoding-hash :accessor flexi-stream-encoding-hash)) - (:documentation "The class for all flexi streams which use an 8-bit -encoding and thus need an additional slot for the encoding hash.")) - -(defclass flexi-8-bit-input-stream (flexi-input-stream flexi-8-bit-stream) - ((encoding-table :accessor flexi-stream-encoding-table)) - (:documentation "The class for all flexi input streams which use an -8-bit encoding and thus need an additional slot for the encoding -table.")) - -(defclass flexi-cr-8-bit-input-stream (flexi-cr-mixin flexi-8-bit-input-stream) - () - (:documentation "The class for all flexi input streams which -use an 8-bit encoding /and/ need end-of-line conversion.")) - -(defclass flexi-ascii-input-stream (flexi-8-bit-input-stream) - () - (:documentation "Special class for flexi input streams which -use the US-ASCCI encoding.")) - -(defclass flexi-cr-ascii-input-stream (flexi-cr-mixin flexi-ascii-input-stream) - () - (:documentation "Special class for flexi input streams which -use the US-ASCCI encoding /and/ need end-of-line conversion.")) - -(defclass flexi-latin-1-input-stream (flexi-8-bit-input-stream) - () - (:documentation "Special class for flexi input streams which -use the ISO-8859-1 encoding.")) - -(defclass flexi-cr-latin-1-input-stream (flexi-cr-mixin flexi-latin-1-input-stream) - () - (:documentation "Special class for flexi input streams which -use the ISO-8859-1 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-utf-32-le-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-32-le-input-stream (flexi-cr-mixin flexi-utf-32-le-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-32-be-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-32-be-input-stream (flexi-cr-mixin flexi-utf-32-be-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-32 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-le-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-16-le-input-stream (flexi-cr-mixin flexi-utf-16-le-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-16-be-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-16-be-input-stream (flexi-cr-mixin flexi-utf-16-be-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-16 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-8-input-stream (flexi-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-8 encoding.")) - -(defclass flexi-cr-utf-8-input-stream (flexi-cr-mixin flexi-utf-8-input-stream) - () - (:documentation "Special class for flexi input streams which -use the UTF-8 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-8-bit-output-stream (flexi-output-stream flexi-8-bit-stream) - () - (:documentation "The class for all flexi output streams which use an -8-bit encoding.")) - -(defclass flexi-cr-8-bit-output-stream (flexi-cr-mixin flexi-8-bit-output-stream) - () - (:documentation "The class for all flexi output streams which -use an 8-bit encoding /and/ need end-of-line conversion.")) - -(defclass flexi-ascii-output-stream (flexi-8-bit-output-stream) - () - (:documentation "Special class for flexi output streams which -use the US-ASCCI encoding.")) - -(defclass flexi-cr-ascii-output-stream (flexi-cr-mixin flexi-ascii-output-stream) - () - (:documentation "Special class for flexi output streams which -use the US-ASCCI encoding /and/ need end-of-line conversion.")) - -(defclass flexi-latin-1-output-stream (flexi-8-bit-output-stream) - () - (:documentation "Special class for flexi output streams which -use the ISO-8859-1 encoding.")) - -(defclass flexi-cr-latin-1-output-stream (flexi-cr-mixin flexi-latin-1-output-stream) - () - (:documentation "Special class for flexi output streams which -use the ISO-8859-1 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-utf-32-le-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-32-le-output-stream (flexi-cr-mixin flexi-utf-32-le-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-32-be-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-32-be-output-stream (flexi-cr-mixin flexi-utf-32-be-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-32 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-le-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-16-le-output-stream (flexi-cr-mixin flexi-utf-16-le-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with little-endian byte ordering /and/ -need end-of-line conversion.")) - -(defclass flexi-utf-16-be-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-16-be-output-stream (flexi-cr-mixin flexi-utf-16-be-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-16 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-8-output-stream (flexi-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-8 encoding.")) - -(defclass flexi-cr-utf-8-output-stream (flexi-cr-mixin flexi-utf-8-output-stream) - () - (:documentation "Special class for flexi output streams which -use the UTF-8 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-8-bit-io-stream (flexi-8-bit-input-stream flexi-8-bit-output-stream flexi-io-stream) - () - (:documentation "The class for all flexi I/O streams which use an -8-bit encoding.")) - -(defclass flexi-cr-8-bit-io-stream (flexi-cr-mixin flexi-8-bit-io-stream) - () - (:documentation "The class for all flexi I/O streams which use -an 8-bit encoding /and/ need end-of-line conversion.")) - -(defclass flexi-ascii-io-stream (flexi-ascii-input-stream flexi-ascii-output-stream flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the US-ASCCI encoding.")) - -(defclass flexi-cr-ascii-io-stream (flexi-cr-mixin flexi-ascii-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the US-ASCCI encoding /and/ need end-of-line conversion.")) - -(defclass flexi-latin-1-io-stream (flexi-latin-1-input-stream flexi-latin-1-output-stream flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the ISO-8859-1 encoding.")) - -(defclass flexi-cr-latin-1-io-stream (flexi-cr-mixin flexi-latin-1-io-stream) - () - (:documentation "Special class for flexi input streams which -use the ISO-8859-1 encoding /and/ need end-of-line conversion.")) - -(defclass flexi-utf-32-le-io-stream (flexi-utf-32-le-input-stream - flexi-utf-32-le-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-32-le-io-stream (flexi-cr-mixin flexi-utf-32-le-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with little-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-32-be-io-stream (flexi-utf-32-be-input-stream - flexi-utf-32-be-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-32-be-io-stream (flexi-cr-mixin flexi-utf-32-be-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-32 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-le-io-stream (flexi-utf-16-le-input-stream - flexi-utf-16-le-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with little-endian byte ordering.")) - -(defclass flexi-cr-utf-16-le-io-stream (flexi-cr-mixin flexi-utf-16-le-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with little-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-16-be-io-stream (flexi-utf-16-be-input-stream - flexi-utf-16-be-output-stream - flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with big-endian byte ordering.")) - -(defclass flexi-cr-utf-16-be-io-stream (flexi-cr-mixin flexi-utf-16-be-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-16 encoding with big-endian byte ordering /and/ need -end-of-line conversion.")) - -(defclass flexi-utf-8-io-stream (flexi-utf-8-input-stream flexi-utf-8-output-stream flexi-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-8 encoding.")) - -(defclass flexi-cr-utf-8-io-stream (flexi-cr-mixin flexi-utf-8-io-stream) - () - (:documentation "Special class for flexi I/O streams which use -the UTF-8 encoding /and/ need end-of-line conversion.")) - -(defmethod (setf flexi-stream-external-format) :after (new-value (stream flexi-stream)) - "After we've changed the external format of a flexi stream, we -might have to change its actual class and maybe also the contents -of its 8-bit encoding slots." - (declare (ignore new-value) - (optimize speed)) - ;; note that it's potentially dangerous to call SET-CLASS from - ;; within a method, see for example this thread: - ;; <http://thread.gmane.org/gmane.lisp.lispworks.general/6269> - (set-class stream)) - -(defmethod set-class ((stream flexi-input-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-cr-ascii-input-stream - 'flexi-ascii-input-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-cr-latin-1-input-stream - 'flexi-latin-1-input-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-cr-8-bit-input-stream - 'flexi-8-bit-input-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-cr-utf-8-input-stream - 'flexi-utf-8-input-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-16-le-input-stream - 'flexi-cr-utf-16-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-16-le-input-stream - 'flexi-utf-16-be-input-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-32-le-input-stream - 'flexi-cr-utf-32-be-input-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-32-le-input-stream - 'flexi-utf-32-be-input-stream)))))))))) - -(defmethod set-class ((stream flexi-output-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-cr-ascii-output-stream - 'flexi-ascii-output-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-cr-latin-1-output-stream - 'flexi-latin-1-output-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-cr-8-bit-output-stream - 'flexi-8-bit-output-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-cr-utf-8-output-stream - 'flexi-utf-8-output-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-16-le-output-stream - 'flexi-cr-utf-16-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-16-le-output-stream - 'flexi-utf-16-be-output-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-32-le-output-stream - 'flexi-cr-utf-32-be-output-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-32-le-output-stream - 'flexi-utf-32-be-output-stream)))))))))) - -(defmethod set-class ((stream flexi-io-stream)) - "Changes the actual class of STREAM depending on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format)) - stream - (let ((external-format-name (external-format-name external-format)) - (external-format-cr (not (eq (external-format-eol-style external-format) :lf)))) - (change-class stream - (cond ((ascii-name-p external-format-name) - (if external-format-cr - 'flexi-cr-ascii-io-stream - 'flexi-ascii-io-stream)) - ((eq external-format-name :iso-8859-1) - (if external-format-cr - 'flexi-cr-latin-1-io-stream - 'flexi-latin-1-io-stream)) - ((or (koi8-r-name-p external-format-name) - (iso-8859-name-p external-format-name) - (code-page-name-p external-format-name)) - (if external-format-cr - 'flexi-cr-8-bit-io-stream - 'flexi-8-bit-io-stream)) - (t (case external-format-name - (:utf-8 (if external-format-cr - 'flexi-cr-utf-8-io-stream - 'flexi-utf-8-io-stream)) - (:utf-16 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-16-le-io-stream - 'flexi-cr-utf-16-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-16-le-io-stream - 'flexi-utf-16-be-io-stream))) - (:utf-32 (if external-format-cr - (if (external-format-little-endian external-format) - 'flexi-cr-utf-32-le-io-stream - 'flexi-cr-utf-32-be-io-stream) - (if (external-format-little-endian external-format) - 'flexi-utf-32-le-io-stream - 'flexi-utf-32-be-io-stream)))))))))) - -(defmethod set-class :after ((stream flexi-stream)) - "After we've changed the actual class of a flexi stream we may -have to set the contents of the 8-bit enconding slots as well." - (declare (optimize speed)) - (set-encoding-hash stream) - (set-encoding-table stream)) - -(defgeneric set-encoding-hash (stream) - (:method (stream)) - (:documentation "Sets the value of the ENCODING-HASH slot of -STREAM if necessary. The default method does nothing.")) - -(defgeneric set-encoding-table (stream) - (:method (stream)) - (:documentation "Sets the value of the ENCODING-TABLE slot of -STREAM if necessary. The default method does nothing.")) - -(defmethod set-encoding-hash ((stream flexi-8-bit-stream)) - "Sets the value of the ENCODING-HASH slot of STREAM depending -on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format) - (encoding-hash flexi-stream-encoding-hash)) - stream - (let ((external-format-name (external-format-name external-format))) - (setq encoding-hash - (cond ((ascii-name-p external-format-name) +ascii-hash+) - ((koi8-r-name-p external-format-name) +koi8-r-hash+) - ((iso-8859-name-p external-format-name) - (cdr (assoc external-format-name +iso-8859-hashes+ :test #'eq))) - ((code-page-name-p external-format-name) - (cdr (assoc (external-format-id external-format) +code-page-hashes+)))))))) - -(defmethod set-encoding-table ((stream flexi-8-bit-input-stream)) - "Sets the value of the ENCODING-TABLE slot of STREAM depending -on its external format." - (declare (optimize speed)) - (with-accessors ((external-format flexi-stream-external-format) - (encoding-table flexi-stream-encoding-table)) - stream - (let ((external-format-name (external-format-name external-format))) - (setq encoding-table - (cond ((ascii-name-p external-format-name) +ascii-table+) - ((koi8-r-name-p external-format-name) +koi8-r-table+) - ((iso-8859-name-p external-format-name) - (cdr (assoc external-format-name +iso-8859-tables+ :test #'eq))) - ((code-page-name-p external-format-name) - (cdr (assoc (external-format-id external-format) +code-page-tables+)))))))) - #+:cmu (defmethod input-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an input stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) t) #+:cmu (defmethod output-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) t) (defun make-flexi-stream (stream &rest args @@ -712,6 +216,7 @@ streams) should be NIL or an integer. If BOUND is not NIL and POSITION has gone beyond BOUND, then the stream will behave as if no more input is available." + (declare #.*standard-optimize-settings*) ;; these arguments are ignored - they are only there to provide a ;; meaningful parameter list for IDEs (declare (ignore element-type column position bound)) Modified: trunk/strings.lisp ============================================================================== --- trunk/strings.lisp (original) +++ trunk/strings.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.4 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.22 2008/05/21 01:43:43 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -29,28 +29,145 @@ (in-package :flexi-streams) -(defun string-to-octets (string &key (external-format (make-external-format :latin1)) - (start 0) end) +(defun string-to-octets (string &key + (external-format :latin1) + (start 0) (end (length string))) "Converts the Lisp string STRING from START to END to an array of -octets corresponding to the external format EXTERNAL-FORMAT." - (declare (optimize speed)) - (with-output-to-sequence (out) - (let ((flexi (make-flexi-stream out :external-format external-format))) - (write-string string flexi :start start :end end)))) - -(defun octets-to-string (vector &key (external-format (make-external-format :latin1)) - (start 0) (end (length vector))) - "Converts the Lisp vector VECTOR of octets from START to END to -string using the external format EXTERNAL-FORMAT." - (declare (optimize speed)) - (with-input-from-sequence (in vector :start start :end end) - (let ((flexi (make-flexi-stream in :external-format external-format)) - (result (make-array (- end start) - :element-type #+:lispworks 'lw:simple-char - #-:lispworks 'character - :fill-pointer t))) - (setf (fill-pointer result) - (read-sequence result flexi)) - result))) - - +octets corresponding to the external format designated by +EXTERNAL-FORMAT." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end) (string string)) + (setq external-format (maybe-convert-external-format external-format)) + (let ((factor (encoding-factor external-format)) + (length (- end start))) + (declare (fixnum length)) + (etypecase factor + (integer + (let ((octets (make-array (* factor length) :element-type 'octet)) + (j 0)) + (declare (fixnum j)) + (flet ((writer (octet) + (declare (octet octet)) + (setf (aref (the (array octet *) octets) j) octet) + (incf j))) + (declare (dynamic-extent (function writer))) + (loop for i of-type fixnum from start below end do + (char-to-octets external-format + (char string i) + #'writer))) + octets)) + (double-float + ;; this is a bit clunky but hopefully a bit more efficient than + ;; using VECTOR-PUSH-EXTEND + (let* ((octets-length (ceiling (* factor length))) + (octets (make-array octets-length + :element-type 'octet + :fill-pointer t + :adjustable t)) + (i start) + (j 0)) + (declare (fixnum i j octets-length) + (double-float factor)) + (flet ((writer (octet) + (declare (octet octet)) + (when (>= j octets-length) + (setq factor (* factor 2.0d0)) + (incf octets-length (the fixnum (ceiling (* factor (- end i))))) + (adjust-array octets octets-length :fill-pointer t)) + (setf (aref (the (array octet *) octets) j) octet) + (incf j))) + (declare (dynamic-extent (function writer))) + (loop + (when (>= i end) + (return)) + (char-to-octets external-format + (char string i) + #'writer) + (incf i)) + (setf (fill-pointer octets) j) + octets)))))) + +(defun octets-to-string (sequence &key + (external-format :latin1) + (start 0) (end (length sequence))) + "Converts the Lisp sequence SEQUENCE of octets from START to END to +string using the external format designated by EXTERNAL-FORMAT." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (setq external-format (maybe-convert-external-format external-format)) + (let* ((factor (encoding-factor external-format)) + (length (- end start)) + (i start) + (reader (etypecase sequence + ((array octet *) + (lambda () + (and (< i end) + (prog1 + (aref (the (array octet *) sequence) i) + (incf i))))) + ((array * *) + (lambda () + (and (< i end) + (prog1 + (aref sequence i) + (incf i))))) + (list + (lambda () + (and (< i end) + (prog1 + (nth i sequence) + (incf i)))))))) + (declare (fixnum i length) (dynamic-extent reader)) + (labels ((pseudo-writer (octet) + (declare (ignore octet)) + (decf i)) + (unreader (char) + (char-to-octets external-format char #'pseudo-writer))) + (declare (dynamic-extent (function pseudo-writer) (function unreader))) + (let ((*current-unreader* #'unreader)) + (flet ((next-char () + (code-char (octets-to-char-code external-format reader)))) + (declare (inline next-char)) + (etypecase factor + (integer + (let* ((string-length (ceiling length factor)) + (string (make-array string-length + :element-type 'char*))) + (declare (fixnum string-length)) + (loop for j of-type fixnum from 0 below string-length + do (setf (schar string j) (next-char)) + finally (return string)))) + (double-float + ;; this is a bit clunky but hopefully a bit more efficient than + ;; using VECTOR-PUSH-EXTEND + (let* ((string-length (ceiling length (the double-float factor))) + (string (make-array string-length + :element-type 'char* + :fill-pointer t + :adjustable t)) + (j 0)) + (declare (fixnum j string-length) + (double-float factor)) + (loop + (when (>= i end) + (return)) + (when (>= j string-length) + (setq factor (/ factor 2.0d0)) + (incf string-length (the fixnum (ceiling (- end i) factor))) + (adjust-array string string-length :fill-pointer t)) + (setf (char string j) (next-char)) + (incf j)) + (setf (fill-pointer string) j) + string)))))))) + +(defun octet-length (string &key (external-format :latin1) (start 0) (end (length string))) + "Returns the length of the substring of STRING from START to END in +octets if encoded using the external format EXTERNAL-FORMAT. Might +return NIL if there's no efficient way to compute the length without +iterating through the whole string." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end) (string string)) + (setq external-format (maybe-convert-external-format external-format)) + (let ((factor (encoding-factor external-format))) + (typecase factor + (fixnum (* factor (- end start)))))) Modified: trunk/test/packages.lisp ============================================================================== --- trunk/test/packages.lisp (original) +++ trunk/test/packages.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.4 2007/01/01 23:47:16 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.6 2008/05/17 16:38:26 edi Exp $ -;;; Copyright (c) 2006-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -30,4 +30,5 @@ (in-package :cl-user) (defpackage :flexi-streams-test - (:use :cl :flexi-streams)) + (:use :cl :flexi-streams) + (:export :run-tests)) Modified: trunk/test/test.lisp ============================================================================== --- trunk/test/test.lisp (original) +++ trunk/test/test.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.17 2007/12/29 22:58:44 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.31 2008/05/20 23:01:53 edi Exp $ -;;; Copyright (c) 2006-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -29,6 +29,13 @@ (in-package :flexi-streams-test) +(defconstant +buffer-size+ 8192 + "Size of buffers for COPY-STREAM* below.") + +(defvar *copy-function* nil + "Which function to use when copying from one stream to the other - +see for example COPY-FILE below.") + (defvar *this-file* (load-time-value (or #.*compile-file-pathname* *load-pathname*)) "The pathname of the file \(`test.lisp') where this variable was @@ -89,13 +96,17 @@ (append args `(:eol-style ,eol-style :little-endian ,little-endian)))))))) -(defun create-test-combinations (file-name symbols) - "For a name suffix FILE-NAME and a list of symbols SYMBOLS -denoting different encodings of the corresponding file returns a -list of lists which can be used as arglists for COMPARE-FILES." +(defun create-test-combinations (file-name symbols &optional simplep) + "For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting +different encodings of the corresponding file returns a list of lists +which can be used as arglists for COMPARE-FILES. If SIMPLEP is true, +a list which can be used for the string tests below is returned." (let ((file-variants (loop for symbol in symbols nconc (create-file-variants file-name symbol)))) (loop for (name-in . external-format-in) in file-variants + when simplep + collect (list name-in external-format-in) + else nconc (loop for (name-out . external-format-out) in file-variants collect (list name-in external-format-in name-out external-format-out))))) @@ -121,6 +132,17 @@ while line do (write-line line out)))) +(defun copy-stream* (stream-in external-format-in stream-out external-format-out) + "Like COPY-STREAM, but uses READ-SEQUENCE and WRITE-SEQUENCE instead +of READ-LINE and WRITE-LINE." + (let ((in (make-flexi-stream stream-in :external-format external-format-in)) + (out (make-flexi-stream stream-out :external-format external-format-out)) + (buffer (make-array +buffer-size+ :element-type 'flex::char*))) + (loop + (let ((position (read-sequence buffer in))) + (when (zerop position) (return)) + (write-sequence buffer out :end position))))) + (defun copy-file (path-in external-format-in path-out external-format-out direction-out direction-in) "Copies the contents of the file denoted by the pathname PATH-IN to the file denoted by the pathname PATH-OUT using flexi @@ -139,7 +161,7 @@ :direction direction-out :if-does-not-exist :create :if-exists :supersede) - (copy-stream in external-format-in out external-format-out)))) + (funcall *copy-function* in external-format-in out external-format-out)))) #+:lispworks (defun copy-file-lw (path-in external-format-in path-out external-format-out direction-out direction-in) @@ -158,7 +180,7 @@ :direction :output :if-does-not-exist :create :if-exists :supersede) - (copy-stream in external-format-in out external-format-out)))) + (funcall *copy-function* in external-format-in out external-format-out)))) (defun compare-files (path-in external-format-in path-out external-format-out) "Copies the contents of the file (in the `test') denoted by the @@ -175,7 +197,8 @@ (full-path-orig (merge-pathnames path-out *this-file*))) (dolist (direction-out '(:output :io)) (dolist (direction-in '(:input :io)) - (format *error-output* "Test ~S ~S [~A]~% --> ~S [~A].~%" path-in + (format *error-output* "Test \(using ~A) ~S ~S [~A]~% --> ~S [~A].~%" + *copy-function* path-in (flex::normalize-external-format external-format-in) direction-in (flex::normalize-external-format external-format-out) direction-out) (copy-file full-path-in external-format-in @@ -186,7 +209,8 @@ (t (format *error-output* " Test failed!!!~%"))) (terpri *error-output*) #+:lispworks - (format *error-output* "LW-Test ~S ~S [~A]~% --> ~S [~A].~%" path-in + (format *error-output* "LW-Test \(using ~A) ~S ~S [~A]~% --> ~S [~A].~%" + *copy-function* path-in (flex::normalize-external-format external-format-in) direction-in (flex::normalize-external-format external-format-out) direction-out) #+:lispworks @@ -200,6 +224,27 @@ #+:lispworks (terpri *error-output*))))) +(defun file-as-octet-vector (pathspec) + "Returns the contents of the file denoted by PATHSPEC as a vector of +octets." + (with-open-file (in pathspec :element-type 'octet) + (let ((vector (make-array (file-length in) :element-type 'octet))) + (read-sequence vector in) + vector))) + +(defun file-as-string (pathspec external-format) + "Reads the contents of the file denoted by PATHSPEC using the +external format EXTERNAL-FORMAT and returns the result as a string." + (with-open-file (in pathspec :element-type 'octet) + (let* ((number-of-octets (file-length in)) + (in (make-flexi-stream in :external-format external-format)) + (string (make-array number-of-octets + :element-type #+:lispworks 'lw:simple-char + #-:lispworks 'character + :fill-pointer t))) + (setf (fill-pointer string) (read-sequence string in)) + string))) + (defmacro with-test ((test-description) &body body) "Defines a test. Two utilities are available inside of the body of the maco: The function FAIL, and the macro CHECK. FAIL, the lowest @@ -231,25 +276,148 @@ (terpri *error-output*)) ,successp)))) +(defun old-string-to-octets (string &key + (external-format (make-external-format :latin1)) + (start 0) end) + "The old version of STRING-TO-OCTETS. We can use it to test +in-memory streams." + (declare (optimize speed)) + (with-output-to-sequence (out) + (let ((flexi (make-flexi-stream out :external-format external-format))) + (write-string string flexi :start start :end end)))) + +(defun old-octets-to-string (vector &key + (external-format (make-external-format :latin1)) + (start 0) (end (length vector))) + "The old version of OCTETS-TO-STRING. We can use it to test +in-memory streams." + (declare (optimize speed)) + (with-input-from-sequence (in vector :start start :end end) + (let ((flexi (make-flexi-stream in :external-format external-format)) + (result (make-array (- end start) + :element-type #+:lispworks 'lw:simple-char + #-:lispworks 'character + :fill-pointer t))) + (setf (fill-pointer result) + (read-sequence result flexi)) + result))) + +(defun string-test (pathspec external-format) + "Tests whether conversion from strings to octets and vice versa +using the external format EXTERNAL-FORMAT works as expected, using the +contents of the file denoted by PATHSPEC as test data and assuming +that the stream conversion functions work. + +Also tests with the old versions of the conversion functions in order +to test in-memory streams." + (let* ((full-path (merge-pathnames pathspec *this-file*)) + (octets-vector (file-as-octet-vector full-path)) + (octets-list (coerce octets-vector 'list)) + (string (file-as-string full-path external-format))) + (with-test ((format nil "String tests with format ~S." + (flex::normalize-external-format external-format))) + (check (string= (octets-to-string octets-vector :external-format external-format) string)) + (check (string= (octets-to-string octets-list :external-format external-format) string)) + (check (equalp (string-to-octets string :external-format external-format) octets-vector)) + (check (string= (old-octets-to-string octets-vector :external-format external-format) string)) + (check (string= (old-octets-to-string octets-list :external-format external-format) string)) + (check (equalp (old-string-to-octets string :external-format external-format) octets-vector))))) + +(defun sequence-equal (seq1 seq2) + "Whether the two sequences have the same elements." + (and (= (length seq1) (length seq2)) + (loop for i below (length seq1) + always (eql (elt seq1 i) (elt seq2 i))))) + +(defun read-sequence-test (pathspec external-format) + "Several tests to confirm that READ-SEQUENCE behaves as expected." + (with-test ((format nil "READ-SEQUENCE tests with format ~S." + (flex::normalize-external-format external-format))) + (let* ((full-path (merge-pathnames pathspec *this-file*)) + (file-string (file-as-string full-path external-format)) + (string-length (length file-string)) + (octets (file-as-octet-vector full-path)) + (octet-length (length octets))) + (when (external-format-equal external-format (make-external-format :utf8)) + #-:openmcl + ;; FLEXI-STREAMS puts integers into the list, but OpenMCL + ;; thinks they are characters... + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (list (make-list octet-length))) + (setf (flexi-stream-element-type in) 'octet) + #-:clisp + (read-sequence list in) + #+:clisp + (ext:read-byte-sequence list in) + (check (sequence-equal list octets)))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (third (floor octet-length 3)) + (half (floor octet-length 2)) + (vector (make-array half :element-type 'octet))) + (check (sequence-equal (loop repeat third + collect (read-byte in)) + (subseq octets 0 third))) + (read-sequence vector in) + (check (sequence-equal vector (subseq octets third (+ third half))))))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (string (make-string (- string-length 10) :element-type 'flex::char*))) + (setf (flexi-stream-element-type in) 'octet) + (check (sequence-equal (loop repeat 10 + collect (read-char in)) + (subseq file-string 0 10))) + (read-sequence string in) + (check (sequence-equal string (subseq file-string 10))))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (list (make-list (- string-length 100)))) + (check (sequence-equal (loop repeat 50 + collect (read-char in)) + (subseq file-string 0 50))) + #-:clisp + (read-sequence list in) + #+:clisp + (ext:read-char-sequence list in) + (check (sequence-equal list (subseq file-string 50 (- string-length 50)))) + (check (sequence-equal (loop repeat 50 + collect (read-char in)) + (subseq file-string (- string-length 50)))))) + (with-open-file (in full-path :element-type 'octet) + (let* ((in (make-flexi-stream in :external-format external-format)) + (array (make-array (- string-length 50)))) + (check (sequence-equal (loop repeat 25 + collect (read-char in)) + (subseq file-string 0 25))) + #-:clisp + (read-sequence array in) + #+:clisp + (ext:read-char-sequence array in) + (check (sequence-equal array (subseq file-string 25 (- string-length 25)))) + (check (sequence-equal (loop repeat 25 + collect (read-char in)) + (subseq file-string (- string-length 25))))))))) + (defmacro using-values ((&rest values) &body body) "Executes BODY and feeds an element from VALUES to the USE-VALUE -restart each time a FLEXI-STREAM-ENCODING-ERROR is signalled. Signals -an error when there are more or less FLEXI-STREAM-ENCODING-ERRORs than -there are elements in VALUES." +restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled. +Signals an error when there are more or less +EXTERNAL-FORMAT-ENCODING-ERRORs than there are elements in VALUES." (flex::with-unique-names (value-stack condition-counter) `(let ((,value-stack ',values) (,condition-counter 0)) - (handler-bind ((flexi-stream-encoding-error + (handler-bind ((external-format-encoding-error #'(lambda (c) (declare (ignore c)) (unless ,value-stack - (error "Too many FLEXI-STREAM-ENCODING-ERRORs signalled, expected only ~A." + (error "Too many encoding errors signalled, expected only ~A." ,(length values))) (incf ,condition-counter) (use-value (pop ,value-stack))))) (prog1 (progn ,@body) (when ,value-stack - (error "~A FLEXI-STREAM-ENCODING-ERRORs signalled, but ~A were expected." + (error "~A encoding errors signalled, but ~A were expected." ,condition-counter ,(length values)))))))) (defun read-flexi-line (sequence external-format) @@ -259,51 +427,84 @@ (setq in (make-flexi-stream in :external-format external-format)) (read-line in))) -(defun encoding-error-handling-test () - "Tests several possible encoding errors and how they are handled." - (with-test ("Handling of encoding errors.") +(defun read-flexi-line* (sequence external-format) + "Like READ-FLEXI-LINE but uses OCTETS-TO-STRING internally." + (octets-to-string sequence :external-format external-format)) + +(defun error-handling-test () + "Tests several possible errors and how they are handled." + (with-test ("Handling of errors.") + ;; handling of EOF in the middle of CRLF + (check (string= #.(string #\Return) + (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf)))) (let ((*substitution-char* #\?)) ;; :ASCII doesn't have characters with char codes > 127 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii))) + (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii))) ;; :WINDOWS-1253 doesn't have a characters with codes 170 and 210 (check (string= "a??" (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253))) + (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253))) ;; not a valid UTF-8 sequence - (check (string= "??" (read-flexi-line `(#xe4 #xf6 #xfc) :utf8))) + (check (string= "??" (read-flexi-line '(#xe4 #xf6 #xfc) :utf8))) + (check (string= "??" (read-flexi-line* #(#xe4 #xf6 #xfc) :utf8))) ;; UTF-8 can't start neither with #b11111110 nor with #b11111111 - (check (string= "??" (read-flexi-line `(#b11111110 #b11111111) :utf8)))) + (check (string= "??" (read-flexi-line '(#b11111110 #b11111111) :utf8))) + (check (string= "??" (read-flexi-line* #(#b11111110 #b11111111) :utf8)))) (let ((*substitution-char* nil)) ;; :ASCII doesn't have characters with char codes > 127 (check (string= "abc" (using-values (#\b #\c) (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))) + (check (string= "abc" (using-values (#\b #\c) + (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii)))) ;; :WINDOWS-1253 encoding doesn't have a characters with codes 170 and 210 (check (string= "axy" (using-values (#\x #\y) (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253)))) + (check (string= "axy" (using-values (#\x #\y) + (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253)))) ;; not a valid UTF-8 sequence - (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line `(#xe4 #xf6 #xfc) :utf8)))) + (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#xe4 #xf6 #xfc) :utf8)))) + (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line* #(#xe4 #xf6 #xfc) :utf8)))) ;; UTF-8 can't start neither with #b11111110 nor with #b11111111 - (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line `(#b11111110 #b11111111) :utf8)))) + (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#b11111110 #b11111111) :utf8)))) + (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line* #(#b11111110 #b11111111) :utf8)))) ;; only one byte - (check (string= "E" (using-values (#\E) (read-flexi-line `(#x01) :utf-16le)))) + (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16le)))) + (check (string= "E" (using-values (#\E) (read-flexi-line* #(#x01) :utf-16le)))) ;; two bytes, but value of resulting word suggests that another word follows - (check (string= "R" (using-values (#\R) (read-flexi-line `(#x01 #xd8) :utf-16le)))) + (check (string= "R" (using-values (#\R) (read-flexi-line '(#x01 #xd8) :utf-16le)))) + (check (string= "R" (using-values (#\R) (read-flexi-line* #(#x01 #xd8) :utf-16le)))) ;; the second word must fit into the [#xdc00; #xdfff] interval, but it is #xdbff - (check (string= "T" (using-values (#\T) (read-flexi-line `(#x01 #xd8 #xff #xdb) :utf-16le)))) + (check (string= "T" (using-values (#\T) (read-flexi-line '(#x01 #xd8 #xff #xdb) :utf-16le)))) + (check (string= "T" (using-values (#\T) (read-flexi-line* #(#x01 #xd8 #xff #xdb) :utf-16le)))) ;; the same as for little endian above, but using inverse order of bytes in words - (check (string= "E" (using-values (#\E) (read-flexi-line `(#x01) :utf-16be)))) - (check (string= "R" (using-values (#\R) (read-flexi-line `(#xd8 #x01) :utf-16be)))) - (check (string= "T" (using-values (#\T) (read-flexi-line `(#xd8 #x01 #xdb #xff) :utf-16be)))) + (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16be)))) + (check (string= "R" (using-values (#\R) (read-flexi-line '(#xd8 #x01) :utf-16be)))) + (check (string= "T" (using-values (#\T) (read-flexi-line '(#xd8 #x01 #xdb #xff) :utf-16be)))) + (check (string= "E" (using-values (#\E) (read-flexi-line* #(#x01) :utf-16be)))) + (check (string= "R" (using-values (#\R) (read-flexi-line* #(#xd8 #x01) :utf-16be)))) + (check (string= "T" (using-values (#\T) (read-flexi-line* #(#xd8 #x01 #xdb #xff) :utf-16be)))) ;; the only case when error is signalled for UTF-32 is at end of file ;; in the middle of 4-byte sequence, both for big and little endian - (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01) :utf-32le)))) - (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01) :utf-32le)))) - (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01 #x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32le)))) (check (string= "aY" (using-values (#\Y) (read-flexi-line `(,(char-code #\a) #x00 #x00 #x00 #x01) :utf-32le)))) - (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01) :utf-32be)))) - (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01) :utf-32be)))) - (check (string= "Y" (using-values (#\Y) (read-flexi-line `(#x01 #x01 #x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32be)))) + (check (string= "aY" (using-values (#\Y) + (read-flexi-line `(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line* #(#x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line* #(#x01 #x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line* #(#x01 #x01 #x01) :utf-32le)))) + (check (string= "aY" (using-values (#\Y) + (read-flexi-line* `#(,(char-code #\a) #x00 #x00 #x00 #x01) :utf-32le)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line* #(#x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line* #(#x01 #x01) :utf-32be)))) + (check (string= "Y" (using-values (#\Y) (read-flexi-line* #(#x01 #x01 #x01) :utf-32be)))) (check (string= "aY" (using-values (#\Y) - (read-flexi-line `(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be))))))) + (read-flexi-line* `#(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be))))))) (defun unread-char-test () "Tests whether UNREAD-CHAR behaves as expected." @@ -311,11 +512,11 @@ (flet ((test-one-file (file-name external-format) (with-open-file (in (merge-pathnames file-name *this-file*) :element-type 'flex:octet) - (setq in (make-flexi-stream in :external-format external-format)) - (loop repeat 300 - for char = (read-char in) - do (unread-char char in) - (check (char= (read-char in) char)))))) + (let ((in (make-flexi-stream in :external-format external-format))) + (loop repeat 300 + for char = (read-char in) + do (unread-char char in) + (check (char= (read-char in) char))))))) (loop for (file-name symbols) in *test-files* do (loop for symbol in symbols do (loop for (file-name . external-format) in (create-file-variants file-name symbol) @@ -323,18 +524,29 @@ (defun run-tests () "Applies COMPARE-FILES to all test scenarios created with -CREATE-TEST-COMBINATIONS, runs test for handling of encoding errors, -and shows simple statistics at the end." +CREATE-TEST-COMBINATIONS, runs other tests like handling of encoding +errors, shows simple statistics at the end." (let* ((*test-success-counter* 0) - (args-list (loop for (file-name symbols) in *test-files* - nconc (create-test-combinations file-name symbols))) - (no-tests (* 4 (length args-list)))) + (compare-files-args-list (loop for (file-name symbols) in *test-files* + nconc (create-test-combinations file-name symbols))) + (no-tests (* 8 (length compare-files-args-list)))) #+:lispworks (setq no-tests (* 2 no-tests)) - (dolist (args args-list) - (apply #'compare-files args)) + (dolist (*copy-function* '(copy-stream copy-stream*)) + (dolist (args compare-files-args-list) + (apply 'compare-files args))) + (let ((string-test-args-list (loop for (file-name symbols) in *test-files* + nconc (create-test-combinations file-name symbols t)))) + (incf no-tests (length string-test-args-list)) + (dolist (args string-test-args-list) + (apply 'string-test args))) + (let ((read-sequence-test-args-list (loop for (file-name symbols) in *test-files* + nconc (create-test-combinations file-name symbols t)))) + (incf no-tests (length read-sequence-test-args-list)) + (dolist (args read-sequence-test-args-list) + (apply 'read-sequence-test args))) (incf no-tests) - (encoding-error-handling-test) + (error-handling-test) (incf no-tests) (unread-char-test) (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%" Modified: trunk/util.lisp ============================================================================== --- trunk/util.lisp (original) +++ trunk/util.lisp Wed May 21 08:00:42 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.13 2007/01/01 23:46:49 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.21 2008/05/20 23:44:45 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -31,7 +31,14 @@ #+:lispworks (eval-when (:compile-toplevel :load-toplevel :execute) - (import 'lw:with-unique-names)) + (import '(lw:with-unique-names lw:when-let))) + +#-:lispworks +(defmacro when-let ((var form) &body body) + "Evaluates FORM and binds VAR to the result, then executes BODY +if VAR has a true value." + `(let ((,var ,form)) + (when ,var ,@body))) #-:lispworks (defmacro with-unique-names ((&rest bindings) &body body) @@ -108,7 +115,9 @@ (unless (find real-name +name-map+ :test #'eq :key #'cdr) - (error "~S is not known to be a name for an external format." name)) + (error 'external-format-error + :format-control "~S is not known to be a name for an external format." + :format-arguments (list name))) real-name)) (defun ascii-name-p (name) @@ -161,6 +170,26 @@ (defmacro with-accessors (slot-entries instance &body body) "For LispWorks, we prefer SLOT-VALUE over accessors for better performance." + ;; note that we assume that the variables have the same names as the + ;; slots `(with-slots ,(mapcar #'car slot-entries) ,instance - ,@body)) \ No newline at end of file + ,@body)) + +(defun make-octet-buffer (&optional (size +buffer-size+)) + "Creates and returns a fresh buffer \(a specialized array) of size ++BUFFER-SIZE+ to hold octets." + (declare #.*standard-optimize-settings*) + (make-array size :element-type 'octet)) + +(defun type-equal (type1 type2) + "Whether TYPE1 and TYPE2 denote the same type." + (declare #.*standard-optimize-settings*) + (and (subtypep type1 type2) + (subtypep type2 type1))) + +(defun maybe-rewind (stream octets) + "Tries to `rewind' the \(binary) stream STREAM by OCTETS octets. +Returns a true value if it succeeds." + (when-let (position (file-position stream)) + (file-position stream (- position octets)))) \ No newline at end of file

1 0

[flexi-streams-cvs] r44 - in branches/edi: . doc
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Wed May 21 07:55:21 2008 New Revision: 44 Modified: branches/edi/CHANGELOG branches/edi/doc/index.html branches/edi/flexi-streams.asd Log: Make it 0.15.0 Modified: branches/edi/CHANGELOG ============================================================================== --- branches/edi/CHANGELOG (original) +++ branches/edi/CHANGELOG Wed May 21 07:55:21 2008 @@ -1,3 +1,5 @@ +Version 0.15.0 +2008-05-21 Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner) Version 0.14.0 Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Wed May 21 07:55:21 2008 @@ -224,7 +224,7 @@ FLEXI-STREAMS together with this documentation can be downloaded from <a href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The -current version is 0.14.0. +current version is 0.15.0. Before you install FLEXI-STREAMS you first need to install the <a @@ -1060,7 +1060,7 @@ his work on making FLEXI-STREAMS faster. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.107 2008/05/21 01:43:45 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.108 2008/05/21 11:53:08 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/flexi-streams.asd ============================================================================== --- branches/edi/flexi-streams.asd (original) +++ branches/edi/flexi-streams.asd Wed May 21 07:55:21 2008 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.64 2008/05/20 23:01:51 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.65 2008/05/21 11:53:07 edi Exp $ -;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved. +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions @@ -35,7 +35,7 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "0.14.0" + :version "0.15.0" :serial t :components ((:file "packages") (:file "mapping")

1 0

[flexi-streams-cvs] r43 - in branches/edi: . doc
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Tue May 20 21:49:41 2008 New Revision: 43 Modified: branches/edi/doc/index.html branches/edi/packages.lisp branches/edi/strings.lisp Log: New function octet-length Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Tue May 20 21:49:41 2008 @@ -115,6 +115,7 @@ <ol> <li><a href="#string-to-octets"><code>string-to-octets</code></a> <li><a href="#octets-to-string"><code>octets-to-string</code></a> + <li><a href="#octet-length"><code>octet-length</code></a> </ol> </ol> <li><a href="#position">File positions</a> @@ -470,8 +471,8 @@ CL-USER 5 > (make-external-format :ucs-2be) #<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CRLF :LITTLE-ENDIAN NIL) 2067DBE4> -CL-USER 6 > (make-external-format :ucs-2be :eol-style :br) -#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :BR :LITTLE-ENDIAN NIL) 206B54AC> +CL-USER 6 > (make-external-format :ucs-2be :eol-style :cr) +#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CR :LITTLE-ENDIAN NIL) 206B54AC> </pre> </blockquote> @@ -982,7 +983,8 @@ <blockquote> Converts the Lisp string <code>string</code> from <code>start</code> to <code>end</code> to an array of -<a href="#octet">octets</a> corresponding to the external format designated by <a href="#external-formats">external format</a> <code>external-format</code>. The defaults for +<a href="#octet">octets</a> corresponding to the <a href="#external-formats">external +format</a> designated by <code>external-format</code>. The defaults for <code>start</code> and <code>end</code> are <code>0</code> and the length of the string. The default for <code>external-format</code> is <code>:LATIN1</code>. @@ -995,9 +997,25 @@ <blockquote> Converts the Lisp sequence <code>sequence</code> of <a href="#octet">octets</a> from <code>start</code> to <code>end</code> to string -using the external format designated -by <a href="#external-formats">external -format</a> <code>external-format</code>. The defaults for +using the <a href="#external-formats">external format</a> designated +by <code>external-format</code>. The defaults for +<code>start</code> and <code>end</code> +are <code>0</code> and the length of the sequence. The default +for <code>external-format</code> is <code>:LATIN1</code>. +</blockquote> + + [Function] + <a class=none name="octet-length">octet-length string <tt>&key</tt> external-format start end => length-or-nil</a> + +<blockquote> + +Returns the length of the substring of <code>string</code> from <code>start</code> to <code>end</code> in +<a href="#octet">octets</a> if encoded using +the <a href="#external-formats">external format</a> designated +by <code>external-format</code>. Might return <code>NIL</code> +if there's no efficient way to compute the length without iterating +through the whole string. +The defaults for <code>start</code> and <code>end</code> are <code>0</code> and the length of the sequence. The default for <code>external-format</code> is <code>:LATIN1</code>. @@ -1042,7 +1060,7 @@ his work on making FLEXI-STREAMS faster. -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.106 2008/05/21 01:06:45 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.107 2008/05/21 01:43:45 edi Exp $ <a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Tue May 20 21:49:41 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.34 2008/05/20 23:44:45 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.35 2008/05/21 01:43:43 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -76,6 +76,7 @@ :make-in-memory-output-stream :make-flexi-stream :octet + :octet-length :octets-to-string :output-stream-sequence-length :peek-byte Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Tue May 20 21:49:41 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.21 2008/05/20 09:04:23 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.22 2008/05/21 01:43:43 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -159,3 +159,15 @@ (incf j)) (setf (fill-pointer string) j) string)))))))) + +(defun octet-length (string &key (external-format :latin1) (start 0) (end (length string))) + "Returns the length of the substring of STRING from START to END in +octets if encoded using the external format EXTERNAL-FORMAT. Might +return NIL if there's no efficient way to compute the length without +iterating through the whole string." + (declare #.*standard-optimize-settings*) + (declare (fixnum start end) (string string)) + (setq external-format (maybe-convert-external-format external-format)) + (let ((factor (encoding-factor external-format))) + (typecase factor + (fixnum (* factor (- end start))))))

1 0

[flexi-streams-cvs] r42 - branches/edi
by eweitz＠common-lisp.net 21 May '08

21 May '08

Author: eweitz Date: Tue May 20 21:28:34 2008 New Revision: 42 Modified: branches/edi/output.lisp Log: More documentation Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Tue May 20 21:28:34 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.59 2008/05/21 01:17:45 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.60 2008/05/21 01:26:43 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -130,7 +130,13 @@ (stream-write-char stream #\Newline)) (defmethod stream-write-sequence ((stream flexi-output-stream) sequence start end &key) -; (declare #.*standard-optimize-settings*) + "An optimized version which uses a buffer underneath. The function +can accepts characters as well as octets and it decides what to do +based on the element type of the sequence \(if possible) or on the +individual elements, i.e. you can mix characters and octets in +SEQUENCE if you want. Whether that really works might also depend on +your Lisp, some of the implementations are more picky than others." + (declare #.*standard-optimize-settings*) (declare (fixnum start end)) (with-accessors ((column flexi-stream-column) (external-format flexi-stream-external-format) @@ -151,23 +157,32 @@ (boolean octet-seen-p) (type (array octet *) buffer)) (labels ((flush-buffer () + "Sends all octets in BUFFER to the underlying stream." (write-sequence buffer stream :end buffer-pos) (setq buffer-pos 0)) (write-octet (octet) + "Adds one octet to the buffer and flush it if necessary." (declare (octet octet)) (when (>= buffer-pos buffer-size) (flush-buffer)) (setf (aref buffer buffer-pos) octet) (incf buffer-pos)) (write-character (char) + "Adds the octets representing the character CHAR to the buffer." (char-to-octets external-format char #'write-octet)) (write-object (object) + "Dispatches to WRITE-OCTET or WRITE-CHARACTER +depending on the type of OBJECT." (etypecase object (octet (setq octet-seen-p t) (write-octet object)) (character (write-character object))))) (declare (dynamic-extent (function write-octet))) (macrolet ((iterate (octets-p output-form) + "An unhygienic macro to implement the actual +iteration through SEQUENCE. OUTPUT-FORM is the form to retrieve one +sequence element and put its octet representation into the buffer. +OCTETS-P is true if we know in advance that we will send octets." `(progn ,@(if octets-p '((setq octet-seen-p t))) (loop for index of-type fixnum from start below end @@ -184,6 +199,7 @@ (iterate t (write-octet (aref sequence index)))) (t (iterate nil (write-object (aref sequence index))))))) (list (iterate nil (write-object (nth index sequence))))) + ;; update the column slot, setting if to NIL if we sent octets (setq column (cond (octet-seen-p nil) (t (let ((last-newline-pos (position #\Newline sequence

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

flexi-streams-cvs May 2008