From b8cd5a1d351e923900241bb906e77ad3b7486757 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Mon, 5 Mar 1990 20:43:43 +0000
Subject: [PATCH] Added VOPs for fixnum=>t in addition to fixnum=>fixnum that
 use overflow trapping instructions.

Added fast-*-fixnum=>fixnum and fast-truncate-fixnum VOP.
---
 compiler/mips/arith.lisp | 135 ++++++++++++++++++++++++++++-----------
 1 file changed, 98 insertions(+), 37 deletions(-)

diff --git a/compiler/mips/arith.lisp b/compiler/mips/arith.lisp
index 883380796..2d0038a99 100644
--- a/compiler/mips/arith.lisp
+++ b/compiler/mips/arith.lisp
@@ -47,11 +47,35 @@
 
 ;;; Assume that any constant operand is the second arg...
 
-(defmacro define-fixnum-binop (name inherits translate op
-				    &key unsigned immed-op function)
-  `(define-vop (,name ,inherits)
+(define-vop (fast-binop)
+  (:args (x :target r
+	    :scs (any-reg descriptor-reg))
+	 (y :target r
+	    :scs (any-reg descriptor-reg)))
+  (:arg-types fixnum fixnum)
+  (:results (r :scs (any-reg descriptor-reg)))
+  (:effects)
+  (:affected)
+  (:note "inline fixnum arithmetic")
+  (:policy :fast-safe))
+
+(defmacro define-fixnum-binop ((name translate cost result-type)
+			       op
+			       &key unsigned immed-op function)
+  `(define-vop (,name fast-binop)
+     (:args (x :target r
+	       :scs (any-reg descriptor-reg))
+	    (y :target r
+	       :scs (any-reg descriptor-reg
+			     ,@(when immed-op
+				 (list (if unsigned
+					   'unsigned-immediate
+					   'negative-immediate)
+				       'immediate
+				       'zero)))))
      (:translate ,translate)
-     (:generator 1
+     (:result-types ,result-type)
+     (:generator ,cost
        (sc-case y
 	 ((any-reg descriptor-reg)
 	  (inst ,op r x y))
@@ -65,48 +89,85 @@
 				   `(,function (tn-value y))
 				   '(tn-value y)))))))))))
 
-;;;; Arithmetic:
+;;; Plus and minus.
 
-(define-vop (fast-binop/fixnum)
-  (:args (x :target r
-	    :scs (any-reg descriptor-reg))
-	 (y :target r
-	    :scs (any-reg descriptor-reg negative-immediate immediate zero)))
-  (:results (r :scs (any-reg descriptor-reg)))
-  (:arg-types fixnum fixnum)
-  (:result-types fixnum)
-  (:effects)
-  (:affected)
-  (:note "inline fixnum arithmetic")
-  (:policy :fast-safe))
+(define-fixnum-binop (fast-+/fixnum=>fixnum + 1 fixnum)
+		     addu :immed-op addiu))
+(define-fixnum-binop (fast-+/fixnum + 2 t)
+		     add :immed-op addi)
 
-(define-fixnum-binop fast-+/fixnum fast-binop/fixnum + add
-  :immed-op addi)
+(define-fixnum-binop (fast--/fixnum=>fixnum - 1 fixnum)
+		     subu :immed-op addiu :function -)
+(define-fixnum-binop (fast--/fixnum - 2 t)
+		     sub :immed-op addi :function -)
 
-(define-fixnum-binop fast--/fixnum fast-binop/fixnum - sub
-  :immed-op addi :function -)
 
+;;; Logical operatons.
 
-;;;; Logic operations:
+(define-fixnum-binop (fast-logior/fixnum logior 1 t)
+		     or :immed-op ori :unsigned t)
 
-;;; Like fast-binop/fixnum, except the immediate operand is unsigned, and
-;;; a fixnum result assertion isn't needed.
-;;;
-(define-vop (fast-logic-binop/fixnum fast-binop/fixnum)
-  (:args (x :target r
-	    :scs (any-reg descriptor-reg))
-	 (y :target r
-	    :scs (any-reg descriptor-reg immediate unsigned-immediate zero)))
-  (:result-types t))
+(define-fixnum-binop (fast-logand/fixnum logand 1 t)
+		     and :immed-op andi :unsigned t)
 
-(define-fixnum-binop fast-logior/fixnum fast-logic-binop/fixnum logior or
-  :immed-op ori :unsigned t)
+(define-fixnum-binop (fast-logxor/fixnum logxor 1 t)
+		     xor :immed-op xori :unsigned t)
 
-(define-fixnum-binop fast-logand/fixnum fast-logic-binop/fixnum logand and
-  :immed-op andi :unsigned t)
 
-(define-fixnum-binop fast-logxor/fixnum fast-logic-binop/fixnum logxor xor
-  :immed-op xori :unsigned t)
+;;; Multiply and Divide.
+
+(define-vop (fast-*/fixnum=>fixnum fast-binop)
+  (:temporary (:scs (non-descriptor-reg) :type random) temp)
+  (:result-types fixnum)
+  (:translate *)
+  (:generator 4
+    (inst sra temp y 2)
+    (inst mult x temp)
+    (inst mflo r)))
+
+(define-vop (fast-*/fixnum fast-binop)
+  (:temporary (:scs (non-descriptor-reg) :type random) temp)
+  (:translate *)
+  (:generator 4
+    (let ((fixnum (gen-label)))
+      (inst sra temp y 2)
+      (inst mult x temp)
+      (inst mfhi temp)
+      (inst beq temp zero-tn fixnum)
+      (inst mflo r)
+      ;; ### Need to make a bignum out of the high and low regs.
+
+      (emit-label fixnum))))
+
+(define-vop (fast-truncate/fixnum fast-binop)
+  (:translate truncate)
+  (:temporary (:scs (non-descriptor-reg) :type random) t1 t2)
+  (:results (q :scs (any-reg descriptor-reg))
+	    (r :scs (any-reg descriptor-reg)))
+  (:node-var node)
+  (:generator 5
+    (let ((zero (generate-error-code node di:division-by-zero-error x y)))
+      (inst beq y zero-tn zero))
+    (inst sra t1 x 2)
+    (inst sra t2 y 2)
+    (inst div t1 t2)
+    (inst mflo t1)
+    (inst sll q t1 2)
+    (inst mfhi t1)
+    (inst sll r t1 2)))
+
+(define-vop (fast-rem/fixnum fast-binop)
+  (:temporary (:scs (non-descriptor-reg) :type random) t1 t2)
+  (:translate rem)
+  (:generator 4
+    (let ((zero (generate-error-code di:division-by-zero-error x y)))
+      (inst beq y zero-tn zero))
+    (inst sra t1 x 2)
+    (inst sra t2 y 2)
+    (inst div t1 t2)
+    (inst mfhi t1)
+    (inst sll r t1 2)))
+
 
 
 
-- 
GitLab