[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Sun Jun 6 01:53:49 UTC 2004
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
More information about the Movitz-cvs
mailing list