0.8.4.26

[sbcl.git] / src / compiler / mips / arith.lisp

diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp
index bc45854..3b6b890 100644 (file)
--- a/src/compiler/mips/arith.lisp
+++ b/src/compiler/mips/arith.lisp
@@ -1,6 +1,15 @@
-(in-package "SB!VM")
+;;;; the VM definition arithmetic VOPs for MIPS
 
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
 
+(in-package "SB!VM")
 \f
 ;;;; Unary operations.
 
@@ -265,15 +274,11 @@
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)
   (:generator 1
-    (cond ((< count 0)
-          ;; It is a right shift.
-          (inst srl result number (min (- count) 31)))
-         ((> count 0)
-          ;; It is a left shift.
-          (inst sll result number (min count 31)))
-         (t
-          ;; Count=0?  Shouldn't happen, but it's easy:
-          (move result number)))))
+    (cond 
+      ((< count -31) (move result zero-tn))
+      ((< count 0) (inst srl result number (min (- count) 31)))
+      ((> count 0) (inst sll result number (min count 31)))
+      (t (bug "identity ASH not transformed away")))))
 
 (define-vop (fast-ash-c/signed=>signed)
   (:policy :fast-safe)
@@ -285,15 +290,10 @@
   (:results (result :scs (signed-reg)))
   (:result-types signed-num)
   (:generator 1
-    (cond ((< count 0)
-          ;; It is a right shift.
-          (inst sra result number (min (- count) 31)))
-         ((> count 0)
-          ;; It is a left shift.
-          (inst sll result number (min count 31)))
-         (t
-          ;; Count=0?  Shouldn't happen, but it's easy:
-          (move result number)))))
+    (cond 
+      ((< count 0) (inst sra result number (min (- count) 31)))
+      ((> count 0) (inst sll result number (min count 31)))
+      (t (bug "identity ASH not transformed away")))))
 
 (define-vop (signed-byte-32-len)
   (:translate integer-length)
@@ -684,6 +684,15 @@
   (:translate +-mod32))
 (define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
   (:translate +-mod32))
+(define-modular-fun --mod32 (x y) - 32)
+(define-vop (fast---mod32/unsigned=>unsigned fast--/unsigned=>unsigned)
+  (:translate --mod32))
+(define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned)
+  (:translate --mod32))
+
+(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
+            fast-ash-c/unsigned=>unsigned)
+  (:translate ash-left-mod32))
 
 ;;; logical operations
 (define-modular-fun lognot-mod32 (x) lognot 32)