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

source: release/1.5/source/compiler/X86/X8664/x8664-vinsns.lisp

Last change on this file was 14257, checked in by Gary Byers, 14 years ago

Add missing vinsn attrs, in 1.5 branch.

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