1 | ;;;-*- Mode: Lisp; Package: (CCL :use CL) -*- |
---|
2 | |
---|
3 | (in-package "CCL") |
---|
4 | |
---|
5 | (eval-when (:compile-toplevel :load-toplevel :execute) |
---|
6 | (require "VINSN") |
---|
7 | (require "X8632-BACKEND")) |
---|
8 | |
---|
9 | (eval-when (:compile-toplevel :execute) |
---|
10 | (require "X8632ENV")) |
---|
11 | |
---|
12 | (defmacro define-x8632-vinsn (vinsn-name (results args &optional temps) &body body) |
---|
13 | (%define-vinsn *x8632-backend* vinsn-name results args temps body)) |
---|
14 | |
---|
15 | |
---|
16 | (define-x8632-vinsn scale-16bit-misc-index (((dest :u32)) |
---|
17 | ((idx :imm))) ; A fixnum |
---|
18 | (movl (:%l idx) (:%l dest)) |
---|
19 | (shrl (:$ub 1) (:%l dest))) |
---|
20 | |
---|
21 | (define-x8632-vinsn scale-8bit-misc-index (((dest :u32)) |
---|
22 | ((idx :imm))) ; A fixnum |
---|
23 | (movl (:%l idx) (:%l dest)) |
---|
24 | (shrl (:$ub 2) (:%l dest))) |
---|
25 | |
---|
26 | (define-x8632-vinsn misc-ref-u32 (((dest :u32)) |
---|
27 | ((v :lisp) |
---|
28 | (scaled-idx :u32))) |
---|
29 | (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
30 | |
---|
31 | (define-x8632-vinsn misc-ref-double-float (((dest :double-float)) |
---|
32 | ((v :lisp) |
---|
33 | (scaled-idx :imm))) |
---|
34 | (movsd (:@ x8632::misc-dfloat-offset (:%l v) (:%l scaled-idx)) (:%xmm dest))) |
---|
35 | |
---|
36 | (define-x8632-vinsn misc-ref-c-double-float (((dest :double-float)) |
---|
37 | ((v :lisp) |
---|
38 | (idx :s32const))) |
---|
39 | (movsd (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest))) |
---|
40 | |
---|
41 | (define-x8632-vinsn misc-ref-node (((dest :lisp)) |
---|
42 | ((v :lisp) |
---|
43 | (scaled-idx :imm))) |
---|
44 | (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
45 | |
---|
46 | (define-x8632-vinsn (push-misc-ref-node :push :node :vsp) (() |
---|
47 | ((v :lisp) |
---|
48 | (scaled-idx :imm))) |
---|
49 | (pushl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)))) |
---|
50 | |
---|
51 | (define-x8632-vinsn misc-set-node (() |
---|
52 | ((val :lisp) |
---|
53 | (v :lisp) |
---|
54 | (unscaled-idx :imm)) |
---|
55 | ()) |
---|
56 | (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx)))) |
---|
57 | |
---|
58 | (define-x8632-vinsn misc-set-immediate-node (() |
---|
59 | ((val :s32const) |
---|
60 | (v :lisp) |
---|
61 | (unscaled-idx :imm)) |
---|
62 | ()) |
---|
63 | (movl (:$l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx)))) |
---|
64 | |
---|
65 | (define-x8632-vinsn misc-set-double-float (() |
---|
66 | ((val :double-float) |
---|
67 | (v :lisp) |
---|
68 | (unscaled-idx :imm)) |
---|
69 | ()) |
---|
70 | (movsd (:%xmm val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx)))) |
---|
71 | |
---|
72 | (define-x8632-vinsn misc-ref-u8 (((dest :u8)) |
---|
73 | ((v :lisp) |
---|
74 | (scaled-idx :s32))) |
---|
75 | (movzbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
76 | |
---|
77 | (define-x8632-vinsn misc-ref-s8 (((dest :s8)) |
---|
78 | ((v :lisp) |
---|
79 | (scaled-idx :s32))) |
---|
80 | (movsbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
81 | |
---|
82 | (define-x8632-vinsn misc-ref-u16 (((dest :u16)) |
---|
83 | ((v :lisp) |
---|
84 | (scaled-idx :s32))) |
---|
85 | (movzwl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
86 | |
---|
87 | (define-x8632-vinsn misc-ref-u32 (((dest :u32)) |
---|
88 | ((v :lisp) |
---|
89 | (scaled-idx :s32))) |
---|
90 | (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
91 | |
---|
92 | (define-x8632-vinsn misc-ref-single-float (((dest :single-float)) |
---|
93 | ((v :lisp) |
---|
94 | (scaled-idx :s32))) |
---|
95 | (movss (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%xmm dest))) |
---|
96 | |
---|
97 | (define-x8632-vinsn misc-ref-s32 (((dest :s32)) |
---|
98 | ((v :lisp) |
---|
99 | (scaled-idx :s32))) |
---|
100 | (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
101 | |
---|
102 | (define-x8632-vinsn misc-ref-s16 (((dest :s16)) |
---|
103 | ((v :lisp) |
---|
104 | (scaled-idx :s32))) |
---|
105 | (movswl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest))) |
---|
106 | |
---|
107 | (define-x8632-vinsn misc-ref-c-node (((dest :lisp)) |
---|
108 | ((v :lisp) |
---|
109 | (idx :u32const)) ; sic |
---|
110 | ()) |
---|
111 | (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest))) |
---|
112 | |
---|
113 | (define-x8632-vinsn (push-misc-ref-c-node :push :node :vsp) |
---|
114 | (() |
---|
115 | ((v :lisp) |
---|
116 | (idx :u32const)) ; sic |
---|
117 | ()) |
---|
118 | (pushl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)))) |
---|
119 | |
---|
120 | (define-x8632-vinsn misc-ref-c-u32 (((dest :u32)) |
---|
121 | ((v :lisp) |
---|
122 | (idx :u32const)) ; sic |
---|
123 | ()) |
---|
124 | ;; xxx - should the 2 be x8632::word-shift? |
---|
125 | (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)) (:%l dest))) |
---|
126 | |
---|
127 | (define-x8632-vinsn misc-ref-c-s32 (((dest :s32)) |
---|
128 | ((v :lisp) |
---|
129 | (idx :s32const)) ; sic |
---|
130 | ()) |
---|
131 | (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest))) |
---|
132 | |
---|
133 | (define-x8632-vinsn misc-ref-c-single-float (((dest :single-float)) |
---|
134 | ((v :lisp) |
---|
135 | (idx :s32const)) ; sic |
---|
136 | ()) |
---|
137 | (movss (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest))) |
---|
138 | |
---|
139 | (define-x8632-vinsn misc-ref-c-u8 (((dest :u32)) |
---|
140 | ((v :lisp) |
---|
141 | (idx :s32const)) ; sic |
---|
142 | ()) |
---|
143 | (movzbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest))) |
---|
144 | |
---|
145 | (define-x8632-vinsn misc-ref-c-s8 (((dest :s32)) |
---|
146 | ((v :lisp) |
---|
147 | (idx :s32const)) ; sic |
---|
148 | ()) |
---|
149 | (movsbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest))) |
---|
150 | |
---|
151 | (define-x8632-vinsn misc-set-c-node (() |
---|
152 | ((val :lisp) |
---|
153 | (v :lisp) |
---|
154 | (idx :s32const))) |
---|
155 | (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)))) |
---|
156 | |
---|
157 | (define-x8632-vinsn misc-set-immediate-c-node (() |
---|
158 | ((val :s32const) |
---|
159 | (v :lisp) |
---|
160 | (idx :s32const))) |
---|
161 | (movl (:$l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)))) |
---|
162 | |
---|
163 | ;;; xxx don't know if this is right |
---|
164 | (define-x8632-vinsn set-closure-forward-reference (() |
---|
165 | ((val :lisp) |
---|
166 | (closure :lisp) |
---|
167 | (idx :s32const))) |
---|
168 | (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l closure)))) |
---|
169 | |
---|
170 | (define-x8632-vinsn misc-set-c-double-float (() |
---|
171 | ((val :double-float) |
---|
172 | (v :lisp) |
---|
173 | (idx :s32const))) |
---|
174 | (movsd (:%xmm val) (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v)))) |
---|
175 | |
---|
176 | (define-x8632-vinsn (call-known-symbol :call) (((result (:lisp x8632::arg_z))) |
---|
177 | () |
---|
178 | ((entry (:label 1)))) |
---|
179 | (:talign x8632::fulltag-tra) |
---|
180 | (call (:@ x8632::symbol.fcell (:% x8632::fname))) |
---|
181 | (movl (:$self 0) (:%l x8632::fn))) |
---|
182 | |
---|
183 | (define-x8632-vinsn (jump-known-symbol :jumplr) (() |
---|
184 | ()) |
---|
185 | |
---|
186 | (jmp (:@ x8632::symbol.fcell (:% x8632::fname)))) |
---|
187 | |
---|
188 | (define-x8632-vinsn set-nargs (() |
---|
189 | ((n :s16const))) |
---|
190 | ((:pred = n 0) |
---|
191 | (xorw (:%w x8632::nargs ) (:%w x8632::nargs ))) |
---|
192 | ((:not (:pred = n 0)) |
---|
193 | (movw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs )))) |
---|
194 | |
---|
195 | (define-x8632-vinsn check-exact-nargs (() |
---|
196 | ((n :u16const))) |
---|
197 | ((:pred = n 0) |
---|
198 | (testw (:%w x8632::nargs) (:%w x8632::nargs))) |
---|
199 | ((:not (:pred = n 0)) |
---|
200 | (cmpw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs))) |
---|
201 | (jz.pt :ok) |
---|
202 | (uuo-error-wrong-number-of-args) |
---|
203 | :ok) |
---|
204 | |
---|
205 | (define-x8632-vinsn check-min-nargs (() |
---|
206 | ((n :u16const))) |
---|
207 | (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift))) |
---|
208 | (jae.pt :ok) |
---|
209 | (uuo-error-too-few-args) |
---|
210 | :ok) |
---|
211 | |
---|
212 | (define-x8632-vinsn check-max-nargs (() |
---|
213 | ((n :u16const))) |
---|
214 | (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift))) |
---|
215 | (jbe.pt :ok) |
---|
216 | (uuo-error-too-many-args) |
---|
217 | :ok) |
---|
218 | |
---|
219 | (define-x8632-vinsn default-1-arg (() |
---|
220 | ((min :u16const))) |
---|
221 | (rcmpw (:%w x8632::nargs) (:$w (:apply ash min x8632::word-shift))) |
---|
222 | (jne :done) |
---|
223 | ((:pred >= min 2) |
---|
224 | (pushl (:%l x8632::arg_y))) |
---|
225 | ((:pred >= min 1) |
---|
226 | (movl (:%l x8632::arg_z) (:%l x8632::arg_y))) |
---|
227 | (movl (:$l x8632::nil-value) (:%l x8632::arg_z)) |
---|
228 | :done) |
---|
229 | |
---|
230 | (define-x8632-vinsn default-2-args (() |
---|
231 | ((min :u16const))) |
---|
232 | (rcmpw (:%w x8632::nargs ) (:$w (:apply ash (:apply 1+ min) x8632::word-shift))) |
---|
233 | (ja :done) |
---|
234 | (je :one) |
---|
235 | ;; We got "min" args; arg_y & arg_z default to nil |
---|
236 | ((:pred >= min 2) |
---|
237 | (pushl (:%l x8632::arg_y))) |
---|
238 | ((:pred >= min 1) |
---|
239 | (pushl (:%l x8632::arg_z))) |
---|
240 | (movl (:$l x8632::nil-value) (:%l x8632::arg_y)) |
---|
241 | (jmp :last) |
---|
242 | :one |
---|
243 | ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil. |
---|
244 | ((:pred >= min 1) |
---|
245 | (pushl (:%l x8632::arg_y))) |
---|
246 | (movl (:%l x8632::arg_z) (:%l x8632::arg_y)) |
---|
247 | :last |
---|
248 | (movl (:$l x8632::nil-value) (:%l x8632::arg_z)) |
---|
249 | :done) |
---|
250 | |
---|
251 | (define-x8632-vinsn default-optionals (() |
---|
252 | ((n :u16const)) |
---|
253 | ((temp :u32))) |
---|
254 | (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::word-shift))) |
---|
255 | (movw (:%w x8632::nargs) (:%w temp)) |
---|
256 | (jae :done) |
---|
257 | :loop |
---|
258 | (addw (:$w x8632::fixnumone) (:%w temp)) |
---|
259 | (cmpw (:$w (:apply ash n x8632::word-shift)) (:%w temp)) |
---|
260 | (pushl (:$l x8632::nil-value)) |
---|
261 | (jne :loop) |
---|
262 | :done) |
---|
263 | |
---|
264 | (define-x8632-vinsn save-lisp-context-no-stack-args (() |
---|
265 | ()) |
---|
266 | (pushl (:%l x8632::ebp)) |
---|
267 | (movl (:%l x8632::esp) (:%l x8632::ebp))) |
---|
268 | |
---|
269 | (define-x8632-vinsn save-lisp-context-offset (() |
---|
270 | ((nbytes-pushed :s32const))) |
---|
271 | (movl (:%l x8632::ebp) (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp))) |
---|
272 | (leal (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)) (:%l x8632::ebp)) |
---|
273 | (popl (:@ x8632::node-size (:%l x8632::ebp)))) |
---|
274 | |
---|
275 | (define-x8632-vinsn save-lisp-context-variable-arg-count (() |
---|
276 | () |
---|
277 | ((temp :u32))) |
---|
278 | (movzwl (:%w x8632::nargs) (:%l temp)) |
---|
279 | (subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp)) |
---|
280 | (jle :push) |
---|
281 | (movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp))) |
---|
282 | (leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp)) |
---|
283 | (popl (:@ x8632::node-size (:%l x8632::ebp))) |
---|
284 | (jmp :done) |
---|
285 | :push |
---|
286 | (pushl (:%l x8632::ebp)) |
---|
287 | (movl (:%l x8632::esp) (:%l x8632::ebp)) |
---|
288 | :done) |
---|
289 | |
---|
290 | ;;; We know that some args were pushed, but don't know how many were |
---|
291 | ;;; passed. |
---|
292 | (define-x8632-vinsn save-lisp-context-in-frame (() |
---|
293 | () |
---|
294 | ((temp :u32))) |
---|
295 | (movzwl (:%w x8632::nargs) (:%l temp)) |
---|
296 | (subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp)) |
---|
297 | (movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp))) |
---|
298 | (leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp)) |
---|
299 | (popl (:@ x8632::node-size (:%l x8632::ebp)))) |
---|
300 | |
---|
301 | (define-x8632-vinsn (vpush-register :push :node :vsp) |
---|
302 | (() |
---|
303 | ((reg :lisp))) |
---|
304 | (pushl (:% reg))) |
---|
305 | |
---|
306 | (define-x8632-vinsn (vpush-fixnum :push :node :vsp) |
---|
307 | (() |
---|
308 | ((const :s32const))) |
---|
309 | ((:and (:pred < const 128) (:pred >= const -128)) |
---|
310 | (pushl (:$b const))) |
---|
311 | ((:not (:and (:pred < const 128) (:pred >= const -128))) |
---|
312 | (pushl (:$l const)))) |
---|
313 | |
---|
314 | (define-x8632-vinsn vframe-load (((dest :lisp)) |
---|
315 | ((frame-offset :u16const) |
---|
316 | (cur-vsp :u16const))) |
---|
317 | (movl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest))) |
---|
318 | |
---|
319 | (define-x8632-vinsn compare-vframe-offset-to-nil (() |
---|
320 | ((frame-offset :u16const) |
---|
321 | (cur-vsp :u16const))) |
---|
322 | (cmpl (:$l x8632::nil-value) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)))) |
---|
323 | |
---|
324 | (define-x8632-vinsn compare-value-cell-to-nil (() |
---|
325 | ((vcell :lisp))) |
---|
326 | (cmpl (:$l x8632::nil-value) (:@ x8632::value-cell.value (:%l vcell)))) |
---|
327 | |
---|
328 | (define-x8632-vinsn lcell-load (((dest :lisp)) |
---|
329 | ((cell :lcell) |
---|
330 | (top :lcell))) |
---|
331 | (movl (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest))) |
---|
332 | |
---|
333 | (define-x8632-vinsn (vframe-push :push :node :vsp) |
---|
334 | (() |
---|
335 | ((frame-offset :u16const) |
---|
336 | (cur-vsp :u16const))) |
---|
337 | (pushl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)))) |
---|
338 | |
---|
339 | (define-x8632-vinsn vframe-store (() |
---|
340 | ((src :lisp) |
---|
341 | (frame-offset :u16const) |
---|
342 | (cur-vsp :u16const))) |
---|
343 | (movl (:%l src) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)))) |
---|
344 | |
---|
345 | (define-x8632-vinsn lcell-store (() |
---|
346 | ((src :lisp) |
---|
347 | (cell :lcell) |
---|
348 | (top :lcell))) |
---|
349 | (movl (:%l src) (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp)))) |
---|
350 | |
---|
351 | (define-x8632-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR) |
---|
352 | (() |
---|
353 | ()) |
---|
354 | (leave) |
---|
355 | (ret)) |
---|
356 | |
---|
357 | (define-x8632-vinsn (restore-full-lisp-context :lispcontext :pop :vsp ) |
---|
358 | (() |
---|
359 | ()) |
---|
360 | (leave)) |
---|
361 | |
---|
362 | (define-x8632-vinsn compare-to-nil (() |
---|
363 | ((arg0 t))) |
---|
364 | (cmpl (:$l x8632::nil-value) (:%l arg0))) |
---|
365 | |
---|
366 | (define-x8632-vinsn ref-constant (((dest :lisp)) |
---|
367 | ((lab :label))) |
---|
368 | (movl (:@ (:^ lab) (:%l x8632::fn)) (:%l dest))) |
---|
369 | |
---|
370 | (define-x8632-vinsn (vpush-constant :push :node :vsp) (() |
---|
371 | ((lab :label))) |
---|
372 | (pushl (:@ (:^ lab) (:%l x8632::fn)))) |
---|
373 | |
---|
374 | (define-x8632-vinsn (jump :jump) |
---|
375 | (() |
---|
376 | ((label :label))) |
---|
377 | (jmp label)) |
---|
378 | |
---|
379 | (define-x8632-vinsn (cbranch-true :branch) (() |
---|
380 | ((label :label) |
---|
381 | (crbit :u8const))) |
---|
382 | (jcc (:$ub crbit) label)) |
---|
383 | |
---|
384 | (define-x8632-vinsn (cbranch-false :branch) (() |
---|
385 | ((label :label) |
---|
386 | (crbit :u8const))) |
---|
387 | (jcc (:$ub (:apply logxor 1 crbit)) label)) |
---|
388 | |
---|
389 | (define-x8632-vinsn (lri :constant-ref) (((dest :imm)) |
---|
390 | ((intval :s32const)) |
---|
391 | ()) |
---|
392 | ((:pred = intval 0) |
---|
393 | (xorl (:%l dest) (:%l dest))) |
---|
394 | ((:and (:pred /= intval 0) |
---|
395 | (:pred >= intval -2147483648) |
---|
396 | (:pred <= intval 2147483647)) |
---|
397 | (movl (:$l intval) (:%l dest)))) |
---|
398 | |
---|
399 | ;;; In the following trap/branch-unless vinsns, it might be worth |
---|
400 | ;;; trying to use byte instructions when the args are known to be |
---|
401 | ;;; accessible as byte regs. It also might be possible to |
---|
402 | ;;; special-case eax/ax/al. |
---|
403 | |
---|
404 | (define-x8632-vinsn trap-unless-bit (() |
---|
405 | ((value :lisp))) |
---|
406 | (testl (:$l (lognot x8632::fixnumone)) (:%l value)) |
---|
407 | (je.pt :ok) |
---|
408 | (uuo-error-reg-not-type (:%l value) (:$ub arch::error-object-not-bit)) |
---|
409 | :ok |
---|
410 | ) |
---|
411 | |
---|
412 | ;;; note that NIL is just a distinguished CONS. |
---|
413 | ;;; the tag formerly known as fulltag-nil is now |
---|
414 | ;;; for tagged return addresses. |
---|
415 | (define-x8632-vinsn trap-unless-list (() |
---|
416 | ((object :lisp)) |
---|
417 | ((tag :u16))) |
---|
418 | (movw (:%w object) (:%w tag)) |
---|
419 | (andw (:$w x8632::fulltagmask) (:%w tag)) |
---|
420 | (cmpw (:$w x8632::fulltag-cons) (:%w tag)) |
---|
421 | (je.pt :ok) |
---|
422 | (uuo-error-reg-not-list (:%l object)) |
---|
423 | :ok) |
---|
424 | |
---|
425 | (define-x8632-vinsn trap-unless-cons (() |
---|
426 | ((object :lisp)) |
---|
427 | ((tag :u16))) |
---|
428 | ;; check for NIL |
---|
429 | (cmpl (:$l x8632::nil-value) (:%l object)) |
---|
430 | (je.pn :bad) |
---|
431 | (movw (:%w object) (:%w tag)) |
---|
432 | (andw (:$w x8632::fulltagmask) (:%w tag)) |
---|
433 | (cmpw (:$w x8632::fulltag-cons) (:%w tag)) |
---|
434 | (je.pt :ok) |
---|
435 | :bad |
---|
436 | (uuo-error-reg-not-tag (:%l object) (:$ub x8632::fulltag-cons)) |
---|
437 | :ok) |
---|
438 | |
---|
439 | (define-x8632-vinsn trap-unless-uvector (() |
---|
440 | ((object :lisp)) |
---|
441 | ((tag :u16))) |
---|
442 | (movw (:%w object) (:%w tag)) |
---|
443 | (andw (:$w x8632::tagmask) (:%w tag)) |
---|
444 | (cmpw (:$w x8632::tag-misc) (:%w tag)) |
---|
445 | (jz.pt :ok) |
---|
446 | (uuo-error-reg-not-tag (:%l object) (:$ub x8632::tag-misc)) |
---|
447 | :ok) |
---|
448 | |
---|
449 | (define-x8632-vinsn trap-unless-character (() |
---|
450 | ((object :lisp))) |
---|
451 | (cmpw (:$w x8632::subtag-character) (:%w object)) |
---|
452 | (je.pt :ok) |
---|
453 | (uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-character)) |
---|
454 | :ok) |
---|
455 | |
---|
456 | (define-x8632-vinsn trap-unless-fixnum (() |
---|
457 | ((object :lisp)) |
---|
458 | ()) |
---|
459 | (testw (:$w x8632::tagmask) (:%w object)) |
---|
460 | (je.pt :ok) |
---|
461 | (uuo-error-reg-not-fixnum (:%l object)) |
---|
462 | :ok) |
---|
463 | |
---|
464 | (define-x8632-vinsn set-flags-from-lisptag (() |
---|
465 | ((reg :lisp))) |
---|
466 | (testw (:$w x8632::tagmask) (:%w reg))) |
---|
467 | |
---|
468 | (define-x8632-vinsn trap-unless-typecode= (() |
---|
469 | ((object :lisp) |
---|
470 | (tagval :u8const)) |
---|
471 | ((tag :u8))) |
---|
472 | (movl (:%l object) (:%l tag)) |
---|
473 | ((:pred = (:apply %hard-regspec-value tag) x8632::eax) |
---|
474 | ;; accumulator |
---|
475 | (andb (:$b x8632::tagmask) (:%accb tag)) |
---|
476 | (cmpb (:$b x8632::tag-misc) (:%accb tag))) |
---|
477 | ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax) |
---|
478 | (:pred <= (:apply %hard-regspec-value tag) x8632::ebx)) |
---|
479 | ;; other register that can be treated as a byte |
---|
480 | (andb (:$b x8632::tagmask) (:%b tag)) |
---|
481 | (cmpb (:$b x8632::tag-misc) (:%b tag))) |
---|
482 | ((:pred > (:apply %hard-regspec-value tag) x8632::ebx) |
---|
483 | ;; non-byte register |
---|
484 | (andl (:$l x8632::tagmask) (:%l tag)) |
---|
485 | (cmpl (:$b x8632::tag-misc) (:%l tag))) |
---|
486 | (jne :have-tag) |
---|
487 | (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag)) |
---|
488 | :have-tag |
---|
489 | (cmpl (:$b tagval) (:%l tag)) |
---|
490 | (je.pt :ok) |
---|
491 | (uuo-error-reg-not-tag (:%l object) (:$ub tagval)) |
---|
492 | :ok) |
---|
493 | |
---|
494 | (define-x8632-vinsn trap-unless-single-float (() |
---|
495 | ((object :lisp)) |
---|
496 | ((tag :u16))) |
---|
497 | (movw (:%w object) (:%w tag)) |
---|
498 | (andw (:$w x8632::tagmask) (:%w tag)) |
---|
499 | (cmpw (:$w x8632::tag-misc) (:%w tag)) |
---|
500 | (jne :have-tag) |
---|
501 | (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag)) |
---|
502 | :have-tag |
---|
503 | (cmpw (:$w x8632::subtag-single-float) (:%w tag)) |
---|
504 | (je.pt :ok) |
---|
505 | (uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-single-float)) |
---|
506 | :ok) |
---|
507 | |
---|
508 | (define-x8632-vinsn trap-unless-double-float (() |
---|
509 | ((object :lisp)) |
---|
510 | ((tag :u16))) |
---|
511 | (movw (:%w object) (:%w tag)) |
---|
512 | (andw (:$w x8632::tagmask) (:%w tag)) |
---|
513 | (cmpw (:$w x8632::tag-misc) (:%w tag)) |
---|
514 | (jne :have-tag) |
---|
515 | (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag)) |
---|
516 | :have-tag |
---|
517 | (cmpw (:$w x8632::subtag-double-float) (:%w tag)) |
---|
518 | (je.pt :ok) |
---|
519 | (uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-double-float)) |
---|
520 | :ok) |
---|
521 | |
---|
522 | (define-x8632-vinsn trap-unless-macptr (() |
---|
523 | ((object :lisp)) |
---|
524 | ((tag :u16))) |
---|
525 | (movw (:%w object) (:%w tag)) |
---|
526 | (andw (:$w x8632::tagmask) (:%w tag)) |
---|
527 | (cmpw (:$w x8632::tag-misc) (:%w tag)) |
---|
528 | (jne :have-tag) |
---|
529 | (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag)) |
---|
530 | :have-tag |
---|
531 | (cmpw (:$w x8632::subtag-macptr) (:%w tag)) |
---|
532 | (je.pt :ok) |
---|
533 | (uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-macptr)) |
---|
534 | :ok) |
---|
535 | |
---|
536 | (define-x8632-vinsn check-misc-bound (() |
---|
537 | ((idx :imm) |
---|
538 | (v :lisp)) |
---|
539 | ((temp :u32))) |
---|
540 | (movl (:@ x8632::misc-header-offset (:%l v)) (:%l temp)) |
---|
541 | ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax) |
---|
542 | (:pred <= (:apply %hard-regspec-value temp) x8632::ebx)) |
---|
543 | (xorb (:%b temp) (:%b temp)) |
---|
544 | (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l temp))) |
---|
545 | ((:pred > (:apply %hard-regspec-value temp) x8632::ebx) |
---|
546 | (shrl (:$ub x8632::num-subtag-bits) (:%l temp)) |
---|
547 | (shll (:$ub x8632::fixnumshift) (:%l temp))) |
---|
548 | (rcmpl (:%l idx) (:%l temp)) |
---|
549 | (jb.pt :ok) |
---|
550 | (uuo-error-vector-bounds (:%l idx) (:%l v)) |
---|
551 | :ok) |
---|
552 | |
---|
553 | (define-x8632-vinsn %cdr (((dest :lisp)) |
---|
554 | ((src :lisp))) |
---|
555 | (movl (:@ x8632::cons.cdr (:%l src)) (:%l dest))) |
---|
556 | |
---|
557 | (define-x8632-vinsn (%vpush-cdr :push :node :vsp) |
---|
558 | (() |
---|
559 | ((src :lisp))) |
---|
560 | (pushl (:@ x8632::cons.cdr (:%l src)))) |
---|
561 | |
---|
562 | (define-x8632-vinsn %car (((dest :lisp)) |
---|
563 | ((src :lisp))) |
---|
564 | (movl (:@ x8632::cons.car (:%l src)) (:%l dest))) |
---|
565 | |
---|
566 | (define-x8632-vinsn (%vpush-car :push :node :vsp) |
---|
567 | (() |
---|
568 | ((src :lisp))) |
---|
569 | (pushl (:@ x8632::cons.car (:%l src)))) |
---|
570 | |
---|
571 | (define-x8632-vinsn u32->char (((dest :lisp) |
---|
572 | (src :u8)) |
---|
573 | ((src :u8)) |
---|
574 | ()) |
---|
575 | (shll (:$ub x8632::charcode-shift) (:%l src)) |
---|
576 | (leal (:@ x8632::subtag-character (:%l src)) (:%l dest))) |
---|
577 | |
---|
578 | (define-x8632-vinsn (load-nil :constant-ref) (((dest t)) |
---|
579 | ()) |
---|
580 | (movl (:$l x8632::nil-value) (:%l dest))) |
---|
581 | |
---|
582 | |
---|
583 | (define-x8632-vinsn (load-t :constant-ref) (((dest t)) |
---|
584 | ()) |
---|
585 | (movl (:$l x8632::t-value) (:%l dest))) |
---|
586 | |
---|
587 | ;;; use something like this for the other extract-whatevers, too, |
---|
588 | ;;; once it's established that it works. |
---|
589 | (define-x8632-vinsn extract-tag (((tag :u8)) |
---|
590 | ((object :lisp))) |
---|
591 | (movl (:%l object) (:%l tag)) |
---|
592 | ((:pred = (:apply %hard-regspec-value tag) x8632::eax) |
---|
593 | ;; tag is the accumulator (2 bytes) |
---|
594 | (andb (:$b x8632::tagmask) (:%accb tag))) |
---|
595 | ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax) |
---|
596 | (:pred <= (:apply %hard-regspec-value tag) x8632::ebx)) |
---|
597 | ;; tag is in a register whose low 8 bits can be accessed by byte |
---|
598 | ;; insns (3 bytes) |
---|
599 | (andb (:$b x8632::tagmask) (:%b tag))) |
---|
600 | ((:pred > (:apply %hard-regspec-value tag) x8632::ebx) |
---|
601 | ;; tag is somewhere else (6 bytes) (could use andw and get a length |
---|
602 | ;; of 5 bytes, but Intel's optimization manual advises avoiding |
---|
603 | ;; length-changing prefixes to change the size of immediates. |
---|
604 | ;; (section 3.4.2.3) |
---|
605 | (andl (:$l x8632::tagmask) (:%l tag)))) |
---|
606 | |
---|
607 | (define-x8632-vinsn extract-tag-fixnum (((tag :imm)) |
---|
608 | ((object :lisp))) |
---|
609 | (leal (:@ (:%l object) 4) (:%l tag)) |
---|
610 | (andw (:$w (ash x8632::tagmask x8632::fixnumshift)) (:%w tag))) |
---|
611 | |
---|
612 | (define-x8632-vinsn extract-fulltag (((tag :u8)) |
---|
613 | ((object :lisp))) |
---|
614 | (movl (:%l object) (:%l tag)) |
---|
615 | (andw (:$w x8632::fulltagmask) (:%w tag))) |
---|
616 | |
---|
617 | (define-x8632-vinsn extract-fulltag-fixnum (((tag :imm)) |
---|
618 | ((object :lisp))) |
---|
619 | (leal (:@ (:%l object) 4) (:%l tag)) |
---|
620 | (andw (:$w (ash x8632::fulltagmask x8632::fixnumshift)) (:%w tag))) |
---|
621 | |
---|
622 | (define-x8632-vinsn extract-typecode (((tag :imm)) |
---|
623 | ((object :lisp))) |
---|
624 | (movl (:%l object) (:%l tag)) |
---|
625 | ((:pred <= (:apply %hard-regspec-value tag) x8632::ebx) |
---|
626 | (andb (:$b x8632::tagmask) (:%b tag)) |
---|
627 | (cmpb (:$b x8632::tag-misc) (:%b tag))) |
---|
628 | ((:pred > (:apply %hard-regspec-value tag) x8632::ebx) |
---|
629 | (andl (:$l x8632::tagmask) (:%l tag)) |
---|
630 | (cmpl (:$l x8632::tag-misc) (:%l tag))) |
---|
631 | (jne :have-tag) |
---|
632 | ((:pred <= (:apply %hard-regspec-value tag) x8632::ebx) |
---|
633 | (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag))) |
---|
634 | ((:pred > (:apply %hard-regspec-value tag) x8632::ebx) |
---|
635 | (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))) |
---|
636 | :have-tag) |
---|
637 | |
---|
638 | (define-x8632-vinsn extract-typecode-fixnum (((tag :imm)) |
---|
639 | ((object :lisp)) |
---|
640 | ((temp :u32))) |
---|
641 | (movl (:%l object) (:%l temp)) |
---|
642 | (andw (:$w x8632::tagmask) (:%w temp)) |
---|
643 | (cmpw (:$w x8632::tag-misc) (:%w temp)) |
---|
644 | (jne :have-tag) |
---|
645 | (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w temp)) |
---|
646 | :have-tag |
---|
647 | (leal (:@ (:%l temp) 4) (:%l tag))) |
---|
648 | |
---|
649 | (define-x8632-vinsn compare-reg-to-zero (() |
---|
650 | ((reg :imm))) |
---|
651 | (testl (:%l reg) (:%l reg))) |
---|
652 | |
---|
653 | ;;; life will be sad if reg isn't byte accessible |
---|
654 | (define-x8632-vinsn compare-u8-reg-to-zero (() |
---|
655 | ((reg :u8))) |
---|
656 | (testb (:%b reg) (:%b reg))) |
---|
657 | |
---|
658 | (define-x8632-vinsn cr-bit->boolean (((dest :lisp)) |
---|
659 | ((crbit :u8const)) |
---|
660 | ((temp :u32))) |
---|
661 | (movl (:$l x8632::t-value) (:%l temp)) |
---|
662 | (leal (:@ (- x8632::t-offset) (:%l temp)) (:%l dest)) |
---|
663 | (cmovccl (:$ub crbit) (:%l temp) (:%l dest))) |
---|
664 | |
---|
665 | (define-x8632-vinsn compare-s32-constant (() |
---|
666 | ((val :imm) |
---|
667 | (const :s32const))) |
---|
668 | ((:or (:pred < const -128) (:pred > const 127)) |
---|
669 | (rcmpl (:%l val) (:$l const))) |
---|
670 | ((:not (:or (:pred < const -128) (:pred > const 127))) |
---|
671 | (rcmpl (:%l val) (:$b const)))) |
---|
672 | |
---|
673 | (define-x8632-vinsn compare-u31-constant (() |
---|
674 | ((val :u32) |
---|
675 | (const :u32const))) |
---|
676 | ((:pred > const 127) |
---|
677 | (rcmpl (:%l val) (:$l const))) |
---|
678 | ((:not (:pred > const 127)) |
---|
679 | (rcmpl (:%l val) (:$b const)))) |
---|
680 | |
---|
681 | (define-x8632-vinsn compare-u8-constant (() |
---|
682 | ((val :u8) |
---|
683 | (const :u8const))) |
---|
684 | ((:pred = (:apply %hard-regspec-value val) x8632::eax) |
---|
685 | (rcmpb (:%accb val) (:$b const))) |
---|
686 | ((:and (:pred > (:apply %hard-regspec-value val) x8632::eax) |
---|
687 | (:pred <= (:apply %hard-regspec-value val) x8632::ebx)) |
---|
688 | (rcmpb (:%b val) (:$b const))) |
---|
689 | ((:pred > (:apply %hard-regspec-value val) x8632::ebx) |
---|
690 | (rcmpl (:%l val) (:$l const))) |
---|
691 | ) |
---|
692 | |
---|
693 | (define-x8632-vinsn cons (((dest :lisp)) |
---|
694 | ((car :lisp) |
---|
695 | (cdr :lisp)) |
---|
696 | ((allocptr (:lisp #.x8632::allocptr)))) |
---|
697 | (subl (:$b (- x8632::cons.size x8632::fulltag-cons)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr)) |
---|
698 | (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l x8632::allocptr)) |
---|
699 | (rcmpl (:%l x8632::allocptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase)) |
---|
700 | (jg :no-trap) |
---|
701 | (uuo-alloc) |
---|
702 | :no-trap |
---|
703 | (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr)) |
---|
704 | (movl (:%l car) (:@ x8632::cons.car (:%l x8632::allocptr))) |
---|
705 | (movl (:%l cdr) (:@ x8632::cons.cdr (:%l x8632::allocptr))) |
---|
706 | (movl (:%l x8632::allocptr) (:%l dest))) |
---|
707 | |
---|
708 | (define-x8632-vinsn unbox-u8 (((dest :u8)) |
---|
709 | ((src :lisp))) |
---|
710 | (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l dest)) |
---|
711 | (andl (:% src) (:% dest)) |
---|
712 | (je.pt :ok) |
---|
713 | (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-8)) |
---|
714 | :ok |
---|
715 | (movl (:%l src) (:%l dest)) |
---|
716 | (shrl (:$ub x8632::fixnumshift) (:%l dest))) |
---|
717 | |
---|
718 | (define-x8632-vinsn %unbox-u8 (((dest :u8)) |
---|
719 | ((src :lisp))) |
---|
720 | (movl (:%l src) (:%l dest)) |
---|
721 | (shrl (:$ub x8632::fixnumshift) (:%l dest)) |
---|
722 | (andl (:$l #xff) (:%l dest))) |
---|
723 | |
---|
724 | (define-x8632-vinsn unbox-s8 (((dest :s8)) |
---|
725 | ((src :lisp))) |
---|
726 | (movl (:%l src) (:%l dest)) |
---|
727 | (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest)) |
---|
728 | (sarl (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest)) |
---|
729 | (cmpl (:%l src) (:%l dest)) |
---|
730 | (jne.pn :bad) |
---|
731 | (testw (:$w x8632::fixnummask) (:%w dest)) |
---|
732 | (jne.pn :bad) |
---|
733 | (sarl (:$ub x8632::fixnumshift) (:%l dest)) |
---|
734 | (jmp :got-it) |
---|
735 | :bad |
---|
736 | (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-8)) |
---|
737 | :got-it) |
---|
738 | |
---|
739 | (define-x8632-vinsn unbox-u16 (((dest :u16)) |
---|
740 | ((src :lisp))) |
---|
741 | (testl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:% src)) |
---|
742 | (movl (:%l src) (:%l dest)) |
---|
743 | (je.pt :ok) |
---|
744 | (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-16)) |
---|
745 | :ok |
---|
746 | (shrl (:$ub x8632::fixnumshift) (:%l dest))) |
---|
747 | |
---|
748 | (define-x8632-vinsn %unbox-u16 (((dest :u16)) |
---|
749 | ((src :lisp))) |
---|
750 | (movl (:%l src) (:%l dest)) |
---|
751 | (shrl (:$ub x8632::fixnumshift) (:%l dest))) |
---|
752 | |
---|
753 | (define-x8632-vinsn unbox-s16 (((dest :s16)) |
---|
754 | ((src :lisp))) |
---|
755 | (movl (:%l src) (:%l dest)) |
---|
756 | (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest)) |
---|
757 | (sarl (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest)) |
---|
758 | (cmpl (:%l src) (:%l dest)) |
---|
759 | (jne.pn :bad) |
---|
760 | (testw (:$w x8632::fixnummask) (:%w dest)) |
---|
761 | (je.pt :got-it) |
---|
762 | :bad |
---|
763 | (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-16)) |
---|
764 | :got-it |
---|
765 | (sarl (:$ub x8632::fixnumshift) (:%l dest))) |
---|
766 | |
---|
767 | (define-x8632-vinsn %unbox-s16 (((dest :s16)) |
---|
768 | ((src :lisp))) |
---|
769 | (movl (:%l src) (:%l dest)) |
---|
770 | (sarl (:$ub x8632::fixnumshift) (:%l dest))) |
---|
771 | |
---|
772 | ;;; xxx -- review this again later |
---|
773 | (define-x8632-vinsn unbox-u32 (((dest :u32)) |
---|
774 | ((src :lisp))) |
---|
775 | (movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest)) |
---|
776 | (testl (:%l dest) (:%l src)) |
---|
777 | (movl (:%l src) (:%l dest)) |
---|
778 | (jnz :maybe-bignum) |
---|
779 | (sarl (:$ub x8632::fixnumshift) (:%l dest)) |
---|
780 | (jmp :done) |
---|
781 | :maybe-bignum |
---|
782 | (andw (:$w x8632::tagmask) (:%w dest)) |
---|
783 | (cmpw (:$w x8632::tag-misc) (:%w dest)) |
---|
784 | (jne :have-tag) |
---|
785 | (movw (:@ x8632::misc-subtag-offset (:%l src)) (:%w dest)) |
---|
786 | (andw (:$w #xff) (:%w dest)) |
---|
787 | :have-tag |
---|
788 | (cmpw (:$w x8632::subtag-bignum) (:%w dest)) |
---|
789 | (jne :bad) |
---|
790 | (movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest)) |
---|
791 | (cmpl (:$l x8632::three-digit-bignum-header) (:%l dest)) |
---|
792 | (je :three) |
---|
793 | (cmpl (:$l x8632::two-digit-bignum-header) (:%l dest)) |
---|
794 | (jne :bad) |
---|
795 | (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest)) |
---|
796 | (testl (:%l dest) (:%l dest)) |
---|
797 | (jns :done) |
---|
798 | :bad |
---|
799 | (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32)) |
---|
800 | :three |
---|
801 | (movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest)) |
---|
802 | (testl (:%l dest) (:%l dest)) |
---|
803 | (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest)) |
---|
804 | (jne :bad) |
---|
805 | :done) |
---|
806 | |
---|
807 | ;;; xxx -- review this again later |
---|
808 | (define-x8632-vinsn unbox-s32 (((dest :s32)) |
---|
809 | ((src :lisp))) |
---|
810 | (movl (:%l src) (:%l dest)) |
---|
811 | (sarl (:$ub x8632::fixnumshift) (:%l dest)) |
---|
812 | ;; Was it a fixnum ? |
---|
813 | (testw (:$w x8632::fixnummask) (:%w src)) |
---|
814 | (je :done) |
---|
815 | ;; May be a 2-digit bignum |
---|
816 | (movw (:%w src) (:%w dest)) |
---|
817 | (andw (:$w x8632::tagmask) (:%w dest)) |
---|
818 | (cmpw (:$w x8632::tag-misc) (:%w dest)) |
---|
819 | (jne :bad) |
---|
820 | (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src))) |
---|
821 | (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest)) |
---|
822 | (je :done) |
---|
823 | :bad |
---|
824 | (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32)) |
---|
825 | :done) |
---|
826 | |
---|
827 | |
---|
828 | ;;; xxx -- sigh... |
---|
829 | (define-x8632-vinsn sign-extend-s8 (((dest :s32)) |
---|
830 | ((src :s8))) |
---|
831 | ;; (movsbl (:%b temp) (:%l dest)) |
---|
832 | (movl (:%l src) (:%l dest)) |
---|
833 | (shll (:$ub 24) (:%l dest)) |
---|
834 | (sarl (:$ub 24) (:%l dest))) |
---|
835 | |
---|
836 | (define-x8632-vinsn sign-extend-s16 (((dest :s32)) |
---|
837 | ((src :s16))) |
---|
838 | (movswl (:%w src) (:%l dest))) |
---|
839 | |
---|
840 | ;;; xxx -- sigh... |
---|
841 | (define-x8632-vinsn zero-extend-u8 (((dest :s32)) |
---|
842 | ((src :u8))) |
---|
843 | ;;(movzbl (:%b src) (:%l dest)) |
---|
844 | (movl (:%l src) (:%l dest)) |
---|
845 | (andl (:$l #xff) (:%l dest))) |
---|
846 | |
---|
847 | (define-x8632-vinsn zero-extend-u16 (((dest :s32)) |
---|
848 | ((src :u16))) |
---|
849 | (movzwl (:%w src) (:%l dest))) |
---|
850 | |
---|
851 | (define-x8632-vinsn (jump-subprim :jumpLR) (() |
---|
852 | ((spno :s32const))) |
---|
853 | (jmp (:@ spno))) |
---|
854 | |
---|
855 | ;;; Call a subprimitive using a tail-aligned CALL instruction. |
---|
856 | (define-x8632-vinsn (call-subprim :call) (() |
---|
857 | ((spno :s32const)) |
---|
858 | ((entry (:label 1)))) |
---|
859 | (:talign x8632::fulltag-tra) |
---|
860 | (call (:@ spno)) |
---|
861 | (movl (:$self 0) (:% x8632::fn))) |
---|
862 | |
---|
863 | (define-x8632-vinsn fixnum-subtract-from (((dest t) |
---|
864 | (y t)) |
---|
865 | ((y t) |
---|
866 | (x t))) |
---|
867 | (subl (:%l y) (:%l x))) |
---|
868 | |
---|
869 | (define-x8632-vinsn %logand-c (((dest t) |
---|
870 | (val t)) |
---|
871 | ((val t) |
---|
872 | (const :s32const))) |
---|
873 | ((:and (:pred >= const -128) (:pred <= const 127)) |
---|
874 | (andl (:$b const) (:%l val))) |
---|
875 | ((:not (:and (:pred >= const -128) (:pred <= const 127))) |
---|
876 | (andl (:$l const) (:%l val)))) |
---|
877 | |
---|
878 | (define-x8632-vinsn %logior-c (((dest t) |
---|
879 | (val t)) |
---|
880 | ((val t) |
---|
881 | (const :s32const))) |
---|
882 | ((:and (:pred >= const -128) (:pred <= const 127)) |
---|
883 | (orl (:$b const) (:%l val))) |
---|
884 | ((:not (:and (:pred >= const -128) (:pred <= const 127))) |
---|
885 | (orl (:$l const) (:%l val)))) |
---|
886 | |
---|
887 | (define-x8632-vinsn %logxor-c (((dest t) |
---|
888 | (val t)) |
---|
889 | ((val t) |
---|
890 | (const :s32const))) |
---|
891 | ((:and (:pred >= const -128) (:pred <= const 127)) |
---|
892 | (xorl (:$b const) (:%l val))) |
---|
893 | ((:not (:and (:pred >= const -128) (:pred <= const 127))) |
---|
894 | (xorl (:$l const) (:%l val)))) |
---|
895 | |
---|
896 | (define-x8632-vinsn character->fixnum (((dest :lisp)) |
---|
897 | ((src :lisp)) |
---|
898 | ()) |
---|
899 | ((:not (:pred = |
---|
900 | (:apply %hard-regspec-value dest) |
---|
901 | (:apply %hard-regspec-value src))) |
---|
902 | (movl (:%l src) (:%l dest))) |
---|
903 | (shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest))) |
---|
904 | |
---|
905 | (define-x8632-vinsn compare (() |
---|
906 | ((x t) |
---|
907 | (y t))) |
---|
908 | (rcmpl (:%l x) (:%l y))) |
---|
909 | |
---|
910 | (define-x8632-vinsn negate-fixnum (((val :lisp)) |
---|
911 | ((val :imm))) |
---|
912 | (negl (:% val))) |
---|
913 | |
---|
914 | ;;; set-bigits-and-header-for-fixnum-overflow |
---|
915 | |
---|
916 | (define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm)) |
---|
917 | ((src :s32)) |
---|
918 | ((temp :s32))) |
---|
919 | (movl (:%l src) (:%l temp)) |
---|
920 | (shll (:$ub x8632::fixnumshift) (:%l temp)) |
---|
921 | (movl (:%l temp) (:%l dest)) ; tagged as a fixnum |
---|
922 | (sarl (:$ub x8632::fixnumshift) (:%l temp)) |
---|
923 | (cmpl (:%l src) (:%l temp))) |
---|
924 | |
---|
925 | (define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm)) |
---|
926 | ((src :u32)) |
---|
927 | ((temp :u32))) |
---|
928 | (movl (:%l src) (:%l temp)) |
---|
929 | (shll (:$ub (1+ x8632::fixnumshift)) (:%l temp)) |
---|
930 | (movl (:%l temp) (:%l dest)) ; tagged as an even fixnum |
---|
931 | (shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp)) |
---|
932 | (shrl (:%l dest)) |
---|
933 | (cmpl (:%l src) (:%l temp)) |
---|
934 | :done) |
---|
935 | |
---|
936 | ;;; setup-bignum-alloc-for-s32-overflow |
---|
937 | ;;; setup-bignum-alloc-for-u32-overflow |
---|
938 | |
---|
939 | (define-x8632-vinsn setup-uvector-allocation (() |
---|
940 | ((header :imm))) |
---|
941 | (movd (:%l header) (:%mmx x8632::mm0))) |
---|
942 | |
---|
943 | ;;; The code that runs in response to the uuo-alloc |
---|
944 | ;;; expects a header in mm0, and a size in imm0. |
---|
945 | ;;; mm0 is an implicit arg (it contains the uvector header) |
---|
946 | ;;; size is actually an arg, not a temporary, |
---|
947 | ;;; but it appears that there's isn't a way to enforce |
---|
948 | ;;; register usage on vinsn args. |
---|
949 | (define-x8632-vinsn %allocate-uvector (((dest :lisp)) |
---|
950 | () |
---|
951 | ((size (:u32 #.x8632::imm0)) |
---|
952 | (freeptr (:lisp #.x8632::allocptr)))) |
---|
953 | (subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr)) |
---|
954 | (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr)) |
---|
955 | (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase)) |
---|
956 | (jg :no-trap) |
---|
957 | (uuo-alloc) |
---|
958 | :no-trap |
---|
959 | (movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr))) |
---|
960 | (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr)) |
---|
961 | ((:not (:pred = freeptr |
---|
962 | (:apply %hard-regspec-value dest))) |
---|
963 | (movl (:%l freeptr) (:%l dest)))) |
---|
964 | |
---|
965 | (define-x8632-vinsn set-bigits-after-fixnum-overflow (() |
---|
966 | ((bignum :lisp))) |
---|
967 | (movq (:%mmx x8632::mm0) (:@ x8632::misc-data-offset (:%l bignum)))) |
---|
968 | |
---|
969 | (define-x8632-vinsn box-fixnum (((dest :imm)) |
---|
970 | ((src :s32))) |
---|
971 | ;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest)) |
---|
972 | (leal (:@ (:%l src) x8632::fixnumone) (:%l dest))) |
---|
973 | |
---|
974 | ;;; xxx |
---|
975 | (define-x8632-vinsn (fix-fixnum-overflow-ool :call) |
---|
976 | (((val :lisp)) |
---|
977 | ((val :lisp)) |
---|
978 | ((unboxed (:s32 #.x8632::edx)) |
---|
979 | (header (:u32 #.x8632::imm0)) |
---|
980 | (entry (:label 1)))) |
---|
981 | (jno.pt :done) |
---|
982 | ((:not (:pred = x8632::arg_z |
---|
983 | (:apply %hard-regspec-value val))) |
---|
984 | (movl (:%l val) (:%l x8632::arg_z))) |
---|
985 | (:talign 5) |
---|
986 | (call (:@ .SPfix-overflow)) |
---|
987 | (movl (:$self 0) (:%l x8632::fn)) |
---|
988 | ((:not (:pred = x8632::arg_z |
---|
989 | (:apply %hard-regspec-value val))) |
---|
990 | (movl (:%l x8632::arg_z) (:%l val))) |
---|
991 | :done) |
---|
992 | |
---|
993 | ;;; xxx |
---|
994 | (define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call) |
---|
995 | (((val :lisp)) |
---|
996 | ((val :lisp) |
---|
997 | (lab :label)) |
---|
998 | ((unboxed (:s32 #.x8664::imm1)) |
---|
999 | (header (:u32 #.x8664::imm0)) |
---|
1000 | (entry (:label 1)))) |
---|
1001 | (jno.pt lab) |
---|
1002 | ((:not (:pred = x8632::arg_z |
---|
1003 | (:apply %hard-regspec-value val))) |
---|
1004 | (movl (:%l val) (:%l x8632::arg_z))) |
---|
1005 | (:talign 5) |
---|
1006 | (call (:@ .SPfix-overflow)) |
---|
1007 | (movl (:$self 0) (:%l x8632::fn)) |
---|
1008 | ((:not (:pred = x8632::arg_z |
---|
1009 | (:apply %hard-regspec-value val))) |
---|
1010 | (movl (:%l x8632::arg_z) (:%l val))) |
---|
1011 | (jmp lab)) |
---|
1012 | |
---|
1013 | |
---|
1014 | (define-x8632-vinsn add-constant (((dest :imm)) |
---|
1015 | ((dest :imm) |
---|
1016 | (const :s32const))) |
---|
1017 | ((:and (:pred >= const -128) (:pred <= const 127)) |
---|
1018 | (addl (:$b const) (:%l dest))) |
---|
1019 | ((:not (:and (:pred >= const -128) (:pred <= const 127))) |
---|
1020 | (addl (:$l const) (:%l dest)))) |
---|
1021 | |
---|
1022 | (define-x8632-vinsn add-constant3 (((dest :imm)) |
---|
1023 | ((src :imm) |
---|
1024 | (const :s32const))) |
---|
1025 | ((:pred = (:apply %hard-regspec-value dest) |
---|
1026 | (:apply %hard-regspec-value src)) |
---|
1027 | ((:and (:pred >= const -128) (:pred <= const 127)) |
---|
1028 | (addl (:$b const) (:%l dest))) |
---|
1029 | ((:not (:and (:pred >= const -128) (:pred <= const 127))) |
---|
1030 | (addl (:$l const) (:%l dest)))) |
---|
1031 | ((:not (:pred = (:apply %hard-regspec-value dest) |
---|
1032 | (:apply %hard-regspec-value src))) |
---|
1033 | (leal (:@ const (:%l src)) (:%l dest)))) |
---|
1034 | |
---|
1035 | (define-x8632-vinsn fixnum-add2 (((dest :imm)) |
---|
1036 | ((dest :imm) |
---|
1037 | (other :imm))) |
---|
1038 | (addl (:%l other) (:%l dest))) |
---|
1039 | |
---|
1040 | (define-x8632-vinsn fixnum-sub2 (((dest :imm)) |
---|
1041 | ((x :imm) |
---|
1042 | (y :imm)) |
---|
1043 | ((temp :imm))) |
---|
1044 | (movl (:%l x) (:%l temp)) |
---|
1045 | (subl (:%l y) (:%l temp)) |
---|
1046 | (movl (:%l temp) (:%l dest))) |
---|
1047 | |
---|
1048 | (define-x8632-vinsn fixnum-add3 (((dest :imm)) |
---|
1049 | ((x :imm) |
---|
1050 | (y :imm))) |
---|
1051 | |
---|
1052 | ((:pred = |
---|
1053 | (:apply %hard-regspec-value x) |
---|
1054 | (:apply %hard-regspec-value dest)) |
---|
1055 | (addl (:%l y) (:%l dest))) |
---|
1056 | ((:not (:pred = |
---|
1057 | (:apply %hard-regspec-value x) |
---|
1058 | (:apply %hard-regspec-value dest))) |
---|
1059 | ((:pred = |
---|
1060 | (:apply %hard-regspec-value y) |
---|
1061 | (:apply %hard-regspec-value dest)) |
---|
1062 | (addl (:%l x) (:%l dest))) |
---|
1063 | ((:not (:pred = |
---|
1064 | (:apply %hard-regspec-value y) |
---|
1065 | (:apply %hard-regspec-value dest))) |
---|
1066 | (leal (:@ (:%l x) (:%l y)) (:%l dest))))) |
---|
1067 | |
---|
1068 | (define-x8632-vinsn copy-gpr (((dest t)) |
---|
1069 | ((src t))) |
---|
1070 | ((:not (:pred = |
---|
1071 | (:apply %hard-regspec-value dest) |
---|
1072 | (:apply %hard-regspec-value src))) |
---|
1073 | (movl (:%l src) (:%l dest)))) |
---|
1074 | |
---|
1075 | (define-x8632-vinsn (vpop-register :pop :node :vsp) |
---|
1076 | (((dest :lisp)) |
---|
1077 | ()) |
---|
1078 | (popl (:%l dest))) |
---|
1079 | |
---|
1080 | (define-x8632-vinsn (push-argregs :push :node :vsp) (() |
---|
1081 | ()) |
---|
1082 | (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size))) |
---|
1083 | (jb :done) |
---|
1084 | (je :one) |
---|
1085 | (pushl (:%l x8632::arg_y)) |
---|
1086 | :one |
---|
1087 | (pushl (:%l x8632::arg_z)) |
---|
1088 | :done) |
---|
1089 | |
---|
1090 | (define-x8632-vinsn (push-max-argregs :push :node :vsp) (() |
---|
1091 | ((max :u32const))) |
---|
1092 | ((:pred >= max 2) |
---|
1093 | (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size))) |
---|
1094 | (jb :done) |
---|
1095 | (je :one) |
---|
1096 | (pushl (:%l x8632::arg_y)) |
---|
1097 | :one |
---|
1098 | (pushl (:%l x8632::arg_z)) |
---|
1099 | :done) |
---|
1100 | ((:pred = max 1) |
---|
1101 | (testw (:%w x8632::nargs) (:%w x8632::nargs)) |
---|
1102 | (je :done) |
---|
1103 | (pushl (:%l x8632::arg_z)) |
---|
1104 | :done)) |
---|
1105 | |
---|
1106 | (define-x8632-vinsn (call-label :call) (() |
---|
1107 | ((label :label)) |
---|
1108 | ((entry (:label 1)))) |
---|
1109 | (:talign 5) |
---|
1110 | (call label) |
---|
1111 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1112 | |
---|
1113 | (define-x8632-vinsn double-float-compare (() |
---|
1114 | ((arg0 :double-float) |
---|
1115 | (arg1 :double-float))) |
---|
1116 | (comisd (:%xmm arg1) (:%xmm arg0))) |
---|
1117 | |
---|
1118 | (define-x8632-vinsn single-float-compare (() |
---|
1119 | ((arg0 :single-float) |
---|
1120 | (arg1 :single-float))) |
---|
1121 | (comiss (:%xmm arg1) (:%xmm arg0))) |
---|
1122 | |
---|
1123 | (define-x8632-vinsn double-float+-2 (((result :double-float)) |
---|
1124 | ((x :double-float) |
---|
1125 | (y :double-float))) |
---|
1126 | ((:pred = |
---|
1127 | (:apply %hard-regspec-value result) |
---|
1128 | (:apply %hard-regspec-value x)) |
---|
1129 | (addsd (:%xmm y) (:%xmm result))) |
---|
1130 | ((:and (:not (:pred = |
---|
1131 | (:apply %hard-regspec-value result) |
---|
1132 | (:apply %hard-regspec-value x))) |
---|
1133 | (:pred = |
---|
1134 | (:apply %hard-regspec-value result) |
---|
1135 | (:apply %hard-regspec-value y))) |
---|
1136 | (addsd (:%xmm x) (:%xmm result))) |
---|
1137 | ((:and (:not (:pred = |
---|
1138 | (:apply %hard-regspec-value result) |
---|
1139 | (:apply %hard-regspec-value x))) |
---|
1140 | (:not (:pred = |
---|
1141 | (:apply %hard-regspec-value result) |
---|
1142 | (:apply %hard-regspec-value y)))) |
---|
1143 | (movsd (:%xmm x) (:%xmm result)) |
---|
1144 | (addsd (:%xmm y) (:%xmm result)))) |
---|
1145 | |
---|
1146 | ;;; Caller guarantees (not (eq y result)) |
---|
1147 | (define-x8632-vinsn double-float--2 (((result :double-float)) |
---|
1148 | ((x :double-float) |
---|
1149 | (y :double-float))) |
---|
1150 | ((:not (:pred = (:apply %hard-regspec-value result) |
---|
1151 | (:apply %hard-regspec-value x))) |
---|
1152 | (movsd (:%xmm x) (:%xmm result))) |
---|
1153 | (subsd (:%xmm y) (:%xmm result))) |
---|
1154 | |
---|
1155 | (define-x8632-vinsn double-float*-2 (((result :double-float)) |
---|
1156 | ((x :double-float) |
---|
1157 | (y :double-float))) |
---|
1158 | ((:pred = |
---|
1159 | (:apply %hard-regspec-value result) |
---|
1160 | (:apply %hard-regspec-value x)) |
---|
1161 | (mulsd (:%xmm y) (:%xmm result))) |
---|
1162 | ((:and (:not (:pred = |
---|
1163 | (:apply %hard-regspec-value result) |
---|
1164 | (:apply %hard-regspec-value x))) |
---|
1165 | (:pred = |
---|
1166 | (:apply %hard-regspec-value result) |
---|
1167 | (:apply %hard-regspec-value y))) |
---|
1168 | (mulsd (:%xmm x) (:%xmm result))) |
---|
1169 | ((:and (:not (:pred = |
---|
1170 | (:apply %hard-regspec-value result) |
---|
1171 | (:apply %hard-regspec-value x))) |
---|
1172 | (:not (:pred = |
---|
1173 | (:apply %hard-regspec-value result) |
---|
1174 | (:apply %hard-regspec-value y)))) |
---|
1175 | (movsd (:%xmm x) (:%xmm result)) |
---|
1176 | (mulsd (:%xmm y) (:%xmm result)))) |
---|
1177 | |
---|
1178 | ;;; Caller guarantees (not (eq y result)) |
---|
1179 | (define-x8632-vinsn double-float/-2 (((result :double-float)) |
---|
1180 | ((x :double-float) |
---|
1181 | (y :double-float))) |
---|
1182 | ((:not (:pred = (:apply %hard-regspec-value result) |
---|
1183 | (:apply %hard-regspec-value x))) |
---|
1184 | (movsd (:%xmm x) (:%xmm result))) |
---|
1185 | (divsd (:%xmm y) (:%xmm result))) |
---|
1186 | |
---|
1187 | (define-x8632-vinsn single-float+-2 (((result :single-float)) |
---|
1188 | ((x :single-float) |
---|
1189 | (y :single-float))) |
---|
1190 | ((:pred = |
---|
1191 | (:apply %hard-regspec-value result) |
---|
1192 | (:apply %hard-regspec-value x)) |
---|
1193 | (addss (:%xmm y) (:%xmm result))) |
---|
1194 | ((:and (:not (:pred = |
---|
1195 | (:apply %hard-regspec-value result) |
---|
1196 | (:apply %hard-regspec-value x))) |
---|
1197 | (:pred = |
---|
1198 | (:apply %hard-regspec-value result) |
---|
1199 | (:apply %hard-regspec-value y))) |
---|
1200 | (addss (:%xmm x) (:%xmm result))) |
---|
1201 | ((:and (:not (:pred = |
---|
1202 | (:apply %hard-regspec-value result) |
---|
1203 | (:apply %hard-regspec-value x))) |
---|
1204 | (:not (:pred = |
---|
1205 | (:apply %hard-regspec-value result) |
---|
1206 | (:apply %hard-regspec-value y)))) |
---|
1207 | (movss (:%xmm x) (:%xmm result)) |
---|
1208 | (addss (:%xmm y) (:%xmm result)))) |
---|
1209 | |
---|
1210 | ;;; Caller guarantees (not (eq y result)) |
---|
1211 | (define-x8632-vinsn single-float--2 (((result :single-float)) |
---|
1212 | ((x :single-float) |
---|
1213 | (y :single-float))) |
---|
1214 | ((:not (:pred = (:apply %hard-regspec-value result) |
---|
1215 | (:apply %hard-regspec-value x))) |
---|
1216 | (movss (:%xmm x) (:%xmm result))) |
---|
1217 | (subss (:%xmm y) (:%xmm result))) |
---|
1218 | |
---|
1219 | (define-x8632-vinsn single-float*-2 (((result :single-float)) |
---|
1220 | ((x :single-float) |
---|
1221 | (y :single-float))) |
---|
1222 | ((:pred = |
---|
1223 | (:apply %hard-regspec-value result) |
---|
1224 | (:apply %hard-regspec-value x)) |
---|
1225 | (mulss (:%xmm y) (:%xmm result))) |
---|
1226 | ((:and (:not (:pred = |
---|
1227 | (:apply %hard-regspec-value result) |
---|
1228 | (:apply %hard-regspec-value x))) |
---|
1229 | (:pred = |
---|
1230 | (:apply %hard-regspec-value result) |
---|
1231 | (:apply %hard-regspec-value y))) |
---|
1232 | (mulss (:%xmm x) (:%xmm result))) |
---|
1233 | ((:and (:not (:pred = |
---|
1234 | (:apply %hard-regspec-value result) |
---|
1235 | (:apply %hard-regspec-value x))) |
---|
1236 | (:not (:pred = |
---|
1237 | (:apply %hard-regspec-value result) |
---|
1238 | (:apply %hard-regspec-value y)))) |
---|
1239 | (movss (:%xmm x) (:%xmm result)) |
---|
1240 | (mulss (:%xmm y) (:%xmm result)))) |
---|
1241 | |
---|
1242 | ;;; Caller guarantees (not (eq y result)) |
---|
1243 | (define-x8632-vinsn single-float/-2 (((result :single-float)) |
---|
1244 | ((x :single-float) |
---|
1245 | (y :single-float))) |
---|
1246 | ((:not (:pred = (:apply %hard-regspec-value result) |
---|
1247 | (:apply %hard-regspec-value x))) |
---|
1248 | (movss (:%xmm x) (:%xmm result))) |
---|
1249 | (divss (:%xmm y) (:%xmm result))) |
---|
1250 | |
---|
1251 | (define-x8632-vinsn get-single (((result :single-float)) |
---|
1252 | ((source :lisp))) |
---|
1253 | (movss (:@ x8632::single-float.value (:%l source)) (:%xmm result))) |
---|
1254 | |
---|
1255 | (define-x8632-vinsn get-double (((result :double-float)) |
---|
1256 | ((source :lisp))) |
---|
1257 | (movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result))) |
---|
1258 | |
---|
1259 | ;;; Extract a double-float value, typechecking in the process. |
---|
1260 | ;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here, |
---|
1261 | ;;; instead of replicating it .. |
---|
1262 | ;;; get-double? |
---|
1263 | |
---|
1264 | (define-x8632-vinsn copy-single-float (((dest :single-float)) |
---|
1265 | ((src :single-float))) |
---|
1266 | (movss (:%xmm src) (:%xmm dest))) |
---|
1267 | |
---|
1268 | (define-x8632-vinsn copy-single-to-double (((dest :double-float)) |
---|
1269 | ((src :single-float))) |
---|
1270 | (cvtss2sd (:%xmm src) (:%xmm dest))) |
---|
1271 | |
---|
1272 | (define-x8632-vinsn copy-double-to-single (((dest :single-float)) |
---|
1273 | ((src :double-float))) |
---|
1274 | (cvtsd2ss (:%xmm src) (:%xmm dest))) |
---|
1275 | |
---|
1276 | (define-x8632-vinsn fitvals (() |
---|
1277 | ((n :u16const)) |
---|
1278 | ((imm :u16))) |
---|
1279 | ((:pred = n 0) |
---|
1280 | (xorl (:%l imm) (:%l imm))) |
---|
1281 | ((:not (:pred = n 0)) |
---|
1282 | (movw (:$w (:apply ash n x8632::fixnumshift)) (:%w imm))) |
---|
1283 | (subw (:%w x8632::nargs) (:%w imm)) |
---|
1284 | (jae :push-more) |
---|
1285 | (movswl (:%w imm) (:%l imm)) |
---|
1286 | (subl (:%l imm) (:%l x8632::esp)) |
---|
1287 | (jmp :done) |
---|
1288 | :push-loop |
---|
1289 | (pushl (:$l x8632::nil-value)) |
---|
1290 | (addw (:$b x8632::node-size) (:%w x8632::nargs)) |
---|
1291 | (subw (:$b x8632::node-size) (:%w imm)) |
---|
1292 | :push-more |
---|
1293 | (jne :push-loop) |
---|
1294 | :done) |
---|
1295 | |
---|
1296 | (define-x8632-vinsn (nvalret :jumpLR) (() |
---|
1297 | ()) |
---|
1298 | (jmp (:@ .SPnvalret))) |
---|
1299 | |
---|
1300 | (define-x8632-vinsn lisp-word-ref (((dest t)) |
---|
1301 | ((base t) |
---|
1302 | (offset t))) |
---|
1303 | (movl (:@ (:%l base) (:%l offset)) (:%l dest))) |
---|
1304 | |
---|
1305 | (define-x8632-vinsn lisp-word-ref-c (((dest t)) |
---|
1306 | ((base t) |
---|
1307 | (offset :s32const))) |
---|
1308 | ((:pred = offset 0) |
---|
1309 | (movl (:@ (:%l base)) (:%l dest))) |
---|
1310 | ((:not (:pred = offset 0)) |
---|
1311 | (movl (:@ offset (:%l base)) (:%l dest)))) |
---|
1312 | |
---|
1313 | ;; start-mv-call |
---|
1314 | |
---|
1315 | ;; xxx check this |
---|
1316 | (define-x8632-vinsn (vpush-label :push :node :vsp) (() |
---|
1317 | ((label :label))) |
---|
1318 | (leal (:@ (:^ label) (:%l x8632::fn)) (:%l x8632::ra0)) |
---|
1319 | (pushl (:%l x8632::ra0))) |
---|
1320 | |
---|
1321 | ;; ???? |
---|
1322 | (define-x8632-vinsn emit-aligned-label (() |
---|
1323 | ((label :label))) |
---|
1324 | (:align 3) |
---|
1325 | (:long (:^ label))) |
---|
1326 | |
---|
1327 | ;; pass-multiple-values-symbol |
---|
1328 | ;;; %ra0 is pointing into %fn, so no need to copy %fn here. |
---|
1329 | (define-x8632-vinsn pass-multiple-values-symbol (() |
---|
1330 | ()) |
---|
1331 | (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr)))) |
---|
1332 | (jmp (:@ x8632::symbol.fcell (:% x8632::fname)))) |
---|
1333 | |
---|
1334 | |
---|
1335 | ;; pass-multiple-values |
---|
1336 | |
---|
1337 | (define-x8632-vinsn reserve-outgoing-frame (() |
---|
1338 | ()) |
---|
1339 | (pushl (:$b x8632::reserved-frame-marker)) |
---|
1340 | (pushl (:$b x8632::reserved-frame-marker))) |
---|
1341 | |
---|
1342 | ;; implicit temp0 arg |
---|
1343 | (define-x8632-vinsn (call-known-function :call) (() |
---|
1344 | () |
---|
1345 | ((entry (:label 1)))) |
---|
1346 | (:talign 5) |
---|
1347 | (call (:%l x8632::temp0)) |
---|
1348 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1349 | |
---|
1350 | (define-x8632-vinsn (jump-known-function :jumplr) (() |
---|
1351 | ()) |
---|
1352 | (movl (:%l x8632::fn) (:%l x8632::xfn)) |
---|
1353 | (movl (:%l x8632::temp0) (:%l x8632::fn)) |
---|
1354 | (jmp (:%l x8632::fn))) |
---|
1355 | |
---|
1356 | (define-x8632-vinsn (list :call) (() |
---|
1357 | () |
---|
1358 | ((entry (:label 1)))) |
---|
1359 | (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0)) |
---|
1360 | (:talign 5) |
---|
1361 | (call (:@ .SPconslist)) |
---|
1362 | :back |
---|
1363 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1364 | |
---|
1365 | (define-x8632-vinsn make-tsp-cons (((dest :lisp)) |
---|
1366 | ((car :lisp) (cdr :lisp)) |
---|
1367 | ((temp :imm))) |
---|
1368 | (subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp)) |
---|
1369 | (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp)) |
---|
1370 | (movq (:%xmm x8632::fpzero) (:@ (:%l temp))) |
---|
1371 | (movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp))) |
---|
1372 | (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp)) |
---|
1373 | (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))) |
---|
1374 | (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) |
---|
1375 | (leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp)) |
---|
1376 | (movl (:%l car) (:@ x8632::cons.car (:%l temp))) |
---|
1377 | (movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp))) |
---|
1378 | (movl (:%l temp) (:%l dest))) |
---|
1379 | |
---|
1380 | |
---|
1381 | ;; make-fixed-stack-gvector |
---|
1382 | |
---|
1383 | (define-x8632-vinsn discard-temp-frame (() |
---|
1384 | () |
---|
1385 | ((temp :imm))) |
---|
1386 | (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp)) |
---|
1387 | (movl (:@ (:%l temp)) (:%l temp)) |
---|
1388 | (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) |
---|
1389 | (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp)) |
---|
1390 | ) |
---|
1391 | |
---|
1392 | (define-x8632-vinsn discard-c-frame (() |
---|
1393 | () |
---|
1394 | ((temp :imm))) |
---|
1395 | (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp)) |
---|
1396 | (movl (:@ (:%l temp)) (:%l temp)) |
---|
1397 | (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))) |
---|
1398 | |
---|
1399 | |
---|
1400 | (define-x8632-vinsn vstack-discard (() |
---|
1401 | ((nwords :u32const))) |
---|
1402 | ((:not (:pred = nwords 0)) |
---|
1403 | ((:pred < nwords 16) |
---|
1404 | (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp))) |
---|
1405 | ((:not (:pred < nwords 16)) |
---|
1406 | (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp))))) |
---|
1407 | |
---|
1408 | (defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno) |
---|
1409 | `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1)))) |
---|
1410 | (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0)) |
---|
1411 | (:talign 5) |
---|
1412 | (jmp (:@ ,spno)) |
---|
1413 | :back |
---|
1414 | (movl (:$self 0) (:%l x8632::fn)))) |
---|
1415 | |
---|
1416 | (defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno) |
---|
1417 | `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1)))) |
---|
1418 | (:talign 5) |
---|
1419 | (call (:@ ,spno)) |
---|
1420 | :back |
---|
1421 | (movl (:$self 0) (:%l x8632::fn)))) |
---|
1422 | |
---|
1423 | (defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno) |
---|
1424 | `(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ()) |
---|
1425 | (jmp (:@ ,spno)))) |
---|
1426 | |
---|
1427 | (define-x8632-vinsn (nthrowvalues :call :subprim-call) (() |
---|
1428 | ((lab :label))) |
---|
1429 | (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0)) |
---|
1430 | (jmp (:@ .SPnthrowvalues))) |
---|
1431 | |
---|
1432 | (define-x8632-vinsn (nthrow1value :call :subprim-call) (() |
---|
1433 | ((lab :label))) |
---|
1434 | (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0)) |
---|
1435 | (jmp (:@ .SPnthrow1value))) |
---|
1436 | |
---|
1437 | (define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0) |
---|
1438 | |
---|
1439 | (define-x8632-vinsn bind-interrupt-level-0-inline (() |
---|
1440 | () |
---|
1441 | ((temp :imm))) |
---|
1442 | (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp)) |
---|
1443 | (cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp))) |
---|
1444 | (pushl (:@ x8632::interrupt-level-binding-index (:%l temp))) |
---|
1445 | (pushl (:$b x8632::interrupt-level-binding-index)) |
---|
1446 | (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link)) |
---|
1447 | (movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp))) |
---|
1448 | (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link)) |
---|
1449 | (jns.pt :done) |
---|
1450 | (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending)) |
---|
1451 | (jae.pt :done) |
---|
1452 | (ud2a) |
---|
1453 | (:byte 2) |
---|
1454 | :done) |
---|
1455 | |
---|
1456 | (define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1) |
---|
1457 | |
---|
1458 | (define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level) |
---|
1459 | |
---|
1460 | (define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level) |
---|
1461 | |
---|
1462 | (define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen) |
---|
1463 | |
---|
1464 | (define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp) |
---|
1465 | |
---|
1466 | (define-x8632-vinsn set-eq-bit (() |
---|
1467 | ()) |
---|
1468 | (testb (:%b x8632::arg_z) (:%b x8632::arg_z))) |
---|
1469 | |
---|
1470 | ;;; %schar8 |
---|
1471 | ;;; %schar32 |
---|
1472 | ;;; %set-schar8 |
---|
1473 | ;;; %set-schar32 |
---|
1474 | |
---|
1475 | (define-x8632-vinsn misc-set-c-single-float (((val :single-float)) |
---|
1476 | ((v :lisp) |
---|
1477 | (idx :u32const))) |
---|
1478 | (movsd (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)))) |
---|
1479 | |
---|
1480 | (define-x8632-vinsn array-data-vector-ref (((dest :lisp)) |
---|
1481 | ((header :lisp))) |
---|
1482 | (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest))) |
---|
1483 | |
---|
1484 | |
---|
1485 | (define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref) |
---|
1486 | |
---|
1487 | (define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set) |
---|
1488 | |
---|
1489 | (define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8)) |
---|
1490 | ((addr :s32const))) |
---|
1491 | (movzbl (:@ addr) (:%l dest))) |
---|
1492 | |
---|
1493 | (define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8)) |
---|
1494 | ((addr :s32const))) |
---|
1495 | (movsbl (:@ addr) (:%l dest))) |
---|
1496 | |
---|
1497 | (define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16)) |
---|
1498 | ((addr :s32const))) |
---|
1499 | (movzwl (:@ addr) (:%l dest))) |
---|
1500 | |
---|
1501 | (define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16)) |
---|
1502 | ((addr :s32const))) |
---|
1503 | (movswl (:@ addr) (:%l dest))) |
---|
1504 | |
---|
1505 | (define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32)) |
---|
1506 | ((addr :s32const))) |
---|
1507 | (movl (:@ addr) (:%l dest))) |
---|
1508 | |
---|
1509 | (define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32)) |
---|
1510 | ((addr :s32const))) |
---|
1511 | (movl (:@ addr) (:%l dest))) |
---|
1512 | |
---|
1513 | (define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32)) |
---|
1514 | ((addr :s32const))) |
---|
1515 | (movl (:@ addr) (:%l dest))) |
---|
1516 | |
---|
1517 | (define-x8632-vinsn event-poll (() |
---|
1518 | ()) |
---|
1519 | (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending)) |
---|
1520 | (jae :no-interrupt) |
---|
1521 | (ud2a) |
---|
1522 | (:byte 2) |
---|
1523 | :no-interrupt) |
---|
1524 | |
---|
1525 | ;;; check-2d-bound |
---|
1526 | ;;; check-3d-bound |
---|
1527 | |
---|
1528 | (define-x8632-vinsn 2d-dim1 (((dest :u32)) |
---|
1529 | ((header :lisp))) |
---|
1530 | (movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell))) |
---|
1531 | (:%l header)) (:%l dest)) |
---|
1532 | (sarl (:$ub x8632::fixnumshift) (:%l dest))) |
---|
1533 | |
---|
1534 | ;;; 3d-dims |
---|
1535 | |
---|
1536 | ;;; xxx |
---|
1537 | (define-x8632-vinsn 2d-unscaled-index (((dest :imm) |
---|
1538 | (dim1 :u32)) |
---|
1539 | ((dim1 :u32) |
---|
1540 | (i :imm) |
---|
1541 | (j :imm))) |
---|
1542 | |
---|
1543 | (imull (:%l i) (:%l dim1)) |
---|
1544 | (leal (:@ (:%l j) (:%l dim1)) (:%l dest))) |
---|
1545 | |
---|
1546 | ;;; 3d-unscaled-index |
---|
1547 | |
---|
1548 | (define-x8632-vinsn branch-unless-both-args-fixnums (() |
---|
1549 | ((a :lisp) |
---|
1550 | (b :lisp) |
---|
1551 | (dest :label)) |
---|
1552 | ((tag :u8))) |
---|
1553 | (movl (:%l a) (:%l tag)) |
---|
1554 | (orl (:%l b) (:%l tag)) |
---|
1555 | ((:pred = (:apply %hard-regspec-value tag) x8632::eax) |
---|
1556 | (testb (:$b x8632::fixnummask) (:%accb tag))) |
---|
1557 | ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax) |
---|
1558 | (:pred <= (:apply %hard-regspec-value tag) x8632::ebx)) |
---|
1559 | (testb (:$b x8632::fixnummask) (:%b tag))) |
---|
1560 | ((:pred > (:apply %hard-regspec-value tag) x8632::ebx) |
---|
1561 | (testl (:$l x8632::fixnummask) (:%l tag))) |
---|
1562 | (jne dest)) |
---|
1563 | |
---|
1564 | (define-x8632-vinsn branch-unless-arg-fixnum (() |
---|
1565 | ((a :lisp) |
---|
1566 | (dest :label))) |
---|
1567 | ((:pred <= (:apply %hard-regspec-value a) x8632::ebx) |
---|
1568 | (testb (:$b x8632::fixnummask) (:%b a))) |
---|
1569 | ((:pred > (:apply %hard-regspec-value a) x8632::ebx) |
---|
1570 | (testl (:$l x8632::fixnummask) (:%l a))) |
---|
1571 | (jne dest)) |
---|
1572 | |
---|
1573 | (define-x8632-vinsn fixnum->single-float (((f :single-float)) |
---|
1574 | ((arg :lisp)) |
---|
1575 | ((unboxed :s32))) |
---|
1576 | (movl (:%l arg) (:%l unboxed)) |
---|
1577 | (sarl (:$ub x8632::fixnumshift) (:%l unboxed)) |
---|
1578 | (cvtsi2ssl (:%l unboxed) (:%xmm f))) |
---|
1579 | |
---|
1580 | (define-x8632-vinsn fixnum->double-float (((f :double-float)) |
---|
1581 | ((arg :lisp)) |
---|
1582 | ((unboxed :s32))) |
---|
1583 | (movl (:%l arg) (:%l unboxed)) |
---|
1584 | (sarl (:$ub x8632::fixnumshift) (:%l unboxed)) |
---|
1585 | (cvtsi2sdl (:%l unboxed) (:%xmm f))) |
---|
1586 | |
---|
1587 | (define-x8632-vinsn xchg-registers (() |
---|
1588 | ((a t) |
---|
1589 | (b t))) |
---|
1590 | (xchgl (:%l a) (:%l b))) |
---|
1591 | |
---|
1592 | (define-x8632-vinsn establish-fn (() |
---|
1593 | ()) |
---|
1594 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1595 | |
---|
1596 | |
---|
1597 | (define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide) |
---|
1598 | |
---|
1599 | (define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp) |
---|
1600 | |
---|
1601 | |
---|
1602 | (define-x8632-vinsn character->code (((dest :u32)) |
---|
1603 | ((src :lisp))) |
---|
1604 | (movl (:%l src) (:%l dest)) |
---|
1605 | (sarl (:$ub x8632::charcode-shift) (:%l dest))) |
---|
1606 | |
---|
1607 | (define-x8632-vinsn adjust-vsp (() |
---|
1608 | ((amount :s32const))) |
---|
1609 | ((:and (:pred >= amount -128) (:pred <= amount 127)) |
---|
1610 | (addl (:$b amount) (:%l x8632::esp))) |
---|
1611 | ((:not (:and (:pred >= amount -128) (:pred <= amount 127))) |
---|
1612 | (addl (:$l amount) (:%l x8632::esp)))) |
---|
1613 | |
---|
1614 | |
---|
1615 | (define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t)) |
---|
1616 | ((spno :s32const) |
---|
1617 | (y t) |
---|
1618 | (z t)) |
---|
1619 | ((entry (:label 1)))) |
---|
1620 | (:talign 5) |
---|
1621 | (call (:@ spno)) |
---|
1622 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1623 | |
---|
1624 | (define-x8632-vinsn zero-double-float-register (((dest :double-float)) |
---|
1625 | ()) |
---|
1626 | (movsd (:%xmm x8632::fpzero) (:%xmm dest))) |
---|
1627 | |
---|
1628 | (define-x8632-vinsn zero-single-float-register (((dest :single-float)) |
---|
1629 | ()) |
---|
1630 | (movss (:%xmm x8632::fpzero) (:%xmm dest))) |
---|
1631 | |
---|
1632 | (define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc) |
---|
1633 | |
---|
1634 | (define-x8632-vinsn misc-element-count-fixnum (((dest :imm)) |
---|
1635 | ((src :lisp)) |
---|
1636 | ((temp :u32))) |
---|
1637 | (movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp)) |
---|
1638 | ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax) |
---|
1639 | (:pred <= (:apply %hard-regspec-value temp) x8632::ebx)) |
---|
1640 | (movb (:$b 0) (:%b temp))) |
---|
1641 | ((:pred > (:apply %hard-regspec-value temp) x8632::ebx) |
---|
1642 | (andl (:$l #xffffff00) (:%l temp))) |
---|
1643 | (movl (:%l temp) (:%l dest)) |
---|
1644 | (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l dest))) |
---|
1645 | |
---|
1646 | |
---|
1647 | |
---|
1648 | (define-x8632-vinsn %logior2 (((dest :imm)) |
---|
1649 | ((x :imm) |
---|
1650 | (y :imm))) |
---|
1651 | ((:pred = |
---|
1652 | (:apply %hard-regspec-value x) |
---|
1653 | (:apply %hard-regspec-value dest)) |
---|
1654 | (orl (:%l y) (:%l dest))) |
---|
1655 | ((:not (:pred = |
---|
1656 | (:apply %hard-regspec-value x) |
---|
1657 | (:apply %hard-regspec-value dest))) |
---|
1658 | ((:pred = |
---|
1659 | (:apply %hard-regspec-value y) |
---|
1660 | (:apply %hard-regspec-value dest)) |
---|
1661 | (orl (:%l x) (:%l dest))) |
---|
1662 | ((:not (:pred = |
---|
1663 | (:apply %hard-regspec-value y) |
---|
1664 | (:apply %hard-regspec-value dest))) |
---|
1665 | (movl (:%l x) (:%l dest)) |
---|
1666 | (orl (:%l y) (:%l dest))))) |
---|
1667 | |
---|
1668 | (define-x8632-vinsn %logand2 (((dest :imm)) |
---|
1669 | ((x :imm) |
---|
1670 | (y :imm))) |
---|
1671 | ((:pred = |
---|
1672 | (:apply %hard-regspec-value x) |
---|
1673 | (:apply %hard-regspec-value dest)) |
---|
1674 | (andl (:%l y) (:%l dest))) |
---|
1675 | ((:not (:pred = |
---|
1676 | (:apply %hard-regspec-value x) |
---|
1677 | (:apply %hard-regspec-value dest))) |
---|
1678 | ((:pred = |
---|
1679 | (:apply %hard-regspec-value y) |
---|
1680 | (:apply %hard-regspec-value dest)) |
---|
1681 | (andl (:%l x) (:%l dest))) |
---|
1682 | ((:not (:pred = |
---|
1683 | (:apply %hard-regspec-value y) |
---|
1684 | (:apply %hard-regspec-value dest))) |
---|
1685 | (movl (:%l x) (:%l dest)) |
---|
1686 | (andl (:%l y) (:%l dest))))) |
---|
1687 | |
---|
1688 | (define-x8632-vinsn %logxor2 (((dest :imm)) |
---|
1689 | ((x :imm) |
---|
1690 | (y :imm))) |
---|
1691 | ((:pred = |
---|
1692 | (:apply %hard-regspec-value x) |
---|
1693 | (:apply %hard-regspec-value dest)) |
---|
1694 | (xorl (:%l y) (:%l dest))) |
---|
1695 | ((:not (:pred = |
---|
1696 | (:apply %hard-regspec-value x) |
---|
1697 | (:apply %hard-regspec-value dest))) |
---|
1698 | ((:pred = |
---|
1699 | (:apply %hard-regspec-value y) |
---|
1700 | (:apply %hard-regspec-value dest)) |
---|
1701 | (xorl (:%l x) (:%l dest))) |
---|
1702 | ((:not (:pred = |
---|
1703 | (:apply %hard-regspec-value y) |
---|
1704 | (:apply %hard-regspec-value dest))) |
---|
1705 | (movl (:%l x) (:%l dest)) |
---|
1706 | (xorl (:%l y) (:%l dest))))) |
---|
1707 | |
---|
1708 | (define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign) |
---|
1709 | |
---|
1710 | (define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref) |
---|
1711 | |
---|
1712 | (define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr) |
---|
1713 | |
---|
1714 | (define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init) |
---|
1715 | |
---|
1716 | (define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc) |
---|
1717 | |
---|
1718 | (define-x8632-vinsn setup-double-float-allocation (() |
---|
1719 | ()) |
---|
1720 | (movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0)) |
---|
1721 | (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8664::imm1.l))) |
---|
1722 | |
---|
1723 | (define-x8632-vinsn set-double-float-value (() |
---|
1724 | ((node :lisp) |
---|
1725 | (val :double-float))) |
---|
1726 | (movsd (:%xmm val) (:@ x8664::double-float.value (:%l node)))) |
---|
1727 | |
---|
1728 | (define-x8632-vinsn %natural+ (((result :u32)) |
---|
1729 | ((result :u32) |
---|
1730 | (other :u32))) |
---|
1731 | (addl (:%l other) (:%l result))) |
---|
1732 | |
---|
1733 | (define-x8632-vinsn %natural+-c (((result :u32)) |
---|
1734 | ((result :u32) |
---|
1735 | (constant :s32const))) |
---|
1736 | (addl (:$l constant) (:%l result))) |
---|
1737 | |
---|
1738 | (define-x8632-vinsn %natural- (((result :u32)) |
---|
1739 | ((result :u32) |
---|
1740 | (other :u32))) |
---|
1741 | (subl (:%l other) (:%l result))) |
---|
1742 | |
---|
1743 | (define-x8632-vinsn %natural--c (((result :u32)) |
---|
1744 | ((result :u32) |
---|
1745 | (constant :s32const))) |
---|
1746 | (subl (:$l constant) (:%l result))) |
---|
1747 | |
---|
1748 | (define-x8632-vinsn %natural-logior (((result :u32)) |
---|
1749 | ((result :u32) |
---|
1750 | (other :u32))) |
---|
1751 | (orl (:%l other) (:%l result))) |
---|
1752 | |
---|
1753 | (define-x8632-vinsn %natural-logior-c (((result :u32)) |
---|
1754 | ((result :u32) |
---|
1755 | (constant :s32const))) |
---|
1756 | (orl (:$l constant) (:%l result))) |
---|
1757 | |
---|
1758 | (define-x8632-vinsn %natural-logand (((result :u32)) |
---|
1759 | ((result :u32) |
---|
1760 | (other :u32))) |
---|
1761 | (andl (:%l other) (:%l result))) |
---|
1762 | |
---|
1763 | (define-x8632-vinsn %natural-logand-c (((result :u32)) |
---|
1764 | ((result :u32) |
---|
1765 | (constant :s32const))) |
---|
1766 | (andl (:$l constant) (:%l result))) |
---|
1767 | |
---|
1768 | (define-x8632-vinsn %natural-logxor (((result :u32)) |
---|
1769 | ((result :u32) |
---|
1770 | (other :u32))) |
---|
1771 | (xorl (:%l other) (:%l result))) |
---|
1772 | |
---|
1773 | (define-x8632-vinsn %natural-logxor-c (((result :u32)) |
---|
1774 | ((result :u32) |
---|
1775 | (constant :s32const))) |
---|
1776 | (xorl (:$l constant) (:%l result))) |
---|
1777 | |
---|
1778 | (define-x8632-vinsn natural-shift-left (((dest :u32)) |
---|
1779 | ((dest :u32) |
---|
1780 | (amt :u8const))) |
---|
1781 | (shll (:$ub amt) (:%l dest))) |
---|
1782 | |
---|
1783 | (define-x8632-vinsn natural-shift-right (((dest :u32)) |
---|
1784 | ((dest :u32) |
---|
1785 | (amt :u8const))) |
---|
1786 | (shrl (:$ub amt) (:%l dest))) |
---|
1787 | |
---|
1788 | (define-x8632-vinsn recover-fn (() |
---|
1789 | ()) |
---|
1790 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1791 | |
---|
1792 | ;;; xxx probably wrong |
---|
1793 | (define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t)) |
---|
1794 | ((spno :s32const) |
---|
1795 | (x t) |
---|
1796 | (y t) |
---|
1797 | (z t)) |
---|
1798 | ((entry (:label 1)))) |
---|
1799 | (:talign 5) |
---|
1800 | (call (:@ spno)) |
---|
1801 | (movl (:$self 0) (:%l x8632::fn))) |
---|
1802 | |
---|
1803 | (queue-fixup |
---|
1804 | (fixup-x86-vinsn-templates |
---|
1805 | *x8632-vinsn-templates* |
---|
1806 | x86::*x86-opcode-template-lists*)) |
---|
1807 | |
---|