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

Modified Files: integers.lisp Log Message: Added 'complicated-eql' that understands ratios. Also, now = is essentially the same as eql.

Date: Sat Jul 31 17:37:31 2004 Author: ffjeld

Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.89 movitz/losp/muerte/integers.lisp:1.90 --- movitz/losp/muerte/integers.lisp:1.89 Fri Jul 30 15:10:59 2004 +++ movitz/losp/muerte/integers.lisp Sat Jul 31 17:37:31 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.89 2004/07/30 22:10:59 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.90 2004/08/01 00:37:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -139,6 +139,57 @@ (:ret)))) (do-it)))

+(defun complicated-eql (x y) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :multiple-values) ; well.. + (:compile-two-forms (:eax :ebx) x y) + (:cmpl :eax :ebx) ; EQ? + (:je 'done) + (:leal (:eax ,(- (movitz:tag :other))) :ecx) + (:testb 7 :cl) + (:jne 'done) + (:leal (:ebx ,(- (movitz:tag :other))) :ecx) + (:testb 7 :cl) + (:jne 'done) + (:movl (:eax ,movitz:+other-type-offset+) :ecx) + (:cmpb ,(movitz:tag :bignum) :cl) + (:jne 'not-bignum) + (:cmpl :ecx (:ebx ,movitz:+other-type-offset+)) + (:jne 'done) + ;; Ok.. we have two bignums of identical sign and size. + (:shrl 16 :ecx) + (:movl :ecx :edx) ; counter + compare-loop + (:subl ,movitz:+movitz-fixnum-factor+ :edx) + (:jz 'done) + (:movl (:eax :edx (:offset movitz-bignum bigit0 -4)) :ecx) + (:cmpl :ecx (:ebx :edx (:offset movitz-bignum bigit0 -4))) + (:je 'compare-loop) + (:jmp 'done) + not-bignum + (:cmpb ,(movitz:tag :ratio) :cl) + (:jne 'not-ratio) + (:cmpl :ecx (:ebx ,movitz:+other-type-offset+)) + (:jne 'done) + (:movl (:eax (:offset movitz-ratio numerator)) :eax) + (:movl (:ebx (:offset movitz-ratio numerator)) :ebx) + (:call (:esi (:offset movitz-funobj code-vector%2op))) + (:jne 'done) + (:compile-two-forms (:eax :ebx) x y) + (:movl (:eax (:offset movitz-ratio denominator)) :eax) + (:movl (:ebx (:offset movitz-ratio denominator)) :ebx) + (:call (:esi (:offset movitz-funobj code-vector%2op))) + (:jmp 'done) + not-ratio + + done + (:movl :edi :eax) + (:clc) + ))) + (do-it))) + + (define-primitive-function fast-eql (x y) "Compare EAX and EBX under EQL, result in ZF. Preserve EAX and EBX." @@ -337,9 +388,7 @@ (:call-global-pf fast-compare-two-reals)))))) ((movitz:movitz-constantp n2 env) `(=%2op ,n2 ,n1)) - (t `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-two-reals))))) + (t `(eql ,n1 ,n2))))

(define-number-relational = =%2op nil :defun-p nil)

@@ -349,7 +398,10 @@ (unless (= first-number n) (return nil))))

-(define-number-relational /= /=%2op :boolean-zf=0 :defun-p nil) +(define-compiler-macro /=%2op (n1 n2) + `(not (= ,n1 ,n2))) + +(define-number-relational /= /=%2op nil :defun-p nil)

(defun /= (&rest numbers) (declare (dynamic-extent numbers)) @@ -724,9 +776,9 @@ (:testb 7 :cl) (:jnz '(:sub-program (not-a-number) (:compile-form (:result-mode :ignore) - (if (ratio-p x) - (make-rational (- (ratio-numerator x)) - (ratio-denominator x)) + (if (typep x 'ratio) + (make-rational (- (%ratio-numerator x)) + (%ratio-denominator x)) (error 'type-error :expected-type 'number :datum x))))) (:movl (:eax ,movitz:+other-type-offset+) :ecx) (:cmpb ,(movitz:tag :bignum) :cl) @@ -1212,21 +1264,21 @@ (defun truncate (number &optional (divisor 1)) (numargs-case (1 (number) - (if (not (ratio-p number)) + (if (not (typep number 'ratio)) (values number 0) (multiple-value-bind (q r) - (truncate (ratio-numerator number) - (ratio-denominator number)) - (values q (make-rational r (ratio-denominator number)))))) + (truncate (%ratio-numerator number) + (%ratio-denominator number)) + (values q (make-rational r (%ratio-denominator number)))))) (t (number divisor) (number-double-dispatch (number divisor) ((t (eql 1)) - (if (not (ratio-p number)) + (if (not (typep number 'ratio)) (values number 0) (multiple-value-bind (q r) - (truncate (ratio-numerator number) - (ratio-denominator number)) - (values q (make-rational r (ratio-denominator number)))))) + (truncate (%ratio-numerator number) + (%ratio-denominator number)) + (values q (make-rational r (%ratio-denominator number)))))) ((fixnum fixnum) (with-inline-assembly (:returns :multiple-values) (:compile-form (:result-mode :eax) number) @@ -1414,10 +1466,10 @@ (defun / (number &rest denominators) (numargs-case (1 (x) - (if (not (ratio-p x)) + (if (not (typep x 'ratio)) (make-rational 1 x) - (make-rational (ratio-denominator x) - (ratio-numerator x)))) + (make-rational (%ratio-denominator x) + (%ratio-numerator x)))) (2 (x y) (multiple-value-bind (q r) (truncate x y) @@ -2172,11 +2224,11 @@ "This is floor written in terms of truncate." (numargs-case (1 (n) - (if (not (ratio-p n)) + (if (not (typep n 'ratio)) (values n 0) (multiple-value-bind (r q) - (floor (ratio-numerator n) (ratio-denominator n)) - (values r (make-rational q (ratio-denominator n)))))) + (floor (%ratio-numerator n) (%ratio-denominator n)) + (values r (%make-rational q (%ratio-denominator n)))))) (2 (n divisor) (multiple-value-bind (q r) (truncate n divisor)