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

Last change on this file since 9488 was 9488, checked in by rme, 12 years ago

Correct errors in %multiply-and-add-harder-loop-2. Implement %floor-99.

File size: 32.9 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;;;
9(defx8632lapfunction %bignum-ref ((bignum arg_y) (i arg_z))
10  (movl (% esp) (% temp0))              ;ptr to return addr on stack in 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(defx8632lapfunction %bignum-ref-hi ((bignum arg_y) (i arg_z))
21  (int ($ 3)))
22
23
24
25;;; BIGNUM[I] := DIGIT[0]
26(defx8632lapfunction %set-digit ((bignum 4) #|(ra 0)|# (i arg_y) (digit arg_z))
27  (movl (@ bignum (% esp)) (% temp0))
28  (svref digit 0 imm0)
29  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% i)))
30  (single-value-return 3))
31
32;;; Return the sign of bignum (0 or -1) as a fixnum
33(defx8632lapfunction %bignum-sign ((bignum arg_z))
34  (vector-length bignum imm0)
35  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
36  (sarl ($ 31) (% imm0))                ;propagate sign bit
37  (box-fixnum imm0 arg_z)
38  (single-value-return))
39
40;;; Count the sign bits in the most significant digit of bignum;
41;;; return fixnum count.
42(defx8632lapfunction %bignum-sign-bits ((bignum arg_z))
43  (vector-length bignum imm0)
44  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
45  (mark-as-imm temp0)
46  (movl (% imm0) (% temp0))
47  (notl (% imm0))
48  (testl (% temp0) (% temp0))
49  (js @wasneg)
50  (notl (% imm0))
51  @wasneg
52  (bsrl (% imm0) (% imm0))
53  (sete (% temp0.b))
54  (xorl ($ 31) (% imm0))
55  (addb (% temp0.b) (% imm0.b))
56  (box-fixnum imm0 arg_z)
57  (mark-as-node temp0)
58  (single-value-return))
59
60(defx8632lapfunction %digit-0-or-plusp ((bignum arg_y) (idx arg_z))
61  (movl (@ x8632::misc-data-offset (% bignum) (% idx)) (% imm0))
62  (movl ($ x8632::nil-value) (% temp0))
63  (leal (@ x8632::t-offset (% temp0)) (% arg_z))
64  (testl (% imm0) (% imm0))
65  (cmovll (% temp0) (% arg_z))
66  (single-value-return))
67
68;;; For oddp, evenp
69(defx8632lapfunction %bignum-oddp ((bignum arg_z))
70  (movl (@ x8632::misc-data-offset (% bignum)) (% imm0))
71  (movl ($ x8632::nil-value) (% temp0))
72  (leal (@ x8632::t-offset (% temp0)) (% arg_z))
73  (testb ($ 1) (% imm0.b))
74  (cmovzl (% temp0) (% arg_z))
75  (single-value-return))
76
77(defx8632lapfunction bignum-plusp ((bignum arg_z))
78  (vector-length bignum imm0)
79  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
80  (movl ($ x8632::nil-value) (% arg_z))
81  (lea (@ x8632::t-offset (% arg_z)) (% temp0))
82  (testl (% imm0) (% imm0))
83  (cmovnsl (% temp0) (% arg_z))
84  (single-value-return))
85
86(defx8632lapfunction bignum-minusp ((bignum arg_z))
87  (vector-length bignum imm0)
88  (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% imm0)) (% imm0))
89  (movl ($ x8632::nil-value) (% arg_z))
90  (lea (@ x8632::t-offset (% arg_z)) (% temp0))
91  (testl (% imm0) (% imm0))
92  (cmovsl (% temp0) (% arg_z))
93  (single-value-return))
94
95;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum,
96;;; either 0 or 1).  Store the result in R[K], and return the outgoing
97;;; carry.  If I is NIL, A is a fixnum.  If J is NIL, B is a fixnum.
98(defx8632lapfunction %add-with-carry ((r 20) (k 16) (c 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
99  (mark-as-imm temp0)
100  (unbox-fixnum b imm0)
101  (cmpl ($ x8632::nil-value) (% j))
102  ;; if j not nil, get b[j]
103  (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
104  (movl (@ a (% esp)) (% arg_y))
105  (unbox-fixnum arg_y temp0)
106  (movl (@ i (% esp)) (% arg_z))
107  (cmpl ($ x8632::nil-value) (% arg_z))
108  ;; if i not nil, get a[i]
109  (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
110  (xorl (% arg_z) (% arg_z))
111  ;; I can't think of a better way to set CF at the moment.
112  ;; NEG would be ideal, but we don't have a free imm reg.
113  (btl ($ x8632::fixnumshift) (@ c (% esp))) ;CF = lsb of carry fixnum
114  (adc (% temp0) (% imm0))
115  (setc (% arg_z.bh))
116  (sarl ($ (- 8 x8632::fixnumshift)) (% arg_z)) ;outgoing carry
117  (mark-as-node temp0)
118  (movl (@ r (% esp)) (% temp0))
119  (movl (@ k (% esp)) (% temp1))
120  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
121  (single-value-return 7))
122
123;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum).
124;;; Store the result in R[K], and return the outgoing carry.  If I is
125;;; NIL, A is a fixnum.  If J is NIL, B is a fixnum.
126#+sse2
127(defx8632lapfunction %add-with-carry ((r 20) (k 16) (c 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
128  (let ((aa mm2)
129        (bb mm3)
130        (cc mm4))
131    (unbox-fixnum b imm0)               ;assume j will be nil
132    (cmpl ($ x8632::nil-value) (% j))
133    ;; if j not nil, get b[j]
134    (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
135    (movd (% imm0) (% bb))
136    (movl (@ a (% esp)) (% arg_y))
137    (movl (@ i (% esp)) (% arg_z))
138    (movl (@ c (% esp)) (% temp0))
139    (unbox-fixnum arg_y imm0)           ;assume i will be nil
140    (cmpl ($ x8632::nil-value) (% arg_z))
141    ;; if i not nil, get a[i]
142    (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% imm0))
143    (movd (% imm0) (% aa))
144    (unbox-fixnum temp0 imm0)
145    (movd (% imm0) (% cc))
146    (paddq (% xx) (% yy))
147    (paddq (% cc) (% yy))
148    (movl (@ r (% esp)) (% temp0))
149    (movl (@ k (% esp)) (% temp1))
150    (movd (% yy) (@ x8632::misc-data-offset (% temp0) (% temp1)))
151    (psrlq ($ 32) (% yy))               ;carry bit
152    (movd (% yy) (% imm0))
153    (box-fixnum imm0 arg_z)
154    (single-value-return 7)))
155
156;;; Store the result of A[I] - B[J] - borrow into R[K], returning the borrow.
157;;; If I is NIL, A is a fixnum; likewise for J and B.
158;;;
159;;; (a - b) - (1 - borrow), or equivalently, (a - b) + borrow - 1
160;;;
161;;; Note: borrow is 1 for no borrow and 0 for a borrow.
162(defx8632lapfunction %subtract-with-borrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
163  (mark-as-imm temp0)
164  (unbox-fixnum b imm0)
165  (cmpl ($ x8632::nil-value) (% j))
166  (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
167  (movl (@ a (% esp)) (% arg_y))
168  (unbox-fixnum arg_y temp0)
169  (movl (@ i (% esp)) (% arg_z))
170  (cmpl ($ x8632::nil-value) (% arg_z))
171  (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
172  ;; unboxed a or a[i] in temp0, unboxed b or b[j] in imm0
173  (cmpl ($ '1) (@ borrow (% esp)))      ;CF = 1 if borrow is 0 else CF = 0
174  (sbb (% imm0) (% temp0))
175  (movl ($ 1) (% imm0))
176  (sbb ($ 0) (% imm0))
177  (box-fixnum imm0 arg_z)
178  (movl (% temp0) (% imm0))
179  (mark-as-node temp0)
180  (movl (@ r (% esp)) (% temp0))
181  (movl (@ k (% esp)) (% temp1))
182  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
183  (single-value-return 7))
184
185#+sse2
186(defx8632lapfunction %subtract-with-borrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
187  (let ((aa mm2)
188        (bb mm3)
189        (ww mm4))
190    (unbox-fixnum b imm0)
191    (cmpl ($ x8632::nil-value) (% j))
192    ;; if j not nil, get b[j]
193    (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
194    (movd (% imm0) (% bb))
195    (movl (@ a (% esp)) (% arg_y))
196    (movl (@ i (% esp)) (% arg_z))
197    (movl (@ borrow (% esp)) (% temp0))
198    (unbox-fixnum arg_y imm0)
199    (cmpl ($ x8632::nil-value) (% arg_z))
200    ;; if i not nil, get a[i]
201    (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% imm0))
202    (movd (% imm0) (% aa))
203    (unbox-fixnum temp0 imm0)
204    (subl ($ 1) (% imm0))
205    (movd (% imm0) (% ww))
206    (psubq (% bb) (% aa))
207    (paddq (% ww) (% aa))
208    (movl (@ r (% esp)) (% temp0))
209    (movl (@ k (% esp)) (% temp1))
210    (movd (% aa) (@ x8632::misc-data-offset (% temp0) (% temp1)))
211    (psrlq ($ 32) (% aa))               ;carry digit
212    (movd (% aa) (% imm0))
213    (xorl (% arg_z) (% arg_z))
214    (test ($ 1) (% imm0))
215    (cmovzl ($ '1) (% arg_z))
216    (single-value-return 7)))
217
218(defx8632lapfunction %subtract-one ((high arg_y) (low arg_z))
219  (mark-as-imm temp0)
220  (unbox-fixnum low imm0)
221  (movl (% high) (% temp0))
222  (shll ($ (- 16 x8632::fixnumshift)) (% temp0))
223  (orl (% imm0) (% temp0))
224  (subl ($ 1) (% temp0))
225  (movzwl (% temp0.w) (% imm0))
226  (box-fixnum imm0 low)
227  (sarl ($ 16) (% temp0))
228  (box-fixnum temp0 high)
229  (mark-as-node temp0)
230  (movl (% esp) (% temp0))
231  (push (% high))
232  (push (% low))
233  (jmp-subprim .SPvalues))
234
235;;; %SUBTRACT-WITH-BORROW -- Internal.
236;;;
237;;; This should be in assembler, and should not cons intermediate results.  It
238;;; returns a 32bit digit and a borrow resulting from subtracting b from a, and
239;;; subtracting a possible incoming borrow.
240;;;
241;;; We really do:  a - b - 1 + borrow, where borrow is either 0 or 1.
242;;;
243
244(defx8632lapfunction %subtract-with-borrow-1 ((a-h 12) (a-l 8) (b-h 4) #|(ra 0)|# (b-l arg_y) (borrow arg_z))
245  (mark-as-imm temp0)
246  (mark-as-imm temp1)
247  (unbox-fixnum b-l temp0)
248  (movl (@ b-h (% esp)) (% imm0))
249  (unbox-fixnum imm0 imm0)
250  (shll ($ 16) (% imm0))
251  (orl (% imm0) (% temp0))
252  (movl (@ a-l (% esp)) (% temp1))
253  (unbox-fixnum temp1 temp1)
254  (movl (@ a-h (% esp)) (% imm0))
255  (unbox-fixnum imm0 imm0)
256  (shll ($ 16) (% imm0))
257  (orl (% imm0) (% temp1))
258  (cmpl ($ '1) (% borrow))          ;CF = 1 if borrow is 0 else CF = 0
259  (sbbl (% temp0) (% temp1))
260  (movl ($ 1) (% imm0))
261  (subb ($ 0) (% imm0))
262  (box-fixnum imm0 arg_z)
263  (movzwl (% temp1.w) (% imm0))
264  (box-fixnum imm0 imm0)
265  (popl (% arg_y))                      ;return address
266  (addl ($ '5) (% esp))                 ;discard reserved frame & stack args
267  (pushl (% arg_y))
268  (push (% imm0))                       ;high
269  (sarl ($ 16) (% temp1))
270  (box-fixnum temp1 imm0)
271  (mark-as-node temp0)
272  (mark-as-node temp1)
273  (push (% imm0))                       ;low
274  (push (% arg_z))                      ;borrow
275  (set-nargs 3)
276  (leal (@ '3 (% esp)) (% temp0))
277  (jmp-subprim .SPvalues))
278 
279
280;;; To normalize a bignum is to drop "trailing" digits which are
281;;; redundant sign information.  When return-fixnum-p is non-nil, make
282;;; the resultant bignum into a fixnum if it fits.
283(defx8632lapfunction %normalize-bignum-2 ((return-fixnum-p arg_y) (bignum arg_z))
284  (push (% return-fixnum-p))
285  (mark-as-imm temp0)
286  (mark-as-imm temp1)
287  (let ((len arg_y)
288        (sign temp0)
289        (next temp1))
290    (vector-length bignum len)
291    (cmpl ($ '1) (% len))
292    (jle @maybe-return-fixnum)
293    ;; Zero trailing sign digits.
294    (push (% len))
295    ;; next-to-last digit
296    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
297    ;; last digit
298    (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% len)) (% sign))
299    (jmp @test)
300    @loop
301    (subl ($ '1) (% len))
302    (movl ($ 0) (@ x8632::misc-data-offset (% bignum) (% len)))
303    (cmpl ($ '1) (% len))               ;any more digits?
304    (je @adjust-length)
305    (movl (% next) (% sign))
306    ;; (bignum-ref bignum (- len 2))
307    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
308    @test
309    (movl (% next) (% imm0))
310    (sarl ($ 31) (% imm0))              ;propagate sign bit
311    (xorl (% sign) (% imm0))            ;whole digit only sign?
312    (jz @loop)
313    ;; New length now in len.
314    @adjust-length
315    (pop (% imm0))                      ;original length
316    (cmpl (% len) (% imm0))
317    ;; If the new length is the same as the original length, we know
318    ;; that the bignum is at least two digits long (because if it was
319    ;; shorter, we would have branched directly to
320    ;; @maybe-return-fixnum), and thus won't fit in a fixnum.
321    ;; Therefore, there's no need to do either of the tests at
322    ;; @maybe-return-fixnum.
323    (je @done)
324    (movl (% len) (% imm0))
325    (shll ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% imm0))
326    (movb ($ x8632::subtag-bignum) (% imm0.b))
327    (movl (% imm0) (@ x8632::misc-header-offset (% bignum)))
328    @maybe-return-fixnum
329    ;; could use SETcc here to avoid one branch
330    (cmpl ($ x8632::nil-value) (@ 0 (% esp))) ;return-fixnum-p
331    (je @done)
332    (cmpl ($ x8632::one-digit-bignum-header) (% imm0))
333    (jne @done)
334    ;; Bignum has one digit.  If it fits in a fixnum, return a fixnum.
335    (movl (@ x8632::misc-data-offset (% bignum)) (% imm0))
336    (box-fixnum imm0 arg_y)
337    (unbox-fixnum arg_y temp0)
338    (cmpl (% temp0) (% imm0))
339    (cmovel (% arg_y) (% arg_z))
340    @done
341    (pop (% imm0))                      ;discard saved return-fixnum-p
342    (mark-as-node temp0)
343    (mark-as-node temp1)
344    (single-value-return)))
345
346;;; Multiply X[I] by the unboxed value of the (non-negative) fixnum Y;
347;;; add the incoming carry from CARRY[0] to the 64-bit product.  Store
348;;; the low word of the 64-bit sum in R[0] and the high word in
349;;; CARRY[0].
350(defx8632lapfunction %multiply-and-add ((r 12) (carry 8) (x 4) #|(ra 0)|# (i arg_y) (y arg_z))
351  (let ((xx mm2)
352        (yy mm3)
353        (cc mm4))
354    (movl (@ x (% esp)) (% imm0))
355    (movd (@ x8632::misc-data-offset (% imm0) (% i)) (% xx))
356    (unbox-fixnum y imm0)
357    (movd (% imm0) (% yy))
358    (pmuludq (% xx) (% yy))             ;64 bit product
359    (movl (@ carry (% esp)) (% arg_y))
360    (movd (@ x8632::misc-data-offset (% arg_y)) (% cc))
361    (paddq (% cc) (% yy))               ;add in 32 bit carry digit
362    (movl (@ r (% esp)) (% arg_z))
363    (movd (% yy) (@ x8632::misc-data-offset (% arg_z)))
364    (psrlq ($ 32) (% yy))
365    (movd (% yy) (@ x8632::misc-data-offset (% arg_y)))
366    (single-value-return 5)))
367
368;; multiply x[i] by y and add to result starting at digit i
369(defx8632lapfunction %multiply-and-add-harder-loop-2
370    ((x 12) (y 8) (r 4) #|(ra 0)|# (i arg_y) (ylen arg_z))
371  (let ((cc mm2)
372        (xx mm3)
373        (yy mm4)
374        (rr mm5)
375        (j imm0))
376    (movl (@ x (% esp)) (% temp0))
377    (movd (@ x8632::misc-data-offset (% temp0) (% i)) (% xx)) ;x[i]
378    (movl (@ y (% esp)) (% temp0))
379    (movl (@ r (% esp)) (% temp1))
380    (pxor (% cc) (% cc))
381    (xorl (% j) (% j))
382    @loop
383    (movd (@ x8632::misc-data-offset (% temp0) (% j)) (% yy)) ;y[j]
384    (pmuludq (% xx) (% yy))
385    ;; 64-bit product now in %yy
386    (movd (@ x8632::misc-data-offset (% temp1) (% i)) (% rr))
387    ;; add in digit from r[i]
388    (paddq (% yy) (% rr))
389    ;; add in carry
390    (paddq (% cc) (% rr))
391    (movd (% rr) (@ x8632::misc-data-offset (% temp1) (% i))) ;update r[i]
392    (movq (% rr) (% cc))
393    (psrlq ($ 32) (% cc))               ;get carry digit into low word
394    (addl ($ '1) (% i))
395    (addl ($ '1) (% j))
396    (subl ($ '1) (% ylen))
397    (jg @loop)
398    (movd (% cc) (@ x8632::misc-data-offset (% temp1) (% i)))
399    (single-value-return 5)))
400
401;; this is silly 
402(defx8632lapfunction %add-the-carry ((high 4) #|(ra 0)|# (low arg_y) (c arg_z))
403  (mark-as-imm temp0)
404  (let ((imm1 temp0)
405        (imm1.w temp0.w))
406    (pop (% temp1))
407    (popl (% imm1))                     ;high
408    (discard-reserved-frame)
409    (push (% temp1))
410    (shll ($ (- 16 x8632::fixnumshift)) (% temp0))
411    (unbox-fixnum low imm0)
412    (orl (% imm0) (% imm1))
413    (unbox-fixnum c imm0)
414    (addl (% imm0) (% imm1))
415    (movzwl (% imm1.w) (% imm0))
416    (box-fixnum imm0 temp1)
417    (sarl ($ 16) (% imm1))
418    (shll ($ x8632::fixnumshift) (% imm1))
419    (push (% imm1))                     ;high
420    (push (% temp1)))                   ;low
421  (mark-as-node temp0)
422  (set-nargs 2)
423  (leal (@ '2 (% esp)) (% temp0))
424  (jmp-subprim .SPvalues))
425
426(defx8632lapfunction %bignum-count-trailing-zero-bits ((bignum arg_z))
427  (let ((i arg_y)
428        (len temp0)
429        (zeros temp1))
430    (vector-length bignum temp0)
431    (xorl (% i) (% i))
432    (movl ($ '32) (% zeros))
433    @loop
434    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% imm0))
435    (addl ($ '1) (% i))
436    (addl ($ '32) (% zeros))
437    (testl (% imm0) (% imm0))
438    (jz @loop)
439    ;; now count zero bits in digit
440    (bsrl (% imm0) (% imm0))
441    (box-fixnum imm0 imm0)
442    (addl (% imm0) (% zeros))
443    (movl (% zeros) (% arg_z))
444    (single-value-return)))
445
446;;; dest[i] = (logand x[i] y[i])
447(defx8632lapfunction %bignum-logand ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
448  (let ((i temp0)
449        (xx temp1)
450        (yy arg_y))
451    (movl (@ idx (% esp)) (% i))
452    (movl (@ x (% esp)) (% xx))
453    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
454    (andl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
455    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
456    (single-value-return 4)))
457
458;;; dest[i] = (logandc1 x[i] y[i])
459(defx8632lapfunction %bignum-logandc1 ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
460  (let ((i temp0)
461        (xx temp1)
462        (yy arg_y))
463    (movl (@ idx (% esp)) (% i))
464    (movl (@ x (% esp)) (% xx))
465    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
466    (not (% imm0))
467    (andl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
468    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
469    (single-value-return 4)))
470
471;;; dest[i] = (logandc2 x[i] y[i])
472(defx8632lapfunction %bignum-logandc2 ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
473  (let ((i temp0)
474        (xx temp1)
475        (yy arg_y))
476    (movl (@ idx (% esp)) (% i))
477    (movl (@ x (% esp)) (% xx))
478    (movl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
479    (not (% imm0))
480    (andl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
481    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
482    (single-value-return 4)))
483
484;;; dest[i] = (logior x[i] y[i])
485(defx8632lapfunction %bignum-logior ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
486  (let ((i temp0)
487        (xx temp1)
488        (yy arg_y))
489    (movl (@ idx (% esp)) (% i))
490    (movl (@ x (% esp)) (% xx))
491    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
492    (orl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
493    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
494    (single-value-return 4)))
495
496;;; dest[i] = (lognot x[i])
497(defx8632lapfunction %bignum-lognot ((idx 4) #|(ra 0)|# (x arg_y) (dest arg_z))
498  (let ((i temp0))
499    (movl (@ idx (% esp)) (% i))
500    (movl (@ x8632::misc-data-offset (% x) (% i)) (% imm0))
501    (not (% imm0))
502    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
503    (single-value-return 3)))
504
505;;; dest[i] = (logxor x[i] y[i])
506(defx8632lapfunction %bignum-logxor ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
507  (let ((i temp0)
508        (xx temp1)
509        (yy arg_y))
510    (movl (@ idx (% esp)) (% i))
511    (movl (@ x (% esp)) (% xx))
512    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
513    (xorl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
514    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
515    (single-value-return 4)))
516
517;;; 0 if a[i] = b[i]; 1 if a[i] > b[i]; -1 if a[i] < b[i]
518(defx8632lapfunction %compare-digits ((a 4) #|(ra 0)|# (b arg_y) (i arg_z))
519  (movl (@ a (% esp)) (% temp0))
520  (movl (@ x8632::misc-data-offset (% temp0) (% i)) (% imm0))
521  (movl ($ '1) (% temp0))
522  (movl ($ '-1) (% temp1))
523  (subl (@ x8632::misc-data-offset (% b) (% i)) (% imm0))
524  (cmovgl (% temp0) (% imm0))
525  (cmovll (% temp1) (% imm0))
526  (movl (% imm0) (% arg_z))
527  (single-value-return 3))
528
529;; returns number of bits in digit-hi,digit-lo that are sign bits
530;; 32 - digits-sign-bits is integer-length
531(defx8632lapfunction %digits-sign-bits ((hi arg_y) (lo arg_z))
532  (mark-as-imm temp0)
533  (shll ($ (- 16 x8632::fixnumshift)) (% hi))
534  (unbox-fixnum lo imm0)
535  (orl (% hi) (% imm0))
536  (movl (% imm0) (% temp0))
537  (not (% imm0))
538  (testl (% temp0) (% temp0))
539  (js @wasneg)
540  (not (% imm0))
541  @wasneg
542  (bsrl (% imm0) (% imm0))
543  (sete (% temp0.b))
544  (xorl ($ 31) (% imm0))
545  (addb (% temp0.b) (% imm0.b))
546  (box-fixnum imm0 arg_z)
547  (mark-as-node temp0)
548  (single-value-return))
549
550(defx8632lapfunction macptr->fixnum ((ptr arg_z))
551  (macptr-ptr arg_z ptr)
552  (single-value-return))
553
554; if dest not nil store unboxed result in dest(0), else return a fixnum
555(defx8632lapfunction fix-digit-logandc2 ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
556  (mark-as-imm temp0)
557  (movl (@ fix (% esp)) (% temp0))
558  (unbox-fixnum temp0 temp0)
559  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
560  (not (% imm0))
561  (andl (% temp0) (% imm0))
562  (mark-as-node temp0)
563  (cmpl ($ x8632::nil-value) (% dest))
564  (jne @store)
565  (box-fixnum imm0 arg_z)
566  (single-value-return 3)
567  @store
568  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
569  (single-value-return 3))
570
571(defx8632lapfunction fix-digit-logandc1 ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
572  (mark-as-imm temp0)
573  (movl (@ fix (% esp)) (% temp0))
574  (unbox-fixnum temp0 temp0)
575  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
576  (not (% temp0))
577  (andl (% temp0) (% imm0))
578  (mark-as-node temp0)
579  (cmpl ($ x8632::nil-value) (% dest))
580  (jne @store)
581  (box-fixnum imm0 arg_z)
582  (single-value-return 3)
583  @store
584  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
585  (single-value-return 3))
586
587(defx8632lapfunction fix-digit-logand ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
588  (mark-as-imm temp0)
589  (movl (@ fix (% esp)) (% temp0))
590  (sarl ($ x8632::fixnumshift) (% temp0))
591  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
592  (andl (% temp0) (% imm0))
593  (mark-as-node temp0)
594  (cmpl ($ x8632::nil-value) (% dest))
595  (jne @store)
596  (box-fixnum imm0 arg_z)
597  (single-value-return 3)
598  @store
599  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
600  (single-value-return 3))
601
602
603(defx8632lapfunction digit-lognot-move ((index 4) #|(ra 0)|# (source arg_y) (dest arg_z))
604  (movl (@ index (% esp)) (% temp0))
605  (movl (@ x8632::misc-data-offset (% source) (% temp0)) (% imm0))
606  (not (% imm0))
607  (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% temp0)))
608  (single-value-return 3))
609
610;; Add b to a starting at a[i]
611;; might want not to use SSE2 for this.  use lea to update loop counter
612;; variables so that the flags don't get set.
613(defx8632lapfunction bignum-add-loop-+ ((i 8) (a 4) #|(ra 0)|# (b arg_y) (blen arg_z))
614  (let ((aa mm2)
615        (bb mm3)
616        (cc mm4))
617    (movl (@ a (% esp)) (% temp0))
618    (movl (@ i (% esp)) (% temp1))
619    (xorl (% imm0) (% imm0))
620    (pxor (% cc) (% cc))
621    @loop
622    (movd (@ x8632::misc-data-offset (% temp0) (% temp1)) (% aa))
623    (movd (@ x8632::misc-data-offset (% b) (% imm0)) (% bb))
624    (paddq (% bb) (% aa))
625    (paddq (% cc) (% aa))
626    (movd (% aa) (@ x8632::misc-data-offset (% temp0) (% temp1)))
627    (psrlq ($ 32) (% aa))
628    (movq (% aa) (% cc))
629    (addl ($ '1) (% temp1))
630    (addl ($ '1) (% imm0))
631    (subl ($ '1) (% blen))
632    (jg @loop)
633    ;; add in final carry
634    (movd (% cc) (% imm0))
635    (addl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
636    (single-value-return 4)))
637
638(defx8632lapfunction bignum-logtest-loop ((count 4) #|(ra 0)|# (s1 arg_y) (s2 arg_z))
639  (let ((i temp1)
640        (c temp0))
641    (movl (@ count (% esp)) (% c))
642    (xorl (% i) (% i))
643    @loop
644    (movl (@ x8632::misc-data-offset (% s1) (% i)) (% imm0))
645    (test (@ x8632::misc-data-offset (% s2) (% i)) (% imm0))
646    (jnz @true)
647    (addl ($ '1) (% i))
648    (cmpl (% i) (% c))
649    (jg @loop)
650    (movl ($ x8632::nil-value) (% arg_z))
651    (single-value-return 3)
652    @true
653    (movl ($ x8632::t-value) (% arg_z))
654    (single-value-return 3)))
655
656(defx8632lapfunction bignum-shift-left-loop ((nbits 12) (result 8)
657                                             (bignum 4) #|(ra 0)|#
658                                             (res-len-1 arg_y) (j arg_z))
659  (movl (@ nbits (% esp)) (% imm0))
660  (sarl ($ x8632::fixnumshift) (% imm0))
661  (movd (% imm0) (% mm7))               ;shift count
662  (subl ($ 32) (% imm0))
663  (movd (% imm0) (% mm6))               ;remaining bits
664  (movl (@ result (% esp)) (% temp0))
665  (movl (@ bignum (% esp)) (% temp1))
666  (push (% arg_z))
667  (push (% arg_y))
668  (xorl (% arg_y) (% arg_y))            ;i
669  (jmp @test)
670  @loop
671  (movd (@ x8632::misc-data-offset (% temp1) (% arg_y)) (% mm0)) ;b[i]
672  (psrlq (% mm6) (% mm0))
673  (movd (@ (+ 4 x8632::misc-data-offset) (% temp1) (% arg_y)) (% mm1)) ;b[i+1]
674  (psllq (% mm7) (% mm1))
675  (por (% mm1) (% mm0))
676  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_z))) ;r[j]
677  (addl ($ '1) (% arg_y))
678  (addl ($ '1) (% arg_z))
679  @test
680  (cmpl (@ (% esp)) (% j))              ;pity res-len-1 can't stay in a reg
681  (jne @loop)
682  (add ($ '1) (% esp))                  ;discard pushed res-len-1
683  (movd (@ x8632::misc-data-offset (% temp1) (% arg_y)) (% mm0)) ;b[i]
684  (psrlq (% mm6) (% mm0))
685  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_z))) ;r[j]
686  ;; reconstitute "digits" arg to bignum-ashift-left-unaligned
687  (pop (% arg_z))
688  (subl ($ '1) (% arg_z))
689  (movd (@ x8632::misc-data-offset (% temp1)) (% mm0)) ;b[0]
690  (psllq (% mm7) (% mm0))
691  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_z))) ;b[digits]
692  (single-value-return 5))
693
694(defx8632lapfunction %logcount-complement ((bignum arg_y) (i arg_z))
695  (mark-as-imm temp0)
696  (let ((rshift imm0)
697        (temp temp0))
698    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% rshift))
699    (notl (% rshift))
700    (xorl (% arg_z) (% arg_z))
701    (testl (% rshift) (% rshift))
702    (jmp @test)
703    @next
704    (lea (@ -1 (% rshift)) (% temp))
705    (and (% temp) (% rshift))           ;sets flags
706    (lea (@ '1 (% arg_z)) (% arg_z))    ;doesn't set flags
707    @test
708    (jne @next)
709    (mark-as-node temp0)
710    (single-value-return)))
711
712(defx8632lapfunction %logcount ((bignum arg_y) (i arg_z))
713  (mark-as-imm temp0)
714  (let ((rshift imm0)
715        (temp temp0))
716    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% rshift))
717    (xorl (% arg_z) (% arg_z))
718    (testl (% rshift) (% rshift))
719    (jmp @test)
720    @next
721    (lea (@ -1 (% rshift)) (% temp))
722    (and (% temp) (% rshift))           ;sets flags
723    (lea (@ '1 (% arg_z)) (% arg_z))    ;doesn't set flags
724    @test
725    (jne @next)
726    (mark-as-node temp0)
727    (single-value-return)))
728
729
730;;; Divide bignum x by single digit y (passed as two halves).
731;;; The quotient in stored in q, and the remainder is returned
732;;; in two halves.  (cf. Knuth, 4.3.1, exercise 16)
733(defx8632lapfunction %floor-loop-quo ((x 8) (res 4) #|(ra 0)|# (yhi arg_y) (ylo arg_z))
734  (compose-digit yhi ylo imm0)
735  (movl (% imm0) (@ (% :rcontext) x8632::tcr.unboxed0))
736  (pop (% temp0))
737  (pop (% arg_z))                       ;res
738  (pop (% arg_y))                       ;x
739  (discard-reserved-frame)
740  (push (% temp0))
741  (mark-as-imm edx)                     ;aka temp1
742  (let ((bignum arg_y)                  ;bignum dividend
743        (result arg_z))                 ;bignum result (quotient)
744    (xorl (% edx) (% edx))
745    (vector-length bignum temp0)
746    (jmp @next)
747    @loop
748    (movl (@ x8632::misc-data-offset (% bignum) (% temp0)) (% eax))
749    (divl (@ (% :rcontext) x8632::tcr.unboxed0))
750    (movl (% eax) (@ x8632::misc-data-offset (% result) (% temp0)))
751    @next
752    (subl ($ '1) (% temp0))
753    (jge @loop))
754  (movl (% esp) (% temp0))
755  ;; extract and push high half of remainder
756  (movl ($ (- #x10000)) (% arg_y))
757  (andl (% edx) (% arg_y))
758  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
759  (push (% arg_y))
760  ;; extract and push low half
761  (shll ($ 16) (% edx))
762  (shrl ($ (- 16 x8632::fixnumshift)) (% edx))
763  (push (% edx))
764  (mark-as-node edx)
765  (set-nargs 2)
766  (jmp-subprim .SPvalues))
767
768;;; For TRUNCATE-BY-FIXNUM et al.
769;;; Doesn't store quotient: just returns rem in 2 halves.
770;;; Could avoid using tcr.unboxed0 if it matters...
771(defx8632lapfunction %floor-loop-no-quo ((x 4) #|(ra 0)|# (yhi arg_y) (ylo arg_z))
772  (compose-digit yhi ylo imm0)
773  (movl (% imm0) (@ (% :rcontext) x8632::tcr.unboxed0))
774  (pop (% temp0))
775  (pop (% arg_y))
776  (discard-reserved-frame)
777  (push (% temp0))
778  (mark-as-imm edx)                     ;aka temp1
779  (let ((bignum arg_y)                  ;bignum dividend
780        (result arg_z))                 ;bignum result (quotient)
781    (xorl (% edx) (% edx))
782    (vector-length bignum temp0)
783    (jmp @next)
784    @loop
785    (movl (@ x8632::misc-data-offset (% bignum) (% temp0)) (% eax))
786    (divl (@ (% :rcontext) x8632::tcr.unboxed0))
787    ;;(movl (% eax) (@ x8632::misc-data-offset (% result) (% temp0)))
788    @next
789    (subl ($ '1) (% temp0))
790    (jge @loop))
791  (movl (% esp) (% temp0))
792  ;; extract and push high half of remainder
793  (movl ($ (- #x10000)) (% arg_y))
794  (andl (% edx) (% arg_y))
795  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
796  (push (% arg_y))
797  ;; extract and push low half
798  (shll ($ 16) (% edx))
799  (shrl ($ (- 16 x8632::fixnumshift)) (% edx))
800  (push (% edx))
801  (mark-as-node edx)
802  (set-nargs 2)
803  (jmp-subprim .SPvalues))
804
805(defx8632lapfunction truncate-guess-loop ((guess-h 16) (guess-l 12) (x 8)
806                                          (xidx 4) #|(ra 0)|#
807                                          (yptr arg_y) (yidx arg_z))
808  (int ($ 3)))
809
810;;; If x[i] = y[j], return the all ones digit (as two halves).
811;;; Otherwise, compute floor x[i]x[i-1] / y[j].
812(defx8632lapfunction %floor-99 ((x-stk 8) (xidx 4) #|(ra 0)|#
813                                (yptr arg_y) (yidx arg_z))
814  (pop (% temp0))
815  (pop (% imm0))
816  (pop (% temp1))
817  (discard-reserved-frame)
818  (push (% temp1))
819  (movl (% imm0) (% temp1))
820  (movl (@ (% temp0) (% temp1)) (% imm0)) ;x[i]
821  (cmpl (% imm0) (@ (% yptr) (% yidx)))   ;y[j]
822  (jne @more)
823  (pushl ($ '#xffff))
824  (pushl ($ '#xffff))
825  (lea (@ '2 (% esp)) (% temp0))
826  (set-nargs 2)
827  (jmp-subprim .SPvalues)
828  @more
829  (mark-as-imm edx)                     ;aka temp1 (contains a fixnum)
830  (movl (@ -4 (% temp0) (% temp1)) (% eax)) ;low digit
831  (movl (@ (% temp0) (% temp1)) (% edx))    ;high digit
832  (divl (@ (% yptr) (% yidx)))
833  (mark-as-node edx)
834  ;; extract and push high half of quotient
835  (movl ($ (- #x10000)) (% arg_y))
836  (andl (% eax) (% arg_y))
837  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
838  (push (% arg_y))
839  ;; extract and push low half
840  (shrl ($ 16) (% eax))
841  (shll ($ x8632::fixnumshift) (% eax))
842  (push (% eax))
843  (set-nargs 2)
844  (lea (@ '2 (% esp)) (% temp0))
845  (jmp-subprim .SPvalues))
846
847(defx8632lapfunction %multiply-and-add-1 ((x-high 16)
848                                          (x-low 12)
849                                          (y-high 8)
850                                          (y-low 4)
851                                          #|(ra 0)|#
852                                          (carry-in-high arg_y)
853                                          (carry-in-low arg_z))
854  (int ($ 3)))
855
856;;; Copy the limb SRC points to to where DEST points.
857(defx8632lapfunction copy-limb ((src arg_y) (dest arg_z))
858  (int ($ 3)))
859
860;;; Return T iff LIMB contains 0.
861(defx8632lapfunction limb-zerop ((limb arg_z))
862  (int ($ 3)))
863
864;;; Return -1,0,1 according to whether the contents of Y are
865;;; <,=,> the contents of Z.
866(defx8632lapfunction compare-limbs ((y arg_y) (z arg_z))
867  (int ($ 3)))
868
869;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
870(defx8632lapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
871  (int ($ 3)))
872
873;;; Store a fixnum value where LIMB points.
874(defx8632lapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
875  (int ($ 3)))
876
877;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
878;;; knows that carries will only propagate for a word or two.
879(defx8632lapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
880  (int ($ 3)))
881
882;;; Store XP-YP at WP; return carry (0 or 1).
883;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
884;;; size: boxed fixnum
885;;; returns boxed carry
886(defx8632lapfunction mpn-sub-n ((wp 8) (xp 4) #|(ra 0)|#
887                                (yp arg_y) (size arg_z))
888  (int ($ 3)))
889
890;;; Store XP+YP at WP; return carry (0 or 1).
891;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
892;;; size = boxed fixnum
893;;; result = boxed carry
894(defx8632lapfunction mpn-add-n ((wp 8) (xp 4) #|(ra 0)|#
895                                (yp arg_y) (size arg_z))
896  (int ($ 3)))
897
898;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
899;;; result at RP.  RP and S1P may be the same place, so check for
900;;; that and do nothing after carry stops propagating.  Return carry.
901(defx8632lapfunction mpn-add-1 ((rp-offset 8) (s1p 4) #|(ra 0)|#
902                                (size arg_y) (limb arg_z))
903  (int ($ 3)))
904
905;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
906;;; the result at RES.  Store the "carry out" (high word of last 64-bit
907;;; partial product) at the limb RESULT.
908;;; res, s1, limbptr, result:
909;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
910;;; It'd be hard to transliterate the GMP code here; the GMP version
911;;; uses lots more immediate registers than we can easily use in LAP
912;;; (and is much more aggressively pipelined).
913(defx8632lapfunction mpn-mul-1 ((res-offset 12)
914                                (s1-offset 8)
915                                (size 4)
916                                #|(ra 0)|#
917                                (limbptr arg_y)
918                                (result arg_z))
919  (int ($ 3)))
920
921;;; multiply s1*limb and add result to res
922;;; res, s1, limbptr, result:
923;;;   unboxed, word-aligned ptrs (fixnums).
924;;; size: boxed fixnum
925;;; limbptr: source "limb".
926;;; result: carry out (high word of product).
927(defx8632lapfunction mpn-addmul-1 ((res-offset 12)
928                                   (s1-offset 8)
929                                   (size 4)
930                                   #|(ra 0)|#
931                                   (limbptr arg_y)
932                                   (result arg_z))
933  (int ($ 3)))
934
935;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
936;;; at VP, store the result at RP.
937(defx8632lapfunction mpn-mul-basecase ((rp-offset 12)
938                                       (up-offset 8)
939                                       (un 4)
940                                       #|(ra 0)|#
941                                       (vp arg_y)
942                                       (vn arg_z))
943  (int ($ 3)))
944
945;;; left-shift src by 1 bit, storing result at res.  Return
946;;; the bit that was shifted out.
947(defx8632lapfunction mpn-lshift-1 ((resptr 4) #|(ra 0)|#
948                                   (s1ptr arg_y) (size-arg arg_z))
949  (int ($ 3)))
950
951;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
952;;; result (low word first) at RESULT.
953(defx8632lapfunction umulppm ((x 4) #|(ra 0)|# (y arg_y) (result arg_z))
954  (int ($ 3)))
955
956(defx8632lapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
957  (unbox-fixnum fixnum imm0)
958  (movl (% imm0) (@ x8632::misc-data-offset (% bignum)))
959  (single-value-return))
960
961(defx8632lapfunction bignum-negate-loop-really ((bignum 4) #|(ra 0)|# 
962                                                (len arg_y) (result arg_z))
963  (mark-as-imm edx)                     ;aka %temp1
964  (unbox-fixnum arg_y edx)
965  (movl (@ bignum (% esp)) (% arg_y))
966  (xorl (% temp0) (% temp0))
967  (stc)
968  @loop
969  (movl (@ x8632::misc-data-offset (% arg_y) (% temp0)) (% imm0))
970  (not (% imm0))
971  (adc ($ 0) (% imm0))
972  (movl (% imm0) (@ x8632::misc-data-offset (% arg_z) (% temp0)))
973  (lea (@ x8632::node-size (% temp0)) (% temp0))
974  (decl (% edx))                        ;preserves carry flag
975  (jg @loop)
976  ;; return carry
977  (setc (% imm0.b))
978  (movzbl (% imm0.b) (% imm0))
979  (box-fixnum imm0 arg_z)
980  (mark-as-node edx)
981  (single-value-return 3))
982
983(defx8632lapfunction %bignum-set ((bignum 8) (i 4) #|(ra 0)|#
984                                  (high arg_y) (low arg_z))
985  (compose-digit high low imm0)
986  (movl (@ bignum (% esp)) (% arg_z))
987  (movl (@ i (% esp)) (% arg_y))
988  (movl (% imm0) (@ x8632::misc-data-offset (% arg_z) (% arg_y)))
989  (single-value-return 4))
990
Note: See TracBrowser for help on using the repository browser.