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

Last change on this file since 11164 was 11164, checked in by gz, 11 years ago

Another batch of changes from the trunk, some bug fixes, optimizations, as well as formatting unification

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.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
74;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.
75;;; Add the 32-bit "prev" digit and the 32-bit carry-in digit to that 64-bit
76;;; result; return the halves as (VALUES high low).
77(defx86lapfunction %multiply-and-add4 ((x 8) #|(ra 0)|# (y arg_x) (prev arg_y) (carry-in arg_z))
78  (let ((unboxed-x imm0)
79        (unboxed-y imm1)
80        (unboxed-prev imm0)
81        (unboxed-carry-in imm0)
82        (unboxed-low imm0)
83        (high arg_y)
84        (low arg_z))
85    (pop (% ra0))
86    (popq (% temp0))
87    (discard-reserved-frame)
88    (push (% ra0))
89    (unbox-fixnum temp0 unboxed-x)
90    (unbox-fixnum y unboxed-y)
91    (mull (%l unboxed-y))
92    (shlq ($ 32) (% unboxed-y))
93    (orq (% unboxed-x) (% unboxed-y))   ; I got yer 64-bit product right here
94    (unbox-fixnum prev unboxed-prev)
95    (addq (% unboxed-prev) (% unboxed-y))
96    (unbox-fixnum carry-in unboxed-carry-in)
97    (addq (% unboxed-carry-in) (% unboxed-y))
98    (movl (%l unboxed-y) (%l unboxed-low))
99    (box-fixnum unboxed-low low)
100    (shr ($ 32) (% unboxed-y))
101    (box-fixnum unboxed-y high)
102    (movq (% rsp) (% temp0))
103    (pushq (% high))
104    (pushq (% low))
105    (set-nargs 2)
106    (jmp-subprim .SPvalues)))
107
108(defx86lapfunction %multiply-and-add3 ((x arg_x) (y arg_y) (carry-in arg_z))
109  (let ((unboxed-x imm0)
110        (unboxed-y imm1)
111        (unboxed-carry-in imm0)
112        (unboxed-low imm0)
113        (high arg_y)
114        (low arg_z))
115    (unbox-fixnum arg_x unboxed-x)
116    (unbox-fixnum y unboxed-y)
117    (mull (%l unboxed-y))
118    (shlq ($ 32) (% unboxed-y))
119    (orq (% unboxed-x) (% unboxed-y))
120    (unbox-fixnum carry-in unboxed-carry-in)
121    (addq (% unboxed-carry-in) (% unboxed-y))
122    (movl (%l unboxed-y) (%l unboxed-low))
123    (box-fixnum unboxed-low low)
124    (shr ($ 32) (% unboxed-y))
125    (box-fixnum unboxed-y high)
126    (movq (% rsp) (% temp0))
127    (pushq (% high))
128    (pushq (% low))
129    (set-nargs 2)
130    (jmp-subprim .SPvalues)))
131
132;;; Return the (possibly truncated) 32-bit quotient and remainder
133;;; resulting from dividing hi:low by divisor.
134(defx86lapfunction %floor ((num-high arg_x) (num-low arg_y) (divisor arg_z))
135  (let ((unboxed-high imm1)
136        (unboxed-low imm0)
137        (unboxed-quo imm0)
138        (unboxed-rem imm1)
139        (unboxed-divisor imm2))
140    (unbox-fixnum divisor unboxed-divisor)
141    (unbox-fixnum num-high unboxed-high)
142    (unbox-fixnum num-low unboxed-low)
143    (divl (%l unboxed-divisor))
144    (box-fixnum unboxed-quo arg_y)
145    (box-fixnum unboxed-rem arg_z)
146    (movq (% rsp) (% temp0))
147    (pushq (% arg_y))
148    (pushq (% arg_z))
149    (set-nargs 2)
150    (jmp-subprim .SPvalues)))
151
152;;; Multiply two (UNSIGNED-BYTE 32) arguments, return the high and
153;;; low halves of the 64-bit result
154(defx86lapfunction %multiply ((x arg_y) (y arg_z))
155  (let ((unboxed-x imm0)
156        (unboxed-y imm1)
157        (unboxed-high imm1)
158        (unboxed-low imm0))
159    (unbox-fixnum x unboxed-x)
160    (unbox-fixnum y unboxed-y)
161    (mull (%l unboxed-y))
162    (box-fixnum unboxed-high arg_y)
163    (box-fixnum unboxed-low arg_z)
164    (movq (% rsp) (% temp0))
165    (pushq (% arg_y))
166    (pushq (% arg_z))
167    (set-nargs 2)
168    (jmp-subprim .SPvalues)))
169
170;;; Any words in the "tail" of the bignum should have been
171;;; zeroed by the caller.
172(defx86lapfunction %set-bignum-length ((newlen arg_y) (bignum arg_z))
173  (movq (% newlen) (% imm0))
174  (shl ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% imm0))
175  (movb ($ x8664::subtag-bignum) (%b imm0))
176  (movq (% imm0) (@ x8664::misc-header-offset (% bignum)))
177  (single-value-return))
178
179;;; Count the sign bits in the most significant digit of bignum;
180;;; return fixnum count.
181(defx86lapfunction %bignum-sign-bits ((bignum arg_z))
182  (vector-size bignum imm0 imm0)
183  (movl (@ (- x8664::misc-data-offset 4) (% bignum) (% imm0) 4) (%l imm0))
184  (movl (% imm0.l) (% imm1.l))
185  (notl (% imm0.l))
186  (testl (% imm1.l) (% imm1.l))
187  (js @wasneg)
188  (notl (% imm0.l)) 
189  @wasneg
190  (bsrl (% imm0.l) (% imm0.l))
191  (sete (% imm1.b))
192  (xorl ($ 31) (% imm0))
193  (addb (% imm1.b) (% imm0.b))
194  (box-fixnum imm0 arg_z)
195  (single-value-return))
196
197(defx86lapfunction %signed-bignum-ref ((bignum arg_y) (index arg_z))
198  (uuo-error-debug-trap)
199  (unbox-fixnum index imm0)
200  (movslq (@ x8664::misc-data-offset (% bignum) (% imm0) 4) (% imm0))
201  (box-fixnum imm0 arg_z)
202  (single-value-return))
203
204
205;;; If the bignum is a one-digit bignum, return the value of the
206;;; single digit as a fixnum.  Otherwise, if it's a two-digit-bignum
207;;; and the two words of the bignum can be represented in a fixnum,
208;;; return that fixnum; else return nil.
209(defx86lapfunction %maybe-fixnum-from-one-or-two-digit-bignum ((bignum arg_z))
210  (getvheader bignum imm1)
211  (cmpq ($ x8664::one-digit-bignum-header) (% imm1))
212  (je @one)
213  (cmpq ($ x8664::two-digit-bignum-header) (% imm1))
214  (jne @no)
215  (movq (@ x8664::misc-data-offset (% bignum)) (% imm0))
216  (box-fixnum imm0 arg_z)
217  (unbox-fixnum arg_z imm1)
218  (cmpq (% imm0) (% imm1))
219  (je @done)
220  @no
221  (movq ($ nil) (% arg_z))
222  (single-value-return)
223  @one
224  (movslq (@ x8664::misc-data-offset (% bignum)) (% imm0))
225  (box-fixnum imm0 arg_z)
226  @done
227  (single-value-return))
228
229;;; Again, we're out of imm regs: a variable shift count has to go in %cl.
230;;; Make sure that the rest of %rcx is 0, to keep the GC happy.
231;;; %rcx == temp2
232(defx86lapfunction %digit-logical-shift-right ((digit arg_y) (count arg_z))
233  (unbox-fixnum digit imm0)
234  (unbox-fixnum count imm2)
235  (shrq (% imm2.b) (% imm0))
236  (box-fixnum imm0 arg_z)
237  (single-value-return))
238
239
240
241(defx86lapfunction %ashr ((digit arg_y) (count arg_z))
242  (unbox-fixnum digit imm0)
243  (unbox-fixnum count imm2)
244  (movslq (%l imm0) (% imm0))
245  (sarq (% imm2.b) (% imm0))
246  (box-fixnum imm0 arg_z)
247  (single-value-return))
248
249(defx86lapfunction %ashl ((digit arg_y) (count arg_z))
250  (unbox-fixnum digit imm0)
251  (unbox-fixnum count imm2)
252  (shlq (% imm2.b) (% imm0))
253  (movl (%l imm0) (%l imm0))            ;zero-extend
254  (box-fixnum imm0 arg_z)
255  (single-value-return))
256
257(defx86lapfunction macptr->fixnum ((ptr arg_z))
258  (macptr-ptr arg_z ptr)
259  (single-value-return))
260
261(defx86lapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
262  (let ((w1 imm0)
263        (w2 imm1))
264    (movq (@ x8664::misc-data-offset (% big)) (% w2))
265    (unbox-fixnum  fix w1)
266    (andq (% w2) (% w1))
267    (cmp-reg-to-nil dest)
268    (jne @store)
269    (box-fixnum w1 arg_z)
270    (single-value-return)
271    @store
272    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
273    (single-value-return)))
274
275(defx86lapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z))
276  (let ((w1 imm0)
277        (w2 imm1))
278    (movq (@ x8664::misc-data-offset (% big)) (% w2))
279    (unbox-fixnum  fix w1)
280    (notq (% w2))
281    (andq (% w2) (% w1))
282    (cmp-reg-to-nil dest)
283    (jne @store)
284    (box-fixnum w1 arg_z)
285    (single-value-return)
286    @store
287    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
288    (single-value-return)))
289
290
291(defx86lapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z))
292  (let ((w1 imm0)
293        (w2 imm1))
294    (movq (@ x8664::misc-data-offset (% big)) (% w2))
295    (unbox-fixnum  fix w1)
296    (notq (% w1))
297    (andq (% w2) (% w1))
298    (cmp-reg-to-nil dest)
299    (jne @store)
300    (box-fixnum w1 arg_z)
301    (single-value-return)
302    @store
303    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
304    (single-value-return)))
305
306
307
Note: See TracBrowser for help on using the repository browser.