[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Sun Jul 11 23:05:24 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv5941
Modified Files:
integers.lisp
Log Message:
Fixed logand and logior for bignums.
Date: Sun Jul 11 16:05:24 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.42 movitz/losp/muerte/integers.lisp:1.43
--- movitz/losp/muerte/integers.lisp:1.42 Sat Jul 10 07:39:28 2004
+++ movitz/losp/muerte/integers.lisp Sun Jul 11 16:05:24 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.42 2004/07/10 14:39:28 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.43 2004/07/11 23:05:24 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1469,35 +1469,29 @@
(:btl ,(+ index movitz::+movitz-fixnum-shift+) :eax)))))
-(defun logand%2op (x y)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) x)
- (:compile-form (:result-mode :ebx) y)
- (:testb #.movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 107)))
- (:testb #.movitz::+movitz-fixnum-zmask+ :bl)
- (:jnz '(:sub-program () (:movl :ebx :eax) (:int 107)))
- (:andl :ebx :eax)))
-
-(define-compiler-macro logand%2op (&whole form x y)
- (cond
- ((and (movitz:movitz-constantp x) (movitz:movitz-constantp y))
- (logand (movitz::movitz-eval x) (movitz::movitz-eval y)))
- (t form)))
-
-(defun logand (&rest integers)
- (declare (dynamic-extent integers))
- (if (null integers)
- -1
- (reduce #'logand%2op integers)))
+;;;(defun logand%2op (x y)
+;;; (with-inline-assembly (:returns :eax)
+;;; (:compile-form (:result-mode :eax) x)
+;;; (:compile-form (:result-mode :ebx) y)
+;;; (:testb #.movitz::+movitz-fixnum-zmask+ :al)
+;;; (:jnz '(:sub-program () (:int 107)))
+;;; (:testb #.movitz::+movitz-fixnum-zmask+ :bl)
+;;; (:jnz '(:sub-program () (:movl :ebx :eax) (:int 107)))
+;;; (:andl :ebx :eax)))
+;;;
+;;;(define-compiler-macro logand%2op (&whole form x y)
+;;; (cond
+;;; ((and (movitz:movitz-constantp x) (movitz:movitz-constantp y))
+;;; (logand (movitz::movitz-eval x) (movitz::movitz-eval y)))
+;;; (t form)))
-(define-compiler-macro logand (&whole form &rest integers)
+(define-compiler-macro logand (&whole form &rest integers &environment env)
(let ((constant-folded-integers (loop for x in integers
with folded-constant = -1
- if (and (movitz:movitz-constantp x)
- (not (= -1 (movitz::movitz-eval x))))
+ if (and (movitz:movitz-constantp x env)
+ (not (= -1 (movitz:movitz-eval x env))))
do (setf folded-constant
- (logand folded-constant (movitz::movitz-eval x)))
+ (logand folded-constant (movitz:movitz-eval x env)))
else collect x into non-constants
finally (return (if (= -1 folded-constant)
non-constants
@@ -1505,10 +1499,59 @@
(case (length constant-folded-integers)
(0 0)
(1 (first constant-folded-integers))
- (2 `(logand%2op ,(first constant-folded-integers) ,(second constant-folded-integers)))
- (t `(logand (logand%2op ,(first constant-folded-integers) ,(second constant-folded-integers))
+ (2 `(no-macro-call logand ,(first constant-folded-integers) ,(second constant-folded-integers)))
+ (t `(logand (logand ,(first constant-folded-integers) ,(second constant-folded-integers))
,@(cddr constant-folded-integers))))))
+(defun logand (&rest integers)
+ (numargs-case
+ (1 (x) x)
+ (2 (x y)
+ (macrolet
+ ((do-it ()
+ `(number-double-dispatch (x y)
+ ((fixnum fixnum)
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) x y)
+ (:andl :ebx :eax)))
+ ((positive-bignum positive-fixnum)
+ (with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) x)
+ (:call-global-constant unbox-u32)
+ (:compile-form (:result-mode :eax) y)
+ (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :ecx)
+ (:andl :ecx :eax)))
+ ((positive-fixnum positive-bignum)
+ (with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) y)
+ (:call-global-constant unbox-u32)
+ (:compile-form (:result-mode :eax) x)
+ (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :ecx)
+ (:andl :ecx :eax)))
+ ((positive-bignum positive-bignum)
+ (if (< (%bignum-bigits y) (%bignum-bigits x))
+ (logand y x)
+ (%bignum-canonicalize
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) (copy-bignum x) y)
+ (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))
+ :ecx)
+ (:leal ((:ecx 4) -4) :edx)
+ pb-pb-and-loop
+ (:movl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))
+ :ecx)
+ (:andl :ecx
+ (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+ (:subl 4 :edx)
+ (:jnc 'pb-pb-and-loop)))))
+ )))
+ (do-it)))
+ (t (&rest integers)
+ (declare (dynamic-extent integers))
+ (if (null integers)
+ -1
+ (reduce #'logand integers)))))
+
(defun logandc1 (integer1 integer2)
(number-double-dispatch (integer1 integer2)
((t positive-fixnum)
@@ -1518,34 +1561,10 @@
(:shll #.movitz:+movitz-fixnum-shift+ :ecx)
(:compile-form (:result-mode :eax) integer2)
(:notl :ecx)
- (:andl :ecx :eax)))
- ((positive-fixnum t)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) integer2)
- (:call-global-constant unbox-u32)
- (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax)
- (:compile-form (:result-mode :ecx) integer1)
- (:notl :ecx)
(:andl :ecx :eax)))))
(defun logandc2 (integer1 integer2)
- (number-double-dispatch (integer1 integer2)
- ((positive-fixnum t)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) integer2)
- (:call-global-constant unbox-u32)
- (:shll #.movitz:+movitz-fixnum-shift+ :ecx)
- (:compile-form (:result-mode :eax) integer1)
- (:notl :ecx)
- (:andl :ecx :eax)))
- ((t positive-fixnum)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) integer1)
- (:call-global-constant unbox-u32)
- (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax)
- (:compile-form (:result-mode :ecx) integer2)
- (:notl :ecx)
- (:andl :ecx :eax)))))
+ (logandc1 integer2 integer1))
(defun logior (&rest integers)
(numargs-case
@@ -1633,20 +1652,20 @@
((positive-fixnum positive-bignum)
(macrolet
((do-it ()
- `(let ((r (copy-bignum y)))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ecx) r x)
- (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:xorl (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) :ecx)))))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ecx) (copy-bignum y) x)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:xorl :ecx
+ (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))
(do-it)))
((positive-bignum positive-fixnum)
(macrolet
((do-it ()
- `(let ((r (copy-bignum x)))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ecx) r y)
- (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:xorl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))))))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ecx) (copy-bignum x) y)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:xorl :ecx
+ (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))
(do-it)))
((positive-bignum positive-bignum)
(if (< (%bignum-bigits x) (%bignum-bigits y))
More information about the Movitz-cvs
mailing list