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