[cmucl-commit] [git] CMU Common Lisp branch master updated. 20e-2-g40aa247

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  40aa2475c25a2715e100bbde7ba7db437a8a4326 (commit)
      from  a7ace14123e6cbe17f041142328593287cdf6586 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 40aa2475c25a2715e100bbde7ba7db437a8a4326
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Thu Oct 17 20:32:52 2013 -0700

    Delete assembly routines for multiplication and truncation. I think
    these were needed for sparc v7 and earlier which didn't have a
    multiply or divide instruction (multiply step, and divide step).  We
    don't support v7 anymore so the existing vops for multiplication and
    division work just fine.

diff --git a/src/assembly/sparc/arith.lisp b/src/assembly/sparc/arith.lisp
index 2ebb72f..a49b1c1 100644
--- a/src/assembly/sparc/arith.lisp
+++ b/src/assembly/sparc/arith.lisp
@@ -210,192 +210,6 @@
   LOW-FITS-IN-FIXNUM
   (move res lo))
 
-(macrolet
-    ((frob (name note cost type sc)
-       `(define-assembly-routine (,name
-				  (:note ,note)
-				  (:cost ,cost)
-				  (:translate *)
-				  (:policy :fast-safe)
-				  (:arg-types ,type ,type)
-				  (:result-types ,type))
-				 ((:arg x ,sc nl0-offset)
-				  (:arg y ,sc nl1-offset)
-				  (:res res ,sc nl0-offset)
-				  (:temp temp ,sc nl2-offset))
-	  ,@(when (eq type 'tagged-num)
-	      `((inst sra x 2)))
-	 (cond ((backend-featurep :sparc-64)
-		;; Sign extend, then multiply
-		(inst sra x 0)
-		(inst sra y 0)
-		(inst mulx res x y))
-	       ((or (backend-featurep :sparc-v8)
-		    (backend-featurep :sparc-v9))
-		(inst smul res x y))
-	       (t
-		(inst wry x)
-		(inst andcc temp zero-tn)
-		(inst nop)
-		(inst nop)
-		(dotimes (i 32)
-		  (inst mulscc temp y))
-		(inst mulscc temp zero-tn)
-		(inst rdy res))))))
-  (frob unsigned-* "unsigned *" 40 unsigned-num unsigned-reg)
-  (frob signed-* "unsigned *" 41 signed-num signed-reg)
-  (frob fixnum-* "fixnum *" 30 tagged-num any-reg))
-
-
-
-;;;; Division.
-
-#+assembler
-(defun emit-divide-loop (divisor rem quo tagged)
-  (inst li quo 0)
-  (labels
-      ((do-loop (depth)
-	 (cond
-	  ((zerop depth)
-	   (inst unimp 0))
-	  (t
-	   (let ((label-1 (gen-label))
-		 (label-2 (gen-label)))
-	     (inst cmp divisor rem)
-	     (inst b :geu label-1)
-	     (inst nop)
-	     (inst sll divisor 1)
-	     (do-loop (1- depth))
-	     (inst srl divisor 1)
-	     (inst cmp divisor rem)
-	     (emit-label label-1)
-	     (inst b :gtu label-2)
-	     (inst sll quo 1)
-	     (inst add quo (if tagged (fixnumize 1) 1))
-	     (inst sub rem divisor)
-	     (emit-label label-2))))))
-    (do-loop (if tagged 30 32))))
-
-(define-assembly-routine (positive-fixnum-truncate
-			  (:note "unsigned fixnum truncate")
-			  (:cost 45)
-			  (:translate truncate)
-			  (:policy :fast-safe)
-			  (:arg-types positive-fixnum positive-fixnum)
-			  (:result-types positive-fixnum positive-fixnum))
-			 ((:arg dividend any-reg nl0-offset)
-			  (:arg divisor any-reg nl1-offset)
-
-			  (:res quo any-reg nl2-offset)
-			  (:res rem any-reg nl0-offset))
-
-  (let ((error (generate-error-code nil division-by-zero-error
-				    dividend divisor)))
-    (inst cmp divisor)
-    (inst b :eq error))
-
-  (move rem dividend)
-  (emit-divide-loop divisor rem quo t))
-
-
-(define-assembly-routine (fixnum-truncate
-			  (:note "fixnum truncate")
-			  (:cost 50)
-			  (:policy :fast-safe)
-			  (:translate truncate)
-			  (:arg-types tagged-num tagged-num)
-			  (:result-types tagged-num tagged-num))
-			 ((:arg dividend any-reg nl0-offset)
-			  (:arg divisor any-reg nl1-offset)
-
-			  (:res quo any-reg nl2-offset)
-			  (:res rem any-reg nl0-offset)
-
-			  (:temp quo-sign any-reg nl5-offset)
-			  (:temp rem-sign any-reg nargs-offset))
-  
-  (let ((error (generate-error-code nil division-by-zero-error
-				    dividend divisor)))
-    (inst cmp divisor)
-    (inst b :eq error))
-
-  (inst xor quo-sign dividend divisor)
-  (inst move rem-sign dividend)
-  (let ((label (gen-label)))
-    (inst cmp dividend)
-    (inst ba :lt label)
-    (inst neg dividend)
-    (emit-label label))
-  (let ((label (gen-label)))
-    (inst cmp divisor)
-    (inst ba :lt label)
-    (inst neg divisor)
-    (emit-label label))
-  (move rem dividend)
-  (emit-divide-loop divisor rem quo t)
-  (let ((label (gen-label)))
-    ;; If the quo-sign is negative, we need to negate quo.
-    (inst cmp quo-sign)
-    (inst ba :lt label)
-    (inst neg quo)
-    (emit-label label))
-  (let ((label (gen-label)))
-    ;; If the rem-sign is negative, we need to negate rem.
-    (inst cmp rem-sign)
-    (inst ba :lt label)
-    (inst neg rem)
-    (emit-label label)))
-
-
-(define-assembly-routine (signed-truncate
-			  (:note "(signed-byte 32) truncate")
-			  (:cost 60)
-			  (:policy :fast-safe)
-			  (:translate truncate)
-			  (:arg-types signed-num signed-num)
-			  (:result-types signed-num signed-num))
-
-			 ((:arg dividend signed-reg nl0-offset)
-			  (:arg divisor signed-reg nl1-offset)
-
-			  (:res quo signed-reg nl2-offset)
-			  (:res rem signed-reg nl0-offset)
-
-			  (:temp quo-sign signed-reg nl5-offset)
-			  (:temp rem-sign signed-reg nargs-offset))
-  
-  (let ((error (generate-error-code nil division-by-zero-error
-				    dividend divisor)))
-    (inst cmp divisor)
-    (inst b :eq error))
-
-  (inst xor quo-sign dividend divisor)
-  (inst move rem-sign dividend)
-  (let ((label (gen-label)))
-    (inst cmp dividend)
-    (inst ba :lt label)
-    (inst neg dividend)
-    (emit-label label))
-  (let ((label (gen-label)))
-    (inst cmp divisor)
-    (inst ba :lt label)
-    (inst neg divisor)
-    (emit-label label))
-  (move rem dividend)
-  (emit-divide-loop divisor rem quo nil)
-  (let ((label (gen-label)))
-    ;; If the quo-sign is negative, we need to negate quo.
-    (inst cmp quo-sign)
-    (inst ba :lt label)
-    (inst neg quo)
-    (emit-label label))
-  (let ((label (gen-label)))
-    ;; If the rem-sign is negative, we need to negate rem.
-    (inst cmp rem-sign)
-    (inst ba :lt label)
-    (inst neg rem)
-    (emit-label label)))
-
 
 ;;;; Comparison
 

-----------------------------------------------------------------------

Summary of changes:
 src/assembly/sparc/arith.lisp |  186 -----------------------------------------
 1 file changed, 186 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp