Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/code cross-modular.lisp, 1.1, 1.2 numbers.lisp, 1.49, 1.50
|
From: Christophe R. <cr...@us...> - 2008-03-07 12:27:21
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv19916/src/code Modified Files: cross-modular.lisp numbers.lisp Log Message: 1.0.15.16: New modular arithmetic representation decision Prefers any exactly-matching modular implementation, then tagged if possible, then untagged. Should make code of the form (logand xxx most-positive-fixnum) more tolerable. Also includes better lognot/fixnum implementation on all platforms. Squashed commit of the following: commit 81776d9aab531db20711320ecea920453e058cef Author: Christophe Rhodes <cs...@ca...> Date: Fri Mar 7 04:54:03 2008 -0700 Fix lognot for fixnums on alpha. commit 27ce80579851bf9227d7d1121cf1554dc383049d Author: SBCL devs <sbc...@al...> Date: Thu Mar 6 15:02:03 2008 -0700 New modular arithmetic ported to alpha (as yet untested beyond make-genesis-2: lognot/fixnum is buggy) commit d6ae6339374983ae874d85f3c52103c77ccad222 Author: Christophe Rhodes <csr21@localhost.localdomain> Date: Fri Jan 11 17:38:19 2008 +0000 New modular arithmetic ported to mips. Tested by Thiemo Seufer. commit 50e2e51d25bb3d3997e4b884b7a15f7ba1992391 Author: Christophe Rhodes <csr21@localhost.localdomain> Date: Fri Jan 11 17:37:41 2008 +0000 Make find-modular-class get signed and unsigned the right way round. As it happened, this all worked by accident anyway, because the only other user of the *foo-modular-class* specials didn't rely on the separation between the classes, but instead used other data. Hmm... (Noticed by Nikodemus Siivola) commit d3de3d27b212999672644d8a4fccfce9676dbf4f Author: Christophe Rhodes <cs...@ze...> Date: Tue Jan 1 14:25:33 2008 +0000 New modular arithmetic ported to sparc. As with ppc, the signed modular arithmetic is not terribly useful, as only good functions have been implemented (so no +, -, * and ash) commit e99c204ab165139f4c8f8aacb59d4a825b90b7d1 Author: Christophe Rhodes <ma...@gi...> Date: Mon Dec 31 18:15:41 2007 +0000 Fix for fixnum LOGNOT on PPC Use subfic res, x, -4 rather than xori res, x, -4 -- xori's immediate argument is not sign-extended. (Thanks to Andy Hefner for the idea to use subfic rather than xori+xoris) commit db8ffb719750c8bc655519b03c2081cc3b8d0b2e Author: Christophe Rhodes <ma...@gi...> Date: Mon Dec 31 18:13:21 2007 +0000 New modular arithmetic ported to ppc. Simple modifications only. It remains for someone to add signed modular definitions of +, -, * and so on for this to become useful on ppc. commit 5c7562fc1e2a96a81d9bc32fb77ad70ed1794e6e Author: Christophe Rhodes <cr...@gi...> Date: Mon Dec 31 10:12:26 2007 +0000 New modular arithmetic choice for x86-64 Simply adapt x86-64/arith.lisp by * removing logxor implementation (as it's now :good) * adapting %LEA implementation commit 39054fae6e5a2e55856a506ad497978adcbbd6c2 Author: Christophe Rhodes <csr21@omega.localdomain> Date: Sun Dec 30 21:50:16 2007 +0000 Better fixnum LOGNOT implementations. Apparently inherited from cmucl, our fixnum and signed LOGNOT VOPs had generator costs that preferred the signed representation over the tagged. Fix this (on all backends; tested only on x86) commit 6eee19de7a49762ea2f3bbfe89d9ea1b0dcee47f Author: Christophe Rhodes <csr21@omega.localdomain> Date: Sun Dec 30 21:29:39 2007 +0000 Better signed modular arithmetic. All the LOGFOO functions are :good modular functions for signed modular arithmetic. LOGXOR is a :good modular function for untagged unsigned modular arithmetic. commit 32961ecb51bcfea655f985d1f774a8fc46bd155b Author: Christophe Rhodes <csr21@omega.localdomain> Date: Sun Dec 30 19:30:57 2007 +0000 Split untagged modular class into unsigned and signed variants. FIND-MODULAR-VERSION now takes both KIND and SIGNEDP arguments. commit e3b88693c3721cd84d9fb4a01d624d450c120cdd Author: Christophe Rhodes <csr21@omega.localdomain> Date: Sun Dec 30 17:58:49 2007 +0000 Choice of modular version, initial commit Commit of approximately September vintage work, x86-only. Index: cross-modular.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/cross-modular.lisp,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- cross-modular.lisp 9 Apr 2005 06:37:04 -0000 1.1 +++ cross-modular.lisp 7 Mar 2008 12:26:41 -0000 1.2 @@ -22,30 +22,27 @@ #. (collect ((forms)) - (flet ((definition (name lambda-list prototype width) + (flet ((unsigned-definition (name lambda-list prototype width) `(defun ,name ,lambda-list - (ldb (byte ,width 0) (,prototype ,@lambda-list))))) - (loop for infos being each hash-value of (modular-class-funs *unsigned-modular-class*) using (hash-key prototype) - when (listp infos) - do (loop for info in infos - for name = (modular-fun-info-name info) - and width = (modular-fun-info-width info) - and lambda-list = (modular-fun-info-lambda-list info) - do (forms (definition name lambda-list prototype width))))) - `(progn ,@(forms))) - -#. -(collect ((forms)) - (flet ((definition (name lambda-list prototype width) + (ldb (byte ,width 0) (,prototype ,@lambda-list)))) + (signed-definition (name lambda-list prototype width) `(defun ,name ,lambda-list (mask-signed-field ,width (,prototype ,@lambda-list))))) - (loop for infos being each hash-value of (modular-class-funs *signed-modular-class*) using (hash-key prototype) - when (listp infos) - do (loop for info in infos - for name = (modular-fun-info-name info) - and width = (modular-fun-info-width info) - and lambda-list = (modular-fun-info-lambda-list info) - do (forms (definition name lambda-list prototype width))))) + (flet ((do-mfuns (class) + (loop for infos being each hash-value of (modular-class-funs class) using (hash-key prototype) + when (listp infos) + do (loop for info in infos + for name = (modular-fun-info-name info) + and width = (modular-fun-info-width info) + and signedp = (modular-fun-info-signedp info) + and lambda-list = (modular-fun-info-lambda-list info) + if signedp + do (forms (signed-definition name lambda-list prototype width)) + else + do (forms (unsigned-definition name lambda-list prototype width)))))) + (do-mfuns *untagged-unsigned-modular-class*) + (do-mfuns *untagged-signed-modular-class*) + (do-mfuns *tagged-modular-class*))) `(progn ,@(forms))) #!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 32) '(and) '(or)) Index: numbers.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v retrieving revision 1.49 retrieving revision 1.50 diff -u -d -r1.49 -r1.50 --- numbers.lisp 21 Aug 2007 05:12:33 -0000 1.49 +++ numbers.lisp 7 Mar 2008 12:26:41 -0000 1.50 @@ -1425,30 +1425,18 @@ ;;;; modular functions #. (collect ((forms)) - (flet ((definition (name lambda-list width pattern) - `(defun ,name ,lambda-list - (flet ((prepare-argument (x) - (declare (integer x)) - (etypecase x - ((unsigned-byte ,width) x) - (fixnum (logand x ,pattern)) - (bignum (logand x ,pattern))))) - (,name ,@(loop for arg in lambda-list - collect `(prepare-argument ,arg))))))) - (loop for infos being each hash-value of (sb!c::modular-class-funs sb!c::*unsigned-modular-class*) - ;; FIXME: We need to process only "toplevel" functions - when (listp infos) - do (loop for info in infos - for name = (sb!c::modular-fun-info-name info) - and width = (sb!c::modular-fun-info-width info) - and lambda-list = (sb!c::modular-fun-info-lambda-list info) - for pattern = (1- (ash 1 width)) - do (forms (definition name lambda-list width pattern))))) - `(progn ,@(forms))) - -#. -(collect ((forms)) - (flet ((definition (name lambda-list width) + (flet ((unsigned-definition (name lambda-list width) + (let ((pattern (1- (ash 1 width)))) + `(defun ,name ,lambda-list + (flet ((prepare-argument (x) + (declare (integer x)) + (etypecase x + ((unsigned-byte ,width) x) + (fixnum (logand x ,pattern)) + (bignum (logand x ,pattern))))) + (,name ,@(loop for arg in lambda-list + collect `(prepare-argument ,arg))))))) + (signed-definition (name lambda-list width) `(defun ,name ,lambda-list (flet ((prepare-argument (x) (declare (integer x)) @@ -1458,14 +1446,22 @@ (bignum (sb!c::mask-signed-field ,width x))))) (,name ,@(loop for arg in lambda-list collect `(prepare-argument ,arg))))))) - (loop for infos being each hash-value of (sb!c::modular-class-funs sb!c::*signed-modular-class*) - ;; FIXME: We need to process only "toplevel" functions - when (listp infos) - do (loop for info in infos - for name = (sb!c::modular-fun-info-name info) - and width = (sb!c::modular-fun-info-width info) - and lambda-list = (sb!c::modular-fun-info-lambda-list info) - do (forms (definition name lambda-list width))))) + (flet ((do-mfuns (class) + (loop for infos being each hash-value of (sb!c::modular-class-funs class) + ;; FIXME: We need to process only "toplevel" functions + when (listp infos) + do (loop for info in infos + for name = (sb!c::modular-fun-info-name info) + and width = (sb!c::modular-fun-info-width info) + and signedp = (sb!c::modular-fun-info-signedp info) + and lambda-list = (sb!c::modular-fun-info-lambda-list info) + if signedp + do (forms (signed-definition name lambda-list width)) + else + do (forms (unsigned-definition name lambda-list width)))))) + (do-mfuns sb!c::*untagged-unsigned-modular-class*) + (do-mfuns sb!c::*untagged-signed-modular-class*) + (do-mfuns sb!c::*tagged-modular-class*))) `(progn ,@(forms))) ;;; KLUDGE: these out-of-line definitions can't use the modular |