[Openmcl-cvs-notifications] r10424 - in /trunk/source: level-1/l1-clos-boot.lisp level-1/l1-streams.lisp library/lispequ.lisp
gb at clozure.com
gb at clozure.com
Sun Aug 10 21:32:43 EDT 2008
Author: gb
Date: Sun Aug 10 21:32:43 2008
New Revision: 10424
Log:
Store the class-wrapper (not the class) in a BASIC-STREAM.
Modified:
trunk/source/level-1/l1-clos-boot.lisp
trunk/source/level-1/l1-streams.lisp
trunk/source/library/lispequ.lisp
Modified: trunk/source/level-1/l1-clos-boot.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-clos-boot.lisp (original)
+++ trunk/source/level-1/l1-clos-boot.lisp Sun Aug 10 21:32:43 2008
@@ -1183,7 +1183,7 @@
(cond ((eql typecode target::subtag-istruct)
(istruct-cell-info (%svref instance 0)))
((eql typecode target::subtag-basic-stream)
- (%class.own-wrapper (basic-stream.class instance)))
+ (basic-stream.wrapper instance))
((typep instance 'funcallable-standard-object)
(gf.instance.class-wrapper instance))
((eql typecode target::subtag-macptr)
@@ -2279,7 +2279,7 @@
(or (find-class (istruct-cell-name cell) nil)
*istruct-class*)))))
(setf (%svref v target::subtag-basic-stream)
- #'(lambda (b) (basic-stream.class b)))
+ #'(lambda (b) (%wrapper-class (basic-stream.wrapper b))))
(setf (%svref v target::subtag-instance)
#'%class-of-instance)
(setf (%svref v #+ppc-target target::subtag-symbol
Modified: trunk/source/level-1/l1-streams.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-streams.lisp (original)
+++ trunk/source/level-1/l1-streams.lisp Sun Aug 10 21:32:43 2008
@@ -518,8 +518,8 @@
(idx (io-buffer-idx inbuf))
(count (io-buffer-count inbuf)))
(unless (=3D count 0)
- (let* ((start (max (- idx (* 5 size)) 0))
- (end (min (+ idx (* 5 size)) count))
+ (let* ((start (max (- idx (* 10 size)) 0))
+ (end (min (+ idx (* 10 size)) count))
(string (make-string (funcall (character-encoding-length-=
of-vector-encoding-function encoding) buffer start end))))
(funcall (character-encoding-vector-decode-function encoding)
buffer
@@ -3652,8 +3652,8 @@
=
(defun allocate-basic-stream (class)
(if (subtypep class 'basic-file-stream)
- (gvector :basic-stream class 0 nil nil nil nil nil)
- (gvector :basic-stream class 0 nil nil)))
+ (gvector :basic-stream (%class-own-wrapper class) 0 nil nil nil nil ni=
l)
+ (gvector :basic-stream (%class-own-wrapper class) 0 nil nil)))
=
=
(defmethod initialize-basic-stream ((s basic-stream) &key &allow-other-key=
s)
@@ -4227,6 +4227,7 @@
(index 0))
=
(defstatic *string-output-stream-class* (make-built-in-class 'string-outpu=
t-stream 'string-stream 'basic-character-output-stream))
+(defstatic *string-output-stream-class-wrapper* (%class-own-wrapper *strin=
g-output-stream-class*))
=
(defstatic *fill-pointer-string-output-stream-class* (make-built-in-class =
'fill-pointer-string-output-stream 'string-output-stream))
=
@@ -4244,8 +4245,8 @@
;;; Should only be used for a stream whose class is exactly
;;; *string-output-stream-class* =
(defun %close-string-output-stream (stream ioblock)
- (when (eq (basic-stream.class stream)
- *string-output-stream-class*)
+ (when (eq (basic-stream.wrapper stream)
+ *string-output-stream-class-wrapper*)
(without-interrupts
(setf (ioblock-stream ioblock) (pool.data %string-output-stream-ioblo=
cks%)
(pool.data %string-output-stream-ioblocks%) ioblock))))
@@ -4253,8 +4254,8 @@
(defun create-string-output-stream-ioblock (&rest keys &key stream &allow-=
other-keys)
(declare (dynamic-extent keys))
(let* ((recycled (and stream
- (eq (basic-stream.class stream)
- *string-output-stream-class*)
+ (eq (basic-stream.wrapper stream)
+ *string-output-stream-class-wrapper*)
(without-interrupts
(let* ((data (pool.data %string-output-stream-iob=
locks%)))
(when data
@@ -4400,8 +4401,11 @@
(setf (string-output-stream-ioblock-index ioblock) newpos)))))
=
(defun make-simple-string-output-stream ()
+ ;; There's a good chance that we'll get a recycled ioblock
+ ;; that already has a string; if not, we defer actually
+ ;; creating a usable string until write-char
(%%make-string-output-stream *string-output-stream-class*
- (make-string 40)
+ ""
'string-output-stream-ioblock-write-char
'string-output-stream-ioblock-write-simple-=
string))
=
@@ -4459,7 +4463,7 @@
;;;One way to indent on newlines:
=
(defstatic *indenting-string-output-stream-class* (make-built-in-class 'in=
denting-string-output-stream 'string-output-stream))
-
+(defstatic *indenting-string-output-stream-class-wrapper* (%class-own-wrap=
per *indenting-string-output-stream-class*))
=
=
(defun indenting-string-stream-ioblock-write-char (ioblock c)
@@ -4500,13 +4504,13 @@
=
(defun (setf indenting-string-output-stream-indent) (new stream)
(if (and (typep stream 'basic-stream)
- (eq (basic-stream.class stream) *indenting-string-output-stream=
-class*))
+ (eq (basic-stream.wrapper stream) *indenting-string-output-stre=
am-class-wrapper*))
(setf (getf (basic-stream.info stream) 'indent) new)
(report-bad-arg stream 'indenting-string-output-stream)))
=
=
(defun get-output-stream-string (s)
- (let* ((class (if (typep s 'basic-stream) (basic-stream.class s))))
+ (let* ((class (if (typep s 'basic-stream) (%wrapper-class (basic-stream.w=
rapper s)))))
(or (eq class *string-output-stream-class*)
(eq class *truncating-string-output-stream-class*)
(eq class *indenting-string-output-stream-class*)
@@ -4526,7 +4530,7 @@
=
;;; String input streams.
(defstatic *string-input-stream-class* (make-built-in-class 'string-input-=
stream 'string-stream 'basic-character-input-stream))
-
+(defstatic *string-input-stream-class-wrapper* (%class-own-wrapper *string=
-input-stream-class*))
(defstruct (string-input-stream-ioblock (:include string-stream-ioblock))
(start 0)
index
@@ -4537,7 +4541,7 @@
=
(defun string-input-stream-index (s)
(if (and (typep s 'basic-stream)
- (eq *string-input-stream-class* (basic-stream.class s)))
+ (eq *string-input-stream-class-wrapper* (basic-stream.wrapper s=
)))
(let* ((ioblock (basic-stream-ioblock s)))
(- (string-input-stream-ioblock-index ioblock)
(string-input-stream-ioblock-offset ioblock)))
@@ -4551,7 +4555,7 @@
(idx (string-input-stream-ioblock-index ioblock))
(end (string-input-stream-ioblock-end ioblock))
(string (string-stream-ioblock-string ioblock)))
- (subseq string (max (- idx 5) start) (min (+ idx 5) end))))))
+ (subseq string (max (- idx 10) start) (min (+ idx 10) end))))))
=
=
(defmethod stream-position ((s string-input-stream) &optional newpos)
@@ -4709,7 +4713,7 @@
stream)))
=
(defun string-stream-string (s)
- (let* ((class (if (typep s 'basic-stream) (basic-stream.class s))))
+ (let* ((class (if (typep s 'basic-stream) (%wrapper-class (basic-stream.=
wrapper s)))))
(or (eq class *string-output-stream-class*)
(eq class *truncating-string-output-stream-class*)
(eq class *indenting-string-output-stream-class*)
Modified: trunk/source/library/lispequ.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/library/lispequ.lisp (original)
+++ trunk/source/library/lispequ.lisp Sun Aug 10 21:32:43 2008
@@ -1317,7 +1317,7 @@
=
;;; "basic" (e.g., builtin, non-extensible) streams.
(def-accessors (basic-stream) %svref
- basic-stream.class ; a class object
+ basic-stream.wrapper ; a class wrapper
basic-stream.flags ; fixnum; bits.
basic-stream.state ; typically an ioblock
basic-stream.info ; a plist for less-often-used thin=
gs.
More information about the Openmcl-cvs-notifications
mailing list