From cf0b72cd4052a09b9a305081524bd44e2948c1e5 Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Fri, 1 Jun 2007 03:02:11 +0000 Subject: [PATCH] 1.0.6.9: micro-optimize portions of the reader * use the more idiomatic (and better optimized) MAKE-ARRAY/REPLACE combination to grow the read buffer; * host some special variable accesses and eliminate bounds checking in CASIFY-READ-BUFFER. --- src/code/reader.lisp | 29 ++++++++++++++++------------- version.lisp-expr | 2 +- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 69a853f..08d6ea3 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -401,12 +401,11 @@ standard Lisp readtable when NIL." (setq *ouch-ptr* (1- (the fixnum *ouch-ptr*))))) (defun grow-read-buffer () - (let ((rbl (length (the simple-string *read-buffer*)))) - (setq *read-buffer* - (concatenate 'simple-string - *read-buffer* - (make-string rbl))) - (setq *read-buffer-length* (* 2 rbl)))) + (let* ((rbl (length *read-buffer*)) + (new-length (* 2 rbl)) + (new-buffer (make-string new-length))) + (setq *read-buffer* (replace new-buffer *read-buffer*)) + (setq *read-buffer-length* new-length))) (defun inchpeek-read-buffer () (if (>= (the fixnum *inch-ptr*) (the fixnum *ouch-ptr*)) @@ -776,16 +775,20 @@ variables to allow for nested and thread safe reading." (let ((case (readtable-case *readtable*))) (cond ((and (null escapes) (eq case :upcase)) - (dotimes (i *ouch-ptr*) - (setf (schar *read-buffer* i) - (char-upcase (schar *read-buffer* i))))) + ;; Pull the special variable access out of the loop. + (let ((buffer *read-buffer*)) + (dotimes (i *ouch-ptr*) + (declare (optimize (sb!c::insert-array-bounds-checks 0))) + (setf (schar buffer i) (char-upcase (schar buffer i)))))) ((eq case :preserve)) (t (macrolet ((skip-esc (&body body) `(do ((i (1- *ouch-ptr*) (1- i)) + (buffer *read-buffer*) (escapes escapes)) ((minusp i)) - (declare (fixnum i)) + (declare (fixnum i) + (optimize (sb!c::insert-array-bounds-checks 0))) (when (or (null escapes) (let ((esc (first escapes))) (declare (fixnum esc)) @@ -794,12 +797,12 @@ variables to allow for nested and thread safe reading." (aver (= esc i)) (pop escapes) nil)))) - (let ((ch (schar *read-buffer* i))) + (let ((ch (schar buffer i))) ,@body))))) (flet ((lower-em () - (skip-esc (setf (schar *read-buffer* i) (char-downcase ch)))) + (skip-esc (setf (schar buffer i) (char-downcase ch)))) (raise-em () - (skip-esc (setf (schar *read-buffer* i) (char-upcase ch))))) + (skip-esc (setf (schar buffer i) (char-upcase ch))))) (ecase case (:upcase (raise-em)) (:downcase (lower-em)) diff --git a/version.lisp-expr b/version.lisp-expr index 9947068..b584e16 100644 --- 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".) -"1.0.6.8" +"1.0.6.9" -- 1.7.10.4