July 2004 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 18 Jul '04

18 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3840 Modified Files: interrupt.lisp Log Message: Misc reformatting and new messages, such as overflow for exception 4. Date: Sun Jul 18 16:48:22 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.14 movitz/losp/muerte/interrupt.lisp:1.15 --- movitz/losp/muerte/interrupt.lisp:1.14 Mon Jun 7 15:13:12 2004 +++ movitz/losp/muerte/interrupt.lisp Sun Jul 18 16:48:22 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.14 2004/06/07 22:13:12 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.15 2004/07/18 23:48:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -268,6 +268,7 @@ (case number (0 (error 'division-by-zero)) (3 (break "Break instruction at ~@Z." $eip)) + (4 (error "Primitive overflow assertion failed.")) (6 (error "Illegal instruction at ~@Z." $eip)) (13 (error "General protection error. EIP=~@Z, error-code: #x~X, EAX: ~@Z, EBX: ~@Z, ECX: ~@Z" $eip @@ -279,17 +280,18 @@ (error 'type-error :datum (@ $eax) :expected-type (@ $edx))) (format *query-io* "Enter a new value: ") (setf (@ $eax) (read *query-io*))) - (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" - $eip $eax $ebx $ecx $edx) + (62 (error "Trying to save too many values: ~@Z." $ecx)) + (63 (error "Primitive assertion error. EIP=~@Z, ESI=~@Z." $eip $esi)) + (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." + $eip (@ (+ interrupt-frame (interrupt-frame-index :esi))) + $eax $ecx)) + (67 (backtrace :fresh-lines nil :length 6) (dotimes (i 100000) (with-inline-assembly (:returns :nothing) (:nop)))) - (67 (backtrace :fresh-lines nil :length 6) + (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" + $eip $eax $ebx $ecx $edx) (dotimes (i 100000) (with-inline-assembly (:returns :nothing) (:nop)))) - (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." - $eip (@ (+ interrupt-frame (interrupt-frame-index :esi))) - $eax $ecx)) - (62 (error "Trying to save too many values: ~@Z." $ecx)) ((5 55) (let* ((old-bottom (prog1 (stack-bottom) (setf (stack-bottom) 0))) @@ -311,8 +313,8 @@ (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X.~%" (- old-bottom new-bottom) new-bottom) - (break "Stack overload exception ~D at ESP=~@Z with bottom #x~X." - number + (break "Stack overload exception ~D at EIP=~@Z, ESI=~@Z, ESP=~@Z, bottom=#x~X." + number $eip $esi (+ interrupt-frame (interrupt-frame-index :ebp)) old-bottom)) (format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%"

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 18 Jul '04

18 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12702 Modified Files: compiler.lisp Log Message: Two minor fixes for some edge cases wrt. register allocation. Date: Sun Jul 18 16:45:45 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.76 movitz/compiler.lisp:1.77 --- movitz/compiler.lisp:1.76 Thu Jul 15 17:03:42 2004 +++ movitz/compiler.lisp Sun Jul 18 16:45:45 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.76 2004/07/16 00:03:42 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.77 2004/07/18 23:45:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1331,6 +1331,7 @@ (second (second i)))))) (negate-branch (branch-type) (ecase branch-type + (:jb :jnb) (:jnb :jb) (:jbe :ja) (:ja :jbe) (:jz :jnz) (:jnz :jz) (:je :jne) (:jne :je) @@ -3988,6 +3989,10 @@ (decf stack-setup-size) `((:pushl :ebx) (:xchgl :eax :ebx))) + ((and (eq :ebx location-0) + (eq :edx location-1)) + `((:movl :ebx :edx) + (:movl :eax :ebx))) (t (append (cond ((eql 1 location-0) @@ -6144,12 +6149,13 @@ (break "check that this is correct..") `((:addl ,(movitz-immediate-value (car (type-specifier-singleton type0))) (:ebp ,(stack-frame-offset loc1))))))) - (t (warn "ADD: ~S = ~A + ~A, ~A ~A, ~A ~A" - destination loc0 loc1 type0 type1 - (type-specifier-singleton type0) - (eq loc1 destination)) - (warn "ADDI: ~S" instruction) - (append (cond + (t +;;; (warn "ADD: ~S = ~A + ~A, ~A ~A, ~A ~A" +;;; destination loc0 loc1 type0 type1 +;;; (type-specifier-singleton type0) +;;; (eq loc1 destination)) +;;; (warn "ADDI: ~S" instruction) + (append (cond ((and (eq :eax loc0) (eq :ebx loc1)) nil) ((and (eq :ebx loc0) (eq :eax loc1))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/bignums.lisp
by Frode Vatvedt Fjeld 18 Jul '04

18 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1339 Modified Files: bignums.lisp Log Message: Wrote %bignum-subf. Date: Sun Jul 18 01:45:39 2004 Author: ffjeld Index: movitz/losp/muerte/bignums.lisp diff -u movitz/losp/muerte/bignums.lisp:1.1 movitz/losp/muerte/bignums.lisp:1.2 --- movitz/losp/muerte/bignums.lisp:1.1 Sat Jul 17 12:30:09 2004 +++ movitz/losp/muerte/bignums.lisp Sun Jul 18 01:45:39 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 19:42:57 2004 ;;;; -;;;; $Id: bignums.lisp,v 1.1 2004/07/17 19:30:09 ffjeld Exp $ +;;;; $Id: bignums.lisp,v 1.2 2004/07/18 08:45:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -64,7 +64,7 @@ (defun copy-bignum (old) (check-type old bignum) - (let* ((length (%bignum-bigits old)) + (let* ((length (ceiling (integer-length old) 32)) (new (malloc-non-pointer-words (1+ length)))) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) new old) @@ -172,3 +172,55 @@ add-bignum-done))) (do-it))))) +(defun %bignum-subf (bignum delta) + "Destructively subtract (abs delta) from bignum." + (check-type bignum bignum) + (etypecase delta + (positive-fixnum + (%bignum-addf-fixnum bignum (- delta))) + (negative-fixnum + (%bignum-addf-fixnum bignum delta)) + (bignum + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + not-size1 + (:load-lexical (:lexical-binding bignum) :eax) ; EAX = bignum + (:load-lexical (:lexical-binding delta) :ebx) ; EBX = delta + (:xorl :edx :edx) ; Counter + (:xorl :ecx :ecx) ; Carry + sub-bignum-loop + (:cmpw :dx (:eax (:offset movitz-bignum length))) + (:jbe '(:sub-program (overflow) (:int 4))) + (:addl (:ebx :edx (:offset movitz-bignum :bigit0)) + :ecx) + (:jz 'carry+digit-overflowed) ; If CF=1, then ECX=0. + (:subl :ecx (:eax :edx (:offset movitz-bignum bigit0))) + carry+digit-overflowed + (:sbbl :ecx :ecx) + (:negl :ecx) ; ECX = Add's Carry. + (:addl 4 :edx) + (:cmpw :dx (:ebx (:offset movitz-bignum length))) + (:ja 'sub-bignum-loop) + ;; Now, if there's a carry we must propagate it. + (:jecxz 'sub-bignum-done) + carry-propagate-loop + (:cmpw :dx (:eax (:offset movitz-bignum length))) + (:jbe '(:sub-program (overflow) (:int 4))) + (:addl 4 :edx) + (:subl 1 (:eax :edx (:offset movitz-bignum bigit0 -4))) + (:jc 'carry-propagate-loop) + sub-bignum-done))) + (do-it))))) + +(defun %bignum-set-zerof (bignum) + (check-type bignum bignum) + (dotimes (i (logior 1 (%bignum-bigits bignum))) + (setf (memref bignum -2 i :lisp) 0)) + bignum) + +(defun %bignum= (x y) + (compiler-macro-call %bignum= x y)) + +(defun %bignum< (x y) + (compiler-macro-call %bignum< x y))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by Frode Vatvedt Fjeld 18 Jul '04

18 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29223 Modified Files: arithmetic-macros.lisp Log Message: Wrote %bignum-compare, %bignum< and %bignum= compiler-macros. Date: Sun Jul 18 01:45:17 2004 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.1 movitz/losp/muerte/arithmetic-macros.lisp:1.2 --- movitz/losp/muerte/arithmetic-macros.lisp:1.1 Sat Jul 17 05:16:03 2004 +++ movitz/losp/muerte/arithmetic-macros.lisp Sun Jul 18 01:45:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.1 2004/07/17 12:16:03 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.2 2004/07/18 08:45:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -400,3 +400,48 @@ (expt (movitz:movitz-eval base-number env) (movitz:movitz-eval power-number env)))) + +(define-compiler-macro %bignum-compare (x y) + "Set ZF and CF according to (:cmpl y x), disregarding sign." + `(with-inline-assembly (:returns :nothing :labels (eax-shortest-loop + ebx-shortest-loop + equal-length-loop + done)) + (:compile-two-forms (:eax :ebx) ,x ,y) + (:xorl :ecx :ecx) + (:xorl :edx :edx) + (:movw (:eax (:offset movitz-bignum length)) :cx) + (:movw (:ebx (:offset movitz-bignum length)) :dx) + (:cmpl :ecx :edx) + (:je 'equal-length-loop) + (:jnc 'eax-shortest-loop) + ebx-shortest-loop + (:cmpl 0 (:eax :ecx (:offset movitz-bignum bigit0 -4))) + (:jne 'done) + (:subl 4 :ecx) + (:cmpl :edx :ecx) + (:jne 'ebx-shortest-loop) + (:jmp 'equal-length-loop) + eax-shortest-loop + (:cmpl 0 (:ebx :edx (:offset movitz-bignum bigit0 -4))) + (:cmc) ; Complement CF + (:jne 'done) + (:subl 4 :edx) + (:cmpl :edx :ecx) + (:jne 'eax-shortest-loop) + equal-length-loop ; Compare from EDX down + (:subl 4 :edx) + (:movl (:eax :edx (:offset movitz-bignum bigit0)) :ecx) + (:cmpl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) + (:jne 'done) + (:testl :edx :edx) + (:jnz 'equal-length-loop) + done)) + +(define-compiler-macro %bignum< (x y) + `(with-inline-assembly (:returns :boolean-below) + (:compile-form (:result-mode :ignore) (%bignum-compare ,x ,y)))) + +(define-compiler-macro %bignum= (x y) + `(with-inline-assembly (:returns :boolean-zf=1) + (:compile-form (:result-mode :ignore) (%bignum-compare ,x ,y))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 17 Jul '04

17 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28608 Modified Files: integers.lisp Log Message: Started work on improving * and truncate for bignums by using destructive bignum operators for the temporaries. Date: Sat Jul 17 15:34:38 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.74 movitz/losp/muerte/integers.lisp:1.75 --- movitz/losp/muerte/integers.lisp:1.74 Sat Jul 17 14:36:34 2004 +++ movitz/losp/muerte/integers.lisp Sat Jul 17 15:34:38 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.74 2004/07/17 21:36:34 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.75 2004/07/17 22:34:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1098,6 +1098,15 @@ (if (< x y) (* y x) ;; X is the biggest factor. + #-movitz-reference-code + (do ((r (%bignum-set-zerof (%make-bignum (ceiling (+ (integer-length x) + (integer-length y)) + 32)))) + (length (integer-length y)) + (i 0 (+ i 29))) + ((>= i length) (%bignum-canonicalize r)) + (setf r (%bignum-addf r (ash (* x (ldb (byte 29 i) y)) i)))) + #+movitz-reference-code (do ((r 0) (length (integer-length y)) (i 0 (+ i 29))) @@ -1238,27 +1247,47 @@ (cond ((= number divisor) (values 1 0)) ((< number divisor) (values 0 number)) - (t (let* ((guess-pos (- (integer-length divisor) 29)) - (msb (ldb (byte 29 guess-pos) divisor))) - (when (eq msb most-positive-fixnum) - (decf guess-pos) - (setf msb (ash msb -1))) - (incf msb) - (do ((q 0) - (r number)) - ((< r divisor) - (assert (and (not (minusp r)) (not (minusp q))) () - "(trunc ~S ~S) r: ~S q: ~S" number divisor r q) -;;; (assert (= number (+ r (* q divisor))) () -;;; "trunc failed: q: ~S R: ~S" q r) - (values q r)) - (let* ((guess (ash (truncate r msb) (- guess-pos)))) - (let ((delta (* guess divisor))) - (if (= 0 guess) - (setf q (1+ q) - r (- r divisor)) - (setf q (+ q guess) - r (- r delta)))))))))) + (t + #-movitz-reference-code + (let* ((guess-pos (- (integer-length divisor) 29)) + (msb (ldb (byte 29 guess-pos) divisor))) + (when (eq msb most-positive-fixnum) + (decf guess-pos) + (setf msb (ash msb -1))) + (incf msb) + (do ((shift (- guess-pos)) + (q (%bignum-set-zerof (%make-bignum (ceiling (- (integer-length number) + (integer-length divisor)) + 32)))) + (r number)) + ((< r divisor) + (values (%bignum-canonicalize q) + r)) + (let* ((guess (ash (truncate r msb) shift))) + (let ((delta (* guess divisor))) + (if (= 0 delta) + (setf q (%bignum-addf-fixnum q 1) + r (- r divisor)) + (setf q (%bignum-addf q guess) + r (- r delta))))))) + #+movitz-reference-code + (let* ((guess-pos (- (integer-length divisor) 29)) + (msb (ldb (byte 29 guess-pos) divisor))) + (when (eq msb most-positive-fixnum) + (decf guess-pos) + (setf msb (ash msb -1))) + (incf msb) + (do ((q 0) + (r number)) + ((< r divisor) + (values q r)) + (let* ((guess (ash (truncate r msb) (- guess-pos)))) + (let ((delta (* guess divisor))) + (if (= 0 guess) + (setf q (1+ q) + r (- r divisor)) + (setf q (+ q guess) + r (- r delta)))))))))) (((integer * -1) (integer 0 *)) (multiple-value-bind (q r) (truncate (- number) divisor)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 17 Jul '04

17 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17537 Modified Files: integers.lisp Log Message: Changed assembly stubs to use :offset assembly-macro. Date: Sat Jul 17 14:36:34 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.73 movitz/losp/muerte/integers.lisp:1.74 --- movitz/losp/muerte/integers.lisp:1.73 Sat Jul 17 12:30:20 2004 +++ movitz/losp/muerte/integers.lisp Sat Jul 17 14:36:34 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.73 2004/07/17 19:30:20 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.74 2004/07/17 21:36:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -65,7 +65,7 @@ (:cmpb ,(movitz:tag :bignum) :cl) (:jne 'n2-not-bignum) - (:cmpb :ch (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::sign))) + (:cmpb :ch (:eax (:offset movitz-bignum sign))) (:jne '(:sub-program (different-signs) ;; Comparing the sign-bytes sets up EFLAGS correctly! (:ret))) @@ -74,7 +74,7 @@ ;; Both n1 and n2 are positive bignums. (:shrl 16 :ecx) - (:cmpw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length))) + (:cmpw :cx (:eax (:offset movitz-bignum length))) (:jne '(:sub-program (positive-different-sizes) (:ret))) @@ -83,25 +83,21 @@ positive-compare-loop (:subl ,movitz:+movitz-fixnum-factor+ :edx) (:jz 'positive-compare-lsb) - (:movl (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) - :ecx) - (:cmpl :ecx - (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) + (:cmpl :ecx (:eax :edx (:offset movitz-bignum bigit0))) (:je 'positive-compare-loop) positive-compare-lsb ;; Now we have to make the compare act as unsigned, which is why ;; we compare zero-extended 16-bit quantities. - (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) - :ecx) ; First compare upper 16 bits. + (:movzxw (:ebx :edx (:offset movitz-bignum bigit0 2)) :ecx) ; First compare upper 16 bits. (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) - (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) - :ecx) + (:movzxw (:eax :edx (:offset movitz-bignum bigit0 2)) :ecx) (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx)) (:jne 'upper-16-decisive) - (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movzxw (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) ; Then compare lower 16 bits. (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) - (:movzxw (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movzxw (:eax :edx (:offset movitz-bignum bigit0)) :ecx) ; Then compare lower 16 bits. (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx)) upper-16-decisive @@ -111,7 +107,7 @@ ;; Moth n1 and n2 are negative bignums. (:shrl 16 :ecx) - (:cmpw (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)) :cx) + (:cmpw (:eax (:offset movitz-bignum length)) :cx) (:jne '(:sub-program (negative-different-sizes) (:ret))) @@ -120,26 +116,23 @@ negative-compare-loop (:subl ,movitz:+movitz-fixnum-factor+ :edx) (:jz 'negative-compare-lsb) - (:movl (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) - :ecx) - (:cmpl :ecx - (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl (:eax :edx (:offset movitz-bignum bigit0)) :ecx) + (:cmpl :ecx (:ebx :edx (:offset movitz-bignum bigit0))) (:je 'negative-compare-loop) (:ret) negative-compare-lsb ; it's down to the LSB bigits. ;; Now we have to make the compare act as unsigned, which is why ;; we compare zero-extended 16-bit quantities. - (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movzxw (:ebx :edx (:offset movitz-bignum bigit0 2)) :ecx) ; First compare upper 16 bits. (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) - (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) - :ecx) + (:movzxw (:eax :edx (:offset movitz-bignum bigit0)) :ecx) (:locally (:cmpl :ecx (:edi (:edi-offset scratch0)))) (:jne 'negative-upper-16-decisive) - (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movzxw (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) ; Then compare lower 16 bits. (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) - (:movzxw (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movzxw (:eax :edx (:offset movitz-bignum bigit0)) :ecx) ; Then compare lower 16 bits. (:locally (:cmpl :ecx (:edi (:edi-offset scratch0)))) negative-upper-16-decisive @@ -171,10 +164,8 @@ compare-loop (:subl ,movitz:+movitz-fixnum-factor+ :edx) (:jz 'done) - (:movl (:eax :edx ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) - :ecx) - (:cmpl :ecx - (:ebx :edx ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) + (:movl (:eax :edx (:offset movitz-bignum bigit0 -4)) :ecx) + (:cmpl :ecx (:ebx :edx (:offset movitz-bignum bigit0 -4))) (:je 'compare-loop) done (:ret)))) @@ -459,18 +450,18 @@ (: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) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:cmpl ,movitz:+movitz-fixnum-factor+ :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 (:offset movitz-bignum bigit0)) :ecx) (:jc 'retry-not-size1) (:call-local-pf 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) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) not-size1 (:declare-label-set retry-jumper (retry-not-size1)) (:locally (:movl :esp (:edi (:edi-offset atomically-esp)))) @@ -481,7 +472,7 @@ :eax) ; Number of words (:call-local-pf get-cons-pointer) (:load-lexical (:lexical-binding y) :ebx) ; bignum - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :edx) (:movl 0 (:eax :edx ,movitz:+other-type-offset+)) ; MSB @@ -494,18 +485,16 @@ (:load-lexical (:lexical-binding x) :ecx) (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:xorl :ebx :ebx) - (:addl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:addl :ecx (:eax (:offset movitz-bignum bigit0))) (:jnc 'add-bignum-done) add-bignum-loop (:addl 4 :ebx) - (:addl 1 (:eax :ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:addl 1 (:eax :ebx (:offset movitz-bignum bigit0))) (:jc 'add-bignum-loop) add-bignum-done - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) - :ecx) - (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) - :ecx) - (:cmpl 0 (:eax :ecx ,(+ -4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) + (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :ecx) + (:cmpl 0 (:eax :ecx (:offset movitz-bignum bigit0 -4))) (:je 'no-expansion) (:addl #x40000 (:eax ,movitz:+other-type-offset+)) (:addl ,movitz:+movitz-fixnum-factor+ :ecx) @@ -526,17 +515,17 @@ no-expansion pfix-pbig-done)) (:compile-two-forms (:eax :ebx) y x) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:cmpl 4 :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 (:offset movitz-bignum bigit0)) :ecx) (:call-local-pf 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) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) not-size1 (:declare-label-set retry-jumper (retry-not-size1)) (:locally (:movl :esp (:edi (:edi-offset atomically-esp)))) @@ -547,7 +536,7 @@ :eax) ; Number of words (:call-local-pf get-cons-pointer) (:load-lexical (:lexical-binding y) :ebx) ; bignum - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :edx) copy-bignum-loop @@ -560,18 +549,18 @@ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:xorl :ebx :ebx) ; counter (:negl :ecx) - (:subl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:subl :ecx (:eax (:offset movitz-bignum bigit0))) (:jnc 'add-bignum-done) add-bignum-loop (:addl 4 :ebx) - (:subl 1 (:eax :ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:subl 1 (:eax :ebx (:offset movitz-bignum bigit0))) (:jc 'add-bignum-loop) add-bignum-done - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :ecx) ; result bignum word-size - (:cmpl 0 (:eax :ecx ,(+ -8 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:cmpl 0 (:eax :ecx (:offset movitz-bignum bigit0 -8))) (:jne 'no-expansion) (:subl #x40000 (:eax ,movitz:+other-type-offset+)) (:subl ,movitz:+movitz-fixnum-factor+ :ecx) @@ -595,17 +584,17 @@ (: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) + (:movzxw (:eax (:offset movitz-bignum 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) + (:movl (:ebx (:offset movitz-bignum bigit0)) :ecx) + (:addl (:eax (:offset movitz-bignum bigit0)) :ecx) (:jc 'retry-not-size1) (:call-local-pf 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) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) not-size1 (:declare-label-set retry-jumper (retry-not-size1)) (:locally (:movl :esp (:edi (:edi-offset atomically-esp)))) @@ -616,7 +605,7 @@ :eax) ; Number of words (:call-local-pf get-cons-pointer) (:load-lexical (:lexical-binding y) :ebx) ; bignum - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :edx) (:movl 0 (:eax :edx ,movitz:+other-type-offset+)) ; MSB @@ -630,37 +619,37 @@ (:xorl :edx :edx) ; counter (:xorl :ecx :ecx) ; Carry add-bignum-loop - (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:ebx (:offset movitz-bignum length))) (:jbe '(:sub-program (zero-padding-loop) - (:addl :ecx (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum - 'movitz::bigit0))) + (:addl :ecx (:eax :edx (:offset movitz-bignum + bigit0))) (:sbbl :ecx :ecx) (:negl :ecx) ; ECX = Add's Carry. (:addl 4 :edx) - (:cmpw :dx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:eax (:offset movitz-bignum length))) (:jae 'zero-padding-loop) (:jmp 'add-bignum-done))) - (:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + (:addl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) (:jc '(:sub-program (term1-carry) ;; The digit + carry carried over, ECX = 0 (:addl 1 :ecx) (:addl 4 :edx) - (:cmpw :dx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:eax (:offset movitz-bignum length))) (:jae 'add-bignum-loop) (:jmp 'add-bignum-done))) - (:addl :ecx (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:addl :ecx (:eax :edx (:offset movitz-bignum bigit0))) (:sbbl :ecx :ecx) (:negl :ecx) ; ECX = Add's Carry. (:addl 4 :edx) - (:cmpw :dx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:eax (:offset movitz-bignum length))) (:jae 'add-bignum-loop) add-bignum-done - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :ecx) - (:cmpl 0 (:eax :ecx ,(+ -4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:cmpl 0 (:eax :ecx (:offset movitz-bignum bigit0 -4))) (:je 'no-expansion) (:addl #x40000 (:eax ,movitz:+other-type-offset+)) (:addl ,movitz:+movitz-fixnum-factor+ :ecx) @@ -712,8 +701,7 @@ (:jne 'not-a-number) (:cmpl ,(dpb 4 (byte 16 16) (movitz:tag :bignum 0)) :ecx) (:jne 'not-most-negative-fixnum) - (:cmpl ,(- most-negative-fixnum) - (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:cmpl ,(- most-negative-fixnum) (:eax (:offset movitz-bignum bigit0))) (:jne 'not-most-negative-fixnum) (:movl ,(ldb (byte 32 0) (* most-negative-fixnum movitz::+movitz-fixnum-factor+)) @@ -722,7 +710,7 @@ not-most-negative-fixnum (:compile-form (:result-mode :eax) (copy-bignum x)) - (:notb (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::sign))) + (:notb (:eax (:offset movitz-bignum sign))) (:jmp 'fix-ok))) (:negl :eax) (:jo '(:sub-program (fix-overflow) @@ -762,28 +750,26 @@ (:xorl :edx :edx) ; counter (:xorl :ecx :ecx) ; carry sub-loop - (:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + (:addl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) (:jc '(:sub-program (carry-overflow) ;; Just propagate carry (:addl 1 :ecx) (:addl 4 :edx) - (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:ebx (:offset movitz-bignum length))) (:jne 'sub-loop) (:jmp 'bignum-sub-done))) - (:subl :ecx - (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:subl :ecx (:eax :edx (:offset movitz-bignum bigit0))) (:sbbl :ecx :ecx) (:negl :ecx) (:addl 4 :edx) - (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:ebx (:offset movitz-bignum length))) (:jne 'sub-loop) - (:subl :ecx - (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:subl :ecx (:eax :edx (:offset movitz-bignum bigit0))) (:jnc 'bignum-sub-done) propagate-carry (:addl 4 :edx) - (:subl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:subl 1 (:eax :edx (:offset movitz-bignum bigit0))) (:jc 'propagate-carry) bignum-sub-done ))))) @@ -950,11 +936,11 @@ ((do-it () `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :ebx) integer) - (:movzxw (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,(* -1 movitz:+movitz-fixnum-factor+)) :eax) ; bigits-1 - (:bsrl (:ebx (:ecx 1) ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:bsrl (:ebx (:ecx 1) (:offset movitz-bignum bigit0 -4)) :ecx) (:shll 5 :eax) ; bits = bigits*32 + (bit-index+1) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) :eax @@ -998,21 +984,21 @@ (byte 16 16) (movitz:tag :bignum 0)) (:eax ,movitz:+other-type-offset+)) (:load-lexical (:lexical-binding d0) :ecx) - (:movl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:movl :ecx (:eax (:offset movitz-bignum bigit0))) (:load-lexical (:lexical-binding d1) :ecx) (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:shrdl ,movitz:+movitz-fixnum-shift+ :ecx - (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:eax (:offset movitz-bignum bigit0))) (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:movl :ecx (:eax ,(+ 4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:movl :ecx (:eax (:offset movitz-bignum bigit0 4))) (:jns 'fixnum-done) ;; if result was negative, we must negate bignum - (:notl (:eax ,(+ 4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) - (:negl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:notl (:eax (:offset movitz-bignum bigit0 4))) + (:negl (:eax (:offset movitz-bignum bigit0))) (:cmc) - (:adcl 0 (:eax ,(+ 4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:adcl 0 (:eax (:offset movitz-bignum bigit0 4))) (:xorl #xff00 (:eax ,movitz:+other-type-offset+)) (:jmp 'fixnum-done) @@ -1053,7 +1039,7 @@ (:edi (:edi-offset atomically-status)))) (:compile-form (:result-mode :eax) y) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+)) :eax) @@ -1074,28 +1060,23 @@ (:negl :esi) ; can't overflow multiply-loop (:movl :edx (:ebx (:ecx 1) ; new - ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:offset movitz-bignum bigit0))) (:compile-form (:result-mode :ebx) y) - (:movl (:ebx (:ecx 1) ; old - ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + (:movl (:ebx (:ecx 1) (:offset movitz-bignum bigit0)) :eax) (:mull :esi :eax :edx) (:compile-form (:result-mode :ebx) r) - (:addl :eax - (:ebx (:ecx 1) - ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:addl :eax (:ebx :ecx (:offset movitz-bignum bigit0))) (:adcl 0 :edx) (:addl 4 :ecx) - (:cmpw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:ja 'multiply-loop) (:testl :edx :edx) (:jz 'no-carry-expansion) - (:movl :edx - (:ebx (:ecx 1) - ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:movl :edx (:ebx :ecx (:offset movitz-bignum bigit0))) (:addl 4 :ecx) - (:movw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:movw :cx (:ebx (:offset movitz-bignum length))) no-carry-expansion (:movl (:ebp -4) :esi) (:movl :ebx :eax) @@ -1167,12 +1148,12 @@ (with-inline-assembly (:returns :multiple-values) (:compile-form (:result-mode :ebx) number) (:cmpw ,movitz:+movitz-fixnum-factor+ - (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:ebx (:offset movitz-bignum 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) + (:movl (:ebx (:offset movitz-bignum bigit0)) :eax) (:xorl :edx :edx) (:divl :ecx :eax :edx) (:movl :eax :ecx) @@ -1185,7 +1166,7 @@ (:jmp 'done) not-size1 (:compile-form (:result-mode :ebx) number) - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:declare-label-set retry-jumper (not-size1)) @@ -1212,13 +1193,11 @@ divide-loop (:load-lexical (:lexical-binding number) :ebx) - (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) - -4 (:ecx 1)) + (:movl (:ebx :ecx (:offset movitz-bignum bigit0 -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 1))) + (:movl :eax (:ebx :ecx (:offset movitz-bignum bigit0 -4))) (:subl 4 :ecx) (:jnz 'divide-loop) (:movl :edi :eax) ; safe value @@ -1228,21 +1207,21 @@ (:movl :ebx :eax) (:movl :edx :ebx) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :ecx) - (:cmpl 0 (:eax :ecx ,(+ -8 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:cmpl 0 (:eax :ecx (:offset movitz-bignum bigit0 -8))) (:jne 'no-more-shrinkage) - (:subw 4 (:eax #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:subw 4 (:eax (:offset movitz-bignum 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))) + (:eax (:offset movitz-bignum bigit0))) (:jnc 'no-more-shrinkage) - (:movl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + (:movl (:eax (:offset movitz-bignum bigit0)) :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) (:jmp 'fixnum-result) ; don't commit the bignum @@ -1396,7 +1375,7 @@ (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)))))))) + (:btl :ecx (:ebx (:offset movitz-bignum bigit0)))))))) (do-it))) (defun logand (&rest integers) @@ -1430,14 +1409,14 @@ (%bignum-canonicalize (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) (copy-bignum x) y) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) -4) :edx) pb-pb-and-loop - (:movl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + (:movl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) (:andl :ecx - (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:eax :edx (:offset movitz-bignum bigit0))) (:subl 4 :edx) (:jnc 'pb-pb-and-loop))))) ))) @@ -1468,21 +1447,19 @@ (:compile-two-forms (:eax :ecx) (copy-bignum integer2) integer1) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) (:notl :ecx) - (:andl :ecx - (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))))) + (:andl :ecx (:eax (:offset movitz-bignum bigit0)))))) ((positive-bignum positive-bignum) (%bignum-canonicalize (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) (copy-bignum integer2) integer1) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:eax (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) -4) :edx) pb-pb-andc1-loop - (:movl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) + (:movl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) (:notl :ecx) - (:andl :ecx - (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + (:andl :ecx (:eax :edx (:offset movitz-bignum bigit0))) (:subl 4 :edx) (:jnc 'pb-pb-andc1-loop))))))) (do-it))) @@ -1507,7 +1484,7 @@ (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ecx) r x) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) - (:orl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))) + (:orl :ecx (:eax (:offset movitz-bignum bigit0))))))) (do-it))) ((positive-bignum positive-fixnum) (macrolet @@ -1516,7 +1493,7 @@ (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ecx) r y) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) - (:orl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))) + (:orl :ecx (:eax (:offset movitz-bignum bigit0))))))) (do-it))) ((positive-bignum positive-bignum) (if (< (%bignum-bigits x) (%bignum-bigits y)) @@ -1526,15 +1503,15 @@ ((do-it () `(with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) r y) - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1) ,(* -1 movitz:+movitz-fixnum-factor+)) :edx) ; EDX is loop counter or-loop - (:movl (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) (:orl :ecx - (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:eax :edx (:offset movitz-bignum bigit0))) (:subl 4 :edx) (:jnc 'or-loop)))) (do-it))))))) @@ -1561,8 +1538,7 @@ `(with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ecx) (copy-bignum y) x) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) - (:xorl :ecx - (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))))) + (:xorl :ecx (:eax (:offset movitz-bignum bigit0)))))) (do-it))) ((positive-bignum positive-fixnum) (macrolet @@ -1570,8 +1546,7 @@ `(with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ecx) (copy-bignum x) y) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) - (:xorl :ecx - (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))))) + (:xorl :ecx (:eax (:offset movitz-bignum bigit0)))))) (do-it))) ((positive-bignum positive-bignum) (if (< (%bignum-bigits x) (%bignum-bigits y)) @@ -1582,15 +1557,14 @@ `(%bignum-canonicalize (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) r y) - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:leal ((:ecx 1),(* -1 movitz:+movitz-fixnum-factor+)) :edx) ; EDX is loop counter xor-loop - (:movl (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movl (:ebx :edx (:offset movitz-bignum bigit0)) :ecx) - (:xorl :ecx - (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:xorl :ecx (:eax :edx (:offset movitz-bignum bigit0))) (:subl 4 :edx) (:jnc 'xor-loop) )))) @@ -1666,15 +1640,14 @@ ;; Have fresh bignum in EAX, now fill it with ones. (:xorl :ecx :ecx) ; counter fill-ones-loop - (:movl #xffffffff - (:eax (:ecx 1) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl #xffffffff (:eax :ecx (:offset movitz-bignum bigit0))) (:addl 4 :ecx) - (:cmpw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length))) + (:cmpw :cx (:eax (:offset movitz-bignum length))) (:jne 'fill-ones-loop) (:popl :ecx) ; The LSB bigit. (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:movl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl :ecx (:eax (:offset movitz-bignum bigit0))) (:movl :eax :ebx) ;; Compute MSB bigit mask in EDX (:compile-form (:result-mode :ecx) size) @@ -1687,10 +1660,10 @@ (:shll :cl :edx) fixnum-mask-ok (:subl 1 :edx) - (:movzxw (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) (:andl :edx ; And EDX with the MSB bigit. - (:ebx (:ecx 1) ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) + (:ebx :ecx (:offset movitz-bignum bigit0 -4))) (:movl :edi :edx) (:movl :edi :eax) (:cld) ; =================> CLD @@ -1723,17 +1696,17 @@ (:addl 4 :ecx) (:cmpl #x4000 :ecx) (:jae 'position-outside-integer) - (:cmpw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:jc '(:sub-program (position-outside-integer) - (:movsxb (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::sign)) :ecx) + (:movsxb (:ebx (:offset movitz-bignum sign)) :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) (:jmp 'done-u32))) (:std) - (:movl (:ebx (:ecx 1) ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl (:ebx :ecx (:offset movitz-bignum bigit0 -4)) :eax) (:movl 0 :edx) ; If position was in last bigit.. (don't touch EFLAGS) (:je 'no-top-bigit) ; ..we must zero-extend rather than read top bigit. - (:movl (:ebx (:ecx 1) ,(+ 0 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl (:ebx :ecx (:offset movitz-bignum bigit0)) :edx) ; Read top bigit into EDX no-top-bigit (:testl #xff00 (:ebx ,movitz:+other-type-offset+)) @@ -1765,7 +1738,7 @@ (byte 16 16) (movitz:tag :bignum 0)) (:ebx ,movitz:+other-type-offset+)) (:jne 'cant-return-same) - (:cmpl :ecx (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:cmpl :ecx (:ebx (:offset movitz-bignum bigit0))) (:jne 'cant-return-same) (:movl :ebx :eax) (:jmp 'done-u32) @@ -1783,9 +1756,9 @@ (:shrl 5 :ecx) ; compute fixnum bigit-number in ecx (:cmpl #x4000 :ecx) (:jnc 'position-outside-integer) - (:cmpw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:jbe '(:sub-program (position-outside-integer) - (:movsxb (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::sign)) :ecx) + (:movsxb (:ebx (:offset movitz-bignum sign)) :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) (:jmp 'done-u32))) @@ -1795,7 +1768,7 @@ (:into) ; just to make sure (:shrl 5 :ecx) ; compute msb bigit index/fixnum in ecx (:addl 4 :ecx) - (:cmpw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :cx (:ebx (:offset movitz-bignum length))) (je '(:sub-program (equal-size-maybe-return-same) (:testl :edx :edx) ; Can only return same if (zerop position). (:jnz 'adjust-size) @@ -1807,10 +1780,9 @@ ;; we know EDX=0, now generate mask in EDX (:addl 1 :edx) (:shll :cl :edx) - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) - (:cmpl :edx (:ebx (:ecx 1) - ,(+ -4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))) + (:cmpl :edx (:ebx :ecx (:offset movitz-bignum bigit0 -4))) (:movl 0 :edx) ; Safe value, and correct if we need to go to adjust-size. (:cld) ; =================> (:jnc 'adjust-size) ; nope, we have to generate a new bignum. @@ -1827,7 +1799,7 @@ adjust-size ;; The bytespec is (partially) outside source-integer, so we make the ;; size smaller before proceeding. new-size = (- source-int-length position) - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) ; length of source-integer (:shll 5 :ecx) ; fixnum bit-position (:xorl :eax :eax) ; In case the new size is zero. @@ -1868,37 +1840,36 @@ ;; Edge case: When size(old)=size(new), the tail-tmp must be zero. ;; We check here, setting the tail-tmp to a mask for and-ing below. - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) ; length of source-integer ;; Initialize tail-tmp to #xffffffff, meaning copy from source-integer. - (:movl #xffffffff - (:ebx (:ecx 1) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) - (:cmpw :cx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:movl #xffffffff (:ebx :ecx (:offset movitz-bignum bigit0))) + (:cmpw :cx (:eax (:offset movitz-bignum length))) (:jc '(:sub-program (result-too-big-shouldnt-happen) (:break))) (:jne 'tail-tmp-ok) ;; Sizes was equal, so set tail-tmp to zero. - (:movl 0 (:ebx (:ecx 1) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl 0 (:ebx :ecx (:offset movitz-bignum bigit0))) tail-tmp-ok ;; Now copy the relevant part of the integer (:std) (:compile-form (:result-mode :ecx) position) (:sarl ,(+ 5 movitz:+movitz-fixnum-shift+) :ecx) ; compute bigit-number in ecx ;; We can use primitive pointers because we're both inside atomically and std. - (:leal (:eax (:ecx 4) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:leal (:eax (:ecx 4) (:offset movitz-bignum bigit0)) :eax) ; Use EAX as primitive pointer into source (:xorl :ecx :ecx) ; counter copy-integer (:movl (:eax) :edx) (:addl 4 :eax) - (:movl :edx (:ebx (:ecx 1) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl :edx (:ebx :ecx (:offset movitz-bignum bigit0))) (:addl 4 :ecx) - (:cmpw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:jne 'copy-integer) ;; Copy one more than the length, namely the tmp at the end. ;; Tail-tmp was initialized to a bit-mask above. (:movl (:eax) :edx) - (:andl :edx (:ebx (:ecx 1) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:andl :edx (:ebx :ecx (:offset movitz-bignum bigit0))) ;; Copy done, now shift (:compile-form (:result-mode :ecx) position) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) @@ -1906,16 +1877,16 @@ (:jz 'shift-done) ; if (zerop (mod position 32)), no shift needed. (:xorl :edx :edx) ; counter shift-loop - (:movl (:ebx (:edx 1) ,(+ 4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:movl (:ebx :edx (:offset movitz-bignum bigit0 4)) :eax) ; Next bigit into eax (:shrdl :cl :eax ; Now shift bigit, with msbs from eax. - (:ebx (:edx 1) ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:ebx :edx (:offset movitz-bignum bigit0))) (:addl 4 :edx) - (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:cmpw :dx (:ebx (:offset movitz-bignum length))) (:jne 'shift-loop) shift-done ;; Now we must mask MSB bigit. - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :edx) (:popl :ecx) ; (new) bytespec size (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) @@ -1924,18 +1895,16 @@ (:movl 1 :eax) ; Generate mask in EAX (:shll :cl :eax) (:subl 1 :eax) - (:andl :eax - (:ebx (:edx 1) ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) + (:andl :eax (:ebx :edx (:offset movitz-bignum bigit0 -4))) mask-done ;; (:movl :edi :edx) ; safe EDX (:movl :edi :eax) ; safe EAX (:cld) ;; Now we must zero-truncate the result bignum in EBX. - (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + (:movzxw (:ebx (:offset movitz-bignum length)) :ecx) zero-truncate-loop - (:cmpl 0 (:ebx (:ecx 1) - ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) + (:cmpl 0 (:ebx :ecx (:offset movitz-bignum bigit0 -4))) (:jne 'zero-truncate-done) (:subl 4 :ecx) (:jnz 'zero-truncate-loop) @@ -1946,16 +1915,16 @@ (:cmpl 4 :ecx) ; If result size is 1, the result might have.. (:jne 'complete-bignum-allocation) ; ..collapsed to a fixnum. (:cmpl ,movitz:+movitz-most-positive-fixnum+ - (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:ebx (:offset movitz-bignum bigit0))) (:ja 'complete-bignum-allocation) - (:movl (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + (:movl (:ebx (:offset movitz-bignum bigit0)) :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) (:jmp 'return-fixnum) complete-bignum-allocation - (:movw :cx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length))) + (:movw :cx (:ebx (:offset movitz-bignum length))) (:movl :ebx :eax) - (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) + (:leal (:ecx ,movitz:+movitz-fixnum-factor+) :ecx) (:call-local-pf cons-commit) return-fixnum

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/common-lisp.lisp
by Frode Vatvedt Fjeld 17 Jul '04

17 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18529 Modified Files: common-lisp.lisp Log Message: *** empty log message *** Date: Sat Jul 17 14:27:16 2004 Author: ffjeld Index: movitz/losp/muerte/common-lisp.lisp diff -u movitz/losp/muerte/common-lisp.lisp:1.9 movitz/losp/muerte/common-lisp.lisp:1.10 --- movitz/losp/muerte/common-lisp.lisp:1.9 Sat Jul 17 12:30:14 2004 +++ movitz/losp/muerte/common-lisp.lisp Sat Jul 17 14:27:16 2004 @@ -9,12 +9,11 @@ ;;;; Created at: Wed Nov 8 18:41:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: common-lisp.lisp,v 1.9 2004/07/17 19:30:14 ffjeld Exp $ +;;;; $Id: common-lisp.lisp,v 1.10 2004/07/17 21:27:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (require :muerte/basic-macros) - (require :muerte/setf) (require :muerte/more-macros) (require :muerte/arithmetic-macros)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 17 Jul '04

17 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6109 Modified Files: inspect.lisp Log Message: Moved some operators to bignums.lisp. Date: Sat Jul 17 12:32:16 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.24 movitz/losp/muerte/inspect.lisp:1.25 --- movitz/losp/muerte/inspect.lisp:1.24 Fri Jul 16 18:52:29 2004 +++ movitz/losp/muerte/inspect.lisp Sat Jul 17 12:32:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.24 2004/07/17 01:52:29 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.25 2004/07/17 19:32:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -258,74 +258,3 @@ #.(movitz::movitz-type-word-size :movitz-struct) (* 2 (truncate (+ (structure-object-length object) 1) 2)))))))) -(defun %bignum-bigits (x) - (%bignum-bigits x)) - -(defun %bignum-canonicalize (x) - "Assuming x is a bignum, return the canonical integer value. That is, -either return a fixnum, or destructively modify the bignum's length so -that the msb isn't zero. DO NOT APPLY TO NON-BIGNUM VALUES!" - (check-type x bignum) - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax) - (:load-lexical (:lexical-binding x) :eax) - (:movl (:eax ,movitz:+other-type-offset+) :ecx) - (:shrl 16 :ecx) - (:jz '(:sub-program (should-never-happen) - (:int 107))) - shrink-loop - (:cmpl 4 :ecx) - (:je 'shrink-no-more) - (:cmpl 0 (:eax :ecx ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) - (:jnz 'shrink-done) - (:subl 4 :ecx) - (:jmp 'shrink-loop) - shrink-no-more - (:cmpl ,(1+ movitz:+movitz-most-positive-fixnum+) - (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) - (:jc '(:sub-program (fixnum-result) - (:movl (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) - :ecx) - (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) - (:jmp 'done))) - shrink-done - (:testb 3 :cl) - (:jnz '(:sub-program () (:int 107))) - (:testw :cx :cx) - (:jz '(:sub-program () (:int 107))) - (:movw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length))) - done - ))) - (do-it))) - -(defun copy-bignum (old) - (check-type old bignum) - (let* ((length (%bignum-bigits old)) - (new (malloc-non-pointer-words (1+ length)))) - (with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ebx) new old) - (:compile-form (:result-mode :edx) length) - copy-bignum-loop - (:movl (:ebx :edx #.movitz:+other-type-offset+) :ecx) - (:movl :ecx (:eax :edx #.movitz:+other-type-offset+)) - (:subl 4 :edx) - (:jnc 'copy-bignum-loop)))) - -(defun %make-bignum (bigits) - (assert (plusp bigits)) - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ecx) (malloc-non-pointer-words (1+ bigits)) bigits) - (:shll 16 :ecx) - (:orl ,(movitz:tag :bignum 0) :ecx) - (:movl :ecx (:eax ,movitz:+other-type-offset+))))) - (do-it))) - -(defun print-bignum (x) - (check-type x bignum) - (dotimes (i (1+ (%bignum-bigits x))) - (format t "~8,'0X " (memref x -6 i :unsigned-byte32))) - (terpri) - (values))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 17 Jul '04

17 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24946 Modified Files: integers.lisp Log Message: Factored out bignum-related operators from integers.lisp to bignums.lisp. Date: Sat Jul 17 12:30:20 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.72 movitz/losp/muerte/integers.lisp:1.73 --- movitz/losp/muerte/integers.lisp:1.72 Sat Jul 17 10:42:10 2004 +++ movitz/losp/muerte/integers.lisp Sat Jul 17 12:30:20 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.72 2004/07/17 17:42:10 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.73 2004/07/17 19:30:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,7 +23,6 @@ (defconstant most-positive-fixnum #.movitz::+movitz-most-positive-fixnum+) (defconstant most-negative-fixnum #.movitz::+movitz-most-negative-fixnum+) - ;;; Comparison (define-primitive-function fast-compare-two-reals (n1 n2) @@ -413,84 +412,6 @@ (:xorl #xff00 (:eax #.movitz:+other-type-offset+))))))) ;;; Addition - -(defun %bignum-addf-fixnum (bignum delta) - "Destructively add a fixnum delta (negative or positive) to an (unsigned) bignum." - (check-type delta fixnum) - (check-type bignum bignum) - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax :labels (add-bignum-loop add-bignum-done)) - (:load-lexical (:lexical-binding delta) :ecx) - (:load-lexical (:lexical-binding bignum) :eax) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ebx) ; length - (:xorl :edx :edx) ; counter - (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:jns 'positive-delta) - ;; negative-delta - (:negl :ecx) - (:subl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jnc 'add-bignum-done) - sub-bignum-loop - (:addl 4 :edx) - (:cmpl :edx :ebx) - (:je '(:sub-program (overflow) (:int 4))) - (:subl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jc 'sub-bignum-loop) - (:jmp 'add-bignum-done) - - positive-delta - (:addl :ecx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jnc 'add-bignum-done) - add-bignum-loop - (:addl 4 :edx) - (:cmpl :edx :ebx) - (:je '(:sub-program (overflow) (:int 4))) - (:addl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) - (:jc 'add-bignum-loop) - add-bignum-done))) - (do-it))) - -(defun %bignum-addf (bignum delta) - "Destructively add (abs delta) to bignum." - (check-type bignum bignum) - (etypecase delta - (positive-fixnum - (%bignum-addf-fixnum bignum delta)) - (negative-fixnum - (%bignum-addf-fixnum bignum (- delta))) - (bignum - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax) - not-size1 - (:load-lexical (:lexical-binding bignum) :eax) ; EAX = bignum - (:load-lexical (:lexical-binding delta) :ebx) ; EBX = delta - (:xorl :edx :edx) ; Counter - (:xorl :ecx :ecx) ; Carry - add-bignum-loop - (:cmpw :dx (:eax (:offset movitz-bignum length))) - (:jbe '(:sub-program (overflow) (:int 4))) - (:addl (:ebx :edx (:offset movitz-bignum :bigit0)) - :ecx) - (:jz 'carry+digit-overflowed) ; If CF=1, then ECX=0. - (:addl :ecx (:eax :edx (:offset movitz-bignum bigit0))) - carry+digit-overflowed - (:sbbl :ecx :ecx) - (:negl :ecx) ; ECX = Add's Carry. - (:addl 4 :edx) - (:cmpw :dx (:ebx (:offset movitz-bignum length))) - (:ja 'add-bignum-loop) - ;; Now, if there's a carry we must propagate it. - (:jecxz 'add-bignum-done) - carry-propagate-loop - (:cmpw :dx (:eax (:offset movitz-bignum length))) - (:jbe '(:sub-program (overflow) (:int 4))) - (:addl 4 :edx) - (:addl 1 (:eax :edx (:offset movitz-bignum bigit0 -4))) - (:jc 'carry-propagate-loop) - add-bignum-done))) - (do-it))))) (defun + (&rest terms) (declare (without-check-stack-limit))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/common-lisp.lisp
by Frode Vatvedt Fjeld 17 Jul '04

17 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23168/losp/muerte Modified Files: common-lisp.lisp Log Message: Factored out bignum-related operators from integers.lisp to bignums.lisp. Date: Sat Jul 17 12:30:14 2004 Author: ffjeld Index: movitz/losp/muerte/common-lisp.lisp diff -u movitz/losp/muerte/common-lisp.lisp:1.8 movitz/losp/muerte/common-lisp.lisp:1.9 --- movitz/losp/muerte/common-lisp.lisp:1.8 Sat Jul 17 05:16:08 2004 +++ movitz/losp/muerte/common-lisp.lisp Sat Jul 17 12:30:14 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:41:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: common-lisp.lisp,v 1.8 2004/07/17 12:16:08 ffjeld Exp $ +;;;; $Id: common-lisp.lisp,v 1.9 2004/07/17 19:30:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -47,6 +47,7 @@ (require :muerte/streams) (require :muerte/restarts) (require :muerte/conditions) +(require :muerte/bignums) (require :muerte/read) (require :muerte/interrupt) (require :muerte/scavenge)

1 0