From 0551e893c099b4c8a9ebcf8d10974d34595332c1 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 9 Apr 1991 17:39:51 +0000
Subject: [PATCH] Offer VOPs for the 32bit-logical ops that are supported the
 instruction set, and deftransform the rest.  Added VOPs for
 shift-towards-{start,end}.

---
 compiler/sparc/arith.lisp | 68 +++++++++++++++++++++++++++++++++------
 1 file changed, 59 insertions(+), 9 deletions(-)

diff --git a/compiler/sparc/arith.lisp b/compiler/sparc/arith.lisp
index 3d3696507..e75d2876f 100644
--- a/compiler/sparc/arith.lisp
+++ b/compiler/sparc/arith.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.5 1990/12/16 14:17:53 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.6 1991/04/09 17:39:51 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition arithmetic VOPs for the MIPS.
 ;;;
@@ -170,31 +170,35 @@
 ;;; Special case fixnum + and - that trap on overflow.  Useful when we
 ;;; don't know that the output type is a fixnum.
 
-(define-vop (fast-+/fixnum fast-+/fixnum=>fixnum)
+(define-vop (+/fixnum fast-+/fixnum=>fixnum)
+  (:policy :safe)
   (:results (r :scs (any-reg descriptor-reg)))
   (:result-types *)
-  (:note nil)
+  (:note "safe inline fixnum arithmetic")
   (:generator 4
     (inst taddcctv r x y)))
 
-(define-vop (fast-+-c/fixnum fast-+-c/fixnum=>fixnum)
+(define-vop (+-c/fixnum fast-+-c/fixnum=>fixnum)
+  (:policy :safe)
   (:results (r :scs (any-reg descriptor-reg)))
   (:result-types *)
-  (:note nil)
+  (:note "safe inline fixnum arithmetic")
   (:generator 3
     (inst taddcctv r x (fixnum y))))
 
-(define-vop (fast--/fixnum fast--/fixnum=>fixnum)
+(define-vop (-/fixnum fast--/fixnum=>fixnum)
+  (:policy :safe)
   (:results (r :scs (any-reg descriptor-reg)))
   (:result-types *)
-  (:note nil)
+  (:note "safe inline fixnum arithmetic")
   (:generator 4
     (inst tsubcctv r x y)))
 
-(define-vop (fast---c/fixnum fast---c/fixnum=>fixnum)
+(define-vop (--c/fixnum fast---c/fixnum=>fixnum)
+  (:policy :safe)
   (:results (r :scs (any-reg descriptor-reg)))
   (:result-types *)
-  (:note nil)
+  (:note "safe inline fixnum arithmetic")
   (:generator 3
     (inst tsubcctv r x (fixnum y))))
 
@@ -448,16 +452,62 @@
   (:generator 1
     (inst and r x y)))
 
+(deftransform 32bit-logical-nand ((x y) (* *))
+  '(32bit-logical-not (32bit-logical-and x y)))
+
 (define-vop (32bit-logical-or 32bit-logical)
   (:translate 32bit-logical-or)
   (:generator 1
     (inst or r x y)))
 
+(deftransform 32bit-logical-nor ((x y) (* *))
+  '(32bit-logical-not (32bit-logical-or x y)))
+
 (define-vop (32bit-logical-xor 32bit-logical)
   (:translate 32bit-logical-xor)
   (:generator 1
     (inst xor r x y)))
 
+(define-vop (32bit-logical-eqv 32bit-logical)
+  (:translate 32bit-logical-eqv)
+  (:generator 1
+    (inst xnor r x y)))
+
+(define-vop (32bit-logical-orc2 32bit-logical)
+  (:translate 32bit-logical-orc2)
+  (:generator 1
+    (inst orn r x y)))
+
+(deftransform 32bit-logical-orc1 ((x y) (* *))
+  '(32bit-logical-orc2 y x))
+
+(define-vop (32bit-logical-andc2 32bit-logical)
+  (:translate 32bit-logical-andc2)
+  (:generator 1
+    (inst andn r x y)))
+
+(deftransform 32bit-logical-andc1 ((x y) (* *))
+  '(32bit-logical-andc2 y x))
+
+
+(define-vop (shift-towards-someplace)
+  (:policy :fast-safe)
+  (:args (num :scs (unsigned-reg))
+	 (amount :scs (signed-reg)))
+  (:arg-types unsigned-num fixnum)
+  (:results (r :scs (unsigned-reg)))
+  (:result-types unsigned-num))
+
+(define-vop (shift-towards-start shift-towards-someplace)
+  (:translate shift-towards-start)
+  (:generator 1
+    (inst sll r num amount)))
+
+(define-vop (shift-towards-end shift-towards-someplace)
+  (:translate shift-towards-end)
+  (:generator 1
+    (inst srl r num amount)))
+
 
 
 
-- 
GitLab