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

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

BIGNUM-SHIFT-LEFT-LOOP: keep fixing bugs ...

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