source: trunk/ccl/level-0/X86/X8664/x8664-bignum.lisp @ 4826

Last change on this file since 4826 was 4153, checked in by gb, 15 years ago

Remove some breakpoints.

  • 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) 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
39
40;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.
41;;; Add the 32-bit "prev" digit and the 32-bit carry-in digit to that 64-bit
42;;; result; return the halves as (VALUES high low).
43(defx86lapfunction %multiply-and-add4 ((x 0) (y arg_x) (prev arg_y) (carry-in arg_z))
44  (let ((unboxed-x imm0)
45        (unboxed-y imm1)
46        (unboxed-prev imm0)
47        (unboxed-carry-in imm0)
48        (unboxed-low imm0)
49        (high arg_y)
50        (low arg_z))
51    (popq (% temp0))
52    (discard-reserved-frame)
53    (unbox-fixnum temp0 unboxed-x)
54    (unbox-fixnum y unboxed-y)
55    (mull (%l unboxed-y))
56    (shlq ($ 32) (% unboxed-y))
57    (orq (% unboxed-x) (% unboxed-y))   ; I got yer 64-bit product right here
58    (unbox-fixnum prev unboxed-prev)
59    (addq (% unboxed-prev) (% unboxed-y))
60    (unbox-fixnum carry-in unboxed-carry-in)
61    (addq (% unboxed-carry-in) (% unboxed-y))
62    (movl (%l unboxed-y) (%l unboxed-low))
63    (box-fixnum unboxed-low low)
64    (shr ($ 32) (% unboxed-y))
65    (box-fixnum unboxed-y high)
66    (pushq (% high))
67    (pushq (% low))
68    (set-nargs 2)
69    (leaq (@ '2 (% rsp)) (% temp0))
70    (jmp-subprim .SPvalues)))
71
72(defx86lapfunction %multiply-and-add3 ((x arg_x) (y arg_y) (carry-in arg_z))
73  (let ((unboxed-x imm0)
74        (unboxed-y imm1)
75        (unboxed-carry-in imm0)
76        (unboxed-low imm0)
77        (high arg_y)
78        (low arg_z))
79    (unbox-fixnum arg_x unboxed-x)
80    (unbox-fixnum y unboxed-y)
81    (mull (%l unboxed-y))
82    (shlq ($ 32) (% unboxed-y))
83    (orq (% unboxed-x) (% unboxed-y))
84    (unbox-fixnum carry-in unboxed-carry-in)
85    (addq (% unboxed-carry-in) (% unboxed-y))
86    (movl (%l unboxed-y) (%l unboxed-low))
87    (box-fixnum unboxed-low low)
88    (shr ($ 32) (% unboxed-y))
89    (box-fixnum unboxed-y high)
90    (pushq (% high))
91    (pushq (% low))
92    (set-nargs 2)
93    (leaq (@ '2 (% rsp)) (% temp0))
94    (jmp-subprim .SPvalues)))
95
96;;; Return the (possibly truncated) 32-bit quotient and remainder
97;;; resulting from dividing hi:low by divisor.
98;;; We only have two immediate registers, and -have- to use them
99;;; to represent hi:low.  We -can- store the unboxed divisor in
100;;; %ebp, if we commit to the idea that %rbp will never be traced
101;;; by the GC.  I'm willing to commit to that for x8664, since
102;;; this is an example of not having enough imm regs.  We do need
103;;; to save/restore %rbp, but hopefully we can do wo without
104;;; hitting memory.
105;;; For x8632, we'll probably have to mark something (%ecx ?) as
106;;; being "temporarily unboxed" by mucking with some bits in the
107;;; TCR.
108(defx86lapfunction %floor ((num-high arg_x) (num-low arg_y) (divisor arg_z))
109  (let ((unboxed-high imm1)
110        (unboxed-low imm0)
111        (unboxed-divisor ebp)
112        (unboxed-quo imm0)
113        (unboxed-rem imm1))
114    (movd (% rbp) (% mm0))
115    (unbox-fixnum divisor rbp)
116    (unbox-fixnum num-high unboxed-high)
117    (unbox-fixnum num-low unboxed-low)
118    (divl (% ebp))
119    (movd (% mm0) (% rbp))
120    (box-fixnum unboxed-quo arg_y)
121    (box-fixnum unboxed-rem arg_z)
122    (movq (% rsp) (% temp0))
123    (pushq (% arg_y))
124    (pushq (% arg_z))
125    (set-nargs 2)
126    (jmp-subprim .SPvalues)))
127
128;;; Multiply two (UNSIGNED-BYTE 32) arguments, return the high and
129;;; low halves of the 64-bit result
130(defx86lapfunction %multiply ((x arg_y) (y arg_z))
131  (let ((unboxed-x imm0)
132        (unboxed-y imm1)
133        (unboxed-high imm1)
134        (unboxed-low imm0))
135    (unbox-fixnum x unboxed-x)
136    (unbox-fixnum y unboxed-y)
137    (mull (%l unboxed-y))
138    (box-fixnum unboxed-high arg_y)
139    (box-fixnum unboxed-low arg_z)
140    (movq (% rsp) (% temp0))
141    (pushq (% arg_y))
142    (pushq (% arg_z))
143    (set-nargs 2)
144    (jmp-subprim .SPvalues)))
145
146;;; Any words in the "tail" of the bignum should have been
147;;; zeroed by the caller.
148(defx86lapfunction %set-bignum-length ((newlen arg_y) (bignum arg_z))
149  (movq (% newlen) (% imm0))
150  (shl ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% imm0))
151  (movb ($ x8664::subtag-bignum) (%b imm0))
152  (movq (% imm0) (@ x8664::misc-header-offset (% bignum)))
153  (single-value-return))
154
155;;; Count the sign bits in the most significant digit of bignum;
156;;; return fixnum count.
157(defx86lapfunction %bignum-sign-bits ((bignum arg_z))
158  (vector-size bignum imm0 imm0)
159  (movl (@ (- x8664::misc-data-offset 4) (% bignum) (% imm0) 4) (%l imm0))
160  (movl (% imm0.l) (% imm1.l))
161  (notl (% imm0.l))
162  (testl (% imm1.l) (% imm1.l))
163  (js @wasneg)
164  (notl (% imm0.l)) 
165  @wasneg
166  (bsrl (% imm0.l) (% imm0.l))
167  (sete (% imm1.b))
168  (xorl ($ 31) (% imm0))
169  (addb (% imm1.b) (% imm0.b))
170  (box-fixnum imm0 arg_z)
171  (single-value-return))
172
173(defx86lapfunction %signed-bignum-ref ((bignum arg_y) (index arg_z))
174  (uuo-error-debug-trap)
175  (unbox-fixnum index imm0)
176  (movslq (@ x8664::misc-data-offset (% bignum) (% imm0) 4) (% imm0))
177  (box-fixnum imm0 arg_z)
178  (single-value-return))
179
180
181;;; If the bignum is a one-digit bignum, return the value of the
182;;; single digit as a fixnum.  Otherwise, if it's a two-digit-bignum
183;;; and the two words of the bignum can be represented in a fixnum,
184;;; return that fixnum; else return nil.
185(defx86lapfunction %maybe-fixnum-from-one-or-two-digit-bignum ((bignum arg_z))
186  (getvheader bignum imm1)
187  (cmpq ($ x8664::one-digit-bignum-header) (% imm1))
188  (je @one)
189  (cmpq ($ x8664::two-digit-bignum-header) (% imm1))
190  (jne @no)
191  (movq (@ x8664::misc-data-offset (% bignum)) (% imm0))
192  (box-fixnum imm0 arg_z)
193  (unbox-fixnum arg_z imm1)
194  (cmpq (% imm0) (% imm1))
195  (je @done)
196  @no
197  (movq ($ nil) (% arg_z))
198  (single-value-return)
199  @one
200  (movslq (@ x8664::misc-data-offset (% bignum)) (% imm0))
201  (box-fixnum imm0 arg_z)
202  @done
203  (single-value-return))
204
205;;; Again, we're out of imm regs: a variable shift count has to go in %cl.
206;;; Make sure that the rest of %rcx is 0, to keep the GC happy.
207;;; %rcx == temp1
208(defx86lapfunction %digit-logical-shift-right ((digit arg_y) (count arg_z))
209  (unbox-fixnum digit imm0)
210  (unbox-fixnum count imm1)
211  (xorq (% temp2) (% temp2))
212  (movb (% imm1.b) (% temp2.b))
213  (shrq (% temp2.b) (% imm0))
214  (movb ($ 0) (% temp2.b))
215  (box-fixnum imm0 arg_z)
216  (single-value-return))
217
218(defx86lapfunction %ashr ((digit arg_y) (count arg_z))
219  (unbox-fixnum digit imm0)
220  (unbox-fixnum count imm1)
221  (movslq (%l imm0) (% imm0))
222  (xorq (% temp2) (% temp2))
223  (movb (% imm1.b) (% temp2.b))
224  (sarq (% temp2.b) (% imm0))
225  (movb ($ 0) (% temp2.b))
226  (box-fixnum imm0 arg_z)
227  (single-value-return))
228
229(defx86lapfunction %ashl ((digit arg_y) (count arg_z))
230  (unbox-fixnum digit imm0)
231  (unbox-fixnum count imm1)
232  (xorq (% temp2) (% temp2))
233  (movb (% imm1.b) (% temp2.b))
234  (shll (% temp2.b) (%l imm0))
235  (movb ($ 0) (% temp2.b)) 
236  (movl (%l imm0) (%l imm0))            ;zero-extend
237  (box-fixnum imm0 arg_z)
238  (single-value-return))
239
240(defx86lapfunction macptr->fixnum ((ptr arg_z))
241  (macptr-ptr arg_z ptr)
242  (single-value-return))
243
244(defx86lapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0
245  (let ((w1 imm0)
246        (w2 imm1))
247    (movq (@ x8664::misc-data-offset (% big)) (% w2))
248    (unbox-fixnum  fix w1)
249    (andq (% w2) (% w1))
250    (cmp-reg-to-nil dest)
251    (jne @store)
252    (box-fixnum w1 arg_z)
253    (single-value-return)
254    @store
255    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
256    (single-value-return)))
257
258(defx86lapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z))
259  (let ((w1 imm0)
260        (w2 imm1))
261    (movq (@ x8664::misc-data-offset (% big)) (% w2))
262    (unbox-fixnum  fix w1)
263    (notq (% w2))
264    (andq (% w2) (% w1))
265    (cmp-reg-to-nil dest)
266    (jne @store)
267    (box-fixnum w1 arg_z)
268    (single-value-return)
269    @store
270    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
271    (single-value-return)))
272
273
274(defx86lapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z))
275  (let ((w1 imm0)
276        (w2 imm1))
277    (movq (@ x8664::misc-data-offset (% big)) (% w2))
278    (unbox-fixnum  fix w1)
279    (notq (% w1))
280    (andq (% w2) (% w1))
281    (cmp-reg-to-nil dest)
282    (jne @store)
283    (box-fixnum w1 arg_z)
284    (single-value-return)
285    @store
286    (movq (% w1) (@ x8664::misc-data-offset (% dest)))
287    (single-value-return)))
288
289
290
Note: See TracBrowser for help on using the repository browser.