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

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

Last change on this file was 16084, checked in by Gary Byers, 11 years ago

ungarble use of :rcontext in nfp vinsns.

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