source: branches/acode-rewrite/source/level-0/X86/X8632/x8632-numbers.lisp

Last change on this file was 16005, checked in by Gary Byers, 11 years ago

%make-complex-single-float, %make-complex-double-float for x86.
Define some SSE/SSE2 instructions.
File size: 10.8 KB
RevLine 
[13067]1;;; Copyright 2009 Clozure Associates
2;;; This file is part of Clozure CL.
3;;;
4;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU
5;;; Public License , known as the LLGPL and distributed with Clozure
6;;; CL as the file "LICENSE". The LLGPL consists of a preamble and
7;;; the LGPL, which is distributed with Clozure CL as the file "LGPL".
8;;; Where these conflict, the preamble takes precedence.
9;;;
10;;; Clozure CL is referenced in the preamble as the "LIBRARY."
11;;;
12;;; The LLGPL is also available online at
13;;; http://opensource.franz.com/preamble.html
14
[7998]15(in-package "CCL")
16
17(defx8632lapfunction %fixnum-signum ((number arg_z))
18 (mov ($ '-1) (% temp0))
19 (mov ($ '1) (% temp1))
20 (test (% number) (% number))
21 (cmovs (% temp0) (% arg_z))
22 (cmovns (% temp1) (% arg_z))
23 (single-value-return))
24
25;;; see %logcount.
26(defx86lapfunction %ilogcount ((number arg_z))
27 (mark-as-imm temp0)
28 (let ((rshift imm0)
29 (temp temp0))
30 (unbox-fixnum number rshift)
31 (xor (% arg_z) (% arg_z))
32 (test (% rshift) (% rshift))
33 (jmp @test)
34 @next
35 (lea (@ -1 (% rshift)) (% temp))
36 (and (% temp) (% rshift)) ;sets flags
37 (lea (@ '1 (% arg_z)) (% arg_z)) ;doesn't set flags
38 @test
39 (jne @next))
40 (mark-as-node temp0)
41 (single-value-return))
42
43;;; might be able to get away with not marking ecx as imm.
44(defx8632lapfunction %iash ((number arg_y) (count arg_z))
45 (mark-as-imm ecx) ;aka temp0
46 (unbox-fixnum count ecx)
47 (test (% count) (% count))
48 (jge @left)
49 (negb (% cl))
50 (unbox-fixnum number imm0)
51 (sar (% cl) (% imm0))
52 (box-fixnum imm0 arg_z)
53 (mark-as-node ecx)
54 (single-value-return)
55 @left
56 (shl (% cl) (% number))
57 (movl (% number) (% arg_z))
58 (mark-as-node ecx)
59 (single-value-return))
60
61(defparameter *double-float-zero* 0.0d0)
62(defparameter *short-float-zero* 0.0s0)
63
64(defx8632lapfunction %sfloat-hwords ((sfloat arg_z))
65 (movl (% esp) (% temp0))
66 (movzwl (@ (+ 2 x8632::misc-data-offset) (% sfloat)) (% imm0))
67 (box-fixnum imm0 temp1)
68 (pushl (% temp1)) ;high
69 (movzwl (@ x8632::misc-data-offset (% sfloat)) (% imm0))
70 (box-fixnum imm0 temp1)
71 (pushl (% temp1)) ;low
72 (set-nargs 2)
73 (jmp-subprim .SPvalues))
74
75(defx8632lapfunction %fixnum-intlen ((number arg_z))
76 (mark-as-imm temp0)
77 (let ((imm1 temp0))
78 (unbox-fixnum arg_z imm0)
79 (mov (% imm0) (% imm1))
80 (not (% imm1))
81 (test (% imm0) (% imm0))
82 (cmovs (% imm1) (% imm0))
83 (bsrl (% imm0) (% imm0))
84 (setne (%b imm1))
85 (addb (%b imm1) (%b imm0))
86 (box-fixnum imm0 arg_z))
87 (mark-as-node temp0)
88 (single-value-return))
89
90;;; Caller guarantees that result fits in a fixnum.
91(defx8632lapfunction %truncate-double-float->fixnum ((arg arg_z))
92 (get-double-float arg fp1)
93 (cvttsd2si (% fp1) (% imm0))
94 (box-fixnum imm0 arg_z)
95 (single-value-return))
96
97(defx8632lapfunction %truncate-short-float->fixnum ((arg arg_z))
98 (get-single-float arg fp1)
99 (cvttss2si (% fp1) (% imm0))
100 (box-fixnum imm0 arg_z)
101 (single-value-return))
102
103;;; DOES round to even
104(defx8632lapfunction %round-nearest-double-float->fixnum ((arg arg_z))
105 (get-double-float arg fp1)
106 (cvtsd2si (% fp1) (% imm0))
107 (box-fixnum imm0 arg_z)
108 (single-value-return))
109
110(defx8632lapfunction %round-nearest-short-float->fixnum ((arg arg_z))
111 (get-single-float arg fp1)
112 (cvtss2si (% fp1) (% imm0))
113 (box-fixnum imm0 arg_z)
114 (single-value-return))
115
[13531]116
117
[7998]118;;; We'll get a SIGFPE if divisor is 0.
119(defx8632lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
[13531]120 (cmpl ($ '-1) (% divisor))
121 (je @neg)
[7998]122 (mark-as-imm temp0)
123 (mark-as-imm temp1)
124 (let ((imm2 temp0)
125 (imm1 temp1)) ;edx
126 (unbox-fixnum dividend imm0)
127 (unbox-fixnum divisor imm2)
128 (cltd) ;edx:eax = sign_extend(eax)
129 (idivl (% imm2))
130 (box-fixnum imm0 arg_z) ;quotient
131 (box-fixnum imm1 arg_y)) ;remainder
132 (mark-as-node temp0)
133 (mark-as-node temp1)
134 (movl (% esp) (% temp0))
135 (push (% arg_z))
136 (push (% arg_y))
137 (set-nargs 2)
[13531]138 (jmp-subprim .SPvalues)
139 @neg
140 (negl (% dividend))
141 (load-constant *least-positive-bignum* arg_z)
142 (cmovol (@ x8632::symbol.vcell (% arg_z)) (% dividend))
143 (movl (% esp) (% temp0))
144 (pushl (% dividend))
145 (pushl ($ 0))
146 (set-nargs 2)
[7998]147 (jmp-subprim .SPvalues))
148
149(defx8632lapfunction called-for-mv-p ()
150 (movl (@ x8632::lisp-frame.return-address (% ebp)) (% imm0))
[10959]151 (cmpl (% imm0) (@ (+ (target-nil-value) (x8632::kernel-global ret1valaddr))))
152 (movl ($ (target-t-value)) (% imm0))
153 (movl ($ (target-nil-value)) (% arg_z))
[7998]154 (cmove (% imm0) (% arg_z))
155 (single-value-return))
[8975]156
[7998]157;;; n1 and n2 must be positive (esp non zero)
158(defx86lapfunction %fixnum-gcd ((boxed-u arg_y) (boxed-v arg_z))
159 (mark-as-imm temp0)
160 (mark-as-imm temp1)
161 (let ((u imm0)
162 (v temp1)
163 (k temp0)) ;temp0 = ecx
164 (xorl (% k) (% k))
165 (bsfl (% boxed-u) (% u))
166 (bsfl (% boxed-v) (% v))
167 (rcmp (% u) (% v))
168 (cmovlel (%l u) (%l k))
169 (cmovgl (%l v) (%l k))
170 (unbox-fixnum boxed-u u)
171 (unbox-fixnum boxed-v v)
172 (subb ($ x8632::fixnumshift) (%b k))
173 (jz @start)
174 (shrl (% cl) (% u))
175 (shrl (% cl) (% v))
176 @start
177 ;; At least one of u or v is odd at this point
178 @loop
179 ;; if u is even, shift it right one bit
180 (testb ($ 1) (%b u))
181 (jne @u-odd)
182 (shrl ($ 1) (% u))
183 (jmp @test)
184 @u-odd
185 ;; if v is even, shift it right one bit
186 (testb ($ 1) (%b v))
187 (jne @both-odd)
188 (shrl ($ 1) (% v))
189 (jmp @test-u)
190 @both-odd
191 (cmpl (% v) (% u))
192 (jb @v>u)
193 (subl (% v) (% u))
194 (shrl ($ 1) (% u))
195 (jmp @test)
196 @v>u
197 (subl (% u) (% v))
198 (shrl ($ 1) (% v))
199 @test-u
200 (testl (% u) (% u))
201 @test
202 (ja @loop)
203 (shll (% cl) (% v))
204 (movb ($ 0) (% cl))
205 (box-fixnum v arg_z))
206 (mark-as-node temp0)
207 (mark-as-node temp1)
208 (single-value-return))
209
[13327]210(defx8632lapfunction %mrg31k3p ((state arg_z))
211 (let ((seed temp0)
212 (m1 #x7fffffff)
213 (m2 #x7fffadb3)
214 (negative-m1 #x80000001)
215 (negative-m2 #x8000524d)
216 (imm1 temp1))
217 (mark-as-imm temp1)
218 (svref state 1 seed)
219 (movl (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)) (% imm0))
220 (andl ($ #x1ff) (% imm0))
221 (shll ($ 22) (% imm0))
222 (movl (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)) (% imm1))
223 (shrl ($ 9) (% imm1))
224 (addl (% imm1) (% imm0))
225
226 (movl (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)) (% imm1))
227 (andl ($ #xffffff) (% imm1))
228 (shll ($ 7) (% imm1))
229 (addl (% imm1) (% imm0))
230 (movl (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)) (% imm1))
231 (shrl ($ 24) (% imm1))
232
233 (addl (% imm1) (% imm0))
234 (leal (@ negative-m1 (% imm0)) (% imm1))
235 (cmpl ($ m1) (% imm0))
236 (cmovael (% imm1) (% imm0))
237
238 (addl (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)) (% imm0))
239 (leal (@ negative-m1 (% imm0)) (% imm1))
240 (cmpl ($ m1) (% imm0))
241 (cmovael (% imm1) (% imm0))
242
243 ;; update state
244 (movl (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)) (% imm1))
245 (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)))
246 (movl (@ (+ x8632::misc-data-offset (* 4 0)) (% seed)) (% imm1))
247 (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)))
248 (movl (% imm0) (@ (+ x8632::misc-data-offset (* 4 0)) (% seed)))
249
250 ;; second component
251 (movzwl (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)) (% imm0))
252 ;(andl ($ #xffff) (% imm0))
253 (shll ($ 15) (% imm0))
254 (movl (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)) (% imm1))
255 (shrl ($ 16) (% imm1))
256 (imull ($ 21069) (% imm1) (% imm1))
257
258 (addl (% imm1) (% imm0))
259 (leal (@ negative-m2 (% imm0)) (% imm1))
260 (cmpl ($ m2) (% imm0))
261 (cmovael (% imm1) (% imm0))
262 (movl (% imm0) (:rcontext x8632::tcr.unboxed0)) ;stash t1
263
264 (movzwl (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)) (% imm0))
265 ;(andl ($ #xffff) (% imm0))
266 (shll ($ 15) (% imm0))
267 (movl (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)) (% imm1))
268 (shrl ($ 16) (% imm1))
269 (imull ($ 21069) (% imm1) (% imm1))
270
271 (addl (% imm1) (% imm0))
272 (leal (@ negative-m2 (% imm0)) (% imm1))
273 (cmpl ($ m2) (% imm0))
274 (cmovael (% imm1) (% imm0))
275
276 (addl (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)) (% imm0))
277 (leal (@ negative-m2 (% imm0)) (% imm1))
278 (cmpl ($ m2) (% imm0))
279 (cmovael (% imm1) (% imm0))
280
281 (addl (:rcontext x8632::tcr.unboxed0) (% imm0)) ;add in t1
282 (leal (@ negative-m2 (% imm0)) (% imm1))
283 (cmpl ($ m2) (% imm0))
284 (cmovael (% imm1) (% imm0))
285
286 ;; update state
287 (movl (@ (+ x8632::misc-data-offset (* 4 4)) (% seed)) (% imm1))
288 (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)))
289 (movl (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)) (% imm1))
290 (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 4)) (% seed)))
291 (movl (% imm0) (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)))
292
293 ;; combination
294 (movl (@ (+ x8632::misc-data-offset (* 4 0)) (% seed)) (% imm1))
295 (xchgl (% imm1) (% imm0)) ;for sanity
296 (rcmpl (% imm0) (% imm1))
297 (ja @ok)
298 (subl (% imm1) (% imm0))
299 (mark-as-node temp1)
300 (addl ($ m1) (% imm0))
301 (box-fixnum imm0 arg_z)
302 (andl ($ #x7fffffff) (% arg_z))
303 (single-value-return)
304 @ok
305 (subl (% imm1) (% imm0))
306 (mark-as-node temp1)
307 (box-fixnum imm0 arg_z)
308 (andl ($ #x7fffffff) (% arg_z))
309 (single-value-return)))
[16005]310
311(defx8632lapfunction %make-complex-double-float ((r arg_y) (i arg_z))
312 (movsd (@ target::misc-dfloat-offset (% r)) (% xmm0))
313 (movsd (@ target::misc-dfloat-offset (% i)) (% xmm1))
314 (unpcklpd (% xmm1) (% xmm0))
315 (movl ($ (logior (ash 5 x8632::num-subtag-bits) x8632::subtag-complex-double-float)) (%l imm0))
316 (movd (% imm0) (% mm0))
317 (movl ($ (- (* 2 8) x8632::fulltag-misc)) (%l imm0))
318 (subl (% imm0) (:rcontext x8632::tcr.save-allocptr))
319 (movl (:rcontext x8632::tcr.save-allocptr) (% allocptr))
320 (cmpl (:rcontext x8632::tcr.save-allocbase) (% allocptr))
321 (ja @no-trap)
322 (uuo-alloc)
323 @no-trap
324 (movd (% mm0) (@ x8632::misc-header-offset (% temp0)))
325 (andb ($ (lognot x8632::fulltagmask)) (:rcontext x8632::tcr.save-allocptr))
326 (movl (% allocptr) (% arg_z))
327 (movdqu (% xmm0) (@ x8632::complex-double-float.realpart (% arg_z)))
328 (single-value-return))
329
330(defx8632lapfunction %make-complex-single-float ((r arg_y) (i arg_z))
331 (movsd (@ target::misc-data-offset (% r)) (% xmm0))
332 (movsd (@ target::misc-data-offset (% i)) (% xmm1))
333 (unpcklps (% xmm1) (% xmm0))
334 (movl ($ (logior (ash 3 x8632::num-subtag-bits) x8632::subtag-complex-single-float)) (%l imm0))
335 (movd (% imm0) (% mm0))
336 (movl ($ (- (* 2 8) x8632::fulltag-misc)) (%l imm0))
337 (subl (% imm0) (:rcontext x8632::tcr.save-allocptr))
338 (movl (:rcontext x8632::tcr.save-allocptr) (% allocptr))
339 (cmpl (:rcontext x8632::tcr.save-allocbase) (% allocptr))
340 (ja @no-trap)
341 (uuo-alloc)
342 @no-trap
343 (movq (% mm0) (@ x8632::misc-header-offset (% temp0)))
344 (andb ($ (lognot x8632::fulltagmask)) (:rcontext x8632::tcr.save-allocptr))
345 (movl (% allocptr) (% arg_z))
346 (movq (% xmm0) (@ x8632::complex-single-float.realpart (% arg_z)))
347 (single-value-return))
Note: See TracBrowser for help on using the repository browser.