From: Nikodemus Siivola Date: Fri, 9 Dec 2011 08:23:24 +0000 (+0200) Subject: FAST-READ-BYTE refactoring X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a3706c5d9d95ebb5a14e7ab7313c5781e5c86713;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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))))))