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

Modified Files: integers.lisp Log Message: Improved truncate a good bit.

Date: Sat Jun 5 18:53:48 2004 Author: ffjeld

Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.18 movitz/losp/muerte/integers.lisp:1.19 --- movitz/losp/muerte/integers.lisp:1.18 Fri Jun 4 06:33:16 2004 +++ movitz/losp/muerte/integers.lisp Sat Jun 5 18:53:48 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.18 2004/06/04 13:33:16 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.19 2004/06/06 01:53:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -116,22 +116,65 @@ ,(* 2 movitz:+movitz-most-negative-fixnum+)) (:jmp 'fix-fix-ok))) fix-fix-ok)) + ((positive-bignum positive-fixnum) + (break "Hello?") + (+ y x)) ((positive-fixnum positive-bignum) (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) x) + (:testl :eax :eax) + (:jz 'pfix-pbig-done) (:compile-form (:result-mode :eax) y) - (:jecxz 'pfix-pbig-done) - (:movzxw (:eax #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) (:cmpl 1 :ecx) (:jne 'not-size1) (:compile-form (:result-mode :ecx) x) (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:addl (:eax #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx) + (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx) (:jc '(:sub-program () (:break))) (:call-global-constant box-u32-ecx) (:jmp 'pfix-pbig-done) not-size1 - (:break) + (:declare-label-set retry-jumper (not-size1)) + (:locally (:movl :esp (:edi (:edi-offset atomically-esp)))) + (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) ,(* 2 movitz:+movitz-fixnum-factor+)) + :eax) ; Number of words + (:call-global-constant get-cons-pointer) + (:load-lexical (:lexical-binding y) :ebx) ; bignum + (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+) + #.movitz:+movitz-fixnum-factor+) + :edx) + (:movl 0 (:eax :edx ,movitz:+other-type-offset+)) ; MSB + copy-bignum-loop + (:subl ,movitz:+movitz-fixnum-factor+ :edx) + (:movl (:ebx :edx ,movitz:+other-type-offset+) :ecx) + (:movl :ecx (:eax :edx ,movitz:+other-type-offset+)) + (:jnz 'copy-bignum-loop) + + (:load-lexical (:lexical-binding x) :ecx) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:xorl :ebx :ebx) + (:addl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:jnc 'add-bignum-done) + add-bignum-loop + (:addl 4 :ebx) + (:addl 1 (:eax :ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:jc 'add-bignum-loop) + add-bignum-done + (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) #+ignore ,movitz:+movitz-fixnum-factor+) + :ebx) +;;; (:cmpl 0 (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) + + (:call-global-constant cons-commit) + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + pfix-pbig-done)) ))) (do-it))) @@ -797,88 +840,100 @@ (:movb 2 :cl) ; return values: qutient, remainder. (:stc))) ((positive-bignum positive-fixnum) - (let (r n) - (with-inline-assembly (:returns :multiple-values) - (:compile-form (:result-mode :ebx) number) - (:movzxw (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) - (:cmpl 1 :ecx) - (:jne 'not-size1) - (:compile-form (:result-mode :ecx) divisor) - (:shrl #.movitz:+movitz-fixnum-shift+ :ecx) - (:std) - (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax) - (:xorl :edx :edx) - (:divl :ecx :eax :edx) - (:movl :eax :ecx) - (:shll #.movitz:+movitz-fixnum-shift+ :edx) - (:movl :edi :eax) - (:cld) - (:pushl :edx) - (:call-global-constant box-u32-ecx) - (:popl :ebx) - (:jmp 'done) - not-size1 - (:cmpl 2 :ecx) - (:jne 'not-size2) - (:compile-form (:result-mode :ecx) divisor) - (:shrl #.movitz:+movitz-fixnum-shift+ :ecx) - (:std) - (:movl (:ebx #.(cl:+ 4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - :edx) - (:cmpl :ecx :edx) - (:jae 'not-size2) - (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax) - (:divl :ecx :eax :edx) - (:movl :eax :ecx) - (:shll #.movitz:+movitz-fixnum-shift+ :edx) - (:movl :edi :eax) - (:cld) - (:pushl :edx) - (:call-global-constant box-u32-ecx) - (:popl :ebx) - (:jmp 'done) - not-size2 - (:cmpl :ecx (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) - -4 (:ecx 4))) - (:jc 'shrink-not-size2) - not-shrink - (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax) - (:compile-form (:result-mode :eax) - (malloc-words (with-inline-assembly (:returns :eax)))) - (:store-lexical (:lexical-binding r) :eax :type t) - (:compile-form (:result-mode :ebx) number) - (:movl (:ebx #.movitz:+other-type-offset+) :ecx) - (:movl :ecx (:eax #.movitz:+other-type-offset+)) - (:shrl 16 :ecx) + (macrolet + ((do-it () + `(let (r n) + (with-inline-assembly (:returns :multiple-values) + (:compile-form (:result-mode :ebx) number) + (:cmpw 1 (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:jne 'not-size1) + (:compile-form (:result-mode :ecx) divisor) + (:shrl #.movitz:+movitz-fixnum-shift+ :ecx) + (:std) + (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax) + (:xorl :edx :edx) + (:divl :ecx :eax :edx) + (:movl :eax :ecx) + (:shll #.movitz:+movitz-fixnum-shift+ :edx) + (:movl :edi :eax) + (:cld) + (:pushl :edx) + (:call-global-constant box-u32-ecx) + (:popl :ebx) + (:jmp 'done) + not-size1 + (:compile-form (:result-mode :ebx) number) + (:movzxw (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + :ecx) + + (:declare-label-set retry-jumper (not-size1)) + (:locally (:movl :esp (:edi (:edi-offset atomically-esp)))) + (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp) + 'retry-jumper) + (:edi (:edi-offset atomically-status)))) + + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+) #.movitz:+movitz-fixnum-factor+) + :eax) ; Number of words + (:call-global-constant get-cons-pointer) ; New bignum into EAX + + + (:store-lexical (:lexical-binding r) :eax :type bignum) + (:compile-form (:result-mode :ebx) number) + (:movl (:ebx #.movitz:+other-type-offset+) :ecx) + (:movl :ecx (:eax #.movitz:+other-type-offset+)) + (:shrl 16 :ecx) - (:xorl :edx :edx) ; edx=hi-digit=0 + (:xorl :edx :edx) ; edx=hi-digit=0 ; eax=lo-digit=msd(number) - (:std) - (:compile-form (:result-mode :esi) divisor) - (:shrl #.movitz:+movitz-fixnum-shift+ :esi) - - divide-loop - (:load-lexical (:lexical-binding number) :ebx) - (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) - -4 (:ecx 4)) - :eax) - (:divl :esi :eax :edx) - (:load-lexical (:lexical-binding r) :ebx) - (:movl :eax (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) - -4 (:ecx 4))) - (:subl 1 :ecx) - (:jnz 'divide-loop) - (:movl :ebx :eax) - (:leal ((:edx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:movl :edi :edx) - (:movl (:ebp -4) :esi) - (:cld) - (:jmp 'done) - shrink-not-size2 - (:int 107) - done - (:movl 2 :ecx) - (:stc)))) + (:std) + (:compile-form (:result-mode :esi) divisor) + (:shrl #.movitz:+movitz-fixnum-shift+ :esi) + + divide-loop + (:load-lexical (:lexical-binding number) :ebx) + (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) + -4 (:ecx 4)) + :eax) + (:divl :esi :eax :edx) + (:load-lexical (:lexical-binding r) :ebx) + (:movl :eax (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) + -4 (:ecx 4))) + (:subl 1 :ecx) + (:jnz 'divide-loop) + (:movl :edi :eax) ; safe value + (:leal ((:edx ,movitz:+movitz-fixnum-factor+)) :edx) + (:movl (:ebp -4) :esi) + (:cld) + (:movl :ebx :eax) + (:movl :edx :ebx) + + (:movzxw (:eax #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) #.movitz:+movitz-fixnum-factor+) + :ecx) + (:cmpl 0 (:eax :ecx ,(+ -8 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:jne 'no-more-shrinkage) + + (:subw 1 (:eax #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:subl ,movitz:+movitz-fixnum-factor+ :ecx) + (:cmpl ,(* 2 movitz:+movitz-fixnum-factor+) :ecx) + (:jne 'no-more-shrinkage) + (:cmpl ,movitz:+movitz-most-positive-fixnum+ + (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:jnc 'no-more-shrinkage) + (:movl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) + (:jmp 'fixnum-result) ; don't commit the bignum + no-more-shrinkage + (:call-global-constant cons-commit) + fixnum-result + (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) + (:edi (:edi-offset atomically-status)))) + done + (:movl 2 :ecx) + (:stc))))) + (do-it))) ))))

(defun round (number &optional (divisor 1)) @@ -1268,17 +1323,22 @@ (t (n &optional (divisor 1)) (floor n divisor))))

+(define-compiler-macro %bignum-bigits (x) + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,x) + (:movzxw (:eax #.(bt:slot-offset 'movitz::movitz-bignum + 'movitz::length)) + :ecx) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) + :eax))) + +(defun %bignum-bigits (x) + (%bignum-bigits x)) + (defun copy-bignum (old) (check-type old bignum) - (let* ((length (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) old) - (:movzxw (:eax #.(bt:slot-offset 'movitz::movitz-bignum - 'movitz::length)) - :ecx) - (:leal ((:ecx #.movitz:+movitz-fixnum-factor+) - #.movitz:+movitz-fixnum-factor+) - :eax))) - (new (malloc-data-clumps length))) + (let* ((length (1+ (%bignum-bigits old))) + (new (malloc-data-words length))) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) new old) (:compile-form (:result-mode :edx) length) @@ -1287,3 +1347,10 @@ (:movl (:ebx :edx #.movitz:+other-type-offset+) :ecx) (:movl :ecx (:eax :edx #.movitz:+other-type-offset+)) (:jnz 'copy-bignum-loop)))) + +(defun print-bignum (x) + (check-type x bignum) + (loop for i from 0 to (%bignum-bigits x) + do (format t "~8,'0X " (memref x -6 i :unsigned-byte32))) + (terpri) + (values)) \ No newline at end of file