source: trunk/source/level-0/X86/X8632/x8632-bignum.lisp @ 10923

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

In %SUBTRACT-WITH-BORROW-1, zero-extend the borrow into the entire
register (the setae instruction only affects the low byte).

This should fix the bug in ticket:341.

Other stuff I noticed while I was in there:

Make %SUBTRACT-ONE work. In %FLOOR-99, swap use of %temp0/%temp1 to
make the comment at @more about temp1 containing a fixnum code be true (and
not incidentally, make the code gc-safe).

File size: 38.2 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  (movzwl (@ (+ 2 x8632::misc-data-offset) (% bignum) (% i)) (% imm0))
22  (box-fixnum imm0 arg_z)
23  (single-value-return))
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  (shll ($ (- 16 x8632::fixnumshift)) (% arg_y))
220  (unbox-fixnum low imm0)
221  ;; high half should always be clear...
222  ;;(movzwl (% imm0.w) (% imm0))
223  (orl (% arg_y) (% imm0))
224  (decl (% imm0))
225  (movl (% esp) (% temp0))
226  ;; extract and push high half
227  (movl ($ (- #x10000)) (% arg_y))
228  (andl (% imm0) (% arg_y))
229  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
230  (push (% arg_y))
231  ;; low half
232  (andl ($ #xffff) (% imm0))
233  (shll ($ x8632::fixnumshift) (% imm0))
234  (push (% imm0))
235  (set-nargs 2)
236  (jmp-subprim .SPvalues))
237
238;;; %SUBTRACT-WITH-BORROW -- Internal.
239;;;
240;;; This should be in assembler, and should not cons intermediate results.  It
241;;; returns a 32bit digit and a borrow resulting from subtracting b from a, and
242;;; subtracting a possible incoming borrow.
243;;;
244;;; We really do:  a - b - 1 + borrow, where borrow is either 0 or 1.
245;;;
246
247(defx8632lapfunction %subtract-with-borrow-1 ((a-h 12) (a-l 8) (b-h 4) #|(ra 0)|# (b-l arg_y) (borrow arg_z))
248  (mark-as-imm temp0)
249  (mark-as-imm temp1)
250  (unbox-fixnum b-l temp0)
251  (movl (@ b-h (% esp)) (% imm0))
252  (sarl ($ x8632::fixnumshift) (% imm0))
253  (shll ($ 16) (% imm0))
254  (orl (% imm0) (% temp0))              ;b in temp0
255  (movl (@ a-l (% esp)) (% temp1))
256  (sarl ($ x8632::fixnumshift) (% temp1))
257  (movl (@ a-h (% esp)) (% imm0))
258  (sarl ($ x8632::fixnumshift) (% imm0))
259  (shll ($ 16) (% imm0))
260  (orl (% imm0) (% temp1))          ;a in temp1
261
262  (unbox-fixnum borrow imm0)
263  (subl ($ 1) (% imm0))                 ;sets carry appropriately
264  (sbbl (% temp0) (% temp1))
265  (setae (%b imm0))                     ;resulting borrow (1 for no, 0 for yes)
266  (movzbl (%b imm0) (% imm0))
267  (box-fixnum imm0 arg_z)
268  (movl (% temp1) (% imm0))
269  (andl ($ (- #x10000)) (% imm0))
270  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0))
271  (popl (% arg_y))                      ;return address
272  (addl ($ '5) (% esp))                 ;discard reserved frame & stack args
273  (pushl (% arg_y))
274  (push (% imm0))                       ;high
275  (andl ($ #xffff) (% temp1))
276  (box-fixnum temp1 imm0)
277  (mark-as-node temp0)
278  (mark-as-node temp1)
279  (push (% imm0))                       ;low
280  (push (% arg_z))                      ;borrow
281  (set-nargs 3)
282  (leal (@ '3 (% esp)) (% temp0))
283  (jmp-subprim .SPvalues))
284 
285
286;;; To normalize a bignum is to drop "trailing" digits which are
287;;; redundant sign information.  When return-fixnum-p is non-nil, make
288;;; the resultant bignum into a fixnum if it fits.
289(defx8632lapfunction %normalize-bignum-2 ((return-fixnum-p arg_y) (bignum arg_z))
290  (push (% return-fixnum-p))
291  (mark-as-imm temp0)
292  (mark-as-imm temp1)
293  (let ((len arg_y)
294        (sign temp0)
295        (next temp1))
296    (vector-length bignum len)
297    (cmpl ($ '1) (% len))
298    (jle @maybe-return-fixnum)
299    ;; Zero trailing sign digits.
300    (push (% len))
301    ;; next-to-last digit
302    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
303    ;; last digit
304    (movl (@ (- x8632::misc-data-offset 4) (% bignum) (% len)) (% sign))
305    (jmp @test)
306    @loop
307    (subl ($ '1) (% len))
308    (movl ($ 0) (@ x8632::misc-data-offset (% bignum) (% len)))
309    (cmpl ($ '1) (% len))               ;any more digits?
310    (je @adjust-length)
311    (movl (% next) (% sign))
312    ;; (bignum-ref bignum (- len 2))
313    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
314    @test
315    (movl (% next) (% imm0))
316    (sarl ($ 31) (% imm0))              ;propagate sign bit
317    (xorl (% sign) (% imm0))            ;whole digit only sign?
318    (jz @loop)
319    ;; New length now in len.
320    @adjust-length
321    (pop (% imm0))                      ;original length
322    (cmpl (% len) (% imm0))
323    ;; If the new length is the same as the original length, we know
324    ;; that the bignum is at least two digits long (because if it was
325    ;; shorter, we would have branched directly to
326    ;; @maybe-return-fixnum), and thus won't fit in a fixnum.
327    ;; Therefore, there's no need to do either of the tests at
328    ;; @maybe-return-fixnum.
329    (je @done)
330    (movl (% len) (% imm0))
331    (shll ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% imm0))
332    (movb ($ x8632::subtag-bignum) (% imm0.b))
333    (movl (% imm0) (@ x8632::misc-header-offset (% bignum)))
334    @maybe-return-fixnum
335    ;; could use SETcc here to avoid one branch
336    (cmpl ($ x8632::nil-value) (@ 0 (% esp))) ;return-fixnum-p
337    (je @done)
338    (cmpl ($ x8632::one-digit-bignum-header)
339          (@ x8632::misc-header-offset (% bignum)))
340    (jne @done)
341    ;; Bignum has one digit.  If it fits in a fixnum, return a fixnum.
342    (movl (@ x8632::misc-data-offset (% bignum)) (% imm0))
343    (box-fixnum imm0 arg_y)
344    (unbox-fixnum arg_y temp0)
345    (cmpl (% temp0) (% imm0))
346    (cmovel (% arg_y) (% arg_z))
347    @done
348    (pop (% imm0))                      ;discard saved return-fixnum-p
349    (mark-as-node temp0)
350    (mark-as-node temp1)
351    (single-value-return)))
352
353;;; Multiply X[I] by the unboxed value of the (non-negative) fixnum Y;
354;;; add the incoming carry from CARRY[0] to the 64-bit product.  Store
355;;; the low word of the 64-bit sum in R[0] and the high word in
356;;; CARRY[0].
357(defx8632lapfunction %multiply-and-add ((r 12) (carry 8) (x 4) #|(ra 0)|# (i arg_y) (y arg_z))
358  (let ((xx mm2)
359        (yy mm3)
360        (cc mm4))
361    (movl (@ x (% esp)) (% imm0))
362    (movd (@ x8632::misc-data-offset (% imm0) (% i)) (% xx))
363    (unbox-fixnum y imm0)
364    (movd (% imm0) (% yy))
365    (pmuludq (% xx) (% yy))             ;64 bit product
366    (movl (@ carry (% esp)) (% arg_y))
367    (movd (@ x8632::misc-data-offset (% arg_y)) (% cc))
368    (paddq (% cc) (% yy))               ;add in 32 bit carry digit
369    (movl (@ r (% esp)) (% arg_z))
370    (movd (% yy) (@ x8632::misc-data-offset (% arg_z)))
371    (psrlq ($ 32) (% yy))
372    (movd (% yy) (@ x8632::misc-data-offset (% arg_y)))
373    (single-value-return 5)))
374
375;; multiply x[i] by y and add to result starting at digit i
376(defx8632lapfunction %multiply-and-add-harder-loop-2
377    ((x 12) (y 8) (r 4) #|(ra 0)|# (i arg_y) (ylen arg_z))
378  (let ((cc mm2)
379        (xx mm3)
380        (yy mm4)
381        (rr mm5)
382        (j imm0))
383    (movl (@ x (% esp)) (% temp0))
384    (movd (@ x8632::misc-data-offset (% temp0) (% i)) (% xx)) ;x[i]
385    (movl (@ y (% esp)) (% temp0))
386    (movl (@ r (% esp)) (% temp1))
387    (pxor (% cc) (% cc))
388    (xorl (% j) (% j))
389    @loop
390    (movd (@ x8632::misc-data-offset (% temp0) (% j)) (% yy)) ;y[j]
391    (pmuludq (% xx) (% yy))
392    ;; 64-bit product now in %yy
393    (movd (@ x8632::misc-data-offset (% temp1) (% i)) (% rr))
394    ;; add in digit from r[i]
395    (paddq (% yy) (% rr))
396    ;; add in carry
397    (paddq (% cc) (% rr))
398    (movd (% rr) (@ x8632::misc-data-offset (% temp1) (% i))) ;update r[i]
399    (movq (% rr) (% cc))
400    (psrlq ($ 32) (% cc))               ;get carry digit into low word
401    (addl ($ '1) (% i))
402    (addl ($ '1) (% j))
403    (subl ($ '1) (% ylen))
404    (jg @loop)
405    (movd (% cc) (@ x8632::misc-data-offset (% temp1) (% i)))
406    (single-value-return 5)))
407
408;; this is silly 
409(defx8632lapfunction %add-the-carry ((high 4) #|(ra 0)|# (low arg_y) (c arg_z))
410  (mark-as-imm temp0)
411  (let ((imm1 temp0)
412        (imm1.w temp0.w))
413    (pop (% temp1))
414    (popl (% imm1))                     ;high
415    (discard-reserved-frame)
416    (push (% temp1))
417    (shll ($ (- 16 x8632::fixnumshift)) (% temp0))
418    (unbox-fixnum low imm0)
419    (orl (% imm0) (% imm1))
420    (unbox-fixnum c imm0)
421    (addl (% imm0) (% imm1))
422    (movzwl (% imm1.w) (% imm0))
423    (box-fixnum imm0 temp1)
424    (sarl ($ 16) (% imm1))
425    (shll ($ x8632::fixnumshift) (% imm1))
426    (push (% imm1))                     ;high
427    (push (% temp1)))                   ;low
428  (mark-as-node temp0)
429  (set-nargs 2)
430  (leal (@ '2 (% esp)) (% temp0))
431  (jmp-subprim .SPvalues))
432
433(defx8632lapfunction %bignum-count-trailing-zero-bits ((bignum arg_z))
434  (let ((i arg_y)
435        (len temp0)
436        (zeros temp1))
437    (vector-length bignum temp0)
438    (xorl (% i) (% i))
439    (xorl (% zeros) (% zeros))
440    @loop
441    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% imm0))
442    (testl (% imm0) (% imm0))
443    (jnz @last)
444    (addl ($ '32) (% zeros))
445    (addl ($ '1) (% i))
446    (cmpl (% len) (% i))
447    (jb @loop)
448    @last
449    ;; now count zero bits in digit
450    (bsfl (% imm0) (% imm0))
451    (shll ($ x8632::fixnumshift) (% imm0))
452    (addl (% imm0) (% zeros))
453    (movl (% zeros) (% arg_z))
454    (single-value-return)))
455
456;;; dest[i] = (logand x[i] y[i])
457(defx8632lapfunction %bignum-logand ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
458  (let ((i temp0)
459        (xx temp1)
460        (yy arg_y))
461    (movl (@ idx (% esp)) (% i))
462    (movl (@ x (% esp)) (% xx))
463    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
464    (andl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
465    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
466    (single-value-return 4)))
467
468;;; dest[i] = (logandc1 x[i] y[i])
469(defx8632lapfunction %bignum-logandc1 ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
470  (let ((i temp0)
471        (xx temp1)
472        (yy arg_y))
473    (movl (@ idx (% esp)) (% i))
474    (movl (@ x (% esp)) (% xx))
475    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
476    (not (% imm0))
477    (andl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
478    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
479    (single-value-return 4)))
480
481;;; dest[i] = (logandc2 x[i] y[i])
482(defx8632lapfunction %bignum-logandc2 ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
483  (let ((i temp0)
484        (xx temp1)
485        (yy arg_y))
486    (movl (@ idx (% esp)) (% i))
487    (movl (@ x (% esp)) (% xx))
488    (movl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
489    (not (% imm0))
490    (andl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
491    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
492    (single-value-return 4)))
493
494;;; dest[i] = (logior x[i] y[i])
495(defx8632lapfunction %bignum-logior ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
496  (let ((i temp0)
497        (xx temp1)
498        (yy arg_y))
499    (movl (@ idx (% esp)) (% i))
500    (movl (@ x (% esp)) (% xx))
501    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
502    (orl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
503    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
504    (single-value-return 4)))
505
506;;; dest[i] = (lognot x[i])
507(defx8632lapfunction %bignum-lognot ((idx 4) #|(ra 0)|# (x arg_y) (dest arg_z))
508  (let ((i temp0))
509    (movl (@ idx (% esp)) (% i))
510    (movl (@ x8632::misc-data-offset (% x) (% i)) (% imm0))
511    (not (% imm0))
512    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
513    (single-value-return 3)))
514
515;;; dest[i] = (logxor x[i] y[i])
516(defx8632lapfunction %bignum-logxor ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
517  (let ((i temp0)
518        (xx temp1)
519        (yy arg_y))
520    (movl (@ idx (% esp)) (% i))
521    (movl (@ x (% esp)) (% xx))
522    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
523    (xorl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
524    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
525    (single-value-return 4)))
526
527;;; 0 if a[i] = b[i]; 1 if a[i] > b[i]; -1 if a[i] < b[i]
528(defx8632lapfunction %compare-digits ((a 4) #|(ra 0)|# (b arg_y) (i arg_z))
529  (movl (@ a (% esp)) (% temp0))
530  (movl (@ x8632::misc-data-offset (% temp0) (% i)) (% imm0))
531  (movl ($ '1) (% temp0))
532  (movl ($ '-1) (% temp1))
533  (subl (@ x8632::misc-data-offset (% b) (% i)) (% imm0))
534  (cmoval (% temp0) (% imm0))
535  (cmovbl (% temp1) (% imm0))
536  (movl (% imm0) (% arg_z))
537  (single-value-return 3))
538
539;; returns number of bits in digit-hi,digit-lo that are sign bits
540;; 32 - digits-sign-bits is integer-length
541(defx8632lapfunction %digits-sign-bits ((hi arg_y) (lo arg_z))
542  (mark-as-imm temp0)
543  (shll ($ (- 16 x8632::fixnumshift)) (% hi))
544  (unbox-fixnum lo imm0)
545  (orl (% hi) (% imm0))
546  (movl (% imm0) (% temp0))
547  (not (% imm0))
548  (testl (% temp0) (% temp0))
549  (js @wasneg)
550  (not (% imm0))
551  @wasneg
552  (bsrl (% imm0) (% imm0))
553  (sete (% temp0.b))
554  (xorl ($ 31) (% imm0))
555  (addb (% temp0.b) (% imm0.b))
556  (box-fixnum imm0 arg_z)
557  (mark-as-node temp0)
558  (single-value-return))
559
560(defx8632lapfunction macptr->fixnum ((ptr arg_z))
561  (macptr-ptr arg_z ptr)
562  (single-value-return))
563
564; if dest not nil store unboxed result in dest(0), else return a fixnum
565(defx8632lapfunction fix-digit-logandc2 ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
566  (mark-as-imm temp0)
567  (movl (@ fix (% esp)) (% temp0))
568  (unbox-fixnum temp0 temp0)
569  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
570  (not (% imm0))
571  (andl (% temp0) (% imm0))
572  (mark-as-node temp0)
573  (cmpl ($ x8632::nil-value) (% dest))
574  (jne @store)
575  (box-fixnum imm0 arg_z)
576  (single-value-return 3)
577  @store
578  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
579  (single-value-return 3))
580
581(defx8632lapfunction fix-digit-logandc1 ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
582  (mark-as-imm temp0)
583  (movl (@ fix (% esp)) (% temp0))
584  (unbox-fixnum temp0 temp0)
585  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
586  (not (% temp0))
587  (andl (% temp0) (% imm0))
588  (mark-as-node temp0)
589  (cmpl ($ x8632::nil-value) (% dest))
590  (jne @store)
591  (box-fixnum imm0 arg_z)
592  (single-value-return 3)
593  @store
594  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
595  (single-value-return 3))
596
597(defx8632lapfunction fix-digit-logand ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
598  (mark-as-imm temp0)
599  (movl (@ fix (% esp)) (% temp0))
600  (sarl ($ x8632::fixnumshift) (% temp0))
601  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
602  (andl (% temp0) (% imm0))
603  (mark-as-node temp0)
604  (cmpl ($ x8632::nil-value) (% dest))
605  (jne @store)
606  (box-fixnum imm0 arg_z)
607  (single-value-return 3)
608  @store
609  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
610  (single-value-return 3))
611
612
613(defx8632lapfunction digit-lognot-move ((index 4) #|(ra 0)|# (source arg_y) (dest arg_z))
614  (movl (@ index (% esp)) (% temp0))
615  (movl (@ x8632::misc-data-offset (% source) (% temp0)) (% imm0))
616  (not (% imm0))
617  (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% temp0)))
618  (single-value-return 3))
619
620;; Add b to a starting at a[i]
621;; might want not to use SSE2 for this.  use lea to update loop counter
622;; variables so that the flags don't get set.
623(defx8632lapfunction bignum-add-loop-+ ((i 8) (a 4) #|(ra 0)|# (b arg_y) (blen arg_z))
624  (let ((aa mm2)
625        (bb mm3)
626        (cc mm4))
627    (movl (@ a (% esp)) (% temp0))
628    (movl (@ i (% esp)) (% temp1))
629    (xorl (% imm0) (% imm0))
630    (pxor (% cc) (% cc))
631    @loop
632    (movd (@ x8632::misc-data-offset (% temp0) (% temp1)) (% aa))
633    (movd (@ x8632::misc-data-offset (% b) (% imm0)) (% bb))
634    (paddq (% bb) (% aa))
635    (paddq (% cc) (% aa))
636    (movd (% aa) (@ x8632::misc-data-offset (% temp0) (% temp1)))
637    (psrlq ($ 32) (% aa))
638    (movq (% aa) (% cc))
639    (addl ($ '1) (% temp1))
640    (addl ($ '1) (% imm0))
641    (subl ($ '1) (% blen))
642    (jg @loop)
643    ;; add in final carry
644    (movd (% cc) (% imm0))
645    (addl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
646    (single-value-return 4)))
647
648(defx8632lapfunction bignum-logtest-loop ((count 4) #|(ra 0)|# (s1 arg_y) (s2 arg_z))
649  (let ((i temp1)
650        (c temp0))
651    (movl (@ count (% esp)) (% c))
652    (xorl (% i) (% i))
653    @loop
654    (movl (@ x8632::misc-data-offset (% s1) (% i)) (% imm0))
655    (test (@ x8632::misc-data-offset (% s2) (% i)) (% imm0))
656    (jnz @true)
657    (addl ($ '1) (% i))
658    (cmpl (% i) (% c))
659    (jg @loop)
660    (movl ($ x8632::nil-value) (% arg_z))
661    (single-value-return 3)
662    @true
663    (movl ($ x8632::t-value) (% arg_z))
664    (single-value-return 3)))
665
666;;; shift bignum left by nbits bits (1 <= nbits < 32)
667;;; start storing into result at digit j
668(defx8632lapfunction bignum-shift-left-loop ((nbits 12) (result 8)
669                                             (bignum 4) #|(ra 0)|#
670                                             (res-len-1 arg_y) (j arg_z))
671  (movl (% ebp) (@ 16 (% esp)))
672  (leal (@ 16 (% esp)) (% ebp))
673  (popl (@ 4 (% ebp)))
674  (push (% arg_y))                      ;ebp - 16
675  (push (% arg_z))                      ;ebp - 20
676
677  (movl (@ -4 (% ebp)) (% imm0))
678  (sarl ($ x8632::fixnumshift) (% imm0))
679  (movd (% imm0) (% mm7))               ;shift count
680  (negl (% imm0))
681  (addl ($ 32) (% imm0))
682  (movd (% imm0) (% mm6))               ;remaining bits
683
684  (let ((rl-1 -16)
685        (r temp0)
686        (b temp1)
687        (i arg_y)
688        (i+1 imm0))
689    (movl (@ -8 (% ebp)) (% r))
690    (movl (@ -12 (% ebp)) (% b))
691    (xorl (% i) (% i))
692    (movl ($ '1) (% i+1))
693    ;; j (in arg_z) is already (1+ digits)
694    (jmp @test)
695    @loop
696    (movd (@ x8632::misc-data-offset (% b) (% i)) (% mm0))
697    (psrlq (% mm6) (% mm0))
698    (movd (@ x8632::misc-data-offset (% b) (% i+1)) (% mm1))
699    (psllq (% mm7) (% mm1))
700    (por (% mm1) (% mm0))
701    (movd (% mm0) (@ x8632::misc-data-offset (% r) (% j)))
702    (movl (% i+1) (% i))
703    (addl ($ '1) (% i+1))
704    (addl ($ '1) (% j))
705    @test
706    (cmpl (@ rl-1 (% ebp)) (% j))
707    (jne @loop)
708    (movd (@ x8632::misc-data-offset (% b)) (% mm0))
709    (psllq (% mm7) (% mm0))
710    (movl (@ -20 (% ebp)) (% imm0))     ;digits + 1 (that is, the original j)
711    (subl ($ '1) (% imm0))              ;digits
712    (movd (% mm0) (@ x8632::misc-data-offset (% r) (% imm0)))
713    (movd (@ x8632::misc-data-offset (% b) (% i)) (% mm0))
714    (psrad (% mm6) (% mm0))
715    (movd (% mm0) (@ x8632::misc-data-offset (% r) (% j))))
716  (leave)
717  (ret))
718
719;;; shift bignum right by i words plus nbits bits.
720(defx8632lapfunction bignum-shift-right-loop-1 ((nbits 12) (result 8)
721                                                (bignum 4) #|(ra 0)|#
722                                                (res-len-1 arg_y)
723                                                (i arg_z))
724  (movl (@ nbits (% esp)) (% imm0))
725  (sarl ($ x8632::fixnumshift) (% imm0))
726  (movd (% imm0) (% mm7))               ;shift count
727
728  (movl (@ result (% esp)) (% temp0))
729  (movl (@ bignum (% esp)) (% temp1))
730  (push (% res-len-1))
731  (xorl (% arg_y) (% arg_y))            ;index into result
732  (jmp @test)
733  @loop
734  (movq (@ x8632::misc-data-offset (% temp1) (% i)) (% mm0)) ;b[i+1] || b[i]
735  (psrlq (% mm7) (% mm0))
736  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_y)))
737  (addl ($ '1) (% i))
738  (addl ($ '1) (% arg_y))
739  @test
740  (cmpl (@ (% esp)) (% arg_y))          ;compare to res-len-1
741  (jne @loop)
742  (addl ($ x8632::node-size) (% esp))
743  @finish
744  (movd (@ x8632::misc-data-offset (% temp1) (% i)) (% mm0)) ;last digit of b
745  (psrad (% mm7) (% mm0))
746  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_y)))
747  (single-value-return 5))
748
749(defx8632lapfunction %logcount-complement ((bignum arg_y) (i arg_z))
750  (mark-as-imm temp0)
751  (let ((rshift imm0)
752        (temp temp0))
753    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% rshift))
754    (notl (% rshift))
755    (xorl (% arg_z) (% arg_z))
756    (testl (% rshift) (% rshift))
757    (jmp @test)
758    @next
759    (lea (@ -1 (% rshift)) (% temp))
760    (and (% temp) (% rshift))           ;sets flags
761    (lea (@ '1 (% arg_z)) (% arg_z))    ;doesn't set flags
762    @test
763    (jne @next)
764    (mark-as-node temp0)
765    (single-value-return)))
766
767(defx8632lapfunction %logcount ((bignum arg_y) (i arg_z))
768  (mark-as-imm temp0)
769  (let ((rshift imm0)
770        (temp temp0))
771    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% rshift))
772    (xorl (% arg_z) (% arg_z))
773    (testl (% rshift) (% rshift))
774    (jmp @test)
775    @next
776    (lea (@ -1 (% rshift)) (% temp))
777    (and (% temp) (% rshift))           ;sets flags
778    (lea (@ '1 (% arg_z)) (% arg_z))    ;doesn't set flags
779    @test
780    (jne @next)
781    (mark-as-node temp0)
782    (single-value-return)))
783
784
785;;; Divide bignum x by single digit y (passed as two halves).
786;;; The quotient in stored in q, and the remainder is returned
787;;; in two halves.  (cf. Knuth, 4.3.1, exercise 16)
788(defx8632lapfunction %floor-loop-quo ((x 8) (res 4) #|(ra 0)|# (yhi arg_y) (ylo arg_z))
789  (compose-digit yhi ylo imm0)
790  (movl (% imm0) (:rcontext x8632::tcr.unboxed0))
791  (pop (% temp0))
792  (pop (% arg_z))                       ;res
793  (pop (% arg_y))                       ;x
794  (discard-reserved-frame)
795  (push (% temp0))
796  (mark-as-imm edx)                     ;aka temp1
797  (let ((bignum arg_y)                  ;bignum dividend
798        (result arg_z))                 ;bignum result (quotient)
799    (xorl (% edx) (% edx))
800    (vector-length bignum temp0)
801    (jmp @next)
802    @loop
803    (movl (@ x8632::misc-data-offset (% bignum) (% temp0)) (% eax))
804    (divl (:rcontext x8632::tcr.unboxed0))
805    (movl (% eax) (@ x8632::misc-data-offset (% result) (% temp0)))
806    @next
807    (subl ($ '1) (% temp0))
808    (jge @loop))
809  (movl (% esp) (% temp0))
810  ;; extract and push high half of remainder
811  (movl ($ (- #x10000)) (% arg_y))
812  (andl (% edx) (% arg_y))
813  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
814  (push (% arg_y))
815  ;; extract and push low half
816  (andl ($ #xffff) (% edx))
817  (shll ($ x8632::fixnumshift) (% edx))
818  (push (% edx))
819  (mark-as-node edx)
820  (set-nargs 2)
821  (jmp-subprim .SPvalues))
822
823;;; For TRUNCATE-BY-FIXNUM et al.
824;;; Doesn't store quotient: just returns rem in 2 halves.
825;;; Could avoid using tcr.unboxed0 if it matters...
826(defx8632lapfunction %floor-loop-no-quo ((x 4) #|(ra 0)|# (yhi arg_y) (ylo arg_z))
827  (compose-digit yhi ylo imm0)
828  (movl (% imm0) (:rcontext x8632::tcr.unboxed0))
829  (pop (% temp0))
830  (pop (% arg_y))
831  (discard-reserved-frame)
832  (push (% temp0))
833  (mark-as-imm edx)                     ;aka temp1
834  (let ((bignum arg_y)                  ;bignum dividend
835        (result arg_z))                 ;bignum result (quotient)
836    (xorl (% edx) (% edx))
837    (vector-length bignum temp0)
838    (jmp @next)
839    @loop
840    (movl (@ x8632::misc-data-offset (% bignum) (% temp0)) (% eax))
841    (divl (:rcontext x8632::tcr.unboxed0))
842    ;;(movl (% eax) (@ x8632::misc-data-offset (% result) (% temp0)))
843    @next
844    (subl ($ '1) (% temp0))
845    (jge @loop))
846  (movl (% esp) (% temp0))
847  ;; extract and push high half of remainder
848  (movl ($ (- #x10000)) (% arg_y))
849  (andl (% edx) (% arg_y))
850  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
851  (push (% arg_y))
852  ;; extract and push low half
853  (andl ($ #xffff) (% edx))
854  (shll ($ x8632::fixnumshift) (% edx))
855  (push (% edx))
856  (mark-as-node edx)
857  (set-nargs 2)
858  (jmp-subprim .SPvalues))
859
860;;; transliterated from bignum-truncate-guess in l0-bignum64.lisp
861;;; this is not beautiful...
862(defx8632lapfunction truncate-guess-loop ((guess-h 16) (guess-l 12) (x 8)
863                                          (xidx 4) #|(ra 0)|#
864                                          (yptr arg_y) (yidx arg_z))
865  (movl (% ebp) (@ 20 (% esp)))
866  (leal (@ 20 (% esp)) (% ebp))
867  (popl (@ 4 (% ebp)))
868  (push (% arg_y))
869  (push (% arg_z))
870
871  (movl (@ -4 (% ebp)) (% temp0))       ;guess-h
872  (movl (@ -8 (% ebp)) (% temp1))       ;guess-l
873  (compose-digit temp0 temp1 imm0)
874  (movd (% imm0) (% mm0))               ;save guess
875
876  (movd (@ (- x8632::misc-data-offset 0) (% yptr) (% yidx)) (% mm1)) ;y1 (high)
877  ;; (%multiply guess y1)
878  (pmuludq (% mm0) (% mm1))
879  ;; (%multiply guess y2)
880  (movd (@ (- x8632::misc-data-offset 4) (% yptr) (% yidx)) (% mm2)) ;y2 (low)
881  (pmuludq (% mm0) (% mm2))
882
883  (movl (@ -12 (% ebp)) (% temp0))       ;x
884  (movl (@ -16 (% ebp)) (% arg_y))       ;xidx
885  (mark-as-imm temp1)                    ;edx now unboxed
886
887  ;; (%subtract-with-borrow x-i-1 low-guess*y1 1)
888  (movl (@ (- x8632::misc-data-offset 4) (% temp0) (% arg_y)) (% edx)) ;x-i-1
889  (movd (% mm1) (% eax))                ;low part of y1*guess
890  (subl (% eax) (% edx))
891  (movd (% edx) (% mm6))                ;save middle digit
892  ;; (%subtract-with-borrow x-i high-guess*y1 borrow)
893  (movl (@ (- x8632::misc-data-offset 0) (% temp0) (% arg_y)) (% edx)) ;x-i
894  (movq (% mm1) (% mm3))
895  (psrlq ($ 32) (% mm3))                ;get high part into low half
896  (movd (% mm3) (% eax))                ;high part of y1*guess
897  (sbbl (% eax) (% edx))
898  (movd (% edx) (% mm7))                ;save high digit
899  ;; guess is now either good, or one too large
900  ;; if (and (= high-digit 0)
901  (test (% edx) (% edx))
902  (jne @return)
903  ;;         (or (> high-guess*y2 middle-digit)
904  (movq (% mm2) (% mm3))
905  (psrlq ($ 32) (% mm3))
906  (movd (% mm3) (% eax))                ;high part of y2*guess
907  (movd (% mm6) (% edx))                ;middle-digit
908  (cmpl (% edx) (% eax))
909  (ja @decrement)
910  ;;             (and (= middle-digit high-guess*y2)
911  (jne @return)
912  ;;                  (> low-guess*y2 x-i-2)
913  (movd (% mm2) (% eax))                ;low part of y2*guess
914  (movl (@ (- x8632::misc-data-offset 8) (% temp0) (% arg_y)) (% edx)) ;x-i-2
915  (cmpl (% edx) (% eax))
916  (ja @decrement)
917  @return
918  (mark-as-node edx)
919  (leave)
920  (movl (% esp) (% temp0))
921  (movd (% mm0) (% imm0))
922  (shrl ($ 16) (% imm0))
923  (shll ($ x8632::fixnumshift) (% imm0)) ;high half
924  (push (% imm0))
925  (movd (% mm0) (% imm0))
926  (andl ($ #xffff) (% imm0))
927  (shll ($ x8632::fixnumshift) (% imm0))
928  (push (% imm0))                       ;low half
929  (set-nargs 2)
930  (jmp-subprim .SPvalues)
931  @decrement
932  (movd (% mm0) (% imm0))               ;guess
933  (subl ($ 1) (% imm0))
934  (movd (% imm0) (% mm0))
935  (jmp @return))
936
937;;; If x[i] = y[j], return the all ones digit (as two halves).
938;;; Otherwise, compute floor x[i]x[i-1] / y[j].
939(defx8632lapfunction %floor-99 ((x-stk 8) (xidx 4) #|(ra 0)|#
940                                (yptr arg_y) (yidx arg_z))
941  (pop (% temp1))
942  (pop (% imm0))
943  (pop (% temp0))
944  (discard-reserved-frame)
945  (push (% temp1))
946  (movl (% imm0) (% temp1))
947  (movl (@ x8632::misc-data-offset (% temp0) (% temp1)) (% imm0)) ;x[i]
948  (cmpl (% imm0) (@ x8632::misc-data-offset (% yptr) (% yidx)))   ;y[j]
949  (jne @more)
950  (pushl ($ '#xffff))
951  (pushl ($ '#xffff))
952  (lea (@ '2 (% esp)) (% temp0))
953  (set-nargs 2)
954  (jmp-subprim .SPvalues)
955  @more
956  (mark-as-imm edx)                     ;aka temp1 (contains a fixnum)
957  (movl (@ (- x8632::misc-data-offset 4) (% temp0) (% temp1)) (% eax)) ;low
958  (movl (@ x8632::misc-data-offset (% temp0) (% temp1)) (% edx))    ;high digit
959  (divl (@ x8632::misc-data-offset (% yptr) (% yidx)))
960  (mark-as-node edx)
961  ;; extract and push high half of quotient
962  (movl ($ (- #x10000)) (% arg_y))
963  (andl (% eax) (% arg_y))
964  (shrl ($ (- 16 x8632::fixnumshift)) (% arg_y))
965  (push (% arg_y))
966  ;; extract and push low half
967  (andl ($ #xffff) (% eax))
968  (shll ($ x8632::fixnumshift) (% eax))
969  (push (% eax))
970  (set-nargs 2)
971  (lea (@ '2 (% esp)) (% temp0))
972  (jmp-subprim .SPvalues))
973
974;;; x * y + carry
975(defx8632lapfunction %multiply-and-add-1 ((x-high 16)
976                                          (x-low 12)
977                                          (y-high 8)
978                                          (y-low 4)
979                                          #|(ra 0)|#
980                                          (carry-in-high arg_y)
981                                          (carry-in-low arg_z))
982  (movl (@ x-high (% esp)) (% temp0))
983  (movl (@ x-low (% esp)) (% temp1))
984  (compose-digit temp0 temp1 imm0)
985  (movd (% imm0) (% mm0))
986  (movl (@ y-high (% esp)) (% temp0))
987  (movl (@ y-low (% esp)) (% temp1))
988  (compose-digit temp0 temp1 imm0)
989  (movd (% imm0) (% mm1))
990  (pmuludq (% mm1) (% mm0))             ;x * y
991  (compose-digit arg_y arg_z imm0)
992  (movd (% imm0) (% mm1))
993  (paddq (% mm1) (% mm0))               ;add in carry digit
994  (movq (% mm0) (% mm1))
995  (psrlq ($ 32) (% mm1))                ;resultant carry digit
996  ;; clean up stack
997  (pop (% temp0))
998  (addl ($ '6) (% esp))
999  (push (% temp0))
1000  ;; return (values carry-h carry-l result-h result-l)
1001  (movl (% esp) (% temp0))
1002  (movd (% mm1) (% imm0))
1003  (shrl ($ 16) (% imm0))
1004  (shll ($ x8632::fixnumshift) (% imm0)) ;carry-h
1005  (push (% imm0))
1006  (movd (% mm1) (% imm0))
1007  (shll ($ 16) (% imm0))
1008  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0)) ;carry-l
1009  (push (% imm0))
1010  (movd (% mm0) (% imm0))
1011  (shrl ($ 16) (% imm0))
1012  (shll ($ x8632::fixnumshift) (% imm0)) ;result-h
1013  (push (% imm0))
1014  (movd (% mm0) (% imm0))
1015  (shll ($ 16) (% imm0))
1016  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0)) ;result-l
1017  (push (% imm0))
1018  (set-nargs 4)
1019  (jmp-subprim .SPvalues))
1020
1021;;; Copy the limb SRC points to to where DEST points.
1022(defx8632lapfunction copy-limb ((src arg_y) (dest arg_z))
1023  (int ($ 3)))
1024
1025;;; Return T iff LIMB contains 0.
1026(defx8632lapfunction limb-zerop ((limb arg_z))
1027  (int ($ 3)))
1028
1029;;; Return -1,0,1 according to whether the contents of Y are
1030;;; <,=,> the contents of Z.
1031(defx8632lapfunction compare-limbs ((y arg_y) (z arg_z))
1032  (int ($ 3)))
1033
1034;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
1035(defx8632lapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1036  (int ($ 3)))
1037
1038;;; Store a fixnum value where LIMB points.
1039(defx8632lapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1040  (int ($ 3)))
1041
1042;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
1043;;; knows that carries will only propagate for a word or two.
1044(defx8632lapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
1045  (int ($ 3)))
1046
1047;;; Store XP-YP at WP; return carry (0 or 1).
1048;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
1049;;; size: boxed fixnum
1050;;; returns boxed carry
1051(defx8632lapfunction mpn-sub-n ((wp 8) (xp 4) #|(ra 0)|#
1052                                (yp arg_y) (size arg_z))
1053  (int ($ 3)))
1054
1055;;; Store XP+YP at WP; return carry (0 or 1).
1056;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
1057;;; size = boxed fixnum
1058;;; result = boxed carry
1059(defx8632lapfunction mpn-add-n ((wp 8) (xp 4) #|(ra 0)|#
1060                                (yp arg_y) (size arg_z))
1061  (int ($ 3)))
1062
1063;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
1064;;; result at RP.  RP and S1P may be the same place, so check for
1065;;; that and do nothing after carry stops propagating.  Return carry.
1066(defx8632lapfunction mpn-add-1 ((rp-offset 8) (s1p 4) #|(ra 0)|#
1067                                (size arg_y) (limb arg_z))
1068  (int ($ 3)))
1069
1070;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
1071;;; the result at RES.  Store the "carry out" (high word of last 64-bit
1072;;; partial product) at the limb RESULT.
1073;;; res, s1, limbptr, result:
1074;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
1075;;; It'd be hard to transliterate the GMP code here; the GMP version
1076;;; uses lots more immediate registers than we can easily use in LAP
1077;;; (and is much more aggressively pipelined).
1078(defx8632lapfunction mpn-mul-1 ((res-offset 12)
1079                                (s1-offset 8)
1080                                (size 4)
1081                                #|(ra 0)|#
1082                                (limbptr arg_y)
1083                                (result arg_z))
1084  (int ($ 3)))
1085
1086;;; multiply s1*limb and add result to res
1087;;; res, s1, limbptr, result:
1088;;;   unboxed, word-aligned ptrs (fixnums).
1089;;; size: boxed fixnum
1090;;; limbptr: source "limb".
1091;;; result: carry out (high word of product).
1092(defx8632lapfunction mpn-addmul-1 ((res-offset 12)
1093                                   (s1-offset 8)
1094                                   (size 4)
1095                                   #|(ra 0)|#
1096                                   (limbptr arg_y)
1097                                   (result arg_z))
1098  (int ($ 3)))
1099
1100;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
1101;;; at VP, store the result at RP.
1102(defx8632lapfunction mpn-mul-basecase ((rp-offset 12)
1103                                       (up-offset 8)
1104                                       (un 4)
1105                                       #|(ra 0)|#
1106                                       (vp arg_y)
1107                                       (vn arg_z))
1108  (int ($ 3)))
1109
1110;;; left-shift src by 1 bit, storing result at res.  Return
1111;;; the bit that was shifted out.
1112(defx8632lapfunction mpn-lshift-1 ((resptr 4) #|(ra 0)|#
1113                                   (s1ptr arg_y) (size-arg arg_z))
1114  (int ($ 3)))
1115
1116;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
1117;;; result (low word first) at RESULT.
1118(defx8632lapfunction umulppm ((x 4) #|(ra 0)|# (y arg_y) (result arg_z))
1119  (int ($ 3)))
1120
1121(defx8632lapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
1122  (unbox-fixnum fixnum imm0)
1123  (movl (% imm0) (@ x8632::misc-data-offset (% bignum)))
1124  (single-value-return))
1125
1126(defx8632lapfunction bignum-negate-loop-really ((bignum 4) #|(ra 0)|# 
1127                                                (len arg_y) (result arg_z))
1128  (mark-as-imm edx)                     ;aka %temp1
1129  (unbox-fixnum arg_y edx)
1130  (movl (@ bignum (% esp)) (% arg_y))
1131  (xorl (% temp0) (% temp0))
1132  (stc)
1133  @loop
1134  (movl (@ x8632::misc-data-offset (% arg_y) (% temp0)) (% imm0))
1135  (not (% imm0))
1136  (adc ($ 0) (% imm0))
1137  (movl (% imm0) (@ x8632::misc-data-offset (% arg_z) (% temp0)))
1138  (lea (@ x8632::node-size (% temp0)) (% temp0))
1139  (decl (% edx))                        ;preserves carry flag
1140  (jg @loop)
1141  ;; return carry
1142  (setc (% imm0.b))
1143  (movzbl (% imm0.b) (% imm0))
1144  (box-fixnum imm0 arg_z)
1145  (mark-as-node edx)
1146  (single-value-return 3))
1147
1148(defx8632lapfunction %bignum-set ((bignum 8) (i 4) #|(ra 0)|#
1149                                  (high arg_y) (low arg_z))
1150  (compose-digit high low imm0)
1151  (movl (@ bignum (% esp)) (% arg_z))
1152  (movl (@ i (% esp)) (% arg_y))
1153  (movl (% imm0) (@ x8632::misc-data-offset (% arg_z) (% arg_y)))
1154  (single-value-return 4))
1155
Note: See TracBrowser for help on using the repository browser.