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

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

commit correct file to fix ticket:1041

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