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

Last change on this file since 14285 was 14285, checked in by gb, 10 years ago

Propagate r14116 from ARM branch to trunk.

File size: 38.9 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 y2 gy1-hi 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 m gy2-hi 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    (add idx len (:$ arm::misc-data-offset))
1018    @loop2
1019    (tst len (:$ arm::fixnumone))
1020    (add len len '1)
1021    (movwne imm1 (:$ arm::one-digit-bignum-header))
1022    (moveq imm1 (:$ #x80000000))
1023    (cmp len oldlen)
1024    (str imm1 (:@ idx res))
1025    (add idx idx '1)
1026    (blt @loop2)
1027    @set-header
1028    (str imm2 (:@ res (:$ arm::misc-header-offset)))
1029    (bx lr)))
1030
1031(defarmlapfunction %count-digit-leading-zeros ((high arg_y) (low arg_z))
1032  (compose-digit imm0 high low)
1033  (clz imm0 imm0)
1034  (box-fixnum arg_z imm0)
1035  (bx lr))
1036
1037(defarmlapfunction %count-digit-trailing-zeros ((high arg_y) (low arg_z))
1038  (compose-digit imm0 high low)
1039  (rsb  imm1 imm0 (:$ 0))
1040  (and imm0 imm0 imm1)
1041  (clz imm0 imm0)
1042  (rsb imm0 imm0 (:$ 31))
1043  (box-fixnum arg_z imm0)
1044  (bx lr))
1045
1046
1047(defarmlapfunction %bignum-count-trailing-zero-bits ((bignum arg_z))
1048  (let ((ndigits arg_x)
1049        (nbits arg_y)
1050        (digit imm0)
1051        (ptr imm1))
1052    (mov ptr (:$ arm::misc-data-offset))
1053    (mov ndigits '-32)
1054    @next
1055    (ldr digit (:@ bignum ptr))
1056    (cmp digit (:$ 0))
1057    (add ptr ptr (:$ 4))
1058    (add ndigits ndigits '32)
1059    (beq @next)
1060    (rsb ptr digit (:$ 0))
1061    (and digit digit ptr)
1062    (clz digit digit)
1063    (rsb digit digit (:$ 31))
1064    (box-fixnum nbits digit)
1065    (add arg_z nbits ndigits)
1066    (bx lr)))
1067
1068
1069(defarmlapfunction %bignum-trim-leading-zeros ((bignum arg_x)
1070                                               (start arg_y)
1071                                               (len arg_z))
1072  (add imm1 start len)
1073  (add imm1 imm1 (:$ (- arm::misc-data-offset 4)))
1074  @loop
1075  (ldr imm0 (:@ bignum imm1))
1076  (cmp imm0 (:$ 0))
1077  (add imm1 imm1 (:$ -4))
1078  (bxne lr)
1079  (subs len len '-1)
1080  (bne @loop)
1081  (bx lr))
1082 
1083;;; Set length of bignum to new-len (zeroing out any trailing words between
1084;;; the old length and the new.
1085(defarmlapfunction %shrink-bignum ((new-len arg_y) (bignum arg_z))
1086  (let ((old-len temp0)
1087        (rzero temp1)
1088        (old-idx imm0)
1089        (new-idx imm2)
1090        (header imm1))
1091    (getvheader header bignum)
1092    (header-length old-len header)
1093    (mov rzero (:$ 0))
1094    (cmp old-len new-len)
1095    (add old-idx old-len (:$ arm::misc-data-offset))
1096    (add new-idx new-len (:$ arm::misc-data-offset))
1097    (bxeq lr)
1098    @loop
1099    (sub old-idx old-idx (:$ 4))
1100    (cmp old-idx new-idx)
1101    (str rzero (:@ bignum old-idx))
1102    (bne @loop)
1103    (mov header (:lsl new-len (:$ (- arm::num-subtag-bits arm::fixnumshift))))
1104    (orr header header (:$ arm::subtag-bignum))
1105    (str header (:@ bignum  (:$ arm::misc-header-offset)))
1106    (bx lr)))
1107
1108;;; Divide bignum x by single digit y (passed as two halves).
1109;;; The quotient in stored in q, and the remainder is returned
1110;;; in two halves.  (cf. Knuth, 4.3.1, exercise 16)
1111(defarmlapfunction %floor-loop-quo ((x 0) (res arg_x) (yhi arg_y) (ylo arg_z))
1112  (let ((bignum temp0)
1113        (len temp2))                    ;not nfn here.
1114    (ldr bignum (:@ vsp (:$ x)))
1115    (add imm1 vsp (:$ arm::node-size))
1116    (build-lisp-frame imm0 imm1)
1117    (vector-length len bignum imm0)
1118    (mov imm2 (:$ 0))
1119    (b @next)
1120    @loop
1121    (add imm0 len (:$ arm::misc-data-offset))
1122    (ldr imm0 (:@ bignum imm0))
1123    (mov imm1 imm2)
1124    (compose-digit imm2 yhi ylo)
1125    (bla .SPudiv64by32)
1126    (add imm1 len (:$ arm::misc-data-offset))
1127    (str imm0 (:@ res imm1))
1128    @next
1129    (subs len len '1)
1130    (bge @loop)
1131    (digit-h yhi imm2)
1132    (digit-l ylo imm2)
1133    (vpush1 yhi)
1134    (vpush1 ylo)
1135    (set-nargs 2)
1136    (ba .SPnvalret)))
1137
1138;;; For TRUNCATE-BY-FIXNUM et al.
1139;;; Doesn't store quotient: just returns rem in 2 halves.
1140(defarmlapfunction %floor-loop-no-quo ((x arg_x) (yhi arg_y) (ylo arg_z))
1141  (let ((len temp1))
1142    (build-lisp-frame)
1143    (vector-length len x imm0)
1144    (mov imm2 (:$ 0))
1145    (b @next)
1146    @loop
1147    (add imm0 len (:$ arm::misc-data-offset))
1148    (ldr imm0 (:@ x imm0))
1149    (mov imm1 imm2)
1150    (compose-digit imm2 yhi ylo)
1151    (bla .SPudiv64by32)
1152    @next
1153    (subs len len '1)
1154    (bge @loop)
1155    (digit-h yhi imm2)
1156    (digit-l ylo imm2)
1157    (vpush1 yhi)
1158    (vpush1 ylo)
1159    (set-nargs 2)
1160    (ba .SPnvalret)))
1161   
1162   
1163
1164   
1165   
1166(defarmlapfunction bignum-negate-loop-really ((big arg_x) (len arg_y) (result arg_z))
1167  (let ((idx imm0)
1168        (x imm1)
1169        (carry imm2))
1170    (mov idx (:$ arm::misc-data-offset))
1171    ;; initialize carry 1
1172    (mov carry (:$ 1))
1173    @loop       
1174    (ldr x (:@ big idx))
1175    (mvn x x)
1176    (adds x x carry)
1177    (str x (:@ result idx))
1178    (movcc carry (:$ 0))
1179    (movcs carry (:$ 1))
1180    (subs len len '1)
1181    (add idx idx '1)
1182    (bgt @loop)
1183    ; return carry
1184    (box-fixnum arg_z carry)
1185    (bx lr)))
1186
1187(defarmlapfunction bignum-shift-left-loop ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (j arg_z))
1188  (let ((y imm0)
1189        (x imm1)
1190        (shift imm2)
1191        (rcontext-save temp1)
1192        (rshift r3)
1193        (i temp0)
1194        (resptr temp2))
1195    (vpop1 resptr)
1196    (mov i (:$ (ash arm::misc-data-offset 2)))
1197    (vpop1 shift)
1198    (mov rcontext-save rcontext)
1199    (ldr x (:@ bignum (:$ arm::misc-data-offset)))
1200    (unbox-fixnum shift shift)
1201    (rsb rshift shift (:$ 32))
1202    (mov x (:lsl x shift))
1203    (add y j (:$ (+ arm::misc-data-offset -4)))
1204    (str x (:@ resptr y))
1205    (cmp len j)
1206    (beq @done)
1207    @loop
1208    (ldr x (:@ bignum (:asr i (:$ 2))))
1209    (mov x (:lsr x rshift))
1210    (add i i '4)                        ;sic
1211    (ldr y (:@ bignum (:asr i (:$ 2))))
1212    (orr y x (:lsl y shift))
1213    (add x j (:$ arm::misc-data-offset))
1214    (str y (:@ resptr x))
1215    (add j j '1)   
1216    (cmp j len)
1217    (blt @loop)   
1218    @done
1219    (ldr y (:@ bignum (:asr i (:$ 2))))
1220    (mov y (:asr y rshift))
1221    (add x len (:$ arm::misc-data-offset))
1222    (str y (:@ resptr x))
1223    (mov rcontext rcontext-save)
1224    (bx lr)))
1225
1226(defarmlapfunction bignum-shift-right-loop-1 ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (iidx arg_z))
1227  (let ((y imm0)
1228        (x imm1)
1229        (shift imm2)
1230        (idx imm2)
1231        (jidx temp0)
1232        (resptr temp1)
1233        (boxed-shift temp2))
1234    (vpop1 resptr)
1235    (vpop1 boxed-shift)
1236    (mov jidx '0)
1237    (cmp jidx len)
1238    (bge @done)
1239    @loop
1240    (add idx iidx (:$ arm::misc-data-offset))
1241    (ldr x (:@ bignum idx))
1242    (unbox-fixnum shift boxed-shift)
1243    (mov x (:lsr x shift))
1244    (add idx iidx (:$ (+ arm::misc-data-offset 4)))
1245    (ldr y (:@ bignum idx))
1246    (unbox-fixnum shift boxed-shift)
1247    (rsb shift shift (:$ 32))
1248    (mov y (:lsl y shift))
1249    (orr x x y)
1250    (add idx jidx (:$ arm::misc-data-offset))
1251    (str x (:@ resptr idx))
1252    (add jidx jidx '1)
1253    (cmp jidx len)
1254    (add iidx iidx '1)
1255    (blt @loop)
1256    @done
1257    (add idx iidx (:$ arm::misc-data-offset))
1258    (ldr x (:@ bignum idx))
1259    (unbox-fixnum shift boxed-shift)
1260    (mov x (:asr x shift))
1261    (add idx jidx (:$ arm::misc-data-offset))
1262    (str x (:@ resptr idx))
1263    (bx lr)))
1264
1265;;; If x[i] = y[j], return the all ones digit (as two halves).
1266;;; Otherwise, compute floor x[i]x[i-1] / y[j].
1267(defarmlapfunction %floor-99 ((x-stk 0) (xidx arg_x) (yptr arg_y) (yidx arg_z))
1268  (add imm1 vsp (:$ 4))
1269  (build-lisp-frame imm0 imm1)
1270  (mov fn nfn)
1271  (ldr temp0 (:@ vsp (:$ x-stk)))
1272  (add imm0 xidx (:$ arm::misc-data-offset))
1273  (add imm1 yidx (:$ arm::misc-data-offset))
1274  (ldr imm0 (:@ temp0 imm0))
1275  (ldr imm2 (:@ yptr imm1))
1276  (cmp imm0 imm2)
1277  (bne @more)
1278  (mov imm0 (:$ (ash #xff arm::fixnumshift)))
1279  (orr imm0 imm0 (:$ (ash #xff00 arm::fixnumshift)))
1280  (vpush1 imm0)
1281  (vpush1 imm0)
1282  (set-nargs 2)
1283  (bx temp1)
1284  @more
1285  (add imm1 xidx (:$ (- arm::misc-data-offset arm::node-size)))
1286  (ldr imm0 (:@ temp0 imm1))
1287  (add imm1 imm1 (:$ arm::node-size))
1288  (ldr imm1 (:@ temp0 imm1))
1289  (bla .SPudiv64by32)
1290  (mov arg_y '-1)
1291  (and arg_y arg_y (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
1292  (mov imm0 (:lsl imm0 (:$ 16)))
1293  (mov arg_z '-1)
1294  (and arg_z arg_z (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
1295  (stmdb (:! vsp) (arg_z arg_y))
1296  (set-nargs 2)
1297  (ba .SPnvalret))
1298
1299;;; Karatsuba multiplication stuff. NYI.
1300;;; Copy the limb SRC points to to where DEST points.
1301(defarmlapfunction copy-limb ((src arg_y) (dest arg_z))
1302  (uuo-debug-trap (:? al)))
1303
1304;;; Return T iff LIMB contains 0.
1305(defarmlapfunction limb-zerop ((limb arg_z))
1306  (uuo-debug-trap (:? al)))
1307
1308;;; Return -1,0,1 according to whether the contents of Y are
1309;;; <,=,> the contents of Z.
1310(defarmlapfunction compare-limbs ((y arg_y) (z arg_z))
1311  (uuo-debug-trap (:? al)))
1312
1313;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
1314(defarmlapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1315  (uuo-debug-trap (:? al)))
1316
1317;;; Store a fixnum value where LIMB points.
1318(defarmlapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1319  (uuo-debug-trap (:? al)))
1320
1321;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
1322;;; knows that carries will only propagate for a word or two.
1323(defarmlapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
1324  (uuo-debug-trap (:? al)))
1325
1326;;; Store XP-YP at WP; return carry (0 or 1).
1327;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
1328;;; size: boxed fixnum
1329;;; returns boxed carry
1330(defarmlapfunction mpn-sub-n ((wp 8) (xp arg_x) (yp arg_y) (size arg_z))
1331  (uuo-debug-trap (:? al)))
1332
1333;;; Store XP+YP at WP; return carry (0 or 1).
1334;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
1335;;; size = boxed fixnum
1336;;; result = boxed carry
1337(defarmlapfunction mpn-add-n ((wp 0) (xp arg_x)
1338                                (yp arg_y) (size arg_z))
1339  (uuo-debug-trap (:? al)))
1340
1341;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
1342;;; result at RP.  RP and S1P may be the same place, so check for
1343;;; that and do nothing after carry stops propagating.  Return carry.
1344(defarmlapfunction mpn-add-1 ((rp-offset 0) (s1p arg_x) 
1345                                (size arg_y) (limb arg_z))
1346  (uuo-debug-trap (:? al)))
1347
1348;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
1349;;; the result at RES.  Store the "carry out" (high word of last 64-bit
1350;;; partial product) at the limb RESULT.
1351;;; res, s1, limbptr, result:
1352;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
1353;;; It'd be hard to transliterate the GMP code here; the GMP version
1354;;; uses lots more immediate registers than we can easily use in LAP
1355;;; (and is much more aggressively pipelined).
1356(defarmlapfunction mpn-mul-1 ((res-offset 4)
1357                                (s1-offset 0)
1358                                (size arg_x)
1359                                (limbptr arg_y)
1360                                (result arg_z))
1361  (uuo-debug-trap (:? al)))
1362
1363;;; multiply s1*limb and add result to res
1364;;; res, s1, limbptr, result:
1365;;;   unboxed, word-aligned ptrs (fixnums).
1366;;; size: boxed fixnum
1367;;; limbptr: source "limb".
1368;;; result: carry out (high word of product).
1369(defarmlapfunction mpn-addmul-1 ((res-offset 4)
1370                                   (s1-offset 0)
1371                                   (size arg_x)
1372                                   (limbptr arg_y)
1373                                   (result arg_z))
1374  (uuo-debug-trap (:? al)))
1375
1376;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
1377;;; at VP, store the result at RP.
1378(defarmlapfunction mpn-mul-basecase ((rp-offset 4)
1379                                       (up-offset 0)
1380                                       (un arg_x)
1381                                       (vp arg_y)
1382                                       (vn arg_z))
1383  (uuo-debug-trap (:? al)))
1384
1385;;; left-shift src by 1 bit, storing result at res.  Return
1386;;; the bit that was shifted out.
1387(defarmlapfunction mpn-lshift-1 ((resptr arg_x) (s1ptr arg_y) (size-arg arg_z))
1388  (uuo-debug-trap (:? al)))
1389
1390;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
1391;;; result (low word first) at RESULT.
1392(defarmlapfunction umulppm ((x arg_x) (y arg_y) (result arg_z))
1393  (uuo-debug-trap (:? al)))
1394
1395
1396; End of arm-bignum.lisp
Note: See TracBrowser for help on using the repository browser.