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

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

arm-asm.lisp, arm-lap.lisp: drain-constant-pool. At least slightly
better than nothing. Check to make sure that :mem12 pc-relative label
references are within 12 bits of their target.

arm-backend: uncomment code to require arm-vinsns

arm-disassemble: hook up to DISASSEMBLE.

arm-vinsns: in REQUIRE-U32, get subtag from the right place.

arm2.lisp: assume that .SPprogvsave sets up an unwind-protect.

arm-bignum.lisp: %ADD-THE-CARRRY is indeed silly.

arm-misc.lisp: unscramble %UNLOCK-GC-LOCK, don't clobber address
in %PTR-STORE-FIXNUM-CONDITIONAL.

arm-utils.lisp: GC.

l1-boot-1.lisp: add ARM to PLATFORM-CPU-NAMES.

l1-boot-2.lisp: require disassembler, lapmacros files on ARM.

l1-boot-3.lisp: comment out error-callback activation on ARM.

l1-init.lisp: set *SAVE-SOURCE-LOCATIONS* to NIL on ARM for now. (More code
to step through/debug, and not short of that.)

version.lisp: don't say "arm-cross" if #+arm-target.

arm-gc.c: get a lot of this working, seemingly.

arm-macros.s: fix skip_stack_vector.

arm-spentry.s: get PROGV support working.

gc-common.c: check static-cons freelist only if GCDebug.

linuxarm/Makefile: enable GC integrity checks.

lisp-debug.c: start to support 'describe exception" for ARM.

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