From dddd16256212eabaa6fd151bf2cbb7ec1d206619 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Mon, 18 Aug 2008 20:40:07 +0000
Subject: [PATCH] compiler/sparc/arith.lisp: compiler/x86/arith.lisp: o Define
 some new vops to handle modular arithmetic stuff when both   args are signed
 but the result is unsigned (because of modular   arithmetic).

---
 compiler/sparc/arith.lisp | 44 ++++++++++++++++++++++++++++++++++++---
 compiler/x86/arith.lisp   | 35 ++++++++++++++++++++++++++++---
 2 files changed, 73 insertions(+), 6 deletions(-)

diff --git a/compiler/sparc/arith.lisp b/compiler/sparc/arith.lisp
index 6ea2f3190..ee75a8d1d 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.45 2008/08/12 21:00:17 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.46 2008/08/18 20:40:02 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2413,6 +2413,16 @@
   (:generator 1
     (inst not res x)))
 
+(define-vop (lognot-mod32/signed=>unsigned)
+  (:translate lognot-mod32)
+  (:args (x :scs (signed-reg)))
+  (:arg-types signed-num)
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:policy :fast-safe)
+  (:generator 1
+    (inst not res x)))
+
 ;; Handle (ldb (byte 32 0) (- x)).  The (- x) gets converted to
 ;; (%negate x), so we build modular functions for %negate.
 
@@ -2436,19 +2446,47 @@
   (:generator 1
     (inst neg res x)))
 
+;; Define a bunch of vops for converting signed to unsigned.
+(macrolet
+    ((frob (op &optional trans)
+       (let ((name (symbolicate "FAST-" op "/SIGNED=>UNSIGNED"))
+	     (vop (symbolicate "FAST-" op "/SIGNED=>SIGNED"))
+	     (trans (symbolicate (or trans op) "-MOD32")))
+	 `(progn
+	    (defknown ,trans ((signed-byte 32) (signed-byte 32))
+	      (unsigned-byte 32)
+	      (movable foldable flushable))
+	    (define-vop (,name ,vop)
+	    (:translate ,trans)
+	    (:results (r :scs (unsigned-reg)))
+	    (:result-types unsigned-num))))))
+  (frob +)
+  (frob -)
+  (frob logxor)
+  (frob logeqv)
+  (frob logandc1)
+  (frob logandc2)
+  (frob logorc1)
+  (frob logorc2)
+  (frob v8-* *))
+
 (defmacro define-modular-backend (fun &optional constantp derived)
   (let ((mfun-name (symbolicate fun '-mod32))
 	(modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
 	(modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned))
 	(vop (symbolicate 'fast- (or derived fun) '/unsigned=>unsigned))
-	(cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned)))
+	(cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned))
+	(smodvop (symbolicate 'fast- (or derived fun) '-mod32/signed=>unsigned))
+	(svop (symbolicate 'fast- (or derived fun) '/signed=>unsigned)))
     `(progn
        (c::define-modular-fun ,mfun-name (x y) ,fun 32)
        (define-vop (,modvop ,vop)
 	 (:translate ,mfun-name))
        ,@(when constantp
 	       `((define-vop (,modcvop ,cvop)
-		   (:translate ,mfun-name)))))))
+		   (:translate ,mfun-name))))
+       (define-vop (,smodvop ,svop)
+	 (:translate ,mfun-name)))))
 
 (define-modular-backend + t)
 (define-modular-backend - t)
diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp
index 761effd36..81955fd9a 100644
--- a/compiler/x86/arith.lisp
+++ b/compiler/x86/arith.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.21 2008/08/16 01:51:56 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.22 2008/08/18 20:40:07 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1496,6 +1496,13 @@
     (move r x)
     (inst not r)))
 
+(define-vop (lognot-mod32/signed=>unsigned lognot-mod32/unsigned=>unsigned)
+  (:translate lognot-mod32)
+  (:args (x :scs (signed-reg signed-stack)
+	    :load-if (not (and (sc-is x signed-stack)
+			       (sc-is r unsigned-stack)))))
+  (:arg-types signed-num))
+
 ;; Handle (ldb (byte 32 0) (- x)).  The (- x) gets converted to
 ;; (%negate x), so we build modular functions for %negate.
 
@@ -1523,19 +1530,41 @@
     (move res x)
     (inst neg res)))
 
+(macrolet
+    ((frob (op)
+       (let ((name (symbolicate "FAST-" op "/SIGNED=>UNSIGNED"))
+	     (vop (symbolicate "FAST-" op "/SIGNED=>SIGNED"))
+	     (trans (symbolicate op "-MOD32")))
+	 `(progn
+	    (defknown ,trans ((signed-byte 32) (signed-byte 32))
+	      (unsigned-byte 32)
+	      (movable foldable flushable))
+	    (define-vop (,name ,vop)
+	    (:translate ,trans)
+	    (:results (r :scs (unsigned-reg)))
+	    (:result-types unsigned-num))))))
+  (frob +)
+  (frob -)
+  (frob logxor)
+  (frob *))
+
 (defmacro define-modular-backend (fun &optional constantp derived)
   (let ((mfun-name (symbolicate fun '-mod32))
 	(modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
 	(modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned))
 	(vop (symbolicate 'fast- (or derived fun) '/unsigned=>unsigned))
-	(cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned)))
+	(cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned))
+	(smodvop (symbolicate 'fast- (or derived fun) '-mod32/signed=>unsigned))
+	(svop (symbolicate 'fast- (or derived fun) '/signed=>unsigned)))
     `(progn
        (c::define-modular-fun ,mfun-name (x y) ,fun 32)
        (define-vop (,modvop ,vop)
 	 (:translate ,mfun-name))
        ,@(when constantp
 	       `((define-vop (,modcvop ,cvop)
-		     (:translate ,mfun-name)))))))
+		   (:translate ,mfun-name))))
+       (define-vop (,smodvop ,svop)
+	 (:translate ,mfun-name)))))
 
 (define-modular-backend + t)
 (define-modular-backend - t)
-- 
GitLab