From ae469bbdd046b46348538f1b69db6e6b044be52f Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 14 Feb 2011 15:08:06 +0000 Subject: [PATCH] 1.0.45.33: optimize CHARPOS on string-streams The POSITION in STRING-OUT-MISC wasn't getting optimized at all due to insufficient type-information. This speeds up pretty-printing on string-streams somewhat. --- NEWS | 2 ++ src/code/stream.lisp | 5 ++++- version.lisp-expr | 2 +- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 51a1c8f..ad1a3da 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,8 @@ changes relative to sbcl-1.0.45: up instance creation in those cases. * optimization: arithmetic operations with multiple constant arguments in now have them reduced at compile-time. (lp#676414) + * optimization: determining current character position on string-streams for + pretty-printing was overly slow. * bug fix: local tail calls to DYNAMIC-EXTENT functions can no longer cause lifetime analysis to overwrite closed-over variables (lp#681092). * bug fix: encoding errors from some multibyte external formats such as EUC-JP diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 7eb78ac..2b43d83 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1460,6 +1460,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") (defun string-out-misc (stream operation &optional arg1 arg2) (declare (ignore arg2)) + (declare (optimize speed)) (case operation (:charpos ;; Keeping this first is a silly micro-optimization: FRESH-LINE @@ -1469,8 +1470,10 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") (buffer (string-output-stream-buffer stream)) (prev (string-output-stream-prev stream)) (base 0)) + (declare (type (or null (simple-array character (*))) buffer)) :next - (let ((pos (position #\newline buffer :from-end t :end pointer))) + (let ((pos (when buffer + (position #\newline buffer :from-end t :end pointer)))) (when (or pos (not buffer)) ;; If newline is at index I, and pointer at index I+N, charpos ;; is N-1. If there is no newline, and pointer is at index N, diff --git a/version.lisp-expr b/version.lisp-expr index 03b2e40..25f596e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,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.45.32" +"1.0.45.33" -- 1.7.10.4