Ignore:
Timestamp:
Jan 19, 2009, 7:59:34 PM (11 years ago)
Author:
gb
Message:

File-ioblocks don't maintain IOBLOCK-UNTYI-CHAR (since it
interacts poorly with/complicates FILE-POSITION and operations
on :io file streams.) Note that the error of calling UNREAD-CHAR
twice in succession is harder to detect.
Implement UNREAD-CHAR by decrementing the file position by the
number of octets needed to encode the character.
Ensure that FORCE-OUTPUT on file streams maintains the file's
position.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sysio.lisp

    r11059 r11628  
    179179         (curpos (+ element-base (io-buffer-idx inbuf))))
    180180    (if (null newpos)
    181       (if (file-ioblock-untyi-char file-ioblock)
    182         (1- curpos)
    183         curpos)
     181      curpos
    184182      (progn
    185         (setf (file-ioblock-untyi-char file-ioblock) nil)
    186183        (if (and (>= newpos element-base)
    187184                 (< newpos (+ element-base (io-buffer-count inbuf))))
     
    246243         (curpos (+ element-base curidx)))
    247244    (if (null newpos)
    248       (if (file-ioblock-untyi-char file-ioblock)
    249         (1- curpos)
    250         curpos)
     245      curpos
    251246      (let* ((incount (io-buffer-count outbuf)))
    252247        (unless (= newpos 0)
    253248          (setf (ioblock-pending-byte-order-mark file-ioblock) nil))       
    254         (when (file-ioblock-untyi-char file-ioblock)
    255           (setf (file-ioblock-untyi-char file-ioblock) nil)
    256           (if (> curidx 0)
    257             (decf curpos)))
    258249        (cond
    259250          ((and (>= newpos element-base)
     
    325316               ;; file, then seek to the new EOF.
    326317               (fd-ftruncate fd new-octet-eof)
    327                (setf (file-ioblock-untyi-char file-ioblock) nil)
    328318               (file-ioblock-seek-and-reset file-ioblock new-octet-eof))
    329319              (t
     
    531521                   
    532522(defun output-file-force-output (stream file-ioblock count finish-p)
    533   (let* ((n (fd-stream-force-output stream file-ioblock count finish-p)))
     523  (let* ((pos (%ioblock-output-file-position file-ioblock nil))
     524         (n (fd-stream-force-output stream file-ioblock count finish-p)))
    534525    (incf (file-ioblock-octet-pos file-ioblock) (or n 0))
     526    (%ioblock-output-file-position file-ioblock pos)
    535527    n))
    536528
    537529;;; Can't be sure where the underlying fd is positioned, so seek first.
    538530(defun io-file-force-output (stream file-ioblock count finish-p)
    539   (file-ioblock-seek file-ioblock (file-ioblock-octet-pos file-ioblock))
    540   (output-file-force-output stream file-ioblock count finish-p))
     531  (let* ((pos (%ioblock-io-file-position file-ioblock nil)))
     532    (file-ioblock-seek file-ioblock (file-ioblock-octet-pos file-ioblock))
     533    (let* ((n (fd-stream-force-output stream file-ioblock count finish-p)))
     534      (incf (file-ioblock-octet-pos file-ioblock) (or n 0))
     535      (%ioblock-io-file-position file-ioblock pos)
     536      n)))
    541537
    542538
     
    547543  (let* ((inbuf (file-ioblock-inbuf file-ioblock))
    548544         (outbuf (file-ioblock-outbuf file-ioblock)))
    549     (setf (file-ioblock-untyi-char file-ioblock) nil)
    550545    (setf (file-ioblock-dirty file-ioblock) nil)
    551546    (when inbuf
     
    718713    (:output 'output-file-force-output)))
    719714
     715(defmethod select-stream-untyi-function ((s file-stream) (direction t))
     716  '%file-ioblock-untyi)
     717
     718;;; Conceptually, decrement the stream's position by the number of octets
     719;;; needed to encode CHAR.
     720;;; Since we don't use IOBLOCK-UNTYI-CHAR, it's hard to detect the error
     721;;; of calling UNREAD-CHAR twice in a row.
     722(defun %file-ioblock-untyi (ioblock char)
     723  (let* ((inbuf (ioblock-inbuf ioblock))
     724         (idx (io-buffer-idx inbuf))
     725         (encoding (ioblock-encoding ioblock))
     726         (noctets (if encoding
     727                    (funcall (character-encoding-character-size-in-octets-function encoding) char)
     728                    1)))
     729    (declare (fixnum idx noctets))
     730    (if (>= idx noctets)
     731      (setf (io-buffer-idx inbuf) (the fixnum (- idx noctets)))
     732      (let* ((stream (ioblock-stream ioblock))
     733             (pos (stream-position stream))
     734             (newpos (- pos noctets)))
     735        (if (< newpos 0)
     736          (error "Invalid attempt to unread ~s on ~s." char (ioblock-stream ioblock))
     737          (stream-position stream newpos))))
     738    char))
    720739
    721740
Note: See TracChangeset for help on using the changeset viewer.