[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