[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Jul 12 13:43:43 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv32252
Modified Files:
integers.lisp
Log Message:
More bignum tweaks.
Date: Mon Jul 12 06:43:43 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.45 movitz/losp/muerte/integers.lisp:1.46
--- movitz/losp/muerte/integers.lisp:1.45 Mon Jul 12 04:09:23 2004
+++ movitz/losp/muerte/integers.lisp Mon Jul 12 06:43:43 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.45 2004/07/12 11:09:23 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.46 2004/07/12 13:43:43 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -192,6 +192,8 @@
(:edi (:edi-offset atomically-status))))
pfix-pbig-done))
+ ((positive-bignum negative-fixnum)
+ (+ y x))
((negative-fixnum positive-bignum)
(with-inline-assembly (:returns :eax :labels (retry-not-size1
not-size1
@@ -256,31 +258,44 @@
(:edi (:edi-offset atomically-status))))
pfix-pbig-done))
- #+ignore
((positive-bignum positive-bignum)
(if (< (%bignum-bigits y) (%bignum-bigits x))
(+ y x)
;; Assume x is smallest.
- (with-inline-assembly (:returns :eax :labels (retry-copy
+ (with-inline-assembly (:returns :eax :labels (retry-not-size1
+ not-size1
+ term-zero
copy-bignum-loop
add-bignum-loop
add-bignum-done
no-expansion
pfix-pbig-done))
- retry-copy
+ (:compile-two-forms (:eax :ebx) y x)
+ (:testl :ebx :ebx)
+ (:jz 'pfix-pbig-done)
+ (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
+ (:cmpl ,movitz:+movitz-fixnum-factor+ :ecx)
+ (:jne 'not-size1)
+ (:movl (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx)
+ (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx)
+ (:jc 'retry-not-size1)
+ (:call-global-constant box-u32-ecx)
+ (:jmp 'pfix-pbig-done)
+ retry-not-size1
(:compile-form (:result-mode :eax) y)
(:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
- (:declare-label-set retry-jumper (retry-copy))
+ not-size1
+ (:declare-label-set retry-jumper (retry-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+))
+ (:leal ((:ecx 1) ,(* 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+)
+ (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+)
:edx)
(:movl 0 (:eax :edx ,movitz:+other-type-offset+)) ; MSB
copy-bignum-loop
@@ -288,31 +303,46 @@
(:movl (:ebx :edx ,movitz:+other-type-offset+) :ecx)
(:movl :ecx (:eax :edx ,movitz:+other-type-offset+))
(:jnz 'copy-bignum-loop)
- ;; We now have a copy of Y in EAX.
- (:load-lexical (:lexical-binding x) :ebx)
- (:xorl :ebx :ebx)
- (:addl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
- (:jnc 'add-bignum-done)
+ (:load-lexical (:lexical-binding x) :ebx)
+ (:xorl :edx :edx) ; counter
+ (:xorl :ecx :ecx) ; Carry
add-bignum-loop
- (:addl 4 :ebx)
- (:addl 1 (:eax :ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
- (:jc 'add-bignum-loop)
+ (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)))
+ (:jbe '(:sub-program (zero-padding-loop)
+ (:addl :ecx (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum
+ 'movitz::bigit0)))
+ (:sbbl :ecx :ecx)
+ (:negl :ecx) ; ECX = Add's Carry.
+ (:addl 4 :edx)
+ (:cmpw :dx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)))
+ (:jae 'zero-padding-loop)
+ (:jmp 'add-bignum-done)))
+ (:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))
+ :ecx)
+ term-zero
+ (:adcl :ecx (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+ (:sbbl :ecx :ecx)
+ (:negl :ecx) ; ECX = Add's Carry.
+ (:addl 4 :edx)
+ (:cmpw :dx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)))
+ (:jae 'add-bignum-loop)
add-bignum-done
(:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))
:ecx)
- (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) ,movitz:+movitz-fixnum-factor+)
+ (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+)
:ecx)
(:cmpl 0 (:eax :ecx ,(+ -4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))))
(:je 'no-expansion)
- (:addl #x10000 (:eax ,movitz:+other-type-offset+))
+ (:addl #x40000 (:eax ,movitz:+other-type-offset+))
(:addl ,movitz:+movitz-fixnum-factor+ :ecx)
no-expansion
(:call-global-constant cons-commit)
(:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
(:edi (:edi-offset atomically-status))))
- pfix-pbig-done)))
+ pfix-pbig-done)
+ ))
)))
(do-it)))
(t (&rest terms)
@@ -1251,43 +1281,6 @@
;;; Division
-(define-compiler-macro truncate (&whole form number &optional (divisor 1))
- `(do-result-mode-case ()
- (:plural
- (no-macro-call , at form))
- (t (truncate%1ret ,number ,divisor))))
-
-(defun truncate%1ret (number divisor)
- (with-inline-assembly (:returns :multiple-values)
- (:compile-form (:result-mode :eax) number)
- (:compile-form (:result-mode :ebx) divisor)
- (:movl :eax :ecx)
- (:orl :ebx :ecx)
- (:testb #.movitz::+movitz-fixnum-zmask+ :cl)
- (:jnz '(:sub-program (not-integer) (:int 107)))
- (:cdq :eax :edx)
- (:idivl :ebx :eax :edx)
- (:shll #.movitz::+movitz-fixnum-shift+ :eax)
- (:clc)))
-
-(define-compiler-macro truncate%1ret (&whole form &environment env number divisor)
- (cond
- ((movitz:movitz-constantp divisor env)
- (let ((d (movitz:movitz-eval divisor env)))
- (check-type d number)
- (case d
- (0 (error "Truncate by zero."))
- (1 number)
- (t `(with-inline-assembly (:returns :eax :type fixnum)
- (:compile-form (:result-mode :eax) ,number)
- (:compile-form (:result-mode :ebx) ,divisor)
- (:testb #.movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 66)))
- (:cdq :eax :edx)
- (:idivl :ebx :eax :edx)
- (:shll #.movitz::+movitz-fixnum-shift+ :eax))))))
- (t form)))
-
(defun truncate (number &optional (divisor 1))
(numargs-case
(1 (number)
@@ -1404,6 +1397,11 @@
(:movl 2 :ecx)
(:stc)))))
(do-it)))
+ ((positive-bignum positive-bignum)
+ (cond
+ ((= number divisor) (values 1 0))
+ ((< number divisor) (values 0 number))
+ (t (error "Don't know how to divide ~S with ~S." number divisor))))
))))
(defun / (number &rest denominators)
@@ -1500,27 +1498,33 @@
(rem bytespec #x400))
(defun logbitp (index integer)
- (check-type integer fixnum)
- (with-inline-assembly (:returns :boolean-cf=1)
- (:compile-two-forms (:eax :ebx) index integer)
- (:testl #x80000003 :eax)
- (:jnz '(:sub-program ()
- (:int 66)))
- (:movl :eax :ecx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:addl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:btl :ecx :ebx)))
+ (check-type index positive-fixnum)
+ (macrolet
+ ((do-it ()
+ `(etypecase integer
+ (fixnum
+ (with-inline-assembly (:returns :boolean-cf=1)
+ (:compile-two-forms (:ecx :ebx) index integer)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:addl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:btl :ecx :ebx)))
+ (positive-bignum
+ (with-inline-assembly (:returns :boolean-cf=1)
+ (:compile-two-forms (:ecx :ebx) index integer)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:btl :ecx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))))))))
+ (do-it)))
-(define-compiler-macro logbitp (&whole form index integer &environment env)
- (if (not (movitz:movitz-constantp index env))
- form
- (let ((index (movitz::movitz-eval index env)))
- (check-type index (integer 0 30))
- `(with-inline-assembly (:returns :boolean-cf=1)
- (:compile-form (:result-mode :eax) ,integer)
- (:testb #.movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 107)))
- (:btl ,(+ index movitz::+movitz-fixnum-shift+) :eax)))))
+;;;(define-compiler-macro logbitp (&whole form index integer &environment env)
+;;; (if (not (movitz:movitz-constantp index env))
+;;; form
+;;; (let ((index (movitz::movitz-eval index env)))
+;;; (check-type index (integer 0 30))
+;;; `(with-inline-assembly (:returns :boolean-cf=1)
+;;; (:compile-form (:result-mode :eax) ,integer)
+;;; (:testb #.movitz::+movitz-fixnum-zmask+ :al)
+;;; (:jnz '(:sub-program () (:int 107)))
+;;; (:btl ,(+ index movitz::+movitz-fixnum-shift+) :eax)))))
;;;(defun logand%2op (x y)
More information about the Movitz-cvs
mailing list