source: branches/x8664-call/ccl/level-0/X86/X8664/x8664-bignum.lisp @ 6370

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

LAP changes to support new x86-64 calling sequence (multiple-values,
CLOS lexpr stuff, etc.)

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