source: trunk/ccl/level-0/PPC/PPC32/ppc32-bignum.lisp @ 5842

Last change on this file since 5842 was 5842, checked in by gb, 13 years ago

BIGNUM-NEGATE-TO-PTR.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 47.2 KB
Line 
1;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17
18(in-package "CCL")
19
20(eval-when (:compile-toplevel :execute)
21  (require "PPC32-ARCH")
22  (require "PPC-LAPMACROS")
23
24    ;; Set RES to 1 if (u< x y), to 0 otherwise.
25  (defppclapmacro sltu (res x y)
26    `(progn
27      (subfc ,res ,x ,y)
28      (subfe ,res ,res ,res)
29      (neg ,res ,res)))
30
31    (defppclapmacro 48x32-divide (x-hi16 x-lo y freg temp-freg freg2 immx)
32    `(let ((temp 16)
33           (temp.h 16)
34           (temp.l 20)
35           (zero 8)
36           (zero.h 8)
37           (zero.l 12))
38      (stwu tsp -24 tsp)
39      (stw tsp 4 tsp)
40      (lwi ,immx #x43300000)  ; 1075 = 1022+53
41      (stw ,immx zero.h tsp)
42      (stw rzero zero.l tsp)
43      (lfd ,temp-freg zero tsp)
44      (rlwimi ,immx ,x-hi16 0 16 31)           
45      (stw ,immx temp.h tsp)
46      (stw ,x-lo temp.l tsp)
47      (lfd ,freg temp tsp)
48     
49      (fsub ,freg ,freg ,temp-freg)
50      (lwi ,immx #x43300000)
51      (stw ,immx temp.h tsp)
52      (stw ,y temp.l tsp)
53      (lfd ,freg2 temp tsp)
54      (lwz tsp 0 tsp)
55      (fsub ,freg2 ,freg2 ,temp-freg)
56      (fdiv ,freg ,freg ,freg2)
57      ))
58   
59  )
60
61;;; %BIGNUM-REF needs to access bignums as obviously as possible, and it needs
62;;; to be able to return 32 bits somewhere no one looks for real objects.
63;;;
64;;; The easiest thing to do is to store the 32 raw bits in two fixnums
65;;; and return multiple values.
66(defppclapfunction %bignum-ref ((bignum arg_y) (i arg_z))
67  (vref32 imm0 bignum i imm1)
68  (digit-h temp0 imm0)
69  (digit-l temp1 imm0)
70  (vpush temp0)
71  (vpush temp1)
72  (la temp0 8 vsp)                      ; ?? why not (mr temp0 vsp) before vpushing?
73  (set-nargs 2)                         ; that doesn't make any difference.  And, in this case,
74                                        ; we can get away without setting nargs (since the caller
75                                        ; called us with 2 args, but that's horrible style.)
76  (ba .SPvalues))
77
78
79;;; Set the 0th element of DEST (a bignum or some other 32-bit ivector)
80;;; to the Ith element of the bignum SRC.
81(defppclapfunction %ref-digit ((bignum arg_x) (i arg_y) (dest arg_z))
82  (la imm1 ppc32::misc-data-offset i)
83  (lwzx imm0 bignum imm1)
84  (stw imm0 ppc32::misc-data-offset dest)
85  (blr))
86
87;;; BIGNUM[I] := DIGIT[0]
88(defppclapfunction %set-digit ((bignum arg_x) (i arg_y) (digit arg_z))
89  (la imm1 ppc32::misc-data-offset i)
90  (lwz imm0 ppc32::misc-data-offset digit)
91  (stwx imm0 bignum imm1)
92  (blr))
93
94;;; Return 0 if the 0th digit in X is 0.
95(defppclapfunction %digit-zerop ((x arg_z))
96  (lwz imm0 ppc32::misc-data-offset x)
97  (cntlzw imm0 imm0)
98  (srwi imm0 imm0 5)
99  (rlwimi imm0 imm0 4 27 27)
100  (addi arg_z imm0 ppc32::nil-value)
101  (blr))
102
103;;; store the sign of bignum (0 or -1) in the one-word bignum "digit".
104(defppclapfunction %bignum-sign-digit ((bignum arg_y) (digit arg_z))
105  (vector-length imm0 bignum imm0)
106  (la imm0 (- ppc32::misc-data-offset 4) imm0) ; Reference last (most significant) digit
107  (lwzx imm0 bignum imm0)
108  (srawi imm0 imm0 31)                  ;propagate sign bit
109  (stw imm0 ppc32::misc-data-offset digit)
110  (blr))
111
112;;; Return the sign of bignum (0 or -1) as a fixnum
113(defppclapfunction %bignum-sign ((bignum arg_z))
114  (vector-length imm0 bignum imm0)
115  (la imm0 (- ppc32::misc-data-offset 4) imm0) ; Reference last (most significant) digit
116  (lwzx imm0 bignum imm0)
117  (srawi imm0 imm0 31)                  ;propagate sign bit
118  (box-fixnum arg_z imm0)
119  (blr))
120
121;;; Count the sign bits in the most significant digit of bignum;
122;;; return fixnum count.
123(defppclapfunction %bignum-sign-bits ((bignum arg_z))
124  (vector-length imm0 bignum imm0)
125  (la imm0 (- ppc32::misc-data-offset 4) imm0) ; Reference last (most significant) digit
126  (lwzx imm0 bignum imm0)
127  (cmpwi imm0 0)
128  (not imm0 imm0)
129  (blt @wasneg)
130  (not imm0 imm0)
131  @wasneg
132  (cntlzw imm0 imm0)
133  (box-fixnum arg_z imm0)
134  (blr))
135
136(defppclapfunction %digit-0-or-plusp ((bignum arg_y) (idx arg_z))
137  (la imm0 ppc32::misc-data-offset idx)
138  (lwzx imm0 bignum imm0)
139  (xoris imm0 imm0 #x8000)              ; invert sign bit
140  (srwi imm0 imm0 31)
141  (bit0->boolean arg_z imm0 imm0)       ; return T if sign bit was clear before inversion
142  (blr))
143
144;;; For oddp, evenp
145(defppclapfunction %bignum-oddp ((bignum arg_z))
146  (lwz imm0 ppc32::misc-data-offset bignum)
147  (clrlwi imm0 imm0 31)
148  (bit0->boolean arg_z imm0 imm0)
149  (blr))
150 
151(defppclapfunction bignum-plusp ((bignum arg_z))
152  (vector-length imm0 bignum imm0)
153  (la imm0 (- ppc32::misc-data-offset 4) imm0) ; Reference last (most significant) digit
154  (lwzx imm0 bignum imm0)
155  (xoris imm0 imm0 #x8000)              ; invert sign bit
156  (srwi imm0 imm0 31)
157  (bit0->boolean arg_z imm0 imm0)       ; return T if sign bit was clear before inversion
158  (blr))
159
160(defppclapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
161  (unbox-fixnum imm0 fixnum)
162  (stw imm0 ppc32::misc-data-offset bignum)
163  (blr))
164
165(defppclapfunction bignum-minusp ((bignum arg_z))
166  (vector-length imm0 bignum imm0)
167  (la imm0 (- ppc32::misc-data-offset 4) imm0) ; Reference last (most significant) digit
168  (lwzx imm0 bignum imm0)
169  (srwi imm0 imm0 31)
170  (rlwimi imm0 imm0 4 27 27)
171  (addi arg_z imm0 ppc32::nil-value)    ; return T if sign bit was clear before inversion
172  (blr))
173
174
175;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum).
176;;; Store the result in R[K], and return the outgoing carry.
177;;; If I is NIL, A is a fixnum.  If J is NIL, B is a fixnum.
178
179(defppclapfunction %add-with-carry ((r 12) (k 8) (c 4) (a 0) (i arg_x) (b arg_y) (j arg_z))
180  (cmpwi cr1 j ppc32::nil-value)
181  (cmpwi cr0 i ppc32::nil-value)
182  (lwz temp0 a vsp)
183  (unbox-fixnum imm1 temp0)
184  (unbox-fixnum imm2 b)
185  (beq cr0 @got-a)
186  (la imm1 ppc32::misc-data-offset i)
187  (lwzx imm1 temp0 imm1)
188  @got-a
189  (beq cr1 @got-b)
190  (la imm2 ppc32::misc-data-offset j)
191  (lwzx imm2 b imm2)
192  @got-b
193  (lwz temp0 c vsp)
194  (unbox-fixnum imm0 temp0)
195  (addic imm0 imm0 -1)
196  (lwz temp1 r vsp)
197  (lwz temp0 k vsp)
198  (la vsp 16 vsp) 
199  (adde imm0 imm1 imm2)
200  (la imm2 ppc32::misc-data-offset temp0)
201  (stwx imm0 temp1 imm2)
202  (addze imm0 rzero)
203  (box-fixnum arg_z imm0)
204  (blr))
205
206
207
208
209   
210;;; Store the result of A[I] - B[J] - borrow into R[K], returning the borrow.
211;;; If I is NIL, A is a fixnum; likewise for J and B.
212(defppclapfunction %subtract-with-borrow ((r 12) (k 8) (borrow 4) (a 0) (i arg_x) (b arg_y) (j arg_z))
213  (cmpwi cr0 i ppc32::nil-value)
214  (cmpwi cr1 j ppc32::nil-value)
215  (lwz temp0 a vsp)
216  (unbox-fixnum imm2 b)
217  (unbox-fixnum imm1 temp0)
218  (beq cr1 @got-b)
219  (la imm2 ppc32::misc-data-offset j)
220  (lwzx imm2 b imm2)
221  @got-b
222  (beq cr0 @got-a)
223  (la imm1 ppc32::misc-data-offset i)
224  (lwzx imm1 temp0 imm1)
225  @got-a
226  (lwz temp0 borrow vsp)
227  (unbox-fixnum imm0 temp0)
228  (addic imm0 imm0 -1)
229  (lwz temp0 r vsp)
230  (lwz temp1 k vsp)
231  (la vsp 16 vsp) 
232  (subfe imm0 imm2 imm1)
233  (la imm1 ppc32::misc-data-offset temp1)
234  (stwx imm0 temp0 imm1)
235  (addze imm0 rzero)
236  (box-fixnum arg_z imm0)
237  (blr))
238
239;; multiply i'th digit of x by y and add to result starting at digit i
240(defppclapfunction %multiply-and-add-harder-loop-2
241    ((x-ptr 4) (y-ptr 0) (resptr arg_x)(residx arg_y) (count arg_z)) 
242  (let ((tem imm0)
243        (y imm1)
244        (prod-h imm2)
245        (prod-l imm3)
246        (x imm4)
247        (xptr temp2)
248        (yidx temp1)
249        (yptr temp0))
250    (lwz xptr x-ptr vsp)
251    (la tem ppc32::misc-data-offset residx)
252    (lwzx x xptr tem)
253    (lwz yptr y-ptr vsp)
254    (li yidx 0) ; init yidx 0
255    (addc prod-h rzero rzero) ; init carry 0, mumble 0
256    @loop
257    (subi count count '1)
258    (cmpwi count 0)
259    (la tem ppc32::misc-data-offset yidx)   ; get yidx
260    (lwzx y yptr tem) 
261    (mullw prod-l x y)
262    (addc prod-l prod-l prod-h)
263    (mulhwu prod-h x y)
264    (addze prod-h prod-h)
265    (la tem ppc32::misc-data-offset residx)
266    (lwzx y resptr tem)   
267    (addc prod-l prod-l y)
268    (addze prod-h prod-h)
269    (stwx prod-l resptr tem)   
270    (addi residx residx '1)
271    (addi yidx yidx '1)
272    (bgt @loop)
273    (la tem ppc32::misc-data-offset residx)
274    (stwx prod-h resptr tem)
275    (la vsp 8 vsp)     
276    (blr)))
277
278
279
280;;; Multiply X[I] by the unboxed value of the (non-negative) fixnum Y;
281;;; add the incoming carry from CARRY[0] to the 64-bit product.  Store
282;;; the low word of the 64-bit sum in R[0] and the high word in
283;;; CARRY[0].
284
285(defppclapfunction %multiply-and-add ((r 4) (carry 0) (x arg_y) (i arg_x) (y arg_z))
286  (unbox-fixnum imm0 arg_z)
287  (la imm1 ppc32::misc-data-offset i)
288  (lwzx imm1 x imm1)
289  (mulhwu imm2 imm0 imm1)
290  (mullw imm1 imm0 imm1)
291  (lwz temp0 carry vsp)
292  (lwz imm0 ppc32::misc-data-offset temp0)
293  (addc imm1 imm1 imm0)
294  (addze imm2 imm2)
295  (stw imm2 ppc32::misc-data-offset temp0)
296  (lwz arg_z r vsp)
297  (la vsp 8 vsp)   
298  (stw imm1 ppc32::misc-data-offset arg_z)
299  (blr))
300 
301(defppclapfunction %floor ((q 4) (r 0) (num-high arg_x) (num-low arg_y) (denom-arg arg_z))
302  (let ((rem imm0)
303        (rem-low imm1)
304        (quo imm2)
305        (temp imm3)
306        (denom imm4))
307    (lwz denom ppc32::misc-data-offset denom)
308    (lwz rem ppc32::misc-data-offset num-high)
309    (lwz rem-low ppc32::misc-data-offset num-low)
310    (mr temp denom)
311    (sltu quo rem denom)
312    (subi temp temp quo)
313    (and temp temp denom)
314    (sub rem temp rem)
315    (li temp0 '32)
316    @loop
317    (subi temp0 temp0 '1)
318    (cmpwi temp0 0)
319    (slwi rem rem 1)
320    (srwi temp rem-low 31)
321    (or rem rem temp)
322    (slwi rem-low rem-low 1)
323    (sltu rem rem denom)
324    (slwi quo quo 1)
325    (or quo quo temp)
326    (subi temp temp 1)
327    (and temp temp denom)
328    (sub rem rem temp)
329    (bne @loop)
330    (not quo quo)
331    (lwz temp0 q vsp)
332    (stw quo ppc32::misc-data-offset temp0)
333    (lwz arg_z r vsp)
334    (la vsp 8 vsp) 
335    (stw rem ppc32::misc-data-offset arg_z)
336    (blr)))
337
338(defppclapfunction %bignum-ref-hi ((bignum arg_y) (i arg_z))
339  (la imm1 ppc32::misc-data-offset i)
340  (lhzx imm0 bignum imm1)
341  (box-fixnum arg_z imm0)
342  (blr))
343
344
345(defppclapfunction %bignum-set ((bignum 0) (i arg_x) (high arg_y) (low arg_z))
346  (compose-digit imm0 high low)
347  (lwz arg_z bignum vsp)
348  (vset32 imm0 arg_z i imm1)
349  (la vsp 4 vsp)
350  (blr))
351
352
353
354
355; this is silly
356(defppclapfunction %add-the-carry ((b-h arg_x) (b-l arg_y) (carry-in arg_z))
357  (let ((a imm0)
358        (b imm1)
359        (temp imm2)
360        (c imm3))   
361    (compose-digit b b-h b-l)
362    (unbox-fixnum c carry-in)
363    (add b c b)
364    (digit-h temp0 b)
365    (digit-l temp1 b)
366    (vpush temp0)
367    (vpush temp1)
368    (la temp0 8 vsp)
369    (set-nargs 2)
370    (ba .SPvalues)))
371
372
373
374
375;;; %SUBTRACT-WITH-BORROW -- Internal.
376;;;
377;;; This should be in assembler, and should not cons intermediate results.  It
378;;; returns a 32bit digit and a borrow resulting from subtracting b from a, and
379;;; subtracting a possible incoming borrow.
380;;;
381;;; We really do:  a - b - 1 + borrow, where borrow is either 0 or 1.
382;;;
383
384(defppclapfunction %subtract-with-borrow-1 ((a-h 4) (a-l 0) (b-h arg_x) (b-l
385arg_y) (borrow-in arg_z))
386  (let ((a imm0)
387        (b imm1)
388        (temp imm2)
389        (c imm3))
390    (lwz temp0 a-h vsp)
391    (lwz temp1 a-l vsp)
392    (compose-digit a temp0 temp1)
393    (compose-digit b b-h b-l)
394    (unbox-fixnum c borrow-in)
395    (li temp -1)
396    (addc temp c temp)
397    (subfe a b a)
398    (addze c rzero)
399    (box-fixnum c c)
400    (digit-h temp0 a)
401    (digit-l temp1 a)
402    (vpush temp0)
403    (vpush temp1)
404    (vpush c)
405    (la temp0 20 vsp)
406    (set-nargs 3)
407    (ba .SPvalues)))
408
409
410
411(defppclapfunction %subtract-one ((a-h arg_y)(a-l arg_z))
412  (let ((a imm0))
413    (compose-digit a a-h a-l)
414    (subi a a 1)
415    (digit-h temp0 a)
416    (vpush temp0)
417    (digit-l temp0 a)
418    (vpush temp0)
419    (la temp0 8 vsp)
420    (set-nargs 2)
421    (ba .spvalues)))
422
423
424
425
426;;; %MULTIPLY-AND-ADD  --  Internal.
427;;;
428;;; This multiplies x-digit and y-digit, producing high and low digits
429;;; manifesting the result.  Then it adds the low digit, res-digit, and
430;;; carry-in-digit.  Any carries (note, you still have to add two digits at a
431;;; time possibly producing two carries) from adding these three digits get
432;;; added to the high digit from the multiply, producing the next carry digit.
433;;; Res-digit is optional since two uses of this primitive multiplies a single
434;;; digit bignum by a multiple digit bignum, and in this situation there is no
435;;; need for a result buffer accumulating partial results which is where the
436;;; res-digit comes from.
437;;; [slh] I assume that the returned carry "digit" can only be 0, 1 or 2
438
439
440(defppclapfunction %multiply-and-add-1 ((x-high 8)
441                                        (x-low 4)
442                                        (y-high 0)
443                                        (y-low arg_x)
444                                        (carry-in-high arg_y)
445                                        (carry-in-low arg_z))
446  (let ((x imm0)
447        (y imm1)
448        (carry-in imm2)
449        (lo imm3)
450        (hi imm4))
451    (compose-digit carry-in carry-in-high carry-in-low)
452    (vpop temp0)
453    (compose-digit y temp0 y-low)
454    (vpop temp0)
455    (vpop temp1)
456    (compose-digit x temp1 temp0)
457    (mullw lo x y)
458    (mulhwu hi x y)
459    (addc lo lo carry-in)
460    (addze hi hi)
461    (digit-h temp0 hi)
462    (digit-l temp1 hi)
463    (digit-h temp2 lo)
464    (digit-l temp3 lo)
465    (vpush temp0)
466    (vpush temp1)
467    (vpush temp2)
468    (vpush temp3)
469    (set-nargs 4)
470    (la temp0 16 vsp)
471    (ba .SPvalues)))
472
473
474(defppclapfunction %logcount-complement ((bignum arg_y) (idx arg_z))
475  (let ((arg imm0)
476        (shift imm1)
477        (temp imm2))
478    (la arg ppc32::misc-data-offset idx)
479    (lwzx arg bignum arg)
480    (not. shift arg)
481    (li arg_z 0)
482    (if ne
483      (progn
484        @loop
485        (la temp -1 shift)
486        (and. shift shift temp)
487        (la arg_z '1 arg_z)
488        (bne @loop)))
489    (blr)))
490
491(defppclapfunction %logcount ((bignum arg_y) (idx arg_z))
492  (let ((arg imm0)
493        (shift imm1)
494        (temp imm2))
495    (la arg ppc32::misc-data-offset idx)
496    (lwzx arg bignum arg)
497    (mr. shift arg)
498    (li arg_z 0)
499    (if ne
500      (progn
501        @loop
502        (la temp -1 shift)
503        (and. shift shift temp)
504        (la arg_z '1 arg_z)
505        (bne @loop)))
506    (blr)))
507
508; return res
509(defppclapfunction bignum-add-loop-2 ((aptr arg_x)(bptr arg_y) (result arg_z))
510  (let ((idx imm0)
511        (count imm1)
512        (x imm2)
513        (y imm3)       
514        (len-a temp0)
515        (len-b temp1)
516        (tem temp2))
517    (li idx ppc32::misc-data-offset)   
518    (lwz imm4 ppc32::misc-header-offset aptr)
519    (header-length len-a imm4)
520    (lwz imm4 ppc32::misc-header-offset bptr)
521    (header-length len-b imm4)
522    ; make a be shorter one
523    (cmpw len-a len-b)
524    (li count 0)
525    ; initialize carry 0
526    (addc x rzero rzero)
527    (ble @loop)
528    ; b shorter - swap em
529    (mr tem len-a)
530    (mr len-a len-b)
531    (mr len-b tem)
532    (mr tem aptr)
533    (mr aptr bptr)
534    (mr bptr tem)   
535    @loop
536    (lwzx y aptr idx)
537    (lwzx x bptr idx)   
538    (addi count count '1)
539    (cmpw count len-a)
540    (adde x x y)
541    (stwx x result idx)
542    (addi idx idx '1)
543    (blt @loop)
544    ; now propagate carry thru longer (b) using sign of shorter   
545    ;(SUBI imm4 idx '1) ; y has hi order word of a
546    ;(lwzx y aptr imm4)
547    (cmpw len-a len-b)
548    (adde imm4 rzero rzero) ; get carry
549    (srawi y y 31)  ; p.o.s clobbers carry
550    (addic imm4 imm4 -1)  ; restore carry
551    (beq @l3)  ; unless equal
552    @loop2
553    (lwzx x bptr idx)
554    (adde x x y)
555    (stwx x result idx)
556    (addi count count '1)
557    (cmpw count len-b)
558    (addi idx idx '1)
559    (blt @loop2)
560    ; y has sign of shorter - get sign of longer to x
561    @l3
562    (subi imm4 idx '1)
563    (lwzx x bptr imm4)
564    (adde imm4 rzero rzero) ; get carry
565    (srawi x x 31)  ; clobbers carry
566    (addic imm4 imm4 -1)
567    (adde x x y)
568    (stwx x result idx)
569    (blr)))
570
571;; same as above but with initial a index and finishes
572(defppclapfunction bignum-add-loop-+ ((init-a 0)(aptr arg_x)(bptr arg_y)(length arg_z))
573  (let ((idx imm0)       
574        (count imm1)
575        (x imm2)
576        (y imm3)
577        (aidx imm4))
578    (li idx ppc32::misc-data-offset)
579    (lwz aidx init-a vsp)
580    (addi aidx aidx ppc32::misc-data-offset)
581    (li count 0)
582    ; initialize carry 0
583    (addc x rzero rzero)
584    @loop
585    (lwzx x aptr aidx)
586    (lwzx y bptr idx)
587    (adde x x y)
588    (stwx x aptr aidx)
589    (addi count count '1)
590    (cmpw count length)
591    (addi idx idx '1)
592    (addi aidx aidx '1)
593    (blt @loop)
594    (lwzx x aptr aidx)  ; add carry into next one
595    (adde x x  rzero)
596    (stwx x aptr aidx)
597    (la vsp 4 vsp)
598    (blr)))
599
600
601
602(defppclapfunction bignum-negate-loop-really ((big arg_x) (len arg_y) (result arg_z))
603  (let ((idx imm0)
604        (one imm1)
605        (x imm2))
606    (li idx ppc32::misc-data-offset)
607    (li one '1)
608    ; initialize carry 1
609    (li x -1)
610    (addic x x 1)
611    @loop       
612    ;(addi count count '1)   
613    ;(cmpw count len)
614    (subf. len one len)
615    (lwzx x big idx)
616    (not x x)
617    (adde x x rzero)
618    (stwx x result idx)   
619    (addi idx idx '1)
620    (bgt @loop)
621    ; return carry
622    (li x 0)
623    (adde x x  rzero)
624    (box-fixnum arg_z x)
625    (blr)))
626
627(defppclapfunction bignum-negate-to-pointer ((big arg_x) (len arg_y) (result arg_z))
628  (let ((idx imm0)
629        (one imm1)
630        (x imm2)
631        (oidx imm3)
632        (ptr imm4))
633    (li idx ppc32::misc-data-offset)
634    (li oidx 0)
635    (macptr-ptr ptr result)
636    (li one '1)
637    ; initialize carry 1
638    (li x -1)
639    (addic x x 1)
640    @loop       
641    ;(addi count count '1)   
642    ;(cmpw count len)
643    (subf. len one len)
644    (lwzx x big idx)
645    (not x x)
646    (adde x x rzero)
647    (stwx x ptr oidx)   
648    (addi idx idx '1)
649    (addi oidx oidx 4)
650    (bgt @loop)
651    ; return carry
652    (li x 0)
653    (adde x x  rzero)
654    (box-fixnum arg_z x)
655    (blr)))
656
657;; she do tolerate len = jidx
658(defppclapfunction bignum-shift-left-loop ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (jidx arg_z))
659  (let ((y imm0)
660        (idx imm1)
661        (bits imm2)
662        (rbits imm3)
663        (x imm4)
664        (iidx temp0)
665        (resptr temp1))
666    (li iidx 0)
667    (lwz bits nbits vsp)
668    (lwz resptr result vsp)
669    (unbox-fixnum bits bits)
670    (subfic rbits bits 32)   
671    ;(dbg)
672    (lwz imm4 ppc32::misc-data-offset bignum)
673    (slw imm4 imm4 bits)
674    (la y (+ ppc32::misc-data-offset -4) jidx) 
675    (stwx imm4 y resptr) 
676     
677    (cmpw len jidx)
678    (beq @done)
679    @loop
680    (addi idx iidx ppc32::misc-data-offset)
681    (lwzx x bignum idx)
682    (srw x x rbits)
683    (addi idx idx '1)
684    (lwzx y bignum idx)
685    (slw y y bits)
686    (or x x y)
687    (addi idx jidx ppc32::misc-data-offset)
688    (stwx x resptr idx)
689    (addi jidx jidx '1)   
690    (cmpw jidx len)
691    (addi iidx iidx '1)
692    (blt @loop)   
693    @done
694    ; do first - lo order
695       
696    ; do last - hi order   
697    (addi idx iidx ppc32::misc-data-offset)
698    ;(dbg t)
699    (lwzx y bignum idx)
700    (sraw y y rbits)
701    (addi idx len ppc32::misc-data-offset)
702    (stwx y resptr idx)
703    (la vsp 8 vsp)
704    (blr)))
705
706
707
708(defppclapfunction bignum-shift-right-loop-1 ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (iidx arg_z))
709  (let ((y imm0)
710        (idx imm1)
711        (bits imm2)
712        (rbits imm3)
713        (x imm4)
714        (jidx temp0)
715        (resptr temp1))
716    (li jidx 0)
717    (lwz bits nbits vsp)
718    (lwz resptr result vsp)
719    (unbox-fixnum bits bits)
720    (cmpw jidx len)
721    (subfic rbits bits 32)   
722    (bge @done)
723    @loop
724    (addi idx iidx ppc32::misc-data-offset)
725    (lwzx x bignum idx)
726    (srw x x bits)
727    (addi idx idx '1)
728    (lwzx y bignum idx)
729    (slw y y rbits)
730    (or x x y)
731    (addi idx jidx ppc32::misc-data-offset)
732    (stwx x resptr idx)
733    (addi jidx jidx '1)   
734    (cmpw jidx len)
735    (addi iidx iidx '1)
736    (blt @loop)
737    @done
738    (addi idx iidx ppc32::misc-data-offset)
739    (lwzx x bignum idx)
740    (sraw x x bits)
741    (addi idx jidx ppc32::misc-data-offset)
742    (stwx x resptr idx)
743    (la vsp 8 vsp)
744    (blr)))
745
746
747(defppclapfunction %compare-digits ((a arg_x) (b arg_y) (idx arg_z))
748  (la imm0 ppc32::misc-data-offset idx)
749  (lwzx imm1 a imm0)
750  (lwzx imm0 b imm0)
751  (cmplw imm1 imm0)
752  (li arg_z '0)
753  (beqlr)
754  (li arg_z '1)
755  (bgtlr)
756  (li arg_z '-1)
757  (blr))
758
759
760 
761;; returns number of bits in digit-hi,digit-lo that are sign bits
762;; 32 - digits-sign-bits is integer-length
763
764(defppclapfunction %digits-sign-bits ((hi arg_y) (lo arg_z))
765  (rlwinm. imm1 hi (- 16 ppc32::fixnumshift) 0 15)
766  (rlwimi imm1 lo (- 32 ppc32::fixnumshift) 16 31)
767  (not imm1 imm1)
768  (blt @wasneg)
769  (not imm1 imm1)
770  @wasneg
771  (cntlzw imm1 imm1)
772  (box-fixnum arg_z imm1)
773  (blr))
774
775(defppclapfunction bignum-logtest-loop ((count arg_x) (s1 arg_y) (s2 arg_z)) 
776  (addi imm1 rzero ppc32::misc-data-offset)
777  @loop
778  (lwzx imm2 s1 imm1)
779  (lwzx imm3 s2 imm1)
780  (and. imm2 imm3 imm2) 
781  (addi imm1 imm1 4)
782  (bne @true)
783  (subic. count count 4)
784  (bgt  @loop)
785  (li arg_z ppc32::nil-value)
786  (blr)
787  @true
788  (li arg_z (+ ppc32::nil-value  ppc32::t-offset))
789  (blr))
790
791;;; dest[idx] <- (lognot src[idx])
792(defppclapfunction %bignum-lognot ((idx arg_x) (src arg_y) (dest arg_z))
793  (la imm1 ppc32::misc-data-offset idx)
794  (lwzx imm0 src imm1)
795  (not imm0 imm0)
796  (stwx imm0 dest imm1)
797  (blr))
798
799;;; dest[idx] <- (logand x[idx] y[idx])
800(defppclapfunction %bignum-logand ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
801  (vpop temp0)
802  (la imm1 ppc32::misc-data-offset temp0)
803  (lwzx imm0 x imm1)
804  (lwzx imm2 y imm1)
805  (and imm0 imm0 imm2)
806  (stwx imm0 dest imm1)
807  (blr))
808
809;;; dest[idx] <- (logandc2 x[idx] y[idx])
810(defppclapfunction %bignum-logandc2 ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
811  (vpop temp0)
812  (la imm1 ppc32::misc-data-offset temp0)
813  (lwzx imm0 x imm1)
814  (lwzx imm2 y imm1)
815  (andc imm0 imm0 imm2)
816  (stwx imm0 dest imm1)
817  (blr))
818
819;;; dest[idx] <- (logandc1 x[idx] y[idx])
820(defppclapfunction %bignum-logandc1 ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
821  (vpop temp0)
822  (la imm1 ppc32::misc-data-offset temp0)
823  (lwzx imm0 x imm1)
824  (lwzx imm2 y imm1)
825  (andc imm0 imm2 imm0)
826  (stwx imm0 dest imm1)
827  (blr))
828
829
830
831(defppclapfunction digit-lognot-move ((index arg_x) (source arg_y) (dest arg_z))
832  (let ((scaled-index imm1))
833    (vref32 imm0 source index scaled-index) ; imm1 has c(index) + data-offset
834    (not imm0 imm0)
835    (stwx imm0 dest scaled-index)
836    (blr)))
837
838; if dest not nil store unboxed result in dest(0), else return boxed result
839(defppclapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
840  (let ((w1 imm0)
841        (w2 imm1))
842    (unbox-fixnum  w1 fix)
843    (lwz w2 ppc32::misc-data-offset big)
844    (cmpwi dest ppc32::nil-value)
845    (not w2 w2)
846    (and w1 w1 w2)
847    (bne @store)
848    (box-fixnum arg_z w1)
849    (blr)
850    @store
851    (stw w1 ppc32::misc-data-offset dest)
852    (blr)))
853
854
855
856(defppclapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
857  (let ((w1 imm0)
858        (w2 imm1))
859    (unbox-fixnum  w1 fix)
860    (lwz w2 ppc32::misc-data-offset big)
861    (cmpwi dest ppc32::nil-value)
862    (and w1 w1 w2)
863    (bne @store)
864    (box-fixnum arg_z w1)
865    (blr)
866    @store
867    (stw w1 ppc32::misc-data-offset dest)
868    (blr)))
869
870
871
872(defppclapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
873  (let ((w1 imm0)
874        (w2 imm1))
875    (unbox-fixnum  w1 fix)
876    (lwz w2 ppc32::misc-data-offset big)
877    (cmpwi dest ppc32::nil-value)
878    (not w1 w1)
879    (and w1 w1 w2)
880    (bne @store)
881    (box-fixnum arg_z w1)
882    (blr)
883    @store
884    (stw w1 ppc32::misc-data-offset dest)
885    (blr)))
886
887;;; dest[idx] <- (logior x[idx] y[idx])
888(defppclapfunction %bignum-logior ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
889  (vpop temp0)
890  (la imm1 ppc32::misc-data-offset temp0)
891  (lwzx imm0 x imm1)
892  (lwzx imm2 y imm1)
893  (or imm0 imm0 imm2)
894  (stwx imm0 dest imm1)
895  (blr))
896
897;;; dest[idx] <- (logxor x[idx] y[idx])
898(defppclapfunction %bignum-logxor ((idx 0) (x arg_x) (y arg_y) (dest arg_z))
899  (vpop temp0)
900  (la imm1 ppc32::misc-data-offset temp0)
901  (lwzx imm0 x imm1)
902  (lwzx imm2 y imm1)
903  (xor imm0 imm0 imm2)
904  (stwx imm0 dest imm1)
905  (blr))
906
907
908
909(defppclapfunction bignum-xor-loop ((count 0) (s1 arg_x) (s2 arg_y) (dest arg_z))
910  (lwz imm0 count vsp)
911  (addi imm1 rzero ppc32::misc-data-offset)
912  @loop
913  (lwzx imm2 s1 imm1)
914  (lwzx imm3 s2 imm1)
915  (xor imm2 imm3 imm2)
916  (subic. imm0 imm0 4)
917  (stwx imm2 dest imm1)
918  (addi imm1 imm1 4)
919  (bgt @loop)
920  @out
921  (la vsp 4 vsp)
922  (blr))
923
924#+nomore
925(defppclapfunction try-guess-loop-1 ((guess-h 8)(guess-l 4)(len-y 0)
926                                     (xidx arg_x) (xptr arg_y) (yptr arg_z))
927  (let ((guess imm0)
928        (carry imm1)
929        (y imm2)
930        (x imm2)
931        (prod-l imm3)
932        (prod-h imm4)
933        (tem imm4)
934        (yidx temp0)
935        (end-y temp1)
936        (carry-bit temp2))
937    (lwz x guess-h vsp)
938    (lwz tem guess-l vsp)
939    (compose-digit guess x tem)
940    (lwz end-y len-y vsp)
941    (li yidx 0)
942    (li carry 0) 
943    (li carry-bit '1)
944    @loop
945    ; multiply guess by ydigit, add carry to lo, hi is new carry
946    ; then get an xdigit subtract prod-lo from it and store result in x (remember carry)
947    (addi tem yidx ppc32::misc-data-offset)   ; get yidx
948    (lwzx y yptr tem)
949    (mullw prod-l guess y)
950    (mulhwu prod-h guess y)   
951    (addc prod-l prod-l carry) 
952    (adde carry prod-h rzero)
953    ; get back saved carry
954    (li tem '-1)
955    (addc tem carry-bit tem)
956    (addi tem xidx ppc32::misc-data-offset)
957    (lwzx x xptr tem)   
958    (subfe x prod-l x)       
959    (stwx x xptr tem)
960    ; save carry
961    (adde prod-l rzero rzero)
962    (box-fixnum carry-bit prod-l)
963    (addi yidx yidx '1)
964    (cmpw yidx end-y)
965    (addi xidx xidx '1)
966    (blt @loop)
967    ; finally subtract carry from last x digit
968    @done
969    (li prod-l '-1)  ; get back saved carry again - box clobbered it?
970    (addc prod-l carry-bit prod-l)
971    (addi tem xidx ppc32::misc-data-offset) ; maybe still there - nope
972    (lwzx x xptr tem)
973    (subfe x carry x)
974    (stwx x xptr tem)
975    (la vsp 12 vsp)
976    (blr)))
977
978;; x0 is at index, x1 at index-1, x2 at index-2
979;; y1 is at index, y2 at index-1
980;; this doesnt help much
981(defppclapfunction truncate-guess-loop ((guess-h 8)(guess-l 4)(x 0)
982                                        (xidx arg_x)(yptr arg_y) (yidx arg_z))
983  (let ((guess imm0)
984        (y1 imm1)
985        (y2 imm1)
986        (gy1-lo imm2) ; look out below
987        (gy1-hi imm2)
988        (gy2-lo imm2)
989        (gy2-hi imm2)
990        (xptr temp0)
991        (m imm3)
992        (tem imm4)
993        (y1-idx 28)
994        (y2-idx 24)
995        (x0-idx 20)
996        (x1-idx 16)
997        (x2-idx 12))
998    (stwu tsp -32 tsp)
999    (stw tsp 4 tsp)
1000    (lwz y1 guess-h vsp)
1001    (lwz tem guess-l vsp)
1002    (compose-digit guess y1 tem)
1003    (addi tem yidx ppc32::misc-data-offset)
1004    (lwzx y1 yptr tem)
1005    (stw y1 y1-idx tsp)
1006    (subi tem tem 4)
1007    (lwzx y2 yptr tem)
1008    (stw y2 y2-idx tsp)
1009    (lwz xptr x vsp)
1010    (addi tem xidx ppc32::misc-data-offset)
1011    (lwzx y1 xptr tem) ; its x0
1012    (stw y1 x0-idx tsp)
1013    (subi tem tem 4)
1014    (lwzx y1 xptr tem)
1015    (stw y1 x1-idx tsp)
1016    (subi tem tem 4)
1017    (lwzx y1 xptr tem)
1018    (stw y1 x2-idx tsp)
1019    @loop
1020    (lwz y1 y1-idx tsp)     ; get y1
1021    (mullw gy1-lo guess y1)
1022    (lwz m x1-idx tsp)      ; get x1
1023    (subc m m gy1-lo)      ; x1 - gy1-lo => m
1024    (mulhwu gy1-hi guess y1)
1025    (lwz tem x0-idx tsp)    ; get x0
1026    (subfe. tem gy1-hi tem)      ; - val not used just cr
1027    (lwz y2 y2-idx tsp)     ; get y2
1028    (mulhwu gy2-hi guess y2)   ; does it pay to do this now even tho may not need?
1029    (bne @done)
1030    (cmpl :cr0 gy2-hi m)       ; if > or = and foo then more - L means logical means unsigned
1031    (blt @done)           ; if < done
1032    (bne @more)           ; if = test lo
1033    (mullw gy2-lo guess y2)
1034    (lwz tem x2-idx tsp) ; get x2
1035    (cmpl :cr0 gy2-lo tem)
1036    (ble @done)
1037    @more
1038    (subi guess guess 1)
1039    (b @loop)
1040    @done
1041    (digit-h temp0 guess)
1042    (vpush temp0)
1043    (digit-l temp0 guess)
1044    (vpush temp0)
1045    (la temp0 20 vsp)
1046    (lwz tsp 0 tsp)
1047    (set-nargs 2)
1048    (ba .spvalues)))
1049
1050(defppclapfunction normalize-bignum-loop ((sign arg_x)(res arg_y)(len arg_z))
1051  (let ((idx imm0)
1052        (usign imm1)
1053        (val imm2))     
1054    (unbox-fixnum usign sign)
1055    (cmpwi len 0)
1056    (addi idx len (- ppc32::misc-data-offset 4)) 
1057    (beqlr) ; huh - can this ever happen?
1058    @loop
1059    (lwzx val res idx)
1060    (cmpw  val usign)   
1061    (subi idx idx '1)
1062    (bne @neq)   
1063    (subic. len len '1)
1064    (bgt @loop)
1065    ; fall through - its all sign - return 1
1066    (li arg_z '1)
1067    (blr)
1068    @neq
1069    (rlwinm usign usign 0 0 0) ; hi bit
1070    (rlwinm val val 0 0 0)
1071    (cmpw usign val)  ; is hi bit = sign, if so then done   
1072    (beqlr)
1073    (addi len len '1) ; if not, need 1 more
1074    (blr)))
1075
1076(defppclapfunction %normalize-bignum-2 ((fixp arg_y)(res arg_z))
1077  (let ((idx imm0)
1078        (usign imm1)
1079        (val imm2)
1080        (len arg_x)
1081        (oldlen temp0))
1082    (lwz imm4 (- ppc32::fulltag-misc) res)
1083    (header-length len imm4)
1084    (cmpwi len 0)
1085    (mr oldlen len)
1086    (addi idx len (- ppc32::misc-data-offset 4)) 
1087    (beqlr) ; huh - can this ever happen?
1088    (lwzx val res idx) ; high order word
1089    (srawi usign val 31) ; get sign
1090    @loop
1091    (lwzx val res idx)
1092    (cmpw  val usign)   
1093    (subi idx idx '1)
1094    (bne @neq)   
1095    (subic. len len '1)
1096    (bgt @loop)
1097    ; fall through - its all sign - return 1
1098    (li len '1)
1099    (rlwinm usign usign 0 0 0) ; hi bit
1100    (b @more)
1101    @neq
1102    (rlwinm usign usign 0 0 0) ; hi bit
1103    (rlwinm val val 0 0 0)
1104    (cmpw usign val)  ; is hi bit = sign, if so then done   
1105    (beq @more)
1106    (addi len len '1) ; if not, need 1 more
1107    (b @big)
1108    @more
1109    (cmpwi :cr1 fixp ppc32::nil-value)
1110    (cmpwi len '1)
1111    (beq :cr1 @big)  ; dont return fixnum
1112    (bgt @big)
1113    ;; stuff for maybe fixnum
1114    ;(dbg t)
1115    (lwz val ppc32::misc-data-offset res)
1116    (rlwinm imm4 val 0 0 2) ; hi 3 bits same? - we assume fixnumshift is 2
1117    (srawi usign usign 2)
1118    (cmpw usign imm4)
1119    (bne @big)   
1120    (box-fixnum arg_z val)
1121    (blr)
1122    @big
1123    (cmpw oldlen len)
1124    (beqlr) ; same length - done
1125    (li imm4 ppc32::subtag-bignum) ; set new length
1126    (rlwimi imm4 len (- ppc32::num-subtag-bits ppc32::fixnumshift) 0 (- 31 ppc32::num-subtag-bits))
1127    (stw imm4 ppc32::misc-header-offset res)
1128    ; 0 to tail if negative
1129    (cmpwi usign 0)
1130    (beqlr) 
1131     ; zero from len inclusive to oldlen exclusive
1132    ;(dbg t)
1133    (addi idx len ppc32::misc-data-offset)
1134    @loop2
1135    (stwx rzero idx res)
1136    (addi len len '1)
1137    (cmpw len oldlen)
1138    (addi idx idx '1)
1139    (blt @loop2)
1140    (blr)))
1141
1142(defppclapfunction %count-digit-leading-zeros ((high arg_y) (low arg_z))
1143  (compose-digit imm0 high low)
1144  (cntlzw imm0 imm0)
1145  (box-fixnum arg_z imm0)
1146  (blr))
1147
1148(defppclapfunction %count-digit-trailing-zeros ((high arg_y) (low arg_z))
1149  (compose-digit imm0 high low)
1150  (neg imm1 imm0)
1151  (and imm0 imm0 imm1)
1152  (cntlzw imm0 imm0)
1153  (subfic imm0 imm0 31)
1154  (box-fixnum arg_z imm0)
1155  (blr))
1156
1157
1158(defppclapfunction %bignum-count-trailing-zero-bits ((bignum arg_z))
1159  (let ((ndigits arg_x)
1160        (nbits arg_y)
1161        (digit imm0)
1162        (ptr imm1))
1163    (li ptr ppc32::misc-data-offset)
1164    (li ndigits '-32)
1165    @next
1166    (lwzx digit bignum ptr)
1167    (cmpwi digit 0)
1168    (la ptr 4 ptr)
1169    (addi ndigits ndigits '32)
1170    (beq @next)
1171    (neg ptr digit)
1172    (and digit digit ptr)
1173    (cntlzw digit digit)
1174    (subfic digit digit 31)
1175    (box-fixnum nbits digit)
1176    (add arg_z nbits ndigits)
1177    (blr)))
1178
1179
1180(defppclapfunction %bignum-trim-leading-zeros ((bignum arg_x)
1181                                               (start arg_y)
1182                                               (len arg_z))
1183  (add imm1 start len)
1184  (la imm1 (- ppc32::misc-data-offset 4) imm1)
1185  @loop
1186  (cmpwi cr0 len '1)
1187  (lwzx imm0 bignum imm1)
1188  (cmpwi cr1 imm0 0)
1189  (la imm1 -4 imm1)
1190  (bnelr cr1)
1191  (la len '-1 len)
1192  (bne @loop)
1193  (blr))
1194 
1195;;; Set length of bignum to new-len (zeroing out any trailing words between
1196;;; the old length and the new.
1197(defppclapfunction %shrink-bignum ((new-len arg_y) (bignum arg_z))
1198  (let ((old-len temp0)
1199        (old-idx imm0)
1200        (new-idx imm2)
1201        (header imm1))
1202    (getvheader header bignum)
1203    (header-length old-len header)
1204    (cmpw old-len new-len)
1205    (la old-idx ppc32::misc-data-offset old-len)
1206    (la new-idx ppc32::misc-data-offset new-len)
1207    (beqlr)
1208    @loop
1209    (subi old-idx old-idx 4)
1210    (cmpw old-idx new-idx)
1211    (stwx ppc32::rzero bignum old-idx)
1212    (bne @loop)
1213    (slwi header new-len (- ppc32::num-subtag-bits ppc32::fixnumshift))
1214    (ori header header ppc32::subtag-bignum)
1215    (stw header ppc32::misc-header-offset bignum)
1216    (blr)))
1217   
1218;;; Especially when large operands are involved, the GNU Multiple Precision
1219;;; library's algorithm's are often faster than OpenMCL's.  GMP's MPN
1220;;; library defines operations on "limb vectors", which are basically
1221;;; just sequences of 32-bit digits (least-significant digit first), which
1222;;; is just about exactly the same way that OpenMCL stores bignums.
1223;;; We might want to (eventually) link some or all of GMP into OpenMCL;
1224;;; in the meantime, it seems that we get some performance benefit from
1225;;; using GMP representation and algorithms in some mixture of LAP and Lisp.
1226;;; To approximate the "limb vector" representation, we copy operands to
1227;;; (and results from) stack-allocated macptrs.  Since those macptrs are
1228;;; word-aligned, we can use fixnums to represent word-aligned pointers.
1229;;; Obviously, it costs a little to copy back and forth like this; we
1230;;; only win when operands are fairly large, and when we can replace an
1231;;; N^2 algorithm with something cheaper.
1232
1233;;; Macptr MUST be word-aligned (low 2 bits must be 0).  Extract
1234;;; such an address, return it as a fixnum.
1235(defppclapfunction macptr->fixnum ((ptr arg_z))
1236  (macptr-ptr arg_z ptr)
1237  (blr))
1238
1239;;; Copy the limb SRC points to to where DEST points.
1240(defppclapfunction copy-limb ((src arg_y) (dest arg_z))
1241  (lwz imm0 0 src)
1242  (stw imm0 0 dest)
1243  (blr))
1244
1245;;; Return T iff LIMB contains 0.
1246(defppclapfunction limb-zerop ((limb arg_z))
1247  (lwz imm0 0 limb)
1248  (cntlzw imm0 imm0)
1249  (srwi imm0 imm0 5)
1250  (bit0->boolean arg_z imm0 imm0)
1251  (blr))
1252
1253;;; Return -1,0,1 according to whether the contents of Y are
1254;;; <,=,> the contents of Z.
1255(defppclapfunction compare-limbs ((y arg_y) (z arg_z))
1256  (lwz imm1 0 z)
1257  (lwz imm0 0 y)
1258  (cmplw imm0 imm1)
1259  (li arg_z 0)
1260  (beqlr)
1261  (li arg_z '1)
1262  (bgtlr)
1263  (li arg_z '-1)
1264  (blr))
1265
1266;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
1267(defppclapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1268  (unbox-fixnum imm0 fixnum)
1269  (lwz imm1 0 limb)
1270  (add imm1 imm1 imm0)
1271  (stw imm1 0 limb)
1272  (blr))
1273
1274;;; Store a fixnum value where LIMB points.
1275(defppclapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
1276  (unbox-fixnum imm0 fixnum)
1277  (stwu imm0 0 limb)
1278  (blr))
1279
1280;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
1281;;; knows that carries will only propagate for a word or two.
1282(defppclapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
1283  (let ((by imm0)
1284        (sum imm1))
1285    (unbox-fixnum by fixby)
1286    @loop
1287    (lwz sum 0 limb)
1288    (add sum sum by)
1289    (cmplw sum by)
1290    (stw sum 0 limb)
1291    (li by 1)
1292    (la limb 4 limb)
1293    (blt @loop)
1294    (blr)))
1295
1296;;; Store XP-YP at WP; return carry (0 or 1).
1297;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
1298;;; size: boxed fixnum
1299;;; returns boxed carry
1300(defppclapfunction mpn-sub-n ((wp 0) (xp arg_x) (yp arg_y) (size arg_z))
1301  (vpop imm0)
1302  (subi size size '1)
1303  (cmpwi size 0)
1304  (lwz imm3 0 xp)
1305  (lwz imm4 0 yp)
1306  (sub imm1 xp imm0)                    ; imm1 = xp-wp
1307  (sub imm2 yp imm0)                    ; imm2 = yp-wp
1308  (addi imm1 imm1 4)                    ; imm1 = xp-wp+4
1309  (addi imm2 imm2 4)                    ; imm2 = yp-wp+4
1310  (subfc imm3 imm4 imm3)
1311  (stw imm3 0 imm0)                     ; wp[0]
1312  (beq @done)
1313  @top
1314  (subi size size '1)
1315  (cmpwi size 0)
1316  (lwzx imm3 imm1 imm0)                 ; imm3 = xp[i]
1317  (lwzx imm4 imm2 imm0)                 ; imm4 = xp[i]
1318  (subfe imm3 imm4 imm3)
1319  (stwu imm3 4 imm0)
1320  (bne @top)
1321  @done
1322  (subfe imm0 rzero rzero)
1323  (subfic imm0 imm0 0)
1324  (box-fixnum arg_z imm0)
1325  (blr))
1326
1327;;; Store XP+YP at WP; return carry (0 or 1).
1328;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
1329;;; size = boxed fixnum
1330;;; result = boxed carry
1331(defppclapfunction mpn-add-n ((wp 0) (xp arg_x) (yp arg_y) (size arg_z))
1332  (vpop imm0)
1333  (subi size size '1)
1334  (cmpwi size 0)
1335  (lwz imm3 0 xp)
1336  (lwz imm4 0 yp)
1337  (sub imm1 xp imm0)                    ; imm1 = xp-wp
1338  (sub imm2 yp imm0)                    ; imm2 = yp-wp
1339  (addi imm1 imm1 4)                    ; imm1 = xp-wp+4
1340  (addi imm2 imm2 4)                    ; imm2 = yp-wp+4
1341  (addc imm3 imm3 imm4)
1342  (stw imm3 0 imm0)                     ; wp[0]
1343  (beq @done)
1344  @top
1345  (subi size size '1)
1346  (cmpwi size 0)
1347  (lwzx imm3 imm1 imm0)                 ; imm3 = xp[i]
1348  (lwzx imm4 imm2 imm0)                 ; imm4 = xp[i]
1349  (adde imm3 imm4 imm3)
1350  (stwu imm3 4 imm0)
1351  (bne @top)
1352  @done
1353  (addze imm0 rzero)
1354  (box-fixnum arg_z imm0)
1355  (blr))
1356
1357;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
1358;;; result at RP.  RP and S1P may be the same place, so check for
1359;;; that and do nothing after carry stops propagating.  Return carry.
1360(defppclapfunction mpn-add-1 ((rp-offset 0) (s1p arg_x) (size arg_y) (limb arg_z))
1361  (let ((rp temp0))
1362    (vpop rp)
1363    (subi size size '1)
1364    (cmpwi cr2 size 0)
1365    (cmpw cr1 rp s1p)                   ;a common case
1366    (subi rp rp 4)
1367    (subi s1p s1p 4)
1368    (lwz imm0 0 limb)
1369    (lwzu imm1 4 s1p)
1370    (addc imm1 imm1 imm0)
1371    (addze. imm0 rzero)
1372    (stwu imm1 4 rp)
1373    (beq cr2 @done)
1374    @top
1375    (beq cr0 @finish)                   ; branch if  no more carry
1376    (subi size size '1)
1377    (cmpwi cr2 size 0)
1378    (lwzu imm1 4 s1p)
1379    (addc imm1 imm1 imm0)
1380    (addze. imm0 rzero)
1381    (stwu imm1 4 rp)
1382    (bne cr2 @top)
1383    (box-fixnum arg_z imm0)
1384    (blr)
1385    @finish
1386    (beq cr1 @done)
1387    @loop
1388    (subi size size '1)
1389    (cmpwi cr2 size 0)
1390    (lwzu imm1 4 s1p)
1391    (stwu imm1 4 rp)
1392    (bne cr2 @loop)
1393    @done
1394    (box-fixnum arg_z imm0)
1395    (blr)))
1396;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
1397;;; the result at RES.  Store the "carry out" (high word of last 64-bit
1398;;; partial product) at the limb RESULT.
1399;;; res, s1, limbptr, result:
1400;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
1401;;; It'd be hard to transliterate the GMP code here; the GMP version
1402;;; uses lots more immediate registers than we can easily use in LAP
1403;;; (and is much more aggressively pipelined).
1404(defppclapfunction mpn-mul-1 ((res-offset 4)
1405                              (s1-offset 0)
1406                              (size arg_x)
1407                              (limbptr arg_y)
1408                              (result arg_z))
1409  (let ((limb imm0)
1410        (resptr temp0)
1411        (s1 temp1)
1412        (src imm1)
1413        (prod-low imm2)
1414        (prod-high imm3)
1415        (carry imm4))
1416    (lwz resptr res-offset vsp)
1417    (lwz s1 s1-offset vsp)
1418    (la vsp 8 vsp)
1419    (la resptr -4 resptr)               ; pre-decrement
1420    (la s1 -4 s1)
1421    (addic carry carry 0)
1422    (li carry 0)
1423    (lwz limb 0 limbptr)
1424    @loop
1425    (subi size size '1)
1426    (cmpwi size 0)
1427    (lwzu src 4 s1)
1428    (mulhwu prod-high src limb)
1429    (mullw prod-low src limb)
1430    (addc prod-low prod-low carry)
1431    (addze carry prod-high)
1432    (stwu prod-low 4 resptr)
1433    (bne @loop)
1434    (stw carry 0 result)
1435    (blr)))
1436
1437;;; multiply s1*limb and add result to res
1438;;; res, s1, limbptr, result:
1439;;;   unboxed, word-aligned ptrs (fixnums).
1440;;; size: boxed fixnum
1441;;; limbptr: source "limb".
1442;;; result: carry out (high word of product).
1443(defppclapfunction mpn-addmul-1 ((res-offset 4)
1444                                 (s1-offset 0)
1445                                 (size arg_x)
1446                                 (limbptr arg_y)
1447                                 (result arg_z))
1448  (let ((limb imm0)
1449        (resptr temp0)
1450        (s1 temp1)
1451        (src imm1)
1452        (prod-low imm2)
1453        (prod-high imm3)
1454        (carry imm4)
1455        (prev imm4))
1456    (lwz resptr res-offset vsp)
1457    (lwz s1 s1-offset vsp)
1458    (la vsp 8 vsp)
1459    (la resptr -4 resptr)               ; pre-decrement
1460    (la s1 -4 s1)
1461    (addic carry carry 0)
1462    (li carry 0)
1463    (lwz limb 0 limbptr)
1464    @loop
1465    (subi size size '1)
1466    (cmpwi size 0)
1467    (lwzu src 4 s1)
1468    (mulhwu prod-high src limb)
1469    (mullw prod-low src limb)
1470    (addc prod-low prod-low carry)
1471    (addze prod-high prod-high)
1472    (lwz prev 4 resptr)
1473    (addc prev prev prod-low)
1474    (stwu prev 4 resptr)
1475    (addze carry prod-high)
1476    (bne @loop)
1477    (stw carry 0 result)
1478    (blr))) 
1479
1480;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
1481;;; at VP, store the result at RP.
1482(defppclapfunction mpn-mul-basecase ((rp-offset 4)
1483                                     (up-offset 0)
1484                                     (un arg_x)
1485                                     (vp arg_y)
1486                                     (vn arg_z))
1487  (let ((resptr temp0)
1488        (s1 temp1)
1489        (up temp2)
1490        (rp temp3)
1491        (size nargs)
1492        (limb imm0)
1493        (src imm1)
1494        (prod-low imm2)
1495        (prod-high imm3)
1496        (prev imm4)
1497        (carry imm4))
1498    (lwz resptr rp-offset vsp)
1499    (la rp -4 resptr)
1500    (lwz up up-offset vsp)
1501    (la s1 -4 up)
1502    (la vsp 8 vsp)
1503    (mr size un)
1504    (lwz limb 0 vp)
1505    (subi vn vn '1)
1506    (cmpwi cr2 vn 0)
1507    (li carry 0)
1508    @mul-1-loop
1509    (subi size size '1)
1510    (cmpwi size 0)
1511    (lwzu src 4 s1)
1512    (mulhwu prod-high src limb)
1513    (mullw prod-low src limb)
1514    (addc prod-low prod-low carry)
1515    (addze carry prod-high)
1516    (stwu prod-low 4 rp)
1517    (bne @mul-1-loop)
1518    (stw carry 4 rp)
1519    @again
1520    (beq cr2 @done)
1521    (subi vn vn '1)
1522    (cmpwi cr2 vn 0)
1523    (mr rp resptr)
1524    (la resptr 4 resptr)
1525    (la s1 -4 up)
1526    (lwzu limb 4 vp)
1527    (mr size un)
1528    (addic carry carry 0)
1529    (li carry 0)
1530    @addmul-1-loop
1531    (subi size size '1)
1532    (cmpwi size 0)
1533    (lwzu src 4 s1)
1534    (mulhwu prod-high src limb)
1535    (mullw prod-low src limb)
1536    (addc prod-low prod-low carry)
1537    (addze prod-high prod-high)
1538    (lwz prev 4 rp)
1539    (addc prev prev prod-low)
1540    (stwu prev 4 rp)
1541    (addze carry prod-high)
1542    (bne @addmul-1-loop)
1543    (stw carry 4 rp)
1544    (b @again)
1545    @done
1546    (li arg_z ppc32::nil-value)
1547    (blr)))
1548
1549;;; left-shift src by 1 bit, storing result at res.  Return
1550;;; the bit that was shifted out.
1551(defppclapfunction mpn-lshift-1 ((resptr arg_x) (s1ptr arg_y) (size-arg arg_z))
1552  (let ((size temp0)
1553        (last-bit imm0)
1554        (prev imm1)
1555        (curr imm2)
1556        (sleft imm3)
1557        (sright imm4))
1558    (subi size size-arg '1)
1559    (cmpwi size 0)
1560    (add resptr resptr size-arg)
1561    (add s1ptr s1ptr size-arg)
1562    (lwzu prev -4 s1ptr)
1563    (srwi last-bit prev 31)
1564    (box-fixnum arg_z last-bit)
1565    (beq @end1)
1566    @loop
1567    (subi size size '1)
1568    (cmpwi size 0)
1569    (lwzu curr -4 s1ptr)
1570    (slwi sleft prev 1)
1571    (srwi sright curr 31)
1572    (or sright sright sleft)
1573    (stwu sright -4 resptr)
1574    (beq @end2)
1575    (subi size size '1)
1576    (cmpwi size 0)
1577    (lwzu prev -4 s1ptr)
1578    (slwi sleft curr 1)
1579    (srwi sright prev 31)
1580    (or sright sright sleft)
1581    (stwu sright -4 resptr)
1582    (bne @loop)
1583    @end1
1584    (slwi sleft prev 1)
1585    (stwu sleft -4 resptr)
1586    (blr)
1587    @end2
1588    (slwi sleft curr 1)
1589    (stwu sleft -4 resptr)
1590    (blr)))
1591
1592;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
1593;;; result (low word first) at RESULT.
1594(defppclapfunction umulppm ((x arg_x) (y arg_y) (result arg_z))
1595  (lwz imm0 0 x)
1596  (lwz imm1 0 y)
1597  (mullw imm2 imm0 imm1)
1598  (mulhwu imm3 imm0 imm1)
1599  (stw imm2 0 result)
1600  (stw imm3 4 result)
1601  (blr))
1602
1603
1604;;; for truncate-by-fixnum etal
1605;;; doesnt store quotient - just returns rem in 2 halves
1606(defppclapfunction %floor-loop-no-quo ((q arg_x)(yhi arg_y)(ylo arg_z))
1607  (let ((a imm1)
1608        (b imm2)
1609        (y imm3)
1610        (quo imm0)
1611        (qidx temp0)
1612        (qlen temp1))
1613    (lwz imm4 (- ppc32::fulltag-misc) q)
1614    (header-length qlen imm4)
1615    (subi qidx qlen 4)
1616    (mr b rzero)
1617    (compose-digit y yhi ylo)
1618    @loop
1619    (rlwinm a b -16 16 31)
1620    (rlwinm b b 16 0 15)
1621    (la imm4 ppc32::misc-data-offset q)
1622    (lwzx imm4 qidx imm4) ; q contents
1623    (rlwimi b imm4 16 16 31) ; hi 16 to lo b
1624    ;(dbg)         
1625    (48x32-divide a b y fp0 fp1 fp2 imm4)
1626    (fctiwz fp0 fp0)
1627    (stwu tsp -32 tsp)
1628    (stw tsp 4 tsp)
1629    (stfd fp0 24 tsp)
1630    (lwz quo (+ 24 4) tsp) ; 16 quo bits above stuff used by 48x32
1631    ; now mul quo by y
1632    (mullw imm4 y quo)
1633    ; and subtract from a,b
1634    (subfc b imm4 b)
1635    ; new a and b are low 2 digits of this (b) and last digit in array
1636    ; and do it again on low 3 digits
1637    ;(dbg)
1638    (rlwinm a b -16 16 31)
1639    (rlwinm b b 16 0 15)
1640    (la imm4 ppc32::misc-data-offset q)
1641    (lwzx imm4 qidx imm4)
1642    (rlwimi b imm4 0 16 31)
1643    (48x32-divide a b y fp0 fp1 fp2 imm4)
1644    (fctiwz fp0 fp0)
1645    (stfd fp0 16 tsp)  ; quo lo
1646    (subi qidx qidx 4)
1647    (cmpwi :cr1 qidx 0)
1648    (lwz quo (+ 16 4) tsp)
1649    (lwz tsp 0 tsp)
1650    (mullw imm4 y quo)
1651    (subfc b imm4 b)  ; b is remainder
1652    (bge :cr1 @loop)
1653    (digit-h temp0 b)
1654    (vpush temp0)
1655    (digit-l temp0 b)
1656    (vpush temp0)
1657    (la temp0 8 vsp)
1658    (set-nargs 2)
1659    (ba .SPvalues)))
1660   
1661
1662; store result in dest, return rem in 2 halves
1663(defppclapfunction %floor-loop-quo ((q-stk 0)(dest arg_x)(yhi arg_y)(ylo arg_z))
1664  (let ((a imm1)
1665        (b imm2)
1666        (y imm3)
1667        (quo imm0)
1668        (qidx temp0)
1669        (qlen temp1)
1670        (q temp2))
1671    (vpop q)
1672    (lwz imm4 (- ppc32::fulltag-misc) q)
1673    (header-length qlen imm4)
1674    (subi qidx qlen 4)
1675    (mr b rzero)
1676    (compose-digit y yhi ylo)
1677    @loop
1678    (rlwinm a b -16 16 31)
1679    (rlwinm b b 16 0 15)
1680    (la imm4 ppc32::misc-data-offset q)
1681    (lwzx imm4 qidx imm4) ; q contents
1682    (rlwimi b imm4 16 16 31) ; hi 16 to lo b       
1683    (48x32-divide a b y fp0 fp1 fp2 imm4)
1684    (fctiwz fp0 fp0)
1685    (stwu tsp -32 tsp)
1686    (stw tsp 4 tsp)
1687    (stfd fp0 24 tsp)
1688    (lwz quo (+ 24 4) tsp) ; 16 quo bits above stuff used by 48x32
1689    ; now mul quo by y
1690    (mullw imm4 y quo)
1691    ; and subtract from a,b
1692    (subfc b imm4 b)
1693    ; new a and b are low 2 digits of this (b) and last digit in array
1694    ; and do it again on low 3 digits
1695    ;(dbg)
1696    (rlwinm a b -16 16 31)
1697    (rlwinm b b 16 0 15)
1698    (la imm4 ppc32::misc-data-offset q)
1699    (lwzx imm4 qidx imm4)
1700    (rlwimi b imm4 0 16 31)
1701    (48x32-divide a b y fp0 fp1 fp2 imm4)
1702    (fctiwz fp0 fp0)
1703    (stfd fp0 16 tsp)  ; quo lo
1704    (lwz quo (+ 16 4) tsp)
1705    (mullw imm4 y quo)
1706    (subfc b imm4 b)  ; b is remainder   
1707    (lwz quo (+ 24 4) tsp) ; quo-hi
1708    (rlwinm quo quo 16 0 15)
1709    (lwz imm4 (+ 16 4) tsp) ; quo lo
1710    (lwz tsp 0 tsp)
1711    (rlwimi quo imm4 0 16 31)   
1712    (la imm4 ppc32::misc-data-offset dest)
1713    (stwx quo qidx imm4)
1714    (subic. qidx qidx 4)
1715    (bge @loop)
1716    (digit-h temp0 b)
1717    (vpush temp0)
1718    (digit-l temp0 b)
1719    (vpush temp0)
1720    (la temp0 8 vsp)
1721    (set-nargs 2)
1722    (ba .SPvalues)))
1723
1724;;; get xidx thing from x, yidx thing from y if same return #xffff
1725;;; #xffff otherwise get another thing from x and 1- xidx and do as
1726;;; %floor of xthing otherx ything
1727;;; Huh?
1728(defppclapfunction %floor-99 ((x-stk 0)(xidx arg_x)(yptr arg_y)(yidx arg_z))
1729  (let ((xptr temp0)
1730        (a imm1)
1731        (b imm2)
1732        (y imm3)
1733        (quo imm0)) 
1734    (vpop xptr)
1735    (la imm4 ppc32::misc-data-offset XIDX)
1736    (lwzx a xptr imm4)
1737    (la imm4 ppc32::misc-data-offset YIDX)
1738    (lwzx y yptr imm4)
1739    (cmpw a y)
1740    (bne @more)
1741    (li imm4 #xffff)
1742    (rlwinm imm4 imm4 ppc32::fixnumshift (- 16 ppc32::fixnumshift) (- 31 ppc32::fixnum-shift))
1743    (vpush imm4)
1744    (vpush imm4)
1745    (la temp0 8 vsp)
1746    (set-nargs 2)
1747    (ba .spvalues)
1748    @MORE
1749    ;  a has 16 bits from ahi, bhi gets alo blo gets bhi
1750    (la imm4 (- ppc32::misc-data-offset 4) xidx)
1751    (lwzx b xptr imm4)
1752    (rlwinm b b 16 16 31)  ; bhi to blo
1753    (rlwimi b a 16 0 15)   ; alo to bhi
1754    (rlwinm a a 16 16 31)  ; a gets alo
1755    (48x32-divide a b y fp0 fp1 fp2 imm4)
1756    (fctiwz fp0 fp0)
1757    (stwu tsp -32 tsp)
1758    (stw tsp 4 tsp)
1759    (stfd fp0 24 tsp)
1760    (lwz quo (+ 24 4) tsp) ; 16 quo bits above stuff used by 48x32
1761    ; now mul quo by y
1762    (mullw imm4 y quo)
1763    ; and subtract from a,b
1764    (subfc b imm4 b)
1765    ; AND AGAIN
1766    (rlwinm a b -16 16 31) ; a gets b hi
1767    (rlwinm b b 16 0 15)   ; b lo to b hi
1768    (la imm4 (- ppc32::misc-data-offset 4) xidx) 
1769    (lwzx imm4 imm4 xptr)
1770    (rlwimi b imm4 0 16 31)
1771    (48x32-divide a b y fp0 fp1 fp2 imm4)
1772    (fctiwz fp0 fp0)
1773    (stfd fp0 16 tsp)  ; quo lo
1774    (lwz quo (+ 24 4) tsp) ; quo-hi
1775    (box-fixnum temp0 quo)
1776    (vpush temp0)
1777    (lwz quo (+ 16 4) tsp) ; quo lo
1778    (lwz tsp 0 tsp)
1779    (box-fixnum temp0 quo)
1780    (vpush temp0)   
1781    (la temp0 8 vsp)
1782    (set-nargs 2)
1783    (ba .SPvalues)))
1784
1785; End of ppc32-bignum.lisp
Note: See TracBrowser for help on using the repository browser.