From: Juho S. <js...@us...> - 2005-10-28 12:16:35
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28243/src/code Modified Files: fd-stream.lisp Log Message: 0.9.6.7: Specialize the sequence functions used for newline-handling in FD-SOUT for the common cases of SIMPLE-BASE-STRING / (SIMPLE-ARRAY CHARACTER). Index: fd-stream.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v retrieving revision 1.86 retrieving revision 1.87 diff -u -d -r1.86 -r1.87 --- fd-stream.lisp 28 Oct 2005 12:11:47 -0000 1.86 +++ fd-stream.lisp 28 Oct 2005 12:16:24 -0000 1.87 @@ -502,15 +502,26 @@ (end (or end (length (the vector thing))))) (declare (fixnum start end)) (if (stringp thing) - (let ((last-newline (and (find #\newline (the simple-string thing) - :start start :end end) - ;; FIXME why do we need both calls? - ;; Is find faster forwards than - ;; position is backwards? - (position #\newline (the simple-string thing) - :from-end t - :start start - :end end)))) + (let ((last-newline + (flet ((do-it (string) + (and (find #\newline string :start start :end end) + ;; FIXME why do we need both calls? + ;; Is find faster forwards than + ;; position is backwards? + (position #\newline string + :from-end t + :start start + :end end)))) + (declare (inline do-it)) + ;; Specialize the common cases + (etypecase thing + (simple-base-string + (do-it (the simple-base-string thing))) + #!+sb-unicode + ((simple-array character) + (do-it (the (simple-array character) thing))) + (string + (do-it thing)))))) (if (and (typep thing 'base-string) (eq (fd-stream-external-format stream) :latin-1)) (ecase (fd-stream-buffering stream) |