source: branches/ia32/level-0/X86/X8632/x8632-bignum.lisp @ 7916

Last change on this file since 7916 was 7916, checked in by rme, 13 years ago

More work on %normalize-bignum-2.

File size: 8.1 KB
Line 
1(in-package "CCL")
2
3;;; %BIGNUM-REF needs to access bignums as obviously as possible, and it needs
4;;; to be able to return 32 bits somewhere no one looks for real objects.
5;;;
6;;; The easiest thing to do is to store the 32 raw bits in two fixnums
7;;; and return multiple values.
8;;; XXX -- figure out how we're going to handle multiple-values...
9(defx8632lapfunction %bignum-ref ((bignum arg_y) (i arg_z))
10  (movl (% esp) (% temp0))
11  (movzwl (@ (+ 2 x8632::misc-data-offset) (% bignum) (% i)) (% imm0))
12  (box-fixnum imm0 temp1)
13  (push (% temp1))                      ;high
14  (movzwl (@ x8632::misc-data-offset (% bignum) (% i)) (% imm0))
15  (box-fixnum imm0 temp1)
16  (push (% temp1))                      ;low
17  (set-nargs 2)
18  (jmp-subprim .SPvalues))
19
20;;; BIGNUM[I] := DIGIT[0]
21(defx8632lapfunction %set-digit ((bignum 4) #|(ra 0)|# (i arg_y) (digit arg_z))
22  (movl (@ bignum (% esp)) (% temp0))
23  (svref digit 0 imm0)
24  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% i)))
25  (single-value-return 3))
26
27;;; Return the sign of bignum (0 or -1) as a fixnum
28(defx8632lapfunction %bignum-sign ((bignum arg_z))
29  (vector-length bignum imm0)
30  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
31  (sarl ($ 31) (% imm0))                ;propagate sign bit
32  (box-fixnum imm0 arg_z)
33  (single-value-return))
34
35;;; Count the sign bits in the most significant digit of bignum;
36;;; return fixnum count.
37(defx8632lapfunction %bignum-sign-bits ((bignum arg_z))
38  (vector-length bignum imm0)
39  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
40  (mark-as-imm temp0)
41  (movl (% imm0) (% temp0))
42  (notl (% imm0))
43  (testl (% temp0) (% temp0))
44  (js @wasneg)
45  (notl (% imm0))
46  @wasneg
47  (bsrl (% imm0) (% imm0))
48  (sete (% temp0.b))
49  (xorl ($ 31) (% imm0))
50  (addb (% temp0.b) (% imm0.b))
51  (box-fixnum imm0 arg_z)
52  (mark-as-node temp0)
53  (single-value-return))
54
55(defx8632lapfunction %digit-0-or-plusp ((bignum arg_y) (idx arg_z))
56  (movl (@ x8632::misc-data-offset (% bignum) (% idx)) (% imm0))
57  (movl ($ x8632::nil-value) (% temp0))
58  (leal (@ x8632::t-offset (% temp0)) (% arg_z))
59  (testl (% imm0) (% imm0))
60  (cmovll (% temp0) (% arg_z))
61  (single-value-return))
62
63;;; For oddp, evenp
64(defx8632lapfunction %bignum-oddp ((bignum arg_z))
65  (movl (@ x8632::misc-data-offset (% bignum)) (% imm0))
66  (movl ($ x8632::nil-value) (% temp0))
67  (leal (@ x8632::t-offset (% temp0)) (% arg_z))
68  (testb ($ 1) (% imm0.b))
69  (cmovzl (% temp0) (% arg_z))
70  (single-value-return))
71
72(defx8632lapfunction bignum-plusp ((bignum arg_z))
73  (vector-length bignum imm0)
74  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
75  (movl ($ x8632::nil-value) (% temp0))
76  (lea (@ x8632::t-offset (% temp0)) (% arg_z))
77  (testl (% imm0) (% imm0))
78  (cmovlel (% temp0) (% arg_z))
79  (single-value-return))
80
81(defx8632lapfunction bignum-minusp ((bignum arg_z))
82  (vector-length bignum imm0)
83  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
84  (movl ($ x8632::nil-value) (% temp0))
85  (lea (@ x8632::t-offset (% temp0)) (% arg_z))
86  (testl (% imm0) (% imm0))
87  (cmovgl (% temp0) (% arg_z))
88  (single-value-return))
89
90;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum,
91;;; either 0 or 1).  Store the result in R[K], and return the outgoing
92;;; carry.  If I is NIL, A is a fixnum.  If J is NIL, B is a fixnum.
93(defx8632lapfunction %add-with-carry ((r 20) (k 16) (c 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
94  (mark-as-imm temp0)
95  (unbox-fixnum b imm0)                 ;assume that j is going to be nil
96  (cmpl ($ x8632::nil-value) (% j))     ;is j in fact nil?
97  (jne @got-b)
98  (movl (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
99  @got-b
100  (movl (@ a (% esp)) (% arg_y))
101  (unbox-fixnum arg_y temp0)            ;assume that i is going be nil
102  (movl (@ i (% esp)) (% arg_z))
103  (cmpl ($ x8632::nil-value) (% arg_z)) ;is i in fact nil?
104  (jne @got-a)
105  (movl (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
106  @got-a
107  ;; unboxed a or a[i] now in temp0
108  ;; unboxed b or b[j] now in imm0
109  (movl ($ '1) (% arg_z))               ;for outgoing carry
110  (movl (@ c (% esp)) (% arg_y))
111  (testl (% arg_y) (% arg_y))           ;clears carry flag
112  (jz @add)
113  (xorl (% arg_y) (% arg_y))
114  (stc)
115  @add
116  ;; arg_y = 0, arg_z = fixnum 1
117  (adc (% temp0) (% imm0))
118  (movl (@ r (% esp)) (% temp0))
119  (movl (@ k (% esp)) (% temp1))
120  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
121  (cmovnc (% arg_y) (% arg_z))          ;zero outgoing carry if no carry
122  (mark-as-node temp0)
123  (single-value-return 7))
124
125;;; Store the result of A[I] - B[J] - borrow into R[K], returning the borrow.
126;;; If I is NIL, A is a fixnum; likewise for J and B.
127(defx8632lapfunction %subtract-with-borrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
128  (mark-as-imm temp0)
129  (unbox-fixnum b imm0)                 ;assume that j is going to be nil
130  (cmpl ($ x8632::nil-value) (% j))     ;is j in fact nil?
131  (jne @got-b)
132  (movl (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
133  @got-b
134  (movl (@ a (% esp)) (% arg_y))
135  (unbox-fixnum arg_y temp0)            ;assume that i is going be nil
136  (movl (@ i (% esp)) (% arg_z))
137  (cmpl ($ x8632::nil-value) (% arg_z)) ;is i in fact nil?
138  (jne @got-a)
139  (movl (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
140  @got-a
141  ;; unboxed a or a[i] now in temp0
142  ;; unboxed b or b[j] now in imm0
143  (movl ($ '1) (% arg_z))               ;for outgoing carry
144  (movl (@ borrow (% esp)) (% arg_y))
145  (testl (% arg_y) (% arg_y))           ;clears carry flag
146  (jz @sub)
147  (xorl (% arg_y) (% arg_y))
148  (stc)
149  @sub
150  ;; arg_y = 0, arg_z = fixnum 1
151  (sbb (% imm0) (% temp0))
152  (movl (@ r (% esp)) (% temp0))
153  (movl (@ k (% esp)) (% temp1))
154  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
155  (cmovnc (% arg_y) (% arg_z))          ;zero outgoing carry if no carry
156  (mark-as-node temp0)
157  (single-value-return 7))
158
159;;; To normalize a bignum is to drop "trailing" digits which are
160;;; redundant sign information.  When return-fixnum-p is non-nil, make
161;;; the resultant bignum into a fixnum if it fits.
162(defx8632lapfunction %normalize-bignum-2 ((return-fixnum-p arg_y) (bignum arg_z))
163  (push (% return-fixnum-p))
164  (mark-as-imm temp0)
165  (mark-as-imm temp1)
166  (let ((len arg_y)
167        (sign temp0)
168        (next temp1))
169    (vector-length bignum len)
170    (cmpl ($ '1) (% len))
171    (jle @maybe-return-fixnum)
172    ;; Zero trailing sign digits.
173    (push (% len))
174    ;; next-to-last digit
175    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
176    ;; last digit
177    (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% len)) (% sign))
178    (jmp @test)
179    @loop
180    (subl ($ '1) (% len))
181    (movl ($ 0) (@ x8632::misc-data-offset (% bignum) (% len)))
182    (cmpl ($ '1) (% len))               ;any more digits?
183    (je @adjust-length)
184    (movl (% next) (% sign))
185    ;; (bignum-ref bignum (- len 2)), i.e., next-to-last digit
186    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
187    @test
188    (movl (% next) (% imm0))
189    (sarl ($ 31) (% imm0))              ;propagate sign bit
190    (xorl (% sign) (% imm0))
191    (testl (% imm0) (% imm0))           ;whole digit only sign?
192    (jz @loop)
193    ;; New length now in len.
194    @adjust-length
195    (pop (% imm0))                      ;original length
196    (cmpl (% len) (% imm0))
197    ;; If the new length is the same as the original length, we know
198    ;; that the bignum is at least two digits long, and will never fit
199    ;; in a fixnum.  Therefore, there's no need to do either of the
200    ;; tests at @maybe-return-fixnum.
201    (je @done)
202    (movl (% len) (% imm0))
203    (shll ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% imm0))
204    (movb ($ x8632::subtag-bignum) (% imm0.b))
205    (movl (% imm0) (@ x8632::misc-header-offset (% bignum)))
206    @maybe-return-fixnum
207    ;; could use SETcc here to avoid one branch
208    (pop (% return-fixnum-p))
209    (cmpl ($ x8632::nil-value) (@ 0 (% esp))) ;return-fixnum-p
210    (je @done)
211    (cmpl ($ x8632::one-digit-bignum-header) (% bignum))
212    (jne @done)
213    ;; Bignum has one digit.  If it fits in a fixnum, return a fixnum.
214    (movl (@ x8632::misc-data-offset (% bignum)) (% imm0))
215    (box-fixnum imm0 arg_y)
216    (unbox-fixnum arg_y temp0)
217    (cmpl (% temp0) (% imm0))
218    (cmovel (% arg_y) (% arg_z))
219    @done
220    (pop (% imm0))                      ;discard saved return-fixnum-p
221    (mark-as-node temp0)
222    (mark-as-node temp1)
223    (single-value-return)))
Note: See TracBrowser for help on using the repository browser.