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

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

Last change on this file was 16144, checked in by Gary Byers, 10 years ago

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