From 6924dbbb3672cdea6cc391b737d743753e9fb624 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 12 Sep 2003 16:53:39 +0000 Subject: [PATCH] 0.8.3.45.modular6: Implement 64-bit modular arithmetic for alpha. ... can't simplify BIGNUM-LOGNOT or 32BIT-LOGICAL-FOO here, because modular arithmetic is 64-bit, duh :-) ... it would be nice to compile (logand ... (1- (ash 1 32))) more efficiently than we currently do; currently we load up a 32-bit quantity into a register, followed by an and instruction; however, we should be able simply to do mskll reg, 4, reg. I think this works. Simple testing shows that it seems to work. But see also CSR sbcl-devel 2003-09-12, because there are a number of nasty surprises lurking in the depths of this backend. --- NEWS | 4 +- src/compiler/alpha/arith.lisp | 93 ++++++++++++++++++++++++++++++------- src/compiler/alpha/parms.lisp | 1 + src/compiler/generic/vm-tran.lisp | 2 +- version.lisp-expr | 2 +- 5 files changed, 82 insertions(+), 20 deletions(-) diff --git a/NEWS b/NEWS index 1a5dc69..9add302 100644 --- a/NEWS +++ b/NEWS @@ -2031,7 +2031,9 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: simple-base-strings and simple-bit-vectors is improved. * optimization: the optimization of 32-bit logical and arithmetic functions introduced in version 0.8.3 on the x86 has been - implemented on the mips, ppc and sparc platforms. + implemented on the mips, ppc and sparc platforms; an + implementation of the same facility, but for 64-bit arithmetic, + has been added for the alpha. * microoptimization: the compiler is better able to make use of the x86 LEA instruction for multiplication by constants. * bug fix: in some situations compiler did not report usage of diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index 1da0e8c..35d0b52 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -101,58 +101,77 @@ (:info y) (:arg-types tagged-num (:constant integer))) -(defmacro define-binop (translate cost untagged-cost op - tagged-type untagged-type) +(defmacro define-binop (translate cost untagged-cost op + tagged-type untagged-type + &optional arg-swap restore-fixnum-mask) `(progn (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM") fast-fixnum-binop) - (:args (x :target r :scs (any-reg)) - (y :target r :scs (any-reg))) + ,@(when restore-fixnum-mask + `((:temporary (:sc non-descriptor-reg) temp))) + (:args (x ,@(unless restore-fixnum-mask `(:target r)) :scs (any-reg)) + (y ,@(unless restore-fixnum-mask `(:target r)) :scs (any-reg))) (:translate ,translate) (:generator ,(1+ cost) - (inst ,op x y r))) + ,(if arg-swap + `(inst ,op y x ,(if restore-fixnum-mask 'temp 'r)) + `(inst ,op x y ,(if restore-fixnum-mask 'temp 'r))) + ,@(when restore-fixnum-mask + `((inst bic temp #.(ash lowtag-mask -1) r))))) (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED") fast-signed-binop) (:args (x :target r :scs (signed-reg)) (y :target r :scs (signed-reg))) (:translate ,translate) (:generator ,(1+ untagged-cost) - (inst ,op x y r))) + ,(if arg-swap + `(inst ,op y x r) + `(inst ,op x y r)))) (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED") fast-unsigned-binop) (:args (x :target r :scs (unsigned-reg)) (y :target r :scs (unsigned-reg))) (:translate ,translate) (:generator ,(1+ untagged-cost) - (inst ,op x y r))) - ,@(when tagged-type + ,(if arg-swap + `(inst ,op y x r) + `(inst ,op x y r)))) + ,@(when (and tagged-type (not arg-swap)) `((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM") fast-fixnum-c-binop) - (:arg-types tagged-num (:constant ,tagged-type)) + (:arg-types tagged-num (:constant ,tagged-type)) + ,@(when restore-fixnum-mask + `((:temporary (:sc non-descriptor-reg) temp))) (:translate ,translate) (:generator ,cost - (inst ,op x (fixnumize y) r))))) - ,@(when untagged-type + (inst ,op x (fixnumize y) ,(if restore-fixnum-mask 'temp 'r)) + ,@(when restore-fixnum-mask + `((inst bic temp #.(ash lowtag-mask -1) r))))))) + ,@(when (and untagged-type (not arg-swap)) `((define-vop (,(symbolicate "FAST-" translate "-C/SIGNED=>SIGNED") fast-signed-c-binop) - (:arg-types signed-num (:constant ,untagged-type)) + (:arg-types signed-num (:constant ,untagged-type)) (:translate ,translate) (:generator ,untagged-cost - (inst ,op x y r))) + (inst ,op x y r))) (define-vop (,(symbolicate "FAST-" translate "-C/UNSIGNED=>UNSIGNED") fast-unsigned-c-binop) - (:arg-types unsigned-num (:constant ,untagged-type)) + (:arg-types unsigned-num (:constant ,untagged-type)) (:translate ,translate) (:generator ,untagged-cost - (inst ,op x y r))))))) + (inst ,op x y r))))))) (define-binop + 1 5 addq (unsigned-byte 6) (unsigned-byte 8)) (define-binop - 1 5 subq (unsigned-byte 6) (unsigned-byte 8)) -(define-binop logior 1 3 bis (unsigned-byte 6) (unsigned-byte 8)) -(define-binop lognor 1 3 ornot (unsigned-byte 6) (unsigned-byte 8)) (define-binop logand 1 3 and (unsigned-byte 6) (unsigned-byte 8)) +(define-binop logandc1 1 3 bic (unsigned-byte 6) (unsigned-byte 8) t) +(define-binop logandc2 1 3 bic (unsigned-byte 6) (unsigned-byte 8)) +(define-binop logior 1 3 bis (unsigned-byte 6) (unsigned-byte 8)) +(define-binop logorc1 1 3 ornot (unsigned-byte 6) (unsigned-byte 8) t t) +(define-binop logorc2 1 3 ornot (unsigned-byte 6) (unsigned-byte 8) nil t) (define-binop logxor 1 3 xor (unsigned-byte 6) (unsigned-byte 8)) +(define-binop logeqv 1 3 eqv (unsigned-byte 6) (unsigned-byte 8) nil t) ;;;; shifting @@ -284,6 +303,45 @@ (:generator 3 (inst mulq x y r))) +;;;; Modular functions: +(define-modular-fun lognot-mod64 (x) lognot 64) +(define-vop (lognot-mod64/unsigned=>unsigned) + (:translate lognot-mod64) + (:args (x :scs (unsigned-reg))) + (:arg-types unsigned-num) + (:results (res :scs (unsigned-reg))) + (:result-types unsigned-num) + (:policy :fast-safe) + (:generator 1 + (inst not x res))) + +(macrolet + ((define-modular-backend (fun &optional constantp) + (let ((mfun-name (symbolicate fun '-mod64)) + (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned)) + (modcvop (symbolicate 'fast- fun 'mod64-c/unsigned=>unsigned)) + (vop (symbolicate 'fast- fun '/unsigned=>unsigned)) + (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned))) + `(progn + (define-modular-fun ,mfun-name (x y) ,fun 64) + (define-vop (,modvop ,vop) + (:translate ,mfun-name)) + ,@(when constantp + `((define-vop (,modcvop ,cvop) + (:translate ,mfun-name)))))))) + (define-modular-backend + t) + (define-modular-backend logxor t) + (define-modular-backend logeqv t) + (define-modular-backend logandc1) + (define-modular-backend logandc2 t) + (define-modular-backend logorc1) + (define-modular-backend logorc2 t)) + +(define-source-transform lognand (x y) + `(lognot (logand ,x ,y))) +(define-source-transform lognor (x y) + `(lognot (logior ,x ,y))) + ;;;; binary conditional VOPs (define-vop (fast-conditional) @@ -776,3 +834,4 @@ (define-static-fun two-arg-and (x y) :translate logand) (define-static-fun two-arg-ior (x y) :translate logior) (define-static-fun two-arg-xor (x y) :translate logxor) +(define-static-fun two-arg-eqv (x y) :translate logeqv) diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 1b2326b..b13e2de 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -234,5 +234,6 @@ sb!kernel:two-arg-and sb!kernel:two-arg-ior sb!kernel:two-arg-xor + sb!kernel:two-arg-eqv sb!kernel:two-arg-gcd sb!kernel:two-arg-lcm)) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 5ac2bea..82627cf 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -440,7 +440,7 @@ ;;;; 32-bit operations -#!-(or ppc sparc x86 mips) ; on X86 it is a modular function +#!-(or ppc sparc x86 mips alpha) ; on X86 it is a modular function (deftransform lognot ((x) ((unsigned-byte 32)) * :node node :result result) diff --git a/version.lisp-expr b/version.lisp-expr index 24d81c5..1c40ac4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.3.45.modular5" +"0.8.3.45.modular6" -- 1.7.10.4