movitz-cvs
Threads by month
- ----- 2025 -----
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2007 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2006 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2005 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2004 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- 2595 discussions
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
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
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
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
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
17 Jul '04
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv20801
Added Files:
bignums.lisp
Log Message:
Factored out bignum-related operators from integers.lisp to bignums.lisp.
Date: Sat Jul 17 12:30:09 2004
Author: ffjeld
1
0
17 Jul '04
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv10134
Modified Files:
integers.lisp
Log Message:
Added operators %bignum-addf and %bignum-addf-fixnum.
Date: Sat Jul 17 10:42:11 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.71 movitz/losp/muerte/integers.lisp:1.72
--- movitz/losp/muerte/integers.lisp:1.71 Sat Jul 17 05:16:12 2004
+++ movitz/losp/muerte/integers.lisp Sat Jul 17 10:42:10 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.71 2004/07/17 12:16:12 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.72 2004/07/17 17:42:10 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -413,6 +413,84 @@
(: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
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv25165
Modified Files:
special-operators.lisp
Log Message:
Added special operator compiler-macro-call, that really does nothing
except ensure that the operator is in fact a compiler-macro.
Date: Sat Jul 17 05:17:35 2004
Author: ffjeld
Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.29 movitz/special-operators.lisp:1.30
--- movitz/special-operators.lisp:1.29 Fri Jul 16 18:49:23 2004
+++ movitz/special-operators.lisp Sat Jul 17 05:17:35 2004
@@ -8,7 +8,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Fri Nov 24 16:22:59 2000
;;;;
-;;;; $Id: special-operators.lisp,v 1.29 2004/07/17 01:49:23 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.30 2004/07/17 12:17:35 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1051,6 +1051,15 @@
(destructuring-bind (operator &rest arguments)
(cdr form)
(compiler-call #'compile-apply-symbol
+ :forward all
+ :form (cons operator arguments))))
+
+(define-special-operator muerte::compiler-macro-call (&all all &form form &env env)
+ (destructuring-bind (operator &rest arguments)
+ (cdr form)
+ (assert (movitz-compiler-macro-function operator env) ()
+ "There is no compiler-macro ~S." operator)
+ (compiler-call #'compile-compiler-macro-form
:forward all
:form (cons operator arguments))))
1
0
17 Jul '04
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv21498
Modified Files:
memref.lisp
Log Message:
Minor edit.
Date: Sat Jul 17 05:16:28 2004
Author: ffjeld
Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.18 movitz/losp/muerte/memref.lisp:1.19
--- movitz/losp/muerte/memref.lisp:1.18 Fri Jul 16 18:53:17 2004
+++ movitz/losp/muerte/memref.lisp Sat Jul 17 05:16:28 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Tue Mar 6 21:25:49 2001
;;;;
-;;;; $Id: memref.lisp,v 1.18 2004/07/17 01:53:17 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.19 2004/07/17 12:16:28 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -96,8 +96,7 @@
(index-var (gensym "memref-index-")))
`(let ((,object-var ,object)
(,index-var ,index))
- (with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsiged-byte 16))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
(:compile-two-forms (:eax :ecx) ,object-var ,index-var)
(:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
(:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))))
1
0
17 Jul '04
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv19438
Modified Files:
integers.lisp
Log Message:
Extracted most compiler-macros from integers.lisp into arithmetic-macros.lisp.
Date: Sat Jul 17 05:16:12 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.70 movitz/losp/muerte/integers.lisp:1.71
--- movitz/losp/muerte/integers.lisp:1.70 Sat Jul 17 04:27:58 2004
+++ movitz/losp/muerte/integers.lisp Sat Jul 17 05:16:12 2004
@@ -9,12 +9,13 @@
;;;; Created at: Wed Nov 8 18:44:57 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: integers.lisp,v 1.70 2004/07/17 11:27:58 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.71 2004/07/17 12:16:12 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
(require :muerte/basic-macros)
(require :muerte/typep)
+(require :muerte/arithmetic-macros)
(provide :muerte/integers)
(in-package muerte)
@@ -22,113 +23,404 @@
(defconstant most-positive-fixnum #.movitz::+movitz-most-positive-fixnum+)
(defconstant most-negative-fixnum #.movitz::+movitz-most-negative-fixnum+)
-(deftype positive-fixnum ()
- `(integer 0 ,movitz:+movitz-most-positive-fixnum+))
-
-(deftype positive-bignum ()
- `(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *))
-
-(deftype negative-fixnum ()
- `(integer ,movitz:+movitz-most-negative-fixnum+ -1))
-(defmacro number-double-dispatch ((x y) &rest clauses)
- `(let ((x ,x) (y ,y))
- (cond ,@(loop for ((x-type y-type) . then-body) in clauses
- collect `((and (typep x ',x-type) (typep y ',y-type))
- ,@then-body))
- (t (error "Not numbers: ~S or ~S." x y)))))
-
-(defun fixnump (x)
- (typep x 'fixnum))
+;;; Comparison
-(define-compiler-macro evenp (x)
- `(with-inline-assembly (:returns :boolean-zf=1)
- (:compile-form (:result-mode :eax) ,x)
- (:call-global-pf unbox-u32)
- (:testb 1 :cl)))
+(define-primitive-function fast-compare-two-reals (n1 n2)
+ "Compare two numbers (i.e. set EFLAGS accordingly)."
+ (macrolet
+ ((do-it ()
+ `(with-inline-assembly (:returns :nothing) ; unspecified
+ (:testb ,movitz::+movitz-fixnum-zmask+ :al)
+ (:jnz 'n1-not-fixnum)
+ (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
+ (:jnz 'n2-not-fixnum-but-n1-is)
+ (:cmpl :ebx :eax) ; both were fixnum
+ (:ret)
+ n1-not-fixnum ; but we don't know about n2
+ (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
+ (:jnz 'neither-is-fixnum)
+ ;; n2 is fixnum
+ (:locally (:jmp (:edi (:edi-offset fast-compare-real-fixnum))))
+ n2-not-fixnum-but-n1-is
+ (:locally (:jmp (:edi (:edi-offset fast-compare-fixnum-real))))
+ neither-is-fixnum
+ ;; Check that both numbers are bignums, and compare them.
+ (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jnz '(:sub-program (n1-not-bignum)
+ (:int 107)))
+ (:movl (:eax ,movitz:+other-type-offset+) :ecx)
+ (:cmpb ,(movitz:tag :bignum) :cl)
+ (:jne 'n1-not-bignum)
-(defun evenp (x)
- (evenp x))
+ (:cmpl :eax :ebx) ; If they are EQ, they are certainly =
+ (:je '(:sub-program (n1-and-n2-are-eq)
+ (:ret)))
-(define-compiler-macro oddp (x)
- `(with-inline-assembly (:returns :boolean-zf=0)
- (:compile-form (:result-mode :eax) ,x)
- (:call-global-pf unbox-u32)
- (:testb 1 :cl)))
+ (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jnz '(:sub-program (n2-not-bignum)
+ (:int 107)))
+ (:movl (:ebx ,movitz:+other-type-offset+) :ecx)
+ (:cmpb ,(movitz:tag :bignum) :cl)
+ (:jne 'n2-not-bignum)
-(defun oddp (x)
- (oddp x))
+ (:cmpb :ch (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::sign)))
+ (:jne '(:sub-program (different-signs)
+ ;; Comparing the sign-bytes sets up EFLAGS correctly!
+ (:ret)))
+ (:testl #xff00 :ecx)
+ (:jnz 'compare-negatives)
+ ;; Both n1 and n2 are positive bignums.
-;;; Types
+ (:shrl 16 :ecx)
+ (:cmpw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)))
+ (:jne '(:sub-program (positive-different-sizes)
+ (:ret)))
-(define-typep integer (x &optional (min '*) (max '*))
- (and (typep x 'integer)
- (or (eq min '*) (<= min x))
- (or (eq max '*) (<= x max))))
+ ;; Both n1 and n2 are positive bignums of the same size, namely ECX.
+ (:movl :ecx :edx) ; counter
+ 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)))
+ (: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.
+ (:locally (:movl :ecx (:edi (:edi-offset scratch0))))
+ (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+ :ecx)
+ (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx))
+ (:jne 'upper-16-decisive)
+ (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::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))
+ :ecx) ; Then compare lower 16 bits.
+ (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx))
+ upper-16-decisive
+ (:ret)
+
+ compare-negatives
+ ;; Moth n1 and n2 are negative bignums.
-(deftype signed-byte (&optional (size '*))
- (cond
- ((eq size '*)
- 'integer)
- ((typep size '(integer 1 *))
- (list 'integer
- (- (ash 1 (1- size)))
- (1- (ash 1 (1- size)))))
- (t (error "Illegal size for signed-byte."))))
+ (:shrl 16 :ecx)
+ (:cmpw (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)) :cx)
+ (:jne '(:sub-program (negative-different-sizes)
+ (:ret)))
-(deftype unsigned-byte (&optional (size '*))
- (cond
- ((eq size '*)
- '(integer 0))
- ((typep size '(integer 1 *))
- (list 'integer 0 (1- (ash 1 size))))
- (t (error "Illegal size for unsigned-byte."))))
+ ;; Both n1 and n2 are negative bignums of the same size, namely ECX.
+ (:movl :ecx :edx) ; counter
+ 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)))
+ (: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)))
+ :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)
+ (:locally (:cmpl :ecx (:edi (:edi-offset scratch0))))
+ (:jne 'negative-upper-16-decisive)
+ (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::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))
+ :ecx) ; Then compare lower 16 bits.
+ (:locally (:cmpl :ecx (:edi (:edi-offset scratch0))))
+ negative-upper-16-decisive
+ (:ret))))
+ (do-it)))
-(define-simple-typep (bit bitp) (x)
- (or (eq x 0) (eq x 1)))
+(define-primitive-function fast-eql (x y)
+ "Compare EAX and EBX under EQL, result in ZF.
+Preserve EAX and EBX."
+ (macrolet
+ ((do-it ()
+ `(with-inline-assembly (:returns :nothing) ; unspecified
+ (:cmpl :eax :ebx) ; EQ?
+ (:je 'done)
+ (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jne 'done)
+ (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jne 'done)
+ (:movl (:eax ,movitz:+other-type-offset+) :ecx)
+ (:cmpb ,(movitz:tag :bignum) :cl)
+ (:jne 'done)
+ (:cmpl :ecx (:ebx ,movitz:+other-type-offset+))
+ (:jne 'done)
+ ;; Ok.. we have two bignums of identical sign and size.
+ (:shrl 16 :ecx)
+ (:movl :ecx :edx) ; counter
+ 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))))
+ (:je 'compare-loop)
+ done
+ (:ret))))
+ (do-it)))
-;;;
+(define-primitive-function fast-compare-fixnum-real (n1 n2)
+ "Compare (known) fixnum <n1> with real <n2>."
+ (macrolet
+ ((do-it ()
+ `(with-inline-assembly (:returns :nothing) ; unspecified
+ (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
+ (:jnz 'n2-not-fixnum)
+ (:cmpl :ebx :eax)
+ (:ret)
+ n2-not-fixnum
+ (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jnz '(:sub-program (not-integer)
+ (:int 107)
+ (:jmp 'not-integer)))
+ (:movl (:ebx ,movitz:+other-type-offset+) :ecx)
+ (:cmpw ,(movitz:tag :bignum 0) :cx)
+ (:jne 'not-plusbignum)
+ ;; compare eax with something bigger
+ (:cmpl #x10000000 :edi)
+ (:ret)
+ not-plusbignum
+ (:cmpw ,(movitz:tag :bignum #xff) :cx)
+ (:jne 'not-integer)
+ ;; compare ebx with something bigger
+ (:cmpl #x-10000000 :edi)
+ (:ret))))
+ (do-it)))
-(defun %negatef (x p0 p1)
- "Negate x. If x is not eq to p0 or p1, negate x destructively."
- (etypecase x
- (fixnum (- x))
- (bignum
- (if (or (eq x p0) (eq x p1))
- (- x)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) x)
- (:xorl #xff00 (:eax #.movitz:+other-type-offset+)))))))
+(define-primitive-function fast-compare-real-fixnum (n1 n2)
+ "Compare real <n1> with fixnum <n2>."
+ (with-inline-assembly (:returns :nothing) ; unspecified
+ (:testb #.movitz::+movitz-fixnum-zmask+ :al)
+ (:jnz 'not-fixnum)
+ (:cmpl :ebx :eax)
+ (:ret)
+ not-fixnum
+ (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jnz '(:sub-program (not-integer)
+ (:int 107)
+ (:jmp 'not-integer)))
+ (:movl (:eax #.movitz:+other-type-offset+) :ecx)
+ (:cmpw #.(movitz:tag :bignum 0) :cx)
+ (:jne 'not-plusbignum)
+ ;; compare ebx with something bigger
+ (:cmpl #x-10000000 :edi)
+ (:ret)
+ not-plusbignum
+ (:cmpw #.(movitz:tag :bignum #xff) :cx)
+ (:jne 'not-integer)
+ ;; compare ebx with something bigger
+ (:cmpl #x10000000 :edi)
+ (:ret)))
-;;; Addition
+;;;
-(define-compiler-macro + (&whole form &rest operands &environment env)
- (case (length operands)
- (0 0)
- (1 (first operands))
- #+ignore (2 `(+%2op ,(first operands) ,(second operands)))
- (2 `(let ((x ,(first operands))
- (y ,(second operands)))
- (++%2op x y)))
- (t (let ((operands
- (loop for operand in operands
- if (movitz:movitz-constantp operand env)
- sum (movitz:movitz-eval operand env)
- into constant-term
- else collect operand
- into non-constant-operands
- finally (return (if (zerop constant-term)
- non-constant-operands
- (cons constant-term non-constant-operands))))))
- `(+ (+ ,(first operands) ,(second operands)) ,@(cddr operands))))))
-(defun + (&rest terms)
- (declare (without-check-stack-limit))
- (numargs-case
- (1 (x) x)
- (2 (x y)
- (macrolet
- ((do-it ()
+(defmacro define-number-relational (name 2op-name condition &key (defun-p t) 3op-name)
+ `(progn
+ ,(when condition
+ `(define-compiler-macro ,2op-name (n1 n2)
+ (cond
+ ((movitz:movitz-constantp n1)
+ (let ((n1 (movitz::movitz-eval n1)))
+ (check-type n1 (signed-byte 30))
+ `(with-inline-assembly (:returns ,,condition :side-effects nil)
+ (:compile-two-forms (:eax :ebx) ,n1 ,n2)
+ (:call-global-pf fast-compare-fixnum-real))))
+ ((movitz:movitz-constantp n2)
+ (let ((n2 (movitz::movitz-eval n2)))
+ (check-type n2 (signed-byte 30))
+ `(with-inline-assembly (:returns ,,condition :side-effects nil)
+ (:compile-two-forms (:eax :ebx) ,n1 ,n2)
+ (:call-global-pf fast-compare-real-fixnum))))
+ (t `(with-inline-assembly (:returns ,,condition :side-effects nil)
+ (:compile-two-forms (:eax :ebx) ,n1 ,n2)
+ (:call-global-pf fast-compare-two-reals))))))
+
+ (defun ,2op-name (n1 n2)
+ (,2op-name n1 n2))
+
+ (define-compiler-macro ,name (&whole form number &rest more-numbers)
+ (case (length more-numbers)
+ (0 `(progn ,number t))
+ (1 `(,',2op-name ,number ,(first more-numbers)))
+ ,@(when 3op-name
+ `((2 `(,',3op-name ,number ,(first more-numbers) ,(second more-numbers)))))
+ (t #+ignore (when (= 2 (length more-numbers))
+ (warn "3op: ~S" form))
+ `(and (,',2op-name ,number ,(first more-numbers))
+ (,',name ,@more-numbers)))))
+
+ ,(when defun-p
+ `(defun ,name (number &rest more-numbers)
+ (declare (dynamic-extent more-numbers))
+ (cond
+ ((null more-numbers)
+ (check-type number fixnum)
+ t)
+ ((not (cdr more-numbers))
+ (,2op-name number (first more-numbers)))
+ (t (and (,2op-name number (first more-numbers))
+ (do ((p more-numbers (cdr p)))
+ ((not (cdr p)) t)
+ (unless (,2op-name (car p) (cadr p))
+ (return nil))))))))))
+
+(define-number-relational >= >=%2op :boolean-greater-equal)
+(define-number-relational > >%2op :boolean-greater)
+(define-number-relational < <%2op :boolean-less)
+(define-number-relational <= <=%2op :boolean-less-equal :3op-name <=%3op)
+
+;;; Unsigned
+
+(defun below (x max)
+ "Is x between 0 and max?"
+ (compiler-macro-call below x max))
+
+
+;;; Equality
+
+(define-compiler-macro =%2op (n1 n2 &environment env)
+ (cond
+ ((movitz:movitz-constantp n1 env)
+ (let ((n1 (movitz:movitz-eval n1 env)))
+ (etypecase n1
+ ((eql 0)
+ `(do-result-mode-case ()
+ (:booleans
+ (with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
+ (:compile-form (:result-mode :eax) ,n2)
+ (:testl :eax :eax)))
+ (t (with-inline-assembly (:returns :boolean-cf=1 :side-effects nil)
+ (:compile-form (:result-mode :eax) ,n2)
+ (:cmpl 1 :eax)))))
+ ((signed-byte 30)
+ `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
+ (:compile-two-forms (:eax :ebx) ,n1 ,n2)
+ (:call-global-pf fast-compare-fixnum-real)))
+ (integer
+ `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
+ (:compile-two-forms (:eax :ebx) ,n1 ,n2)
+ (:call-global-pf fast-compare-two-reals))))))
+ ((movitz:movitz-constantp n2 env)
+ `(=%2op ,n2 ,n1))
+ (t `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
+ (:compile-two-forms (:eax :ebx) ,n1 ,n2)
+ (:call-global-pf fast-compare-two-reals)))))
+
+(define-number-relational = =%2op nil :defun-p nil)
+
+(defun = (first-number &rest numbers)
+ (declare (dynamic-extent numbers))
+ (dolist (n numbers t)
+ (unless (= first-number n)
+ (return nil))))
+
+(define-number-relational /= /=%2op :boolean-zf=0 :defun-p nil)
+
+(defun /= (&rest numbers)
+ (declare (dynamic-extent numbers))
+ (do ((p (cdr numbers) (cdr p)))
+ ((null p) t)
+ (do ((v numbers (cdr v)))
+ ((eq p v))
+ (when (= (car p) (car v))
+ (return-from /= nil)))))
+
+
+;;;;
+
+(deftype positive-fixnum ()
+ `(integer 0 ,movitz:+movitz-most-positive-fixnum+))
+
+(deftype positive-bignum ()
+ `(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *))
+
+(deftype negative-fixnum ()
+ `(integer ,movitz:+movitz-most-negative-fixnum+ -1))
+
+(defun fixnump (x)
+ (typep x 'fixnum))
+
+(defun evenp (x)
+ (compiler-macro-call evenp x))
+
+(defun oddp (x)
+ (compiler-macro-call oddp x))
+
+;;; Types
+
+(define-typep integer (x &optional (min '*) (max '*))
+ (and (typep x 'integer)
+ (or (eq min '*) (<= min x))
+ (or (eq max '*) (<= x max))))
+
+(deftype signed-byte (&optional (size '*))
+ (cond
+ ((eq size '*)
+ 'integer)
+ ((typep size '(integer 1 *))
+ (list 'integer
+ (- (ash 1 (1- size)))
+ (1- (ash 1 (1- size)))))
+ (t (error "Illegal size for signed-byte."))))
+
+(deftype unsigned-byte (&optional (size '*))
+ (cond
+ ((eq size '*)
+ '(integer 0))
+ ((typep size '(integer 1 *))
+ (list 'integer 0 (1- (ash 1 size))))
+ (t (error "Illegal size for unsigned-byte."))))
+
+(define-simple-typep (bit bitp) (x)
+ (or (eq x 0) (eq x 1)))
+
+;;;
+
+(defun %negatef (x p0 p1)
+ "Negate x. If x is not eq to p0 or p1, negate x destructively."
+ (etypecase x
+ (fixnum (- x))
+ (bignum
+ (if (or (eq x p0) (eq x p1))
+ (- x)
+ (with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) x)
+ (:xorl #xff00 (:eax #.movitz:+other-type-offset+)))))))
+
+;;; Addition
+
+(defun + (&rest terms)
+ (declare (without-check-stack-limit))
+ (numargs-case
+ (1 (x) x)
+ (2 (x y)
+ (macrolet
+ ((do-it ()
`(number-double-dispatch (x y)
((fixnum fixnum)
(with-inline-assembly (:returns :eax)
@@ -315,677 +607,214 @@
retry-not-size1
(:compile-form (:result-mode :eax) y)
(:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
- 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 1) ,(* 2 movitz:+movitz-fixnum-factor+))
- :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)
- (:leal ((:ecx 1) ,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) :ebx)
- (:xorl :edx :edx) ; counter
- (:xorl :ecx :ecx) ; Carry
- 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)
- (: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)))
- (:jae 'add-bignum-loop)
- (:jmp 'add-bignum-done)))
- (: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 '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))))
- (:je 'no-expansion)
- (:addl #x40000 (:eax ,movitz:+other-type-offset+))
- (:addl ,movitz:+movitz-fixnum-factor+ :ecx)
- no-expansion
- (:call-local-pf cons-commit)
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))
- pfix-pbig-done)
- ))
- (((integer * -1) (integer 0 *))
- (- y (- x)))
- (((integer 0 *) (integer * -1))
- (- x (- y)))
- (((integer * -1) (integer * -1))
- (%negatef (+ (- x) (- y)) x y))
- )))
- (do-it)))
- (t (&rest terms)
- (declare (dynamic-extent terms))
- (if (null terms)
- 0
- (reduce #'+ terms)))))
-
-(defun 1+ (number)
- (+ 1 number))
-
-(define-compiler-macro 1+ (number)
- `(+ 1 ,number))
-
-(defun 1- (number)
- (+ -1 number))
-
-(define-compiler-macro 1- (number)
- `(+ -1 ,number))
-
-(define-modify-macro incf (&optional (delta-form 1)) +)
-
-;;; Subtraction
-
-(define-compiler-macro - (&whole form &rest operands &environment env)
- (case (length operands)
- (0 0)
- (1 (let ((x (first operands)))
- (if (movitz:movitz-constantp x env)
- (- (movitz:movitz-eval x env))
- form)))
- (2 (let ((minuend (first operands))
- (subtrahend (second operands)))
- (cond
- ((movitz:movitz-constantp subtrahend env)
- `(+ ,minuend ,(- (movitz:movitz-eval subtrahend env))))
- (t form))))
- (t `(- ,(first operands) (+ ,@(rest operands))))))
-
-(defun - (minuend &rest subtrahends)
- (declare (dynamic-extent subtrahends))
- (numargs-case
- (1 (x)
- (macrolet
- ((do-it ()
- `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) x)
- (:testb ,movitz:+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program (not-fixnum)
- (:leal (:eax ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz '(:sub-program (not-a-number)
- (:compile-form (:result-mode :ignore)
- (error 'type-error :expected-type 'number :datum x))))
- (:movl (:eax ,movitz:+other-type-offset+) :ecx)
- (:cmpb ,(movitz:tag :bignum) :cl)
- (: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)))
- (:jne 'not-most-negative-fixnum)
- (:movl ,(ldb (byte 32 0)
- (* most-negative-fixnum movitz::+movitz-fixnum-factor+))
- :eax)
- (:jmp 'fix-ok)
- not-most-negative-fixnum
- (:compile-form (:result-mode :eax)
- (copy-bignum x))
- (:notb (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::sign)))
- (:jmp 'fix-ok)))
- (:negl :eax)
- (:jo '(:sub-program (fix-overflow)
- (:compile-form (:result-mode :eax)
- ,(1+ movitz:+movitz-most-positive-fixnum+))
- (:jmp 'fix-ok)))
- fix-ok
- )))
- (do-it)))
- (2 (minuend subtrahend)
- (macrolet
- ((do-it ()
- `(number-double-dispatch (minuend subtrahend)
- ((t (eql 0))
- minuend)
- (((eql 0) t)
- (- subtrahend))
- ((fixnum fixnum)
- (with-inline-assembly (:returns :eax :side-effects nil)
- (:compile-two-forms (:eax :ebx) minuend subtrahend)
- (:subl :ebx :eax)
- (:into)))
- ((positive-bignum fixnum)
- (+ (- subtrahend) minuend))
- ((fixnum positive-bignum)
- (- (+ (- minuend) subtrahend)))
- ((positive-bignum positive-bignum)
- (cond
- ((= minuend subtrahend)
- 0)
- ((< minuend subtrahend)
- (let ((x (- subtrahend minuend)))
- (%negatef x subtrahend minuend)))
- (t (%bignum-canonicalize
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ebx) (copy-bignum minuend) subtrahend)
- (:xorl :edx :edx) ; counter
- (:xorl :ecx :ecx) ; carry
- sub-loop
- (:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::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)))
- (:jne 'sub-loop)
- (:jmp 'bignum-sub-done)))
- (:subl :ecx
- (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
- (:sbbl :ecx :ecx)
- (:negl :ecx)
- (:addl 4 :edx)
- (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)))
- (:jne 'sub-loop)
- (:subl :ecx
- (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
- (:jnc 'bignum-sub-done)
- propagate-carry
- (:addl 4 :edx)
- (:subl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
- (:jc 'propagate-carry)
- bignum-sub-done
- )))))
- (((integer 0 *) (integer * -1))
- (+ minuend (- subtrahend)))
- (((integer * -1) (integer 0 *))
- (%negatef (+ (- minuend) subtrahend) minuend subtrahend))
- (((integer * -1) (integer * -1))
- (+ minuend (- subtrahend)))
- )))
- (do-it)))
- (t (minuend &rest subtrahends)
- (declare (dynamic-extent subtrahends))
- (if subtrahends
- (reduce #'- subtrahends :initial-value minuend)
- (- minuend)))))
-
-(define-modify-macro decf (&optional (delta-form 1)) -)
-
-;;; Comparison
-
-(define-primitive-function fast-compare-two-reals (n1 n2)
- "Compare two numbers (i.e. set EFLAGS accordingly)."
- (macrolet
- ((do-it ()
- `(with-inline-assembly (:returns :nothing) ; unspecified
- (:testb ,movitz::+movitz-fixnum-zmask+ :al)
- (:jnz 'n1-not-fixnum)
- (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
- (:jnz 'n2-not-fixnum-but-n1-is)
- (:cmpl :ebx :eax) ; both were fixnum
- (:ret)
- n1-not-fixnum ; but we don't know about n2
- (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
- (:jnz 'neither-is-fixnum)
- ;; n2 is fixnum
- (:locally (:jmp (:edi (:edi-offset fast-compare-real-fixnum))))
- n2-not-fixnum-but-n1-is
- (:locally (:jmp (:edi (:edi-offset fast-compare-fixnum-real))))
- neither-is-fixnum
- ;; Check that both numbers are bignums, and compare them.
- (:leal (:eax ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz '(:sub-program (n1-not-bignum)
- (:int 107)))
- (:movl (:eax ,movitz:+other-type-offset+) :ecx)
- (:cmpb ,(movitz:tag :bignum) :cl)
- (:jne 'n1-not-bignum)
-
- (:cmpl :eax :ebx) ; If they are EQ, they are certainly =
- (:je '(:sub-program (n1-and-n2-are-eq)
- (:ret)))
-
- (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz '(:sub-program (n2-not-bignum)
- (:int 107)))
- (:movl (:ebx ,movitz:+other-type-offset+) :ecx)
- (:cmpb ,(movitz:tag :bignum) :cl)
- (:jne 'n2-not-bignum)
-
- (:cmpb :ch (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::sign)))
- (:jne '(:sub-program (different-signs)
- ;; Comparing the sign-bytes sets up EFLAGS correctly!
- (:ret)))
- (:testl #xff00 :ecx)
- (:jnz 'compare-negatives)
- ;; Both n1 and n2 are positive bignums.
-
- (:shrl 16 :ecx)
- (:cmpw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)))
- (:jne '(:sub-program (positive-different-sizes)
- (:ret)))
-
- ;; Both n1 and n2 are positive bignums of the same size, namely ECX.
- (:movl :ecx :edx) ; counter
- 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)))
- (: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.
- (:locally (:movl :ecx (:edi (:edi-offset scratch0))))
- (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
- :ecx)
- (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx))
- (:jne 'upper-16-decisive)
- (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::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))
- :ecx) ; Then compare lower 16 bits.
- (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx))
- upper-16-decisive
- (:ret)
-
- compare-negatives
- ;; Moth n1 and n2 are negative bignums.
-
- (:shrl 16 :ecx)
- (:cmpw (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)) :cx)
- (:jne '(:sub-program (negative-different-sizes)
- (:ret)))
-
- ;; Both n1 and n2 are negative bignums of the same size, namely ECX.
- (:movl :ecx :edx) ; counter
- 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)))
- (: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)))
- :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)
- (:locally (:cmpl :ecx (:edi (:edi-offset scratch0))))
- (:jne 'negative-upper-16-decisive)
- (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::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))
- :ecx) ; Then compare lower 16 bits.
- (:locally (:cmpl :ecx (:edi (:edi-offset scratch0))))
- negative-upper-16-decisive
- (:ret))))
- (do-it)))
-
-(define-primitive-function fast-eql (x y)
- "Compare EAX and EBX under EQL, result in ZF.
-Preserve EAX and EBX."
- (macrolet
- ((do-it ()
- `(with-inline-assembly (:returns :nothing) ; unspecified
- (:cmpl :eax :ebx) ; EQ?
- (:je 'done)
- (:leal (:eax ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jne 'done)
- (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jne 'done)
- (:movl (:eax ,movitz:+other-type-offset+) :ecx)
- (:cmpb ,(movitz:tag :bignum) :cl)
- (:jne 'done)
- (:cmpl :ecx (:ebx ,movitz:+other-type-offset+))
- (:jne 'done)
- ;; Ok.. we have two bignums of identical sign and size.
- (:shrl 16 :ecx)
- (:movl :ecx :edx) ; counter
- 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))))
- (:je 'compare-loop)
- done
- (:ret))))
- (do-it)))
-
-(define-primitive-function fast-compare-fixnum-real (n1 n2)
- "Compare (known) fixnum <n1> with real <n2>."
- (macrolet
- ((do-it ()
- `(with-inline-assembly (:returns :nothing) ; unspecified
- (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
- (:jnz 'n2-not-fixnum)
- (:cmpl :ebx :eax)
- (:ret)
- n2-not-fixnum
- (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz '(:sub-program (not-integer)
- (:int 107)
- (:jmp 'not-integer)))
- (:movl (:ebx ,movitz:+other-type-offset+) :ecx)
- (:cmpw ,(movitz:tag :bignum 0) :cx)
- (:jne 'not-plusbignum)
- ;; compare eax with something bigger
- (:cmpl #x10000000 :edi)
- (:ret)
- not-plusbignum
- (:cmpw ,(movitz:tag :bignum #xff) :cx)
- (:jne 'not-integer)
- ;; compare ebx with something bigger
- (:cmpl #x-10000000 :edi)
- (:ret))))
- (do-it)))
-
-(define-primitive-function fast-compare-real-fixnum (n1 n2)
- "Compare real <n1> with fixnum <n2>."
- (with-inline-assembly (:returns :nothing) ; unspecified
- (:testb #.movitz::+movitz-fixnum-zmask+ :al)
- (:jnz 'not-fixnum)
- (:cmpl :ebx :eax)
- (:ret)
- not-fixnum
- (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz '(:sub-program (not-integer)
- (:int 107)
- (:jmp 'not-integer)))
- (:movl (:eax #.movitz:+other-type-offset+) :ecx)
- (:cmpw #.(movitz:tag :bignum 0) :cx)
- (:jne 'not-plusbignum)
- ;; compare ebx with something bigger
- (:cmpl #x-10000000 :edi)
- (:ret)
- not-plusbignum
- (:cmpw #.(movitz:tag :bignum #xff) :cx)
- (:jne 'not-integer)
- ;; compare ebx with something bigger
- (:cmpl #x10000000 :edi)
- (:ret)))
-
-;;;
-
-(define-compiler-macro <=%3op (min x max &environment env)
- (cond
- ((and (movitz:movitz-constantp min env)
- (movitz:movitz-constantp max env))
- (let ((min (movitz:movitz-eval min env))
- (max (movitz:movitz-eval max env)))
- (check-type min fixnum)
- (check-type max fixnum)
- ;; (warn "~D -- ~D" min max)
- (cond
- ((movitz:movitz-constantp x env)
- (<= min (movitz:movitz-eval x env) max))
- ((< max min)
- nil)
- ((= max min)
- `(= ,x ,min))
- ((minusp min)
- `(let ((x ,x))
- (and (<= ,min x) (<= x ,max))))
- ((= 0 min)
- `(with-inline-assembly (:returns :boolean-cf=1)
- (:compile-form (:result-mode :eax) ,x)
- (:testb ,movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 107)))
- (:cmpl ,(* (1+ max) movitz::+movitz-fixnum-factor+) :eax)))
- (t `(do-result-mode-case ()
- (:booleans
- (with-inline-assembly (:returns :boolean-zf=0)
- (:compile-form (:result-mode :eax) ,x)
- (:testb ,movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 107)))
- (:cmpl ,(* min movitz::+movitz-fixnum-factor+) :eax)
- (:sbbl :ecx :ecx)
- (:cmpl ,(* (1+ max) movitz::+movitz-fixnum-factor+) :eax)
- (:adcl 0 :ecx)))
- (t (with-inline-assembly (:returns (:boolean-ecx 1 0))
- (:compile-form (:result-mode :eax) ,x)
- (:testb ,movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program () (:int 107)))
- (:cmpl ,(* min movitz::+movitz-fixnum-factor+) :eax)
- (:sbbl :ecx :ecx)
- (:cmpl ,(* (1+ max) movitz::+movitz-fixnum-factor+) :eax)
- (:adcl 0 :ecx))))))))
- #+ignore ; this is buggy.
- ((movitz:movitz-constantp min env)
- (let ((min (movitz:movitz-eval min env)))
- (check-type min fixnum)
- (cond
- ((minusp min)
- `(let ((x ,x))
- (and (<= ,min x) (<= x ,max))))
- (t `(do-result-mode-case ()
- (:booleans
- (with-inline-assembly (:returns :boolean-zf=1)
- (:compile-two-forms (:eax :ebx) ,x ,max)
- (:movl :eax :ecx)
- (:orl :ebx :ecx)
- (:testb ,movitz::+movitz-fixnum-zmask+ :cl)
- (:jne '(:sub-program () (:int 107)))
- (:cmpl :eax :ebx)
- (:sbbl :ecx :ecx)
- ,@(unless (= 0 min)
- `((:subl ,(* min movitz::+movitz-fixnum-factor+) :ebx)))
- (:addl :ebx :ebx)
- (:adcl 0 :ecx)))
- (t (with-inline-assembly (:returns (:boolean-ecx 0 1))
- (:compile-two-forms (:eax :ebx) ,x ,max)
- (:movl :eax :ecx)
- (:orl :ebx :ecx)
- (:testb ,movitz::+movitz-fixnum-zmask+ :cl)
- (:jne '(:sub-program () (:int 107)))
- (:cmpl :eax :ebx) ; if x>max, CF=1
- (:sbbl :ecx :ecx) ; ecx = x>max ? -1 : 0
- ,@(unless (= 0 min)
- `((:subl ,(* min movitz::+movitz-fixnum-factor+) :ebx)))
- (:addl :ebx :ebx) ; if x<min, CF=1
- (:adcl 0 :ecx) ;
- (:andl 1 :ecx))))))))
- (t `(let ((x ,x))
- (and (<= ,min x) (<= x ,max))))))
-
-
-(defmacro define-number-relational (name 2op-name condition &key (defun-p t) 3op-name)
- `(progn
- ,(when condition
- `(define-compiler-macro ,2op-name (n1 n2)
- (cond
- ((movitz:movitz-constantp n1)
- (let ((n1 (movitz::movitz-eval n1)))
- (check-type n1 (signed-byte 30))
- `(with-inline-assembly (:returns ,,condition :side-effects nil)
- (:compile-two-forms (:eax :ebx) ,n1 ,n2)
- (:call-global-pf fast-compare-fixnum-real))))
- ((movitz:movitz-constantp n2)
- (let ((n2 (movitz::movitz-eval n2)))
- (check-type n2 (signed-byte 30))
- `(with-inline-assembly (:returns ,,condition :side-effects nil)
- (:compile-two-forms (:eax :ebx) ,n1 ,n2)
- (:call-global-pf fast-compare-real-fixnum))))
- (t `(with-inline-assembly (:returns ,,condition :side-effects nil)
- (:compile-two-forms (:eax :ebx) ,n1 ,n2)
- (:call-global-pf fast-compare-two-reals))))))
-
- (defun ,2op-name (n1 n2)
- (,2op-name n1 n2))
-
- (define-compiler-macro ,name (&whole form number &rest more-numbers)
- (case (length more-numbers)
- (0 `(progn ,number t))
- (1 `(,',2op-name ,number ,(first more-numbers)))
- ,@(when 3op-name
- `((2 `(,',3op-name ,number ,(first more-numbers) ,(second more-numbers)))))
- (t #+ignore (when (= 2 (length more-numbers))
- (warn "3op: ~S" form))
- `(and (,',2op-name ,number ,(first more-numbers))
- (,',name ,@more-numbers)))))
-
- ,(when defun-p
- `(defun ,name (number &rest more-numbers)
- (declare (dynamic-extent more-numbers))
- (cond
- ((null more-numbers)
- (check-type number fixnum)
- t)
- ((not (cdr more-numbers))
- (,2op-name number (first more-numbers)))
- (t (and (,2op-name number (first more-numbers))
- (do ((p more-numbers (cdr p)))
- ((not (cdr p)) t)
- (unless (,2op-name (car p) (cadr p))
- (return nil))))))))))
-
-(define-number-relational >= >=%2op :boolean-greater-equal)
-(define-number-relational > >%2op :boolean-greater)
-(define-number-relational < <%2op :boolean-less)
-(define-number-relational <= <=%2op :boolean-less-equal :3op-name <=%3op)
-
-;;; Unsigned
-
-(define-compiler-macro below (&whole form x max &environment env)
- (let ((below-not-integer (gensym "below-not-integer-")))
- (if (movitz:movitz-constantp max env)
- `(with-inline-assembly (:returns :boolean-cf=1)
- (:compile-form (:result-mode :eax) ,x)
- (:testb ,movitz::+movitz-fixnum-zmask+ :al)
- (:jnz '(:sub-program (,below-not-integer) (:int 107)))
- (:cmpl ,(* (movitz:movitz-eval max env)
- movitz::+movitz-fixnum-factor+)
- :eax))
- `(with-inline-assembly (:returns :boolean-cf=1)
- (:compile-two-forms (:eax :ebx) ,x ,max)
- (:movl :eax :ecx)
- (:orl :ebx :ecx)
- (:testb ,movitz::+movitz-fixnum-zmask+ :cl)
- (:jnz '(:sub-program (,below-not-integer) (:int 107)))
- (:cmpl :ebx :eax)))))
-
-(defun below (x max)
- "Is x between 0 and max?"
- (below x max))
-
-
-;;; Equality
+ 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 1) ,(* 2 movitz:+movitz-fixnum-factor+))
+ :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)
+ (:leal ((:ecx 1) ,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)
-(define-compiler-macro =%2op (n1 n2 &environment env)
- (cond
- ((movitz:movitz-constantp n1 env)
- (let ((n1 (movitz:movitz-eval n1 env)))
- (etypecase n1
- ((eql 0)
- `(do-result-mode-case ()
- (:booleans
- (with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
- (:compile-form (:result-mode :eax) ,n2)
- (:testl :eax :eax)))
- (t (with-inline-assembly (:returns :boolean-cf=1 :side-effects nil)
- (:compile-form (:result-mode :eax) ,n2)
- (:cmpl 1 :eax)))))
- ((signed-byte 30)
- `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
- (:compile-two-forms (:eax :ebx) ,n1 ,n2)
- (:call-global-pf fast-compare-fixnum-real)))
- (integer
- `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
- (:compile-two-forms (:eax :ebx) ,n1 ,n2)
- (:call-global-pf fast-compare-two-reals))))))
- ((movitz:movitz-constantp n2 env)
- `(=%2op ,n2 ,n1))
- (t `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil)
- (:compile-two-forms (:eax :ebx) ,n1 ,n2)
- (:call-global-pf fast-compare-two-reals)))))
+ (:load-lexical (:lexical-binding x) :ebx)
+ (:xorl :edx :edx) ; counter
+ (:xorl :ecx :ecx) ; Carry
+ 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)
+ (: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)))
+ (:jae 'add-bignum-loop)
+ (:jmp 'add-bignum-done)))
+ (: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 '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))))
+ (:je 'no-expansion)
+ (:addl #x40000 (:eax ,movitz:+other-type-offset+))
+ (:addl ,movitz:+movitz-fixnum-factor+ :ecx)
+ no-expansion
+ (:call-local-pf cons-commit)
+ (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
+ (:edi (:edi-offset atomically-status))))
+ pfix-pbig-done)
+ ))
+ (((integer * -1) (integer 0 *))
+ (- y (- x)))
+ (((integer 0 *) (integer * -1))
+ (- x (- y)))
+ (((integer * -1) (integer * -1))
+ (%negatef (+ (- x) (- y)) x y))
+ )))
+ (do-it)))
+ (t (&rest terms)
+ (declare (dynamic-extent terms))
+ (if (null terms)
+ 0
+ (reduce #'+ terms)))))
-(define-number-relational = =%2op nil :defun-p nil)
+(defun 1+ (number)
+ (+ 1 number))
-(defun = (first-number &rest numbers)
- (declare (dynamic-extent numbers))
- (dolist (n numbers t)
- (unless (= first-number n)
- (return nil))))
+(defun 1- (number)
+ (+ -1 number))
-(define-number-relational /= /=%2op :boolean-zf=0 :defun-p nil)
+;;; Subtraction
-(defun /= (&rest numbers)
- (declare (dynamic-extent numbers))
- (do ((p (cdr numbers) (cdr p)))
- ((null p) t)
- (do ((v numbers (cdr v)))
- ((eq p v))
- (when (= (car p) (car v))
- (return-from /= nil)))))
+(defun - (minuend &rest subtrahends)
+ (declare (dynamic-extent subtrahends))
+ (numargs-case
+ (1 (x)
+ (macrolet
+ ((do-it ()
+ `(with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) x)
+ (:testb ,movitz:+movitz-fixnum-zmask+ :al)
+ (:jnz '(:sub-program (not-fixnum)
+ (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jnz '(:sub-program (not-a-number)
+ (:compile-form (:result-mode :ignore)
+ (error 'type-error :expected-type 'number :datum x))))
+ (:movl (:eax ,movitz:+other-type-offset+) :ecx)
+ (:cmpb ,(movitz:tag :bignum) :cl)
+ (: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)))
+ (:jne 'not-most-negative-fixnum)
+ (:movl ,(ldb (byte 32 0)
+ (* most-negative-fixnum movitz::+movitz-fixnum-factor+))
+ :eax)
+ (:jmp 'fix-ok)
+ not-most-negative-fixnum
+ (:compile-form (:result-mode :eax)
+ (copy-bignum x))
+ (:notb (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::sign)))
+ (:jmp 'fix-ok)))
+ (:negl :eax)
+ (:jo '(:sub-program (fix-overflow)
+ (:compile-form (:result-mode :eax)
+ ,(1+ movitz:+movitz-most-positive-fixnum+))
+ (:jmp 'fix-ok)))
+ fix-ok
+ )))
+ (do-it)))
+ (2 (minuend subtrahend)
+ (macrolet
+ ((do-it ()
+ `(number-double-dispatch (minuend subtrahend)
+ ((t (eql 0))
+ minuend)
+ (((eql 0) t)
+ (- subtrahend))
+ ((fixnum fixnum)
+ (with-inline-assembly (:returns :eax :side-effects nil)
+ (:compile-two-forms (:eax :ebx) minuend subtrahend)
+ (:subl :ebx :eax)
+ (:into)))
+ ((positive-bignum fixnum)
+ (+ (- subtrahend) minuend))
+ ((fixnum positive-bignum)
+ (- (+ (- minuend) subtrahend)))
+ ((positive-bignum positive-bignum)
+ (cond
+ ((= minuend subtrahend)
+ 0)
+ ((< minuend subtrahend)
+ (let ((x (- subtrahend minuend)))
+ (%negatef x subtrahend minuend)))
+ (t (%bignum-canonicalize
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) (copy-bignum minuend) subtrahend)
+ (:xorl :edx :edx) ; counter
+ (:xorl :ecx :ecx) ; carry
+ sub-loop
+ (:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::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)))
+ (:jne 'sub-loop)
+ (:jmp 'bignum-sub-done)))
+ (:subl :ecx
+ (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+ (:sbbl :ecx :ecx)
+ (:negl :ecx)
+ (:addl 4 :edx)
+ (:cmpw :dx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)))
+ (:jne 'sub-loop)
+ (:subl :ecx
+ (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+ (:jnc 'bignum-sub-done)
+ propagate-carry
+ (:addl 4 :edx)
+ (:subl 1 (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+ (:jc 'propagate-carry)
+ bignum-sub-done
+ )))))
+ (((integer 0 *) (integer * -1))
+ (+ minuend (- subtrahend)))
+ (((integer * -1) (integer 0 *))
+ (%negatef (+ (- minuend) subtrahend) minuend subtrahend))
+ (((integer * -1) (integer * -1))
+ (+ minuend (- subtrahend)))
+ )))
+ (do-it)))
+ (t (minuend &rest subtrahends)
+ (declare (dynamic-extent subtrahends))
+ (if subtrahends
+ (reduce #'- subtrahends :initial-value minuend)
+ (- minuend)))))
;;;
(defun zerop (number)
(= 0 number))
-(define-compiler-macro zerop (number)
- `(= 0 ,number))
-
(defun plusp (number)
(> number 0))
-(define-compiler-macro plusp (number)
- `(> ,number 0))
-
(defun minusp (number)
(< number 0))
-(define-compiler-macro minusp (number)
- `(< ,number 0))
-
-(define-compiler-macro abs (x)
- `(let ((x ,x))
- (if (>= x 0) x (- x))))
-
(defun abs (x)
- (abs x))
+ (compiler-macro-call abs x))
(defun signum (x)
(cond
@@ -995,19 +824,10 @@
;;;
-(define-compiler-macro max (&whole form first-number &rest more-numbers)
- (case (length more-numbers)
- (0 first-number)
- (1 `(let ((x ,first-number)
- (y ,(car more-numbers)))
- (if (>= x y) x y)))
- ((2 3 4)
- `(max ,first-number (max ,@more-numbers)))
- (t form)))
-
(defun max (number1 &rest numbers)
(numargs-case
- (2 (x y) (max x y))
+ (2 (x y)
+ (compiler-macro-call max x y))
(t (number1 &rest numbers)
(declare (dynamic-extent numbers))
(let ((max number1))
@@ -1015,19 +835,10 @@
(when (> x max)
(setq max x)))))))
-(define-compiler-macro min (&whole form first-number &rest more-numbers)
- (case (length more-numbers)
- (0 first-number)
- (1 `(let ((x ,first-number)
- (y ,(car more-numbers)))
- (if (<= x y) x y)))
- ((2 3 4)
- `(min ,first-number (min ,@more-numbers)))
- (t form)))
-
(defun min (number1 &rest numbers)
(numargs-case
- (2 (x y) (min x y))
+ (2 (x y)
+ (compiler-macro-call min x y))
(t (number1 &rest numbers)
(declare (dynamic-extent numbers))
(let ((min number1))
@@ -1037,54 +848,6 @@
;; shift
-(define-compiler-macro ash (&whole form integer count &environment env)
- (if (not (movitz:movitz-constantp count env))
- form
- (let ((count (movitz:movitz-eval count env)))
- (cond
- ((movitz:movitz-constantp integer env)
- (ash (movitz::movitz-eval integer env) count))
- ((= 0 count)
- integer)
- (t form
- #+igore
- (let ((load-integer `((:compile-form (:result-mode :register) ,integer)
- (:testb ,movitz::+movitz-fixnum-zmask+ (:result-register-low8))
- (:jnz '(:sub-program () (:int 107) (:jmp (:pc+ -4)))))))
- (cond
- ((<= 1 count 4)
- `(with-inline-assembly (:returns :register :side-effects nil)
- ,@load-integer
- ,@(loop repeat count
- append `((:addl (:result-register) (:result-register))
- (:into)))))
- ((< 0 count #.(cl:1- movitz::+movitz-fixnum-bits+))
- `(with-inline-assembly (:returns :register :side-effects nil :type integer)
- ,@load-integer
- (:cmpl ,(ash 1 (- (- 31 0) count))
- (:result-register))
- (:jge '(:sub-program () (:int 4)))
- (:cmpl ,(- (ash 1 (- (- 31 0) count)))
- (:result-register))
- (:jl '(:sub-program () (:int 4)))
- (:shll ,count (:result-register))))
- ((= -1 count)
- `(with-inline-assembly (:returns :register :side-effects nil :type integer)
- ,@load-integer
- (:andb #.(cl:logxor #xfe (cl:* 2 movitz::+movitz-fixnum-zmask+)) (:result-register-low8))
- (:sarl 1 (:result-register))))
- ((> 0 count #.(cl:- (cl:1- movitz::+movitz-fixnum-bits+)))
- `(with-inline-assembly (:returns :register :side-effects nil :type integer)
- ,@load-integer
- (:andl ,(ldb (byte 32 0)
- (ash movitz:+movitz-most-positive-fixnum+
- (- movitz:+movitz-fixnum-shift+ count)))
- (:result-register))
- (:sarl ,(- count) (:result-register))))
- ((minusp count)
- `(if (minusp ,integer) -1 0))
- (t `(if (= 0 ,integer) 0 (with-inline-assembly (:returns :non-local-exit) (:int 4)))))))))))
-
(defun ash (integer count)
(cond
((= 0 count)
@@ -1202,30 +965,6 @@
;;; Multiplication
-(define-compiler-macro * (&whole form &rest operands &environment env)
- (case (length operands)
- (0 0)
- (1 (first operands))
- (2 (let ((factor1 (first operands))
- (factor2 (second operands)))
- (cond
- ((and (movitz:movitz-constantp factor1 env)
- (movitz:movitz-constantp factor2 env))
- (* (movitz:movitz-eval factor1 env)
- (movitz:movitz-eval factor2 env)))
- ((movitz:movitz-constantp factor2 env)
- `(* ,(movitz:movitz-eval factor2 env) ,factor1))
- ((movitz:movitz-constantp factor1 env)
- (let ((f1 (movitz:movitz-eval factor1 env)))
- (check-type f1 integer)
- (case f1
- (0 `(progn ,factor2 0))
- (1 factor2)
- (2 `(let ((x ,factor2)) (+ x x)))
- (t `(no-macro-call * ,factor1 ,factor2)))))
- (t `(no-macro-call * ,factor1 ,factor2)))))
- (t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands)))))
-
(defun * (&rest factors)
(numargs-case
(1 (x) x)
@@ -1637,16 +1376,6 @@
(defun byte (size position)
(+ (* size #x400) position))
-(define-compiler-macro byte (&whole form size position)
- (cond
- ((and (integerp size)
- (integerp position))
- (+ (* size #x400) position))
- #+ignore
- ((integerp size)
- `(+ ,position ,(* size #x400)))
- (t form)))
-
(defun byte-size (bytespec)
(truncate bytespec #x400))
@@ -1671,24 +1400,6 @@
(:btl :ecx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))))))))
(do-it)))
-(define-compiler-macro logand (&whole form &rest integers &environment env)
- (let ((constant-folded-integers (loop for x in integers
- with folded-constant = -1
- if (and (movitz:movitz-constantp x env)
- (not (= -1 (movitz:movitz-eval x env))))
- do (setf folded-constant
- (logand folded-constant (movitz:movitz-eval x env)))
- else collect x into non-constants
- finally (return (if (= -1 folded-constant)
- non-constants
- (cons folded-constant non-constants))))))
- (case (length constant-folded-integers)
- (0 0)
- (1 (first constant-folded-integers))
- (2 `(no-macro-call logand ,(first constant-folded-integers) ,(second constant-folded-integers)))
- (t `(logand (logand ,(first constant-folded-integers) ,(second constant-folded-integers))
- ,@(cddr constant-folded-integers))))))
-
(defun logand (&rest integers)
(numargs-case
(1 (x) x)
@@ -1834,24 +1545,6 @@
0
(reduce #'logior integers)))))
-(define-compiler-macro logior (&whole form &rest integers &environment env)
- (let ((constant-folded-integers (loop for x in integers
- with folded-constant = 0
- if (and (movitz:movitz-constantp x env)
- (not (zerop (movitz:movitz-eval x env))))
- do (setf folded-constant
- (logior folded-constant (movitz:movitz-eval x env)))
- else collect x into non-constants
- finally (return (if (= 0 folded-constant)
- non-constants
- (cons folded-constant non-constants))))))
- (case (length constant-folded-integers)
- (0 0)
- (1 (first constant-folded-integers))
- (2 `(no-macro-call logior ,(first constant-folded-integers) ,(second constant-folded-integers)))
- (t `(logior (logior ,(first constant-folded-integers) ,(second constant-folded-integers))
- ,@(cddr constant-folded-integers))))))
-
(defun logxor (&rest integers)
(numargs-case
(1 (x) x)
@@ -2271,104 +1964,10 @@
(:edi (:edi-offset atomically-status))))
ldb-done))))
(do-it)))))))
-
-
-(define-compiler-macro ldb%byte (&whole form &environment env size position integer)
- "This is LDB with explicit byte-size and position parameters."
- (cond
- ((and (movitz:movitz-constantp size env)
- (movitz:movitz-constantp position env)
- (movitz:movitz-constantp integer env))
- (ldb (byte (movitz:movitz-eval size env)
- (movitz:movitz-eval position env))
- (movitz:movitz-eval integer env))) ; constant folding
- ((and (movitz:movitz-constantp size env)
- (movitz:movitz-constantp position env))
- (let* ((size (movitz:movitz-eval size env))
- (position (movitz:movitz-eval position env))
- (result-type `(unsigned-byte ,size)))
- (cond
- ((or (minusp size) (minusp position))
- (error "Negative byte-spec for ldb."))
- ((= 0 size)
- `(progn ,integer 0))
- ((<= (+ size position) (- 31 movitz:+movitz-fixnum-shift+))
- `(with-inline-assembly (:returns :register
- :type ,result-type)
- (:compile-form (:result-mode :eax) ,integer)
- (:call-global-pf unbox-u32)
- (:andl ,(mask-field (byte size position) -1) :ecx)
- ,@(unless (zerop position)
- `((:shrl ,position :ecx)))
- (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) (:result-register))))
- ((<= (+ size position) 32)
- `(with-inline-assembly-case (:type ,result-type)
- (do-case (t :eax :labels (nix done))
- (:compile-form (:result-mode :eax) ,integer)
- ,@(cond
- ((and (= 0 position) (= 32 size))
- ;; If integer is a positive bignum with one bigit, return it.
- `((:leal (:eax ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz 'nix)
- (:cmpl ,(dpb 4 (byte 16 16) (movitz:tag :bignum 0))
- (:eax ,movitz:+other-type-offset+))
- (:je 'done)))
- ((and (= 0 position) (<= (- 32 movitz:+movitz-fixnum-shift+) size ))
- `((:leal (:eax ,(- (movitz:tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz 'nix)
- (:cmpl ,(dpb 4 (byte 16 16) (movitz:tag :bignum 0))
- (:eax ,movitz:+other-type-offset+))
- (:jne 'nix)
- (:movl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))
- :ecx)
- (:testl ,(logxor #xffffffff (mask-field (byte size 0) -1))
- :ecx)
- (:jz 'done)
- (:andl ,(mask-field (byte size 0) -1)
- :ecx)
- (:call-local-pf box-u32-ecx)
- (:jmp 'done))))
- nix
- (:call-global-pf unbox-u32)
- ,@(unless (= 32 (- size position))
- `((:andl ,(mask-field (byte size position) -1) :ecx)))
- ,@(unless (zerop position)
- `((:shrl ,position :ecx)))
- (:call-local-pf box-u32-ecx)
- done)))
- (t form))))
- (t form)))
(defun ldb (bytespec integer)
(ldb%byte (byte-size bytespec) (byte-position bytespec) integer))
-(define-compiler-macro ldb (&whole form &environment env bytespec integer)
- (let ((bytespec (movitz::movitz-macroexpand bytespec env)))
- (if (not (and (consp bytespec) (eq 'byte (car bytespec))))
- form
- `(ldb%byte ,(second bytespec) ,(third bytespec) ,integer))))
-
-(define-setf-expander ldb (bytespec int &environment env)
- "Stolen from the Hyperspec example in the define-setf-expander entry."
- (multiple-value-bind (temps vals stores store-form access-form)
- (get-setf-expansion int env) ;Get setf expansion for int.
- (let ((btemp (gensym)) ;Temp var for byte specifier.
- (store (gensym)) ;Temp var for byte to store.
- (stemp (first stores))) ;Temp var for int to store.
- (if (cdr stores) (error "Can't expand this."))
- ;; Return the setf expansion for LDB as five values.
- (values (cons btemp temps) ;Temporary variables.
- (cons bytespec vals) ;Value forms.
- (list store) ;Store variables.
- `(let ((,stemp (dpb ,store ,btemp ,access-form)))
- ,store-form
- ,store) ;Storing form.
- `(ldb ,btemp ,access-form) ;Accessing form.
- ))))
-
-
(defun ldb-test (bytespec integer)
(case (byte-size bytespec)
(0 nil)
@@ -2456,14 +2055,6 @@
r+1
r)))
(setf r next-r))))))
-
-(define-compiler-macro expt (&whole form base-number power-number &environment env)
- (if (not (and (movitz:movitz-constantp base-number env)
- (movitz:movitz-constantp power-number env)))
- form
- (expt (movitz:movitz-eval base-number env)
- (movitz:movitz-eval power-number env))))
-
(defun expt (base-number power-number)
"Take base-number to the power-number."
1
0