[flexi-streams-cvs] r38 - in branches/edi: . doc test - flexi-streams-cvs@common-lisp.net - mailman3.common-lisp.net

21 May 2008

Author: eweitz
Date: Tue May 20 19:45:25 2008
New Revision: 38
Modified:
   branches/edi/conditions.lisp
   branches/edi/decode.lisp
   branches/edi/doc/index.html
   branches/edi/encode.lisp
   branches/edi/external-format.lisp
   branches/edi/flexi-streams.asd
   branches/edi/input.lisp
   branches/edi/mapping.lisp
   branches/edi/output.lisp
   branches/edi/packages.lisp
   branches/edi/specials.lisp
   branches/edi/test/test.lisp
   branches/edi/util.lisp
Log:
IO stream cleanup
Modified: branches/edi/conditions.lisp
==============================================================================

--- branches/edi/conditions.lisp	(original)
+++ branches/edi/conditions.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.5 2008/05/19 07:57:07 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.6 2008/05/20 23:44:45 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -48,6 +48,15 @@
   (:documentation "Errors of this type are signalled if the flexi
 stream has a wrong element type."))
+(define-condition flexi-stream-out-of-sync-error (flexi-stream-error)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "Stream out of sync from previous
+lookahead, couldn't rewind.")))
+  (:documentation "This can happen if you're trying to write to an IO
+stream which had prior to that `looked ahead' while reading and now
+can't `rewind' to the octet where you /should/ be."))
+
 (define-condition in-memory-stream-error (stream-error)
   ()
   (:documentation "Superclass for all errors related to
Modified: branches/edi/decode.lisp
==============================================================================
--- branches/edi/decode.lisp	(original)
+++ branches/edi/decode.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.15 2008/05/20 09:37:43 edi Exp $
+;;; $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.
@@ -61,12 +61,12 @@
 whenever this function is called."))
(defmethod octets-to-char-code ((format flexi-latin-1-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (funcall reader))
(defmethod octets-to-char-code ((format flexi-ascii-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (when-let (octet (funcall reader))
     (if (> (the octet octet) 127)
@@ -75,7 +75,7 @@
       octet)))
(defmethod octets-to-char-code ((format flexi-8-bit-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (with-accessors ((decoding-table external-format-decoding-table))
       format
@@ -89,7 +89,7 @@
           char-code)))))
(defmethod octets-to-char-code ((format flexi-utf-8-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))  
   (let (first-octet-seen)
     (declare (boolean first-octet-seen))
@@ -105,7 +105,7 @@
       (let ((octet (read-next-byte)))
         (declare (type octet octet))
         (multiple-value-bind (start count)
-            (cond ((zerop (logand octet #b10000000))
+            (cond ((not (logbitp 7 octet))
                    (values octet 0))
                   ((= #b11000000 (logand octet #b11100000))
                    (values (logand octet #b00011111) 1))
@@ -124,8 +124,8 @@
           (declare (fixnum count))
           ;; 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 (the (unsigned-byte 26) result) 6)
+          (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)
@@ -136,7 +136,7 @@
                 finally (return result)))))))
(defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (let (first-octet-seen)
     (declare (boolean first-octet-seen))
@@ -169,7 +169,7 @@
                 (t word)))))))
(defmethod octets-to-char-code ((format flexi-utf-16-be-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (let (first-octet-seen)
     (declare (boolean first-octet-seen))
@@ -202,7 +202,7 @@
                 (t word)))))))
(defmethod octets-to-char-code ((format flexi-utf-32-le-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (let (first-octet-seen)
     (declare (boolean first-octet-seen))
@@ -220,7 +220,7 @@
             sum (ash octet count)))))
(defmethod octets-to-char-code ((format flexi-utf-32-be-format) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function reader))
   (let (first-octet-seen)
     (declare (boolean first-octet-seen))
@@ -238,7 +238,7 @@
             sum (ash octet count)))))
(defmethod octets-to-char-code ((format flexi-cr-mixin) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (ignore reader))
   (let ((char-code (call-next-method)))
     (case char-code
@@ -246,7 +246,7 @@
       (otherwise char-code))))
(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (function *current-unreader*))
   (declare (ignore reader))
   (let ((char-code (call-next-method)))
Modified: branches/edi/doc/index.html
==============================================================================
--- branches/edi/doc/index.html	(original)
+++ branches/edi/doc/index.html	Tue May 20 19:45:25 2008
@@ -89,6 +89,7 @@
       <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-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>
       </ol>
@@ -804,6 +805,15 @@
 </blockquote>
<p><br>[Condition]
+<br><a class=none name="flexi-stream-out-of-sync-error"><b>flexi-stream-out-of-sync-error</b></a>
+
+<blockquote><br> 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 <em>should</em> be.
+</blockquote>
+
+<p><br>[Condition]
 <br><a class=none name="flexi-stream-element-type-error"><b>flexi-stream-element-type-error</b></a>
<blockquote><br>
@@ -1030,7 +1040,7 @@
 numerous patches and additions.
<p>
-$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.104 2008/05/20 06:55:21 edi Exp $
+$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.105 2008/05/20 23:44:47 edi Exp $
 <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: branches/edi/encode.lisp
==============================================================================
--- branches/edi/encode.lisp	(original)
+++ branches/edi/encode.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.11 2008/05/20 08:02:49 edi Exp $
+;;; $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.
@@ -38,7 +38,7 @@
 unspecified."))
(defmethod char-to-octets ((format flexi-latin-1-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (let ((octet (char-code char)))
     (when (> octet 255)
@@ -46,7 +46,7 @@
     (funcall writer octet)))
(defmethod char-to-octets ((format flexi-ascii-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (let ((octet (char-code char)))
     (when (> octet 127)
@@ -54,7 +54,7 @@
     (funcall writer octet)))
(defmethod char-to-octets ((format flexi-8-bit-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (with-accessors ((encoding-hash external-format-encoding-hash))
       format
@@ -64,7 +64,7 @@
       (funcall writer octet))))
(defmethod char-to-octets ((format flexi-utf-8-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (let ((char-code (char-code char)))
     (tagbody
@@ -96,7 +96,7 @@
      zero)))
(defmethod char-to-octets ((format flexi-utf-16-le-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (flet ((write-word (word)
            (funcall writer (ldb (byte 8 0) word))
@@ -111,7 +111,7 @@
                (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))))
(defmethod char-to-octets ((format flexi-utf-16-be-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (flet ((write-word (word)
            (funcall writer (ldb (byte 8 8) word))
@@ -126,7 +126,7 @@
                (write-word (logior #xdc00 (ldb (byte 10 0) char-code))))))))
(defmethod char-to-octets ((format flexi-utf-32-le-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (let ((char-code (char-code char)))
     (funcall writer (ldb (byte 8 0) char-code))
@@ -135,7 +135,7 @@
     (funcall writer (ldb (byte 8 24) char-code))))
(defmethod char-to-octets ((format flexi-utf-32-be-format) char writer)
-  (declare #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char) (function writer))
   (let ((char-code (char-code char)))
     (funcall writer (ldb (byte 8 24) char-code))
@@ -144,14 +144,14 @@
     (funcall writer (ldb (byte 8 0) char-code))))
(defmethod char-to-octets ((format flexi-cr-mixin) char writer)
-  (declare #.*standard-optimize-settings*)
+  (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 #.*standard-optimize-settings*)
+  (declare #.*fixnum-optimize-settings*)
   (declare (character char))
   (cond ((char= char #\Newline)
          (call-next-method format #\Return writer)
Modified: branches/edi/external-format.lisp
==============================================================================
--- branches/edi/external-format.lisp	(original)
+++ branches/edi/external-format.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.20 2008/05/20 08:02:50 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-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -284,7 +284,7 @@
                                  'flexi-crlf-utf-32-be-format))))))))
(defun make-external-format% (name &key (little-endian *default-little-endian*)
-                                        id eol-style)
+                                   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."
@@ -297,7 +297,9 @@
                  (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*)
Modified: branches/edi/flexi-streams.asd
==============================================================================
--- branches/edi/flexi-streams.asd	(original)
+++ branches/edi/flexi-streams.asd	Tue May 20 19:45:25 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.63 2008/05/18 23:13:59 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.64 2008/05/20 23:01:51 edi Exp $
;;; Copyright (c) 2005-2007, Dr. Edmund Weitz.  All rights reserved.
@@ -54,6 +54,7 @@
                #+:lispworks (:file "lw-binary-stream")
                (:file "output")
                (:file "input")
+               (:file "io")
                (:file "strings"))
   :depends-on (:trivial-gray-streams))
Modified: branches/edi/input.lisp
==============================================================================
--- branches/edi/input.lisp	(original)
+++ branches/edi/input.lisp	Tue May 20 19:45:25 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.67 2008/05/20 09:38:07 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.68 2008/05/20 23:01:51 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -213,7 +213,7 @@
                    (element-type flexi-stream-element-type)
                    (stream flexi-stream-stream))
       flexi-input-stream
-    (let* ((buffer (make-octet-buffer))
+    (let* (buffer
            (buffer-pos 0)
            (buffer-end 0)
            (index start)
@@ -229,7 +229,7 @@
            ;; OCTET-STACK), especially for UTF-8
            (reserve (if (floatp factor) (* 2 integer-factor) 0)))
       (declare (fixnum buffer-pos buffer-end index integer-factor reserve)
-               (type (array octet *) buffer))
+               (boolean want-chars-p))
       (flet ((compute-minimum ()
                "Computes the minimum amount of octets we can savely
 read into the buffer without violating the stream's bound (if there
@@ -243,6 +243,15 @@
              (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))
@@ -254,15 +263,7 @@
                  (incf position buffer-end))))
         (let ((minimum (compute-minimum)))
           (declare (fixnum minimum))
-          ;; put data from octet stack into buffer if there is any
-          (loop
-           (when (>= buffer-pos minimum)
-             (return))
-           (let ((next-octet (pop octet-stack)))
-             (cond (next-octet
-                    (setf (aref buffer buffer-pos) (the octet next-octet))
-                    (incf buffer-pos))
-                   (t (return)))))
+          (setq buffer (make-octet-buffer minimum))
           ;; fill buffer for the first time or return immediately if
           ;; we don't succeed
           (unless (fill-buffer minimum)
@@ -277,7 +278,7 @@
                    (unless (fill-buffer (compute-minimum))
                      (return-from next-octet)))
                  (prog1
-                     (aref buffer buffer-pos)
+                     (aref (the (array octet *) buffer) buffer-pos)
                    (incf buffer-pos)))
                (unreader (char)
                  (unread-char% char flexi-input-stream)))
@@ -310,7 +311,7 @@
                                 (when (>= buffer-pos buffer-end)
                                   (return))
                                 (decf buffer-end)
-                                (push (aref buffer buffer-end) octet-stack))
+                                (push (aref (the (array octet *) buffer) buffer-end) octet-stack))
                                (leave))
                              (let ((next-thing ,(if octetp
                                                   '(next-octet)
Modified: branches/edi/mapping.lisp
==============================================================================
--- branches/edi/mapping.lisp	(original)
+++ branches/edi/mapping.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.1 2008/05/19 09:09:15 edi Exp $
+;;; $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.
@@ -40,9 +40,16 @@
   #-:lispworks 'character)
(deftype char-code-integer ()
-  "The type of integers which can be returned by the function CHAR-CODE."
+  "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)
Modified: branches/edi/output.lisp
==============================================================================
--- branches/edi/output.lisp	(original)
+++ branches/edi/output.lisp	Tue May 20 19:45:25 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.54 2008/05/20 06:15:44 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.56 2008/05/20 23:44:45 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -29,37 +29,37 @@
(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))  
+(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))
+(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 #.*standard-optimize-settings*)
   (with-accessors ((stream flexi-stream-stream))
-      sink
+      flexi-output-stream
     (write-byte byte stream)))
(defmethod stream-write-char ((stream flexi-output-stream) char)
@@ -180,7 +180,7 @@
     (return-from stream-write-sequence
       (call-next-method)))
   (let ((buffer (make-array (+ +buffer-size+ 20)
-                            :element-type '(unsigned-byte 8)
+                            :element-type 'octet
                             :fill-pointer 0))
         (last-newline-pos (position #\Newline sequence
                                     :test #'char=
Modified: branches/edi/packages.lisp
==============================================================================
--- branches/edi/packages.lisp	(original)
+++ branches/edi/packages.lisp	Tue May 20 19:45:25 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.33 2008/05/19 07:57:08 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.34 2008/05/20 23:44:45 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -53,12 +53,13 @@
            :flexi-io-stream
            :flexi-stream
            :flexi-stream-bound
+           :flexi-stream-column
            :flexi-stream-external-format
            :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-stream
            :get-output-stream-sequence
Modified: branches/edi/specials.lisp
==============================================================================
--- branches/edi/specials.lisp	(original)
+++ branches/edi/specials.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.31 2008/05/19 07:57:08 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.32 2008/05/20 23:01:51 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -38,6 +38,17 @@
     (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).
@@ -162,7 +173,7 @@
 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: branches/edi/test/test.lisp
==============================================================================
--- branches/edi/test/test.lisp	(original)
+++ branches/edi/test/test.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.30 2008/05/20 09:37:30 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-2008, Dr. Edmund Weitz.  All rights reserved.
Modified: branches/edi/util.lisp
==============================================================================
--- branches/edi/util.lisp	(original)
+++ branches/edi/util.lisp	Tue May 20 19:45:25 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.19 2008/05/19 22:32:57 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.21 2008/05/20 23:44:45 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
@@ -176,12 +176,20 @@
        ,instance
      ,@body))
-(defun make-octet-buffer ()
+(defun make-octet-buffer (&optional (size +buffer-size+))
   "Creates and returns a fresh buffer (a specialized array) of size
 +BUFFER-SIZE+ to hold octets."
-  (make-array +buffer-size+ :element-type 'octet))
+  (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)))
\ No newline at end of file
+       (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

    