source: trunk/source/level-0/ARM/arm-bignum.lisp @ 15578

Last change on this file since 15578 was 15578, checked in by gb, 7 years ago

Faster bignum x fixnum multiplication for 32-bit architectures.

File size: 39.7 KB
Line 
1;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2010 Clozure Associates
4
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18
19(in-package "CCL")
20
21(eval-when (:compile-toplevel :execute)
22  (require "ARM-ARCH")
23  (require "ARM-LAPMACROS"))
24
25;;; %BIGNUM-REF needs to access bignums as obviously as possible, and it needs
26;;; to be able to return 32 bits somewhere no one looks for real objects.
27;;;
28;;; The easiest thing to do is to store the 32 raw bits in two fixnums
29;;; and return multiple values.
30(defarmlapfunction %bignum-ref ((bignum arg_y) (i arg_z))
31  (vref32 imm0 bignum i imm1)
32  (digit-h temp0 imm0)
33  (digit-l temp1 imm0)
34  (vpush1 temp0)
35  (vpush1 temp1)
36  (add temp0 vsp (:$ 8))                 
37  (set-nargs 2)                         
38  (spjump .SPvalues))
39
40
41;;; Set the 0th element of DEST (a bignum or some other 32-bit ivector)
42;;; to the Ith element of the bignum SRC.
43(defarmlapfunction %ref-digit ((bignum arg_x) (i arg_y) (dest arg_z))
44  (add imm1 i (:$ arm::misc-data-offset))
45  (ldr imm0 (:@ bignum imm1))
46  (str imm0 (:@ dest (:$ arm::misc-data-offset)))
47  (bx lr))
48
49;;; BIGNUM[I] := DIGIT[0]
50(defarmlapfunction %set-digit ((bignum arg_x) (i arg_y) (digit arg_z))
51  (add imm1 i (:$ arm::misc-data-offset))
52  (ldr imm0 (:@ digit (:$ arm::misc-data-offset)))
53  (str imm0 (:@ bignum imm1))
54  (bx lr))
55
56
57
58
59
60;;; Return the sign of bignum (0 or -1) as a fixnum
61(defarmlapfunction %bignum-sign ((bignum arg_z))
62  (vector-length imm0 bignum imm0)
63  (add imm0 imm0 (:$ (- arm::misc-data-offset 4))) ; Reference last (most significant) digit
64  (ldr imm0 (:@ bignum imm0))
65  (mov imm0 (:asr imm0 (:$ 31)))        ;propagate sign bit
66  (box-fixnum arg_z imm0)
67  (bx lr))
68
69;;; Count the sign bits in the most significant digit of bignum;
70;;; return fixnum count.
71(defarmlapfunction %bignum-sign-bits ((bignum arg_z))
72  (vector-length imm0 bignum imm0)
73  (add imm0 imm0 (:$ (- arm::misc-data-offset 4))) ; Reference last (most significant) digit
74  (ldr imm0 (:@ bignum imm0))
75  (cmp imm0 (:$ 0))
76  (mvnlt imm0 imm0)
77  (clz imm0 imm0)
78  (box-fixnum arg_z imm0)
79  (bx lr))
80
81(defarmlapfunction %digit-0-or-plusp ((bignum arg_y) (idx arg_z))
82  (add imm0 idx (:$ arm::misc-data-offset))
83  (ldr imm0 (:@ bignum imm0))
84  (mov arg_z 'nil)
85  (cmp imm0 (:$ 0))
86  (addge arg_z arg_z (:$ arm::t-offset))
87  (bx lr))
88
89;;; For oddp, evenp
90(defarmlapfunction %bignum-oddp ((bignum arg_z))
91  (ldr imm0 (:@ bignum (:$ arm::misc-data-offset)))
92  (mov arg_z 'nil)
93  (tst imm0 (:$ 1))
94  (addne arg_z arg_z (:$ arm::t-offset))
95  (bx lr))
96 
97(defarmlapfunction bignum-plusp ((bignum arg_z))
98  (vector-length imm0 bignum imm0)
99  (add imm0 imm0 (:$ (- arm::misc-data-offset 4))) ; Reference last (most significant) digit
100  (ldr imm0 (:@ bignum imm0))
101  (mov arg_z 'nil)
102  (cmp imm0 (:$ 0))
103  (addge arg_z arg_z (:$ arm::t-offset))
104  (bx lr))
105
106(defarmlapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
107  (unbox-fixnum imm0 fixnum)
108  (str imm0 (:@ bignum  (:$ arm::misc-data-offset)))
109  (bx lr))
110
111(defarmlapfunction bignum-minusp ((bignum arg_z))
112  (vector-length imm0 bignum imm0)
113  (add imm0 imm0 (:$ (- arm::misc-data-offset 4))) ; Reference last (most significant) digit
114  (ldr imm0 (:@ bignum imm0))
115  (mov arg_z 'nil)
116  (cmp imm0 (:$ 0))
117  (addlt arg_z arg_z (:$ arm::t-offset))
118  (bx lr))
119
120
121;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum).
122;;; Store the result in R[K], and return the outgoing carry.
123;;; If I is NIL, A is a fixnum.  If J is NIL, B is a fixnum.
124
125(defarmlapfunction %add-with-carry ((r 12) (k 8) (c 4) (a 0) (i arg_x) (b arg_y) (j arg_z))
126  (cmp i 'nil)
127  (ldr temp0 (:@ vsp (:$ a)))
128  (moveq imm1 (:asr temp0 (:$ arm::fixnumshift)))
129  (addne imm1 i (:$ arm::misc-data-offset))
130  (ldrne imm1 (:@ temp0 imm1))
131  (cmp j 'nil)
132  (moveq imm2 (:asr b (:$ arm::fixnumshift)))
133  (addne imm2 j (:$ arm::misc-data-offset))
134  (ldrne imm2 (:@ b imm2))
135  (ldr temp0 (:@ vsp (:$ c)))
136  (unbox-fixnum imm0 temp0)
137  (subs imm0 imm0 (:$ 1))
138  (ldr temp1 (:@ vsp (:$ r)))
139  (ldr temp0 (:@ vsp (:$ k)))
140  (add vsp vsp (:$ 16)) 
141  (adcs imm0 imm1 imm2)
142  (add imm2 temp0 (:$ arm::misc-data-offset))
143  (str imm0 (:@ temp1 imm2))
144  (mov imm0 (:$ 0))
145  (adc imm0 imm0 (:$ 0))
146  (box-fixnum arg_z imm0)
147  (bx lr))
148
149; this is silly
150(defarmlapfunction %add-the-carry ((b-h arg_x) (b-l arg_y) (carry-in arg_z))
151  (let ((a imm0)
152        (b imm1)
153        (c imm2))   
154    (compose-digit b b-h b-l)
155    (unbox-fixnum c carry-in)
156    (add b c b)
157    (digit-h temp0 b)
158    (digit-l temp1 b)
159    (vpush1 temp0)
160    (vpush1 temp1)
161    (add temp0 vsp '2)
162    (set-nargs 2)
163    (spjump .SPvalues)))
164
165
166
167
168   
169;;; Store the result of A[I] - B[J] - borrow into R[K], returning the borrow.
170;;; If I is NIL, A is a fixnum; likewise for J and B.
171(defarmlapfunction %subtract-with-borrow ((r 12) (k 8) (borrow 4) (a 0) (i arg_x) (b arg_y) (j arg_z))
172  (cmp i 'nil)
173  (ldr temp0 (:@ vsp (:$ a)))
174  (moveq imm1 (:asr temp0 (:$ arm::fixnumshift)))
175  (addne imm1 i (:$ arm::misc-data-offset))
176  (ldrne imm1 (:@ temp0 imm1))
177  (cmp j 'nil)
178  (moveq imm2 (:asr b (:$ arm::fixnumshift)))
179  (addne imm2 j (:$ arm::misc-data-offset))
180  (ldrne imm2 (:@ b imm2))
181  (ldr temp0 (:@ vsp (:$ borrow)))
182 
183  (unbox-fixnum imm0 temp0)
184  (subs imm0 imm0 (:$ 1))
185  (ldr temp0 (:@ vsp (:$ r)))
186  (ldr temp1 (:@ vsp (:$ k)))
187  (add vsp vsp (:$ 16)) 
188  (sbcs imm0 imm1 imm2)
189  (add imm1 temp1 (:$ arm::misc-data-offset))
190  (str imm0 (:@ temp0 imm1))
191  (mov imm0 (:$ 0))
192  (adc imm0 imm0 (:$ 0))
193  (box-fixnum arg_z imm0)
194  (bx lr))
195
196;; multiply i'th digit of x by y and add to result starting at digit i
197
198(defarmlapfunction %multiply-and-add-harder-loop-2
199    ((x-ptr 4) (y-ptr 0) (resptr arg_x)(residx arg_y) (count arg_z)) 
200  (let ((x imm0)
201        (y imm1)
202        (prod-h imm2)
203        (prod-l rcontext)
204        (xptr temp2)
205        (yidx temp1)
206        (yptr temp0)
207        (xsave 4))
208    (mov imm1 (:$ 0))
209    (mov imm0 (:$ (ash 1 arm::num-subtag-bits)))
210    (orr imm0 imm0 (:$ arm::subtag-u32-vector))
211    (stmdb (:! sp) (imm0 imm1))
212    (ldr xptr (:@ vsp (:$ x-ptr)))
213    (mov residx (:lsl residx (:$ 2)))
214    (add residx residx (:$ (ash arm::misc-data-offset 2)))
215    (ldr x (:@ xptr (:asr residx (:$ 2))))   
216    (ldr yptr (:@ vsp (:$ y-ptr)))
217    (vpush1 rcontext)
218    (str x (:@ sp (:$ xsave)))
219    (mov yidx (:$ (ash arm::misc-data-offset 2))) ; init yidx 0
220    (movs prod-h (:$ 0)) ; init carry 0, mumble 0
221    @loop
222    (ldr y (:@ yptr (:asr yidx (:$ 2))))
223    (mul prod-l x y)
224    (adds prod-l prod-l prod-h)
225    (umull x prod-h x y)
226    (adc prod-h prod-h (:$ 0))
227    (ldr x (:@ sp (:$ xsave)))
228    (ldr y (:@ resptr (:asr residx (:$ 2))))
229    (adds prod-l prod-l y)
230    (adc prod-h prod-h (:$ 0))
231    (subs count count '1)
232    (str prod-l (:@ resptr (:asr residx (:$ 2))))   
233    (add residx residx '4)              ;sic
234    (add yidx yidx '4)                  ;even sicer
235    (bgt @loop)
236    (str prod-h (:@ resptr (:asr residx (:$ 2))))
237    (vpop1 rcontext)
238    (add vsp vsp (:$ 8))
239    (add sp sp (:$ 8))
240    (bx lr)))
241
242
243
244;;; Multiply X[I] by the unboxed value of the (non-negative) fixnum Y;
245;;; add the incoming carry from CARRY[0] to the 64-bit product.  Store
246;;; the low word of the 64-bit sum in R[0] and the high word in
247;;; CARRY[0].
248
249(defarmlapfunction %multiply-and-add ((r 4) (carry 0) (x arg_y) (i arg_x) (y arg_z))
250  (unbox-fixnum imm0 arg_z)
251  (add imm1 i (:$ arm::misc-data-offset))
252  (ldr imm1 (:@ x imm1))
253  (umull imm1 imm2 imm0 imm1)
254  (ldr temp0 (:@ vsp (:$ carry)))
255  (ldr imm0 (:@ temp0 (:$ arm::misc-data-offset)))
256  (adds imm1 imm1 imm0)
257  (adc imm2 imm2 (:$ 0))
258  (str imm2 (:@ temp0  (:$ arm::misc-data-offset)))
259  (ldr arg_z (:@ vsp (:$ r)))
260  (add vsp vsp (:$ 8))   
261  (str imm1 (:@ arg_z  (:$ arm::misc-data-offset)))
262  (bx lr))
263
264(defarmlapfunction %multiply-and-add-fixnum-loop ((len 0) (x arg_x) (y arg_y) (result arg_z))
265  (let ((rlen temp0)
266        (idx rcontext)
267        (carry imm2)
268        (lo imm0)
269        (hi imm1))
270    (ldr rlen (:@ vsp (:$ len)))
271    (str rcontext (:@ vsp (:$ 0)))
272    (mov idx (:$ arm::misc-data-offset))
273    (mov carry (:$ 0))
274    (b @test)
275    @loop
276    (unbox-fixnum imm0 y)
277    (ldr imm1 (:@ x idx))
278    (umull lo hi imm0 imm1)
279    (adds lo lo carry)
280    (adc carry hi (:$ 0))
281    (str lo (:@ result idx))
282    (add idx idx (:$ 4))
283    @test
284    (subs rlen rlen '1)
285    (bge @loop)
286    (str carry (:@ result idx))
287    (vpop1 rcontext)
288    (bx lr)))
289
290
291   
292   
293
294
295(defarmlapfunction %bignum-ref-hi ((bignum arg_y) (i arg_z))
296  (add imm1 i (:$ (+ 2 arm::misc-data-offset)))
297  (ldrh imm0 (:@ bignum imm1))
298  (box-fixnum arg_z imm0)
299  (bx lr))
300
301
302(defarmlapfunction %bignum-set ((bignum 0) (i arg_x) (high arg_y) (low arg_z))
303  (compose-digit imm0 high low)
304  (ldr arg_z (:@ vsp (:$ bignum)))
305  (vset32 imm0 arg_z i imm1)
306  (add vsp vsp (:$ 4))
307  (bx lr))
308
309
310
311
312; this is silly
313#+notyet
314(defarmlapfunction %add-the-carry ((b-h arg_x) (b-l arg_y) (carry-in arg_z))
315  (let ((a imm0)
316        (b imm1)
317        (temp imm2)
318        (c imm3))   
319    (compose-digit b b-h b-l)
320    (unbox-fixnum c carry-in)
321    (add b c b)
322    (digit-h temp0 b)
323    (digit-l temp1 b)
324    (vpush temp0)
325    (vpush temp1)
326    (add temp0 vsp (:$ 8))
327    (set-nargs 2)
328    (spjump .SPvalues)))
329
330
331
332
333;;; %SUBTRACT-WITH-BORROW -- Internal.
334;;;
335;;; This should be in assembler, and should not cons intermediate results.  It
336;;; returns a 32bit digit and a borrow resulting from subtracting b from a, and
337;;; subtracting a possible incoming borrow.
338;;;
339;;; We really do:  a - b - 1 + borrow, where borrow is either 0 or 1.
340;;;
341
342(defarmlapfunction %subtract-with-borrow-1 ((a-h 4) (a-l 0) (b-h arg_x) (b-l
343arg_y) (borrow-in arg_z))
344  (let ((a imm0)
345        (b imm1)
346        (temp imm0)
347        (c imm2))
348    (ldr temp0 (:@ vsp (:$ a-h)))
349    (ldr temp1 (:@ vsp (:$ a-l)))
350    (compose-digit b b-h b-l)
351    (unbox-fixnum c borrow-in)
352    (adds temp c (:$ -1))
353    (compose-digit a temp0 temp1)
354    (sbcs a a b)
355    (mov c (:$ 0))
356    (adc c c c)
357    (box-fixnum c c)
358    (digit-h temp0 a)
359    (digit-l temp1 a)
360    (vpush1 temp0)
361    (vpush1 temp1)
362    (vpush1 c)
363    (add temp0 vsp (:$ 20))
364    (set-nargs 3)
365    (spjump .SPvalues)))
366
367
368(defarmlapfunction %subtract-one ((a-h arg_y)(a-l arg_z))
369  (let ((a imm0))
370    (compose-digit a a-h a-l)
371    (sub a a (:$ 1))
372    (digit-h temp0 a)
373    (vpush1 temp0)
374    (digit-l temp0 a)
375    (vpush1 temp0)
376    (add temp0 vsp (:$ 8))
377    (set-nargs 2)
378    (spjump .SPvalues)))
379
380
381
382
383;;; %MULTIPLY-AND-ADD  --  Internal.
384;;;
385;;; This multiplies x-digit and y-digit, producing high and low digits
386;;; manifesting the result.  Then it adds the low digit, res-digit, and
387;;; carry-in-digit.  Any carries (note, you still have to add two digits at a
388;;; time possibly producing two carries) from adding these three digits get
389;;; added to the high digit from the multiply, producing the next carry digit.
390;;; Res-digit is optional since two uses of this primitive multiplies a single
391;;; digit bignum by a multiple digit bignum, and in this situation there is no
392;;; need for a result buffer accumulating partial results which is where the
393;;; res-digit comes from.
394;;; [slh] I assume that the returned carry "digit" can only be 0, 1 or 2
395
396
397
398(defarmlapfunction %multiply-and-add-1 ((x-high 8)
399                                        (x-low 4)
400                                        (y-high 0)
401                                        (y-low arg_x)
402                                        (carry-in-high arg_y)
403                                        (carry-in-low arg_z))
404  (let ((x imm0)
405        (y imm1)
406        (carry-in imm2)
407        (lo x)
408        (hi y))
409    (compose-digit carry-in carry-in-high carry-in-low)
410    (vpop1 temp0)
411    (compose-digit y temp0 y-low)
412    (vpop1 temp0)
413    (vpop1 temp1)
414    (compose-digit x temp1 temp0)
415    (umull lo hi x y)
416    (adds lo lo carry-in)
417    (adc hi hi (:$ 0))
418    (digit-h temp0 hi)
419    (digit-l temp1 hi)
420    (digit-h temp2 lo)
421    (digit-l arg_z lo)
422    (vpush1 temp0)
423    (vpush1 temp1)
424    (vpush1 temp2)
425    (vpush1 arg_z)
426    (set-nargs 4)
427    (add temp0 vsp (:$ 16))
428    (spjump .SPvalues)))
429
430
431(defarmlapfunction %logcount-complement ((bignum arg_y) (idx arg_z))
432  (let ((arg imm0)
433        (shift imm1)
434        (temp imm2))
435    (add arg idx (:$ arm::misc-data-offset))
436    (ldr arg (:@ bignum arg))
437    (mvns shift arg)
438    (mov arg_z '0)
439    (bxeq lr)
440    @loop
441    (add temp shift (:$ -1))
442    (ands shift shift temp)
443    (add arg_z arg_z '1)
444    (bne @loop)
445    (bx lr)))
446
447(defarmlapfunction %logcount ((bignum arg_y) (idx arg_z))
448  (let ((arg imm0)
449        (shift imm1)
450        (temp imm2))
451    (add arg idx (:$ arm::misc-data-offset))
452    (ldr arg (:@ bignum arg))
453    (movs shift arg)
454    (mov arg_z '0)
455    (bxeq lr)
456    @loop
457    (add temp shift (:$ -1))
458    (ands shift shift temp)
459    (add arg_z arg_z '1)
460    (bne @loop)
461    (bx lr)))
462
463; return res
464#+notyet
465(defarmlapfunction bignum-add-loop-2 ((aptr arg_x)(bptr arg_y) (result arg_z))
466  (let ((idx imm0)
467        (count imm1)
468        (x imm2)
469        (y imm3)       
470        (len-a temp0)
471        (len-b temp1)
472        (tem temp2))
473    (li idx arm::misc-data-offset)   
474    (ldr imm4 aptr (:$ arm::misc-header-offset))
475    (header-length len-a imm4)
476    (ldr imm4 bptr (:$ arm::misc-header-offset))
477    (header-length len-b imm4)
478    ; make a be shorter one
479    (cmpw len-a len-b)
480    (li count 0)
481    ; initialize carry 0
482    (addc x rzero rzero)
483    (ble @loop)
484    ; b shorter - swap em
485    (mr tem len-a)
486    (mr len-a len-b)
487    (mr len-b tem)
488    (mr tem aptr)
489    (mr aptr bptr)
490    (mr bptr tem)   
491    @loop
492    (ldr y (:@ aptr idx))
493    (ldr x (:@ bptr idx))   
494    (addi count count '1)
495    (cmpw count len-a)
496    (adde x x y)
497    (str x (:@ result idx))
498    (addi idx idx '1)
499    (blt @loop)
500    ; now propagate carry thru longer (b) using sign of shorter   
501    ;(SUBI imm4 idx '1) ; y has hi order word of a
502    ;(ldr y (:@ aptr imm4))
503    (cmpw len-a len-b)
504    (adde imm4 rzero rzero) ; get carry
505    (srawi y y 31)  ; p.o.s clobbers carry
506    (addic imm4 imm4 -1)  ; restore carry
507    (beq @l3)  ; unless equal
508    @loop2
509    (ldr x (:@ bptr idx))
510    (adde x x y)
511    (str x (:@ result idx))
512    (addi count count '1)
513    (cmpw count len-b)
514    (addi idx idx '1)
515    (blt @loop2)
516    ; y has sign of shorter - get sign of longer to x
517    @l3
518    (subi imm4 idx '1)
519    (ldr x (:@ bptr imm4))
520    (adde imm4 rzero rzero) ; get carry
521    (srawi x x 31)  ; clobbers carry
522    (addic imm4 imm4 -1)
523    (adde x x y)
524    (str x (:@ result idx))
525    (bx lr)))
526
527;; same as above but with initial a index and finishes, and is actually called.
528(defarmlapfunction bignum-add-loop-+ ((init-a 0)(aptr arg_x)(bptr arg_y)(length arg_z))
529  (let ((count temp0)
530        (carry temp1)
531        (x imm0)
532        (y imm1)
533        (aidx imm2)
534        (idx y))
535    (ldr aidx (:@ vsp (:$ init-a)))
536    (add aidx aidx (:$ arm::misc-data-offset))
537    (mov count (:$ 0))
538    ; initialize carry 0
539    (mov carry (:$ 0))
540    @loop
541    (adds carry carry carry)
542    (ldr x (:@ aptr aidx))
543    (add idx count (:$ arm::misc-data-offset))
544    (ldr y (:@ bptr idx))
545    (adcs x x y)
546    (movcc carry '0)
547    (movcs carry (:$ #x80000000))
548    (str x (:@ aptr aidx))
549    (add count count '1)
550    (cmp count length)
551    (add aidx aidx '1)
552    (blt @loop)
553    (adds carry carry carry)
554    (ldr x (:@ aptr aidx))  ; add carry into next one
555    (adc x x (:$ 0))
556    (str x (:@ aptr aidx))
557    (add vsp vsp (:$ 4))
558    (bx lr)))
559
560
561#+notyet
562(defarmlapfunction bignum-negate-loop-really ((big arg_x) (len arg_y) (result arg_z))
563  (let ((idx imm0)
564        (one imm1)
565        (x imm2))
566    (li idx arm::misc-data-offset)
567    (li one '1)
568    ; initialize carry 1
569    (li x -1)
570    (addic x x 1)
571    @loop       
572    ;(addi count count '1)   
573    ;(cmpw count len)
574    (subf. len one len)
575    (ldr x (:@ big idx))
576    (not x x)
577    (adde x x rzero)
578    (str x (:@ result idx))   
579    (addi idx idx '1)
580    (bgt @loop)
581    ; return carry
582    (li x 0)
583    (adde x x  rzero)
584    (box-fixnum arg_z x)
585    (bx lr)))
586
587#+notyet
588(defarmlapfunction bignum-negate-to-pointer ((big arg_x) (len arg_y) (result arg_z))
589  (let ((idx imm0)
590        (one imm1)
591        (x imm2)
592        (oidx imm3)
593        (ptr imm4))
594    (li idx arm::misc-data-offset)
595    (li oidx 0)
596    (macptr-ptr ptr result)
597    (li one '1)
598    ; initialize carry 1
599    (li x -1)
600    (addic x x 1)
601    @loop       
602    ;(addi count count '1)   
603    ;(cmpw count len)
604    (subf. len one len)
605    (ldr x (:@ big idx))
606    (not x x)
607    (adde x x rzero)
608    (str x (:@ ptr oidx))   
609    (addi idx idx '1)
610    (addi oidx oidx 4)
611    (bgt @loop)
612    ; return carry
613    (li x 0)
614    (adde x x  rzero)
615    (box-fixnum arg_z x)
616    (bx lr)))
617
618
619
620
621#+notyet
622(defarmlapfunction bignum-shift-right-loop-1 ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (iidx arg_z))
623  (let ((y imm0)
624        (idx imm1)
625        (bits imm2)
626        (rbits imm3)
627        (x imm4)
628        (jidx temp0)
629        (resptr temp1))
630    (li jidx 0)
631    (ldr bits vsp (:$ nbits))
632    (ldr resptr vsp (:$ result))
633    (unbox-fixnum bits bits)
634    (cmpw jidx len)
635    (subfic rbits bits 32)   
636    (bge @done)
637    @loop
638    (addi idx iidx arm::misc-data-offset)
639    (ldr x (:@ bignum idx))
640    (srw x x bits)
641    (addi idx idx '1)
642    (ldr y (:@ bignum idx))
643    (slw y y rbits)
644    (or x x y)
645    (addi idx jidx arm::misc-data-offset)
646    (str x (:@ resptr idx))
647    (addi jidx jidx '1)   
648    (cmpw jidx len)
649    (addi iidx iidx '1)
650    (blt @loop)
651    @done
652    (addi idx iidx arm::misc-data-offset)
653    (ldr x (:@ bignum idx))
654    (sraw x x bits)
655    (addi idx jidx arm::misc-data-offset)
656    (str x (:@ resptr idx))
657    (add vsp vsp (:$ 8))
658    (bx lr)))
659
660
661(defarmlapfunction %compare-digits ((a arg_x) (b arg_y) (idx arg_z))
662  (add imm0 idx (:$ arm::misc-data-offset))
663  (ldr imm1 (:@ a imm0))
664  (ldr imm0 (:@ b imm0))
665  (cmp imm1 imm0)
666  (moveq arg_z '0)
667  (movhi arg_z '1)
668  (movlo arg_z '-1)
669  (bx lr))
670
671
672 
673;; returns number of bits in digit-hi,digit-lo that are sign bits
674;; 32 - digits-sign-bits is integer-length
675
676(defarmlapfunction %digits-sign-bits ((hi arg_y) (lo arg_z))
677  (compose-digit imm1 hi lo)
678  (cmp imm1 (:$ 0))
679  (mvnlt imm1 imm1)
680  (clz imm1 imm1)
681  (box-fixnum arg_z imm1)
682  (bx lr))
683
684(defarmlapfunction bignum-logtest-loop ((count arg_x) (b1 arg_y) (b2 arg_z)) 
685  (mov imm1 (:$ arm::misc-data-offset))
686  @loop
687  (ldr imm2 (:@ b1 imm1))
688  (ldr imm0 (:@ b2 imm1))
689  (ands imm2 imm0 imm2) 
690  (add imm1 imm1 (:$ 4))
691  (bne @true)
692  (subs count count (:$ 4))
693  (bgt  @loop)
694  (mov arg_z (:$ arm::nil-value))
695  (bx lr)
696  @true
697  (mov arg_z (:$ arm::nil-value))
698  (add arg_z arg_z (:$ arm::t-offset))
699  (bx lr))
700
701;;; dest[idx] <- (lognot src[idx])
702(defarmlapfunction %bignum-lognot ((idx arg_x) (src arg_y) (dest arg_z))
703  (add imm1 idx (:$ arm::misc-data-offset))
704  (ldr imm0 (:@ src imm1))
705  (mvn imm0 imm0)
706  (str imm0 (:@ dest imm1))
707  (bx lr))
708
709;;; dest[idx] <- (logand x[idx] y[idx])
710(defarmlapfunction %bignum-logand ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
711  (vpop1 temp0)
712  (add imm1 temp0 (:$ arm::misc-data-offset))
713  (ldr imm0 (:@ x imm1))
714  (ldr imm2 (:@ y imm1))
715  (and imm0 imm0 imm2)
716  (str imm0 (:@ dest imm1))
717  (bx lr))
718
719;;; dest[idx] <- (logandc2 x[idx] y[idx])
720(defarmlapfunction %bignum-logandc2 ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
721  (vpop1 temp0)
722  (add imm1 temp0 (:$ arm::misc-data-offset))
723  (ldr imm0 (:@ x imm1))
724  (ldr imm2 (:@ y imm1))
725  (bic imm0 imm0 imm2)
726  (str imm0 (:@ dest imm1))
727  (bx lr))
728
729;;; dest[idx] <- (logandc1 x[idx] y[idx])
730(defarmlapfunction %bignum-logandc1 ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
731  (vpop1 temp0)
732  (add imm1 temp0 (:$ arm::misc-data-offset))
733  (ldr imm0 (:@ x imm1))
734  (ldr imm2 (:@ y imm1))
735  (bic imm0 imm2 imm0)
736  (str imm0 (:@ dest imm1))
737  (bx lr))
738
739
740
741(defarmlapfunction digit-lognot-move ((index arg_x) (source arg_y) (dest arg_z))
742  (let ((scaled-index imm1))
743    (vref32 imm0 source index scaled-index) ; imm1 has c(index) + data-offset
744    (mvn imm0 imm0)
745    (str imm0 (:@ dest scaled-index))
746    (bx lr)))
747
748(defarmlapfunction macptr->fixnum ((ptr arg_z))
749  (macptr-ptr arg_z ptr)
750  (bx lr))
751
752; if dest not nil store unboxed result in dest(0), else return boxed result
753(defarmlapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
754  (let ((w1 imm0)
755        (w2 imm1))
756    (unbox-fixnum  w1 fix)
757    (ldr w2 (:@ big (:$ arm::misc-data-offset)))
758    (cmp dest 'nil)
759    (bic w1 w1 w2)
760    (bne @store)
761    (box-fixnum arg_z w1)
762    (bx lr)
763    @store
764    (str w1 (:@ dest  (:$ arm::misc-data-offset)))
765    (bx lr)))
766
767
768
769(defarmlapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
770  (let ((w1 imm0)
771        (w2 imm1))
772    (unbox-fixnum  w1 fix)
773    (ldr w2 (:@ big (:$ arm::misc-data-offset)))
774    (cmp dest 'nil)
775    (and w1 w1 w2)
776    (bne @store)
777    (box-fixnum arg_z w1)
778    (bx lr)
779    @store
780    (str w1 (:@ dest  (:$ arm::misc-data-offset)))
781    (bx lr)))
782
783
784
785(defarmlapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
786  (let ((w1 imm0)
787        (w2 imm1))
788    (unbox-fixnum  w1 fix)
789    (ldr w2 (:@ big (:$ arm::misc-data-offset)))
790    (cmp dest 'nil)
791    (bic w1 w2 w1)
792    (bne @store)
793    (box-fixnum arg_z w1)
794    (bx lr)
795    @store
796    (str w1 (:@ dest  (:$ arm::misc-data-offset)))
797    (bx lr)))
798
799;;; dest[idx] <- (logior x[idx] y[idx])
800(defarmlapfunction %bignum-logior ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
801  (vpop1 temp0)
802  (add imm1 temp0 (:$ arm::misc-data-offset))
803  (ldr imm0 (:@ x imm1))
804  (ldr imm2 (:@ y imm1))
805  (orr imm0 imm0 imm2)
806  (str imm0 (:@ dest imm1))
807  (bx lr))
808
809;;; dest[idx] <- (logxor x[idx] y[idx])
810(defarmlapfunction %bignum-logxor ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
811  (vpop1 temp0)
812  (add imm1 temp0 (:$ arm::misc-data-offset))
813  (ldr imm0 (:@ x imm1))
814  (ldr imm2 (:@ y imm1))
815  (eor imm0 imm0 imm2)
816  (str imm0 (:@ dest imm1))
817  (bx lr))
818
819
820
821(defarmlapfunction bignum-xor-loop ((count 0) (b1 arg_x) (b2 arg_y) (dest arg_z))
822  (ldr temp0 (:@ vsp (:$ count)))
823  (mov imm1 (:$ arm::misc-data-offset))
824  @loop
825  (ldr imm2 (:@ b1 imm1))
826  (ldr imm0 (:@ b2 imm1))
827  (eor imm2 imm0 imm2)
828  (subs temp0 temp0 (:$ 4))
829  (str imm2 (:@ dest imm1))
830  (add imm1 imm1 (:$ 4))
831  (bgt @loop)
832  @out
833  (add vsp vsp (:$ 4))
834  (bx lr))
835
836#+nomore
837(defarmlapfunction try-guess-loop-1 ((guess-h 8)(guess-l 4)(len-y 0)
838                                     (xidx arg_x) (xptr arg_y) (yptr arg_z))
839  (let ((guess imm0)
840        (carry imm1)
841        (y imm2)
842        (x imm2)
843        (prod-l imm3)
844        (prod-h imm4)
845        (tem imm4)
846        (yidx temp0)
847        (end-y temp1)
848        (carry-bit temp2))
849    (ldr x vsp (:$ guess-h))
850    (ldr tem vsp (:$ guess-l))
851    (compose-digit guess x tem)
852    (ldr end-y vsp (:$ len-y))
853    (li yidx 0)
854    (li carry 0) 
855    (li carry-bit '1)
856    @loop
857    ; multiply guess by ydigit, add carry to lo, hi is new carry
858    ; then get an xdigit subtract prod-lo from it and store result in x (remember carry)
859    (addi tem yidx arm::misc-data-offset)   ; get yidx
860    (ldr y (:@ yptr tem))
861    (mullw prod-l guess y)
862    (mulhwu prod-h guess y)   
863    (addc prod-l prod-l carry) 
864    (adde carry prod-h rzero)
865    ; get back saved carry
866    (li tem '-1)
867    (addc tem carry-bit tem)
868    (addi tem xidx arm::misc-data-offset)
869    (ldr x (:@ xptr tem))   
870    (subfe x prod-l x)       
871    (str x (:@ xptr tem))
872    ; save carry
873    (adde prod-l rzero rzero)
874    (box-fixnum carry-bit prod-l)
875    (addi yidx yidx '1)
876    (cmpw yidx end-y)
877    (addi xidx xidx '1)
878    (blt @loop)
879    ; finally subtract carry from last x digit
880    @done
881    (li prod-l '-1)  ; get back saved carry again - box clobbered it?
882    (addc prod-l carry-bit prod-l)
883    (addi tem xidx arm::misc-data-offset) ; maybe still there - nope
884    (ldr x (:@ xptr tem))
885    (subfe x carry x)
886    (str x (:@ xptr tem))
887    (add vsp vsp (:$ 12))
888    (bx lr)))
889
890;; x0 is at index, x1 at index-1, x2 at index-2
891;; y1 is at index, y2 at index-1
892;; this doesnt help much
893(defarmlapfunction truncate-guess-loop ((guess-h 8)(guess-l 4)(x 0)
894                                        (xidx arg_x)(yptr arg_y) (yidx arg_z))
895  (let ((guess imm0)
896        (y1 imm1)
897        (y2 imm1)
898        (gy1-lo imm2) ; look out below
899        (gy1-hi imm2)
900        (gy2-lo imm2)
901        (gy2-hi imm2)
902        (xptr temp0)
903        (m r3)
904        (tem temp1)
905        (save-rcontext temp2)
906        (m-save 24)
907        (y1-idx 20)
908        (y2-idx 16)
909        (x0-idx 12)
910        (x1-idx 8)
911        (x2-idx 4))
912    (mov imm0 (:$ (ash 6 arm::num-subtag-bits)))
913    (orr imm0 imm0 (:$ arm::subtag-u32-vector))
914    (str imm0 (:@! sp (:$ -32)))
915    (mov save-rcontext rcontext)
916    (ldr y1 (:@ vsp (:$ guess-h)))
917    (ldr m (:@ vsp (:$ guess-l)))
918    (compose-digit guess y1 m)
919    (mov tem (:lsl yidx (:$ arm::fixnumshift)))
920    (add tem tem (:$ (ash arm::misc-data-offset arm::fixnumshift)))
921    (ldr y1 (:@ yptr (:asr tem (:$ arm::fixnumshift))))
922    (str y1 (:@ sp  (:$ y1-idx)))
923    (sub tem tem '4)
924    (ldr y2 (:@ yptr (:asr tem (:$ arm::fixnumshift))))
925    (str y2 (:@ sp  (:$ y2-idx)))
926    (ldr xptr (:@ vsp (:$ x)))
927    (mov tem (:lsl xidx (:$ arm::fixnumshift)))
928    (add tem tem (:$ (ash arm::misc-data-offset arm::fixnumshift)))
929    (ldr y1 (:@ xptr (:asr tem (:$ arm::fixnumshift)))) ; its x0
930    (str y1 (:@ sp  (:$ x0-idx)))
931    (sub tem tem '4)
932    (ldr y1 (:@ xptr (:asr tem (:$ arm::fixnumshift))))
933    (str y1 (:@ sp  (:$ x1-idx)))
934    (sub tem tem '4)
935    (ldr y1 (:@ xptr (:asr tem (:$ arm::fixnumshift))))
936    (str y1 (:@ sp  (:$ x2-idx)))
937    @loop
938    (ldr y1 (:@ sp (:$ y1-idx)))     ; get y1
939    (mul gy1-lo guess y1)
940    (ldr m (:@ sp (:$ x1-idx)))      ; get x1
941    (subs m m gy1-lo)      ; x1 - gy1-lo => m
942    (umull y2 gy1-hi guess y1)
943    (ldr y2 (:@ sp (:$ x0-idx)))    ; get x0
944    (rscs y2 gy1-hi y2)      ; - val not used just cr
945    (ldr y2 (:@ sp (:$ y2-idx)))     ; get y2
946    (str m (:@ sp (:$ m-save)))
947    (umull m gy2-hi guess y2)   ; does it pay to do this now even tho may not need?
948    (ldr m (:@ sp (:$ m-save)))
949    (bne @done)
950    (cmp gy2-hi m)       ; if > or = and foo then more - L means logical means unsigned
951    (blo @done)           ; if < done
952    (bne @more)           ; if = test lo
953    (mul gy2-lo guess y2)
954    (ldr y1 (:@ sp (:$ x2-idx))) ; get x2
955    (cmp gy2-lo y1)
956    (bls @done)
957    @more
958    (sub guess guess (:$ 1))
959    (b @loop)
960    @done
961    (mov rcontext save-rcontext)
962    (digit-h temp0 guess)
963    (vpush1 temp0)
964    (digit-l temp0 guess)
965    (vpush1 temp0)
966    (add temp0 vsp (:$ 20))
967    (add sp sp (:$ 32))
968    (set-nargs 2)
969    (spjump .SPvalues)))
970
971(defarmlapfunction normalize-bignum-loop ((sign arg_x)(res arg_y)(len arg_z))
972  (let ((idx imm0)
973        (usign imm1)
974        (val imm2))     
975    (unbox-fixnum usign sign)
976    (cmp len '0)
977    (add idx len (:$ (- arm::misc-data-offset 4))  )
978    (bxeq lr) ; huh - can this ever happen?
979    @loop
980    (ldr val (:@ res idx))
981    (cmp  val usign)   
982    (sub idx idx '1)
983    (bne @neq)   
984    (subs len len '1)
985    (bgt @loop)
986    ; fall through - its all sign - return 1
987    (mov arg_z '1)
988    (bx lr)
989    @neq
990    (and usign usign (:$ #x80000000))
991    (and val val (:$ #x80000000))
992    (cmp usign val)  ; is hi bit = sign, if so then done   
993    (addne len len '1) ; if not, need 1 more
994    (bx lr)))
995
996(defarmlapfunction %normalize-bignum-2 ((fixp arg_y)(res arg_z))
997  (let ((idx imm0)
998        (usign imm1)
999        (val imm2)
1000        (len arg_x)
1001        (oldlen temp0))
1002    (vector-length len res imm0)
1003    (cmp len (:$ 0))
1004    (mov oldlen len)
1005    (add idx len (:$ (- arm::misc-data-offset 4))  )
1006    (bxeq lr) ; huh - can this ever happen?
1007    (ldr val (:@ res idx)) ; high order word
1008    (mov usign (:asr val (:$ 31))) ; get sign
1009    @loop
1010    (ldr val (:@ res idx))
1011    (cmp  val usign)   
1012    (sub idx idx '1)
1013    (bne @neq)   
1014    (subs len len '1)
1015    (bgt @loop)
1016    ; fall through - its all sign - return 1
1017    (mov len '1)
1018    (and usign usign (:$ #x80000000))
1019    (b @more)
1020    @neq
1021    (and usign usign (:$ #x80000000))
1022    (and val val (:$ #x80000000))
1023    (cmp usign val)  ; is hi bit = sign, if so then done   
1024    (beq @more)
1025    (add len len '1) ; if not, need 1 more
1026    (b @big)
1027    @more
1028    (cmp  fixp 'nil)
1029    (beq @big)                          ; dont return fixnum
1030    (cmp len '1)
1031    (bgt @big)
1032    ;; stuff for maybe fixnum
1033    ;(dbg t)
1034    (ldr val (:@ res (:$ arm::misc-data-offset)))
1035    (box-fixnum temp1 val)
1036    (cmp val (:asr temp1 (:$ arm::fixnumshift)))
1037    (moveq arg_z temp1)
1038    (bxeq lr)
1039    @big
1040    (cmp oldlen len)
1041    (bxeq lr) ; same length - done
1042    (mov imm2 (:$ arm::subtag-bignum))
1043    (cmp usign (:$ 0))
1044    (orr imm2 imm2 (:lsl len (:$ (- arm::num-subtag-bits arm::fixnumshift))))
1045    ;; 0 to tail if negative
1046    (beq @set-header) 
1047    ;; zero from len inclusive to oldlen exclusive
1048    (add idx len (:$ arm::misc-data-offset))
1049    @loop2
1050    (tst len (:$ arm::fixnumone))
1051    (add len len '1)
1052    (movne imm1 (:$ (logand #xff00 arm::one-digit-bignum-header)))
1053    (orrne imm1 imm1 (:$ (logand #xff arm::one-digit-bignum-header)))
1054    (moveq imm1 (:$ #x80000000))
1055    (cmp len oldlen)
1056    (str imm1 (:@ idx res))
1057    (add idx idx '1)
1058    (blt @loop2)
1059    @set-header
1060    (str imm2 (:@ res (:$ arm::misc-header-offset)))
1061    (bx lr)))
1062
1063(defarmlapfunction %count-digit-leading-zeros ((high arg_y) (low arg_z))
1064  (compose-digit imm0 high low)
1065  (clz imm0 imm0)
1066  (box-fixnum arg_z imm0)
1067  (bx lr))
1068
1069(defarmlapfunction %count-digit-trailing-zeros ((high arg_y) (low arg_z))
1070  (compose-digit imm0 high low)
1071  (rsb  imm1 imm0 (:$ 0))
1072  (and imm0 imm0 imm1)
1073  (clz imm0 imm0)
1074  (rsb imm0 imm0 (:$ 31))
1075  (box-fixnum arg_z imm0)
1076  (bx lr))
1077
1078
1079(defarmlapfunction %bignum-count-trailing-zero-bits ((bignum arg_z))
1080  (let ((ndigits arg_x)
1081        (nbits arg_y)
1082        (digit imm0)
1083        (ptr imm1))
1084    (mov ptr (:$ arm::misc-data-offset))
1085    (mov ndigits '-32)
1086    @next
1087    (ldr digit (:@ bignum ptr))
1088    (cmp digit (:$ 0))
1089    (add ptr ptr (:$ 4))
1090    (add ndigits ndigits '32)
1091    (beq @next)
1092    (rsb ptr digit (:$ 0))
1093    (and digit digit ptr)
1094    (clz digit digit)
1095    (rsb digit digit (:$ 31))
1096    (box-fixnum nbits digit)
1097    (add arg_z nbits ndigits)
1098    (bx lr)))
1099
1100
1101(defarmlapfunction %bignum-trim-leading-zeros ((bignum arg_x)
1102                                               (start arg_y)
1103                                               (len arg_z))
1104  (add imm1 start len)
1105  (add imm1 imm1 (:$ (- arm::misc-data-offset 4)))
1106  @loop
1107  (ldr imm0 (:@ bignum imm1))
1108  (cmp imm0 (:$ 0))
1109  (add imm1 imm1 (:$ -4))
1110  (bxne lr)
1111  (subs len len '-1)
1112  (bne @loop)
1113  (bx lr))
1114 
1115;;; Set length of bignum to new-len (zeroing out any trailing words between
1116;;; the old length and the new.
1117(defarmlapfunction %shrink-bignum ((new-len arg_y) (bignum arg_z))
1118  (let ((old-len temp0)
1119        (rzero temp1)
1120        (old-idx imm0)
1121        (new-idx imm2)
1122        (header imm1))
1123    (getvheader header bignum)
1124    (header-length old-len header)
1125    (mov rzero (:$ 0))
1126    (cmp old-len new-len)
1127    (add old-idx old-len (:$ arm::misc-data-offset))
1128    (add new-idx new-len (:$ arm::misc-data-offset))
1129    (bxeq lr)
1130    @loop
1131    (sub old-idx old-idx (:$ 4))
1132    (cmp old-idx new-idx)
1133    (str rzero (:@ bignum old-idx))
1134    (bne @loop)
1135    (mov header (:lsl new-len (:$ (- arm::num-subtag-bits arm::fixnumshift))))
1136    (orr header header (:$ arm::subtag-bignum))
1137    (str header (:@ bignum  (:$ arm::misc-header-offset)))
1138    (bx lr)))
1139
1140;;; Divide bignum x by single digit y (passed as two halves).
1141;;; The quotient in stored in q, and the remainder is returned
1142;;; in two halves.  (cf. Knuth, 4.3.1, exercise 16)
1143(defarmlapfunction %floor-loop-quo ((x 0) (res arg_x) (yhi arg_y) (ylo arg_z))
1144  (let ((bignum temp0)
1145        (len temp2))                    ;not nfn here.
1146    (ldr bignum (:@ vsp (:$ x)))
1147    (add imm1 vsp (:$ arm::node-size))
1148    (build-lisp-frame imm0 imm1)
1149    (vector-length len bignum imm0)
1150    (mov imm2 (:$ 0))
1151    (b @next)
1152    @loop
1153    (add imm0 len (:$ arm::misc-data-offset))
1154    (ldr imm0 (:@ bignum imm0))
1155    (mov imm1 imm2)
1156    (compose-digit imm2 yhi ylo)
1157    (sploadlr .SPudiv64by32)
1158    (blx lr)
1159    (add imm1 len (:$ arm::misc-data-offset))
1160    (str imm0 (:@ res imm1))
1161    @next
1162    (subs len len '1)
1163    (bge @loop)
1164    (digit-h yhi imm2)
1165    (digit-l ylo imm2)
1166    (vpush1 yhi)
1167    (vpush1 ylo)
1168    (set-nargs 2)
1169    (spjump .SPnvalret)))
1170
1171;;; For TRUNCATE-BY-FIXNUM et al.
1172;;; Doesn't store quotient: just returns rem in 2 halves.
1173(defarmlapfunction %floor-loop-no-quo ((x arg_x) (yhi arg_y) (ylo arg_z))
1174  (let ((len temp1))
1175    (build-lisp-frame)
1176    (vector-length len x imm0)
1177    (mov imm2 (:$ 0))
1178    (b @next)
1179    @loop
1180    (add imm0 len (:$ arm::misc-data-offset))
1181    (ldr imm0 (:@ x imm0))
1182    (mov imm1 imm2)
1183    (compose-digit imm2 yhi ylo)
1184    (sploadlr .SPudiv64by32)
1185    (blx lr)
1186    @next
1187    (subs len len '1)
1188    (bge @loop)
1189    (digit-h yhi imm2)
1190    (digit-l ylo imm2)
1191    (vpush1 yhi)
1192    (vpush1 ylo)
1193    (set-nargs 2)
1194    (spjump .SPnvalret)))
1195   
1196   
1197
1198   
1199   
1200(defarmlapfunction bignum-negate-loop-really ((big arg_x) (len arg_y) (result arg_z))
1201  (let ((idx imm0)
1202        (x imm1)
1203        (carry imm2))
1204    (mov idx (:$ arm::misc-data-offset))
1205    ;; initialize carry 1
1206    (mov carry (:$ 1))
1207    @loop       
1208    (ldr x (:@ big idx))
1209    (mvn x x)
1210    (adds x x carry)
1211    (str x (:@ result idx))
1212    (movcc carry (:$ 0))
1213    (movcs carry (:$ 1))
1214    (subs len len '1)
1215    (add idx idx '1)
1216    (bgt @loop)
1217    ; return carry
1218    (box-fixnum arg_z carry)
1219    (bx lr)))
1220
1221(defarmlapfunction bignum-shift-left-loop ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (j arg_z))
1222  (let ((y imm0)
1223        (x imm1)
1224        (shift imm2)
1225        (rcontext-save temp1)
1226        (rshift r3)
1227        (i temp0)
1228        (resptr temp2))
1229    (vpop1 resptr)
1230    (mov i (:$ (ash arm::misc-data-offset 2)))
1231    (vpop1 shift)
1232    (mov rcontext-save rcontext)
1233    (ldr x (:@ bignum (:$ arm::misc-data-offset)))
1234    (unbox-fixnum shift shift)
1235    (rsb rshift shift (:$ 32))
1236    (mov x (:lsl x shift))
1237    (add y j (:$ (+ arm::misc-data-offset -4)))
1238    (str x (:@ resptr y))
1239    (cmp len j)
1240    (beq @done)
1241    @loop
1242    (ldr x (:@ bignum (:asr i (:$ 2))))
1243    (mov x (:lsr x rshift))
1244    (add i i '4)                        ;sic
1245    (ldr y (:@ bignum (:asr i (:$ 2))))
1246    (orr y x (:lsl y shift))
1247    (add x j (:$ arm::misc-data-offset))
1248    (str y (:@ resptr x))
1249    (add j j '1)   
1250    (cmp j len)
1251    (blt @loop)   
1252    @done
1253    (ldr y (:@ bignum (:asr i (:$ 2))))
1254    (mov y (:asr y rshift))
1255    (add x len (:$ arm::misc-data-offset))
1256    (str y (:@ resptr x))
1257    (mov rcontext rcontext-save)
1258    (bx lr)))
1259
1260(defarmlapfunction bignum-shift-right-loop-1 ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (iidx arg_z))
1261  (let ((y imm0)
1262        (x imm1)
1263        (shift imm2)
1264        (idx imm2)
1265        (jidx temp0)
1266        (resptr temp1)
1267        (boxed-shift temp2))
1268    (vpop1 resptr)
1269    (vpop1 boxed-shift)
1270    (mov jidx '0)
1271    (cmp jidx len)
1272    (bge @done)
1273    @loop
1274    (add idx iidx (:$ arm::misc-data-offset))
1275    (ldr x (:@ bignum idx))
1276    (unbox-fixnum shift boxed-shift)
1277    (mov x (:lsr x shift))
1278    (add idx iidx (:$ (+ arm::misc-data-offset 4)))
1279    (ldr y (:@ bignum idx))
1280    (unbox-fixnum shift boxed-shift)
1281    (rsb shift shift (:$ 32))
1282    (mov y (:lsl y shift))
1283    (orr x x y)
1284    (add idx jidx (:$ arm::misc-data-offset))
1285    (str x (:@ resptr idx))
1286    (add jidx jidx '1)
1287    (cmp jidx len)
1288    (add iidx iidx '1)
1289    (blt @loop)
1290    @done
1291    (add idx iidx (:$ arm::misc-data-offset))
1292    (ldr x (:@ bignum idx))
1293    (unbox-fixnum shift boxed-shift)
1294    (mov x (:asr x shift))
1295    (add idx jidx (:$ arm::misc-data-offset))
1296    (str x (:@ resptr idx))
1297    (bx lr)))
1298
1299;;; If x[i] = y[j], return the all ones digit (as two halves).
1300;;; Otherwise, compute floor x[i]x[i-1] / y[j].
1301(defarmlapfunction %floor-99 ((x-stk 0) (xidx arg_x) (yptr arg_y) (yidx arg_z))
1302  (add imm1 vsp (:$ 4))
1303  (build-lisp-frame imm0 imm1)
1304  (mov fn nfn)
1305  (ldr temp0 (:@ vsp (:$ x-stk)))
1306  (add imm0 xidx (:$ arm::misc-data-offset))
1307  (add imm1 yidx (:$ arm::misc-data-offset))
1308  (ldr imm0 (:@ temp0 imm0))
1309  (ldr imm2 (:@ yptr imm1))
1310  (cmp imm0 imm2)
1311  (bne @more)
1312  (mov imm0 (:$ (ash #xff arm::fixnumshift)))
1313  (orr imm0 imm0 (:$ (ash #xff00 arm::fixnumshift)))
1314  (vpush1 imm0)
1315  (vpush1 imm0)
1316  (set-nargs 2)
1317  (spjump .SPnvalret)
1318  @more
1319  (add imm1 xidx (:$ (- arm::misc-data-offset arm::node-size)))
1320  (ldr imm0 (:@ temp0 imm1))
1321  (add imm1 imm1 (:$ arm::node-size))
1322  (ldr imm1 (:@ temp0 imm1))
1323  (sploadlr .SPudiv64by32)
1324  (blx lr)
1325  (mov arg_y '-1)
1326  (and arg_y arg_y (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
1327  (mov imm0 (:lsl imm0 (:$ 16)))
1328  (mov arg_z '-1)
1329  (and arg_z arg_z (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
1330  (stmdb (:! vsp) (arg_z arg_y))
1331  (set-nargs 2)
1332  (spjump .SPnvalret))
1333
1334;;; Karatsuba multiplication stuff. NYI.
1335;;; Copy the limb SRC points to to where DEST points.
1336(defarmlapfunction copy-limb ((src arg_y) (dest arg_z))
1337  (uuo-debug-trap (:? al)))
1338
1339;;; Return T iff LIMB contains 0.
1340(defarmlapfunction limb-zerop ((limb arg_z))
1341  (uuo-debug-trap (:? al)))
1342
1343;;; Return -1,0,1 according to whether the contents of Y are
1344;;; <,=,> the contents of Z.
1345(defarmlapfunction compare-limbs ((y arg_y) (z arg_z))
1346  (uuo-debug-trap (:? al)))
1347
1348;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
1349(defarmlapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1350  (uuo-debug-trap (:? al)))
1351
1352;;; Store a fixnum value where LIMB points.
1353(defarmlapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1354  (uuo-debug-trap (:? al)))
1355
1356;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
1357;;; knows that carries will only propagate for a word or two.
1358(defarmlapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
1359  (uuo-debug-trap (:? al)))
1360
1361;;; Store XP-YP at WP; return carry (0 or 1).
1362;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
1363;;; size: boxed fixnum
1364;;; returns boxed carry
1365(defarmlapfunction mpn-sub-n ((wp 8) (xp arg_x) (yp arg_y) (size arg_z))
1366  (uuo-debug-trap (:? al)))
1367
1368;;; Store XP+YP at WP; return carry (0 or 1).
1369;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
1370;;; size = boxed fixnum
1371;;; result = boxed carry
1372(defarmlapfunction mpn-add-n ((wp 0) (xp arg_x)
1373                                (yp arg_y) (size arg_z))
1374  (uuo-debug-trap (:? al)))
1375
1376;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
1377;;; result at RP.  RP and S1P may be the same place, so check for
1378;;; that and do nothing after carry stops propagating.  Return carry.
1379(defarmlapfunction mpn-add-1 ((rp-offset 0) (s1p arg_x) 
1380                                (size arg_y) (limb arg_z))
1381  (uuo-debug-trap (:? al)))
1382
1383;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
1384;;; the result at RES.  Store the "carry out" (high word of last 64-bit
1385;;; partial product) at the limb RESULT.
1386;;; res, s1, limbptr, result:
1387;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
1388;;; It'd be hard to transliterate the GMP code here; the GMP version
1389;;; uses lots more immediate registers than we can easily use in LAP
1390;;; (and is much more aggressively pipelined).
1391(defarmlapfunction mpn-mul-1 ((res-offset 4)
1392                                (s1-offset 0)
1393                                (size arg_x)
1394                                (limbptr arg_y)
1395                                (result arg_z))
1396  (uuo-debug-trap (:? al)))
1397
1398;;; multiply s1*limb and add result to res
1399;;; res, s1, limbptr, result:
1400;;;   unboxed, word-aligned ptrs (fixnums).
1401;;; size: boxed fixnum
1402;;; limbptr: source "limb".
1403;;; result: carry out (high word of product).
1404(defarmlapfunction mpn-addmul-1 ((res-offset 4)
1405                                   (s1-offset 0)
1406                                   (size arg_x)
1407                                   (limbptr arg_y)
1408                                   (result arg_z))
1409  (uuo-debug-trap (:? al)))
1410
1411;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
1412;;; at VP, store the result at RP.
1413(defarmlapfunction mpn-mul-basecase ((rp-offset 4)
1414                                       (up-offset 0)
1415                                       (un arg_x)
1416                                       (vp arg_y)
1417                                       (vn arg_z))
1418  (uuo-debug-trap (:? al)))
1419
1420;;; left-shift src by 1 bit, storing result at res.  Return
1421;;; the bit that was shifted out.
1422(defarmlapfunction mpn-lshift-1 ((resptr arg_x) (s1ptr arg_y) (size-arg arg_z))
1423  (uuo-debug-trap (:? al)))
1424
1425;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
1426;;; result (low word first) at RESULT.
1427(defarmlapfunction umulppm ((x arg_x) (y arg_y) (result arg_z))
1428  (uuo-debug-trap (:? al)))
1429
1430
1431; End of arm-bignum.lisp
Note: See TracBrowser for help on using the repository browser.