diff --git a/assembly/sparc/arith.lisp b/assembly/sparc/arith.lisp index 8b297d86d5bf16d0780f1f516972771a2dd6df3f..94d4214c1863cbd724681e8a06d72207c7ff366c 100644 --- a/assembly/sparc/arith.lisp +++ b/assembly/sparc/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/arith.lisp,v 1.2 1990/11/24 19:20:44 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/arith.lisp,v 1.3 1990/11/30 10:16:07 wlott Exp $ ;;; ;;; Stuff to handle simple cases for generic arithmetic. ;;; @@ -117,6 +117,7 @@ ;;;; Multiplication + (define-assembly-routine (generic-* (:cost 50) (:return-style :full-call) @@ -145,15 +146,27 @@ ;; Remove the tag from one arg so that the result will have the correct ;; fixnum tag. (inst sra temp x 2) - (emit-multiply temp y hi res :signed) + (inst wry temp) + (inst andcc hi zero-tn) + (inst nop) + (inst nop) + (dotimes (i 32) + (inst mulscc hi y)) + (inst mulscc hi zero-tn) + (inst cmp x) + (inst b :ge MULTIPLIER-POSITIVE) + (inst nop) + (inst sub hi y) + MULTIPLIER-POSITIVE + (inst rdy lo) + ;; Check to see if the result will fit in a fixnum. (I.e. the high word ;; is just 32 copies of the sign bit of the low word). - (inst sra temp res 31) + (inst sra temp lo 31) (inst xorcc temp hi) - (inst b :eq DONE) - ;; Shift the double word hi:res down two bits into hi:low to get rid of the - ;; fixnum tag. - (inst srl lo res 2) + (inst b :eq LOW-FITS-IN-FIXNUM) + ;; Shift the double word hi:lo down two bits to get rid of the fixnum tag. + (inst srl lo 2) (inst sll temp hi 30) (inst or lo temp) (inst sra hi 2) @@ -189,7 +202,8 @@ vm:function-pointer-type)) (inst move cfp-tn csp-tn) - DONE) + LOW-FITS-IN-FIXNUM + (move res lo)) (macrolet ((frob (name note cost type sc) @@ -206,7 +220,14 @@ (:temp temp ,sc nl2-offset)) ,@(when (eq type 'tagged-num) `((inst sra x 2))) - (emit-multiply x y temp res :unsigned)))) + (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))