diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index d49465b5ffe7e4e773bbf5bdb0dd6fb174661e44..d95aa7e3b855dfb452b67f1337e3b32052c86fa8 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.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/generic/vm-tran.lisp,v 1.58 2005/01/29 22:39:03 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.59 2006/12/24 01:41:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -29,9 +29,17 @@ (def-source-transform char-int (x) `(char-code ,x)) +#-(or sparc ppc) (deftransform abs ((x) (rational)) '(if (< x 0) (- x) x)) +#+(or sparc ppc) +(deftransform abs ((x) (rational)) + (let ((x-type (continuation-type x))) + (if (csubtypep x-type (specifier-type '(signed-byte #.vm:word-bits))) + (give-up) + '(if (< x 0) (- x) x)))) + ;;; For now, the layout is stored in slot 0. ;;; (def-source-transform %instance-layout (x) diff --git a/compiler/ppc/arith.lisp b/compiler/ppc/arith.lisp index 67ede5df571d0105039522c281eb1801b88bcf22..df9d03fb962f0565009939037186b606c07c9126 100644 --- a/compiler/ppc/arith.lisp +++ b/compiler/ppc/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/arith.lisp,v 1.12 2006/11/30 02:56:17 rtoy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/arith.lisp,v 1.13 2006/12/24 01:41:36 rtoy Exp $ ;;; ;;; This file contains the VM definition arithmetic VOPs for the MIPS. ;;; @@ -266,6 +266,21 @@ ((typep y '(unsigned-byte 15)) (inst andi. r x y))))) +(define-vop (fast-abs/signed fast-safe-arith-op) + (:args (x :scs (signed-reg))) + (:arg-types signed-num) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:translate abs) + (:note "inline 32-bit abs") + (:temporary (:scs (signed-reg)) y) + (:generator 1 + ;; From Hacker's Delight + ;; + ;; abs(x) = (x ^ y) - y, where y = x >> 31 (signed shift) + (inst srawi y x (1- vm:word-bits)) + (inst xor r y x) + (inst sub r r y))) ;;; Special case fixnum + and - that trap on overflow. Useful when we ;;; don't know that the output type is a fixnum.