X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Farith.lisp;h=cafd2a35aac429f80030f3b13c930dd2e40c59ed;hb=16a6592367eec7c5e9da668ec42fd260e7705b0c;hp=880be1f98ccf778110aacd24031db7f57b16eecb;hpb=ace140856e6b3f92bb06597092a59753f1e59142;p=sbcl.git diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index 880be1f..cafd2a3 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -295,6 +295,9 @@ ;; Count=0? Shouldn't happen, but it's easy: (move number result))))) +;;; FIXME: implement FAST-ASH-LEFT/UNSIGNED=>UNSIGNED and friends, for +;;; use in modular ASH (and because they're useful anyway). -- CSR, +;;; 2004-08-16 (define-vop (signed-byte-32-len) (:translate integer-length) @@ -577,12 +580,12 @@ ;;;; modular functions -(define-modular-fun +-mod32 (x y) + 32) +(define-modular-fun +-mod32 (x y) + :unsigned 32) (define-vop (fast-+-mod32/unsigned=>unsigned fast-+/unsigned=>unsigned) (:translate +-mod32)) (define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned) (:translate +-mod32)) -(define-modular-fun --mod32 (x y) - 32) +(define-modular-fun --mod32 (x y) - :unsigned 32) (define-vop (fast---mod32/unsigned=>unsigned fast--/unsigned=>unsigned) (:translate --mod32)) (define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned) @@ -591,8 +594,17 @@ (define-vop (fast-ash-left-mod32-c/unsigned=>unsigned fast-ash-c/unsigned=>unsigned) (:translate ash-left-mod32)) - -(define-modular-fun lognot-mod32 (x) lognot 32) +(define-vop (fast-ash-left-mod32/unsigned=>unsigned + ;; FIXME: when FAST-ASH-LEFT/UNSIGNED=>UNSIGNED is + ;; implemented, use it here. -- CSR, 2004-08-16 + fast-ash/unsigned=>unsigned)) +(deftransform ash-left-mod32 ((integer count) + ((unsigned-byte 32) (unsigned-byte 5))) + (when (sb!c::constant-lvar-p count) + (sb!c::give-up-ir1-transform)) + '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count)) + +(define-modular-fun lognot-mod32 (x) lognot :unsigned 32) (define-vop (lognot-mod32/unsigned=>unsigned) (:translate lognot-mod32) (:args (x :scs (unsigned-reg))) @@ -611,7 +623,7 @@ (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) (vop (symbolicate 'fast- fun '/unsigned=>unsigned))) `(progn - (define-modular-fun ,mfun-name (x y) ,fun 32) + (define-modular-fun ,mfun-name (x y) ,fun :unsigned 32) (define-vop (,modvop ,vop) (:translate ,mfun-name)))))) (define-modular-backend logxor) @@ -631,42 +643,6 @@ (define-source-transform lognor (x y) `(lognot (logior ,x y))) -;;;; 32-bit logical operations - -(define-source-transform word-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform word-logical-and ((x y)) - '(logand x y)) - -(define-source-transform word-logical-nand (x y) - `(word-logical-not (word-logical-and ,x ,y))) - -(deftransform word-logical-or ((x y)) - '(logior x y)) - -(define-source-transform word-logical-nor (x y) - `(logand (lognor (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) - #.(1- (ash 1 32)))) - -(deftransform word-logical-xor ((x y)) - '(logxor x y)) - -(define-source-transform word-logical-eqv (x y) - `(word-logical-not (word-logical-xor ,x ,y))) - -(define-source-transform word-logical-orc1 (x y) - `(word-logical-or (word-logical-not ,x) ,y)) - -(define-source-transform word-logical-orc2 (x y) - `(word-logical-or ,x (word-logical-not ,y))) - -(deftransform word-logical-andc1 (x y) - '(logandc1 x y)) - -(deftransform word-logical-andc2 (x y) - '(logandc2 x y)) - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg))