[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2013-05-6-g59c5005

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  59c50055f4538c8ba49f6f8cae403563ea76cfbb (commit)
       via  78cce51df441b220c071024fb5e616f1928184dd (commit)
      from  0b5c1254cc522e4e10d0f14ea248cc74b82fae69 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 59c50055f4538c8ba49f6f8cae403563ea76cfbb
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat May 18 17:47:39 2013 -0700

    Update.

diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt
index 74e024e..d9aeb5e 100644
--- a/src/general-info/release-20e.txt
+++ b/src/general-info/release-20e.txt
@@ -59,6 +59,7 @@ New in this release:
     * FILE-POSITION no longer returns incorrect values.  See ticket
       #79.
     * Fix error in (format t "~ve" 21 5d-324).  (See ticket #80).
+    * String reverse is much faster (upto 20 times)
 
 
   * Trac Tickets:
@@ -77,6 +78,8 @@ New in this release:
     * Ticket #79 fixed.
     * Ticket #77 fixed.
     * Ticket #80 fixed.
+    * Ticket #81 fixed.
+    * Ticket #83 fixed.
 
   * Other changes:
     * -8 option for build-all.sh is deprecated since we don't

commit 78cce51df441b220c071024fb5e616f1928184dd
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat May 18 17:44:02 2013 -0700

    Fix ticket:81 and fix ticket:83.
    
    From ticket 81, the tests are now:
    
    {{{
    (time (prog1 t (time-rev *s*)))
    ; Evaluation took:
    ;   0.49 seconds of real time
    ;   0.481813 seconds of user run time
    ;   0.003624 seconds of system run time
    ;   1,490,776,936 CPU cycles
    ;   [Run times include 0.13 seconds GC run time]
    ;   0 page faults and
    ;   200,073,704 bytes consed.
    
    (time (prog1 t (time-rev *s2*)))
    ; Evaluation took:
    ;   0.97 seconds of real time
    ;   0.965893 seconds of user run time
    ;   0.005139 seconds of system run time
    ;   2,980,415,911 CPU cycles
    ;   [Run times include 0.23 seconds GC run time]
    ;   0 page faults and
    ;   400,005,560 bytes consed.
    }}}
    
    So the new string-reverse* is 20 times faster for strings without
    surrogates and 10 times faster for strings containing only surrogates.

diff --git a/src/code/string.lisp b/src/code/string.lisp
index 4b90930..f23db5b 100644
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -1172,13 +1172,24 @@
 	   (type string sequence))
   (with-string sequence
     (let* ((length (- end start))
-	   (string (make-string length))
-	   (j length))
-      (declare (type kernel:index length j))
-      (loop for i = start then n as n = (%glyph-f sequence i) do
-	    (replace string sequence :start1 (decf j (- n i)) :start2 i :end2 n)
-	    while (< n end))
-      string)))
+	   (r (make-string length)))
+      (do ((dst-index (1- length) (1- dst-index))
+	   (src-index start (1+ src-index)))
+	  ((minusp dst-index))
+	(declare (fixnum src-index dst-index))
+	(let ((current-char (schar sequence src-index)))
+	  (cond ((and (lisp::surrogatep current-char :leading)
+		      (plusp dst-index))
+		 ;; Reverse surrogate pairs correctly, which means the
+		 ;; pair isn't reversed at all.
+		 (incf src-index)
+		 (setf (schar r dst-index) (schar sequence src-index))
+		 (decf dst-index)
+		 (setf (schar r dst-index) current-char))
+		(t
+		 ;; Easy case
+		 (setf (schar r dst-index) current-char)))))
+      r)))
 
 #+unicode
 (defun string-nreverse* (sequence)

-----------------------------------------------------------------------

Summary of changes:
 src/code/string.lisp             |   25 ++++++++++++++++++-------
 src/general-info/release-20e.txt |    3 +++
 2 files changed, 21 insertions(+), 7 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp