source: branches/working-0711/ccl/level-0/X86/X8664/x8664-bignum.lisp @ 12973

Last change on this file since 12973 was 12973, checked in by gz, 10 years ago

Faster bignum multiplication (r12839, r12847, r12850)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.7 KB
Line 
1;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2006, Clozure Associates
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(defx86lapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))
25  (movq (% fixnum) (% arg_x))
26  (shl ($ (- 32 x8664::fixnumshift)) (% arg_x))
27  (sar ($ (- 32 x8664::fixnumshift)) (% arg_x))
28  (unbox-fixnum fixnum imm0)
29  (cmp (% arg_x) (% fixnum))
30  (je @chop)
31  (movq (% imm0)  (@ x8664::misc-data-offset (% bignum)))
32  (single-value-return)
33  @chop
34  (movq ($ x8664::one-digit-bignum-header) (@ x8664::misc-header-offset (% bignum)))
35  (movl (% imm0.l) (@ x8664::misc-data-offset (% bignum)))
36  (single-value-return))
37 
38;; multiply x[i] by y and add to result starting at digit idx
39(defx86lapfunction %multiply-and-add-loop
40    ((x 16) (y 8) #|(ra 0)|# (r arg_x) (idx arg_y) (ylen arg_z))
41  (let ((cc mm2)
42        (xx mm3)
43        (yy mm4)
44        (rr mm5)
45        (i imm0)
46        (j imm1))
47    (unbox-fixnum idx i)
48    (movq (@ x (% rsp)) (% temp0))
49    (movd (@ x8664::misc-data-offset (% temp0) (% i) 4) (% xx)) ;x[i]
50    (movq (@ y (% rsp)) (% temp0))
51    (movq (% r) (% temp1))
52    (pxor (% cc) (% cc))
53    (xorq (% j) (% j))
54    @loop
55    (movd (@ x8664::misc-data-offset (% temp0) (% j) 4) (% yy)) ;y[j]
56    (pmuludq (% xx) (% yy))
57    ;; 64-bit product now in %yy
58    (movd (@ x8664::misc-data-offset (% temp1) (% i) 4) (% rr))
59    ;; add in digit from r[i]
60    (paddq (% yy) (% rr))
61    ;; add in carry
62    (paddq (% cc) (% rr))
63    (movd (% rr) (@ x8664::misc-data-offset (% temp1) (% i) 4)) ;update r[i]
64    (movq (% rr) (% cc))
65    (psrlq ($ 32) (% cc))               ;get carry digit into low word
66    (addq ($ 1) (% i))
67    (addq ($ 1) (% j))
68    (subq ($ '1) (% ylen))
69    (jg @loop)
70    (movd (% cc) (@ x8664::misc-data-offset (% temp1) (% i) 4))
71    (single-value-return 4)))
72
73(defx86lapfunction %multiply-and-add-loop64
74    ((xs 16) (ys 8) #|(ra 0)|# (r arg_x) (i arg_y) (ylen arg_z))
75  (let ((y temp2)
76        (j temp0)
77        (c imm2))
78    (movq (@ xs (% rsp)) (% temp0))
79    (movq (@ x8664::misc-data-offset (% temp0) (% i)) (% mm0)) ;x[i]
80    (movq (@ ys (% rsp)) (% y))
81    (xorl (%l j) (%l j))
82    (xorl (%l c) (%l c))
83    @loop
84    ;; It's a pity to have to reload this every time, but there's no
85    ;; imm3.  (Give him 16 registers, and he still complains...)
86    (movd (% mm0) (% rax))
87    (mulq (@ x8664::misc-data-offset (% y) (% j))) ;128-bit x * y[j] in rdx:rax
88    (addq (@ x8664::misc-data-offset (% r) (% i)) (% rax)) ;add in r[i]
89    (adcq ($ 0) (% rdx))
90    ;; add in carry digit
91    (addq (% c) (% rax))
92    (movl ($ 0) (%l c))
93    (adcq (% rdx) (% c))                                   ;new carry digit
94    (movq (% rax) (@ x8664::misc-data-offset (% r) (% i))) ;update r[i]
95    (addq ($ '1) (% i))
96    (addq ($ '1) (% j))
97    (subq ($ '1) (% ylen))
98    (ja @loop)
99    (movq (% c) (@ x8664::misc-data-offset (% r) (% i)))
100    (single-value-return 4)))
101
102;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.
103;;; Add the 32-bit "prev" digit and the 32-bit carry-in digit to that 64-bit
104;;; result; return the halves as (VALUES high low).
105(defx86lapfunction %multiply-and-add4 ((x 8) #|(ra 0)|# (y arg_x) (prev arg_y) (carry-in arg_z))
106  (let ((unboxed-x imm0)
107        (unboxed-y imm1)
108        (unboxed-prev imm0)
109        (unboxed-carry-in imm0)
110        (unboxed-low imm0)
111        (high arg_y)
112        (low arg_z))
113    (pop (% ra0))
114    (popq (% temp0))
115    (discard-reserved-frame)
116    (push (% ra0))
117    (unbox-fixnum temp0 unboxed-x)
118    (unbox-fixnum y unboxed-y)
119    (mull (%l unboxed-y))
120    (shlq ($ 32) (% unboxed-y))
121    (orq (% unboxed-x) (% unboxed-y))   ; I got yer 64-bit product right here
122    (unbox-fixnum prev unboxed-prev)
123    (addq (% unboxed-prev) (% unboxed-y))
124    (unbox-fixnum carry-in unboxed-carry-in)
125    (addq (% unboxed-carry-in) (% unboxed-y))
126    (movl (%l unboxed-y) (%l unboxed-low))
127    (box-fixnum unboxed-low low)
128    (shr ($ 32) (% unboxed-y))
129    (box-fixnum unboxed-y high)
130    (movq (% rsp) (% temp0))
131    (pushq (% high))
132    (pushq (% low))
133    (set-nargs 2)
134    (jmp-subprim .SPvalues)))
135
136(defx86lapfunction %multiply-and-add3 ((x arg_x) (y arg_y) (carry-in arg_z))
137  (let ((unboxed-x imm0)
138        (unboxed-y imm1)
139        (unboxed-carry-in imm0)
140        (unboxed-low imm0)
141        (high arg_y)
142        (low arg_z))
143    (unbox-fixnum arg_x unboxed-x)
144    (unbox-fixnum y unboxed-y)
145    (mull (%l unboxed-y))
146    (shlq ($ 32) (% unboxed-y))
147    (orq (% unboxed-x) (% unboxed-y))
148    (unbox-fixnum carry-in unboxed-carry-in)
149    (addq (% unboxed-carry-in) (% unboxed-y))
150    (movl (%l unboxed-y) (%l unboxed-low))
151    (box-fixnum unboxed-low low)
152    (shr ($ 32) (% unboxed-y))
153    (box-fixnum unboxed-y high)
154    (movq (% rsp) (% temp0))
155    (pushq (% high))
156    (pushq (% low))
157    (set-nargs 2)
158    (jmp-subprim .SPvalues)))
159
160;;; Return the (possibly truncated) 32-bit quotient and remainder
161;;; resulting from dividing hi:low by divisor.
162(defx86lapfunction %floor ((num-high arg_x) (num-low arg_y) (divisor arg_z))
163  (let ((unboxed-high imm1)
164        (unboxed-low imm0)
165        (unboxed-quo imm0)
166        (unboxed-rem imm1)
167        (unboxed-divisor imm2))
168    (unbox-fixnum divisor unboxed-divisor)
169    (unbox-fixnum num-high unboxed-high)
170    (unbox-fixnum num-low unboxed-low)
171    (divl (%l unboxed-divisor))
172    (box-fixnum unboxed-quo arg_y)
173    (box-fixnum unboxed-rem arg_z)
174    (movq (% rsp) (% temp0))
175    (pushq (% arg_y))
176    (pushq (% arg_z))
177    (set-nargs 2)
178    (jmp-subprim .SPvalues)))
179
180;;; Multiply two (UNSIGNED-BYTE 32) arguments, return the high and
181;;; low halves of the 64-bit result
182(defx86lapfunction %multiply ((x arg_y) (y arg_z))
183  (let ((unboxed-x imm0)
184        (unboxed-y imm1)
185        (unboxed-high imm1)
186        (unboxed-low imm0))
187    (unbox-fixnum x unboxed-x)
188    (unbox-fixnum y unboxed-y)
189    (mull (%l unboxed-y))
190    (box-fixnum unboxed-high arg_y)
191    (box-fixnum unboxed-low arg_z)
192    (movq (% rsp) (% temp0))
193    (pushq (% arg_y))
194    (pushq (% arg_z))
195    (set-nargs 2)
196    (jmp-subprim .SPvalues)))
197
198;;; Any words in the "tail" of the bignum should have been
199;;; zeroed by the caller.
200(defx86lapfunction %set-bignum-length ((newlen arg_y) (bignum arg_z))
201  (movq (% newlen) (% imm0))
202  (shl ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% imm0))
203  (movb ($ x8664::subtag-bignum) (%b imm0))
204  (movq (% imm0) (@ x8664::misc-header-offset (% bignum)))
205  (single-value-return))
206
207;;; Count the sign bits in the most significant digit of bignum;
208;;; return fixnum count.
209(defx86lapfunction %bignum-sign-bits ((bignum arg_z))
210  (vector-size bignum imm0 imm0)
211  (movl (@ (- x8664::misc-data-offset 4) (% bignum) (% imm0) 4) (%l imm0))
212  (movl (% imm0.l) (% imm1.l))
213  (notl (% imm0.l))
214  (testl (% imm1.l) (% imm1.l))
215  (js @wasneg)
216  (notl (% imm0.l)) 
217  @wasneg
218  (bsrl (% imm0.l) (% imm0.l))
219  (sete (% imm1.b))
220  (xorl ($ 31) (% imm0))
221  (addb (% imm1.b) (% imm0.b))
222  (box-fixnum imm0 arg_z)
223  (single-value-return))
224
225(defx86lapfunction %signed-bignum-ref ((bignum arg_y) (index arg_z))
226  (uuo-error-debug-trap)
227  (unbox-fixnum index imm0)
228  (movslq (@ x8664::misc-data-offset (% bignum) (% imm0) 4) (% imm0))
229  (box-fixnum imm0 arg_z)
230  (single-value-return))
231
232
233;;; If the bignum is a one-digit bignum, return the value of the
234;;; single digit as a fixnum.  Otherwise, if it's a two-digit-bignum
235;;; and the two words of the bignum can be represented in a fixnum,
236;;; return that fixnum; else return nil.
237(defx86lapfunction %maybe-fixnum-from-one-or-two-digit-bignum ((bignum arg_z))
238  (getvheader bignum imm1)
239  (cmpq ($ x8664::one-digit-bignum-header) (% imm1))
240  (je @one)
241  (cmpq ($ x8664::two-digit-bignum-header) (% imm1))
242  (jne @no)
243  (movq (@ x8664::misc-data-offset (% bignum)) (% imm0))
244  (box-fixnum imm0 arg_z)
245  (unbox-fixnum arg_z imm1)
246  (cmpq (% imm0) (% imm1))
247  (je @done)
248  @no
249  (movq ($ nil) (% arg_z))
250  (single-value-return)
251  @one
252  (movslq (@ x8664::misc-data-offset (% bignum)) (% imm0))
253  (box-fixnum imm0 arg_z)
254  @done
255  (single-value-return))
256
257;;; Again, we're out of imm regs: a variable shift count has to go in %cl.
258;;; Make sure that the rest of %rcx is 0, to keep the GC happy.
259;;; %rcx == temp2
260(defx86lapfunction %digit-logical-shift-right ((digit arg_y) (count arg_z))
261  (unbox-fixnum digit imm0)
262  (unbox-fixnum count imm2)
263  (shrq (% imm2.b) (% imm0))
264  (box-fixnum imm0 arg_z)
265  (single-value-return))
266
267
268
269(defx86lapfunction %ashr ((digit arg_y) (count arg_z))
270  (unbox-fixnum digit imm0)
271  (unbox-fixnum count imm2)
272  (movslq (%l imm0) (% imm0))
273  (sarq (% imm2.b) (% imm0))
274  (box-fixnum imm0 arg_z)
275  (single-value-return))
276
277(defx86lapfunction %ashl ((digit arg_y) (count arg_z))
278  (unbox-fixnum digit imm0)
279  (unbox-fixnum count imm2)
280  (shlq (% imm2.b) (% imm0))
281  (movl (%l imm0) (%l imm0))            ;zero-extend
282  (box-fixnum imm0 arg_z)
283  (single-value-return))
284
285(defx86lapfunction macptr->fixnum ((ptr arg_z))
286  (macptr-ptr arg_z ptr)
287  (single-value-return))
288
289(defx86lapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
290  (let ((w1 imm0)
291        (w2 imm1))
292    (movq (@ x8664::misc-data-offset (% big)) (% w2))
293    (unbox-fixnum  fix w1)
294    (andq (% w2) (% w1))
295    (cmp-reg-to-nil dest)
296    (jne @store)
297    (box-fixnum w1 arg_z)
298    (single-value-return)
299    @store
300    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
301    (single-value-return)))
302
303(defx86lapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z))
304  (let ((w1 imm0)
305        (w2 imm1))
306    (movq (@ x8664::misc-data-offset (% big)) (% w2))
307    (unbox-fixnum  fix w1)
308    (notq (% w2))
309    (andq (% w2) (% w1))
310    (cmp-reg-to-nil dest)
311    (jne @store)
312    (box-fixnum w1 arg_z)
313    (single-value-return)
314    @store
315    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
316    (single-value-return)))
317
318
319(defx86lapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z))
320  (let ((w1 imm0)
321        (w2 imm1))
322    (movq (@ x8664::misc-data-offset (% big)) (% w2))
323    (unbox-fixnum  fix w1)
324    (notq (% w1))
325    (andq (% w2) (% w1))
326    (cmp-reg-to-nil dest)
327    (jne @store)
328    (box-fixnum w1 arg_z)
329    (single-value-return)
330    @store
331    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
332    (single-value-return)))
333
334
335
Note: See TracBrowser for help on using the repository browser.