FAST-READ-BYTE refactoring

  Change PREPARE-FOR-FAST-READ-BYTE into WITH-FAST-READ-BYTE.

  DONE-WITH-FAST-READ-BYTE is gone.

  FAST-READ-BYTE is a local inline function instead of a macro.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index d712dd9..7312ffb 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1207,7 +1207,6 @@ possibly temporariliy, because it might be used internally."
                "+EMPTY-HT-SLOT+"
 
                ;; low-level i/o stuff
-               "DONE-WITH-FAST-READ-BYTE"
                "DONE-WITH-FAST-READ-CHAR"
                "FAST-READ-BYTE"
                "FAST-READ-BYTE-REFILL"
@@ -1218,7 +1217,7 @@ possibly temporariliy, because it might be used internally."
                "FAST-READ-VAR-U-INTEGER"
                "FILE-NAME"
                "INTERN*"
-               "PREPARE-FOR-FAST-READ-BYTE"
+               "WITH-FAST-READ-BYTE"
                "PREPARE-FOR-FAST-READ-CHAR"
 
                ;; reflection of our backquote implementation that the

diff --git a/src/code/cross-io.lisp b/src/code/cross-io.lisp
index 5932205..0121256 100644 (file)
--- a/src/code/cross-io.lisp
+++ b/src/code/cross-io.lisp
@@ -18,13 +18,15 @@
 ;;;; implementations, and the ordinary fop implementations are defined in terms
 ;;;; of fast-read operations.)
 
-(defmacro prepare-for-fast-read-byte (stream &body forms)
-  `(let ((%frc-stream% ,stream))
-     ,@forms))
-
-(defmacro fast-read-byte (&optional (eof-error-p t) (eof-value nil) any-type)
-  (declare (ignore any-type))
-  `(read-byte %frc-stream% ,eof-error-p ,eof-value))
-
-(defmacro done-with-fast-read-byte ()
-  `(values))
+(defmacro with-fast-read-byte ((type stream &optional (eof-error-p t) eof-value)
+                               &body body)
+  (declare (ignore type))
+  (let ((f-stream (gensym "STREAM"))
+        (f-eof-error-p (gensym "EOF-ERROR-P"))
+        (f-eof-value (gensym "EOF-VALUE")))
+    `(let ((,f-stream ,stream)
+           (,f-eof-error-p ,eof-error-p)
+           (,f-eof-value ,eof-value))
+       (flet ((fast-read-byte ()
+                  (the ,type (read-byte ,f-stream ,f-eof-error-p ,f-eof-value))))
+         ,@body))))

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index bcfb9cd..24e5c0a 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -275,16 +275,12 @@
   (load-s-integer (clone-arg)))
 
 (define-fop (fop-word-integer 35)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-     (fast-read-s-integer #.sb!vm:n-word-bytes)
-     (done-with-fast-read-byte))))
+  (with-fast-read-byte ((unsigned-byte 8) *fasl-input-stream*)
+    (fast-read-s-integer #.sb!vm:n-word-bytes)))
 
 (define-fop (fop-byte-integer 36)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-     (fast-read-s-integer 1)
-     (done-with-fast-read-byte))))
+  (with-fast-read-byte ((unsigned-byte 8) *fasl-input-stream*)
+    (fast-read-s-integer 1)))
 
 (define-fop (fop-ratio 70)
   (let ((den (pop-stack)))
@@ -302,17 +298,13 @@
   (macrolet ((define-complex-fop (name fop-code type)
                (let ((reader (symbolicate "FAST-READ-" type)))
                  `(define-fop (,name ,fop-code)
-                      (prepare-for-fast-read-byte *fasl-input-stream*
-                        (prog1
-                            (complex (,reader) (,reader))
-                          (done-with-fast-read-byte))))))
+                      (with-fast-read-byte ((unsigned-byte 8) *fasl-input-stream*)
+                        (complex (,reader) (,reader))))))
              (define-float-fop (name fop-code type)
                (let ((reader (symbolicate "FAST-READ-" type)))
                  `(define-fop (,name ,fop-code)
-                      (prepare-for-fast-read-byte *fasl-input-stream*
-                        (prog1
-                            (,reader)
-                          (done-with-fast-read-byte)))))))
+                    (with-fast-read-byte ((unsigned-byte 8) *fasl-input-stream*)
+                      (,reader))))))
     (define-complex-fop fop-complex-single-float 72 single-float)
     (define-complex-fop fop-complex-double-float 73 double-float)
     #!+long-float
@@ -435,68 +427,64 @@
 ;;;   extra bits. This must be packed according to the local
 ;;;   byte-ordering, allowing us to directly read the bits.
 (define-fop (fop-int-vector 43)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (let* ((len (fast-read-u-integer #.sb!vm:n-word-bytes))
-           (size (fast-read-byte))
-           (res (case size
-                  (0 (make-array len :element-type 'nil))
-                  (1 (make-array len :element-type 'bit))
-                  (2 (make-array len :element-type '(unsigned-byte 2)))
-                  (4 (make-array len :element-type '(unsigned-byte 4)))
-                  (7 (prog1 (make-array len :element-type '(unsigned-byte 7))
-                       (setf size 8)))
-                  (8 (make-array len :element-type '(unsigned-byte 8)))
-                  (15 (prog1 (make-array len :element-type '(unsigned-byte 15))
-                        (setf size 16)))
-                  (16 (make-array len :element-type '(unsigned-byte 16)))
-                  (31 (prog1 (make-array len :element-type '(unsigned-byte 31))
-                        (setf size 32)))
-                  (32 (make-array len :element-type '(unsigned-byte 32)))
-                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                  (63 (prog1 (make-array len :element-type '(unsigned-byte 63))
-                        (setf size 64)))
-                  (64 (make-array len :element-type '(unsigned-byte 64)))
-                  (t (bug "losing i-vector element size: ~S" size)))))
-      (declare (type index len))
-      (done-with-fast-read-byte)
-      (read-n-bytes *fasl-input-stream*
-                    res
-                    0
-                    (ceiling (the index (* size len)) sb!vm:n-byte-bits))
-      res)))
+  (let* ((len (read-word-arg))
+         (size (read-byte-arg))
+         (res (case size
+                (0 (make-array len :element-type 'nil))
+                (1 (make-array len :element-type 'bit))
+                (2 (make-array len :element-type '(unsigned-byte 2)))
+                (4 (make-array len :element-type '(unsigned-byte 4)))
+                (7 (prog1 (make-array len :element-type '(unsigned-byte 7))
+                     (setf size 8)))
+                (8 (make-array len :element-type '(unsigned-byte 8)))
+                (15 (prog1 (make-array len :element-type '(unsigned-byte 15))
+                      (setf size 16)))
+                (16 (make-array len :element-type '(unsigned-byte 16)))
+                (31 (prog1 (make-array len :element-type '(unsigned-byte 31))
+                      (setf size 32)))
+                (32 (make-array len :element-type '(unsigned-byte 32)))
+                #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                (63 (prog1 (make-array len :element-type '(unsigned-byte 63))
+                      (setf size 64)))
+                (64 (make-array len :element-type '(unsigned-byte 64)))
+                (t (bug "losing i-vector element size: ~S" size)))))
+    (declare (type index len))
+    (read-n-bytes *fasl-input-stream*
+                  res
+                  0
+                  (ceiling (the index (* size len)) sb!vm:n-byte-bits))
+    res))
 
 ;;; This is the same as FOP-INT-VECTOR, except this is for signed
 ;;; SIMPLE-ARRAYs.
 (define-fop (fop-signed-int-vector 50)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (let* ((len (fast-read-u-integer #.sb!vm:n-word-bytes))
-           (size (fast-read-byte))
-           (res (case size
-                  (8 (make-array len :element-type '(signed-byte 8)))
-                  (16 (make-array len :element-type '(signed-byte 16)))
-                  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
-                  (29 (prog1 (make-array len :element-type '(unsigned-byte 29))
-                        (setf size 32)))
-                  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
-                  (30 (prog1 (make-array len :element-type '(signed-byte 30))
-                        (setf size 32)))
-                  (32 (make-array len :element-type '(signed-byte 32)))
-                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                  (60 (prog1 (make-array len :element-type '(unsigned-byte 60))
-                        (setf size 64)))
-                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                  (61 (prog1 (make-array len :element-type '(signed-byte 61))
-                        (setf size 64)))
-                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-                  (64 (make-array len :element-type '(signed-byte 64)))
-                  (t (bug "losing si-vector element size: ~S" size)))))
-      (declare (type index len))
-      (done-with-fast-read-byte)
-      (read-n-bytes *fasl-input-stream*
-                    res
-                    0
-                    (ceiling (the index (* size len)) sb!vm:n-byte-bits))
-      res)))
+  (let* ((len (read-word-arg))
+         (size (read-byte-arg))
+         (res (case size
+                (8 (make-array len :element-type '(signed-byte 8)))
+                (16 (make-array len :element-type '(signed-byte 16)))
+                #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+                (29 (prog1 (make-array len :element-type '(unsigned-byte 29))
+                      (setf size 32)))
+                #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+                (30 (prog1 (make-array len :element-type '(signed-byte 30))
+                      (setf size 32)))
+                (32 (make-array len :element-type '(signed-byte 32)))
+                #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                (60 (prog1 (make-array len :element-type '(unsigned-byte 60))
+                      (setf size 64)))
+                #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                (61 (prog1 (make-array len :element-type '(signed-byte 61))
+                      (setf size 64)))
+                #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                (64 (make-array len :element-type '(signed-byte 64)))
+                (t (bug "losing si-vector element size: ~S" size)))))
+    (declare (type index len))
+    (read-n-bytes *fasl-input-stream*
+                  res
+                  0
+                  (ceiling (the index (* size len)) sb!vm:n-byte-bits))
+    res))
 
 (define-fop (fop-eval 53)
   (if *skip-until*

diff --git a/src/code/load.lisp b/src/code/load.lisp
index dc85504..193f393 100644 (file)
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -96,10 +96,8 @@
   (declare (optimize (speed 0)))
   (if (= n 1)
       `(the (unsigned-byte 8) (read-byte *fasl-input-stream*))
-      `(prepare-for-fast-read-byte *fasl-input-stream*
-         (prog1
-          (fast-read-u-integer ,n)
-          (done-with-fast-read-byte)))))
+      `(with-fast-read-byte ((unsigned-byte 8) *fasl-input-stream*)
+         (fast-read-u-integer ,n))))
 
 (declaim (inline read-byte-arg read-halfword-arg read-word-arg))
 (defun read-byte-arg ()

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 71adb3a..30f0e68 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -441,10 +441,8 @@
   ;; a-s-read-sequence and needs a lambda list that's congruent with
   ;; that of a-s-read-char
   (declare (ignore recursive-p))
-  (prepare-for-fast-read-byte stream
-    (prog1
-        (fast-read-byte eof-error-p eof-value t)
-      (done-with-fast-read-byte))))
+  (with-fast-read-byte (t stream eof-error-p eof-value)
+    (fast-read-byte)))
 
 (defun read-byte (stream &optional (eof-error-p t) eof-value)
   (if (ansi-stream-p stream)

diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index 59b8b45..b0aeb17 100644 (file)
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -184,37 +184,39 @@ maintained."
 ;;; Just like PREPARE-FOR-FAST-READ-CHAR except that we get the BIN
 ;;; method. The stream is assumed to be a ANSI-STREAM.
 ;;;
-;;; KLUDGE: It seems weird to have to remember to explicitly call
-;;; DONE-WITH-FAST-READ-BYTE at the end of this, given that we're
-;;; already wrapping the stuff inside in a block. Why not rename this
-;;; macro to WITH-FAST-READ-BYTE, do the DONE-WITH-FAST-READ-BYTE stuff
-;;; automatically at the end of the block, and eliminate
-;;; DONE-WITH-FAST-READ-BYTE as a separate entity? (and similarly
-;;; for the FAST-READ-CHAR stuff) -- WHN 19990825
-(defmacro prepare-for-fast-read-byte (stream &body forms)
-  `(let* ((%frc-stream% ,stream)
-          (%frc-method% (ansi-stream-bin %frc-stream%))
-          (%frc-buffer% (ansi-stream-in-buffer %frc-stream%))
-          (%frc-index% (ansi-stream-in-index %frc-stream%)))
-     (declare (type index %frc-index%)
-              (type ansi-stream %frc-stream%))
-     ,@forms))
-
-;;; Similar to fast-read-char, but we use a different refill routine & don't
-;;; convert to characters. If ANY-TYPE is true, then this can be used on any
-;;; integer streams, and we don't assert the result type.
-(defmacro fast-read-byte (&optional (eof-error-p t) (eof-value ()) any-type)
-  ;; KLUDGE: should use ONCE-ONLY on EOF-ERROR-P and EOF-VALUE -- WHN 19990825
-  `(truly-the
-    ,(if (and (eq eof-error-p t) (not any-type)) '(unsigned-byte 8) t)
-    (cond
-     ((not %frc-buffer%)
-      (funcall %frc-method% %frc-stream% ,eof-error-p ,eof-value))
-     ((= %frc-index% +ansi-stream-in-buffer-length+)
-      (prog1 (fast-read-byte-refill %frc-stream% ,eof-error-p ,eof-value)
-        (setq %frc-index% (ansi-stream-in-index %frc-stream%))))
-     (t
-      (prog1 (aref %frc-buffer% %frc-index%)
-        (incf %frc-index%))))))
-(defmacro done-with-fast-read-byte ()
-  `(done-with-fast-read-char))
+;;; FIXME: Refactor PREPARE-FOR-FAST-READ-CHAR into similar shape.
+(defmacro with-fast-read-byte ((type stream &optional (eof-error-p t) eof-value)
+                               &body body)
+  (aver (or (eq t eof-error-p) (eq t type)))
+  (with-unique-names (f-stream f-method f-buffer f-index eof-p eof-val)
+    `(let* ((,f-stream ,stream)
+            (,eof-p ,eof-error-p)
+            (,eof-val ,eof-value)
+            (,f-method (ansi-stream-bin ,f-stream))
+            (,f-buffer (ansi-stream-in-buffer ,f-stream))
+            (,f-index (ansi-stream-in-index ,f-stream)))
+       (declare (type ansi-stream ,f-stream)
+                (type index ,f-index))
+       (declare (disable-package-locks fast-read-byte))
+       (flet ((fast-read-byte ()
+                  (,@(cond ((equal '(unsigned-byte 8) type)
+                            ;; KLUDGE: For some reason I haven't tracked down
+                            ;; this makes a difference even in given the TRULY-THE.
+                            `(logand #xff))
+                           (t
+                            `(identity)))
+                   (truly-the ,type
+                              (cond
+                                ((not ,f-buffer)
+                                 (funcall ,f-method ,f-stream ,eof-p ,eof-val))
+                                ((= ,f-index +ansi-stream-in-buffer-length+)
+                                 (prog1 (fast-read-byte-refill ,f-stream ,eof-p ,eof-val)
+                                   (setq ,f-index (ansi-stream-in-index ,f-stream))))
+                                (t
+                                 (prog1 (aref ,f-buffer ,f-index)
+                                   (incf ,f-index))))))))
+         (declare (inline fast-read-byte))
+         (declare (enable-package-locks read-byte))
+         (unwind-protect
+              (locally ,@body)
+           (setf (ansi-stream-in-index ,f-stream) ,f-index))))))