close Warning: Can't use blame annotator: 
No changeset 2899 in the repository

source: branches/lscan/source/compiler/X86/X8664/x8664-vinsns.lisp

Last change on this file was 16546, checked in by Gary Byers, 9 years ago

ready to merge into trunk.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 193.0 KB
RevLine 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;; Copyright (C) 2005-2009 Clozure Associates and contributors.
4;;; This file is part of Clozure CL.
5;;;
6;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;; License known as the LLGPL and distributed with Clozure CL as the
8;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL
9;;; which is distributed with Clozure CL as the file "LGPL". Where these
10;;; conflict the preamble takes precedence.
11;;;
12;;; Clozure CL is referenced in the preamble as the "LIBRARY."
13;;;
14;;; The LLGPL is also available online at
15;;; http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel :load-toplevel :execute)
20 (require "VINSN")
21 (require "X8664-BACKEND"))
22
23(eval-when (:compile-toplevel :execute)
24 (require "X8664ENV"))
25
26(defmacro define-x8664-vinsn (vinsn-name (results args &optional temps) &body body)
27 (%define-vinsn *x8664-backend* vinsn-name results args temps body))
28
29
30
31(define-x8664-vinsn scale-32bit-misc-index (((dest :u64))
32 ((idx :imm) ; A fixnum
33 )
34 ())
35 (movq (:%q idx) (:%q dest))
36 (shrq (:$1 1) (:%q dest)))
37
38(define-x8664-vinsn scale-16bit-misc-index (((dest :u64))
39 ((idx :imm)))
40
41 (movq (:%q idx) (:%q dest))
42 (shrq (:$ub 2) (:%q dest)))
43
44(define-x8664-vinsn scale-8bit-misc-index (((dest :u64))
45 ((idx :imm) ; A fixnum
46 )
47 ())
48 (movq (:%q idx) (:%q dest))
49 (shrq (:$ub 3) (:%q dest)))
50
51;;; same as above, but looks better in bit vector contexts
52(define-x8664-vinsn scale-1bit-misc-index (((dest :u64))
53 ((idx :imm) ; A fixnum
54 )
55 ())
56 (movq (:%q idx) (:%q dest))
57 (shrq (:$ub 3) (:%q dest)))
58
59(define-x8664-vinsn misc-ref-u64 (((dest :u64))
60 ((v :lisp)
61 (scaled-idx :imm)))
62 (movq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%q dest)))
63
64(define-x8664-vinsn misc-ref-double-float (((dest :double-float))
65 ((v :lisp)
66 (scaled-idx :imm)))
67 (movsd (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%xmm dest)))
68
69(define-x8664-vinsn misc-ref-complex-single-float (((dest :complex-single-float))
70 ((v :lisp)
71 (scaled-idx :imm)))
72 (movq (:@ x8664::complex-single-float.realpart (:%q v) (:%q scaled-idx)) (:%xmm dest)))
73
74(define-x8664-vinsn misc-ref-complex-double-float (((dest :complex-double-float))
75 ((v :lisp)
76 (scaled-idx :imm)))
77 (movapd (:@ x8664::complex-double-float.realpart (:%q v) (:%q scaled-idx) 2) (:%xmm dest)))
78
79(define-x8664-vinsn misc-ref-c-double-float (((dest :double-float))
80 ((v :lisp)
81 (idx :s32const)))
82 (movsd (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q v)) (:%xmm dest)))
83
84
85(define-x8664-vinsn misc-ref-c-complex-single-float (((dest :complex-single-float))
86 ((v :lisp)
87 (idx :s32const)))
88 (movq (:@ (:apply + x8664::complex-single-float.realpart (:apply ash idx x8664::word-shift)) (:%q v)) (:%xmm dest)))
89
90(define-x8664-vinsn misc-ref-node (((dest :lisp))
91 ((v :lisp)
92 (scaled-idx :imm)))
93 (movq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%q dest)))
94
95(define-x8664-vinsn (push-misc-ref-node :push :node :vsp) (()
96 ((v :lisp)
97 (scaled-idx :imm)))
98 (pushq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
99
100(define-x8664-vinsn misc-set-node (()
101 ((val :lisp)
102 (v :lisp)
103 (unscaled-idx :imm))
104 ())
105 (movq (:%q val) (:@ x8664::misc-data-offset (:%q v) (:%q unscaled-idx))))
106
107(define-x8664-vinsn misc-set-immediate-node (()
108 ((val :s32const)
109 (v :lisp)
110 (unscaled-idx :imm))
111 ())
112 (movq (:$l val) (:@ x8664::misc-data-offset (:%q v) (:%q unscaled-idx))))
113
114
115(define-x8664-vinsn misc-set-double-float (()
116 ((val :double-float)
117 (v :lisp)
118 (unscaled-idx :imm))
119 ())
120 (movsd (:%xmm val) (:@ x8664::misc-data-offset (:%q v) (:%q unscaled-idx))))
121
122(define-x8664-vinsn misc-set-complex-single-float (()
123 ((val :complex-single-float)
124 (v :lisp)
125 (unscaled-idx :imm))
126 ())
127 (movq (:%xmm val) (:@ x8664::complex-single-float.realpart (:%q v) (:%q unscaled-idx))))
128
129(define-x8664-vinsn misc-set-complex-double-float (()
130 ((val :complex-double-float)
131 (v :lisp)
132 (unscaled-idx :imm))
133 ())
134 (movapd (:%xmm val) (:@ x8664::complex-double-float.realpart (:%q v) (:%q unscaled-idx) 2)))
135
136(define-x8664-vinsn misc-ref-u8 (((dest :u8))
137 ((v :lisp)
138 (scaled-idx :s64)))
139 (movzbl (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%l dest)))
140
141(define-x8664-vinsn misc-ref-s8 (((dest :s8))
142 ((v :lisp)
143 (scaled-idx :s64)))
144 (movsbq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%q dest)))
145
146(define-x8664-vinsn misc-ref-u16 (((dest :u16))
147 ((v :lisp)
148 (scaled-idx :s64)))
149 (movzwl (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%l dest)))
150
151(define-x8664-vinsn misc-ref-u32 (((dest :u32))
152 ((v :lisp)
153 (scaled-idx :s64)))
154 (movl (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%l dest)))
155
156
157(define-x8664-vinsn misc-ref-single-float (((dest :single-float))
158 ((v :lisp)
159 (scaled-idx :s64)))
160 (movss(:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%xmm dest)))
161
162(define-x8664-vinsn misc-ref-s32 (((dest :s32))
163 ((v :lisp)
164 (scaled-idx :s64)))
165 (movslq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%q dest)))
166
167(define-x8664-vinsn misc-ref-s16 (((dest :s16))
168 ((v :lisp)
169 (scaled-idx :s64)))
170 (movswq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%q dest)))
171
172(define-x8664-vinsn misc-ref-s64 (((dest :s64))
173 ((v :lisp)
174 (scaled-idx :imm)))
175 (movq (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx)) (:%q dest)))
176
177
178(define-x8664-vinsn misc-ref-c-node (((dest :lisp))
179 ((v :lisp)
180 (idx :u32const)) ; sic
181 ())
182 (movq (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q v)) (:%q dest)))
183
184
185(define-x8664-vinsn (push-misc-ref-c-node :push :node :vsp)
186 (()
187 ((v :lisp)
188 (idx :u32const)) ; sic
189 ())
190 (pushq (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q v))))
191
192(define-x8664-vinsn misc-ref-c-u64 (((dest :u64))
193 ((v :lisp)
194 (idx :u32const)) ; sic
195 ())
196 (movq (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q v)) (:%q dest)))
197
198
199(define-x8664-vinsn misc-ref-c-s64 (((dest :s64))
200 ((v :lisp)
201 (idx :s32const)) ; sic
202 ())
203 (movq (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q v)) (:%q dest)))
204
205
206(define-x8664-vinsn misc-ref-c-u32 (((dest :u32))
207 ((v :lisp)
208 (idx :u32const)) ; sic
209 ())
210 (movl (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v)) (:%l dest)))
211
212(define-x8664-vinsn misc-ref-c-s32 (((dest :s32))
213 ((v :lisp)
214 (idx :s32const)) ; sic
215 ())
216 (movslq (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q v)) (:%q dest)))
217
218(define-x8664-vinsn misc-ref-c-single-float (((dest :single-float))
219 ((v :lisp)
220 (idx :s32const)) ; sic
221 ())
222 (movss (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v)) (:%xmm dest)))
223
224(define-x8664-vinsn misc-ref-c-u8 (((dest :u64))
225 ((v :lisp)
226 (idx :s32const)) ; sic
227 ())
228 (movzbl (:@ (:apply + x8664::misc-data-offset idx) (:%q v)) (:%l dest)))
229
230(define-x8664-vinsn misc-ref-c-s8 (((dest :s64))
231 ((v :lisp)
232 (idx :s32const)) ; sic
233 ())
234 (movsbq (:@ (:apply + x8664::misc-data-offset idx) (:%q v)) (:%q dest)))
235
236(define-x8664-vinsn misc-set-u64 (()
237 ((val :u64)
238 (v :lisp)
239 (idx :u64)))
240 (movq (:%q val) (:@ x8664::misc-data-offset (:%q v) (:%q idx))))
241
242(define-x8664-vinsn misc-set-immediate-u64 (()
243 ((val :u32const)
244 (v :lisp)
245 (idx :u64)))
246 (movq (:$l val) (:@ x8664::misc-data-offset (:%q v) (:%q idx))))
247
248(define-x8664-vinsn misc-set-c-u64 (()
249 ((val :u64)
250 (v :lisp)
251 (idx :u32const)))
252 (movq (:%q val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
253
254(define-x8664-vinsn misc-set-immediate-c-u64 (()
255 ((val :u32const)
256 (v :lisp)
257 (idx :u32const)))
258 (movq (:$l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
259
260(define-x8664-vinsn misc-set-s64 (()
261 ((val :s64)
262 (v :lisp)
263 (scaled-idx :imm)))
264 (movq (:%q val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
265
266(define-x8664-vinsn misc-set-immediate-s64 (()
267 ((val :s32const)
268 (v :lisp)
269 (scaled-idx :imm)))
270 (movq (:$l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
271
272
273(define-x8664-vinsn misc-set-c-s64 (()
274 ((val :s64)
275 (v :lisp)
276 (idx :s32const)))
277 (movq (:%q val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
278
279(define-x8664-vinsn misc-set-immediate-c-s64 (()
280 ((val :s32const)
281 (v :lisp)
282 (idx :s32const)))
283 (movq (:$l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
284
285
286(define-x8664-vinsn misc-set-c-node (()
287 ((val :lisp)
288 (v :lisp)
289 (idx :s32const)))
290 (movq (:%q val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
291
292
293
294
295(define-x8664-vinsn misc-set-immediate-c-node (()
296 ((val :s32const)
297 (v :lisp)
298 (idx :s32const)))
299 (movq (:$l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
300
301(define-x8664-vinsn set-closure-forward-reference (()
302 ((val :lisp)
303 (closure :lisp)
304 (idx :s32const)))
305 (movq (:%q val) (:@ (:apply + x8664::misc-function-offset (:apply ash idx x8664::word-shift)) (:%q closure))))
306
307
308(define-x8664-vinsn misc-set-c-double-float (()
309 ((val :double-float)
310 (v :lisp)
311 (idx :s32const)))
312 (movsd (:%xmm val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 3)) (:%q v))))
313
314
315
316(define-x8664-vinsn (call-known-symbol :call) (((result (:lisp x8664::arg_z)))
317 ()
318 ((entry (:label 1))))
319 (:talign 4)
320 (call (:@ x8664::symbol.fcell (:% x8664::fname)))
321 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
322
323
324(define-x8664-vinsn (jump-known-symbol :jumplr) (()
325 ())
326
327 (jmp (:@ x8664::symbol.fcell (:% x8664::fname))))
328
329(define-x8664-vinsn set-nargs (()
330 ((n :s16const)))
331 ((:pred = n 0)
332 (xorl (:%l x8664::nargs ) (:%l x8664::nargs )))
333 ((:not (:pred = n 0))
334 (movl (:$l (:apply ash n x8664::word-shift)) (:%l x8664::nargs ))))
335
336(define-x8664-vinsn check-exact-nargs (()
337 ((n :u16const)))
338 :resume
339 ((:pred = n 0)
340 (testl (:%l x8664::nargs) (:%l x8664::nargs)))
341 ((:not (:pred = n 0))
342 ((:pred < n 16)
343 (cmpl (:$b (:apply ash n x8664::word-shift)) (:%l x8664::nargs)))
344 ((:pred >= n 16)
345 (cmpl (:$l (:apply ash n x8664::word-shift)) (:%l x8664::nargs))))
346 (jne :bad)
347 (:anchored-uuo-section :resume)
348 :bad
349 (:anchored-uuo (uuo-error-wrong-number-of-args)))
350
351(define-x8664-vinsn check-min-nargs (()
352 ((min :u16const)))
353 :resume
354 ((:pred = min 1)
355 (testl (:%l x8664::nargs) (:%l x8664::nargs))
356 (je :toofew))
357 ((:not (:pred = min 1))
358 ((:pred < min 16)
359 (rcmpl (:%l x8664::nargs) (:$b (:apply ash min x8664::word-shift))))
360 ((:pred >= min 16)
361 (rcmpl (:%l x8664::nargs) (:$l (:apply ash min x8664::word-shift))))
362 (jb :toofew))
363
364 (:anchored-uuo-section :resume)
365 :toofew
366 (:anchored-uuo (uuo-error-too-few-args)))
367
368(define-x8664-vinsn check-max-nargs (()
369 ((n :u16const)))
370 :resume
371 ((:pred < n 16)
372 (rcmpl (:%l x8664::nargs) (:$b (:apply ash n x8664::word-shift))))
373 ((:pred >= n 16)
374 (rcmpl (:%l x8664::nargs) (:$l (:apply ash n x8664::word-shift))))
375 (ja :bad)
376
377 (:anchored-uuo-section :resume)
378 :bad
379 (:anchored-uuo (uuo-error-too-many-args)))
380
381
382(define-x8664-vinsn check-min-max-nargs (()
383 ((min :u16const)
384 (max :u16const)))
385 :resume
386 ((:pred = min 1)
387 (testl (:%l x8664::nargs) (:%l x8664::nargs))
388 (je :toofew))
389 ((:not (:pred = min 1))
390 ((:pred < min 16)
391 (rcmpl (:%l x8664::nargs) (:$b (:apply ash min x8664::word-shift))))
392 ((:pred >= min 16)
393 (rcmpl (:%l x8664::nargs) (:$l (:apply ash min x8664::word-shift))))
394 (jb :toofew))
395 ((:pred < max 16)
396 (rcmpl (:%l x8664::nargs) (:$b (:apply ash max x8664::word-shift))))
397 ((:pred >= max 16)
398 (rcmpl (:%l x8664::nargs) (:$l (:apply ash max x8664::word-shift))))
399 (ja :toomany)
400
401 (:anchored-uuo-section :resume)
402 :toofew
403 (:anchored-uuo (uuo-error-too-few-args))
404 (:anchored-uuo-section :resume)
405 :toomany
406 (:anchored-uuo (uuo-error-too-many-args)))
407
408
409(define-x8664-vinsn default-1-arg (()
410 ((min :u16const)))
411 ((:pred < min 16)
412 (rcmpl (:%l x8664::nargs) (:$b (:apply ash min x8664::word-shift))))
413 ((:pred >= min 16)
414 (rcmpl (:%l x8664::nargs) (:$l (:apply ash min x8664::word-shift))))
415 (jne :done)
416 ((:pred >= min 3)
417 (pushq (:%q x8664::arg_x)))
418 ((:pred >= min 2)
419 (movq (:%q x8664::arg_y) (:%q x8664::arg_x)))
420 ((:pred >= min 1)
421 (movq (:%q x8664::arg_z) (:%q x8664::arg_y)))
422 (movq (:$l (:apply target-nil-value)) (:%q x8664::arg_z))
423 :done)
424
425
426(define-x8664-vinsn default-2-args (()
427 ((min :u16const)))
428 ((:pred < (:apply 1+ min) 16)
429 (rcmpl (:%l x8664::nargs ) (:$b (:apply ash (:apply 1+ min) x8664::word-shift))))
430 ((:pred >= (:apply 1+ min) 16)
431 (rcmpl (:%l x8664::nargs ) (:$l (:apply ash (:apply 1+ min) x8664::word-shift))))
432 (ja :done)
433 (je :one)
434 ;; We got "min" args; arg_y & arg_z default to nil
435 ((:pred >= min 3)
436 (pushq (:%q x8664::arg_x)))
437 ((:pred >= min 2)
438 (pushq (:%q x8664::arg_y)))
439 ((:pred >= min 1)
440 (movq (:%q x8664::arg_z) (:%q x8664::arg_x)))
441 (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_y))
442 (jmp :last)
443 :one
444 ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
445 ((:pred >= min 2)
446 (pushq (:%q x8664::arg_x)))
447 ((:pred >= min 1)
448 (movq (:%q x8664::arg_y) (:%q x8664::arg_x)))
449 (movq (:%q x8664::arg_z) (:%q x8664::arg_y))
450 :last
451 (movq (:$l (:apply target-nil-value)) (:%q x8664::arg_z))
452 :done)
453
454(define-x8664-vinsn default-3-args (()
455 ((min :u16const)))
456 ((:pred < (:apply + 2 min) 16)
457 (rcmpl (:%l x8664::nargs ) (:$b (:apply ash (:apply + 2 min) x8664::word-shift))))
458 ((:pred >= (:apply + 2 min) 16)
459 (rcmpl (:%l x8664::nargs ) (:$l (:apply ash (:apply + 2 min) x8664::word-shift))))
460 (ja :done)
461 (je :two)
462 ((:pred < min 16)
463 (rcmpl (:%l x8664::nargs ) (:$b (:apply ash min x8664::word-shift))))
464 ((:pred >= min 16)
465 (rcmpl (:%l x8664::nargs ) (:$l (:apply ash min x8664::word-shift))))
466 (je :none)
467 ;; The first (of three) &optional args was supplied.
468 ((:pred >= min 2)
469 (pushq (:%q x8664::arg_x)))
470 ((:pred >= min 1)
471 (pushq (:%q x8664::arg_y)))
472 (movq (:%q x8664::arg_z) (:%q x8664::arg_x))
473 (jmp :last-2)
474 :two
475 ;; The first two (of three) &optional args were supplied.
476 ((:pred >= min 1)
477 (pushq (:%q x8664::arg_x)))
478 (movq (:%q x8664::arg_y) (:%q x8664::arg_x))
479 (movq (:%q x8664::arg_z) (:%q x8664::arg_y))
480 (jmp :last-1)
481 ;; None of the three &optional args was provided.
482 :none
483 ((:pred >= min 3)
484 (pushq (:%q x8664::arg_x)))
485 ((:pred >= min 2)
486 (pushq (:%q x8664::arg_y)))
487 ((:pred >= min 1)
488 (pushq (:%q x8664::arg_z)))
489 (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_x))
490 :last-2
491 (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_y))
492 :last-1
493 (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_z))
494 :done)
495
496
497(define-x8664-vinsn default-optionals (()
498 ((n :u16const))
499 ((temp :u64)))
500 ((:pred < n 16)
501 (rcmpl (:%l x8664::nargs) (:$b (:apply ash n x8664::word-shift))))
502 ((:pred >= n 16)
503 (rcmpl (:%l x8664::nargs) (:$l (:apply ash n x8664::word-shift))))
504 (movl (:%l x8664::nargs) (:%l temp))
505 (jae :done)
506 :loop
507 (addl (:$b x8664::fixnumone) (:%l temp))
508 ((:pred < n 16)
509 (cmpl (:$b (:apply ash n x8664::word-shift)) (:%l temp)))
510 ((:pred >= n 16)
511 (cmpl (:$l (:apply ash n x8664::word-shift)) (:%l temp)))
512 (pushq (:$l (:apply target-nil-value)))
513 (jne :loop)
514 :done)
515
516
517(define-x8664-vinsn (save-lisp-context-no-stack-args :uses-frame-pointer) (()
518 ())
519 (pushq (:%q x8664::rbp))
520 (movq (:%q x8664::rsp) (:%q x8664::rbp)))
521
522
523(define-x8664-vinsn (save-lisp-context-offset :needs-frame-pointer) (()
524 ((nbytes-pushed :s32const)))
525 (movq (:%q x8664::rbp) (:@ (:apply + nbytes-pushed x8664::node-size) (:%q x8664::rsp)))
526 (leaq (:@ (:apply + nbytes-pushed x8664::node-size) (:%q x8664::rsp)) (:%q x8664::rbp))
527 (popq (:@ x8664::node-size (:%q x8664::rbp))))
528
529(define-x8664-vinsn (save-lisp-context-variable-arg-count :needs-frame-pointer) (()
530 ()
531 ((temp :u64)))
532 (movl (:%l x8664::nargs) (:%l temp))
533 (subq (:$b (* $numx8664argregs x8664::node-size)) (:%q temp))
534 (jle :push)
535 (movq (:%q x8664::rbp) (:@ x8664::node-size (:%q x8664::rsp) (:%q temp)))
536 (leaq (:@ x8664::node-size (:%q x8664::rsp) (:%q temp)) (:%q x8664::rbp))
537 (popq (:@ 8 (:%q x8664::rbp)))
538 (jmp :done)
539 :push
540 (pushq (:%q x8664::rbp))
541 (movq (:%q x8664::rsp) (:%q x8664::rbp))
542 :done)
543
544;;; We know that some args were pushed, but don't know how many were
545;;; passed.
546(define-x8664-vinsn (save-lisp-context-in-frame :needs-frame-pointer) (()
547 ()
548 ((temp :u64)))
549 (movl (:%l x8664::nargs) (:%l temp))
550 (subq (:$b (* $numx8664argregs x8664::node-size)) (:%q temp))
551 (movq (:%q x8664::rbp) (:@ x8664::node-size (:%q x8664::rsp) (:%q temp)))
552 (leaq (:@ x8664::node-size (:%q x8664::rsp) (:%q temp)) (:%q x8664::rbp))
553 (popq (:@ x8664::node-size (:%q x8664::rbp))))
554
555
556(define-x8664-vinsn (vpush-register :push :node :vsp)
557 (()
558 ((reg :lisp)))
559 (pushq (:% reg)))
560
561(define-x8664-vinsn (vpush-fixnum :push :node :vsp)
562 (()
563 ((const :s32const)))
564 ((:and (:pred < const 128) (:pred >= const -128))
565 (pushq (:$b const)))
566 ((:not (:and (:pred < const 128) (:pred >= const -128)))
567 (pushq (:$l const))))
568
569
570
571(define-x8664-vinsn (vframe-load :vsp :ref :needs-frame-pointer)
572 (((dest :lisp))
573 ((frame-offset :stack-offset)
574 (cur-vsp :stack-offset)))
575 (movq (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp)) (:%q dest)))
576
577(define-x8664-vinsn (compare-vframe-offset-to-nil :vsp :ref :needs-frame-pointer)
578 (()
579 ((frame-offset :u16const)
580 (cur-vsp :u16const)))
581 (cmpb (:$b x8664::fulltag-nil) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
582
583(define-x8664-vinsn (compare-vframe-offset-to-fixnum :vsp :ref :needs-frame-pointer)
584 (()
585 ((frame-offset :stack-offset)
586 (cur-vsp :stack-offset)
587 (fixval :s32const)))
588 ((:and (:pred < fixval 128) (:pred >= fixval -128))
589 (cmpq (:$b fixval) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
590 ((:not (:and (:pred < fixval 128) (:pred >= fixval -128)))
591 (cmpq (:$l fixval) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp)))))
592
593
594(define-x8664-vinsn (add-constant-to-vframe-offset :vsp :ref :set :needs-frame-pointer)
595 (()
596 ((frame-offset :stack-offset)
597 (cur-vsp :stack-offset)
598 (constant :s32const)))
599 ((:and (:pred < constant 128) (:pred >= constant -128))
600 (addq (:$b constant) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
601 ((:not (:and (:pred < constant 128) (:pred >= constant -128)))
602 (addq (:$l constant) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp)))))
603
604
605(define-x8664-vinsn compare-value-cell-to-nil (()
606 ((vcell :lisp)))
607 (cmpb (:$b x8664::fulltag-nil) (:@ x8664::value-cell.value (:%q vcell))))
608
609
610
611(define-x8664-vinsn (vframe-push :push :node :vsp :ref :needs-frame-pointer)
612 (()
613 ((frame-offset :stack-offset)
614 (cur-vsp :stack-offset)))
615 (pushq (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
616
617(define-x8664-vinsn (vframe-store :vsp :set :needs-frame-pointer)
618 (()
619 ((src :lisp)
620 (frame-offset :stack-offset)
621 (cur-vsp :stack-offset)))
622 (movq (:%q src) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
623
624
625
626
627
628
629
630(define-x8664-vinsn (restore-full-lisp-context :lispcontext :pop :vsp :uses-frame-pointer)
631 (()
632 ())
633 (leave))
634
635(define-x8664-vinsn compare-to-nil (()
636 ((arg0 t)))
637 (cmpb (:$b x8664::fulltag-nil) (:%b arg0)))
638
639(define-x8664-vinsn compare-to-t (()
640 ((arg0 t)))
641 (cmpq (:$l (:apply target-t-value)) (:%q arg0)))
642
643(define-x8664-vinsn ref-constant (((dest :lisp))
644 ((lab :label)))
645 (movq (:@ (:^ lab) (:%q x8664::fn)) (:%q dest)))
646
647(define-x8664-vinsn compare-constant-to-register (()
648 ((lab :label)
649 (reg :lisp)))
650 (cmpq (:@ (:^ lab) (:%q x8664::fn)) (:%q reg)))
651
652
653(define-x8664-vinsn (vpush-constant :push :node :vsp) (()
654 ((lab :label)))
655 (pushq (:@ (:^ lab) (:%q x8664::fn))))
656
657
658(define-x8664-vinsn (jump :jump)
659 (()
660 ((label :label)))
661 (jmp label))
662
663(define-x8664-vinsn (cbranch-true :branch) (()
664 ((label :label)
665 (crbit :u8const)))
666 (jcc (:$ub crbit) label))
667
668(define-x8664-vinsn (cbranch-false :branch) (()
669 ((label :label)
670 (crbit :u8const)))
671 (jcc (:$ub (:apply logxor 1 crbit)) label))
672
673
674(define-x8664-vinsn (lri :constant-ref) (((dest :imm))
675 ((intval :s64const))
676 ())
677 ((:pred = intval 0)
678 (xorl (:%l dest) (:%l dest)))
679 ((:and (:pred /= intval 0)
680 (:pred >= intval -2147483648)
681 (:pred <= intval #xffffffff))
682 ((:pred > intval 0)
683 (movl (:$l intval) (:%l dest)))
684 ((:pred < intval 0)
685 (movq (:$l intval) (:%q dest))))
686 ((:or (:pred < intval -2147483648)
687 (:pred > intval #xffffffff))
688 (movq (:$q (:apply logand #xffffffffffffffff intval)) (:%q dest))))
689
690(define-x8664-vinsn (lriu :constant-ref) (((dest :imm))
691 ((intval :u64const))
692 ())
693 ((:pred = intval 0)
694 (xorl (:%l dest) (:%l dest)))
695 ((:and (:pred > intval 0)
696 (:pred <= intval #xffffffff))
697 (movl (:$l intval) (:%l dest)))
698 ((:pred > intval #xffffffff)
699 (movq (:$q (:apply logand #xffffffffffffffff intval)) (:%q dest))))
700
701(define-x8664-vinsn trap-unless-bit (()
702 ((value :lisp)))
703 :resume
704 (testq (:$l (lognot x8664::fixnumone)) (:%q value))
705 (jne :bad)
706
707 (:anchored-uuo-section :resume)
708 :bad
709 (:anchored-uuo (uuo-error-reg-not-type (:%q value) (:$ub arch::error-object-not-bit)))
710 )
711
712(define-x8664-vinsn trap-unless-list (()
713 ((object :lisp))
714 ((tag :u8)))
715 :resume
716 (movl (:%l object) (:%l tag))
717 (andl (:$b x8664::tagmask) (:%l tag))
718 (cmpl (:$b x8664::tag-list) (:%l tag))
719 (jne :bad)
720
721 (:anchored-uuo-section :resume)
722 :bad
723 (:anchored-uuo (uuo-error-reg-not-list (:%q object))))
724
725
726
727(define-x8664-vinsn trap-unless-cons (()
728 ((object :lisp))
729 ((tag :u8)))
730 :resume
731 (movl (:%l object) (:%l tag))
732 (andl (:$b x8664::fulltagmask) (:%l tag))
733 (cmpl (:$b x8664::fulltag-cons) (:%l tag))
734 (jne :bad)
735
736 (:anchored-uuo-section :resume)
737 :bad
738 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::fulltag-cons))))
739
740(define-x8664-vinsn set-z-flag-if-consp (()
741 ((object :lisp))
742 ((tag :u8)))
743 (movl (:%l object) (:%l tag))
744 (andl (:$b x8664::fulltagmask) (:%l tag))
745 (cmpl (:$b x8664::fulltag-cons) (:%l tag)))
746
747(define-x8664-vinsn trap-unless-uvector (()
748 ((object :lisp))
749 ((tag :u8)))
750 :resume
751 (movl (:%l object) (:%l tag))
752 (andl (:$b x8664::tagmask) (:%l tag))
753 (cmpl (:$b x8664::tag-misc) (:%l tag))
754 (jne :bad)
755
756 (:anchored-uuo-section :resume)
757 :bad
758 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::tag-misc))))
759
760(define-x8664-vinsn trap-unless-single-float (()
761 ((object :lisp)))
762 :resume
763 (cmpb (:$b x8664::tag-single-float) (:%b object))
764 (jne :bad)
765
766 (:anchored-uuo-section :resume)
767 :bad
768 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::tag-single-float))))
769
770(define-x8664-vinsn trap-unless-character (()
771 ((object :lisp)))
772 :resume
773 (cmpb (:$b x8664::subtag-character) (:%b object))
774 (jne :bad)
775
776 (:anchored-uuo-section :resume)
777 :bad
778 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-character))))
779
780(define-x8664-vinsn trap-unless-fixnum (()
781 ((object :lisp))
782 ())
783 :resume
784 (testb (:$b x8664::tagmask) (:%b object))
785 (jne :bad)
786
787 (:anchored-uuo-section :resume)
788 :bad
789 (:anchored-uuo (uuo-error-reg-not-fixnum (:%q object))))
790
791(define-x8664-vinsn set-flags-from-lisptag (()
792 ((reg :lisp)))
793 (testb (:$b x8664::tagmask) (:%b reg)))
794
795
796(define-x8664-vinsn trap-unless-typecode= (()
797 ((object :lisp)
798 (tagval :u16const))
799 ((tag :u8)))
800 :resume
801 (movl (:%l object) (:%l tag))
802 (andl (:$b x8664::tagmask) (:%l tag))
803 (cmpl (:$b x8664::tag-misc) (:%l tag))
804 (jne :have-tag)
805 ;; This needs to be a sign-extending mov, since the cmpl below
806 ;; will sign-extend the 8-bit constant operand.
807 (movsbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
808 :have-tag
809 (cmpl (:$b tagval) (:%l tag))
810 (jne :bad)
811 (:anchored-uuo-section :resume)
812 :bad
813 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub tagval))))
814
815(define-x8664-vinsn trap-unless-double-float (()
816 ((object :lisp))
817 ((tag :u8)))
818 :resume
819 (movl (:%l object) (:%l tag))
820 (andl (:$b x8664::tagmask) (:%l tag))
821 (cmpl (:$b x8664::tag-misc) (:%l tag))
822 (jne :have-tag)
823 (movsbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
824 :have-tag
825 (cmpl (:$b x8664::subtag-double-float) (:%l tag))
826 (jne :bad)
827 (:anchored-uuo-section :resume)
828 :bad
829 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-double-float))))
830
831(define-x8664-vinsn trap-unless-complex-double-float (()
832 ((object :lisp))
833 ((tag :u8)))
834 :resume
835 (movl (:%l object) (:%l tag))
836 (andl (:$b x8664::tagmask) (:%l tag))
837 (cmpl (:$b x8664::tag-misc) (:%l tag))
838 (jne :have-tag)
839 (movsbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
840 :have-tag
841 (cmpl (:$b x8664::subtag-complex-double-float) (:%l tag))
842 (jne :bad)
843 (:anchored-uuo-section :resume)
844 :bad
845 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-complex-double-float))))
846
847(define-x8664-vinsn trap-unless-complex-single-float (()
848 ((object :lisp))
849 ((tag :u8)))
850 :resume
851 (movl (:%l object) (:%l tag))
852 (andl (:$b x8664::tagmask) (:%l tag))
853 (cmpl (:$b x8664::tag-misc) (:%l tag))
854 (jne :have-tag)
855 (movsbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
856 :have-tag
857 (cmpl (:$b x8664::subtag-complex-single-float) (:%l tag))
858 (jne :bad)
859 (:anchored-uuo-section :resume)
860 :bad
861 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-complex-single-float))))
862
863
864
865
866(define-x8664-vinsn trap-unless-macptr (()
867 ((object :lisp))
868 ((tag :u8)))
869 :resume
870 (movl (:%l object) (:%l tag))
871 (andl (:$b x8664::tagmask) (:%l tag))
872 (cmpl (:$b x8664::tag-misc) (:%l tag))
873 (jne :have-tag)
874 (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
875 :have-tag
876 (cmpb (:$b x8664::subtag-macptr) (:%b tag))
877 (jne :bad)
878
879 (:anchored-uuo-section :resume)
880 :bad
881 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-macptr))))
882
883
884(define-x8664-vinsn check-misc-bound (()
885 ((idx :imm)
886 (v :lisp))
887 ((temp :u64)))
888 :resume
889 (movq (:@ x8664::misc-header-offset (:%q v)) (:%q temp))
890 (shrq (:$ub x8664::num-subtag-bits) (:%q temp))
891 (shlq (:$ub x8664::fixnumshift) (:%q temp))
892 (rcmpq (:%q idx) (:%q temp))
893 (jae :bad)
894
895 (:anchored-uuo-section :resume)
896 :bad
897 (:anchored-uuo (uuo-error-vector-bounds (:%q idx) (:%q v))))
898
899(define-x8664-vinsn check-vector-header-bound (()
900 ((v :lisp)
901 (idx :imm)))
902 :resume
903 (cmpq (:@ x8664::vectorH.physsize (:%q v)) (:%q idx))
904 (jae :bad)
905 (:anchored-uuo-section :resume)
906 :bad
907 (:anchored-uuo (uuo-error-vector-bounds (:%q idx) (:%q v))))
908
909(define-x8664-vinsn deref-vector-header (((vector :lisp)
910 (index :lisp))
911 ((vector :lisp)
912 (index :lisp)))
913 :again
914 (addq (:@ x8664::vectorH.displacement (:%q vector)) (:%q index))
915 (btw (:$ub (+ x8664::fixnumshift $arh_disp_bit)) (:@ x8664::vectorH.flags (:%q vector)))
916 (movq (:@ x8664::vectorH.data-vector (:%q vector)) (:%q vector))
917 (jb :again))
918
919
920(define-x8664-vinsn %cdr (((dest :lisp))
921 ((src :lisp)))
922 (movq (:@ x8664::cons.cdr (:%q src)) (:%q dest)))
923
924(define-x8664-vinsn (%vpush-cdr :push :node :vsp)
925 (()
926 ((src :lisp)))
927 (pushq (:@ x8664::cons.cdr (:%q src))))
928
929(define-x8664-vinsn %car (((dest :lisp))
930 ((src :lisp)))
931 (movq (:@ x8664::cons.car (:%q src)) (:%q dest)))
932
933(define-x8664-vinsn (%vpush-car :push :node :vsp)
934 (()
935 ((src :lisp)))
936 (pushq (:@ x8664::cons.car (:%q src))))
937
938
939(define-x8664-vinsn u32->char (((dest :lisp)
940 (src :u8))
941 ((src :u8))
942 ())
943 (shll (:$ub x8664::charcode-shift) (:%l src))
944 (leaq (:@ x8664::subtag-character (:%q src)) (:%q dest)))
945
946
947(define-x8664-vinsn (load-nil :constant-ref) (((dest t))
948 ())
949 (movl (:$l (:apply target-nil-value)) (:%l dest)))
950
951
952(define-x8664-vinsn (load-t :constant-ref) (((dest t))
953 ())
954 (movl(:$l (:apply target-t-value)) (:%l dest)))
955
956
957(define-x8664-vinsn extract-tag (((tag :u8))
958 ((object :lisp)))
959 (movl (:%l object) (:%l tag))
960 (andl (:$b x8664::tagmask) (:%l tag)))
961
962(define-x8664-vinsn extract-tag-fixnum (((tag :imm))
963 ((object :lisp)))
964 ((:pred =
965 (:apply %hard-regspec-value tag)
966 (:apply %hard-regspec-value object))
967 (shll (:$ub x8664::fixnumshift) (:%l object)))
968 ((:not (:pred =
969 (:apply %hard-regspec-value tag)
970 (:apply %hard-regspec-value object)))
971 (imull (:$b x8664::fixnumone) (:%l object) (:%l tag)))
972 (andl (:$b (ash x8664::tagmask x8664::fixnumshift)) (:%l tag)))
973
974(define-x8664-vinsn extract-fulltag (((tag :u8))
975 ((object :lisp)))
976 (movl (:%l object) (:%l tag))
977 (andl (:$b x8664::fulltagmask) (:%l tag)))
978
979(define-x8664-vinsn extract-fulltag-fixnum (((tag :imm))
980 ((object :lisp)))
981 ((:pred =
982 (:apply %hard-regspec-value tag)
983 (:apply %hard-regspec-value object))
984 (shll (:$ub x8664::fixnumshift) (:%l object)))
985 ((:not (:pred =
986 (:apply %hard-regspec-value tag)
987 (:apply %hard-regspec-value object)))
988 (imull (:$b x8664::fixnumone) (:%l object) (:%l tag)))
989 (andl (:$b (ash x8664::fulltagmask x8664::fixnumshift)) (:%l tag)))
990
991(define-x8664-vinsn extract-typecode (((tag :u32))
992 ((object :lisp)))
993 (movl (:%l object) (:%l tag))
994 (andl (:$b x8664::tagmask) (:%l tag))
995 (cmpl (:$b x8664::tag-misc) (:%l tag))
996 (jne :have-tag)
997 (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
998 :have-tag)
999
1000(define-x8664-vinsn extract-typecode-fixnum (((tag :imm))
1001 ((object :lisp))
1002 ((temp :u32)))
1003 (movl (:%l object) (:%l temp))
1004 (andl (:$b x8664::tagmask) (:%l temp))
1005 (cmpl (:$b x8664::tag-misc) (:%l temp))
1006 (jne :have-tag)
1007 (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l temp))
1008 :have-tag
1009 (imulq (:$b x8664::fixnumone) (:%q temp) (:%q tag)))
1010
1011
1012(define-x8664-vinsn compare-reg-to-zero (()
1013 ((reg :imm)))
1014 (testq (:%q reg) (:%q reg)))
1015
1016(define-x8664-vinsn compare-u8-reg-to-zero (()
1017 ((reg :u8)))
1018 (testb (:%b reg) (:%b reg)))
1019
1020(define-x8664-vinsn cr-bit->boolean (((dest :lisp))
1021 ((crbit :u8const))
1022 ((true :u64)))
1023 (movl (:$l (:apply target-t-value)) (:%l true))
1024 (movl (:$l (:apply target-nil-value)) (:%l dest))
1025 (cmovccl (:$ub crbit) (:%l true) (:%l dest)))
1026
1027
1028
1029
1030
1031(define-x8664-vinsn compare-s32-constant (()
1032 ((val :imm)
1033 (const :s32const)))
1034 ((:or (:pred < const -128) (:pred > const 127))
1035 (rcmpq (:%q val) (:$l const)))
1036 ((:not (:or (:pred < const -128) (:pred > const 127)))
1037 (rcmpq (:%q val) (:$b const))))
1038
1039(define-x8664-vinsn compare-u31-constant (()
1040 ((val :u64)
1041 (const :u32const)))
1042 ((:pred > const 127)
1043 (rcmpq (:%q val) (:$l const)))
1044 ((:not (:pred > const 127))
1045 (rcmpq (:%q val) (:$b const))))
1046
1047(define-x8664-vinsn compare-u8-constant (()
1048 ((val :u8)
1049 (const :u8const)))
1050 #|
1051 ((:pred logbitp 7 const)
1052 (movzbl (:%b val) (:%l val))
1053 (rcmpw (:%w val) (:$w const)))
1054 ((:not (:pred logbitp 7 const))
1055 (rcmpb (:%b val) (:$b const)))
1056 ||#
1057 (rcmpb (:%b val) (:$b const))
1058 )
1059
1060(define-x8664-vinsn allocate-cons-cell (((allocptr :lisp)) ; must be x8664::allocptr
1061 ())
1062 (subq (:$b (- x8664::cons.size x8664::fulltag-cons)) (:rcontext x8664::tcr.save-allocptr))
1063 (movq (:rcontext x8664::tcr.save-allocptr) (:%q allocptr))
1064 (rcmpq (:%q allocptr) (:rcontext x8664::tcr.save-allocbase))
1065 (:byte #x77) (:byte #x02) ;(ja :no-trap)
1066
1067 (uuo-alloc)
1068 :no-trap
1069
1070 (andb (:$b (lognot x8664::fulltagmask)) (:rcontext x8664::tcr.save-allocptr))
1071)
1072
1073(define-x8664-vinsn init-cons (((dest :lisp))
1074 ((car :lisp)
1075 (cdr :lisp)
1076 (cell :lisp)))
1077 (movq (:%q car) (:@ x8664::cons.car (:%q cell)))
1078 (movq (:%q cdr) (:@ x8664::cons.cdr (:%q cell)))
1079 (movq (:%q cell) (:%q dest)))
1080
1081(define-x8664-vinsn cons (((dest :lisp))
1082 ((car :lisp)
1083 (cdr :lisp))
1084 ((allocptr (:lisp #.x8664::allocptr))))
1085 (subq (:$b (- x8664::cons.size x8664::fulltag-cons)) (:rcontext x8664::tcr.save-allocptr))
1086 (movq (:rcontext x8664::tcr.save-allocptr) (:%q allocptr))
1087 (rcmpq (:%q allocptr) (:rcontext x8664::tcr.save-allocbase))
1088 (:byte #x77) (:byte #x02) ;(ja :no-trap)
1089 (uuo-alloc)
1090 :no-trap
1091
1092 (andb (:$b (lognot x8664::fulltagmask)) (:rcontext x8664::tcr.save-allocptr))
1093 (movq (:%q car) (:@ x8664::cons.car (:%q allocptr)))
1094 (movq (:%q cdr) (:@ x8664::cons.cdr (:%q allocptr)))
1095 ((:pred /= (:apply %hard-regspec-value dest) (:apply %hard-regspec-value x8664::allocptr))
1096 (movq (:%q allocptr) (:%q dest))))
1097
1098(define-x8664-vinsn make-vcell (((dest :lisp))
1099 ((val :lisp))
1100 ((allocptr (:lisp #.x8664::allocptr))
1101 (disp (:s64 #.x8664::imm1))
1102 (header (:u64 #.x8664::imm0))))
1103 (movl (:$l x8664::value-cell-header) (:%l header))
1104 (movl (:$l (- x8664::value-cell.size x8664::fulltag-misc)) (:%l disp))
1105 (subq (:%q disp) (:rcontext x8664::tcr.save-allocptr))
1106 (movq (:rcontext x8664::tcr.save-allocptr) (:%q allocptr))
1107 (rcmpq (:%q allocptr) (:rcontext x8664::tcr.save-allocbase))
1108 (:byte #x77) (:byte #x02) ;(ja :no-trap)
1109 (uuo-alloc)
1110 :no-trap
1111 (movq (:%q header) (:@ x8664::misc-header-offset (:%q allocptr)))
1112 (andb (:$b (lognot x8664::fulltagmask)) (:rcontext x8664::tcr.save-allocptr))
1113
1114 (movq (:%q allocptr) (:%q dest))
1115 (movq (:%q ) (:@ x8664::value-cell.value (:%q dest))))
1116
1117(define-x8664-vinsn ref (()
1118 ((arg t)))
1119 )
1120
1121
1122
1123(define-x8664-vinsn (spill :spill :needs-frame-pointer) (()
1124 ((src :lisp)
1125 (slot :stack-offset)))
1126 (movq (:%q src) (:@ (:apply - (:apply ash (:apply 1+ slot) 3)) (:%q x8664::rbp))))
1127
1128(define-x8664-vinsn (spill-natural :spill :nfp :set) (()
1129 ((val :u64)
1130 (offset :u16const))
1131 ((nfp :lisp)))
1132 (movq (:rcontext x8664::tcr.nfp) (:%q nfp))
1133 (movq (:%q val) (:@ (:apply + 16 offset) (:%q nfp))))
1134
1135
1136
1137(define-x8664-vinsn (spill-single-float :spill :nfp :set) (()
1138 ((val :single-float)
1139 (offset :u16const))
1140 ((nfp :lisp)))
1141 (movq (:rcontext x8664::tcr.nfp) (:%q nfp))
1142 (movss (:%xmm val) (:@ (:apply + 16 offset) (:%q nfp))))
1143
1144
1145
1146
1147(define-x8664-vinsn (spill-double-float :spill :nfp :set) (()
1148 ((val :double-float)
1149 (offset :u16const))
1150 ((nfp :lisp)))
1151 (movq (:rcontext x8664::tcr.nfp) (:%q nfp))
1152 (movsd (:%xmm val) (:@ (:apply + 16 offset) (:%q nfp))))
1153
1154
1155
1156
1157(define-x8664-vinsn (spill-complex-single-float :spill :nfp :set) (()
1158 ((val :complex-single-float)
1159 (offset :u16const))
1160 ((nfp :lisp)))
1161
1162
1163 (movq (:rcontext x8664::tcr.nfp) (:%q nfp))
1164 (movq (:%xmm val) (:@ (:apply + 16 offset) (:%q nfp))))
1165
1166(define-x8664-vinsn (spill-complex-double-float :spill :nfp :set) (()
1167 ((val :complex-double-float)
1168 (offset :u16const)))
1169 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
1170 (movdqu (:%xmm val) (:@ (:apply + 16 offset) (:% x8664::temp5))))
1171
1172(define-x8664-vinsn (reload :reload :needs-frame-pointer) (((dest :lisp))
1173 ((slot :stack-offset)))
1174
1175 (movq (:@ (:apply - (:apply ash (:apply 1+ slot) 3)) (:%q x8664::rbp)) (:%q dest)))
1176
1177(define-x8664-vinsn unbox-u8 (((dest :u8))
1178 ((src :lisp)))
1179 :resume
1180 (movq (:$l (lognot (ash #xff x8664::fixnumshift))) (:%q dest))
1181 (andq (:% src) (:% dest))
1182 (jne :bad)
1183 (movq (:%q src) (:%q dest))
1184 (shrq (:$ub x8664::fixnumshift) (:%q dest))
1185
1186 (:anchored-uuo-section :resume)
1187 :bad
1188 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-unsigned-byte-8))))
1189
1190(define-x8664-vinsn %unbox-u8 (((dest :u8))
1191 ((src :lisp)))
1192 (movl (:%l src) (:%l dest))
1193 (shrl (:$ub x8664::fixnumshift) (:%l dest))
1194 (movzbl (:%b dest) (:%l dest)))
1195
1196(define-x8664-vinsn unbox-s8 (((dest :s8))
1197 ((src :lisp)))
1198 :resume
1199 (movq (:%q src) (:%q dest))
1200 (shlq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q dest))
1201 (sarq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q dest))
1202 (cmpq (:%q src) (:%q dest))
1203 (jne :bad)
1204 (testb (:$b x8664::fixnummask) (:%b dest))
1205 (jne :bad)
1206 (sarq (:$ub x8664::fixnumshift) (:%q dest))
1207
1208 (:anchored-uuo-section :resume)
1209 :bad
1210 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-signed-byte-8))))
1211
1212(define-x8664-vinsn %unbox-s8 (((dest :s8))
1213 ((src :lisp)))
1214 (movq (:%q src) (:%q dest))
1215 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
1216
1217(define-x8664-vinsn unbox-u16 (((dest :u16))
1218 ((src :lisp)))
1219 :resume
1220 (testq (:$l (lognot (ash #xffff x8664::fixnumshift))) (:% src))
1221 (movq (:%q src) (:%q dest))
1222 (jne :bad)
1223 (shrq (:$ub x8664::fixnumshift) (:%q dest))
1224
1225 (:anchored-uuo-section :resume)
1226 :bad
1227 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-unsigned-byte-16))))
1228
1229(define-x8664-vinsn %unbox-u16 (((dest :u16))
1230 ((src :lisp)))
1231 (movq (:%q src) (:%q dest))
1232 (shrq (:$ub x8664::fixnumshift) (:%q dest)))
1233
1234(define-x8664-vinsn unbox-s16 (((dest :s16))
1235 ((src :lisp)))
1236 :resume
1237 (movq (:%q src) (:%q dest))
1238 (shlq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q dest))
1239 (sarq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q dest))
1240 (cmpq (:%q src) (:%q dest))
1241 (jne :bad)
1242 (testb (:$b x8664::fixnummask) (:%b dest))
1243 (jne :bad)
1244 (sarq (:$ub x8664::fixnumshift) (:%q dest))
1245
1246 (:anchored-uuo-section :resume)
1247 :bad
1248 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-signed-byte-16))))
1249
1250(define-x8664-vinsn %unbox-s16 (((dest :s16))
1251 ((src :lisp)))
1252 (movq (:%q src) (:%q dest))
1253 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
1254
1255(define-x8664-vinsn unbox-u32 (((dest :u32))
1256 ((src :lisp)))
1257 :resume
1258 (movq (:$q (lognot (ash #xffffffff x8664::fixnumshift))) (:%q dest))
1259 (testq (:% src) (:% dest))
1260 (jne :bad)
1261 (movq (:%q src) (:%q dest))
1262 (shrq (:$ub x8664::fixnumshift) (:%q dest))
1263
1264 (:anchored-uuo-section :resume)
1265 :bad
1266 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-unsigned-byte-32))))
1267
1268(define-x8664-vinsn %unbox-u32 (((dest :u32))
1269 ((src :lisp)))
1270
1271 (movq (:%q src) (:%q dest))
1272 (shrq (:$ub x8664::fixnumshift) (:%q dest)))
1273
1274(define-x8664-vinsn unbox-s32 (((dest :s32))
1275 ((src :lisp)))
1276 :resume
1277 (movq (:%q src) (:%q dest))
1278 (shlq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q dest))
1279 (sarq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q dest))
1280 (cmpq (:%q src) (:%q dest))
1281 (jne :bad)
1282 (testb (:$b x8664::fixnummask) (:%b dest))
1283 (jne :bad)
1284 (sarq (:$ub x8664::fixnumshift) (:%q dest))
1285
1286 (:anchored-uuo-section :resume)
1287 :bad
1288 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-signed-byte-32))))
1289
1290(define-x8664-vinsn %unbox-s32 (((dest :s32))
1291 ((src :lisp)))
1292 (movq (:%q src) (:%q dest))
1293 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
1294
1295
1296(define-x8664-vinsn unbox-u64 (((dest :u64))
1297 ((src :lisp)))
1298 :resume
1299 (movq (:$q (lognot (ash x8664::target-most-positive-fixnum x8664::fixnumshift))) (:%q dest))
1300 (testq (:%q dest) (:%q src))
1301 (movq (:%q src) (:%q dest))
1302 (jnz :maybe-bignum)
1303 (shrq (:$ub x8664::fixnumshift) (:%q dest))
1304 (jmp :done)
1305 :maybe-bignum
1306 (andl (:$b x8664::tagmask) (:%l dest))
1307 (cmpl (:$b x8664::tag-misc) (:%l dest))
1308 (jne :have-tag)
1309 (movzbl (:@ x8664::misc-subtag-offset (:%q src)) (:%l dest))
1310 :have-tag
1311 (cmpl (:$b x8664::subtag-bignum) (:%l dest))
1312 (jne :bad)
1313 (movq (:@ x8664::misc-header-offset (:%q src)) (:%q dest))
1314 (cmpq (:$l x8664::three-digit-bignum-header) (:%q dest))
1315 (je :three)
1316 (cmpq (:$l x8664::two-digit-bignum-header) (:%q dest))
1317 (jne :bad)
1318 (movq (:@ x8664::misc-data-offset (:%q src)) (:%q dest))
1319 (testq (:%q dest) (:%q dest))
1320 (js :bad)
1321 (jmp :done)
1322
1323 :three
1324 (movl (:@ (+ 8 x8664::misc-data-offset) (:%q src)) (:%l dest))
1325 (testl (:%l dest) (:%l dest))
1326 (movq (:@ x8664::misc-data-offset (:%q src)) (:%q dest))
1327 (jne :bad)
1328 :done
1329
1330 (:anchored-uuo-section :resume)
1331 :bad
1332 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-unsigned-byte-64))))
1333
1334(define-x8664-vinsn unbox-s64 (((dest :s64))
1335 ((src :lisp)))
1336 :resume
1337 (movq (:%q src) (:%q dest))
1338 (sarq (:$ub x8664::fixnumshift) (:%q dest))
1339 ;; Was it a fixnum ?
1340 (testb (:$b x8664::fixnummask) (:%b src))
1341 (je :done)
1342 ;; May be a 2-digit bignum
1343 (movl (:%l src) (:%l dest))
1344 (andl (:$b x8664::tagmask) (:%l dest))
1345 (cmpl (:$b x8664::tag-misc) (:%l dest))
1346 (jne :bad)
1347 (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q src)))
1348 (movq (:@ x8664::misc-data-offset (:%q src)) (:%q dest))
1349 (jne :bad)
1350 :done
1351
1352 (:anchored-uuo-section :resume)
1353 :bad
1354 (:anchored-uuo (uuo-error-reg-not-type (:%q src) (:$ub arch::error-object-not-signed-byte-64))))
1355
1356(define-x8664-vinsn sign-extend-s8 (((dest :s64))
1357 ((src :s8)))
1358 (movsbq (:%b src) (:%q dest)))
1359
1360(define-x8664-vinsn sign-extend-s16 (((dest :s64))
1361 ((src :s16)))
1362 (movswq (:%w src) (:%q dest)))
1363
1364(define-x8664-vinsn sign-extend-s32 (((dest :s64))
1365 ((src :s32)))
1366 (movslq (:%l src) (:%q dest)))
1367
1368
1369(define-x8664-vinsn zero-extend-u8 (((dest :s64))
1370 ((src :u8)))
1371 (movzbl (:%b src) (:%l dest)))
1372
1373(define-x8664-vinsn zero-extend-u16 (((dest :s64))
1374 ((src :u16)))
1375 (movzwl (:%w src) (:%l dest)))
1376
1377(define-x8664-vinsn zero-extend-u32 (((dest :s64))
1378 ((src :u32)))
1379 (movl (:%l src) (:%l dest)))
1380
1381(define-x8664-vinsn (jump-subprim :jumpLR) (()
1382 ((spno :s32const)))
1383 (jmp (:@ spno)))
1384
1385;;; Call a subprimitive using a tail-aligned CALL instruction.
1386(define-x8664-vinsn (call-subprim :call :subprim) (()
1387 ((spno :s32const))
1388 ((entry (:label 1))))
1389 (:talign 4)
1390 (call (:@ spno))
1391 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1392
1393(define-x8664-vinsn (call-subprim-no-return) (()
1394 ((spno :s32const))
1395 ((entry (:label 1))))
1396 (:talign 4)
1397 (call (:@ spno))
1398 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1399
1400
1401
1402(define-x8664-vinsn %logand-c (((dest t))
1403 ((val t)
1404 (const :s32const)))
1405 ((:not (:pred = (:apply %hard-regspec-value val)
1406 (:apply %hard-regspec-value dest)))
1407 (movq (:%q val) (:%q dest)))
1408 ((:and (:pred >= const -128) (:pred <= const 127))
1409 (andq (:$b const) (:%q dest)))
1410 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1411 (andq (:$l const) (:%q dest))))
1412
1413(define-x8664-vinsn %logior-c (((dest t)
1414 (val t))
1415 ((val t)
1416 (const :s32const)))
1417 ((:and (:pred >= const -128) (:pred <= const 127))
1418 (orq (:$b const) (:%q val)))
1419 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1420 (orq (:$l const) (:%q val))))
1421
1422(define-x8664-vinsn %logxor-c (((dest t)
1423 (val t))
1424 ((val t)
1425 (const :s32const)))
1426 ((:and (:pred >= const -128) (:pred <= const 127))
1427 (xorq (:$b const) (:%q val)))
1428 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1429 (xorq (:$l const) (:%q val))))
1430
1431(define-x8664-vinsn character->fixnum (((dest :lisp))
1432 ((src :lisp))
1433 ())
1434 ((:not (:pred =
1435 (:apply %hard-regspec-value dest)
1436 (:apply %hard-regspec-value src)))
1437 (movq (:%q src) (:%q dest)))
1438 (shrq (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%q dest)))
1439
1440(define-x8664-vinsn compare (()
1441 ((x t)
1442 (y t)))
1443 (rcmpq (:%q x) (:%q y)))
1444
1445(define-x8664-vinsn negate-fixnum (((val :lisp))
1446 ((val :imm)))
1447 (negq (:% val)))
1448
1449(define-x8664-vinsn handle-fixnum-overflow-inline
1450 (()
1451 ((val :lisp))
1452 ((header (:u64 #.x8664::imm0))
1453 (scaled-size (:u64 #.x8664::imm1))
1454 (bigits (:u64 #.x8664::imm2))
1455 (freeptr (:lisp #.x8664::allocptr))))
1456 (movq (:%q val) (:%q bigits))
1457 (btcq (:$ub 63) (:%q bigits))
1458 (sarq (:$ub x8664::fixnumshift) (:%q bigits))
1459 (btcq (:$ub 60) (:%q bigits))
1460 (movl (:$l x8664::two-digit-bignum-header) (:%l header))
1461 (xorl (:%l scaled-size) (:%l scaled-size))
1462 (movb (:$b (- 16 x8664::fulltag-misc)) (:%b scaled-size))
1463 (subq (:%q scaled-size) (:rcontext x8664::tcr.save-allocptr))
1464 (movq (:rcontext x8664::tcr.save-allocptr) (:%q freeptr))
1465 (rcmpq (:%q freeptr) (:rcontext x8664::tcr.save-allocbase))
1466 (:byte #x77) (:byte #x02) ;(ja :no-trap)
1467 (uuo-alloc)
1468 :no-trap
1469 (movq (:%q header) (:@ x8664::misc-header-offset (:%q freeptr)))
1470 (andb (:$b (lognot x8664::fulltagmask)) (:rcontext x8664::tcr.save-allocptr))
1471 ((:not (:pred = freeptr
1472 (:apply %hard-regspec-value val)))
1473 (movq (:%q freeptr) (:%q val)))
1474 (movq (:%q bigits) (:@ x8664::misc-data-offset (:%q val))))
1475
1476(define-x8664-vinsn %set-z-flag-if-s64-fits-in-fixnum (((dest :imm))
1477 ((src :s64))
1478 ((temp :s64)))
1479 (movq (:%q src) (:%q temp))
1480 (shlq (:$ub x8664::fixnumshift) (:%q temp))
1481 (movq (:%q temp) (:%q dest)) ; tagged as a fixnum
1482 (sarq (:$ub x8664::fixnumshift) (:%q temp))
1483 (cmpq (:%q src) (:%q temp)))
1484
1485(define-x8664-vinsn %set-z-flag-if-u64-fits-in-fixnum (((dest :imm))
1486 ((src :u64)))
1487 (movq (:$q (ash #xf 60)) (:%q dest))
1488 (testq (:%q dest) (:%q src))
1489 (leaq (:@ (:%q src) x8664::fixnumone) (:% dest)))
1490
1491
1492(define-x8664-vinsn setup-bignum-alloc-for-s64-overflow (()
1493 ((src :s64)))
1494 (movq (:%q src) (:%q x8664::imm2))
1495 (movl (:$l x8664::two-digit-bignum-header) (:%l x8664::imm0.l))
1496 (movl (:$l (- 16 x8664::fulltag-misc)) (:%l x8664::imm1.l)))
1497
1498
1499;;; If the sign bit is set in SRC, need to make a 3-digit bignum
1500;;; that requires 32 bytes of aligned memory
1501(define-x8664-vinsn setup-bignum-alloc-for-u64-overflow (()
1502 ((src :s64)))
1503 (testq (:%q src) (:%q src))
1504 (movq (:%q src) (:%q x8664::imm2))
1505 (movl (:$l x8664::two-digit-bignum-header) (:%l x8664::imm0.l))
1506 (movl (:$l (- 16 x8664::fulltag-misc)) (:%l x8664::imm1.l))
1507 (jns :done)
1508 (movl (:$l x8664::three-digit-bignum-header) (:%l x8664::imm0.l))
1509 (movl (:$l (- 32 x8664::fulltag-misc)) (:%l x8664::imm1.l))
1510 :done)
1511
1512
1513
1514(define-x8664-vinsn %allocate-uvector (((dest :lisp))
1515 ()
1516 ((header (:u64 #.x8664::imm0))
1517 (freeptr (:lisp #.x8664::allocptr))))
1518 (subq (:%q x8664::imm1) (:rcontext x8664::tcr.save-allocptr))
1519 (movq (:rcontext x8664::tcr.save-allocptr) (:%q freeptr))
1520 (rcmpq (:%q freeptr) (:rcontext x8664::tcr.save-allocbase))
1521 (:byte #x77) (:byte #x02) ;(ja :no-trap)
1522 (uuo-alloc)
1523 :no-trap
1524 (movq (:%q header) (:@ x8664::misc-header-offset (:%q freeptr)))
1525 (andb (:$b (lognot x8664::fulltagmask)) (:rcontext x8664::tcr.save-allocptr))
1526 ((:not (:pred eql freeptr
1527 (:apply %hard-regspec-value dest)))
1528 (movq (:%q freeptr) (:%q dest))))
1529
1530(define-x8664-vinsn set-bigits-after-fixnum-overflow (()
1531 ((bignum :lisp)))
1532 (movq (:%q x8664::imm2) (:@ x8664::misc-data-offset (:%q bignum))))
1533
1534
1535(define-x8664-vinsn box-fixnum (((dest :imm))
1536 ((src :s8)))
1537 (imulq (:$b x8664::fixnumone) (:%q src)(:%q dest)))
1538
1539
1540(define-x8664-vinsn (return-or-fix-overflow :jumpLR)(()
1541 ())
1542 (jo :fix)
1543 (:byte #xf3) (ret)
1544 :fix
1545 (jmp (:@ .SPfix-overflow)))
1546
1547(define-x8664-vinsn add-constant (((dest :imm))
1548 ((dest :imm)
1549 (const :s32const)))
1550 ((:and (:pred >= const -128) (:pred <= const 127))
1551 (addq (:$b const) (:%q dest)))
1552 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1553 (addq (:$l const) (:%q dest))))
1554
1555(define-x8664-vinsn add-constant3 (((dest :imm))
1556 ((src :imm)
1557 (const :s32const)))
1558 ((:pred = (:apply %hard-regspec-value dest)
1559 (:apply %hard-regspec-value src))
1560 ((:and (:pred >= const -128) (:pred <= const 127))
1561 (addq (:$b const) (:%q dest)))
1562 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1563 (addq (:$l const) (:%q dest))))
1564 ((:not (:pred = (:apply %hard-regspec-value dest)
1565 (:apply %hard-regspec-value src)))
1566 (leaq (:@ const (:%q src)) (:%q dest))))
1567
1568
1569
1570(define-x8664-vinsn fixnum-add2 (((dest :imm))
1571 ((dest :imm)
1572 (other :imm)))
1573 (addq (:%q other) (:%q dest)))
1574
1575(define-x8664-vinsn fixnum-sub2 (((dest :imm))
1576 ((x :imm)
1577 (y :imm))
1578 ((temp :imm)))
1579 ((:pred = (:apply %hard-regspec-value x) (:apply %hard-regspec-value dest))
1580 (subq (:%q y) (:%q dest)))
1581 ((:not (:pred = (:apply %hard-regspec-value x) (:apply %hard-regspec-value dest)))
1582 ((:pred = (:apply %hard-regspec-value y) (:apply %hard-regspec-value dest))
1583 (movq (:%q x) (:%q temp))
1584 (subq (:%q y) (:%q temp))
1585 (movq (:%q temp) (:%q dest)))
1586 ((:not (:pred = (:apply %hard-regspec-value y) (:apply %hard-regspec-value dest)))
1587 (movq (:%q x) (:%q dest))
1588 (subq (:%q y) (:%q dest)))))
1589
1590
1591
1592(define-x8664-vinsn fixnum-add3 (((dest :imm))
1593 ((x :imm)
1594 (y :imm)))
1595
1596 ((:pred =
1597 (:apply %hard-regspec-value x)
1598 (:apply %hard-regspec-value dest))
1599 (addq (:%q y) (:%q dest)))
1600 ((:not (:pred =
1601 (:apply %hard-regspec-value x)
1602 (:apply %hard-regspec-value dest)))
1603 ((:pred =
1604 (:apply %hard-regspec-value y)
1605 (:apply %hard-regspec-value dest))
1606 (addq (:%q x) (:%q dest)))
1607 ((:not (:pred =
1608 (:apply %hard-regspec-value y)
1609 (:apply %hard-regspec-value dest)))
1610 (leaq (:@ (:%q x) (:%q y)) (:%q dest)))))
1611
1612(define-x8664-vinsn (ref-gpr) (()
1613 ((src t)))
1614 ;; no code
1615 )
1616
1617
1618(define-x8664-vinsn (copy-gpr :trivial-copy) (((dest t))
1619 ((src t)))
1620 ((:not (:pred =
1621 (:apply %hard-regspec-value dest)
1622 (:apply %hard-regspec-value src)))
1623 (movq (:%q src) (:%q dest))))
1624
1625(define-x8664-vinsn copy-gpr! (((dest t))
1626 ((src t)))
1627 ((:not (:pred =
1628 (:apply %hard-regspec-value dest)
1629 (:apply %hard-regspec-value src)))
1630 (movq (:%q src) (:%q dest))))
1631
1632(define-x8664-vinsn copy-incoming-register-arg (((dest t))
1633 ((src t)))
1634 ((:not (:pred eq src dest))
1635 (movq (:%q src) (:%q dest))))
1636
1637(define-x8664-vinsn (vpop-register :pop :node :vsp)
1638 (((dest :lisp))
1639 ())
1640 (popq (:%q dest)))
1641
1642(define-x8664-vinsn (vpop-gvector-element :pop :node :vsp)
1643 (()
1644 ((vector :lisp)
1645 (idx :u32const))
1646 ())
1647 (popq (:@ (:apply + x8664::misc-data-offset (:apply ash idx x8664::word-shift)) (:%q vector))))
1648
1649(define-x8664-vinsn (push-argregs :push :node :vsp) (()
1650 ())
1651 (testl (:%l x8664::nargs) (:%l x8664::nargs))
1652 (jz :done)
1653 (rcmpl (:%l x8664::nargs) (:$b (* 2 x8664::node-size)))
1654 (jb :one)
1655 (je :two)
1656 (pushq (:%q x8664::arg_x))
1657 :two
1658 (pushq (:%q x8664::arg_y))
1659 :one
1660 (pushq (:%q x8664::arg_z))
1661 :done)
1662
1663(define-x8664-vinsn (push-max-argregs :push :node :vsp) (()
1664 ((max :u32const)))
1665 ((:pred >= max 3)
1666 (testl (:%l x8664::nargs) (:%l x8664::nargs))
1667 (jz :done)
1668 (rcmpl (:%l x8664::nargs) (:$b (* 2 x8664::node-size)))
1669 (jb :one)
1670 (je :two)
1671 (pushq (:%q x8664::arg_x))
1672 :two
1673 (pushq (:%q x8664::arg_y))
1674 :one
1675 (pushq (:%q x8664::arg_z))
1676 :done)
1677 ((:pred = max 2)
1678 (rcmpl (:%l x8664::nargs) (:$b (* 1 x8664::node-size)))
1679 (jb :done)
1680 (je :one)
1681 (pushq (:%q x8664::arg_y))
1682 :one
1683 (pushq (:%q x8664::arg_z))
1684 :done)
1685 ((:pred = max 1)
1686 (testl (:%l x8664::nargs) (:%l x8664::nargs))
1687 (je :done)
1688 (pushq (:%q x8664::arg_z))
1689 :done))
1690
1691(define-x8664-vinsn (call-label :call) (()
1692 ((label :label))
1693 ((entry (:label 1))))
1694 (:talign 4)
1695 (call label)
1696 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1697
1698(define-x8664-vinsn double-float-compare (()
1699 ((arg0 :double-float)
1700 (arg1 :double-float)))
1701 (comisd (:%xmm arg1) (:%xmm arg0)))
1702
1703(define-x8664-vinsn single-float-compare (()
1704 ((arg0 :single-float)
1705 (arg1 :single-float)))
1706 (comiss (:%xmm arg1) (:%xmm arg0)))
1707
1708
1709(define-x8664-vinsn double-float+-2 (((result :double-float))
1710 ((x :double-float)
1711 (y :double-float)))
1712 ((:pred =
1713 (:apply %hard-regspec-value result)
1714 (:apply %hard-regspec-value x))
1715 (addsd (:%xmm y) (:%xmm result)))
1716 ((:and (:not (:pred =
1717 (:apply %hard-regspec-value result)
1718 (:apply %hard-regspec-value x)))
1719 (:pred =
1720 (:apply %hard-regspec-value result)
1721 (:apply %hard-regspec-value y)))
1722 (addsd (:%xmm x) (:%xmm result)))
1723 ((:and (:not (:pred =
1724 (:apply %hard-regspec-value result)
1725 (:apply %hard-regspec-value x)))
1726 (:not (:pred =
1727 (:apply %hard-regspec-value result)
1728 (:apply %hard-regspec-value y))))
1729 (movsd (:%xmm x) (:%xmm result))
1730 (addsd (:%xmm y) (:%xmm result))))
1731
1732;;; Caller guarantees (not (eq y result))
1733(define-x8664-vinsn double-float--2 (((result :double-float))
1734 ((x :double-float)
1735 (y :double-float)))
1736 ((:not (:pred = (:apply %hard-regspec-value result)
1737 (:apply %hard-regspec-value x)))
1738 (movsd (:%xmm x) (:%xmm result)))
1739 (subsd (:%xmm y) (:%xmm result)))
1740
1741(define-x8664-vinsn double-float*-2 (((result :double-float))
1742 ((x :double-float)
1743 (y :double-float)))
1744 ((:pred =
1745 (:apply %hard-regspec-value result)
1746 (:apply %hard-regspec-value x))
1747 (mulsd (:%xmm y) (:%xmm result)))
1748 ((:and (:not (:pred =
1749 (:apply %hard-regspec-value result)
1750 (:apply %hard-regspec-value x)))
1751 (:pred =
1752 (:apply %hard-regspec-value result)
1753 (:apply %hard-regspec-value y)))
1754 (mulsd (:%xmm x) (:%xmm result)))
1755 ((:and (:not (:pred =
1756 (:apply %hard-regspec-value result)
1757 (:apply %hard-regspec-value x)))
1758 (:not (:pred =
1759 (:apply %hard-regspec-value result)
1760 (:apply %hard-regspec-value y))))
1761 (movsd (:%xmm x) (:%xmm result))
1762 (mulsd (:%xmm y) (:%xmm result))))
1763
1764;;; Caller guarantees (not (eq y result))
1765(define-x8664-vinsn double-float/-2 (((result :double-float))
1766 ((x :double-float)
1767 (y :double-float)))
1768 ((:not (:pred = (:apply %hard-regspec-value result)
1769 (:apply %hard-regspec-value x)))
1770 (movsd (:%xmm x) (:%xmm result)))
1771 (divsd (:%xmm y) (:%xmm result)))
1772
1773
1774(define-x8664-vinsn complex-double-float+-2 (((result :complex-double-float))
1775 ((x :complex-double-float)
1776 (y :complex-double-float)))
1777 ((:pred =
1778 (:apply %hard-regspec-value result)
1779 (:apply %hard-regspec-value x))
1780 (addpd (:%xmm y) (:%xmm result)))
1781 ((:and (:not (:pred =
1782 (:apply %hard-regspec-value result)
1783 (:apply %hard-regspec-value x)))
1784 (:pred =
1785 (:apply %hard-regspec-value result)
1786 (:apply %hard-regspec-value y)))
1787 (addpd (:%xmm x) (:%xmm result)))
1788 ((:and (:not (:pred =
1789 (:apply %hard-regspec-value result)
1790 (:apply %hard-regspec-value x)))
1791 (:not (:pred =
1792 (:apply %hard-regspec-value result)
1793 (:apply %hard-regspec-value y))))
1794 (movapd (:%xmm x) (:%xmm result))
1795 (addpd (:%xmm y) (:%xmm result))))
1796
1797;;; Caller guarantees (not (eq y result))
1798(define-x8664-vinsn complex-double-float--2 (((result :complex-double-float))
1799 ((x :complex-double-float)
1800 (y :complex-double-float)))
1801 ((:not (:pred = (:apply %hard-regspec-value result)
1802 (:apply %hard-regspec-value x)))
1803 (movapd (:%xmm x) (:%xmm result)))
1804 (subpd (:%xmm y) (:%xmm result)))
1805
1806(define-x8664-vinsn complex-double-float*-2 (((result :complex-double-float))
1807 ((x :complex-double-float)
1808 (y :complex-double-float))
1809 ((b :double-float)
1810 (ix :double-float)
1811 (iy :double-float)))
1812 (movapd (:%xmm x) (:%xmm ix))
1813 (shufpd (:$ub 1) (:%xmm x8664::fpzero) (:%xmm ix))
1814 (movapd (:%xmm y) (:%xmm iy))
1815 (shufpd (:$ub 1) (:%xmm x8664::fpzero) (:%xmm iy))
1816 (movsd (:%xmm y) (:%xmm result))
1817 (mulsd (:%xmm x) (:%xmm result))
1818 (movsd (:%xmm iy) (:%xmm b))
1819 (mulsd (:%xmm ix) (:%xmm b))
1820 (subsd (:%xmm b) (:%xmm result))
1821 (mulsd (:%xmm x) (:%xmm iy))
1822 (mulsd (:%xmm y) (:%xmm ix))
1823 (addsd (:%xmm ix) (:%xmm iy))
1824 (shufpd (:$ub 0) (:%xmm iy) (:%xmm result)))
1825
1826
1827
1828
1829
1830
1831(define-x8664-vinsn single-float+-2 (((result :single-float))
1832 ((x :single-float)
1833 (y :single-float)))
1834 ((:pred =
1835 (:apply %hard-regspec-value result)
1836 (:apply %hard-regspec-value x))
1837 (addss (:%xmm y) (:%xmm result)))
1838 ((:and (:not (:pred =
1839 (:apply %hard-regspec-value result)
1840 (:apply %hard-regspec-value x)))
1841 (:pred =
1842 (:apply %hard-regspec-value result)
1843 (:apply %hard-regspec-value y)))
1844 (addss (:%xmm x) (:%xmm result)))
1845 ((:and (:not (:pred =
1846 (:apply %hard-regspec-value result)
1847 (:apply %hard-regspec-value x)))
1848 (:not (:pred =
1849 (:apply %hard-regspec-value result)
1850 (:apply %hard-regspec-value y))))
1851 (movss (:%xmm x) (:%xmm result))
1852 (addss (:%xmm y) (:%xmm result))))
1853
1854;;; Caller guarantees (not (eq y result))
1855(define-x8664-vinsn single-float--2 (((result :single-float))
1856 ((x :single-float)
1857 (y :single-float)))
1858 ((:not (:pred = (:apply %hard-regspec-value result)
1859 (:apply %hard-regspec-value x)))
1860 (movss (:%xmm x) (:%xmm result)))
1861 (subss (:%xmm y) (:%xmm result)))
1862
1863(define-x8664-vinsn single-float*-2 (((result :single-float))
1864 ((x :single-float)
1865 (y :single-float)))
1866 ((:pred =
1867 (:apply %hard-regspec-value result)
1868 (:apply %hard-regspec-value x))
1869 (mulss (:%xmm y) (:%xmm result)))
1870 ((:and (:not (:pred =
1871 (:apply %hard-regspec-value result)
1872 (:apply %hard-regspec-value x)))
1873 (:pred =
1874 (:apply %hard-regspec-value result)
1875 (:apply %hard-regspec-value y)))
1876 (mulss (:%xmm x) (:%xmm result)))
1877 ((:and (:not (:pred =
1878 (:apply %hard-regspec-value result)
1879 (:apply %hard-regspec-value x)))
1880 (:not (:pred =
1881 (:apply %hard-regspec-value result)
1882 (:apply %hard-regspec-value y))))
1883 (movss (:%xmm x) (:%xmm result))
1884 (mulss (:%xmm y) (:%xmm result))))
1885
1886;;; Caller guarantees (not (eq y result))
1887(define-x8664-vinsn single-float/-2 (((result :single-float))
1888 ((x :single-float)
1889 (y :single-float)))
1890 ((:not (:pred = (:apply %hard-regspec-value result)
1891 (:apply %hard-regspec-value x)))
1892 (movss (:%xmm x) (:%xmm result)))
1893 (divss (:%xmm y) (:%xmm result)))
1894
1895(define-x8664-vinsn complex-single-float+-2 (((result :complex-single-float))
1896 ((x :complex-single-float)
1897 (y :complex-single-float)))
1898 ((:pred =
1899 (:apply %hard-regspec-value result)
1900 (:apply %hard-regspec-value x))
1901 (addps (:%xmm y) (:%xmm result)))
1902 ((:and (:not (:pred =
1903 (:apply %hard-regspec-value result)
1904 (:apply %hard-regspec-value x)))
1905 (:pred =
1906 (:apply %hard-regspec-value result)
1907 (:apply %hard-regspec-value y)))
1908 (addps (:%xmm x) (:%xmm result)))
1909 ((:and (:not (:pred =
1910 (:apply %hard-regspec-value result)
1911 (:apply %hard-regspec-value x)))
1912 (:not (:pred =
1913 (:apply %hard-regspec-value result)
1914 (:apply %hard-regspec-value y))))
1915 (movq (:%xmm x) (:%xmm result))
1916 (addps (:%xmm y) (:%xmm result))))
1917
1918;;; Caller guarantees (not (eq y result))
1919(define-x8664-vinsn complex-single-float--2 (((result :complex-single-float))
1920 ((x :complex-single-float)
1921 (y :complex-single-float)))
1922 ((:not (:pred = (:apply %hard-regspec-value result)
1923 (:apply %hard-regspec-value x)))
1924 (movq (:%xmm x) (:%xmm result)))
1925 (subps (:%xmm y) (:%xmm result)))
1926
1927(define-x8664-vinsn complex-single-float*-2 (((result :complex-single-float))
1928 ((x :complex-single-float)
1929 (y :complex-single-float))
1930 ((b :single-float)
1931 (ix :single-float)
1932 (iy :single-float)))
1933 (movq (:%xmm x) (:%xmm ix))
1934 (psrlq (:$ub 32) (:%xmm ix))
1935 (movq (:%xmm y) (:%xmm iy))
1936 (psrlq (:$ub 32) (:%xmm iy))
1937 (movss(:%xmm y) (:%xmm result))
1938 (mulss (:%xmm x) (:%xmm result))
1939 (movss (:%xmm iy) (:%xmm b))
1940 (mulss (:%xmm ix) (:%xmm b))
1941 (subss (:%xmm b) (:%xmm result))
1942 (mulss (:%xmm x) (:%xmm iy))
1943 (mulss (:%xmm y) (:%xmm ix))
1944 (addss (:%xmm ix) (:%xmm iy))
1945 (unpcklps (:%xmm iy) (:%xmm result)))
1946
1947(define-x8664-vinsn get-single (((result :single-float))
1948 ((source :lisp)))
1949 (movd (:%q source) (:%xmm result))
1950 (psrlq (:$ub 32) (:%xmm result)))
1951
1952(define-x8664-vinsn get-double (((result :double-float))
1953 ((source :lisp)))
1954 (movsd (:@ x8664::double-float.value (:%q source)) (:%xmm result)))
1955
1956(define-x8664-vinsn get-complex-double-float (((result :complex-double-float))
1957 ((source :lisp)))
1958 (movdqa (:@ x8664::complex-double-float.realpart (:%q source)) (:%xmm result)))
1959
1960(define-x8664-vinsn get-complex-single-float (((result :complex-single-float))
1961 ((source :lisp)))
1962 (movq (:@ x8664::complex-single-float.realpart (:%q source)) (:%xmm result)))
1963
1964
1965;;; Extract a double-float value, typechecking in the process.
1966;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1967;;; instead of replicating it ..
1968
1969(define-x8664-vinsn get-double? (((target :double-float))
1970 ((source :lisp))
1971 ((tag :u8)))
1972 :resume
1973 (movl (:%l source) (:%l tag))
1974 (andl (:$b x8664::tagmask) (:%l tag))
1975 (cmpl (:$b x8664::tag-misc) (:%l tag))
1976 (jne :have-tag)
1977 (movsbl (:@ x8664::misc-subtag-offset (:%q source)) (:%l tag))
1978 :have-tag
1979 (cmpl (:$b x8664::subtag-double-float) (:%l tag))
1980 (jne :bad)
1981 (movsd (:@ x8664::double-float.value (:%q source)) (:%xmm target))
1982
1983 (:anchored-uuo-section :resume)
1984 :bad
1985 (:anchored-uuo (uuo-error-reg-not-tag (:%q source) (:$ub x8664::subtag-double-float))))
1986
1987(define-x8664-vinsn single->node (((result :lisp)
1988 (source :single-float))
1989 ((source :single-float)))
1990 (psllq (:$ub 32) (:%xmm source))
1991 (movd (:%xmm source) (:%q result))
1992 (movb (:$b x8664::tag-single-float) (:%b result)))
1993
1994(define-x8664-vinsn (copy-double-float :trivial-copy) (((dest :double-float))
1995 ((src :double-float)))
1996 (movsd (:%xmm src) (:%xmm dest)))
1997
1998(define-x8664-vinsn (copy-single-float :trivial-copy) (((dest :single-float))
1999 ((src :single-float)))
2000 (movss (:%xmm src) (:%xmm dest)))
2001
2002(define-x8664-vinsn (copy-complex-single-float :trivial-copy) (((dest :complex-single-float))
2003 ((src :complex-single-float)))
2004 (movq (:%xmm src) (:%xmm dest)))
2005
2006(define-x8664-vinsn (copy-complex-double-float :trivial-copy) (((dest :complex-double-float))
2007
2008
2009 ((src :complex-double-float)))
2010 (movapd (:%xmm src) (:%xmm dest)))
2011
2012
2013(define-x8664-vinsn copy-single-to-double (((dest :double-float))
2014 ((src :single-float)))
2015 (cvtss2sd (:%xmm src) (:%xmm dest)))
2016
2017(define-x8664-vinsn copy-double-to-single (((dest :single-float))
2018 ((src :double-float)))
2019 (cvtsd2ss (:%xmm src) (:%xmm dest)))
2020
2021(define-x8664-vinsn u8->fixnum (((result :imm))
2022 ((val :u8))
2023 ())
2024 (leaq (:@ (:%q val) 8) (:%q result)))
2025
2026(define-x8664-vinsn fitvals (()
2027 ((n :u16const))
2028 ((imm :u16)))
2029 ((:pred = n 0)
2030 (xorl (:%l imm) (:%l imm)))
2031 ((:not (:pred = n 0))
2032 (movl (:$l (:apply ash n x8664::fixnumshift)) (:%l imm)))
2033 (subl (:%l x8664::nargs) (:%l imm))
2034 (jae :push-more)
2035 (movslq (:%l imm) (:%q imm))
2036 (subq (:%q imm) (:%q x8664::rsp)) ; sic. "imm" ia negative here
2037 (jmp :done)
2038 :push-loop
2039
2040 (pushq (:$l (:apply target-nil-value)))
2041 (addl (:$b x8664::node-size) (:%l x8664::nargs))
2042 (subl (:$b x8664::node-size) (:%l imm))
2043 :push-more
2044 (jne :push-loop)
2045 :done)
2046
2047(define-x8664-vinsn (nvalret :jumpLR :needs-frame-pointer) (()
2048 ())
2049
2050 (jmp (:@ .SPnvalret)))
2051
2052
2053(define-x8664-vinsn lisp-word-ref (((dest t))
2054 ((base t)
2055 (offset t)))
2056 (movq (:@ (:%q base) (:%q offset)) (:%q dest)))
2057
2058
2059(define-x8664-vinsn lisp-word-ref-c (((dest t))
2060 ((base t)
2061 (offset :s32const)))
2062 ((:pred = offset 0)
2063 (movq (:@ (:%q base)) (:%q dest)))
2064 ((:not (:pred = offset 0))
2065 (movq (:@ offset (:%q base)) (:%q dest))))
2066
2067
2068(define-x8664-vinsn (vpush-label :push :node :vsp) (()
2069 ((label :label))
2070 ((temp :lisp)))
2071 (leaq (:@ (:^ label) (:%q x8664::fn)) (:%q temp))
2072 (pushq (:%q temp)))
2073
2074;; ????
2075(define-x8664-vinsn (emit-aligned-label :align) (()
2076 ((label :label)))
2077 (:align 3)
2078 (:long (:^ label)))
2079
2080;;; %ra0 is pointing into %fn, so no need to copy %fn here.
2081(define-x8664-vinsn (xpass-multiple-values-symbol :call :extended-call :jumplr)
2082 (()
2083 ((lab :label))
2084 ())
2085 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2086 (jmp (:@ x8664::symbol.fcell (:% x8664::fname)))
2087
2088 )
2089
2090(define-x8664-vinsn (pass-multiple-values-symbol :call :extended-call :jumplr)
2091 (()
2092 ()
2093 ())
2094 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2095 (jmp (:@ x8664::symbol.fcell (:% x8664::fname)))
2096
2097 )
2098
2099;;; It'd be good to have a variant that deals with a known function
2100;;; as well as this.
2101(define-x8664-vinsn (xpass-multiple-values :call :extended-call :jumplr) (()
2102 ((lab :label))
2103 ((tag :u8)))
2104 :resume
2105 (movl (:%l x8664::temp0) (:%l tag))
2106 (andl (:$b x8664::fulltagmask) (:%l tag))
2107 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2108 (cmovgq (:%q x8664::temp0) (:%q x8664::fn))
2109 (jl :bad)
2110 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::fn))
2111 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2112 (jmp (:%q x8664::fn))
2113
2114 (:anchored-uuo-section :resume)
2115 :bad
2116 (:anchored-uuo (uuo-error-not-callable)))
2117
2118(define-x8664-vinsn (pass-multiple-values :call :jumplr) (()
2119 ()
2120 ((tag :u8)))
2121 :resume
2122 (movl (:%l x8664::temp0) (:%l tag))
2123 (andl (:$b x8664::fulltagmask) (:%l tag))
2124 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2125 (cmovgq (:%q x8664::temp0) (:%q x8664::fn))
2126 (jl :bad)
2127 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::fn))
2128 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2129 (jmp (:%q x8664::fn))
2130
2131 (:anchored-uuo-section :resume)
2132 :bad
2133 (:anchored-uuo (uuo-error-not-callable)))
2134
2135(define-x8664-vinsn (xpass-multiple-values-known-function :call :extended-call :jumplr)
2136 (() ((lab :label) (fnreg :lisp)))
2137 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2138 (jmp (:%q fnreg)))
2139
2140(define-x8664-vinsn (pass-multiple-values-known-function :call :extended-call :jumplr)
2141 (() ((fnreg :lisp)))
2142 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2143 (jmp (:%q fnreg)))
2144
2145(define-x8664-vinsn reserve-outgoing-frame (()
2146 ())
2147 (pushq (:$b x8664::reserved-frame-marker))
2148 (pushq (:$b x8664::reserved-frame-marker)))
2149
2150(define-x8664-vinsn (pop-return-address-into-reserved-frame) (()
2151 ())
2152 (popq (:@ 16 (:%q x8664::rsp))))
2153
2154
2155
2156(define-x8664-vinsn (call-known-function :call) (()
2157 ()
2158 ((entry (:label 1))))
2159 (:talign 4)
2160 (call (:%q x8664::temp0))
2161 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2162
2163(define-x8664-vinsn (jump-known-function :jumplr) (()
2164 ()
2165 ((xfn (:lisp #.x8664::xfn))))
2166 (movq (:%q x8664::fn) (:%q x8664::xfn))
2167 (movq (:%q x8664::temp0) (:%q x8664::fn))
2168 (jmp (:%q x8664::fn)))
2169
2170(define-x8664-vinsn (list :call) (()
2171 ()
2172 ((entry (:label 1))))
2173 (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
2174 (:talign 4)
2175 (jmp (:@ .SPconslist))
2176 :back
2177 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2178
2179
2180(define-x8664-vinsn (make-tsp-cons ) (((dest :lisp))
2181 ((car :lisp) (cdr :lisp))
2182 ((temp :imm)
2183 (stack-temp :imm)))
2184 (subq (:$b (+ x8664::cons.size x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
2185 (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
2186 (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
2187 (movapd (:%xmm x8664::fpzero) (:@ 16 (:%q temp)))
2188 (movq (:rcontext x8664::tcr.save-tsp) (:%q stack-temp))
2189 (movq (:%q stack-temp) (:@ (:%q temp)))
2190 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
2191 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2192 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-cons) (:%q temp)) (:%q temp))
2193 (movq (:%q car) (:@ x8664::cons.car (:%q temp)))
2194 (movq (:%q cdr) (:@ x8664::cons.cdr (:%q temp)))
2195 (movq (:%q temp) (:%q dest)))
2196
2197(define-x8664-vinsn make-fixed-stack-gvector (((dest :lisp))
2198 ((aligned-size :u32const)
2199 (header :s32const))
2200 ((tempa :imm)
2201 (tempb :imm)
2202 (stack-temp :imm)))
2203 ((:and (:pred >= (:apply + aligned-size x8664::dnode-size) -128)
2204 (:pred <= (:apply + aligned-size x8664::dnode-size) 127))
2205 (subq (:$b (:apply + aligned-size x8664::dnode-size))
2206 (:rcontext x8664::tcr.next-tsp)))
2207 ((:not (:and (:pred >= (:apply + aligned-size x8664::dnode-size) -128)
2208 (:pred <= (:apply + aligned-size x8664::dnode-size) 127)))
2209 (subq (:$l (:apply + aligned-size x8664::dnode-size))
2210 (:rcontext x8664::tcr.next-tsp)))
2211 (movq (:rcontext x8664::tcr.save-tsp) (:%q tempb))
2212 (movq (:rcontext x8664::tcr.next-tsp) (:%q tempa))
2213 (movq (:%q tempb) (:%q stack-temp))
2214 :loop
2215 (movapd (:%xmm x8664::fpzero) (:@ -16 (:%q tempb)))
2216 (subq (:$b x8664::dnode-size) (:%q tempb))
2217 (cmpq (:%q tempa) (:%q tempb))
2218 (jnz :loop)
2219 (movq (:%q stack-temp) (:@ (:%q tempa)))
2220 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q tempa)))
2221 (movq (:%q tempa) (:rcontext x8664::tcr.save-tsp))
2222 (movl (:$l header) (:@ x8664::dnode-size (:%q tempa)))
2223 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q tempa)) (:%q dest)))
2224
2225
2226(define-x8664-vinsn (discard-temp-frame :tsp :pop :discard) (()
2227 ()
2228 ((temp :imm)))
2229 (movq (:rcontext x8664::tcr.save-tsp) (:%q temp))
2230 (movq (:@ (:%q temp)) (:%q temp))
2231 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2232 (movq (:%q temp) (:rcontext x8664::tcr.next-tsp))
2233 )
2234
2235(define-x8664-vinsn (discard-c-frame :pop :discard) (()
2236 ()
2237 ((temp :imm)))
2238 (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
2239 (movq (:@ (:%q temp)) (:%q temp))
2240 (movq (:%q temp) (:rcontext x8664::tcr.foreign-sp)))
2241
2242
2243(define-x8664-vinsn (vstack-discard :vsp :pop :discard) (()
2244 ((nwords :u32const)))
2245 ((:not (:pred = nwords 0))
2246 ((:pred < nwords 16)
2247 (addq (:$b (:apply ash nwords x8664::word-shift)) (:%q x8664::rsp)))
2248 ((:not (:pred < nwords 16))
2249 (addq (:$l (:apply ash nwords x8664::word-shift)) (:%q x8664::rsp)))))
2250
2251
2252(defmacro define-x8664-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
2253 `(define-x8664-vinsn (,name :call :subprim ,@other-attrs) (() () ((entry (:label 1))))
2254 (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
2255 (:talign 4)
2256 (jmp (:@ ,spno))
2257 :back
2258 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
2259
2260(defmacro define-x8664-subprim-call-vinsn ((name &rest other-attrs) spno)
2261 `(define-x8664-vinsn (,name :call :subprim ,@other-attrs) (() () ((entry (:label 1))))
2262 (:talign 4)
2263 (call (:@ ,spno))
2264 :back
2265 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
2266
2267(defmacro define-x8664-subprim-jump-vinsn ((name &rest other-attrs) spno)
2268 `(define-x8664-vinsn (,name :jumpLR ,@other-attrs) (() ())
2269 (jmp (:@ ,spno))))
2270
2271(define-x8664-vinsn (nthrowvalues :call :subprim :needs-frame-pointer) (() ())
2272 (jmp (:@ .SPnthrowvalues)))
2273
2274(define-x8664-vinsn (nthrow1value :call :subprim :needs-frame-pointer) (() ())
2275 (jmp (:@ .SPnthrow1value)))
2276
2277
2278
2279(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
2280
2281
2282(define-x8664-vinsn (bind-interrupt-level-0-inline) (()
2283 ()
2284 ((temp :imm)))
2285 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2286 (cmpq (:$b 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
2287 (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
2288 (pushq (:$b x8664::interrupt-level-binding-index))
2289 (pushq (:rcontext x8664::tcr.db-link))
2290 (movq (:$l 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
2291 (movq (:%q x8664::rsp) (:rcontext x8664::tcr.db-link))
2292 (jns :done)
2293 (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
2294 (jae :done)
2295 (ud2a)
2296 (:byte 2)
2297 :done)
2298
2299
2300
2301(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
2302
2303(define-x8664-vinsn bind-interrupt-level-m1-inline (()
2304 ()
2305 ((temp :imm)))
2306 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2307 (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
2308 (pushq (:$b x8664::interrupt-level-binding-index))
2309 (pushq (:rcontext x8664::tcr.db-link))
2310 (movq (:$l (ash -1 x8664::fixnumshift)) (:@ x8664::interrupt-level-binding-index (:%q temp)))
2311 (movq (:%q x8664::rsp) (:rcontext x8664::tcr.db-link)))
2312
2313(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
2314
2315(define-x8664-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
2316
2317(define-x8664-vinsn unbind-interrupt-level-inline (()
2318 ()
2319 ((link :imm)
2320 (curval :imm)
2321 (oldval :imm)
2322 (tlb :imm)))
2323 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q tlb))
2324 (movq (:rcontext x8664::tcr.db-link) (:%q link))
2325 (movq (:@ x8664::interrupt-level-binding-index (:%q tlb)) (:%q curval))
2326 (testq (:%q curval) (:%q curval))
2327 (movq (:@ 16 #|binding.val|# (:%q link)) (:%q oldval))
2328 (movq (:@ #|binding.link|# (:%q link)) (:%q link))
2329 (movq (:%q oldval) (:@ x8664::interrupt-level-binding-index (:%q tlb)))
2330 (movq (:%q link) (:rcontext x8664::tcr.db-link))
2331 (jns :done)
2332 (testq (:%q oldval) (:%q oldval))
2333 (js :done)
2334 (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
2335 (jae :done)
2336 (ud2a)
2337 (:byte 2)
2338 :done)
2339
2340(define-x8664-vinsn (jump-return-pc :jumpLR)
2341 (()
2342 ())
2343 (ret))
2344
2345(define-x8664-vinsn label-address (((dest :lisp))
2346 ((lab :label)))
2347
2348 (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q dest)))
2349
2350
2351(define-x8664-vinsn (mkunwind :call :subprim :needs-frame-pointer) (() ())
2352 ; sic
2353 (jmp (:@ .SPmkunwind)))
2354
2355(define-x8664-vinsn (nmkunwind :call :subprim :needs-frame-pointer) (() ())
2356
2357 (jmp (:@ .SPnmkunwind)))
2358
2359;;; "old" mkunwind. Used by PROGV, since the binding of *interrupt-level*
2360;;; on entry to the new mkunwind confuses the issue.
2361
2362
2363(define-x8664-subprim-lea-jmp-vinsn (gvector) .SPgvector)
2364
2365(define-x8664-subprim-call-vinsn (getu64) .SPgetu64)
2366
2367;;; Call something callable and obtain the single value that it
2368;;; returns.
2369(define-x8664-vinsn (funcall :call) (()
2370 ()
2371 ((tag :u8)
2372 (entry (:label 1))))
2373 :resume
2374 (movl (:%l x8664::temp0) (:%l tag))
2375 (andl (:$b x8664::fulltagmask) (:%l tag))
2376 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2377 (cmovgq (:%q x8664::temp0) (:%q x8664::xfn))
2378 (jl :bad)
2379 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::xfn))
2380 (:talign 4)
2381 (call (:%q x8664::xfn))
2382 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
2383 (:anchored-uuo-section :resume)
2384 :bad
2385 (:anchored-uuo (uuo-error-not-callable)))
2386
2387(define-x8664-vinsn (tail-funcall :jumplr) (()
2388 ()
2389 ((tag (:u8 #.x8664::imm0))))
2390 :resume
2391 (movl (:%l x8664::temp0) (:%l tag))
2392 (andl (:$b x8664::fulltagmask) (:%l tag))
2393 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2394 (cmovgq (:%q x8664::temp0) (:%q x8664::xfn))
2395 (jl :bad)
2396 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::xfn))
2397 (jmp (:%q x8664::xfn))
2398
2399 (:anchored-uuo-section :resume)
2400 :bad
2401 (:anchored-uuo (uuo-error-not-callable)))
2402
2403
2404
2405;;; Magic numbers in here include the address of .SPcall-closure.
2406(define-x8664-vinsn init-nclosure (()
2407 ((closure :lisp))
2408 ((imm0 :u64)))
2409 (movq (:$q #x24fffffffff92d8d) (:%q imm0))
2410 (movb (:$b 4) (:@ x8664::misc-data-offset (:%q closure))) ; code word count
2411 (movb (:$b #x4c) (:@ (+ x8664::misc-data-offset 7) (:%q closure))) ; 1st byte of lea
2412 (movq (:%q imm0) (:@ (+ x8664::misc-data-offset 8) (:%q closure))) ; rest of lea, start of jmp
2413 (movl (:$l #x01516825) (:@ (+ x8664::misc-data-offset 16) (:%q closure)))
2414 (movb (:$b x8664::function-boundary-marker) (:@ (+ x8664::misc-data-offset 24) (:%q closure))))
2415
2416
2417(define-x8664-vinsn finalize-closure (((closure :lisp))
2418 ((closure :lisp)))
2419 (addq (:$b (- x8664::fulltag-function x8664::fulltag-misc)) (:%q closure)))
2420
2421
2422(define-x8664-vinsn (ref-symbol-value :call :subprim)
2423 (((val :lisp))
2424 ((sym (:lisp (:ne val))))
2425 ((entry (:label 1))))
2426 (:talign 4)
2427 (call (:@ .SPspecrefcheck))
2428 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)) )
2429
2430(define-x8664-vinsn ref-symbol-value-inline (((dest :lisp))
2431 ((src (:lisp (:ne dest))))
2432 ((table :imm)
2433 (idx :imm)))
2434 :resume
2435 (movq (:@ x8664::symbol.binding-index (:%q src)) (:%q idx))
2436 ;; The entry for binding-index 0 in the table always
2437 ;; contains a no-thread-local-binding marker; treat
2438 ;; out-of-bounds indices as 0 to avoid branches
2439 (xorl (:%l table) (:%l table))
2440 (rcmpq (:%q idx) (:rcontext x8664::tcr.tlb-limit))
2441 (cmovael (:%l table) (:%l idx))
2442 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q table))
2443 (movq (:@ (:%q table) (:%q idx)) (:%q dest))
2444 (cmpl (:$b x8664::subtag-no-thread-local-binding) (:%l dest))
2445 (cmoveq (:@ x8664::symbol.vcell (:%q src)) (:%q dest))
2446 :test
2447 (cmpl (:$b x8664::unbound-marker) (:%l dest))
2448 (je :bad)
2449
2450 (:anchored-uuo-section :resume)
2451 :bad
2452 (:anchored-uuo (uuo-error-unbound (:%q src))))
2453
2454
2455(define-x8664-vinsn (%ref-symbol-value :call :subprim)
2456 (((val :lisp))
2457 ((sym (:lisp (:ne val))))
2458 ((entry (:label 1))))
2459 (:talign 4)
2460 (call (:@ .SPspecref))
2461 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2462
2463(define-x8664-vinsn %ref-symbol-value-inline (((dest :lisp))
2464 ((src (:lisp (:ne dest))))
2465 ((table :imm)
2466 (idx :imm)))
2467 ;; Treat out-of-bounds indices as index 0
2468 (movq (:@ x8664::symbol.binding-index (:%q src)) (:%q idx))
2469 (xorl (:%l table) (:%l table))
2470 (rcmpq (:%q idx) (:rcontext x8664::tcr.tlb-limit))
2471 (cmovael (:%l table) (:%l idx))
2472 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q table))
2473 (movq (:@ (:%q table) (:%q idx)) (:%q dest))
2474 (cmpb (:$b x8664::subtag-no-thread-local-binding) (:%b dest))
2475 (cmoveq (:@ x8664::symbol.vcell (:%q src)) (:%q dest)))
2476
2477(define-x8664-vinsn ref-interrupt-level (((dest :imm))
2478 ()
2479 ((temp :u64)))
2480 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2481 (movq (:@ x8664::INTERRUPT-LEVEL-BINDING-INDEX (:%q temp)) (:%q dest)))
2482
2483
2484
2485
2486(define-x8664-vinsn setup-double-float-allocation (()
2487 ())
2488 (movl (:$l (arch::make-vheader x8664::double-float.element-count x8664::subtag-double-float)) (:%l x8664::imm0.l))
2489 (movl (:$l (- x8664::double-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2490
2491(define-x8664-vinsn setup-complex-double-float-allocation (()
2492 ())
2493 (movl (:$l (arch::make-vheader 6 x8664::subtag-complex-double-float)) (:%l x8664::imm0.l))
2494 (movl (:$l (- x8664::complex-double-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2495
2496(define-x8664-vinsn setup-complex-single-float-allocation (()
2497 ())
2498 (movl (:$l (arch::make-vheader 2 x8664::subtag-complex-single-float)) (:%l x8664::imm0.l))
2499 (movl (:$l (- x8664::complex-single-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2500
2501(define-x8664-vinsn set-double-float-value (()
2502 ((node :lisp)
2503 (val :double-float)))
2504 (movsd (:%xmm val) (:@ x8664::double-float.value (:%q node))))
2505
2506(define-x8664-vinsn set-complex-double-float-value (()
2507 ((node :lisp)
2508 (val :complex-double-float)))
2509 (movdqa (:%xmm val) (:@ x8664::complex-double-float.realpart (:%q node))))
2510
2511(define-x8664-vinsn set-complex-single-float-value (()
2512 ((node :lisp)
2513 (val :complex-single-float)))
2514 (movq (:%xmm val) (:@ x8664::complex-single-float.realpart (:%q node))))
2515
2516
2517(define-x8664-vinsn word-index-and-bitnum-from-index (((word-index :u64)
2518 (bitnum :u8))
2519 ((index :imm)))
2520 (movq (:%q index) (:%q word-index))
2521 (shrq (:$ub x8664::fixnumshift) (:%q word-index))
2522 (movl (:$l 63) (:%l bitnum))
2523 (andl (:%l word-index) (:%l bitnum))
2524 (shrq (:$ub 6) (:%q word-index)))
2525
2526(define-x8664-vinsn ref-bit-vector-fixnum (((dest :imm)
2527 (bitnum :u8))
2528 ((bitnum :u8)
2529 (bitvector :lisp)
2530 (word-index :u64)))
2531 (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector) (:%q word-index) 8))
2532 (setb (:%b bitnum))
2533 (negb (:%b bitnum))
2534 (andl (:$l x8664::fixnumone) (:%l bitnum))
2535 (movl (:%l bitnum) (:%l dest)))
2536
2537(define-x8664-vinsn nref-bit-vector-fixnum (((dest :imm)
2538 (bitnum :s64))
2539 ((bitnum :s64)
2540 (bitvector :lisp))
2541 ())
2542 (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector)))
2543 (setc (:%b bitnum))
2544 (movzbl (:%b bitnum) (:%l bitnum))
2545 (imull (:$b x8664::fixnumone) (:%l bitnum) (:%l dest)))
2546
2547
2548(define-x8664-vinsn nref-bit-vector-flags (()
2549 ((bitnum :s64)
2550 (bitvector :lisp))
2551 ())
2552 (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector))))
2553
2554(define-x8664-vinsn misc-ref-c-bit-fixnum (((dest :imm))
2555 ((src :lisp)
2556 (idx :u64const))
2557 ((temp :u8)))
2558 (btq (:$ub (:apply logand 63 idx))
2559 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
2560 (setc (:%b temp))
2561 (movzbl (:%b temp) (:%l temp))
2562 (imull (:$b x8664::fixnumone) (:%l temp) (:%l dest)))
2563
2564
2565(define-x8664-vinsn misc-ref-c-bit-flags (()
2566 ((src :lisp)
2567 (idx :u64const))
2568 )
2569 (btq (:$ub (:apply logand 63 idx))
2570 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
2571
2572(define-x8664-vinsn deref-macptr (((addr :address))
2573 ((src :lisp))
2574 ())
2575 (movq (:@ x8664::macptr.address (:%q src)) (:%q addr)))
2576
2577(define-x8664-vinsn reserve-spill-area (() () ((count :u32)))
2578 ((:pred > (:apply x8664-spill-area-needed) 0)
2579 ((:pred = (:apply x8664-spill-area-needed) 1)
2580 (pushq (:$b 0)))
2581 ((:pred = (:apply x8664-spill-area-needed) 2)
2582 (pushq (:$b 0))
2583 (pushq (:$b 0)))
2584 ((:pred = (:apply x8664-spill-area-needed) 3)
2585 (pushq (:$b 0))
2586 (pushq (:$b 0))
2587 (pushq (:$b 0)))
2588 ((:pred = (:apply x8664-spill-area-needed) 4)
2589 (pushq (:$b 0))
2590 (pushq (:$b 0))
2591 (pushq (:$b 0))
2592 (pushq (:$b 0)))
2593 ((:pred = (:apply x8664-spill-area-needed) 5)
2594 (pushq (:$b 0))
2595 (pushq (:$b 0))
2596 (pushq (:$b 0))
2597 (pushq (:$b 0))
2598 (pushq (:$b 0)))
2599 ((:pred > (:apply x8664-spill-area-needed) 5)
2600 (movl (:$l (:apply x8664-spill-area-needed)) (:%l count))
2601 :loop
2602 (pushq (:$b 0))
2603 (subl (:$b 1) (:%l count))
2604 (jge :loop))))
2605
2606
2607
2608
2609(define-x8664-vinsn save-nfp (()
2610 ()
2611 ((nfp :lisp)))
2612 ((:pred > (:apply x862-max-nfp-depth) 0)
2613 (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
2614 (:if (:pred < (:apply + 16 (:apply x862-max-nfp-depth)) 128)
2615 (subq (:$b (:apply + 16 (:apply x862-max-nfp-depth))) (:rcontext x8664::tcr.foreign-sp))
2616 (subq (:$l (:apply + 16 (:apply x862-max-nfp-depth))) (:rcontext x8664::tcr.foreign-sp)))
2617 (movq (:rcontext x8664::tcr.foreign-sp) (:%q nfp))
2618 (movq (:%mmx x8664::stack-temp) (:@ (:%q nfp)))
2619 (movq (:rcontext x8664::tcr.nfp) (:%mmx x8664::stack-temp))
2620 (movq (:%mmx x8664::stack-temp) (:@ 8 (:%q nfp)))
2621 (movq (:%q nfp) (:rcontext x8664::tcr.nfp))))
2622
2623
2624
2625
2626(define-x8664-vinsn restore-nfp (()
2627 ()
2628 ())
2629 ((:pred > (:apply x862-max-nfp-depth) 0)
2630 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2631 (movq (:@ 8 (:%q x8664::temp5)) (:%mmx x8664::stack-temp))
2632 (movq (:@ (:%q x8664::temp5)) (:%q x8664::temp5))
2633 (movq (:%q x8664::temp5) (:rcontext x8664::tcr.foreign-sp))
2634 (movq (:%mmx x8664::stack-temp)(:rcontext x8664::tcr.nfp))))
2635
2636
2637
2638
2639
2640
2641
2642
2643(define-x8664-vinsn (reload-natural :reload :nfp :ref) (((val :u64))
2644 ((offset :u16const)))
2645 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2646 (movq (:@ (:apply + 16 offset) (:%q x8664::temp5)) (:%q val)))
2647
2648
2649
2650
2651(define-x8664-vinsn (reload-double-float :reload :nfp :ref) (((val :double-float))
2652 ((offset :u16const)))
2653 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2654 (movsd (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2655
2656
2657
2658
2659
2660
2661
2662(define-x8664-vinsn (reload-single-float :reload :nfp :ref) (((val :single-float))
2663 ((offset :u16const)
2664 ))
2665 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2666 (movss (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2667
2668
2669
2670
2671(define-x8664-vinsn (reload-complex-single-float :reload :nfp :ref) (((val :complex-single-float))
2672 ((offset :u16const)
2673 (nfp :imm)))
2674 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2675 (movq (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2676
2677
2678
2679
2680(define-x8664-vinsn (reload-complex-double-float :reload :nfp :ref) (((val :complex-double-float))
2681 ((offset :u16const)
2682 ))
2683 (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2684 (movdqu (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2685
2686(define-x8664-vinsn (temp-push-unboxed-word :push :word )
2687 (()
2688 ((w :u64))
2689 ((temp :imm)
2690 (stack-temp :imm)))
2691 (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
2692 (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp))
2693 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::temp5))
2694 (movq (:%q stack-temp) (:@ (:%q x8664::temp5)))
2695 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::temp5)))
2696 (movq (:%q w) (:@ x8664::dnode-size (:%q x8664::temp5))))
2697
2698
2699(define-x8664-vinsn (temp-push-node :push :word :tsp)
2700 (()
2701 ((w :lisp))
2702 ((temp :imm)
2703 (stack-temp :imm)))
2704 (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
2705 (movq (:rcontext x8664::tcr.save-tsp) (:%q stack-temp))
2706 (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
2707 (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
2708 (movapd (:%xmm x8664::fpzero) (:@ 16 (:%q temp)))
2709 (movq (:%q stack-temp) (:@ (:%q temp)))
2710 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
2711 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2712 (movq (:%q w) (:@ x8664::dnode-size (:%q temp))))
2713
2714(define-x8664-vinsn (temp-push-double-float :push :word )
2715 (()
2716 ((f :double-float))
2717 ((temp :imm)
2718 (stack-temp :imm)))
2719 (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
2720 (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp))
2721 (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
2722 (movq (:%q stack-temp) (:@ (:%q temp)))
2723 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q temp)))
2724 (movapd (:%xmm f) (:@ x8664::dnode-size (:%q temp))))
2725
2726
2727(define-x8664-vinsn (vpush-single-float :push :word :vsp)
2728 (()
2729 ((f :single-float)))
2730 (pushq (:$b x8664::tag-single-float))
2731 (movss (:%xmm f) (:@ 4 (:%q x8664::rsp))))
2732
2733(define-x8664-vinsn (vpop-single-float :pop :word :vsp)
2734 (()
2735 ((f :single-float)))
2736 (movss (:@ 4 (:%q x8664::rsp)) (:%xmm f))
2737 (addq (:$b x8664::node-size) (:%q x8664::rsp)))
2738
2739(define-x8664-vinsn (temp-pop-unboxed-word :pop :word )
2740 (((w :u64))
2741 ()
2742 ((temp (:u64 #.x8664::ra0))))
2743 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2744 (movq (:@ x8664::dnode-size (:%q x8664::ra0)) (:%q w))
2745 (addq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp)))
2746
2747
2748(define-x8664-vinsn (temp-pop-node :pop :word :tsp)
2749 (((w :lisp))
2750 ()
2751 ((temp :imm)))
2752 (movq (:rcontext x8664::tcr.save-tsp) (:%q temp))
2753 (movq (:@ x8664::dnode-size (:%q temp)) (:%q w))
2754 (movq (:@ (:%q temp)) (:%q temp))
2755 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2756 (movq (:%q temp) (:rcontext x8664::tcr.next-tsp)))
2757
2758(define-x8664-vinsn (temp-pop-double-float :pop :word)
2759 (((f :double-float))
2760 ()
2761 ((temp (:u64 #.x8664::ra0))))
2762 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2763 (movapd (:@ x8664::dnode-size (:%q x8664::ra0)) (:%xmm f))
2764 (addq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp)))
2765
2766
2767
2768(define-x8664-vinsn macptr->stack (((dest :lisp))
2769 ((ptr :address))
2770 ((temp :imm)
2771 (stack-temp :imm)))
2772 (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
2773 (subq (:$b (+ x8664::dnode-size x8664::macptr.size)) (:rcontext x8664::tcr.foreign-sp))
2774 (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
2775 (movq (:%q stack-temp) (:@ (:%q temp)))
2776 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q temp)))
2777 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q temp)) (:%q dest))
2778 (movq (:$l x8664::macptr-header) (:@ x8664::macptr.header (:%q dest)))
2779 (movq (:%q ptr) (:@ x8664::macptr.address (:%q dest)))
2780 (movapd (:%xmm x8664::fpzero) (:@ x8664::macptr.domain (:%q dest))))
2781
2782(define-x8664-vinsn fixnum->signed-natural (((dest :s64))
2783 ((src :imm)))
2784 (movq (:%q src) (:%q dest))
2785 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
2786
2787(define-x8664-vinsn mem-set-double-float (()
2788 ((val :double-float)
2789 (src :address)
2790 (index :s64)))
2791 (movsd (:%xmm val) (:@ (:%q src) (:%q index))))
2792
2793(define-x8664-vinsn mem-set-single-float (()
2794 ((val :single-float)
2795 (src :address)
2796 (index :s64)))
2797 (movss (:%xmm val) (:@ (:%q src) (:%q index))))
2798
2799
2800
2801(define-x8664-vinsn mem-set-c-doubleword (()
2802 ((val :u64)
2803 (dest :address)
2804 (offset :s32const)))
2805 ((:pred = offset 0)
2806 (movq (:%q val) (:@ (:%q dest))))
2807 ((:not (:pred = offset 0))
2808 (movq (:%q val) (:@ offset (:%q dest)))))
2809
2810(define-x8664-vinsn mem-set-c-fullword (()
2811 ((val :u32)
2812 (dest :address)
2813 (offset :s32const)))
2814 ((:pred = offset 0)
2815 (movl (:%l val) (:@ (:%q dest))))
2816 ((:not (:pred = offset 0))
2817 (movl (:%l val) (:@ offset (:%q dest)))))
2818
2819(define-x8664-vinsn mem-set-c-halfword (()
2820 ((val :u16)
2821 (dest :address)
2822 (offset :s32const)))
2823 ((:pred = offset 0)
2824 (movw (:%w val) (:@ (:%q dest))))
2825 ((:not (:pred = offset 0))
2826 (movw (:%w val) (:@ offset (:%q dest)))))
2827
2828(define-x8664-vinsn mem-set-c-byte (()
2829 ((val :u8)
2830 (dest :address)
2831 (offset :s32const)))
2832 ((:pred = offset 0)
2833 (movb (:%b val) (:@ (:%q dest))))
2834 ((:not (:pred = offset 0))
2835 (movb (:%b val) (:@ offset (:%q dest)))))
2836
2837(define-x8664-vinsn mem-set-c-constant-doubleword (()
2838 ((val :s32const)
2839 (dest :address)
2840 (offset :s32const)))
2841 ((:pred = offset 0)
2842 (movq (:$l val) (:@ (:%q dest))))
2843 ((:not (:pred = offset 0))
2844 (movq (:$l val) (:@ offset (:%q dest)))))
2845
2846(define-x8664-vinsn mem-set-c-constant-fullword (()
2847 ((val :s32const)
2848 (dest :address)
2849 (offset :s32const)))
2850 ((:pred = offset 0)
2851 (movl (:$l val) (:@ (:%q dest))))
2852 ((:not (:pred = offset 0))
2853 (movl (:$l val) (:@ offset (:%q dest)))))
2854
2855(define-x8664-vinsn mem-set-c-constant-halfword (()
2856 ((val :s16const)
2857 (dest :address)
2858 (offset :s32const)))
2859 ((:pred = offset 0)
2860 (movw (:$w val) (:@ (:%q dest))))
2861 ((:not (:pred = offset 0))
2862 (movw (:$w val) (:@ offset (:%q dest)))))
2863
2864(define-x8664-vinsn mem-set-c-constant-byte (()
2865 ((val :s8const)
2866 (dest :address)
2867 (offset :s32const)))
2868 ((:pred = offset 0)
2869 (movb (:$b val) (:@ (:%q dest))))
2870 ((:not (:pred = offset 0))
2871 (movb (:$b val) (:@ offset (:%q dest)))))
2872
2873
2874
2875
2876
2877
2878(define-x8664-vinsn mem-ref-natural (((dest :u64))
2879 ((src :address)
2880 (index :s64)))
2881 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2882
2883(define-x8664-vinsn setup-macptr-allocation (()
2884 ((src :address)))
2885 (movq (:%q src) (:%q x8664::imm2))
2886 (movl (:$l x8664::macptr-header) (:%l x8664::imm0.l))
2887 (movl (:$l (- x8664::macptr.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2888
2889(define-x8664-vinsn %set-new-macptr-value (()
2890 ((ptr :lisp)))
2891 (movq (:%q x8664::imm2) (:@ x8664::macptr.address (:%q ptr))))
2892
2893(define-x8664-vinsn mem-ref-c-fullword (((dest :u32))
2894 ((src :address)
2895 (index :s32const)))
2896 ((:pred = index 0)
2897 (movl (:@ (:%q src)) (:%l dest)))
2898 ((:not (:pred = index 0))
2899 (movl (:@ index (:%q src)) (:%l dest))))
2900
2901(define-x8664-vinsn mem-ref-c-signed-fullword (((dest :s32))
2902 ((src :address)
2903 (index :s32const)))
2904 ((:pred = index 0)
2905 (movslq (:@ (:%q src)) (:%q dest)))
2906 ((:not (:pred = index 0))
2907 (movslq (:@ index (:%q src)) (:%q dest))))
2908
2909
2910(define-x8664-vinsn mem-ref-c-single-float (((dest :single-float))
2911 ((src :address)
2912 (index :s32const)))
2913 ((:pred = index 0)
2914 (movss (:@ (:%q src)) (:%xmm dest)))
2915 ((:not (:pred = index 0))
2916 (movss (:@ index (:%q src)) (:%xmm dest))))
2917
2918(define-x8664-vinsn mem-set-c-single-float (()
2919 ((val :single-float)
2920 (src :address)
2921 (index :s16const)))
2922 ((:pred = index 0)
2923 (movss (:%xmm val) (:@ (:%q src))))
2924 ((:not (:pred = index 0))
2925 (movss (:%xmm val) (:@ index (:%q src)))))
2926
2927(define-x8664-vinsn mem-ref-c-doubleword (((dest :u64))
2928 ((src :address)
2929 (index :s32const)))
2930 ((:pred = index 0)
2931 (movq (:@ (:%q src)) (:%q dest)))
2932 ((:not (:pred = index 0))
2933 (movq (:@ index (:%q src)) (:%q dest))))
2934
2935(define-x8664-vinsn mem-ref-c-signed-doubleword (((dest :s64))
2936 ((src :address)
2937 (index :s32const)))
2938 ((:pred = index 0)
2939 (movq (:@ (:%q src)) (:%q dest)))
2940 ((:not (:pred = index 0))
2941 (movq (:@ index (:%q src)) (:%q dest))))
2942
2943(define-x8664-vinsn mem-ref-c-natural (((dest :u64))
2944 ((src :address)
2945 (index :s32const)))
2946 ((:pred = index 0)
2947 (movq (:@ (:%q src)) (:%q dest)))
2948 ((:not (:pred = index 0))
2949 (movq (:@ index (:%q src)) (:%q dest))))
2950
2951(define-x8664-vinsn mem-ref-c-double-float (((dest :double-float))
2952 ((src :address)
2953 (index :s32const)))
2954 ((:pred = index 0)
2955 (movsd (:@ (:%q src)) (:%xmm dest)))
2956 ((:not (:pred = index 0))
2957 (movsd (:@ index (:%q src)) (:%xmm dest))))
2958
2959(define-x8664-vinsn mem-set-c-double-float (()
2960 ((val :double-float)
2961 (src :address)
2962 (index :s16const)))
2963 ((:pred = index 0)
2964 (movsd (:%xmm val) (:@ (:%q src))))
2965 ((:not (:pred = index 0))
2966 (movsd (:%xmm val) (:@ index (:%q src)))))
2967
2968(define-x8664-vinsn mem-ref-fullword (((dest :u32))
2969 ((src :address)
2970 (index :s64)))
2971 (movl (:@ (:%q src) (:%q index)) (:%l dest)))
2972
2973(define-x8664-vinsn mem-ref-signed-fullword (((dest :s32))
2974 ((src :address)
2975 (index :s64)))
2976 (movslq (:@ (:%q src) (:%q index)) (:%q dest)))
2977
2978(define-x8664-vinsn mem-ref-doubleword (((dest :u64))
2979 ((src :address)
2980 (index :s64)))
2981 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2982
2983(define-x8664-vinsn mem-ref-natural (((dest :u64))
2984 ((src :address)
2985 (index :s64)))
2986 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2987
2988(define-x8664-vinsn mem-ref-signed-doubleword (((dest :s64))
2989 ((src :address)
2990 (index :s64)))
2991 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2992
2993(define-x8664-vinsn mem-ref-c-u16 (((dest :u16))
2994 ((src :address)
2995 (index :s32const)))
2996 ((:pred = index 0)
2997 (movzwq (:@ (:%q src)) (:%q dest)))
2998 ((:not (:pred = index 0))
2999 (movzwq (:@ index (:%q src)) (:%q dest))))
3000
3001(define-x8664-vinsn mem-ref-u16 (((dest :u16))
3002 ((src :address)
3003 (index :s64)))
3004 (movzwq (:@ (:%q src) (:%q index)) (:%q dest)))
3005
3006
3007(define-x8664-vinsn mem-ref-c-s16 (((dest :s16))
3008 ((src :address)
3009 (index :s32const)))
3010 ((:pred = index 0)
3011 (movswq (:@ (:%q src)) (:%q dest)))
3012 ((:not (:pred = index 0))
3013 (movswq (:@ index (:%q src)) (:%q dest))))
3014
3015(define-x8664-vinsn mem-ref-s16 (((dest :s16))
3016 ((src :address)
3017 (index :s32)))
3018 (movswq (:@ (:%q src) (:%q index)) (:%q dest)))
3019
3020(define-x8664-vinsn mem-ref-c-u8 (((dest :u8))
3021 ((src :address)
3022 (index :s16const)))
3023 ((:pred = index 0)
3024 (movzbq (:@ (:%q src)) (:%q dest)))
3025 ((:not (:pred = index 0))
3026 (movzbq (:@ index (:%q src)) (:%q dest))))
3027
3028(define-x8664-vinsn mem-ref-u8 (((dest :u8))
3029 ((src :address)
3030 (index :s32)))
3031 (movzbq (:@ (:%q src) (:%q index)) (:%q dest)))
3032
3033(define-x8664-vinsn mem-ref-c-s8 (((dest :s8))
3034 ((src :address)
3035 (index :s16const)))
3036 ((:pred = index 0)
3037 (movsbq (:@ (:%q src)) (:%q dest)))
3038 ((:not (:pred = index 0))
3039 (movsbq (:@ index (:%q src)) (:%q dest))))
3040
3041(define-x8664-vinsn misc-set-c-s8 (((val :s8))
3042 ((v :lisp)
3043 (idx :u32const))
3044 ())
3045 (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
3046
3047(define-x8664-vinsn misc-set-s8 (((val :s8))
3048 ((v :lisp)
3049 (scaled-idx :s64))
3050 ())
3051 (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3052
3053(define-x8664-vinsn mem-ref-s8 (((dest :s8))
3054 ((src :address)
3055 (index :s32)))
3056 (movsbq (:@ (:%q src) (:%q index)) (:%q dest)))
3057
3058(define-x8664-vinsn mem-set-constant-doubleword (()
3059 ((val :s32const)
3060 (ptr :address)
3061 (offset :s64)))
3062 (movq (:$l val) (:@ (:%q ptr) (:%q offset))))
3063
3064(define-x8664-vinsn mem-set-constant-fullword (()
3065 ((val :s32const)
3066 (ptr :address)
3067 (offset :s64)))
3068 (movl (:$l val) (:@ (:%q ptr) (:%q offset))))
3069
3070
3071(define-x8664-vinsn mem-set-constant-halfword (()
3072 ((val :s16const)
3073 (ptr :address)
3074 (offset :s64)))
3075 (movw (:$w val) (:@ (:%q ptr) (:%q offset))))
3076
3077(define-x8664-vinsn mem-set-constant-byte (()
3078 ((val :s8const)
3079 (ptr :address)
3080 (offset :s64)))
3081 (movb (:$b val) (:@ (:%q ptr) (:%q offset))))
3082
3083(define-x8664-vinsn misc-set-c-u8 (((val :u8))
3084 ((v :lisp)
3085 (idx :u32const))
3086 ())
3087 (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
3088
3089(define-x8664-vinsn misc-set-u8 (((val :u8))
3090 ((v :lisp)
3091 (scaled-idx :s64))
3092 ())
3093 (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3094
3095(define-x8664-vinsn misc-set-c-u8 (((val :u8))
3096 ((v :lisp)
3097 (idx :s32const))
3098 ())
3099 (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
3100
3101(define-x8664-vinsn misc-set-u8 (()
3102 ((val :u8)
3103 (v :lisp)
3104 (scaled-idx :s64))
3105 ())
3106 (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3107
3108(define-x8664-vinsn misc-set-c-u16 (()
3109 ((val :u16)
3110 (v :lisp)
3111 (idx :s32const))
3112 ())
3113 (movw (:%w val) (:@ (:apply + x8664::misc-data-offset (:apply * 2 idx)) (:%q v))))
3114
3115
3116(define-x8664-vinsn misc-set-u16 (()
3117 ((val :u16)
3118 (v :lisp)
3119 (scaled-idx :s64))
3120 ())
3121 (movw (:%w val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3122
3123(define-x8664-vinsn misc-set-c-s16 (()
3124 ((val :s16)
3125 (v :lisp)
3126 (idx :s32const))
3127 ())
3128 (movw (:%w val) (:@ (:apply + x8664::misc-data-offset (:apply * 2 idx)) (:%q v))))
3129
3130
3131(define-x8664-vinsn misc-set-s16 (()
3132 ((val :s16)
3133 (v :lisp)
3134 (scaled-idx :s64))
3135 ())
3136 (movw (:%w val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3137
3138(define-x8664-vinsn misc-set-c-u32 (()
3139 ((val :u32)
3140 (v :lisp)
3141 (idx :u32const)) ; sic
3142 ())
3143 (movl (:%l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
3144
3145(define-x8664-vinsn misc-set-u32 (()
3146 ((val :u32)
3147 (v :lisp)
3148 (scaled-idx :s64))
3149 ())
3150 (movl (:%l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3151
3152(define-x8664-vinsn misc-set-c-s32 (()
3153 ((val :s32)
3154 (v :lisp)
3155 (idx :u32const)) ; sic
3156 ())
3157 (movl (:%l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
3158
3159(define-x8664-vinsn misc-set-s32 (()
3160 ((val :s32)
3161 (v :lisp)
3162 (scaled-idx :s64))
3163 ())
3164 (movl (:%l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3165
3166(define-x8664-vinsn %iasr (((dest :lisp))
3167 ((count :lisp)
3168 (src :lisp))
3169 ((temp (:s64 #.x8664::rax))
3170 (shiftcount (:s64 #.x8664::rcx))))
3171 (movq (:%q count) (:%q temp))
3172 (sarq (:$ub x8664::fixnumshift) (:%q temp))
3173 (movl (:$l 63) (:%l shiftcount))
3174 (rcmpq (:%q temp) (:%q shiftcount))
3175 (cmovbel (:%l temp) (:%l shiftcount))
3176 (movq (:%q src) (:%q temp))
3177 (sarq (:%shift x8664::cl) (:%q temp))
3178 (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
3179 (movq (:%q temp) (:%q dest)))
3180
3181(define-x8664-vinsn %ilsr (((dest :imm))
3182 ((count :imm)
3183 (src :imm))
3184 ((temp (:s64 #.x8664::rax))
3185 (shiftcount (:s64 #.x8664::rcx))))
3186 (movq (:%q count) (:%q temp))
3187 (sarq (:$ub x8664::fixnumshift) (:%q temp))
3188 (movl (:$l 63) (:%l shiftcount))
3189 (rcmpq (:%q temp) (:%q shiftcount))
3190 (cmovbel (:%l temp) (:%l shiftcount))
3191 (movq (:%q src) (:%q temp))
3192 (shrq (:%shift x8664::cl) (:%q temp))
3193 (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
3194 (movq (:%q temp) (:%q dest)))
3195
3196
3197(define-x8664-vinsn %iasr-c (((dest :imm))
3198 ((count :u8const)
3199 (src :imm))
3200 ((temp :s64)))
3201 (movq (:%q src) (:%q temp))
3202 (sarq (:$ub count) (:%q temp))
3203 (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
3204 (movq (:%q temp) (:%q dest)))
3205
3206(define-x8664-vinsn %ilsr-c (((dest :imm))
3207 ((count :u8const)
3208 (src :imm))
3209 ((temp :s64)))
3210 (movq (:%q src) (:%q temp))
3211 (shrq (:$ub count) (:%q temp))
3212 (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
3213 (movq (:%q temp) (:%q dest)))
3214
3215(define-x8664-vinsn %ilsl (((dest :imm))
3216 ((count :imm)
3217 (src :imm))
3218 ((shiftcount (:s64 #.x8664::rcx))))
3219 (movl (:$l (ash 63 x8664::fixnumshift)) (:%l shiftcount))
3220 (rcmpq (:%q count) (:%q shiftcount))
3221 (cmovbl (:%l count) (:%l shiftcount))
3222 (sarl (:$ub x8664::fixnumshift) (:%l shiftcount))
3223 ((:not (:pred =
3224 (:apply %hard-regspec-value src)
3225 (:apply %hard-regspec-value dest)))
3226 (movq (:%q src) (:%q dest)))
3227 (shlq (:%shift x8664::cl) (:%q dest)))
3228
3229(define-x8664-vinsn %ilsl-c (((dest :imm))
3230 ((count :u8const)
3231 (src :imm)))
3232 ((:not (:pred =
3233 (:apply %hard-regspec-value src)
3234 (:apply %hard-regspec-value dest)))
3235 (movq (:%q src) (:%q dest)))
3236 (shlq (:$ub count) (:%q dest)))
3237
3238(define-x8664-vinsn fixnum-ash-left (((dest :lisp))
3239 ((num :lisp)
3240 (amt :lisp))
3241 ((shiftcount (:s64 #.x8664::rcx))))
3242 (movq (:%q amt) (:%q shiftcount))
3243 (sarq (:$ub x8664::fixnumshift) (:%q shiftcount))
3244 ((:not (:pred =
3245 (:apply %hard-regspec-value num)
3246 (:apply %hard-regspec-value dest)))
3247 (movq (:%q num) (:%q dest)))
3248 (shlq (:%shift x8664::cl) (:%q dest)))
3249
3250(define-x8664-vinsn fixnum-ash (((dest :lisp))
3251 ((num :lisp)
3252 (amt :lisp))
3253 ((shiftcount (:s64 #.x8664::rcx))
3254 (temp (:s64))))
3255 (movq (:%q amt) (:%q shiftcount))
3256 (sarq (:$ub x8664::fixnumshift) (:%q shiftcount))
3257 (jns :left)
3258 (negq (:%q shiftcount))
3259 (movq (:%q num) (:%q temp))
3260 (sarq (:$ub x8664::fixnumshift) (:%q temp))
3261 (sarq (:%shift x8664::cl) (:%q temp))
3262 (imulq (:$b x8664::fixnumone) (:%q temp)(:%q dest))
3263 (jmp :done)
3264 :left
3265 ((:not (:pred =
3266 (:apply %hard-regspec-value num)
3267 (:apply %hard-regspec-value dest)))
3268 (movq (:%q num) (:%q dest)))
3269 (shlq (:%shift x8664::cl) (:%q dest))
3270 :done)
3271
3272
3273;;; In safe code, something else has ensured that the value is of type
3274;;; BIT.
3275(define-x8664-vinsn set-variable-bit-to-variable-value (()
3276 ((vec :lisp)
3277 (word-index :s64)
3278 (bitnum :u8)
3279 (value :lisp)))
3280 (testb (:%b value) (:%b value))
3281 (je :clr)
3282 (btsq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8))
3283 (jmp :done)
3284 :clr
3285 (btrq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8))
3286 :done)
3287
3288(define-x8664-vinsn set-variable-bit-to-zero (()
3289 ((vec :lisp)
3290 (word-index :s64)
3291 (bitnum :u8)))
3292 (btrq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8)))
3293
3294(define-x8664-vinsn set-variable-bit-to-one (()
3295 ((vec :lisp)
3296 (word-index :s64)
3297 (bitnum :u8)))
3298 (btsq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8)))
3299
3300;;; In safe code, something else has ensured that the value is of type
3301;;; BIT.
3302(define-x8664-vinsn nset-variable-bit-to-variable-value (()
3303 ((vec :lisp)
3304 (index :s64)
3305 (value :lisp)))
3306 (testb (:%b value) (:%b value))
3307 (je :clr)
3308 (btsq (:%q index) (:@ x8664::misc-data-offset (:%q vec)))
3309 (jmp :done)
3310 :clr
3311 (btrq (:%q index) (:@ x8664::misc-data-offset (:%q vec)))
3312 :done)
3313
3314(define-x8664-vinsn nset-variable-bit-to-zero (()
3315 ((vec :lisp)
3316 (index :s64)))
3317 (btrq (:%q index) (:@ x8664::misc-data-offset (:%q vec))))
3318
3319(define-x8664-vinsn nset-variable-bit-to-one (()
3320 ((vec :lisp)
3321 (index :s64)))
3322 (btsq (:%q index) (:@ x8664::misc-data-offset (:%q vec))))
3323
3324(define-x8664-vinsn set-constant-bit-to-zero (()
3325 ((src :lisp)
3326 (idx :u64const)))
3327 (btrq (:$ub (:apply logand 63 idx))
3328 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
3329
3330(define-x8664-vinsn set-constant-bit-to-one (()
3331 ((src :lisp)
3332 (idx :u64const)))
3333 (btsq (:$ub (:apply logand 63 idx))
3334 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
3335
3336(define-x8664-vinsn set-constant-bit-to-variable-value (()
3337 ((src :lisp)
3338 (idx :u64const)
3339 (value :lisp)))
3340 (testb (:%b value) (:%b value))
3341 (je :clr)
3342 (btsq (:$ub (:apply logand 63 idx))
3343 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
3344 (jmp :done)
3345 :clr
3346 (btrq (:$ub (:apply logand 63 idx))
3347 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
3348 :done)
3349
3350
3351(define-x8664-vinsn require-fixnum (()
3352 ((object :lisp)))
3353 :again
3354 (testl (:$l x8664::fixnummask) (:%l object))
3355 (jne :bad)
3356 (:anchored-uuo-section :again)
3357 :bad
3358 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-fixnum))))
3359
3360(define-x8664-vinsn require-integer (()
3361 ((object :lisp))
3362 ((tag :u8)))
3363 :again
3364 (movl (:%l object) (:%l tag))
3365 (andl (:$b x8664::fixnummask) (:%l tag))
3366 (je :got-it)
3367 (cmpl (:$b x8664::tag-misc) (:%l tag))
3368 (jne :bad)
3369 (cmpb (:$b x8664::subtag-bignum) (:@ x8664::misc-subtag-offset (:%q object)))
3370 (jne :bad)
3371 :got-it
3372
3373 (:anchored-uuo-section :again)
3374 :bad
3375 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-integer))))
3376
3377(define-x8664-vinsn require-simple-vector (()
3378 ((object :lisp))
3379 ((tag :u8)))
3380 :again
3381 (movl (:%l object) (:%l tag))
3382 (andl (:$b x8664::fixnummask) (:%l tag))
3383 (cmpl (:$b x8664::tag-misc) (:%l tag))
3384 (jne :bad)
3385 (cmpb (:$b x8664::subtag-simple-vector) (:@ x8664::misc-subtag-offset (:%q object)))
3386 (jne :bad)
3387
3388 (:anchored-uuo-section :again)
3389 :bad
3390 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-simple-vector))))
3391
3392(define-x8664-vinsn require-simple-string (()
3393 ((object :lisp))
3394 ((tag :u8)))
3395 :again
3396 (movl (:%l object) (:%l tag))
3397 (andl (:$b x8664::fixnummask) (:%l tag))
3398 (cmpl (:$b x8664::tag-misc) (:%l tag))
3399 (jne :bad)
3400 (cmpb (:$b x8664::subtag-simple-base-string) (:@ x8664::misc-subtag-offset (:%q object)))
3401 (jne :bad)
3402
3403 (:anchored-uuo-section :again)
3404 :bad
3405 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-simple-string))))
3406
3407(define-x8664-vinsn require-real (()
3408 ((object :lisp))
3409 ((tag :u8)
3410 (mask :u64)))
3411 (movq (:$q (logior (ash 1 x8664::tag-fixnum)
3412 (ash 1 x8664::tag-single-float)
3413 (ash 1 x8664::subtag-double-float)
3414 (ash 1 x8664::subtag-bignum)
3415 (ash 1 x8664::subtag-ratio)))
3416 (:%q mask))
3417 :again
3418 (movl (:%l object) (:%l tag))
3419 (andl (:$b x8664::tagmask) (:%l tag))
3420 (cmpl (:$b x8664::tag-misc) (:%l tag))
3421 (jne :have-tag)
3422 (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
3423 :have-tag
3424 (rcmpl (:%l tag) (:$b 64))
3425 (jae :bad)
3426 (btq (:%q tag) (:%q mask))
3427 (jae :bad)
3428
3429 (:anchored-uuo-section :again)
3430 :bad
3431 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-real))))
3432
3433(define-x8664-vinsn require-number (()
3434 ((object :lisp))
3435 ((tag :u8)
3436 (mask :u64)))
3437 (movq (:$q (logior (ash 1 x8664::tag-fixnum)
3438 (ash 1 x8664::tag-single-float)
3439 (ash 1 x8664::subtag-double-float)
3440 (ash 1 x8664::subtag-bignum)
3441 (ash 1 x8664::subtag-ratio)
3442 (ash 1 x8664::subtag-complex)))
3443 (:%q mask))
3444 :again
3445 (movl (:%l object) (:%l tag))
3446 (andl (:$b x8664::tagmask) (:%l tag))
3447 (cmpl (:$b x8664::tag-misc) (:%l tag))
3448 (jne :have-tag)
3449 (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
3450 :have-tag
3451 (cmpl (:$b x8664::subtag-complex-single-float) (:%l tag))
3452 (jz :good)
3453 (cmpl (:$b x8664::subtag-complex-double-float) (:%l tag))
3454 (jz :good)
3455 (rcmpl (:%l tag) (:$b 64))
3456 (jae :bad)
3457 (btq (:%q tag) (:%q mask))
3458 (jae :bad)
3459 :good
3460 (:anchored-uuo-section :again)
3461 :bad
3462 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-number))))
3463
3464(define-x8664-vinsn require-list (()
3465 ((object :lisp))
3466 ((tag :u8)))
3467 :again
3468 (movl (:%l object) (:%l tag))
3469 (andl (:$b x8664::tagmask) (:%l tag))
3470 (cmpl (:$b x8664::tag-list) (:%l tag))
3471 (jne :bad)
3472
3473 (:anchored-uuo-section :again)
3474 :bad
3475 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-list))))
3476
3477(define-x8664-vinsn require-symbol (()
3478 ((object :lisp))
3479 ((tag :u8)))
3480 :again
3481 (movzbl (:%b object) (:%l tag))
3482 (cmpl (:$b x8664::fulltag-nil) (:%l tag))
3483 (je :good)
3484 (andl (:$b x8664::tagmask) (:%l tag))
3485 (cmpl (:$b x8664::tag-symbol) (:%l tag))
3486 (jne :bad)
3487 :good
3488
3489 (:anchored-uuo-section :again)
3490 :bad
3491 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))))
3492
3493(define-x8664-vinsn require-character (()
3494 ((object :lisp)))
3495 :again
3496 (cmpb (:$b x8664::subtag-character) (:%b object))
3497 (jne :bad)
3498 (:anchored-uuo-section :again)
3499 :bad
3500 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-character))))
3501
3502(define-x8664-vinsn require-s8 (()
3503 ((object :lisp))
3504 ((tag :u32)))
3505 :again
3506 (movq (:%q object) (:%q tag))
3507 (shlq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q tag))
3508 (sarq (:$ub (- x8664::nbits-in-word 8)) (:%q tag))
3509 (shlq (:$ub x8664::fixnumshift) (:%q tag))
3510 (cmpq (:%q object) (:%q tag))
3511 (jne :bad)
3512
3513 (:anchored-uuo-section :again)
3514 :bad
3515 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-8))))
3516
3517(define-x8664-vinsn require-u8 (()
3518 ((object :lisp))
3519 ((tag :u32)))
3520 :again
3521 (movq (:$l (lognot (ash #xff x8664::fixnumshift))) (:%q tag))
3522 (andq (:% object) (:% tag))
3523 (jne :bad)
3524 (:anchored-uuo-section :again)
3525 :bad
3526 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-8))))
3527
3528(define-x8664-vinsn require-s16 (()
3529 ((object :lisp))
3530 ((tag :s64)))
3531 :again
3532 (movq (:%q object) (:%q tag))
3533 (shlq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q tag))
3534 (sarq (:$ub (- x8664::nbits-in-word 16)) (:%q tag))
3535 (shlq (:$ub x8664::fixnumshift) (:%q tag))
3536 (cmpq (:%q object) (:%q tag))
3537 (jne :bad)
3538 (:anchored-uuo-section :again)
3539 :bad
3540 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-16))))
3541
3542(define-x8664-vinsn require-u16 (()
3543 ((object :lisp))
3544 ((tag :u32)))
3545 :again
3546 (movq (:$l (lognot (ash #xffff x8664::fixnumshift))) (:%q tag))
3547 (andq (:% object) (:% tag))
3548 (jne :bad)
3549 (:anchored-uuo-section :again)
3550 :bad
3551 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-16))))
3552
3553(define-x8664-vinsn require-s32 (()
3554 ((object :lisp))
3555 ((tag :s64)))
3556 :again
3557 (movq (:%q object) (:%q tag))
3558 (shlq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q tag))
3559 (sarq (:$ub (- x8664::nbits-in-word 32)) (:%q tag))
3560 (shlq (:$ub x8664::fixnumshift) (:%q tag))
3561 (cmpq (:%q object) (:%q tag))
3562 (jne :bad)
3563 (testl (:$l x8664::fixnummask) (:%l object))
3564 (jne :bad)
3565 (:anchored-uuo-section :again)
3566 :bad
3567 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-32))))
3568
3569(define-x8664-vinsn require-u32 (()
3570 ((object :lisp))
3571 ((tag :u32)))
3572 :again
3573 (movq (:$q (lognot (ash #xffffffff x8664::fixnumshift))) (:%q tag))
3574 (andq (:% object) (:% tag))
3575 (jne :bad)
3576 (:anchored-uuo-section :again)
3577 :bad
3578 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-32))))
3579
3580(define-x8664-vinsn require-s64 (()
3581 ((object :lisp))
3582 ((tag :s64)))
3583 :again
3584 (testl (:$l x8664::fixnummask) (:%l object))
3585 (movl (:%l object) (:%l tag))
3586 (je :ok)
3587 (andl (:$b x8664::fulltagmask) (:%l tag))
3588 (cmpl (:$b x8664::fulltag-misc) (:%l tag))
3589 (jne :bad)
3590 (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3591 (jne :bad)
3592 :ok
3593 (:anchored-uuo-section :again)
3594 :bad
3595 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-64))))
3596
3597(define-x8664-vinsn require-u64 (()
3598 ((object :lisp))
3599 ((tag :s64)))
3600 :again
3601 (testl (:$l x8664::fixnummask) (:%l object))
3602 (movq (:%q object) (:%q tag))
3603 (je :ok-if-non-negative)
3604 (andl (:$b x8664::fulltagmask) (:%l tag))
3605 (cmpl (:$b x8664::fulltag-misc) (:%l tag))
3606 (jne :bad)
3607 (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3608 (je :two)
3609 (cmpq (:$l x8664::three-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3610 (jne :bad)
3611 (cmpl (:$b 0) (:@ (+ x8664::misc-data-offset 8) (:%q object)))
3612 (je :ok)
3613 (jmp :bad)
3614 :two
3615 (movq (:@ x8664::misc-data-offset (:%q object)) (:%q tag))
3616 :ok-if-non-negative
3617 (testq (:%q tag) (:%q tag))
3618 (js :bad)
3619 :ok
3620 (:anchored-uuo-section :again)
3621 :bad
3622 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-64))))
3623
3624(define-x8664-vinsn require-char-code (()
3625 ((object :lisp))
3626 ((tag :u32)))
3627 :again
3628 (testl (:$l x8664::fixnummask) (:%l object))
3629 (jne :bad)
3630 (cmpq (:$l (ash #x110000 x8664::fixnumshift)) (:%q object))
3631 (jae :bad)
3632 (:anchored-uuo-section :again)
3633 :bad
3634 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-mod-char-code-limit))))
3635
3636
3637;;; set DEST to
3638(define-x8664-vinsn mask-base-char (((dest :u8))
3639 ((src :lisp)))
3640 (movzbl (:%b src) (:%l dest)))
3641
3642(define-x8664-vinsn single-float-bits (((dest :u32))
3643 ((src :lisp)))
3644 (movq (:%q src) (:%q dest))
3645 (shrq (:$ub 32) (:%q dest)))
3646
3647(define-x8664-vinsn zero-double-float-register (((dest :double-float))
3648 ())
3649 (movsd (:%xmm x8664::fpzero) (:%xmm dest)))
3650
3651(define-x8664-vinsn zero-single-float-register (((dest :single-float))
3652 ())
3653 (movss (:%xmm x8664::fpzero) (:%xmm dest)))
3654
3655(define-x8664-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
3656(define-x8664-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
3657(define-x8664-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
3658
3659(define-x8664-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
3660
3661(define-x8664-vinsn misc-element-count-fixnum (((dest :imm))
3662 ((src :lisp))
3663 ((temp :u64)))
3664 (movq (:@ x8664::misc-header-offset (:%q src)) (:%q temp))
3665 (shrq (:$ub x8664::num-subtag-bits) (:%q temp))
3666 (imulq (:$b x8664::fixnumone) (:%q temp)(:%q dest)))
3667
3668(define-x8664-vinsn %logior2 (((dest :imm))
3669 ((x :imm)
3670 (y :imm)))
3671 ((:pred =
3672 (:apply %hard-regspec-value x)
3673 (:apply %hard-regspec-value dest))
3674 (orq (:%q y) (:%q dest)))
3675 ((:not (:pred =
3676 (:apply %hard-regspec-value x)
3677 (:apply %hard-regspec-value dest)))
3678 ((:pred =
3679 (:apply %hard-regspec-value y)
3680 (:apply %hard-regspec-value dest))
3681 (orq (:%q x) (:%q dest)))
3682 ((:not (:pred =
3683 (:apply %hard-regspec-value y)
3684 (:apply %hard-regspec-value dest)))
3685 (movq (:%q x) (:%q dest))
3686 (orq (:%q y) (:%q dest)))))
3687
3688(define-x8664-vinsn %logand2 (((dest :imm))
3689 ((x :imm)
3690 (y :imm)))
3691 ((:pred =
3692 (:apply %hard-regspec-value x)
3693 (:apply %hard-regspec-value dest))
3694 (andq (:%q y) (:%q dest)))
3695 ((:not (:pred =
3696 (:apply %hard-regspec-value x)
3697 (:apply %hard-regspec-value dest)))
3698 ((:pred =
3699 (:apply %hard-regspec-value y)
3700 (:apply %hard-regspec-value dest))
3701 (andq (:%q x) (:%q dest)))
3702 ((:not (:pred =
3703 (:apply %hard-regspec-value y)
3704 (:apply %hard-regspec-value dest)))
3705 (movq (:%q x) (:%q dest))
3706 (andq (:%q y) (:%q dest)))))
3707
3708(define-x8664-vinsn %logxor2 (((dest :imm))
3709 ((x :imm)
3710 (y :imm)))
3711 ((:pred =
3712 (:apply %hard-regspec-value x)
3713 (:apply %hard-regspec-value dest))
3714 (xorq (:%q y) (:%q dest)))
3715 ((:not (:pred =
3716 (:apply %hard-regspec-value x)
3717 (:apply %hard-regspec-value dest)))
3718 ((:pred =
3719 (:apply %hard-regspec-value y)
3720 (:apply %hard-regspec-value dest))
3721 (xorq (:%q x) (:%q dest)))
3722 ((:not (:pred =
3723 (:apply %hard-regspec-value y)
3724 (:apply %hard-regspec-value dest)))
3725 (movq (:%q x) (:%q dest))
3726 (xorq (:%q y) (:%q dest)))))
3727
3728
3729(define-x8664-vinsn vcell-ref (((dest :lisp))
3730 ((vcell :lisp)))
3731 (movq (:@ x8664::misc-data-offset (:%q vcell)) (:%q dest)))
3732
3733(define-x8664-vinsn (call-subprim-3 :call :subprim) (((dest t))
3734 ((spno :s32const)
3735 (x t)
3736 (y t)
3737 (z t))
3738 ((entry (:label 1))))
3739 (:talign 4)
3740 (call (:@ spno))
3741 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3742
3743(define-x8664-vinsn setup-vcell-allocation (()
3744 ())
3745 (movl (:$l x8664::value-cell-header) (:%l x8664::imm0))
3746 (movl (:$l (- x8664::value-cell.size x8664::fulltag-misc)) (:%l x8664::imm1)))
3747
3748(define-x8664-vinsn %init-vcell (()
3749 ((vcell :lisp)
3750 (closed :lisp)))
3751 (movq (:%q closed) (:@ x8664::value-cell.value (:%q vcell))))
3752
3753(define-x8664-subprim-call-vinsn (progvsave :needs-frame-pointer) .SPprogvsave)
3754
3755(define-x8664-subprim-jump-vinsn (progvrestore :call :needs-frame-pointer) .SPprogvrestore)
3756
3757(define-x8664-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
3758
3759(define-x8664-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
3760
3761(define-x8664-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
3762
3763(define-x8664-vinsn scale-nargs (()
3764 ((nfixed :s16const)))
3765 ((:pred > nfixed 0)
3766 ((:pred < nfixed 16)
3767 (subl (:$b (:apply ash nfixed x8664::word-shift)) (:%l x8664::nargs)))
3768 ((:pred >= nfixed 16)
3769 (subl (:$l (:apply ash nfixed x8664::word-shift)) (:%l x8664::nargs)))))
3770
3771(define-x8664-vinsn opt-supplied-p (()
3772 ((num-opt :u16const))
3773 ((nargs (:u64 #.x8664::nargs))
3774 (imm :imm)))
3775 (xorl (:%l imm) (:%l imm))
3776 (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_y))
3777 :loop
3778 (rcmpl (:%l imm) (:%l nargs))
3779 (movl (:%l x8664::arg_y) (:%l x8664::arg_z))
3780 (cmovll (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l x8664::arg_y)) (:%l x8664::arg_z))
3781 (addl (:$b x8664::node-size) (:%l imm))
3782 (rcmpl (:%l imm) (:$l (:apply ash num-opt x8664::fixnumshift)))
3783 (pushq (:%q x8664::arg_z))
3784 (jne :loop))
3785
3786(define-x8664-vinsn one-opt-supplied-p (()
3787 ()
3788 ((temp :u64)))
3789 (testl (:%l x8664::nargs) (:%l x8664::nargs))
3790 (movl (:$l (:apply target-nil-value)) (:%l temp))
3791 (cmovnel (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp)) (:%l temp))
3792 (pushq (:%q temp)))
3793
3794(define-x8664-vinsn two-opt-supplied-p (()
3795 ()
3796 ((temp0 :u64)
3797 (temp1 :u64)))
3798 (rcmpl (:%l x8664::nargs) (:$b x8664::node-size))
3799 (movl (:$l (:apply target-nil-value)) (:%l temp0))
3800 (movl (:%l temp0) (:%l temp1))
3801 (cmovael (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp0)) (:%l temp0))
3802 (cmoval (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp1)) (:%l temp1))
3803 (pushq (:%q temp0))
3804 (pushq (:%q temp1)))
3805
3806
3807(define-x8664-vinsn set-c-flag-if-constant-logbitp (()
3808 ((bit :u8const)
3809 (int :imm)))
3810 (btq (:$ub bit) (:%q int)))
3811
3812(define-x8664-vinsn set-c-flag-if-variable-logbitp (()
3813 ((bit :imm)
3814 (int :imm))
3815 ((temp0 :u8)
3816 (temp1 :u8)))
3817 (movl (:$l 63) (:%l temp1))
3818 (movq (:%q bit) (:%q temp0))
3819 (sarq (:$ub x8664::fixnumshift) (:%q temp0))
3820 (addq (:$b x8664::fixnumshift) (:%q temp0))
3821 (rcmpq (:%q temp0) (:%q temp1))
3822 (cmoval (:%l temp1) (:%l temp0))
3823 (btq (:%q temp0) (:%q int)))
3824
3825(define-x8664-vinsn multiply-immediate (((dest :imm))
3826 ((src :imm)
3827 (const :s32const)))
3828 ((:and (:pred >= const -128) (:pred <= const 127))
3829 (imulq (:$b const) (:%q src) (:%q dest)))
3830 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
3831 (imulq (:$l const) (:%q src) (:%q dest))))
3832
3833(define-x8664-vinsn multiply-fixnums (((dest :imm))
3834 ((x :imm)
3835 (y :imm))
3836 ((unboxed :s64)))
3837 ((:pred =
3838 (:apply %hard-regspec-value x)
3839 (:apply %hard-regspec-value dest))
3840 (movq (:%q y) (:%q unboxed))
3841 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3842 (imulq (:%q unboxed) (:%q dest)))
3843 ((:and (:not (:pred =
3844 (:apply %hard-regspec-value x)
3845 (:apply %hard-regspec-value dest)))
3846 (:pred =
3847 (:apply %hard-regspec-value y)
3848 (:apply %hard-regspec-value dest)))
3849 (movq (:%q x) (:%q unboxed))
3850 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3851 (imulq (:%q unboxed) (:%q dest)))
3852 ((:and (:not (:pred =
3853 (:apply %hard-regspec-value x)
3854 (:apply %hard-regspec-value dest)))
3855 (:not (:pred =
3856 (:apply %hard-regspec-value y)
3857 (:apply %hard-regspec-value dest))))
3858 (movq (:%q y) (:%q dest))
3859 (movq (:%q x) (:%q unboxed))
3860 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3861 (imulq (:%q unboxed) (:%q dest))))
3862
3863
3864(define-x8664-vinsn save-lexpr-argregs (()
3865 ((min-fixed :u16const)))
3866 ((:pred >= min-fixed $numx8664argregs)
3867 (pushq (:%q x8664::arg_x))
3868 (pushq (:%q x8664::arg_y))
3869 (pushq (:%q x8664::arg_z)))
3870 ((:pred = min-fixed 2) ; at least 2 args
3871 (cmpl (:$b (ash 2 x8664::word-shift)) (:%l x8664::nargs))
3872 (je :yz2) ; skip arg_x if exactly 2
3873 (pushq (:%q x8664::arg_x))
3874 :yz2
3875 (pushq (:%q x8664::arg_y))
3876 (pushq (:%q x8664::arg_z)))
3877 ((:pred = min-fixed 1) ; at least one arg
3878 (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
3879 (jl :z1) ; branch if exactly one
3880 (je :yz1) ; branch if exactly two
3881 (pushq (:%q x8664::arg_x))
3882 :yz1
3883 (pushq (:%q x8664::arg_y))
3884 :z1
3885 (pushq (:%q x8664::arg_z)))
3886 ((:pred = min-fixed 0)
3887 (testl (:%l x8664::nargs) (:%l x8664::nargs))
3888 (je :none) ; exactly zero
3889 (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
3890 (je :yz0) ; exactly two
3891 (jl :z0) ; one
3892 ; Three or more ...
3893 (pushq (:%q x8664::arg_x))
3894 :yz0
3895 (pushq (:%q x8664::arg_y))
3896 :z0
3897 (pushq (:%q x8664::arg_z))
3898 :none
3899 )
3900 ((:not (:pred = min-fixed 0))
3901 (leaq (:@ (:apply - (:apply ash min-fixed x8664::word-shift)) (:%q x8664::nargs))
3902 (:%q x8664::nargs)))
3903 (pushq (:%q x8664::nargs))
3904 (movq (:%q x8664::rsp) (:%q x8664::arg_z)))
3905
3906
3907
3908
3909;;; The frame that was built (by SAVE-LISP-CONTEXT-VARIABLE-ARG-COUNT
3910;;; and SAVE-LEXPR-ARGREGS) contains an unknown number of arguments
3911;;; followed by the count of non-required arguments; the count is on
3912;;; top of the stack and its address is in %arg_z. We need to build a
3913;;; frame so that the function can address its arguments (copies of
3914;;; the required arguments and the lexpr) and locals; when the
3915;;; function returns, it should one or more values (depending on how
3916;;; it was called) and discard the hidden lexpr frame. At this point,
3917;;; %ra0 still contains the "real" return address. If it's not the
3918;;; magic multiple-value address, we can make the function return to
3919;;; something that does a single-value return (.SPpopj); otherwise, we
3920;;; need to make it return multiple values to the real caller. (Unlike
3921;;; the PPC, this case only involves creating one frame here, but that
3922;;; frame has two return addresses.)
3923(define-x8664-vinsn (build-lexpr-frame :needs-frame-pointer) (()
3924 ()
3925 ((temp :imm)))
3926 (movq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr)))
3927 (:%q temp))
3928 (cmpq (:%q temp)
3929 (:%q x8664::ra0))
3930 (je :multiple)
3931 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::lexpr-return1v))))
3932 (jmp :finish)
3933 :multiple
3934 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::lexpr-return))))
3935 (pushq (:%q temp))
3936 :finish
3937 (pushq (:%q x8664::rbp))
3938 (movq (:%q x8664::rsp) (:%q x8664::rbp)))
3939
3940
3941(define-x8664-vinsn copy-lexpr-argument (()
3942 ((n :u16const))
3943 ((temp :imm)))
3944 (movq (:@ (:%q x8664::arg_z)) (:%q temp))
3945 (pushq (:@ (:apply ash n x8664::word-shift) (:%q x8664::arg_z) (:%q temp))))
3946
3947
3948(define-x8664-vinsn %current-tcr (((dest :lisp))
3949 ())
3950 (movq (:rcontext x8664::tcr.linear) (:%q dest)))
3951
3952(define-x8664-vinsn (setq-special :call :subprim)
3953 (()
3954 ((sym :lisp)
3955 (val :lisp))
3956 ((entry (:label 1))))
3957 (:talign 4)
3958 (call (:@ .SPspecset))
3959 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3960
3961(define-x8664-vinsn set-z-flag-if-istruct-typep (()
3962 ((val :lisp)
3963 (type :lisp))
3964 ((tag :u8)
3965 (valtype :lisp)))
3966 (xorl (:%l valtype) (:%l valtype))
3967 (movl (:%l val) (:%l tag))
3968 (andl (:$b x8664::tagmask) (:%l tag))
3969 (cmpl (:$b x8664::tag-misc) (:%l tag))
3970 (jne :have-tag)
3971 (movzbl (:@ x8664::misc-subtag-offset (:%q val)) (:%l tag))
3972 :have-tag
3973 (cmpl (:$b x8664::subtag-istruct) (:%l tag))
3974 (jne :do-compare)
3975 (movq (:@ x8664::misc-data-offset (:%q val)) (:%q valtype))
3976 :do-compare
3977 (cmpq (:%q valtype) (:%q type)))
3978
3979(define-x8664-subprim-call-vinsn (misc-ref) .SPmisc-ref)
3980
3981(define-x8664-subprim-call-vinsn (ksignalerr) .SPksignalerr)
3982
3983(define-x8664-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
3984
3985(define-x8664-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
3986
3987(define-x8664-subprim-lea-jmp-vinsn (make-stack-gvector) .SPstkgvector)
3988
3989(define-x8664-vinsn load-character-constant (((dest :lisp))
3990 ((code :u32const))
3991 ())
3992 (movl (:$l (:apply logior (:apply ash code 8) x8664::subtag-character))
3993 (:%l dest)))
3994
3995(define-x8664-vinsn %scharcode8 (((code :imm))
3996 ((str :lisp)
3997 (idx :imm))
3998 ((imm :u64)))
3999 (movq (:%q idx) (:%q imm))
4000 (sarq (:$ub x8664::fixnumshift) (:%q imm))
4001 (movzbl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
4002 (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code)))
4003
4004(define-x8664-vinsn %scharcode32 (((code :imm))
4005 ((str :lisp)
4006 (idx :imm))
4007 ((imm :u64)))
4008 (movq (:%q idx) (:%q imm))
4009 (sarq (:$ub 1) (:%q imm))
4010 (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
4011 (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code)))
4012
4013(define-x8664-subprim-jump-vinsn (tail-call-sym-slide :needs-frame-pointer) .SPtcallsymslide)
4014
4015(define-x8664-subprim-jump-vinsn (tail-call-sym-vsp :needs-frame-pointer) .SPtcallsymvsp)
4016
4017
4018(define-x8664-vinsn character->code (((dest :u32))
4019 ((src :lisp)))
4020 (movq (:%q src) (:%q dest))
4021 (sarq (:$ub x8664::charcode-shift) (:%q dest)))
4022
4023(define-x8664-vinsn (adjust-vsp :vsp :pop :discard)
4024 (()
4025 ((amount :s32const)))
4026 ((:and (:pred >= amount -128) (:pred <= amount 127))
4027 (addq (:$b amount) (:%q x8664::rsp)))
4028 ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
4029 (addq (:$l amount) (:%q x8664::rsp))))
4030
4031(define-x8664-vinsn (call-subprim-2 :call :subprim) (((dest t))
4032 ((spno :s32const)
4033 (y t)
4034 (z t))
4035 ((entry (:label 1))))
4036 (:talign 4)
4037 (call (:@ spno))
4038 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
4039
4040(define-x8664-vinsn (call-subprim-1 :call :subprim) (((dest t))
4041 ((spno :s32const)
4042 (x t))
4043 ((entry (:label 1))))
4044 (:talign 4)
4045 (call (:@ spno))
4046 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
4047
4048
4049
4050(define-x8664-vinsn set-macptr-address (()
4051 ((addr :address)
4052 (src :lisp))
4053 ())
4054 (movq (:%q addr) (:@ x8664::macptr.address (:%q src))))
4055
4056(define-x8664-vinsn %symbol->symptr (((dest :lisp))
4057 ((src :lisp))
4058 ((tag :u8)))
4059 :begin
4060 (movl (:$l (:apply + (:apply target-nil-value) x8664::nilsym-offset)) (:%l tag))
4061 (cmpb (:$b x8664::fulltag-nil) (:%b src))
4062 (cmoveq (:%q tag) (:%q dest))
4063 (movl (:%l src) (:%l tag))
4064 (je :ok)
4065 (andl (:$b x8664::tagmask) (:%l tag))
4066 (cmpl (:$b x8664::tag-symbol) (:%l tag))
4067 (jne :bad)
4068
4069 ((:not (:pred =
4070 (:apply %hard-regspec-value dest)
4071 (:apply %hard-regspec-value src)))
4072 (movq (:% src) (:% dest)))
4073 :ok
4074 (:anchored-uuo-section :begin)
4075 :bad
4076 (:anchored-uuo (uuo-error-reg-not-tag (:%q src) (:$ub x8664::fulltag-symbol))))
4077
4078(define-x8664-vinsn symbol-function (((val :lisp))
4079 ((sym (:lisp (:ne val))))
4080 ((tag :u8)))
4081 :anchor
4082 (movq (:@ x8664::symbol.fcell (:%q sym)) (:%q val))
4083 (movl (:%l val) (:%l tag))
4084 (andl (:$b x8664::tagmask) (:%l tag))
4085 (cmpl (:$b x8664::tag-function) (:%l tag))
4086 (jne :bad)
4087
4088 (:anchored-uuo-section :anchor)
4089 :bad
4090 (:anchored-uuo (uuo-error-udf (:%q sym))))
4091
4092(define-x8664-subprim-jump-vinsn (tail-call-fn-slide :needs-frame-pointer) .SPtcallnfnslide)
4093
4094(define-x8664-vinsn load-double-float-constant (((dest :double-float))
4095 ((lab :label)
4096))
4097 (movsd (:@ (:^ lab) (:%q x8664::fn)) (:%xmm dest)))
4098
4099(define-x8664-vinsn load-single-float-constant (((dest :single-float))
4100 ((lab :label)
4101))
4102 (movss (:@ (:^ lab) (:%q x8664::fn)) (:%xmm dest)))
4103
4104(define-x8664-subprim-call-vinsn (misc-set) .SPmisc-set)
4105
4106(define-x8664-subprim-lea-jmp-vinsn (slide-values :needs-frame-pointer) .SPmvslide)
4107
4108(define-x8664-subprim-lea-jmp-vinsn (spread-list) .SPspreadargz)
4109
4110;;; Even though it's implemented by calling a subprim, THROW is really
4111;;; a JUMP (to a possibly unknown destination). If the destination's
4112;;; really known, it should probably be inlined (stack-cleanup, value
4113;;; transfer & jump ...)
4114(define-x8664-vinsn (throw :jump-unknown :needs-frame-pointer) (()
4115 ()
4116 ((entry (:label 1))))
4117 (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
4118 (:talign 4)
4119 (jmp (:@ .SPthrow))
4120 :back
4121 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
4122 (uuo-error-reg-not-tag (:%q x8664::temp0) (:$ub x8664::subtag-catch-frame)))
4123
4124
4125
4126(define-x8664-vinsn unbox-base-char (((dest :u64))
4127 ((src :lisp)))
4128 :anchor
4129 (movq (:%q src) (:%q dest))
4130 (shrq (:$ub x8664::charcode-shift) (:%q dest))
4131 (cmpb (:$b x8664::subtag-character) (:%b src))
4132 (jne :bad)
4133 (:anchored-uuo-section :anchor)
4134 :bad
4135 (:anchored-uuo (uuo-error-reg-not-tag (:%q src) (:$ub x8664::subtag-character))))
4136
4137(define-x8664-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
4138
4139(define-x8664-subprim-lea-jmp-vinsn (recover-values) .SPrecover-values)
4140
4141(define-x8664-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
4142
4143(define-x8664-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
4144
4145(define-x8664-subprim-call-vinsn (make-stack-block) .SPmakestackblock)
4146
4147(define-x8664-subprim-call-vinsn (make-stack-block0) .Spmakestackblock0)
4148
4149;;; "dest" is preallocated, presumably on a stack somewhere.
4150(define-x8664-vinsn store-double (()
4151 ((dest :lisp)
4152 (source :double-float))
4153 ())
4154 (movsd (:%xmm source) (:@ x8664::double-float.value (:%q dest))))
4155
4156(define-x8664-vinsn fixnum->char (((dest :lisp))
4157 ((src :imm))
4158 ((temp :u32)))
4159 (movl (:%l src) (:%l temp))
4160 (sarl (:$ub (+ x8664::fixnumshift 1)) (:%l temp))
4161 (cmpl (:$l (ash #xfffe -1)) (:%l temp))
4162 (je :bad-if-eq)
4163 (sarl (:$ub (- 11 1)) (:%l temp))
4164 (cmpl (:$b (ash #xd800 -11))(:%l temp))
4165 :bad-if-eq
4166 (movl (:$l (:apply target-nil-value)) (:%l temp))
4167 (cmovel (:%l temp) (:%l dest))
4168 (je :done)
4169 ((:not (:pred =
4170 (:apply %hard-regspec-value dest)
4171 (:apply %hard-regspec-value src)))
4172 (movl (:%l src) (:%l dest)))
4173 (shll (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%l dest))
4174 (addl (:$b x8664::subtag-character) (:%l dest))
4175 :done)
4176
4177;;; src is known to be a code for which CODE-CHAR returns non-nil.
4178(define-x8664-vinsn code-char->char (((dest :lisp))
4179 ((src :imm))
4180 ())
4181 ((:not (:pred =
4182 (:apply %hard-regspec-value dest)
4183 (:apply %hard-regspec-value src)))
4184 (movl (:%l src) (:%l dest)))
4185 (shll (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%l dest))
4186 (addl (:$b x8664::subtag-character) (:%l dest))
4187 :done)
4188
4189
4190(define-x8664-vinsn sign-extend-halfword (((dest :imm))
4191 ((src :imm)))
4192 (movq (:%q src ) (:%q dest))
4193 (shlq (:$ub (- 48 x8664::fixnumshift)) (:%q dest))
4194 (sarq (:$ub (- 48 x8664::fixnumshift)) (:%q dest)))
4195
4196(define-x8664-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
4197
4198(define-x8664-subprim-call-vinsn (gets64) .SPgets64)
4199
4200(define-x8664-subprim-call-vinsn (getu64) .SPgetu64)
4201
4202(define-x8664-vinsn %init-gvector (()
4203 ((v :lisp)
4204 (nbytes :u32const))
4205 ((count :imm)))
4206 (movl (:$l nbytes) (:%l count))
4207 (jmp :test)
4208 :loop
4209 (popq (:@ x8664::misc-data-offset (:%q v) (:%q count)))
4210 :test
4211 (subq (:$b x8664::node-size) (:%q count))
4212 (jge :loop))
4213
4214(define-x8664-subprim-jump-vinsn (tail-funcall-slide :needs-frame-pointer) .SPtfuncallslide)
4215
4216(define-x8664-vinsn nth-value (((result :lisp))
4217 ()
4218 ((imm0 :u64)))
4219 (leaq (:@ (:%q x8664::rsp) (:%q x8664::nargs)) (:%q imm0))
4220 (subq (:@ (:%q imm0)) (:%q x8664::nargs))
4221 (movl (:$l (:apply target-nil-value)) (:%l result))
4222 (jle :done)
4223 ;; I -think- that a CMOV would be safe here, assuming that N wasn't
4224 ;; extremely large. Don't know if we can assume that.
4225 (movq (:@ (- x8664::node-size) (:%q x8664::rsp) (:%q x8664::nargs)) (:%q result))
4226 :done
4227 (leaq (:@ x8664::node-size (:%q imm0)) (:%q x8664::rsp)))
4228
4229
4230(define-x8664-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
4231
4232(define-x8664-subprim-call-vinsn (stack-misc-alloc-init) .SPstack-misc-alloc-init)
4233
4234(define-x8664-vinsn fixnum->unsigned-natural (((dest :u64))
4235 ((src :imm)))
4236 (movq (:%q src) (:%q dest))
4237 (shrq (:$ub x8664::fixnumshift) (:%q dest)))
4238
4239(define-x8664-vinsn %debug-trap (()
4240 ())
4241 (uuo-error-debug-trap))
4242
4243(define-x8664-vinsn double-to-single (((result :single-float))
4244 ((arg :double-float)))
4245 (cvtsd2ss (:%xmm arg) (:%xmm result)))
4246
4247(define-x8664-vinsn single-to-double (((result :double-float))
4248 ((arg :single-float)))
4249 (cvtss2sd (:%xmm arg) (:%xmm result)))
4250
4251
4252(define-x8664-vinsn alloc-c-frame (()
4253 ((nwords :u32const))
4254 ((temp :imm)
4255 (stack-temp :imm)))
4256 (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
4257 ((:pred < (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift) 128)
4258 (subq (:$b (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift)) (:rcontext x8664::tcr.foreign-sp)))
4259 ((:not (:pred < (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift) 128))
4260 (subq (:$l (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift)) (:rcontext x8664::tcr.foreign-sp)))
4261 (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
4262 (movq (:%q stack-temp) (:@ (:%q temp)))
4263 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q temp))))
4264
4265(define-x8664-vinsn alloc-variable-c-frame (()
4266 ((nwords :imm))
4267 ((size :s64)
4268 (temp :imm)
4269 (stack-temp :imm)))
4270 (leaq (:@ (* 9 x8664::node-size) (:%q nwords)) (:%q size))
4271 (andb (:$b (lognot x8664::fulltagmask)) (:%b size))
4272
4273 (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
4274 (subq (:%q size) (:rcontext x8664::tcr.foreign-sp))
4275 (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
4276 (movq (:%q stack-temp) (:@ (:%q temp)))
4277 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q temp))))
4278
4279(define-x8664-vinsn set-c-arg (()
4280 ((arg :u64)
4281 (offset :u32const))
4282 ((temp (:u64 #.x8664::ra0))))
4283 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
4284 (movq (:%q arg) (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0))))
4285
4286(define-x8664-vinsn set-single-c-arg (()
4287 ((arg :single-float)
4288 (offset :u32const))
4289 ((temp (:u64 #.x8664::ra0))))
4290 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
4291 (movss (:%xmm arg) (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0))))
4292
4293(define-x8664-vinsn reload-single-c-arg (((arg :single-float))
4294 ((offset :u32const))
4295 ((u64 (:u64 #.x8664::ra0))))
4296 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
4297 (movss (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0)) (:%xmm arg)))
4298
4299(define-x8664-vinsn set-double-c-arg (()
4300 ((arg :double-float)
4301 (offset :u32const))
4302 ((temp (:u64 #.x8664::ra0))))
4303 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
4304 (movsd (:%xmm arg) (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0))))
4305
4306(define-x8664-vinsn reload-double-c-arg (((arg :double-float))
4307 ((offset :u32const))
4308 ((temp (:u64 #.x8664::ra0))))
4309 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
4310 (movsd (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0)) (:%xmm arg)))
4311
4312(define-x8664-subprim-call-vinsn (ff-call) .SPffcall)
4313
4314(define-x8664-subprim-call-vinsn (ff-call-return-registers) .SPffcall-return-registers)
4315
4316(define-x8664-subprim-call-vinsn (syscall) .SPsyscall)
4317
4318(define-x8664-subprim-call-vinsn (setqsym) .SPsetqsym)
4319
4320(define-x8664-vinsn recover-fn-from-rip (()
4321 ())
4322 (leaq (:@ (:apply - (:^ :disp)) (:%q x8664::rip)) (:%q x8664::fn))
4323 :disp)
4324
4325
4326
4327(define-x8664-subprim-call-vinsn (makeu64) .SPmakeu64)
4328
4329(define-x8664-subprim-call-vinsn (makes64) .SPmakes64)
4330
4331(define-x8664-subprim-lea-jmp-vinsn (stack-cons-list*) .SPstkconslist-star)
4332
4333(define-x8664-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
4334
4335(define-x8664-vinsn make-tsp-vcell (((dest :lisp))
4336 ((closed :lisp))
4337 ((temp :imm)
4338 (stack-temp :imm)))
4339 (subq (:$b (+ x8664::value-cell.size x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
4340 (movq (:rcontext x8664::tcr.save-tsp) (:%q stack-temp))
4341 (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
4342 (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
4343 (movapd (:%xmm x8664::fpzero) (:@ x8664::dnode-size (:%q temp)))
4344 (movq (:%q stack-temp) (:@ (:%q temp)))
4345 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
4346 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
4347 (movq (:$l x8664::value-cell-header) (:@ x8664::dnode-size (:%q temp)))
4348 (movq (:%q closed) (:@ (+ x8664::dnode-size x8664::node-size) (:%q temp)))
4349 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q temp)) (:%q dest)))
4350
4351(define-x8664-subprim-lea-jmp-vinsn (bind-nil) .SPbind-nil)
4352
4353(define-x8664-subprim-lea-jmp-vinsn (bind-self) .SPbind-self)
4354
4355(define-x8664-subprim-lea-jmp-vinsn (bind-self-boundp-check) .SPbind-self-boundp-check)
4356
4357(define-x8664-subprim-lea-jmp-vinsn (bind) .SPbind)
4358
4359
4360(define-x8664-vinsn (bind-inline ) (()
4361 ((sym :lisp)
4362 (val :lisp))
4363 ((idx :lisp)
4364 (tlb-pointer :lisp)))
4365 (movq (:@ x8664::symbol.binding-index (:%q sym)) (:%q idx))
4366 (cmpq (:rcontext x8664::tcr.tlb-limit) (:%q idx))
4367 (jb :tlb-ok)
4368 (pushq (:%q idx))
4369 (ud2a)
4370 (:byte 1)
4371 :tlb-ok
4372 (movq (:rcontext target::tcr.tlb-pointer) (:%q tlb-pointer))
4373 (pushq (:@ (:%q tlb-pointer) (:%q idx)))
4374 (pushq (:%q idx))
4375 (pushq (:rcontext target::tcr.db-link))
4376 (movq (:%q target::rsp)(:rcontext target::tcr.db-link))
4377 (movq (:%q val) (:@ (:%q tlb-pointer) (:%q idx))))
4378
4379
4380(define-x8664-vinsn unbind-inline (()
4381 ()
4382 ((link :lisp)
4383 (tlb-pointer :lisp)
4384 (idx :lisp)
4385 (val :lisp)))
4386
4387 (movq (:rcontext target::tcr.db-link) (:%q link))
4388 (movq (:rcontext target::tcr.tlb-pointer) (:%q tlb-pointer))
4389 (movq (:@ 8 (:%q link)) (:%q idx))
4390 (movq (:@ 16 (:%q link)) (:%q val))
4391 (movq (:@ (:%q link)) (:%q link))
4392 (movq (:% val) (:@ (:%q tlb-pointer) (:% idx)))
4393 (movq (:%q link) (:rcontext target::tcr.db-link)))
4394
4395
4396
4397(define-x8664-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
4398
4399(define-x8664-subprim-call-vinsn (make-stack-list) .Spmakestacklist)
4400
4401(define-x8664-vinsn node-slot-ref (((dest :lisp))
4402 ((node :lisp)
4403 (cellno :u32const)))
4404 (movq (:@ (:apply + x8664::misc-data-offset (:apply ash cellno 3))
4405 (:%q node)) (:%q dest)))
4406
4407(define-x8664-subprim-lea-jmp-vinsn (stack-cons-list) .SPstkconslist)
4408
4409
4410(define-x8664-vinsn %slot-ref (((dest :lisp))
4411 ((instance (:lisp (:ne dest)))
4412 (index :lisp)))
4413 (movq (:@ x8664::misc-data-offset (:%q instance) (:%q index)) (:%q dest))
4414 (cmpl (:$b x8664::slot-unbound-marker) (:%l dest))
4415 (je :bad)
4416 :ok
4417 (:anchored-uuo-section :ok)
4418 :bad
4419 (:anchored-uuo (uuo-error-slot-unbound (:%q dest) (:%q instance) (:%q index))))
4420
4421(define-x8664-vinsn eep.address (((dest t))
4422 ((src (:lisp (:ne dest )))))
4423 (movq (:@ (+ (ash 1 x8664::word-shift) x8664::misc-data-offset) (:%q src))
4424 (:%q dest))
4425 (cmpb (:$b x8664::fulltag-nil) (:%b dest))
4426 (je :bad)
4427 :ok
4428 (:anchored-uuo-section :ok)
4429 :bad
4430 (:anchored-uuo (uuo-error-eep-unresolved (:%q src) (:%q dest))))
4431
4432
4433(define-x8664-subprim-lea-jmp-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
4434
4435(define-x8664-subprim-lea-jmp-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
4436
4437(define-x8664-subprim-lea-jmp-vinsn (make-stack-vector) .SPmkstackv)
4438
4439(define-x8664-vinsn (%current-frame-ptr :needs-frame-pointer) (((dest :imm))
4440 ())
4441 (movq (:%q x8664::rbp) (:%q dest)))
4442
4443(define-x8664-vinsn %foreign-stack-pointer (((dest :imm))
4444 ())
4445 (movq (:rcontext x8664::tcr.foreign-sp) (:%q dest)))
4446
4447
4448(define-x8664-vinsn %set-scharcode8 (()
4449 ((str :lisp)
4450 (idx :imm)
4451 (code :imm))
4452 ((imm :u64)
4453 (imm1 :u64)))
4454 (movq (:%q code) (:%q imm1))
4455 (movq (:%q idx) (:%q imm))
4456 (shrq (:$ub x8664::fixnumshift) (:%q imm1))
4457 (shrq (:$ub x8664::word-shift) (:%q imm))
4458 (movb (:%b imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm))))
4459
4460
4461(define-x8664-vinsn %set-scharcode32 (()
4462 ((str :lisp)
4463 (idx :imm)
4464 (code :imm))
4465 ((imm :u64)
4466 (imm1 :u64)))
4467 (movq (:%q code) (:%q imm1))
4468 (movq (:%q idx) (:%q imm))
4469 (shrq (:$ub x8664::fixnumshift) (:%q imm1))
4470 (shrq (:$ub 1) (:%q imm))
4471 (movl (:%l imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm))))
4472
4473
4474
4475
4476(define-x8664-vinsn pop-argument-registers (()
4477 ())
4478 (testl (:%l x8664::nargs) (:%l x8664::nargs))
4479 (je :done)
4480 (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
4481 (popq (:%q x8664::arg_z))
4482 (jb :done)
4483 (popq (:%q x8664::arg_y))
4484 (je :done)
4485 (popq (:%q x8664::arg_x))
4486 :done)
4487
4488(define-x8664-vinsn %symptr->symvector (((target :lisp))
4489 ((target :lisp)))
4490 (subb (:$b (- x8664::fulltag-symbol x8664::fulltag-misc)) (:%b target)))
4491
4492(define-x8664-vinsn %symvector->symptr (((target :lisp))
4493 ((target :lisp)))
4494 (addb (:$b (- x8664::fulltag-symbol x8664::fulltag-misc)) (:%b target)))
4495
4496
4497(define-x8664-subprim-lea-jmp-vinsn (spread-lexpr) .SPspread-lexpr-z)
4498
4499(define-x8664-vinsn mem-ref-double-float (((dest :double-float))
4500 ((src :address)
4501 (index :s64)))
4502 (movsd (:@ (:%q src) (:%q index)) (:%xmm dest)))
4503
4504(define-x8664-vinsn mem-ref-single-float (((dest :single-float))
4505 ((src :address)
4506 (index :s64)))
4507 (movss (:@ (:%q src) (:%q index)) (:%xmm dest)))
4508
4509(define-x8664-vinsn zero-extend-nargs (()
4510 ())
4511 (movzwl (:%w x8664::nargs) (:%l x8664::nargs)))
4512
4513(define-x8664-vinsn load-adl (()
4514 ((n :u32const)))
4515 (movl (:$l n) (:%l x8664::nargs)))
4516
4517(define-x8664-subprim-lea-jmp-vinsn (macro-bind) .SPmacro-bind)
4518
4519(define-x8664-subprim-lea-jmp-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
4520
4521(define-x8664-subprim-lea-jmp-vinsn (destructuring-bind) .SPdestructuring-bind)
4522
4523(define-x8664-vinsn symbol-ref (((dest :lisp))
4524 ((src :lisp)
4525 (cellno :u32const)))
4526 (movq (:@ (:apply + (- x8664::node-size x8664::fulltag-symbol)
4527 (:apply ash cellno 3))
4528 (:%q src)) (:%q dest)))
4529
4530(define-x8664-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
4531 ((src :address)
4532 (offset :s32const))
4533 ((temp :u32)))
4534 ((:pred = 0 (:apply ash offset -6))
4535 (btq (:$ub (:apply logand 63 offset))
4536 (:@ (:%q src))))
4537 ((:not (:pred = 0 (:apply ash offset -6)))
4538 (btq (:$ub (:apply logand 63 offset))
4539 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
4540 (movl (:$l x8664::fixnumone) (:%l temp))
4541 (leaq (:@ (- x8664::fixnumone) (:%q temp)) (:%q dest))
4542 (cmovbl (:%l temp) (:%l dest)))
4543
4544(define-x8664-vinsn mem-ref-c-bit (((dest :lisp))
4545 ((src :address)
4546 (offset :s32const))
4547 ((temp :u32)))
4548 ((:pred = 0 (:apply ash offset -6))
4549 (btq (:$ub (:apply logand 63 offset))
4550 (:@ (:%q src))))
4551 ((:not (:pred = 0 (:apply ash offset -6)))
4552 (btq (:$ub (:apply logand 63 offset))
4553 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
4554 (setb (:%b temp))
4555 (movzbl (:%b temp) (:%l dest)))
4556
4557(define-x8664-vinsn mem-ref-bit-fixnum (((dest :lisp)
4558 (src :address))
4559 ((src :address)
4560 (offset :lisp))
4561 ((temp :u32)))
4562 (movq (:%q offset) (:%q temp))
4563 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4564 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4565 (movq (:%q offset) (:%q temp))
4566 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4567 (andl (:$l 63) (:%l temp))
4568 (btq (:%q temp) (:@ (:%q src)))
4569 (movl (:$l x8664::fixnumone) (:%l temp))
4570 (leaq (:@ (- x8664::fixnumone) (:%q temp)) (:%q dest))
4571 (cmovbl (:%l temp) (:%l dest)))
4572
4573(define-x8664-vinsn mem-ref-bit (((dest :lisp)
4574 (src :address))
4575 ((src :address)
4576 (offset :lisp))
4577 ((temp :u32)))
4578 (movq (:%q offset) (:%q temp))
4579 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4580 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4581 (movq (:%q offset) (:%q temp))
4582 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4583 (andl (:$l 63) (:%l temp))
4584 (btq (:%q temp) (:@ (:%q src)))
4585 (setb (:%b temp))
4586 (movzbl (:%b temp) (:%l dest)))
4587
4588
4589(define-x8664-vinsn mem-set-c-bit-0 (()
4590 ((src :address)
4591 (offset :s32const)))
4592
4593 ((:pred = 0 (:apply ash offset -6))
4594 (btrq (:$ub (:apply logand 63 offset))
4595 (:@ (:%q src))))
4596 ((:not (:pred = 0 (:apply ash offset -6)))
4597 (btrq (:$ub (:apply logand 63 offset))
4598 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src)))))
4599
4600(define-x8664-vinsn mem-set-c-bit-1 (()
4601 ((src :address)
4602 (offset :s32const)))
4603
4604 ((:pred = 0 (:apply ash offset -6))
4605 (btsq (:$ub (:apply logand 63 offset))
4606 (:@ (:%q src))))
4607 ((:not (:pred = 0 (:apply ash offset -6)))
4608 (btsq (:$ub (:apply logand 63 offset))
4609 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src)))))
4610
4611(define-x8664-vinsn mem-set-c-bit-variable-value (()
4612 ((src :address)
4613 (offset :s32const)
4614 (value :lisp)))
4615 (testq (:%q value) (:%q value))
4616 (jne :set)
4617 ((:pred = 0 (:apply ash offset -6))
4618 (btrq (:$ub (:apply logand 63 offset))
4619 (:@ (:%q src))))
4620 ((:not (:pred = 0 (:apply ash offset -6)))
4621 (btrq (:$ub (:apply logand 63 offset))
4622 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
4623 (jmp :done)
4624 :set
4625 ((:pred = 0 (:apply ash offset -6))
4626 (btsq (:$ub (:apply logand 63 offset))
4627 (:@ (:%q src))))
4628 ((:not (:pred = 0 (:apply ash offset -6)))
4629 (btsq (:$ub (:apply logand 63 offset))
4630 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
4631 :done)
4632
4633
4634(define-x8664-vinsn mem-set-bit-0 (((src :address))
4635 ((src :address)
4636 (offset :lisp))
4637 ((temp :u32)))
4638 (movq (:%q offset) (:%q temp))
4639 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4640 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4641 (movq (:%q offset) (:%q temp))
4642 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4643 (andl (:$l 63) (:%l temp))
4644 (btrq (:%q temp) (:@ (:%q src))))
4645
4646(define-x8664-vinsn mem-set-bit-1 (((src :address))
4647 ((src :address)
4648 (offset :lisp))
4649 ((temp :u32)))
4650 (movq (:%q offset) (:%q temp))
4651 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4652 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4653 (movq (:%q offset) (:%q temp))
4654 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4655 (andl (:$l 63) (:%l temp))
4656 (btsq (:%q temp) (:@ (:%q src))))
4657
4658
4659(define-x8664-vinsn mem-set-bit-variable-value (((src :address))
4660 ((src :address)
4661 (offset :lisp)
4662 (value :lisp))
4663 ((temp :u32)))
4664 (movq (:%q offset) (:%q temp))
4665 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4666 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4667 (movq (:%q offset) (:%q temp))
4668 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4669 (andl (:$l 63) (:%l temp))
4670 (testq (:%q value) (:%q value))
4671 (jne :set)
4672 (btrq (:%q temp) (:@ (:%q src)))
4673 (jmp :done)
4674 :set
4675 (btsq (:%q temp) (:@ (:%q src)))
4676 :done)
4677
4678(define-x8664-vinsn %natural+ (((result :u64))
4679 ((result :u64)
4680 (other :u64)))
4681 (addq (:%q other) (:%q result)))
4682
4683(define-x8664-vinsn %natural+-c (((result :u64))
4684 ((result :u64)
4685 (constant :s32const)))
4686 (addq (:$l constant) (:%q result)))
4687
4688(define-x8664-vinsn %natural- (((result :u64))
4689 ((result :u64)
4690 (other :u64)))
4691 (subq (:%q other) (:%q result)))
4692
4693(define-x8664-vinsn %natural--c (((result :u64))
4694 ((result :u64)
4695 (constant :s32const)))
4696 (subq (:$l constant) (:%q result)))
4697
4698(define-x8664-vinsn %natural-logior (((result :u64))
4699 ((result :u64)
4700 (other :u64)))
4701 (orq (:%q other) (:%q result)))
4702
4703(define-x8664-vinsn %natural-logior-c (((result :u64))
4704 ((result :u64)
4705 (constant :s32const)))
4706 (orq (:$l constant) (:%q result)))
4707
4708(define-x8664-vinsn %natural-logand (((result :u64))
4709 ((result :u64)
4710 (other :u64)))
4711 (andq (:%q other) (:%q result)))
4712
4713(define-x8664-vinsn %natural-logand-c (((result :u64))
4714 ((result :u64)
4715 (constant :s32const)))
4716 (andq (:$l constant) (:%q result)))
4717
4718(define-x8664-vinsn %natural-logxor (((result :u64))
4719 ((result :u64)
4720 (other :u64)))
4721 (xorq (:%q other) (:%q result)))
4722
4723(define-x8664-vinsn %natural-logxor-c (((result :u64))
4724 ((result :u64)
4725 (constant :s32const)))
4726 (xorq (:$l constant) (:%q result)))
4727
4728(define-x8664-vinsn natural-shift-left (((dest :u64))
4729 ((dest :u64)
4730 (amt :u8const)))
4731 (shlq (:$ub amt) (:%q dest)))
4732
4733(define-x8664-vinsn natural-shift-right (((dest :u64))
4734 ((dest :u64)
4735 (amt :u8const)))
4736 (shrq (:$ub amt) (:%q dest)))
4737
4738(define-x8664-vinsn set-z-if-uvector-type (((crf :crf))
4739 ((src :lisp)
4740 (type :u8const))
4741 ((tag :u8)))
4742 (movl (:%l src) (:%l tag))
4743 (andl (:$b x8664::tagmask) (:%l tag))
4744 (cmpl (:$b x8664::tag-misc) (:%l tag))
4745 (jne :done)
4746 (cmpb (:$b type) (:@ x8664::misc-subtag-offset (:%q src)))
4747 :done)
4748
4749(define-x8664-vinsn set-z-if-header-type (((crf :crf))
4750 ((src :lisp)
4751 (type :u8const))
4752 ((flags :u32)))
4753 (movl (:@ x8664::vectorH.flags (:%q src)) (:%l flags))
4754 (shrl (:$ub (+ x8664::fixnumshift 8)) (:%l flags))
4755 (cmpb (:$b type) (:%b flags))
4756)
4757
4758(define-x8664-vinsn trap-unless-simple-array-2 (()
4759 ((object :lisp)
4760 (expected-flags :u32const)
4761 (type-error :u8const))
4762 ((tag :u8)))
4763 :again
4764 (movl (:%l object) (:%l tag))
4765 (andl (:$b x8664::tagmask) (:%l tag))
4766 (cmpl (:$b x8664::tag-misc) (:%l tag))
4767 (jne :bad)
4768 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4769 (jne :bad)
4770 (cmpq (:$b (ash 2 x8664::fixnumshift)) (:@ x8664::arrayH.rank (:%q object)))
4771 (jne :bad)
4772 (cmpq (:$l (:apply ash expected-flags x8664::fixnumshift)) (:@ x8664::arrayH.flags (:%q object)))
4773 (jne :bad)
4774
4775 (:anchored-uuo-section :again)
4776 :bad
4777 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub type-error))))
4778
4779(define-x8664-vinsn set-z-if-typed-array (((crf :crf))
4780 ((object :lisp)
4781 (expected-type :u8const)
4782 (rank :u8const))
4783 ((tag :u8)))
4784 :again
4785 (movl (:%l object) (:%l tag))
4786 (andl (:$b x8664::tagmask) (:%l tag))
4787 (cmpl (:$b x8664::tag-misc) (:%l tag))
4788 (jne :notz)
4789 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4790 (jne :notz)
4791 (cmpq (:$b (:apply ash rank x8664::fixnumshift)) (:@ x8664::arrayH.rank (:%q object)))
4792 (jne :notz)
4793 (movl (:@ x8664::arrayH.flags (:%q object)) (:%l tag))
4794 (shrl (:$ub (+ x8664::fixnumshift 8)) (:%l tag))
4795 (cmpb (:$b expected-type) (:%b tag))
4796 :notz
4797)
4798
4799
4800
4801(define-x8664-vinsn trap-unless-simple-array-3 (()
4802 ((object :lisp)
4803 (expected-flags :u32const)
4804 (type-error :u8const))
4805 ((tag :u8)))
4806 :again
4807 (movl (:%l object) (:%l tag))
4808 (andl (:$b x8664::tagmask) (:%l tag))
4809 (cmpl (:$b x8664::tag-misc) (:%l tag))
4810 (jne :bad)
4811 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4812 (jne :bad)
4813 (cmpq (:$b (ash 3 x8664::fixnumshift)) (:@ x8664::arrayH.rank (:%q object)))
4814 (jne :bad)
4815 (cmpq (:$l (:apply ash expected-flags x8664::fixnumshift)) (:@ x8664::arrayH.flags (:%q object)))
4816 (jne :bad)
4817 (:anchored-uuo-section :again)
4818 :bad
4819 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub type-error))))
4820
4821(define-x8664-vinsn trap-unless-array-header (()
4822 ((object :lisp))
4823 ((tag :u8)))
4824 :again
4825 (movl (:%l object) (:%l tag))
4826 (andl (:$b x8664::tagmask) (:%l tag))
4827 (cmpl (:$b x8664::tag-misc) (:%l tag))
4828 (jne :trap)
4829 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4830 (jne :trap)
4831
4832 (:anchored-uuo-section :again)
4833 :trap
4834 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-arrayH))))
4835
4836(define-x8664-vinsn check-arrayH-rank (()
4837 ((header :lisp)
4838 (expected :u32const))
4839 ((rank :imm)))
4840 :anchor
4841 (movl (:$l (:apply ash expected x8664::fixnumshift)) (:%l rank))
4842 (cmpq (:@ x8664::arrayH.rank (:%q header)) (:%q rank))
4843 (jne :bad)
4844 (:anchored-uuo-section :anchor)
4845 :bad
4846 (:anchored-uuo (uuo-error-array-rank (:%q header) (:%q rank))))
4847
4848(define-x8664-vinsn check-arrayH-flags (()
4849 ((header :lisp)
4850 (expected :u32const)
4851 (type-error :u8const)))
4852 :anchor
4853 (cmpq (:$l (:apply ash expected x8664::fixnumshift))
4854 (:@ x8664::arrayH.flags (:%q header)))
4855 (jne :bad)
4856 (:anchored-uuo-section :anchor)
4857 :bad
4858 (:anchored-uuo (uuo-error-reg-not-type (:%q header) (:$ub type-error))))
4859
4860(define-x8664-vinsn misc-ref-c-u16 (((dest :u16))
4861 ((v :lisp)
4862 (idx :u32const))
4863 ())
4864 (movzwl (:@ (:apply + x8664::misc-data-offset (:apply ash idx 1)) (:%q v)) (:%l dest)))
4865
4866(define-x8664-vinsn misc-ref-c-s16 (((dest :s16))
4867 ((v :lisp)
4868 (idx :u32const))
4869 ())
4870 (movswq (:@ (:apply + x8664::misc-data-offset (:apply ash idx 1)) (:%q v)) (:%q dest)))
4871
4872(define-x8664-vinsn misc-set-single-float (()
4873 ((val :single-float)
4874 (v :lisp)
4875 (scaled-idx :u32)))
4876 (movss (:%xmm val) (:@ x8664::misc-data-offset (:% v) (:% scaled-idx))))
4877
4878(define-x8664-vinsn u16->u32 (((dest :u32))
4879 ((src :u16)))
4880 (movzwl (:%w src) (:%l dest)))
4881
4882(define-x8664-vinsn u8->u32 (((dest :u32))
4883 ((src :u8)))
4884 (movzbl (:%b src) (:%l dest)))
4885
4886
4887(define-x8664-vinsn s16->s32 (((dest :s32))
4888 ((src :s16)))
4889 (movswl (:%w src) (:%l dest)))
4890
4891(define-x8664-vinsn s8->s32 (((dest :s32))
4892 ((src :s8)))
4893 (movsbl (:%b src) (:%l dest)))
4894
4895(define-x8664-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
4896
4897(define-x8664-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
4898
4899(define-x8664-vinsn set-eq-bit (()
4900 ())
4901 (testb (:%b x8664::arg_z) (:%b x8664::arg_z)))
4902
4903(define-x8664-vinsn %schar8 (((char :imm))
4904 ((str :lisp)
4905 (idx :imm))
4906 ((imm :u32)))
4907 (movq (:%q idx) (:%q imm))
4908 (shrq (:$ub x8664::fixnumshift) (:%q imm))
4909 (movzbl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
4910 (shll (:$ub x8664::charcode-shift) (:%l imm))
4911 (leaq (:@ x8664::subtag-character (:%q imm)) (:%q char)))
4912
4913(define-x8664-vinsn %schar32 (((char :imm))
4914 ((str :lisp)
4915 (idx :imm))
4916 ((imm :u32)))
4917 (movq (:%q idx) (:%q imm))
4918 (shrq (:$ub 1) (:%q imm))
4919 (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
4920 (shll (:$ub x8664::charcode-shift) (:%l imm))
4921 (leaq (:@ x8664::subtag-character (:%q imm)) (:%q char)))
4922
4923
4924(define-x8664-vinsn %set-schar8 (()
4925 ((str :lisp)
4926 (idx :imm)
4927 (char :imm))
4928 ((imm0 :u64)
4929 (imm1 :u64)))
4930 (movq (:%q idx) (:%q imm0))
4931 (movl (:%l char) (:%l imm1))
4932 (shrq (:$ub x8664::fixnumshift) (:%q imm0))
4933 (shrl (:$ub x8664::charcode-shift) (:%l imm1))
4934 (movb (:%b imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm0))))
4935
4936(define-x8664-vinsn %set-schar32 (()
4937 ((str :lisp)
4938 (idx :imm)
4939 (char :imm))
4940 ((imm0 :u64)
4941 (imm1 :u64)))
4942 (movq (:%q idx) (:%q imm0))
4943 (movl (:%l char) (:%l imm1))
4944 (shrq (:$ub 1) (:%q imm0))
4945 (shrl (:$ub x8664::charcode-shift) (:%l imm1))
4946 (movl (:%l imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm0))))
4947
4948(define-x8664-vinsn misc-set-c-single-float (((val :single-float))
4949 ((v :lisp)
4950 (idx :u32const)))
4951 (movss (:%xmm val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
4952
4953(define-x8664-vinsn array-data-vector-ref (((dest :lisp))
4954 ((header :lisp)))
4955 (movq (:@ x8664::arrayH.data-vector (:%q header)) (:%q dest)))
4956
4957(define-x8664-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
4958
4959(define-x8664-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
4960
4961(define-x8664-vinsn mem-ref-c-absolute-u8 (((dest :u8))
4962 ((addr :s32const)))
4963 (movzbl (:@ addr) (:%l dest)))
4964
4965(define-x8664-vinsn mem-ref-c-absolute-s8 (((dest :s8))
4966 ((addr :s32const)))
4967 (movsbq (:@ addr) (:%q dest)))
4968
4969(define-x8664-vinsn mem-ref-c-absolute-u16 (((dest :u16))
4970 ((addr :s32const)))
4971 (movzwl (:@ addr) (:%l dest)))
4972
4973(define-x8664-vinsn mem-ref-c-absolute-s16 (((dest :s16))
4974 ((addr :s32const)))
4975 (movswq (:@ addr) (:%q dest)))
4976
4977(define-x8664-vinsn mem-ref-c-absolute-fullword (((dest :u32))
4978 ((addr :s32const)))
4979 (movl (:@ addr) (:%l dest)))
4980
4981(define-x8664-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
4982 ((addr :s32const)))
4983 (movslq (:@ addr) (:%q dest)))
4984
4985(define-x8664-vinsn mem-ref-c-absolute-doubleword (((dest :s64))
4986 ((addr :s32const)))
4987 (movq (:@ addr) (:%q dest)))
4988
4989(define-x8664-vinsn mem-ref-c-absolute-signed-doubleword (((dest :s64))
4990 ((addr :s32const)))
4991 (movq (:@ addr) (:%q dest)))
4992
4993(define-x8664-vinsn mem-ref-c-absolute-natural (((dest :u64))
4994 ((addr :s32const)))
4995 (movq (:@ addr) (:%q dest)))
4996
4997(define-x8664-vinsn event-poll (()
4998 ())
4999 (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
5000 (jae :no-interrupt)
5001 (ud2a)
5002 (:byte 2)
5003 :no-interrupt)
5004
5005;;; Return dim1 (unboxed)
5006(define-x8664-vinsn check-2d-bound (((dim :u64))
5007 ((i :imm)
5008 (j :imm)
5009 (header :lisp)))
5010 :anchor
5011 (cmpq (:@ (+ x8664::misc-data-offset (* 8 x8664::arrayH.dim0-cell)) (:%q header)) (:%q i))
5012 (jae :bad-i)
5013 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header))
5014 (:%q dim))
5015 (cmpq (:%q dim) (:%q j))
5016 (jae :bad-j)
5017 (sarq (:$ub x8664::fixnumshift) (:%q dim))
5018 (:anchored-uuo-section :anchor)
5019 :bad-i
5020 (:anchored-uuo (uuo-error-array-bounds (:%q i) (:%q header)))
5021 (:anchored-uuo-section :anchor)
5022 :bad-j
5023 (:anchored-uuo (uuo-error-array-bounds (:%q j) (:%q header))))
5024
5025;;; Return dim1, dim2 (unboxed)
5026(define-x8664-vinsn check-3d-bound (((dim1 :u64)
5027 (dim2 :u64))
5028 ((i :imm)
5029 (j :imm)
5030 (k :imm)
5031 (header :lisp)))
5032 :anchor
5033 (cmpq (:@ (+ x8664::misc-data-offset (* 8 x8664::arrayH.dim0-cell)) (:%q header)) (:%q i))
5034 (jae :bad-i)
5035 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim1))
5036 (cmpq (:%q dim1) (:%q j))
5037 (jae :bad-j)
5038 (sarq (:$ub x8664::fixnumshift) (:%q dim1))
5039 (movq (:@ (+ x8664::misc-data-offset (* 8 (+ 2 x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim2))
5040 (cmpq (:%q dim2) (:%q k))
5041 (jae :bad-k)
5042 (sarq (:$ub x8664::fixnumshift) (:%q dim2))
5043 (:anchored-uuo-section :anchor)
5044 :bad-i
5045 (:anchored-uuo (uuo-error-array-bounds (:%q i) (:%q header)))
5046 (:anchored-uuo-section :anchor)
5047 :bad-j
5048 (:anchored-uuo (uuo-error-array-bounds (:%q j) (:%q header)))
5049 (:anchored-uuo-section :anchor)
5050 :bad-k
5051 (:anchored-uuo (uuo-error-array-bounds (:%q k) (:%q header)))
5052 )
5053
5054
5055(define-x8664-vinsn 2d-dim1 (((dest :u64))
5056 ((header :lisp)))
5057 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header))
5058 (:%q dest))
5059 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
5060
5061
5062(define-x8664-vinsn 3d-dims (((dim1 :u64)
5063 (dim2 :u64))
5064 ((header :lisp)))
5065 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim1))
5066 (movq (:@ (+ x8664::misc-data-offset (* 8 (+ 2 x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim2))
5067 (sarq (:$ub x8664::fixnumshift) (:%q dim1))
5068 (sarq (:$ub x8664::fixnumshift) (:%q dim2)))
5069
5070(define-x8664-vinsn 2d-unscaled-index (((dest :imm)
5071 (dim1 :u64))
5072 ((dim1 :u64)
5073 (i :imm)
5074 (j :imm)))
5075
5076 (imulq (:%q i) (:%q dim1))
5077 (leaq (:@ (:%q j) (:%q dim1)) (:%q dest)))
5078
5079
5080;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
5081(define-x8664-vinsn 3d-unscaled-index (((dest :imm)
5082 (dim1 :u64)
5083 (dim2 :u64))
5084 ((dim1 :u64)
5085 (dim2 :u64)
5086 (i :imm)
5087 (j :imm)
5088 (k :imm)))
5089 (imulq (:%q dim2) (:%q dim1))
5090 (imulq (:%q j) (:%q dim2))
5091 (imulq (:%q i) (:%q dim1))
5092 (addq (:%q dim1) (:%q dim2))
5093 (leaq (:@ (:%q k) (:%q dim2)) (:%q dest)))
5094
5095(define-x8664-vinsn set-z-flag-if-arg-fixnum (()
5096 ((arg :imm)))
5097 (testb (:$b x8664::fixnummask) (:%b arg)))
5098
5099(define-x8664-vinsn set-z-flag-if-both-args-fixnums (()
5100 ((a :imm)
5101 (b :imm))
5102 ((tag :u32)))
5103 (movl (:%l a) (:%l tag))
5104 (orl (:%l b) (:%l tag))
5105 (testb (:$b x8664::fixnummask) (:%b tag)))
5106
5107
5108
5109
5110
5111(define-x8664-vinsn fixnum->single-float (((f :single-float))
5112 ((arg :lisp))
5113 ((unboxed :s64)))
5114 (movq (:%q arg) (:%q unboxed))
5115 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
5116 (cvtsi2ssq (:%q unboxed) (:%xmm f)))
5117
5118(define-x8664-vinsn fixnum->double-float (((f :double-float))
5119 ((arg :lisp))
5120 ((unboxed :s64)))
5121 (movq (:%q arg) (:%q unboxed))
5122 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
5123 (cvtsi2sdq (:%q unboxed) (:%xmm f)))
5124
5125
5126(define-x8664-vinsn xchg-registers (()
5127 ((a t)
5128 (b t)))
5129 (xchgq (:%q a) (:%q b)))
5130
5131(define-x8664-vinsn establish-fn (()
5132 ()
5133 ((entry (:label 1))))
5134 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
5135
5136(define-x8664-vinsn %ilognot (((dest :imm)
5137 (src :imm))
5138 ((src :imm)))
5139 (xorq (:$b (- x8664::fixnumone)) (:%q dest)))
5140
5141
5142(define-x8664-vinsn align-loop-head (()
5143 ()
5144 ()))
5145
5146(define-x8664-vinsn double-float-negate (((reg :double-float))
5147 ((reg :double-float)
5148 (tmp :double-float)))
5149 (movsd (:@ (:^ :const) (:% x8664::fn)) (:%xmm tmp))
5150 (pxor (:%xmm tmp) (:%xmm reg))
5151 (:uuo-section)
5152 :const
5153 (:long 0)
5154 (:long #x-80000000))
5155
5156(define-x8664-vinsn single-float-negate (((reg :single-float))
5157 ((reg :single-float)
5158 (tmp :single-float)))
5159 (movss (:@ (:^ :const) (:% x8664::fn)) (:%xmm tmp))
5160 (pxor (:%xmm tmp) (:%xmm reg))
5161 (:uuo-section)
5162 :const
5163 (:long #x80000000))
5164
5165(define-x8664-vinsn fixnum-ref-c-double-float (((dest :double-float))
5166 ((base :imm)
5167 (idx :u32const)))
5168 (movsd (:@ (:apply ash idx 3) (:%q base)) (:%xmm dest)))
5169
5170(define-x8664-vinsn fixnum-ref-double-float (((dest :double-float))
5171 ((base :imm)
5172 (idx :imm)))
5173 (movsd (:@ (:%q base) (:%q idx)) (:%xmm dest)))
5174
5175(define-x8664-vinsn fixnum-set-c-double-float (()
5176 ((base :imm)
5177 (idx :u32const)
5178 (val :double-float)))
5179 (movsd (:%xmm val) (:@ (:apply ash idx 3) (:%q base))))
5180
5181(define-x8664-vinsn fixnum-set-double-float (()
5182 ((base :imm)
5183 (idx :imm)
5184 (val :double-float)))
5185 (movsd (:%xmm val) (:@ (:%q base) (:%q idx))))
5186
5187
5188(define-x8664-vinsn (pop-outgoing-arg :needs-frame-pointer) (((n :u16const))
5189 ())
5190 (popq (:@ (:apply * n (- x8664::node-size)) (:%q x8664::rbp))))
5191
5192(define-x8664-vinsn (slide-nth-arg :needs-frame-pointer) (()
5193 ((n :u16const)
5194 (nstackargs :u16const)
5195 (temp :lisp)))
5196 (movq (:@ (:apply * (:apply - nstackargs (:apply + 1 n)) x8664::node-size) (:%q x8664::rsp)) (:%q temp))
5197 (movq (:%q temp) (:@ (:apply * (:apply + n 1) (- x8664::node-size)) (:%q x8664::rbp))))
5198
5199
5200(define-x8664-vinsn (set-tail-vsp :needs-frame-pointer) (((nargs :u16const))
5201 ())
5202 ((:pred = 0 nargs)
5203 (movq (:%q x8664::rbp) (:%q x8664::rsp)))
5204 ((:not (:pred = 0 nargs))
5205 (leaq (:@ (:apply * nargs (- x8664::node-size)) (:%q x8664::rbp)) (:%q x8664::rsp))))
5206
5207
5208;;; If we've used one of the fixed-stack-args !slideN vinsns above
5209;;; and are calling some function (rather than jumping to an internal
5210;;; entry point), we need to push the caller's return address and unlink
5211;;; its frame pointer.
5212(define-x8664-vinsn (prepare-tail-call :needs-frame-pointer) (()
5213 ())
5214 (pushq (:@ x8664::node-size (:%q x8664::rbp)))
5215 (movq (:@ (:%q x8664::rbp)) (:%q x8664::rbp)))
5216
5217(define-x8664-vinsn (reuse-frame :needs-frame-pointer) (()())
5218 (movq (:%q x8664::rbp) (:%q x8664::rsp)))
5219
5220(define-x8664-vinsn set-carry-if-fixnum-in-range
5221 (((idx :u32))
5222 ((reg :imm)
5223 (minval :s32const)
5224 (maxval :u32const)))
5225 (movq (:%q reg) (:%q idx))
5226 (sarq (:$ub x8664::fixnumshift) (:%q idx))
5227 ((:not (:pred zerop minval))
5228 ((:and (:pred < minval 128) (:pred >= minval -128))
5229 (subq (:$b minval) (:%q idx)))
5230 ((:not (:and (:pred < minval 128) (:pred >= minval -128)))
5231 (subq (:$l minval) (:%q idx))))
5232 ((:pred < maxval 128)
5233 (cmpq (:$b maxval) (:%q idx)))
5234 ((:pred >= maxval 128)
5235 (cmpq (:$l maxval) (:%q idx))))
5236
5237(define-x8664-vinsn (ijmp ) (((idx :u32))
5238 ((idx :u32)
5239 (count :u32const))
5240 ((rjmp :lisp)))
5241 (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q idx) 4) (:%l idx))
5242 (leaq (:@ (:%q x8664::fn) (:%q idx)) (:%q rjmp))
5243 (jmp (:%q rjmp))
5244 (:uuo-section)
5245 (:align 2)
5246 (:long count)
5247 :jtab)
5248
5249
5250(define-x8664-vinsn jtabentry (()
5251 ((label :label)))
5252 (:uuo-section)
5253 (:long (:^ label)))
5254
5255
5256(define-x8664-vinsn ivector-typecode-p (((dest :lisp))
5257 ((src :lisp))
5258 ((temp :u32)
5259 (mask :u32)))
5260 (movl (:%l src) (:%l temp))
5261 (shrl (:$ub x8664::fixnumshift) (:%l temp))
5262 (andl (:$b x8664::fulltagmask) (:%l temp))
5263 (movl (:$l (logior (ash 1 x8664::fulltag-immheader-0)
5264 (ash 1 x8664::fulltag-immheader-1)
5265 (ash 1 x8664::fulltag-immheader-2))) (:%l mask))
5266 (btl (:%l temp) (:%l mask))
5267 (movl (:$l 0) (:%l mask))
5268 ((:not (:pred =
5269 (:apply %hard-regspec-value dest)
5270 (:apply %hard-regspec-value src)))
5271 (movl (:%l src) (:%l dest)))
5272 (cmovael (:%l mask) (:%l dest)))
5273
5274(define-x8664-vinsn gvector-typecode-p (((dest :lisp))
5275 ((src :lisp))
5276 ((temp :u32)
5277 (mask :u32)))
5278 (movl (:%l src) (:%l temp))
5279 (shrl (:$ub x8664::fixnumshift) (:%l temp))
5280 (andl (:$b x8664::fulltagmask) (:%l temp))
5281 (movl (:$l (logior (ash 1 x8664::fulltag-nodeheader-0)
5282 (ash 1 x8664::fulltag-nodeheader-1))) (:%l mask))
5283 (btl (:%l temp) (:%l mask))
5284 (movl (:$l 0) (:%l mask))
5285 ((:not (:pred =
5286 (:apply %hard-regspec-value dest)
5287 (:apply %hard-regspec-value src)))
5288 (movl (:%l src) (:%l dest)))
5289 (cmovael (:%l mask) (:%l dest)))
5290
5291(define-x8664-vinsn %complex-single-float-realpart
5292 (((dest :single-float))
5293 ((src :complex-single-float)))
5294 ((:not (:pred =
5295 (:apply %hard-regspec-value dest)
5296 (:apply %hard-regspec-value src)))
5297 (movss (:%xmm src) (:%xmm dest))))
5298
5299(define-x8664-vinsn %complex-single-float-imagpart
5300 (((dest :single-float))
5301 ((src :complex-single-float)))
5302 ((:not (:pred = (:apply %hard-regspec-value src ) (:apply %hard-regspec-value dest)))
5303 (movapd (:%xmm src) (:%xmm dest)))
5304 (psrlq (:$ub 32) (:%xmm dest)))
5305
5306(define-x8664-vinsn %complex-double-float-realpart
5307 (((dest :double-float))
5308 ((src :complex-double-float)))
5309 ((:not (:pred =
5310 (:apply %hard-regspec-value dest)
5311 (:apply %hard-regspec-value src)))
5312 (movsd (:%xmm src) (:%xmm dest))))
5313
5314(define-x8664-vinsn %complex-double-float-imagpart
5315 (((dest :double-float))
5316 ((src :complex-double-float)))
5317 ((:not (:pred = (:apply %hard-regspec-value src ) (:apply %hard-regspec-value dest)))
5318 (movapd (:%xmm src) (:%xmm dest)))
5319 (shufpd (:$ub 1) (:%xmm target::fpzero) (:%xmm dest)))
5320
5321
5322(define-x8664-vinsn %make-complex-single-float
5323 (((dest :complex-single-float))
5324 ((r :single-float)
5325 (i :single-float)))
5326 ((:not (:pred = (:apply %hard-regspec-value r) (:apply %hard-regspec-value dest)))
5327 (movss (:%xmm r) (:%xmm dest)))
5328 (unpcklps (:%xmm i) (:%xmm dest)))
5329
5330(define-x8664-vinsn %make-complex-double-float
5331 (((dest :complex-double-float))
5332 ((r :double-float)
5333 (i :double-float)))
5334 ((:not (:pred = (:apply %hard-regspec-value r) (:apply %hard-regspec-value dest)))
5335 (:movupd (:%xmm r) (:%xmm dest)))
5336 (shufpd (:$ub 0) (:%xmm i) (:%xmm dest)))
5337
5338
5339
5340
5341(queue-fixup
5342 (fixup-x86-vinsn-templates
5343 *x8664-vinsn-templates*
5344 x86::*x86-opcode-template-lists* *x8664-backend*))
5345
5346
5347(provide "X8664-VINSNS")
5348
Note: See TracBrowser for help on using the repository browser.