source: release/1.4/source/level-0/X86/X8632/x8632-numbers.lisp @ 13075

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

Merge trunk changes r13066 through r13067.
(copyright notices)

File size: 6.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;;; 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
Note: See TracBrowser for help on using the repository browser.