[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-serv8756

Modified Files:
	integers.lisp 
Log Message:
Added bignum support in evenp, and thus also oddp.

Date: Tue Jun  1 06:38:35 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.12 movitz/losp/muerte/integers.lisp:1.13
--- movitz/losp/muerte/integers.lisp:1.12	Mon May 24 15:38:03 2004
+++ movitz/losp/muerte/integers.lisp	Tue Jun  1 06:38:35 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: integers.lisp,v 1.12 2004/05/24 22:38:03 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.13 2004/06/01 13:38:35 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -32,15 +32,28 @@
   (typep x 'fixnum))
 
 (defun evenp (x)
-  (with-inline-assembly (:returns :ebx)
-    (:compile-form (:result-mode :eax) x)
-    (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx))
-    (:testb #.(cl:1+ (cl:* 2 movitz::+movitz-fixnum-zmask+)) :al)
-    (:jz 'done)
-    (:movl :edi :ebx)
-    (:testb #.movitz::+movitz-fixnum-zmask+ :al)
-    (:jnz '(:sub-program (not-fixnum) (:int 107) (:jmp (:pc+ -4))))
-    done))
+  (macrolet
+      ((do-it ()
+	 `(with-inline-assembly (:returns :ebx)
+	    (:compile-form (:result-mode :eax) x)
+	    (:movl :eax :ecx)
+	    (:andl 7 :ecx)
+	    (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx))
+	    (:cmpl ,(movitz:tag :even-fixnum) :ecx)
+	    (:je 'done)
+	    (:movl :edi :ebx)
+	    (:cmpl ,(movitz:tag :odd-fixnum) :ecx)
+	    (:je 'done)
+	    (:cmpl ,(movitz:tag :other) :ecx)
+	    (:jnz '(:sub-program (not-integer)
+		    (:int 107)))
+	    (:cmpb ,(movitz:tag :bignum) (:eax ,movitz:+other-type-offset+))
+	    (:jne 'not-integer)
+	    (:testb 1 (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+	    (:jnz 'done)
+	    (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx))
+	   done)))
+    (do-it)))
 
 (defun oddp (x)
   (not (evenp x)))
@@ -64,6 +77,7 @@
 				    (cons constant-term non-constant-operands))))))
 	 `(+ (+%2op ,(first operands) ,(second operands)) ,@(cddr operands))))))
 
+#+ignore
 (defun +%2op (term1 term2)
   (check-type term1 fixnum)
   (check-type term2 fixnum)
@@ -73,37 +87,36 @@
     (:addl :ebx :eax)
     (:into)))
 
-#+ignore
-(define-compiler-macro +%2op (&whole form term1 term2)
-  (cond
-   ((and (movitz:movitz-constantp term1)	; first operand zero?
-	 (zerop (movitz:movitz-eval term1)))
-    term2)				; (+ 0 x) => x
-   ((and (movitz:movitz-constantp term2)	; second operand zero?
-	 (zerop (movitz:movitz-eval term2)))
-    term1)				; (+ x 0) => x
-   ((and (movitz:movitz-constantp term1)
-	 (movitz:movitz-constantp term2))
-    (+ (movitz:movitz-eval term1)
-       (movitz:movitz-eval term2)))	; compile-time constant folding.
-   ((movitz:movitz-constantp term1)
-    (let ((constant-term1 (movitz:movitz-eval term1)))
-      (check-type constant-term1 (signed-byte 30))
-      `(with-inline-assembly (:returns :register :side-effects nil) ; inline
-	 (:compile-form (:result-mode :register) ,term2)
-	 (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term1) (:result-register))
-	 (:into))))
-   ((movitz:movitz-constantp term2)
-    (let ((constant-term2 (movitz:movitz-eval term2)))
-      (check-type constant-term2 (signed-byte 30))
-      `(with-inline-assembly (:returns :register :side-effects nil) ; inline
-	 (:compile-form (:result-mode :register) ,term1)
-	 (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term2) (:result-register))
-	 (:into))))
-   (t `(with-inline-assembly (:returns :eax :side-effects nil)
-	 (:compile-two-forms (:ebx :eax) ,term1 ,term2)
-	 (:addl :ebx :eax)
-	 (:into)))))
+;;;(define-compiler-macro +%2op (&whole form term1 term2)
+;;;  (cond
+;;;   ((and (movitz:movitz-constantp term1)	; first operand zero?
+;;;	 (zerop (movitz:movitz-eval term1)))
+;;;    term2)				; (+ 0 x) => x
+;;;   ((and (movitz:movitz-constantp term2)	; second operand zero?
+;;;	 (zerop (movitz:movitz-eval term2)))
+;;;    term1)				; (+ x 0) => x
+;;;   ((and (movitz:movitz-constantp term1)
+;;;	 (movitz:movitz-constantp term2))
+;;;    (+ (movitz:movitz-eval term1)
+;;;       (movitz:movitz-eval term2)))	; compile-time constant folding.
+;;;   ((movitz:movitz-constantp term1)
+;;;    (let ((constant-term1 (movitz:movitz-eval term1)))
+;;;      (check-type constant-term1 (signed-byte 30))
+;;;      `(with-inline-assembly (:returns :register :side-effects nil) ; inline
+;;;	 (:compile-form (:result-mode :register) ,term2)
+;;;	 (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term1) (:result-register))
+;;;	 (:into))))
+;;;   ((movitz:movitz-constantp term2)
+;;;    (let ((constant-term2 (movitz:movitz-eval term2)))
+;;;      (check-type constant-term2 (signed-byte 30))
+;;;      `(with-inline-assembly (:returns :register :side-effects nil) ; inline
+;;;	 (:compile-form (:result-mode :register) ,term1)
+;;;	 (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term2) (:result-register))
+;;;	 (:into))))
+;;;   (t `(with-inline-assembly (:returns :eax :side-effects nil)
+;;;	 (:compile-two-forms (:ebx :eax) ,term1 ,term2)
+;;;	 (:addl :ebx :eax)
+;;;	 (:into)))))
 
 (defun 1+ (number)
   (+ 1 number))
@@ -194,7 +207,7 @@
    ((movitz:movitz-constantp subtrahend)
     (let ((constant-subtrahend (movitz:movitz-eval subtrahend)))
       (check-type constant-subtrahend (signed-byte 30))
-      `(+%2op ,minuend ,(- constant-subtrahend))))
+      `(+ ,minuend ,(- constant-subtrahend))))
    (t `(with-inline-assembly (:returns :eax :side-effects nil)
 	 (:compile-two-forms (:eax :ebx) ,minuend ,subtrahend)
 	 (:subl :ebx :eax)