[git] CMU Common Lisp branch master updated. snapshot-2013-07-4-g0d3125c

Carl S. Shapiro cshapiro at common-lisp.net
Fri Aug 2 05:06:44 UTC 2013


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  0d3125cf5eda435f8dca8f490a01e508e66c69cb (commit)
      from  5e340d321c4f4b4f0a2ef948293892ffe47c9308 (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 0d3125cf5eda435f8dca8f490a01e508e66c69cb
Author: Carl Shapiro <cshapiro at common-lisp.net>
Date:   Thu Aug 1 21:59:57 2013 -0700

    Remove EAX dependency in length/list and retire fast-length/list.

diff --git a/src/compiler/x86/subprim.lisp b/src/compiler/x86/subprim.lisp
index c130ed7..f5e5caf 100644
--- a/src/compiler/x86/subprim.lisp
+++ b/src/compiler/x86/subprim.lisp
@@ -28,66 +28,74 @@
   (:translate length)
   (:args (object :scs (descriptor-reg control-stack) :target ptr))
   (:arg-types list)
-  (:temporary (:sc unsigned-reg :offset eax-offset) eax)
   (:temporary (:sc descriptor-reg :from (:argument 0)) ptr)
+  (:temporary (:scs (unsigned-reg)) temp)
   (:results (count :scs (any-reg)))
   (:result-types positive-fixnum)
   (:policy :fast-safe)
   (:vop-var vop)
   (:save-p :compute-only)
-  (:generator 40
-    ;; Move OBJECT into a temp we can bash on, and initialize the count.
-    (move ptr object)
-    (inst xor count count)
-    ;; If we are starting with NIL, then it's real easy.
-    (inst cmp ptr nil-value)
-    (inst jmp :e done)
-    ;; Note: we don't have to test to see if the original argument is a
-    ;; list, because this is a :fast-safe vop.
-    LOOP
-    ;; Get the CDR and boost the count.
-    (loadw ptr ptr cons-cdr-slot list-pointer-type)
-    (inst add count (fixnumize 1))
-    ;; If we hit NIL, then we are done.
-    (inst cmp ptr nil-value)
-    (inst jmp :e done)
-    ;; Otherwise, check to see if we hit the end of a dotted list.  If
-    ;; not, loop back for more.
-    (move eax ptr)
-    (inst and al-tn lowtag-mask)
-    (inst cmp al-tn list-pointer-type)
-    (inst jmp :e loop)
-    ;; It's dotted all right.  Flame out.
-    (error-call vop object-not-list-error ptr)
-    ;; We be done.
-    DONE))
-
-(define-vop (fast-length/list)
+  (:generator 50
+    (let ((done (gen-label))
+	  (loop (gen-label))
+	  (not-list (generate-error-code vop object-not-list-error object)))
+      (move ptr object)
+      (inst xor count count)
+
+      (inst cmp ptr nil-value)
+      (inst jmp :e done)
+
+      (emit-label loop)
+
+      (loadw ptr ptr cons-cdr-slot list-pointer-type)
+      (inst add count (fixnumize 1))
+
+      (move temp ptr)
+      (inst and temp lowtag-mask)
+      (inst cmp temp list-pointer-type)
+      (inst jmp :ne not-list)
+
+      (inst cmp ptr nil-value)
+      (inst jmp :ne loop)
+
+      (emit-label done))))
+
+#+ignore
+(define-vop (length/list)
   (:translate length)
   (:args (object :scs (descriptor-reg control-stack) :target ptr))
   (:arg-types list)
   (:temporary (:sc descriptor-reg :from (:argument 0)) ptr)
+  (:temporary (:scs (unsigned-reg)) temp)
   (:results (count :scs (any-reg)))
   (:result-types positive-fixnum)
-  (:policy :fast)
+  (:policy :fast-safe)
   (:vop-var vop)
   (:save-p :compute-only)
-  (:generator 30
-    ;; Get a copy of OBJECT in a register we can bash on, and
-    ;; initialize COUNT.
-    (move ptr object)
-    (inst xor count count)
-    ;; If we are starting with NIL, we be done.
-    (inst cmp ptr nil-value)
-    (inst jmp :e done)
-    ;; Indirect the next cons cell, and boost the count.
-    LOOP
-    (loadw ptr ptr cons-cdr-slot list-pointer-type)
-    (inst add count (fixnumize 1))
-    ;; If we arn't done, go back for more.
-    (inst cmp ptr nil-value)
-    (inst jmp :ne loop)
-    DONE))
+  (:generator 50
+    (let ((done (gen-label))
+	  (loop (gen-label))
+	  (not-list (generate-error-code vop object-not-list-error object)))
+      (move ptr object)
+      (inst xor count count)
+
+      (inst cmp ptr nil-value)
+      (inst jmp :e done)
+
+      (emit-label loop)
+
+      (loadw ptr ptr cons-cdr-slot list-pointer-type)
+      (inst add count (fixnumize 1))
+
+      (move temp ptr)
+      (inst and temp lowtag-mask)
+      (inst cmp temp list-pointer-type)
+      (inst jmp :ne not-list)
+
+      (inst cmp ptr nil-value)
+      (inst jmp :ne loop)
+
+      (emit-label done))))
 
 
 (define-static-function length (object) :translate length)

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

Summary of changes:
 src/compiler/x86/subprim.lisp |  100 ++++++++++++++++++++++-------------------
 1 file changed, 54 insertions(+), 46 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp



More information about the cmucl-cvs mailing list