source: trunk/source/level-0/X86/X8632/x8632-numbers.lisp @ 13531

Last change on this file since 13531 was 13531, checked in by gb, 10 years ago

Handle the seemingly special case of (%FIXNUM-TRUNCATE MOST-NEGATIVE-FIXNUM -1)
on x86, too.

File size: 9.1 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
117
118;;; We'll get a SIGFPE if divisor is 0.
119(defx8632lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
120  (cmpl ($ '-1) (% divisor))
121  (je @neg)
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)
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)
147  (jmp-subprim .SPvalues))
148
149(defx8632lapfunction called-for-mv-p ()
150  (movl (@ x8632::lisp-frame.return-address (% ebp)) (% imm0))
151  (cmpl (% imm0) (@ (+ (target-nil-value) (x8632::kernel-global ret1valaddr))))
152  (movl ($ (target-t-value)) (% imm0))
153  (movl ($ (target-nil-value)) (% arg_z))
154  (cmove (% imm0) (% arg_z))
155  (single-value-return))
156       
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
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)))
Note: See TracBrowser for help on using the repository browser.