From a37dfc192774fb23fd9b7fef6e6878321f58e096 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sun, 22 Aug 2004 15:32:48 +0000
Subject: [PATCH] o Add a VOP for INTEGER-LENGTH for (UNSIGNED-BYTE 32) o
 Modify the modular ash optimizer to handle both left and right   modular
 shifts.

---
 compiler/sparc/arith.lisp | 54 +++++++++++++++++++++++++++++++++++----
 1 file changed, 49 insertions(+), 5 deletions(-)

diff --git a/compiler/sparc/arith.lisp b/compiler/sparc/arith.lisp
index 0a6aada48..6e102bc92 100644
--- a/compiler/sparc/arith.lisp
+++ b/compiler/sparc/arith.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.43 2004/07/15 18:08:47 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.44 2004/08/22 15:32:48 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -825,6 +825,31 @@
       (inst b :ne loop)
       (inst srln shift 1))))
 
+(define-vop (unsigned-byte-32-len)
+  (:translate integer-length)
+  (:note "inline (unsigned-byte 32) integer-length")
+  (:policy :fast-safe)
+  (:args (arg :scs (unsigned-reg) :target shift))
+  (:arg-types unsigned-num)
+  (:results (res :scs (any-reg)))
+  (:result-types positive-fixnum)
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift)
+  (:generator 30
+    (let ((loop (gen-label))
+	  (test (gen-label)))
+      (move shift arg)
+      (inst b test)
+      (move res zero-tn)
+
+      (emit-label loop)
+      (inst add res (fixnumize 1))
+      
+      (emit-label test)
+      (inst cmp shift)
+      (inst b :ne loop)
+      (inst srln shift 1))))
+
+
 (define-vop (unsigned-byte-32-count)
   (:translate logcount)
   (:note "inline (unsigned-byte 32) logcount")
@@ -2444,10 +2469,18 @@
   (unsigned-byte 32)
   (foldable flushable movable))
 
+(defknown vm::ash-mod32 (integer integer)
+  (unsigned-byte 32)
+  (foldable flushable movable))
+
 (define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
 	     digit-ashl)
   (:translate ash-left-mod32))
 
+(define-vop (fast-ash-mod32/unsigned=>unsigned
+	     fast-ash/unsigned=>unsigned)
+    (:translate ash-mod32))
+
 )
 
 (in-package :c)
@@ -2460,10 +2493,21 @@
   ;; which takes the count mod 64.  Then a left shift of 32 or more
   ;; will produce 0 in the lower 32 bits of the register, which is
   ;; what we want.)
-  (when (and (<= width 32)
-	     (csubtypep (continuation-type count) (specifier-type '(unsigned-byte 5))))
-    (cut-to-width integer width)
-    'vm::ash-left-mod32))
+  (when (<= width 32)
+    ;; We can do a modular shift.  If the shift is known to be a left
+    ;; shift, we can use the left shift vop to get a left shift
+    ;; instruction.  Otherwise, we can use the regular fast-ash vop to
+    ;; get the shift.
+    (let ((count-type (continuation-type count)))
+      (cond ((csubtypep count-type (specifier-type '(unsigned-byte 5)))
+	     (cut-to-width integer width)
+	     'vm::ash-left-mod32)
+	    ((csubtypep count-type (specifier-type '(integer -31 31)))
+	     (cut-to-width integer width)
+	     'vm::ash-mod32)
+	    (t
+	     ;; Do nothing
+	     nil)))))
 
 ;;; If both arguments and the result are (unsigned-byte 32), try to come up
 ;;; with a ``better'' multiplication using multiplier recoding.  There are two
-- 
GitLab