source: trunk/source/level-0/X86/x86-numbers.lisp @ 13327

Last change on this file since 13327 was 13327, checked in by rme, 11 years ago

Improve CL:RANDOM.

The new generator is the MRG321k3p generator described in

  1. L'Ecuyer and R. Touzin, "Fast Combined Multiple Recursive

Generators with Multipliers of the form a = +/- 2d +/- 2e"",
Proceedings of the 2000 Winter Simulation Conference, Dec. 2000,
683--689.

It has a period of about 2185 and produces output of much higher
statistical quality than the previous generator.

Performance of the new generator should generally be comparable to that
of the old generator, despite the fact that the new generator does
a lot more work.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.3 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;;; We'll get a SIGFPE if divisor is 0.
115;;; Don't use %rbp.  Trust callback_for_interrupt() to preserve
116;;; the word below the stack pointer
117(defx86lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
118  (save-simple-frame)
119  (unbox-fixnum divisor imm0)
120  (movq (% imm0) (% imm2))
121  (unbox-fixnum dividend imm0)
122  (cqto)                                ; imm1 := sign_extend(imm0)
123  (idivq (% imm2))
124  (pop (% rbp))
125  (movq (% rsp) (% temp0))
126  (box-fixnum imm1 arg_y)
127  (box-fixnum imm0 arg_z)
128  (pushq (% arg_z))
129  (pushq (% arg_y))
130  (set-nargs 2)
131  (jmp-subprim .SPvalues))
132
133(defx86lapfunction called-for-mv-p ()
134  (ref-global ret1valaddr imm0)
135  (movq (@ x8664::lisp-frame.return-address (% rbp)) (% imm1))
136  (cmpq (% imm0) (% imm1))
137  (movq ($ t) (% imm0))
138  (movq ($ nil) (% arg_z))
139  (cmoveq (% imm0) (% arg_z))
140  (single-value-return))
141
142
143;;; n1 and n2 must be positive (esp non zero)
144(defx86lapfunction %fixnum-gcd ((boxed-u arg_y) (boxed-v arg_z))
145  (let ((u imm0)
146        (v imm1)
147        (k imm2))
148    (xorl (% imm2.l) (% imm2.l))
149    (bsfq (% boxed-u) (% u))
150    (bsfq (% boxed-v) (% v))
151    (rcmp (% u) (% v))
152    (cmovlel (%l u) (%l k))
153    (cmovgl (%l v) (%l k))
154    (unbox-fixnum boxed-u u)
155    (unbox-fixnum boxed-v v)
156    (subb ($ x8664::fixnumshift) (%b k))
157    (jz @start)
158    (shrq (% cl) (% u))
159    (shrq (% cl) (% v))
160    @start
161    ;; At least one of u or v is odd at this point
162    @loop
163    ;; if u is even, shift it right one bit
164    (testb ($ 1) (%b u))
165    (jne @u-odd)
166    (shrq ($ 1) (% u))
167    (jmp @test)
168    @u-odd
169    ;; if v is even, shift it right one bit
170    (testb ($ 1) (%b v))
171    (jne @both-odd)
172    (shrq ($ 1) (% v))
173    (jmp @test-u)
174    @both-odd
175    (cmpq (% v) (% u))
176    (jb @v>u)
177    (subq (% v) (% u))
178    (shrq ($ 1) (% u))
179    (jmp @test)
180    @v>u
181    (subq (% u) (% v))
182    (shrq ($ 1) (% v))
183    @test-u
184    (testq (% u) (% u))
185    @test
186    (ja @loop)
187    (shlq (% cl) (% v))
188    (movb ($ 0) (% cl))
189    (box-fixnum v arg_z)
190    (single-value-return)))
191
192(defx86lapfunction %mrg31k3p ((state arg_z))
193  (let ((seed temp0)
194        (m1 #x7fffffff)
195        (m2 #x7fffadb3)
196        (negative-m1 #x80000001)
197        (negative-m2 #x8000524d))
198    (svref state 1 seed)
199    (movl (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)) (% imm0.l))
200    (andl ($ #x1ff) (% imm0.l))
201    (shll ($ 22) (% imm0.l))
202    (movl (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)) (% imm1.l))
203    (shrl ($ 9) (% imm1.l))
204    (addl (% imm1.l) (% imm0.l))
205
206    (movl (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)) (% imm1.l))
207    (andl ($ #xffffff) (% imm1.l))
208    (shll ($ 7) (% imm1.l))
209    (addl (% imm1.l) (% imm0.l))
210    (movl (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)) (% imm1.l))
211    (shrl ($ 24) (% imm1.l))
212
213    (addl (% imm1.l) (% imm0.l))
214    (leal (@ negative-m1 (% imm0.l)) (% imm1.l))
215    (cmpl ($ m1) (% imm0.l))
216    (cmovael (% imm1.l) (% imm0.l))
217
218    (addl (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)) (% imm0.l))
219    (leal (@ negative-m1 (% imm0.l)) (% imm1.l))
220    (cmpl ($ m1) (% imm0.l))
221    (cmovael (% imm1.l) (% imm0.l))
222
223    ;; update state
224    (movl (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)) (% imm1.l))
225    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 2)) (% seed)))
226    (movl (@ (+ x8664::misc-data-offset (* 4 0)) (% seed)) (% imm1.l))
227    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 1)) (% seed)))
228    (movl (% imm0.l) (@ (+ x8664::misc-data-offset (* 4 0)) (% seed)))
229
230    ;; second component
231    (movl (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)) (% imm0.l))
232    (andl ($ #xffff) (% imm0.l))
233    (shll ($ 15) (% imm0.l))
234    (movl (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)) (% imm1.l))
235    (shrl ($ 16) (% imm1.l))
236    (imull ($ 21069) (% imm1.l) (% imm1.l))
237
238    (addl (% imm1.l) (% imm0.l))
239    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
240    (cmpl ($ m2) (% imm0.l))
241    (cmovael (% imm1.l) (% imm0.l))
242
243    (movl (% imm0.l) (% imm2.l))        ;stash t1
244
245    (movl (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)) (% imm0.l))
246    (andl ($ #xffff) (% imm0.l))
247    (shll ($ 15) (% imm0.l))
248    (movl (@ (+ x8664::misc-data-offset (* 4 5)) (% 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    (addl (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)) (% imm0.l))
258    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
259    (cmpl ($ m2) (% imm0.l))
260    (cmovael (% imm1.l) (% imm0.l))
261
262    (addl (% imm2.l) (% imm0.l))        ;add in t1
263    (leal (@ negative-m2 (% imm0.l)) (% imm1.l))
264    (cmpl ($ m2) (% imm0.l))
265    (cmovael (% imm1.l) (% imm0.l))
266
267    ;; update state
268    (movl (@ (+ x8664::misc-data-offset (* 4 4)) (% seed)) (% imm1.l))
269    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 5)) (% seed)))
270    (movl (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)) (% imm1.l))
271    (movl (% imm1.l) (@ (+ x8664::misc-data-offset (* 4 4)) (% seed)))
272    (movl (% imm0.l) (@ (+ x8664::misc-data-offset (* 4 3)) (% seed)))
273
274    ;; combination
275    (movl (@ (+ x8664::misc-data-offset (* 4 0)) (% seed)) (% imm1.l))
276    (xchgl (% imm1.l) (% imm0.l))               ;for sanity
277    (rcmpl (% imm0.l) (% imm1.l))
278    (ja @ok)
279    (subl (% imm1.l) (% imm0.l))
280    (addl ($ m1) (% imm0.l))
281    (box-fixnum imm0 arg_z)
282    (single-value-return)
283    @ok
284    (subl (% imm1.l) (% imm0.l))
285    (box-fixnum imm0 arg_z)
286    (single-value-return)))
287
288;;; End of x86-numbers.lisp
289) ; #+x8664-target
Note: See TracBrowser for help on using the repository browser.