source: branches/new-random/level-0/X86/X8632/x8632-numbers.lisp @ 13316

Last change on this file since 13316 was 13316, checked in by rme, 10 years ago

Version of %mrg31k3p in x8632 lap.

File size: 9.5 KB
Line 
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
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
116;;; We'll get a SIGFPE if divisor is 0.
117(defx8632lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
118  (mark-as-imm temp0)
119  (mark-as-imm temp1)
120  (let ((imm2 temp0)
121        (imm1 temp1))                   ;edx
122    (unbox-fixnum dividend imm0)
123    (unbox-fixnum divisor imm2)
124    (cltd)                              ;edx:eax = sign_extend(eax)
125    (idivl (% imm2))
126    (box-fixnum imm0 arg_z)             ;quotient
127    (box-fixnum imm1 arg_y))            ;remainder
128  (mark-as-node temp0)
129  (mark-as-node temp1)
130  (movl (% esp) (% temp0))
131  (push (% arg_z))
132  (push (% arg_y))
133  (set-nargs 2)
134  (jmp-subprim .SPvalues))
135
136(defx8632lapfunction called-for-mv-p ()
137  (movl (@ x8632::lisp-frame.return-address (% ebp)) (% imm0))
138  (cmpl (% imm0) (@ (+ (target-nil-value) (x8632::kernel-global ret1valaddr))))
139  (movl ($ (target-t-value)) (% imm0))
140  (movl ($ (target-nil-value)) (% arg_z))
141  (cmove (% imm0) (% arg_z))
142  (single-value-return))
143
144(defx8632lapfunction %next-random-pair ((high arg_y) (low arg_z))
145  ;; high: (unsigned-byte 15)
146  ;; low: (unsigned-byte 16)
147  (unbox-fixnum low imm0)
148  ;; clear most significant bit
149  (shll ($ (1+ (- 16 x8632::fixnumshift))) (% high))
150  (shrl ($ 1) (% high))
151  (orl (% high) (% imm0))
152  (mark-as-imm edx)
153  (movl ($ 48271) (% edx))
154  (mul (% edx))
155  (mark-as-node edx)
156  (movl ($ (- #x10000)) (% high))       ;#xffff0000
157  (andl (% imm0) (% high))
158  (shrl ($ (- 16 x8632::fixnumshift)) (% high))
159  (shll ($ 16) (% imm0))
160  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0))
161  (movl (% imm0) (% low))
162  (movl (% esp) (% temp0))
163  (push (% high))
164  (push (% low))
165  (set-nargs 2)
166  (jmp-subprim .SPvalues))
167       
168;;; n1 and n2 must be positive (esp non zero)
169(defx86lapfunction %fixnum-gcd ((boxed-u arg_y) (boxed-v arg_z))
170  (mark-as-imm temp0)
171  (mark-as-imm temp1)
172  (let ((u imm0)
173        (v temp1)
174        (k temp0))                      ;temp0 = ecx
175    (xorl (% k) (% k))
176    (bsfl (% boxed-u) (% u))
177    (bsfl (% boxed-v) (% v))
178    (rcmp (% u) (% v))
179    (cmovlel (%l u) (%l k))
180    (cmovgl (%l v) (%l k))
181    (unbox-fixnum boxed-u u)
182    (unbox-fixnum boxed-v v)
183    (subb ($ x8632::fixnumshift) (%b k))
184    (jz @start)
185    (shrl (% cl) (% u))
186    (shrl (% cl) (% v))
187    @start
188    ;; At least one of u or v is odd at this point
189    @loop
190    ;; if u is even, shift it right one bit
191    (testb ($ 1) (%b u))
192    (jne @u-odd)
193    (shrl ($ 1) (% u))
194    (jmp @test)
195    @u-odd
196    ;; if v is even, shift it right one bit
197    (testb ($ 1) (%b v))
198    (jne @both-odd)
199    (shrl ($ 1) (% v))
200    (jmp @test-u)
201    @both-odd
202    (cmpl (% v) (% u))
203    (jb @v>u)
204    (subl (% v) (% u))
205    (shrl ($ 1) (% u))
206    (jmp @test)
207    @v>u
208    (subl (% u) (% v))
209    (shrl ($ 1) (% v))
210    @test-u
211    (testl (% u) (% u))
212    @test
213    (ja @loop)
214    (shll (% cl) (% v))
215    (movb ($ 0) (% cl))
216    (box-fixnum v arg_z))
217  (mark-as-node temp0)
218  (mark-as-node temp1)
219  (single-value-return))
220
221(defx8632lapfunction %mrg31k3p ((state arg_z))
222  (let ((seed temp0)
223        (m1 #x7fffffff)
224        (m2 #x7fffadb3)
225        (negative-m1 #x80000001)
226        (negative-m2 #x8000524d)
227        (imm1 edx))                     ;temp1
228    (std)                               ;temp1 now unboxed
229    (svref state 1 seed)
230    (movl (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)) (% imm0))
231    (andl ($ #x1ff) (% imm0))
232    (shll ($ 22) (% imm0))
233    (movl (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)) (% imm1))
234    (shrl ($ 9) (% imm1))
235    (addl (% imm1) (% imm0))
236
237    (movl (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)) (% imm1))
238    (andl ($ #xffffff) (% imm1))
239    (shll ($ 7) (% imm1))
240    (addl (% imm1) (% imm0))
241    (movl (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)) (% imm1))
242    (shrl ($ 24) (% imm1))
243
244    (addl (% imm1) (% imm0))
245    (leal (@ negative-m1 (% imm0)) (% imm1))
246    (cmpl ($ m1) (% imm0))
247    (cmovael (% imm1) (% imm0))
248
249    (addl (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)) (% imm0))
250    (leal (@ negative-m1 (% imm0)) (% imm1))
251    (cmpl ($ m1) (% imm0))
252    (cmovael (% imm1) (% imm0))
253
254    ;; update state
255    (movl (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)) (% imm1))
256    (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 2)) (% seed)))
257    (movl (@ (+ x8632::misc-data-offset (* 4 0)) (% seed)) (% imm1))
258    (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 1)) (% seed)))
259    (movl (% imm0) (@ (+ x8632::misc-data-offset (* 4 0)) (% seed)))
260
261    ;; second component
262    (movzwl (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)) (% imm0))
263    ;(andl ($ #xffff) (% imm0))
264    (shll ($ 15) (% imm0))
265    (movl (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)) (% imm1))
266    (shrl ($ 16) (% imm1))
267    (imull ($ 21069) (% imm1) (% imm1))
268
269    (addl (% imm1) (% imm0))
270    (leal (@ negative-m2 (% imm0)) (% imm1))
271    (cmpl ($ m2) (% imm0))
272    (cmovael (% imm1) (% imm0))
273    (movl (% imm0) (:rcontext x8632::tcr.unboxed0))     ;stash t1
274
275    (movzwl (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)) (% imm0))
276    ;(andl ($ #xffff) (% imm0))
277    (shll ($ 15) (% imm0))
278    (movl (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)) (% imm1))
279    (shrl ($ 16) (% imm1))
280    (imull ($ 21069) (% imm1) (% imm1))
281
282    (addl (% imm1) (% imm0))
283    (leal (@ negative-m2 (% imm0)) (% imm1))
284    (cmpl ($ m2) (% imm0))
285    (cmovael (% imm1) (% imm0))
286
287    (addl (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)) (% imm0))
288    (leal (@ negative-m2 (% imm0)) (% imm1))
289    (cmpl ($ m2) (% imm0))
290    (cmovael (% imm1) (% imm0))
291
292    (addl (:rcontext x8632::tcr.unboxed0) (% imm0))     ;add in t1
293    (leal (@ negative-m2 (% imm0)) (% imm1))
294    (cmpl ($ m2) (% imm0))
295    (cmovael (% imm1) (% imm0))
296
297    ;; update state
298    (movl (@ (+ x8632::misc-data-offset (* 4 4)) (% seed)) (% imm1))
299    (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 5)) (% seed)))
300    (movl (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)) (% imm1))
301    (movl (% imm1) (@ (+ x8632::misc-data-offset (* 4 4)) (% seed)))
302    (movl (% imm0) (@ (+ x8632::misc-data-offset (* 4 3)) (% seed)))
303
304    ;; combination
305    (movl (@ (+ x8632::misc-data-offset (* 4 0)) (% seed)) (% imm1))
306    (xchgl (% imm1) (% imm0))           ;for sanity
307    (rcmpl (% imm0) (% imm1))
308    (ja @ok)
309    (subl (% imm1) (% imm0))
310    (xorl (% imm1) (% imm1))
311    (cld)
312    (addl ($ m1) (% imm0))
313    (box-fixnum imm0 arg_z)
314    (andl ($ #x7fffffff) (% arg_z))
315    (single-value-return)
316    @ok
317    (subl (% imm1) (% imm0))
318    (xorl (% imm1) (% imm1))
319    (cld)
320    (box-fixnum imm0 arg_z)
321    (andl ($ #x7fffffff) (% arg_z))
322    (single-value-return)))
Note: See TracBrowser for help on using the repository browser.