From dddd16256212eabaa6fd151bf2cbb7ec1d206619 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 18 Aug 2008 20:40:07 +0000 Subject: [PATCH] compiler/sparc/arith.lisp: compiler/x86/arith.lisp: o Define some new vops to handle modular arithmetic stuff when both args are signed but the result is unsigned (because of modular arithmetic). --- compiler/sparc/arith.lisp | 44 ++++++++++++++++++++++++++++++++++++--- compiler/x86/arith.lisp | 35 ++++++++++++++++++++++++++++--- 2 files changed, 73 insertions(+), 6 deletions(-) diff --git a/compiler/sparc/arith.lisp b/compiler/sparc/arith.lisp index 6ea2f3190..ee75a8d1d 100644 --- a/compiler/sparc/arith.lisp +++ b/compiler/sparc/arith.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/sparc/arith.lisp,v 1.45 2008/08/12 21:00:17 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/arith.lisp,v 1.46 2008/08/18 20:40:02 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -2413,6 +2413,16 @@ (:generator 1 (inst not res x))) +(define-vop (lognot-mod32/signed=>unsigned) + (:translate lognot-mod32) + (:args (x :scs (signed-reg))) + (:arg-types signed-num) + (:results (res :scs (unsigned-reg))) + (:result-types unsigned-num) + (:policy :fast-safe) + (:generator 1 + (inst not res x))) + ;; Handle (ldb (byte 32 0) (- x)). The (- x) gets converted to ;; (%negate x), so we build modular functions for %negate. @@ -2436,19 +2446,47 @@ (:generator 1 (inst neg res x))) +;; Define a bunch of vops for converting signed to unsigned. +(macrolet + ((frob (op &optional trans) + (let ((name (symbolicate "FAST-" op "/SIGNED=>UNSIGNED")) + (vop (symbolicate "FAST-" op "/SIGNED=>SIGNED")) + (trans (symbolicate (or trans op) "-MOD32"))) + `(progn + (defknown ,trans ((signed-byte 32) (signed-byte 32)) + (unsigned-byte 32) + (movable foldable flushable)) + (define-vop (,name ,vop) + (:translate ,trans) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num)))))) + (frob +) + (frob -) + (frob logxor) + (frob logeqv) + (frob logandc1) + (frob logandc2) + (frob logorc1) + (frob logorc2) + (frob v8-* *)) + (defmacro define-modular-backend (fun &optional constantp derived) (let ((mfun-name (symbolicate fun '-mod32)) (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) (modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned)) (vop (symbolicate 'fast- (or derived fun) '/unsigned=>unsigned)) - (cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned))) + (cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned)) + (smodvop (symbolicate 'fast- (or derived fun) '-mod32/signed=>unsigned)) + (svop (symbolicate 'fast- (or derived fun) '/signed=>unsigned))) `(progn (c::define-modular-fun ,mfun-name (x y) ,fun 32) (define-vop (,modvop ,vop) (:translate ,mfun-name)) ,@(when constantp `((define-vop (,modcvop ,cvop) - (:translate ,mfun-name))))))) + (:translate ,mfun-name)))) + (define-vop (,smodvop ,svop) + (:translate ,mfun-name))))) (define-modular-backend + t) (define-modular-backend - t) diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp index 761effd36..81955fd9a 100644 --- a/compiler/x86/arith.lisp +++ b/compiler/x86/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.21 2008/08/16 01:51:56 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.22 2008/08/18 20:40:07 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -1496,6 +1496,13 @@ (move r x) (inst not r))) +(define-vop (lognot-mod32/signed=>unsigned lognot-mod32/unsigned=>unsigned) + (:translate lognot-mod32) + (:args (x :scs (signed-reg signed-stack) + :load-if (not (and (sc-is x signed-stack) + (sc-is r unsigned-stack))))) + (:arg-types signed-num)) + ;; Handle (ldb (byte 32 0) (- x)). The (- x) gets converted to ;; (%negate x), so we build modular functions for %negate. @@ -1523,19 +1530,41 @@ (move res x) (inst neg res))) +(macrolet + ((frob (op) + (let ((name (symbolicate "FAST-" op "/SIGNED=>UNSIGNED")) + (vop (symbolicate "FAST-" op "/SIGNED=>SIGNED")) + (trans (symbolicate op "-MOD32"))) + `(progn + (defknown ,trans ((signed-byte 32) (signed-byte 32)) + (unsigned-byte 32) + (movable foldable flushable)) + (define-vop (,name ,vop) + (:translate ,trans) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num)))))) + (frob +) + (frob -) + (frob logxor) + (frob *)) + (defmacro define-modular-backend (fun &optional constantp derived) (let ((mfun-name (symbolicate fun '-mod32)) (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) (modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned)) (vop (symbolicate 'fast- (or derived fun) '/unsigned=>unsigned)) - (cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned))) + (cvop (symbolicate 'fast- (or derived fun) '-c/unsigned=>unsigned)) + (smodvop (symbolicate 'fast- (or derived fun) '-mod32/signed=>unsigned)) + (svop (symbolicate 'fast- (or derived fun) '/signed=>unsigned))) `(progn (c::define-modular-fun ,mfun-name (x y) ,fun 32) (define-vop (,modvop ,vop) (:translate ,mfun-name)) ,@(when constantp `((define-vop (,modcvop ,cvop) - (:translate ,mfun-name))))))) + (:translate ,mfun-name)))) + (define-vop (,smodvop ,svop) + (:translate ,mfun-name))))) (define-modular-backend + t) (define-modular-backend - t) -- GitLab