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

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

Fix fixnum-return case in %NORMALIZE-BIGNUM-2.

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