0.9.2.25:

  * use a fresh read buffer for non-recursive reads to allow for
    nested and thread safe reading
  * killed read-from-string's string-input-stream and stringify-object's
    string-output-stream cache mainly for thread safety reasons
  * as a side-effect potentially huge buffers do not linger

diff --git a/NEWS b/NEWS
index bc4b411..8a3a2bd 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,7 @@ changes in sbcl-0.9.3 relative to sbcl-0.9.2:
   * various error reporting improvements.
   * optimizations: LOGNOR on fixnums is improved in the MIPS backend.
     (Thanks to Thiemo Seufer)
+  * bug fix: nested reader invokations work correctly
   * threads
     ** added x86-64 support
     ** incompatible change: the threading api now works with thread
@@ -25,6 +26,7 @@ changes in sbcl-0.9.3 relative to sbcl-0.9.2:
        starting up or going down
     ** bug fix: a race where an exiting thread could lose its stack to gc
     ** fixed numerous gc deadlocks introduced in the pthread merge
+    ** bug fix: fixed thread safety issues in read and print
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** TYPE-ERRORs from signalled by COERCE now have DATUM and
        EXPECTED-TYPE slots filled.

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 4d7aa09..018cf57 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -230,16 +230,11 @@
 
 ;;; This produces the printed representation of an object as a string.
 ;;; The few ...-TO-STRING functions above call this.
-(defvar *string-output-streams* ())
 (defun stringify-object (object)
-  (let ((stream (if *string-output-streams*
-                   (pop *string-output-streams*)
-                   (make-string-output-stream))))
+  (let ((stream (make-string-output-stream)))
     (setup-printer-state)
     (output-object object stream)
-    (prog1
-       (get-output-stream-string stream)
-      (push stream *string-output-streams*))))
+    (get-output-stream-string stream)))
 \f
 ;;;; support for the PRINT-UNREADABLE-OBJECT macro
 

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 86b223e..cbdb50d 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -63,7 +63,8 @@
   ;; FIXME: should probably become inline function
   `(if (typep ,char 'base-char)
        (elt (character-attribute-array ,rt) (char-code ,char))
-       (gethash ,char (character-attribute-hash-table ,rt) +char-attr-constituent+)))
+       (gethash ,char (character-attribute-hash-table ,rt)
+        +char-attr-constituent+)))
 
 (defun set-cat-entry (char newvalue &optional (rt *readtable*))
   (if (typep char 'base-char)
@@ -292,7 +293,8 @@
              ((/= (the fixnum
                      (if (typep char 'base-char)
                          (aref attribute-array (char-code char))
-                         (gethash char attribute-hash-table +char-attr-constituent+)))
+                         (gethash char attribute-hash-table
+                                  +char-attr-constituent+)))
                   +char-attr-whitespace+)
               (done-with-fast-read-char)
               char)))
@@ -305,7 +307,8 @@
                 (/= (the fixnum
                        (if (typep char 'base-char)
                            (aref attribute-array (char-code char))
-                           (gethash char attribute-hash-table +char-attr-constituent+)))
+                           (gethash char attribute-hash-table
+                                    +char-attr-constituent+)))
                     +char-attr-whitespace+))
             (if (eq char :eof)
                 (error 'end-of-file :stream stream)
@@ -374,11 +377,6 @@
      ;; *INCH-PTR* always points to next char to read.
      (setq *inch-ptr* 0)))
 
-(defun !cold-init-read-buffer ()
-  (setq *read-buffer* (make-string 512)) ; initial bufsize
-  (setq *read-buffer-length* 512)
-  (reset-read-buffer))
-
 ;;; FIXME I removed "THE FIXNUM"'s from OUCH-READ-BUFFER and
 ;;; OUCH-UNREAD-BUFFER, check to make sure that Python really is smart
 ;;; enough to make good code without them. And while I'm at it,
@@ -428,6 +426,18 @@
 
 (defun read-buffer-to-string ()
   (subseq *read-buffer* 0 *ouch-ptr*))
+
+(defmacro with-reader ((&optional recursive-p) &body body)
+  #!+sb-doc
+  "If RECURSIVE-P is NIL, bind *READER-BUFFER* and its subservient
+variables to allow for nested and thread safe reading."
+  `(if ,recursive-p
+       (progn ,@body)
+       (let* ((*read-buffer* (make-string 128))
+              (*read-buffer-length* 128)
+              (*ouch-ptr* 0)
+              (*inch-ptr* 0))
+         ,@body)))
 \f
 ;;;; READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST, and READ
 
@@ -464,10 +474,11 @@
                        (result (multiple-value-list
                                 (funcall macrofun stream char))))
                   ;; Repeat if macro returned nothing.
-                 (when result 
+                 (when result
                     (return (unless *read-suppress* (car result)))))))))
-      (let ((*sharp-equal-alist* nil))
-       (read-preserving-whitespace stream eof-error-p eof-value t))))
+      (with-reader ()
+        (let ((*sharp-equal-alist* nil))
+          (read-preserving-whitespace stream eof-error-p eof-value t)))))
 
 ;;; Return NIL or a list with one thing, depending.
 ;;;
@@ -507,12 +518,12 @@
   #!+sb-doc
   "Read Lisp values from INPUT-STREAM until the next character after a
    value's representation is ENDCHAR, and return the objects as a list."
-  (declare (ignore recursive-p))
-  (do ((char (flush-whitespace input-stream)
-            (flush-whitespace input-stream))
-       (retlist ()))
-      ((char= char endchar) (unless *read-suppress* (nreverse retlist)))
-    (setq retlist (nconc (read-maybe-nothing input-stream char) retlist))))
+  (with-reader (recursive-p)
+    (do ((char (flush-whitespace input-stream)
+               (flush-whitespace input-stream))
+         (retlist ()))
+        ((char= char endchar) (unless *read-suppress* (nreverse retlist)))
+      (setq retlist (nconc (read-maybe-nothing input-stream char) retlist)))))
 \f
 ;;;; basic readmacro definitions
 ;;;;
@@ -1485,11 +1496,6 @@
 \f
 ;;;; READ-FROM-STRING
 
-;;; FIXME: Is it really worth keeping this pool?
-(defvar *read-from-string-spares* ()
-  #!+sb-doc
-  "A resource of string streams for Read-From-String.")
-
 (defun read-from-string (string &optional (eof-error-p t) eof-value
                                &key (start 0) end
                                preserve-whitespace)
@@ -1498,23 +1504,14 @@
    and the lisp object built by the reader is returned. Macro chars
    will take effect."
   (declare (string string))
-  
   (with-array-data ((string string :offset-var offset)
                    (start start)
                    (end (%check-vector-sequence-bounds string start end)))
-    (unless *read-from-string-spares*
-      (push (make-string-input-stream "" 0 0) *read-from-string-spares*))
-    (let ((stream (pop *read-from-string-spares*)))
-      (setf (string-input-stream-string stream)
-           (coerce string '(simple-array character (*))))
-      (setf (string-input-stream-current stream) start)
-      (setf (string-input-stream-end stream) end)
-      (unwind-protect
-         (values (if preserve-whitespace
-                     (read-preserving-whitespace stream eof-error-p eof-value)
-                     (read stream eof-error-p eof-value))
-                 (- (string-input-stream-current stream) offset))
-       (push stream *read-from-string-spares*)))))
+    (let ((stream (make-string-input-stream string start end)))
+      (values (if preserve-whitespace
+                  (read-preserving-whitespace stream eof-error-p eof-value)
+                  (read stream eof-error-p eof-value))
+              (- (string-input-stream-current stream) offset)))))
 \f
 ;;;; PARSE-INTEGER
 
@@ -1577,7 +1574,6 @@
 ;;;; reader initialization code
 
 (defun !reader-cold-init ()
-  (!cold-init-read-buffer)
   (!cold-init-constituent-trait-table)
   (!cold-init-standard-readtable)
   ;; FIXME: This was commented out, but should probably be restored.

diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp
index 46be9f9..1d90ae1 100644 (file)
--- a/tests/reader.impure.lisp
+++ b/tests/reader.impure.lisp
@@ -83,5 +83,24 @@
 (assert (eq (symbol-package (read-from-string "||::FOO"))
            (find-package "")))
 
+;;; test nested reads, test case by Helmut Eller for cmucl
+(defclass my-in-stream (sb-gray:fundamental-character-input-stream)
+  ((last-char :initarg :last-char)))
+
+(let ((string " a ")
+      (i 0))
+  (defmethod sb-gray:stream-read-char ((s my-in-stream))
+    (with-input-from-string (s "b") (read s))
+    (with-slots (last-char) s
+      (cond (last-char (prog1 last-char (setf last-char nil)))
+            (t (prog1 (aref string i)
+                 (setq i (mod (1+ i) (length string)))))))))
+
+(defmethod sb-gray:stream-unread-char ((s my-in-stream) char)
+  (setf (slot-value s 'last-char) char)
+  nil)
+
+(assert (eq 'a (read (make-instance 'my-in-stream :last-char nil))))
+
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index d065352..9622ec5 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.2.24"
+"0.9.2.25"