source: branches/working-0711/ccl/level-0/X86/x86-numbers.lisp @ 13546

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

From trunk: fix for truncate of most-positive-fixnum (r13529,r13530,r13531,r13532)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.6 KB
Line 
1;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18
19
20(in-package "CCL")
21#+x8664-target
22(progn
23
24
25
26(defx86lapfunction %fixnum-signum ((number arg_z))
27  (movq ($ '-1) (% arg_x))
28  (movq ($ '1) (% arg_y))
29  (testq (% number) (% number))
30  (cmovsq (% arg_x) (% arg_z))
31  (cmovnsq (% arg_y) (% arg_z))
32  (single-value-return))
33
34;;; see %logcount.
35(defx86lapfunction %ilogcount ((number arg_z))
36  (let ((rshift imm0)
37        (temp imm1))
38    (unbox-fixnum number rshift)
39    (xorq (% arg_z) (% arg_z))
40    (testq (% rshift) (% rshift))
41    (jmp @test)
42    @next
43    (lea (@ -1 (% rshift)) (% temp))
44    (and (% temp) (% rshift))            ; sets flags
45    (lea (@ '1 (% arg_z)) (% arg_z))    ; doesn't set flags
46    @test
47    (jne @next)
48    (single-value-return)))
49
50(defx86lapfunction %iash ((number arg_y) (count arg_z))
51  (unbox-fixnum count imm1)
52  (unbox-fixnum number imm0)
53  (xorq (% rcx) (% rcx))                ;rcx = imm2
54  (testq (% count) (% count))
55  (jge @left)
56  (subb (% imm1.b) (% cl))
57  (sar (% cl) (% imm0))
58  (box-fixnum imm0 arg_z)
59  (single-value-return)
60  @left
61  (movb (% imm1.b) (% cl))
62  (shl (% cl) (% number))
63  (movq (% number) (% arg_z))
64  (single-value-return))
65
66(defparameter *double-float-zero* 0.0d0)
67(defparameter *short-float-zero* 0.0s0)
68
69
70(defx86lapfunction %fixnum-intlen ((number arg_z))
71  (unbox-fixnum arg_z imm0)
72  (movq (% imm0) (% imm1))
73  (notq (% imm1))
74  (testq (% imm0) (% imm0))
75  (cmovsq (% imm1) (% imm0))
76  (bsrq (% imm0) (% imm0))
77  (setne (% imm1.b))
78  (addb (% imm1.b) (% imm0.b))
79  (box-fixnum imm0 arg_z)
80  (single-value-return))
81
82
83;;; Caller guarantees that result fits in a fixnum.
84
85(defx86lapfunction %truncate-double-float->fixnum ((arg arg_z))
86  (get-double-float arg fp1)
87  (cvttsd2si (% fp1) (% imm0))
88  (box-fixnum imm0 arg_z) 
89  (single-value-return))
90
91
92(defx86lapfunction %truncate-short-float->fixnum ((arg arg_z))
93  (get-single-float arg fp1)
94  (cvttss2si (% fp1) (% imm0))
95  (box-fixnum imm0 arg_z) 
96  (single-value-return))
97
98;;; DOES round to even
99
100(defx86lapfunction %round-nearest-double-float->fixnum ((arg arg_z))
101  (get-double-float arg fp1)
102  (cvtsd2si (% fp1) (% imm0))
103  (box-fixnum imm0 arg_z) 
104  (single-value-return))
105
106
107(defx86lapfunction %round-nearest-short-float->fixnum ((arg arg_z))
108  (get-single-float arg fp1)
109  (cvtss2si (% fp1) (% imm0))
110  (box-fixnum imm0 arg_z) 
111  (single-value-return))
112
113
114
115;;; We'll get a SIGFPE if divisor is 0.
116;;; Don't use %rbp.  Trust callback_for_interrupt() to preserve
117;;; the word below the stack pointer
118(defx86lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
119  (save-simple-frame)
120  (cmpq ($ '-1) (% divisor))
121  (je @neg)
122  (unbox-fixnum divisor imm0)
123  (movq (% imm0) (% imm2))
124  (unbox-fixnum dividend imm0)
125  (cqto)                                ; imm1 := sign_extend(imm0)
126  (idivq (% imm2))
127  (pop (% rbp))
128  (movq (% rsp) (% temp0))
129  (box-fixnum imm1 arg_y)
130  (box-fixnum imm0 arg_z)
131  (pushq (% arg_z))
132  (pushq (% arg_y))
133  (set-nargs 2)
134  (jmp-subprim .SPvalues)
135  @neg
136  (negq (% dividend))
137  (load-constant *least-positive-bignum* arg_z)
138  (cmovoq (@ x8664::symbol.vcell (% arg_z)) (% dividend))
139  (pop (% rbp))
140  (movq (% rsp) (% temp0))
141  (pushq (% dividend))
142  (pushq ($ 0))
143  (set-nargs 2)
144  (jmp-subprim .SPvalues))
145 
146
147(defx86lapfunction called-for-mv-p ()
148  (ref-global ret1valaddr imm0)
149  (movq (@ x8664::lisp-frame.return-address (% rbp)) (% imm1))
150  (cmpq (% imm0) (% imm1))
151  (movq ($ t) (% imm0))
152  (movq ($ nil) (% arg_z))
153  (cmoveq (% imm0) (% arg_z))
154  (single-value-return))
155
156
157;;; n1 and n2 must be positive (esp non zero)
158(defx86lapfunction %fixnum-gcd ((boxed-u arg_y) (boxed-v arg_z))
159  (let ((u imm0)
160        (v imm1)
161        (k imm2))
162    (xorl (% imm2.l) (% imm2.l))
163    (bsfq (% boxed-u) (% u))
164    (bsfq (% boxed-v) (% v))
165    (rcmp (% u) (% v))
166    (cmovlel (%l u) (%l k))
167    (cmovgl (%l v) (%l k))
168    (unbox-fixnum boxed-u u)
169    (unbox-fixnum boxed-v v)
170    (subb ($ x8664::fixnumshift) (%b k))
171    (jz @start)
172    (shrq (% cl) (% u))
173    (shrq (% cl) (% v))
174    @start
175    ;; At least one of u or v is odd at this point
176    @loop
177    ;; if u is even, shift it right one bit
178    (testb ($ 1) (%b u))
179    (jne @u-odd)
180    (shrq ($ 1) (% u))
181    (jmp @test)
182    @u-odd
183    ;; if v is even, shift it right one bit
184    (testb ($ 1) (%b v))
185    (jne @both-odd)
186    (shrq ($ 1) (% v))
187    (jmp @test-u)
188    @both-odd
189    (cmpq (% v) (% u))
190    (jb @v>u)
191    (subq (% v) (% u))
192    (shrq ($ 1) (% u))
193    (jmp @test)
194    @v>u
195    (subq (% u) (% v))
196    (shrq ($ 1) (% v))
197    @test-u
198    (testq (% u) (% u))
199    @test
200    (ja @loop)
201    (shlq (% cl) (% v))
202    (movb ($ 0) (% cl))
203    (box-fixnum v arg_z)
204    (single-value-return)))
205
206(defx86lapfunction %mrg31k3p ((state arg_z))
207  (let ((seed temp0)
208        (m1 #x7fffffff)
209        (m2 #x7fffadb3)
210        (negative-m1 #x80000001)
211        (negative-m2 #x8000524d))
212    (svref state 1 seed)
213    (movl (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)) (% imm0.l))
214    (andl ($ #x1ff) (% imm0.l))
215    (shll ($ 22) (% imm0.l))
216    (movl (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)) (% imm1.l))
217    (shrl ($ 9) (% imm1.l))
218    (addl (% imm1.l) (% imm0.l))
219
220    (movl (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)) (% imm1.l))
221    (andl ($ #xffffff) (% imm1.l))
222    (shll ($ 7) (% imm1.l))
223    (addl (% imm1.l) (% imm0.l))
224    (movl (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)) (% imm1.l))
225    (shrl ($ 24) (% imm1.l))
226
227    (addl (% imm1.l) (% imm0.l))
228    (leal (@ negative-m1 (% imm0.l)) (% imm1.l))
229    (cmpl ($ m1) (% imm0.l))
230    (cmovael (% imm1.l) (% imm0.l))
231
232    (addl (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)) (% imm0.l))
233    (leal (@ negative-m1 (% imm0.l)) (% imm1.l))
234    (cmpl ($ m1) (% imm0.l))
235    (cmovael (% imm1.l) (% imm0.l))
236
237    ;; update state
238    (movl (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)) (% imm1.l))
239    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)))
240    (movl (@ (+ x8664::misc-data-offset (* 4 0)) (% seed)) (% imm1.l))
241    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)))
242    (movl (% imm0.l) (@ (+ x8664::misc-data-offset (* 4 0)) (% seed)))
243
244    ;; second component
245    (movl (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)) (% imm0.l))
246    (andl ($ #xffff) (% imm0.l))
247    (shll ($ 15) (% imm0.l))
248    (movl (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)) (% imm1.l))
249    (shrl ($ 16) (% imm1.l))
250    (imull ($ 21069) (% imm1.l) (% imm1.l))
251
252    (addl (% imm1.l) (% imm0.l))
253    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
254    (cmpl ($ m2) (% imm0.l))
255    (cmovael (% imm1.l) (% imm0.l))
256
257    (movl (% imm0.l) (% imm2.l))        ;stash t1
258
259    (movl (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)) (% imm0.l))
260    (andl ($ #xffff) (% imm0.l))
261    (shll ($ 15) (% imm0.l))
262    (movl (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)) (% imm1.l))
263    (shrl ($ 16) (% imm1.l))
264    (imull ($ 21069) (% imm1.l) (% imm1.l))
265
266    (addl (% imm1.l) (% imm0.l))
267    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
268    (cmpl ($ m2) (% imm0.l))
269    (cmovael (% imm1.l) (% imm0.l))
270
271    (addl (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)) (% imm0.l))
272    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
273    (cmpl ($ m2) (% imm0.l))
274    (cmovael (% imm1.l) (% imm0.l))
275
276    (addl (% imm2.l) (% imm0.l))        ;add in t1
277    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
278    (cmpl ($ m2) (% imm0.l))
279    (cmovael (% imm1.l) (% imm0.l))
280
281    ;; update state
282    (movl (@ (+ x8664::misc-data-offset (* 4 4)) (% seed)) (% imm1.l))
283    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)))
284    (movl (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)) (% imm1.l))
285    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 4)) (% seed)))
286    (movl (% imm0.l) (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)))
287
288    ;; combination
289    (movl (@ (+ x8664::misc-data-offset (* 4 0)) (% seed)) (% imm1.l))
290    (xchgl (% imm1.l) (% imm0.l))               ;for sanity
291    (rcmpl (% imm0.l) (% imm1.l))
292    (ja @ok)
293    (subl (% imm1.l) (% imm0.l))
294    (addl ($ m1) (% imm0.l))
295    (box-fixnum imm0 arg_z)
296    (single-value-return)
297    @ok
298    (subl (% imm1.l) (% imm0.l))
299    (box-fixnum imm0 arg_z)
300    (single-value-return)))
301
302;;; End of x86-numbers.lisp
303) ; #+x8664-target
Note: See TracBrowser for help on using the repository browser.