[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv26302

Modified Files:
	integers.lisp 
Log Message:
Improved bignum support for logand and lognot.

Date: Thu Sep  1 00:34:14 2005
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.109 movitz/losp/muerte/integers.lisp:1.110
--- movitz/losp/muerte/integers.lisp:1.109	Fri Aug 26 21:39:14 2005
+++ movitz/losp/muerte/integers.lisp	Thu Sep  1 00:34:14 2005
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: integers.lisp,v 1.109 2005/08/26 19:39:14 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.110 2005/08/31 22:34:14 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -328,6 +328,9 @@
 (deftype negative-fixnum ()
   `(integer #.movitz:+movitz-most-negative-fixnum+ -1))
 
+(deftype negative-bignum ()
+  `(integer * #.(cl:1- movitz::+movitz-most-negative-fixnum+)))
+
 (defun fixnump (x)
   (typep x 'fixnum))
 
@@ -1482,6 +1485,36 @@
 			     (:eax :edx (:offset movitz-bignum bigit0)))
 		      (:subl 4 :edx)
 		      (:jnc 'pb-pb-and-loop)))))
+		((negative-bignum fixnum)
+		 (with-inline-assembly (:returns :eax)
+		   (:load-lexical (:lexical-binding x) :untagged-fixnum-ecx)
+		   (:load-lexical (:lexical-binding y) :eax)
+		   (:leal ((:ecx 4) -4) :ecx)
+		   (:notl :ecx)
+		   (:andl :ecx :eax)))
+		((negative-bignum positive-bignum)
+		 (cond
+		  ((<= (%bignum-bigits y) (%bignum-bigits x))
+		   (let ((r (copy-bignum y)))
+		     (with-inline-assembly (:returns :eax)
+		       (:load-lexical (:lexical-binding r) :eax)
+		       (:load-lexical (:lexical-binding x) :ebx)
+		       (:xorl :edx :edx)
+		       (:movl #xffffffff :ecx)
+		      loop
+		       (:addl (:ebx :edx (:offset movitz-bignum bigit0))
+			      :ecx)
+		       (:notl :ecx)
+		       (:andl :ecx (:eax :edx (:offset movitz-bignum bigit0)))
+		       (:notl :ecx)
+		       (:cmpl -1 :ecx)
+		       (:je 'carry)
+		       (:xorl :ecx :ecx)
+		      carry
+		       (:addl 4 :edx)
+		       (:cmpw :dx (:eax (:offset movitz-bignum length)))
+		       (:ja 'loop))))
+		  (t (error "Logand not implemented."))))
 		)))
 	(do-it)))
    (t (&rest integers)
@@ -1639,10 +1672,7 @@
 	(reduce #'logxor integers)))))
 
 (defun lognot (integer)
-  (check-type integer fixnum)
-  (with-inline-assembly (:returns :eax)
-    (:compile-form (:result-mode :eax) integer)
-    (:xorl #.(cl:- #xffffffff movitz::+movitz-fixnum-zmask+) :eax)))
+  (- -1 integer))
 
 (defun ldb%byte (size position integer)
   "This is LDB with explicit byte-size and position parameters."