CMUCL commit: src/code (3 files)
Raymond Toy
rtoy at common-lisp.net
Sat Jan 23 19:02:05 CET 2010
Date: Saturday, January 23, 2010 @ 13:02:05
Author: rtoy
Path: /project/cmucl/cvsroot/src/code
Modified: fd-stream-extfmt.lisp fd-stream.lisp stream.lisp
Oops. Last change to fd-stream doesn't actually compile because no
everything is defined yet. Hence, add dummy
%SET-FD-STREAM-EXTERNAL-FORMAT and move the real one to
fd-stream-extfmt.lisp. This builds.
code/fd-stream.lisp:
o Always call %SET-FD-STREAM-EXTERNAL-FORMAT, even if
LISP::*ENABLE-STREAM-BUFFER-P* is NIL.
code/stream.lisp:
o Move %SET-FD-STREAM-EXTERNAL-FORMAT to fd-stream-extfmt.lisp.
o Add dummy implementation of %SET-FD-STREAM-EXTERNAL-FORMAT.
code/fd-stream-extfmt.lisp:
o %SET-FD-STREAM-EXTERNAL-FORMAT moved here.
-----------------------+
fd-stream-extfmt.lisp | 54 ++++++++++++++++++++++++++++++++++++++++++++-
fd-stream.lisp | 5 +---
stream.lisp | 57 ++++--------------------------------------------
3 files changed, 60 insertions(+), 56 deletions(-)
Index: src/code/fd-stream-extfmt.lisp
diff -u src/code/fd-stream-extfmt.lisp:1.5 src/code/fd-stream-extfmt.lisp:1.6
--- src/code/fd-stream-extfmt.lisp:1.5 Tue Dec 15 12:22:41 2009
+++ src/code/fd-stream-extfmt.lisp Sat Jan 23 13:02:04 2010
@@ -5,7 +5,7 @@
;;; domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.5 2009-12-15 17:22:41 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.6 2010-01-23 18:02:04 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -61,6 +61,58 @@
(error "Setting external-format on Gray streams not supported."))
extfmt)
+(defun %set-fd-stream-external-format (stream extfmt &optional (updatep t))
+ (declare (type fd-stream stream))
+ (let ((old-format (fd-stream-external-format stream)))
+ (setf (fd-stream-external-format stream)
+ (stream::ef-name (stream::find-external-format extfmt))
+ (fd-stream-oc-state stream) nil
+ (fd-stream-co-state stream) nil)
+ (when (fd-stream-ibuf-sap stream) ; input stream
+ (setf (fd-stream-in stream) (ef-cin extfmt)))
+ (when (fd-stream-obuf-sap stream) ; output stream
+ (setf (fd-stream-out stream) (ef-cout extfmt)
+ ;;@@ (fd-stream-sout stream) (ef-sout extfmt)
+ ))
+ (when (and lisp::*enable-stream-buffer-p* updatep
+ (lisp-stream-string-buffer stream))
+ ;; We want to reconvert any octets that haven't been converted
+ ;; yet. So, we need to figure out which octet to start with.
+ ;; This is done by converting (the previously converted) octets
+ ;; until we've converted the right number of characters.
+ (let ((ibuf (lisp-stream-in-buffer stream))
+ (sindex (1- (lisp-stream-string-index stream)))
+ (index 0)
+ (state (fd-stream-saved-oc-state stream)))
+ ;; Reconvert all the octets we've already converted and read.
+ ;; We don't know how many octets that is, but do know how many
+ ;; characters there are.
+ (multiple-value-bind (s pos count new-state)
+ (octets-to-string ibuf
+ :start 0
+ :external-format old-format
+ :string (make-string sindex)
+ :state state)
+ (declare (ignore s pos))
+ (setf state new-state)
+ (setf index count))
+
+ ;; We now know the last octet that was used. Now convert the
+ ;; rest of the octets using the new format.
+ (multiple-value-bind (s pos count new-state)
+ (octets-to-string ibuf
+ :start index
+ :end (fd-stream-in-length stream)
+ :external-format (fd-stream-external-format stream)
+ :string (lisp-stream-string-buffer stream)
+ :s-start 1
+ :state state)
+ (declare (ignore s))
+ (setf (lisp-stream-string-index stream) 1)
+ (setf (lisp-stream-string-buffer-len stream) pos)
+ (setf (lisp-stream-in-index stream) (+ index count))
+ (setf (fd-stream-oc-state stream) new-state))))
+ extfmt))
(stream::precompile-ef-slot :iso8859-1 #.stream::+ef-cin+)
Index: src/code/fd-stream.lisp
diff -u src/code/fd-stream.lisp:1.95 src/code/fd-stream.lisp:1.96
--- src/code/fd-stream.lisp:1.95 Fri Jan 22 22:00:07 2010
+++ src/code/fd-stream.lisp Sat Jan 23 13:02:05 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.95 2010-01-23 03:00:07 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.96 2010-01-23 18:02:05 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1803,8 +1803,7 @@
;;
;;#-unicode-bootstrap ; fails in stream-reinit otherwise
#+(and unicode (not unicode-bootstrap))
- (when lisp::*enable-stream-buffer-p*
- (%set-fd-stream-external-format stream external-format nil))
+ (%set-fd-stream-external-format stream external-format nil)
(set-routines stream element-type input output input-buffer-p
:binary-stream-p binary-stream-p)
#+(and unicode (not unicode-bootstrap))
Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.88 src/code/stream.lisp:1.89
--- src/code/stream.lisp:1.88 Sun Oct 18 10:21:24 2009
+++ src/code/stream.lisp Sat Jan 23 13:02:05 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.88 2009-10-18 14:21:24 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.89 2010-01-23 18:02:05 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -298,59 +298,12 @@
;; fundamental-stream
:default))
+;; This is only used while building; it's reimplemented in
+;; fd-stream-extfmt.lisp
#+unicode
(defun %set-fd-stream-external-format (stream extfmt &optional (updatep t))
- (declare (type fd-stream stream))
- (let ((old-format (fd-stream-external-format stream)))
- (setf (fd-stream-external-format stream)
- (stream::ef-name (stream::find-external-format extfmt))
- (fd-stream-oc-state stream) nil
- (fd-stream-co-state stream) nil)
- (when (fd-stream-ibuf-sap stream) ; input stream
- (setf (fd-stream-in stream) (ef-cin extfmt)))
- (when (fd-stream-obuf-sap stream) ; output stream
- (setf (fd-stream-out stream) (ef-cout extfmt)
- ;;@@ (fd-stream-sout stream) (ef-sout extfmt)
- ))
- (when (and lisp::*enable-stream-buffer-p* updatep
- (lisp-stream-string-buffer stream))
- ;; We want to reconvert any octets that haven't been converted
- ;; yet. So, we need to figure out which octet to start with.
- ;; This is done by converting (the previously converted) octets
- ;; until we've converted the right number of characters.
- (let ((ibuf (lisp-stream-in-buffer stream))
- (sindex (1- (lisp-stream-string-index stream)))
- (index 0)
- (state (fd-stream-saved-oc-state stream)))
- ;; Reconvert all the octets we've already converted and read.
- ;; We don't know how many octets that is, but do know how many
- ;; characters there are.
- (multiple-value-bind (s pos count new-state)
- (octets-to-string ibuf
- :start 0
- :external-format old-format
- :string (make-string sindex)
- :state state)
- (declare (ignore s pos))
- (setf state new-state)
- (setf index count))
-
- ;; We now know the last octet that was used. Now convert the
- ;; rest of the octets using the new format.
- (multiple-value-bind (s pos count new-state)
- (octets-to-string ibuf
- :start index
- :end (fd-stream-in-length stream)
- :external-format (fd-stream-external-format stream)
- :string (lisp-stream-string-buffer stream)
- :s-start 1
- :state state)
- (declare (ignore s))
- (setf (lisp-stream-string-index stream) 1)
- (setf (lisp-stream-string-buffer-len stream) pos)
- (setf (lisp-stream-in-index stream) (+ index count))
- (setf (fd-stream-oc-state stream) new-state))))
- extfmt))
+ extfmt)
+
;; This is only used while building; it's reimplemented in
;; fd-stream-extfmt.lisp
More information about the cmucl-commit
mailing list