Changeset 11628
- Timestamp:
- Jan 19, 2009, 7:59:34 PM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-sysio.lisp
r11059 r11628 179 179 (curpos (+ element-base (io-buffer-idx inbuf)))) 180 180 (if (null newpos) 181 (if (file-ioblock-untyi-char file-ioblock) 182 (1- curpos) 183 curpos) 181 curpos 184 182 (progn 185 (setf (file-ioblock-untyi-char file-ioblock) nil)186 183 (if (and (>= newpos element-base) 187 184 (< newpos (+ element-base (io-buffer-count inbuf)))) … … 246 243 (curpos (+ element-base curidx))) 247 244 (if (null newpos) 248 (if (file-ioblock-untyi-char file-ioblock) 249 (1- curpos) 250 curpos) 245 curpos 251 246 (let* ((incount (io-buffer-count outbuf))) 252 247 (unless (= newpos 0) 253 248 (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)))258 249 (cond 259 250 ((and (>= newpos element-base) … … 325 316 ;; file, then seek to the new EOF. 326 317 (fd-ftruncate fd new-octet-eof) 327 (setf (file-ioblock-untyi-char file-ioblock) nil)328 318 (file-ioblock-seek-and-reset file-ioblock new-octet-eof)) 329 319 (t … … 531 521 532 522 (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))) 534 525 (incf (file-ioblock-octet-pos file-ioblock) (or n 0)) 526 (%ioblock-output-file-position file-ioblock pos) 535 527 n)) 536 528 537 529 ;;; Can't be sure where the underlying fd is positioned, so seek first. 538 530 (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))) 541 537 542 538 … … 547 543 (let* ((inbuf (file-ioblock-inbuf file-ioblock)) 548 544 (outbuf (file-ioblock-outbuf file-ioblock))) 549 (setf (file-ioblock-untyi-char file-ioblock) nil)550 545 (setf (file-ioblock-dirty file-ioblock) nil) 551 546 (when inbuf … … 718 713 (:output 'output-file-force-output))) 719 714 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)) 720 739 721 740
Note: See TracChangeset
for help on using the changeset viewer.