source: branches/arm/level-0/ARM/arm-bignum.lisp @ 14089

Last change on this file since 14089 was 14089, checked in by gb, 9 years ago

%MULTIPLY-AND-ADD-HARDER-LOOP: need to preserve X, which is kind of
the idea here.

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