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

Last change on this file since 14104 was 14104, checked in by gb, 11 years ago

Don't use "ba" pseudo-instruction.

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