source: trunk/source/level-0/PPC/PPC64/ppc64-bignum.lisp @ 12847

Last change on this file since 12847 was 12847, checked in by rme, 10 years ago

Try doing bignum multiplies 64 bits at a time on ppc64, too.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.4 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;;; The caller has allocated a two-digit bignum (quite likely on the stack).
21;;; If we can fit in a single digit (if the high word is just a sign
22;;; extension of the low word), truncate the bignum in place (the
23;;; trailing words should already be zeroed.
24(defppclapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
25  (unbox-fixnum imm0 fixnum)
26  (srdi imm1 imm0 32)
27  (srawi imm2 imm0 31)
28  (cmpw imm2 imm1)
29  (stw imm0 ppc64::misc-data-offset bignum)
30  (li imm2 ppc64::one-digit-bignum-header)
31  (beq @chop)
32  (stw imm1 (+ ppc64::misc-data-offset 4) bignum)
33  (blr)
34  @chop
35  (std imm2 ppc64::misc-header-offset bignum)
36  (blr))
37 
38(defppclapfunction %multiply-and-add-loop
39    ((x 8) (y 0)  (r arg_x) (idx arg_y) (ylen arg_z))
40  (let ((cc nargs)
41        (xx imm2)
42        (yy imm3)
43        (rr imm4)
44        (i imm0)
45        (j imm1))
46    (srdi i idx 1)
47    (la i ppc64::misc-data-offset i)
48    (ld temp0 x vsp)
49    (lwzx xx temp0 i)                   ;x[i]
50    (ld temp0 y vsp)
51    (mr temp1 r)
52    (li cc 0)
53    (li j ppc64::misc-data-offset)
54    @loop
55    (lwzx yy temp0 j)
56    (mulld yy xx yy)
57    ;; 64-bit product now in %yy
58    (lwzx rr temp1 i)
59    ;; add in digit from r[i]
60    (add rr rr yy)
61    ;; add in carry
62    (add rr rr cc)
63    (stwx rr temp1 i)
64    (srdi cc rr 32)             ;get carry digit into low word
65    (cmpdi ylen '1)
66    (la i 4 i)
67    (la j 4 j)
68    (subi ylen ylen '1)
69    (bne  @loop)
70    (stwx cc temp1 i)
71    (set-nargs 0)
72    (la vsp 16 vsp)
73    (blr)))
74
75(defppclapfunction %multiply-and-add-loop64
76    ((x 8) (y 0) (r arg_x) (idx arg_y) (ylen arg_z))
77  (let ((i imm0)
78        (j imm1)
79        (xx imm2)
80        (yy imm3)
81        (rr imm4)
82        (dd imm5)
83        (cc nargs))
84    (ld temp0 x vsp)
85    (la i ppc64::misc-data-offset idx)
86    (ldx xx temp0 i)                    ;x[i]
87    (rotldi xx xx 32)
88    (ld temp0 y vsp)
89    (li cc 0)
90    (li j ppc64::misc-data-offset)
91    @loop
92    (ldx yy temp0 j)                    ;y[j]
93    (rotldi yy yy 32)
94    (mulld dd xx yy)  ;low
95    (ldx rr r i)                        ;r[i]
96    (rotldi rr rr 32)
97    (addc rr rr dd)                     ;r[i] = r[i] + low
98    (mulhdu dd xx yy)                   ;high
99    (addze dd dd)                       ;carry from addding in low
100    (addc rr rr cc)                     ;add in carry digit
101    (addze cc dd)
102    (rotldi rr rr 32)
103    (stdx rr r i)                       ;update r[i]
104    (cmpdi ylen '1)
105    (la i 8 i)
106    (la j 8 j)
107    (subi ylen ylen '1)
108    (bne @loop)
109    (rotldi cc cc 32)
110    (stdx cc r i)
111    (set-nargs 0)
112    (la vsp 16 vsp)
113    (blr)))
114
115;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.
116;;; Add the 32-bit "prev" digit and the 32-bit carry-in digit to that 64-bit
117;;; result; return the halves as (VALUES high low).
118(defppclapfunction %multiply-and-add4 ((x 0) (y arg_x) (prev arg_y) (carry-in arg_z))
119  (let ((unboxed-x imm0)
120        (unboxed-y imm1)
121        (unboxed-prev imm2)
122        (unboxed-carry-in imm3)
123        (result64 imm4)
124        (high arg_y)
125        (low arg_z))
126    (ld temp0 x vsp)
127    (unbox-fixnum unboxed-x temp0)
128    (unbox-fixnum unboxed-y y)
129    (unbox-fixnum unboxed-prev prev)
130    (unbox-fixnum unboxed-carry-in carry-in)
131    (mulld result64 unboxed-x unboxed-y)
132    (add result64 result64 unboxed-prev)
133    (add result64 result64 unboxed-carry-in)
134    (clrlsldi low result64 32 ppc64::fixnumshift)
135    (clrrdi high result64 32)
136    (srdi high high (- 32 ppc64::fixnumshift))
137    (std high 0 vsp)
138    (set-nargs 2)
139    (vpush low)
140    (la temp0 '2 vsp)
141    (ba .SPvalues)))
142
143(defppclapfunction %multiply-and-add3 ((x arg_x) (y arg_y) (carry-in arg_z))
144  (let ((unboxed-x imm0)
145        (unboxed-y imm1)
146        (unboxed-carry-in imm2)
147        (result64 imm3)
148        (high arg_y)
149        (low arg_z))
150    (unbox-fixnum unboxed-x arg_x)
151    (unbox-fixnum unboxed-y y)
152    (unbox-fixnum unboxed-carry-in carry-in)
153    (mulld result64 unboxed-x unboxed-y)
154    (add result64 result64 unboxed-carry-in)
155    (clrlsldi low result64 32 ppc64::fixnumshift)
156    (clrrdi high result64 32)
157    (srdi high high (- 32 ppc64::fixnumshift))
158    (vpush high)
159    (set-nargs 2)
160    (vpush low)
161    (la temp0 '2 vsp)
162    (ba .SPvalues)))
163
164;;; Return the (possibly truncated) 32-bit quotient and remainder
165;;; resulting from dividing hi:low by divisor.
166(defppclapfunction %floor ((num-high arg_x) (num-low arg_y) (divisor arg_z))
167  (let ((unboxed-num imm0)
168        (unboxed-low imm1)
169        (unboxed-divisor imm2)
170        (unboxed-quo imm3)
171        (unboxed-rem imm4))
172    (sldi unboxed-num num-high (- 32 ppc64::fixnumshift))
173    (unbox-fixnum unboxed-low num-low)
174    (unbox-fixnum unboxed-divisor divisor)
175    (or unboxed-num unboxed-low unboxed-num)
176    (divdu unboxed-quo unboxed-num unboxed-divisor)
177    (mulld unboxed-rem unboxed-quo unboxed-divisor)
178    (sub unboxed-rem unboxed-num unboxed-rem)
179    (clrlsldi arg_y unboxed-quo 32 ppc64::fixnumshift)
180    (clrlsldi arg_z unboxed-rem 32 ppc64::fixnumshift)
181    (mr temp0 vsp)
182    (vpush arg_y)
183    (vpush arg_z)
184    (set-nargs 2)
185    (ba .SPvalues)))
186
187;;; Multiply two (UNSIGNED-BYTE 32) arguments, return the high and
188;;; low halves of the 64-bit result
189(defppclapfunction %multiply ((x arg_y) (y arg_z))
190  (let ((unboxed-x imm0)
191        (unboxed-y imm1)
192        (unboxed-high imm2)
193        (unboxed-low imm3))
194    (unbox-fixnum unboxed-x x)
195    (unbox-fixnum unboxed-y y)
196    (mulld imm2 unboxed-x unboxed-y)
197    (clrlsldi arg_y imm2 32 ppc64::fixnumshift) ; arg_y = low32
198    (srdi imm2 imm2 32)
199    (box-fixnum arg_z imm2)             ; arg_z = high32
200    (mr temp0 vsp)
201    (vpush arg_z)
202    (set-nargs 2)
203    (vpush arg_y)
204    (ba .SPvalues)))
205
206;;; Any words in the "tail" of the bignum should have been
207;;; zeroed by the caller.
208(defppclapfunction %set-bignum-length ((newlen arg_y) (bignum arg_z))
209  (sldi imm0 newlen (- ppc64::num-subtag-bits ppc64::fixnumshift))
210  (ori imm0 imm0 ppc64::subtag-bignum)
211  (std imm0 ppc64::misc-header-offset bignum)
212  (blr))
213
214;;; Count the sign bits in the most significant digit of bignum;
215;;; return fixnum count.
216(defppclapfunction %bignum-sign-bits ((bignum arg_z))
217  (vector-size imm0 bignum imm0)
218  (sldi imm0 imm0 2)
219  (la imm0 (- ppc64::misc-data-offset 4) imm0) ; Reference last (most significant) digit
220  (lwzx imm0 bignum imm0)
221  (cmpwi imm0 0)
222  (not imm0 imm0)
223  (blt @wasneg)
224  (not imm0 imm0)
225  @wasneg
226  (cntlzw imm0 imm0)
227  (box-fixnum arg_z imm0)
228  (blr))
229
230(defppclapfunction %signed-bignum-ref ((bignum arg_y) (index arg_z))
231  (srdi imm0 index 1)
232  (la imm0 ppc64::misc-data-offset imm0)
233  (lwax imm0 bignum imm0)
234  (box-fixnum arg_z imm0)
235  (blr))
236
237
238;;; If the bignum is a one-digit bignum, return the value of the
239;;; single digit as a fixnum.  Otherwise, if it's a two-digit-bignum
240;;; and the two words of the bignum can be represented in a fixnum,
241;;; return that fixnum; else return nil.
242(defppclapfunction %maybe-fixnum-from-one-or-two-digit-bignum ((bignum arg_z))
243  (ld imm1 ppc64::misc-header-offset bignum)
244  (cmpdi cr1 imm1 ppc64::one-digit-bignum-header)
245  (cmpdi cr2 imm1 ppc64::two-digit-bignum-header)
246  (beq cr1 @one)
247  (bne cr2 @no)
248  (ld imm0 ppc64::misc-data-offset bignum)
249  (rotldi imm0 imm0 32)
250  (box-fixnum arg_z imm0)
251  (unbox-fixnum imm1 arg_z)
252  (cmpd imm0 imm1)
253  (beqlr)
254  @no
255  (li arg_z nil)
256  (blr)
257  @one
258  (lwa imm0 ppc64::misc-data-offset bignum)
259  (box-fixnum arg_z imm0)
260  (blr))
261
262
263(defppclapfunction %digit-logical-shift-right ((digit arg_y) (count arg_z))
264  (unbox-fixnum imm0 digit)
265  (unbox-fixnum imm1 count)
266  (srw imm0 imm0 imm1)
267  (box-fixnum arg_z imm0)
268  (blr))
269
270(defppclapfunction %ashr ((digit arg_y) (count arg_z))
271  (unbox-fixnum imm0 digit)
272  (unbox-fixnum imm1 count)
273  (sraw imm0 imm0 imm1)
274  (box-fixnum arg_z imm0)
275  (blr))
276
277(defppclapfunction %ashl ((digit arg_y) (count arg_z))
278  (unbox-fixnum imm0 digit)
279  (unbox-fixnum imm1 count)
280  (slw imm0 imm0 imm1)
281  (clrlsldi arg_z imm0 32 ppc64::fixnumshift)
282  (blr))
283
284(defppclapfunction macptr->fixnum ((ptr arg_z))
285  (macptr-ptr imm0 ptr)
286  (andi. imm1 imm0 7)
287  (li arg_z nil)
288  (bne @done)
289  (mr arg_z imm0)
290  @done
291  (blr))
292
293(defppclapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
294  (let ((w1 imm0)
295        (w2 imm1))
296    (ld w2 ppc64::misc-data-offset big)
297    (unbox-fixnum  w1 fix)
298    (rotldi w2 w2 32)
299    (cmpdi dest nil)
300    (and w1 w1 w2)
301    (bne @store)
302    (box-fixnum arg_z w1)
303    (blr)
304    @store
305    (rotldi w1 w1 32)
306    (std w1 ppc64::misc-data-offset dest)
307    (blr)))
308
309
310
311(defppclapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z))
312  (cmpdi dest nil)
313  (ld imm1 ppc64::misc-data-offset big)
314  (unbox-fixnum imm0 fix)
315  (rotldi imm1 imm1 32)
316  (andc imm1 imm0 imm1)
317  (bne @store)
318  (box-fixnum arg_z imm1)
319  (blr)
320  @store
321  (rotldi imm1 imm1 32)
322  (std imm1 ppc64::misc-data-offset dest)
323  (blr))
324
325(defppclapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z))
326  (cmpdi dest nil)
327  (ld imm1 ppc64::misc-data-offset big)
328  (unbox-fixnum imm0 fix)
329  (rotldi imm1 imm1 32)
330  (andc imm1 imm1 imm0)
331  (bne @store)
332  (box-fixnum arg_z imm1)
333  (blr)
334  @store
335  (rotldi imm1 imm1 32)
336  (std imm1 ppc64::misc-data-offset dest)
337  (blr))
338
339
Note: See TracBrowser for help on using the repository browser.