Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12671
Modified Files: integers.lisp Log Message: Added logior for (positive) bignums.
Date: Thu Jun 10 06:31:14 2004 Author: ffjeld
Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.35 movitz/losp/muerte/integers.lisp:1.36 --- movitz/losp/muerte/integers.lisp:1.35 Wed Jun 9 19:13:19 2004 +++ movitz/losp/muerte/integers.lisp Thu Jun 10 06:31:14 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.35 2004/06/10 02:13:19 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.36 2004/06/10 13:31:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -1459,28 +1459,59 @@ (:notl :ecx) (:andl :ecx :eax)))))
-(defun logior%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))) - (:orl :ebx :eax))) - - -(define-compiler-macro logior%2op (&whole form x y) - (cond - ((and (movitz:movitz-constantp x) (movitz:movitz-constantp y)) - (logior (movitz::movitz-eval x) (movitz::movitz-eval y))) - (t form))) - (defun logior (&rest integers) - (declare (dynamic-extent integers)) - (if (null integers) - 0 - (reduce #'logior%2op integers))) + (numargs-case + (1 (x) x) + (2 (x y) + (number-double-dispatch (x y) + ((fixnum fixnum) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) x y) + (:orl :ebx :eax))) + ((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) + (:orl :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) + (:orl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))) + (do-it))) + ((positive-bignum positive-bignum) + (if (< (%bignum-bigits x) (%bignum-bigits y)) + (logior y x) + (let ((r (copy-bignum x))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) r y) + (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) + ,(* -1 movitz:+movitz-fixnum-factor+)) + :edx) ; EDX is loop counter + or-loop + (:movl (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) + (:orl :ecx + (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:subl 4 :edx) + (:jnc 'or-loop)))) + (do-it))))))) + (t (&rest integers) + (declare (dynamic-extent integers)) + (if (null integers) + 0 + (reduce #'logior integers)))))
(define-compiler-macro logior (&whole form &rest integers) (let ((constant-folded-integers (loop for x in integers @@ -1496,8 +1527,8 @@ (case (length constant-folded-integers) (0 0) (1 (first constant-folded-integers)) - (2 `(logior%2op ,(first constant-folded-integers) ,(second constant-folded-integers))) - (t `(logior (logior%2op ,(first constant-folded-integers) ,(second constant-folded-integers)) + (2 `(no-macro-call logior ,(first constant-folded-integers) ,(second constant-folded-integers))) + (t `(logior (logior ,(first constant-folded-integers) ,(second constant-folded-integers)) ,@(cddr constant-folded-integers))))))
(defun logxor (&rest integers) @@ -1535,7 +1566,6 @@ (:cmpl ,(* (1- movitz:+movitz-fixnum-bits+) movitz:+movitz-fixnum-factor+) :ecx) (:ja '(:sub-program (outside-fixnum) - (:break) (:addl #x80000000 :eax) ; sign into carry (:sbbl :ecx :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax)