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

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

Last change on this file was 13222, checked in by R. Matthew Emerson, 15 years ago

Merge r13221 (fix to MISC-SET-C-SINGLE-FLOAT) to 1.4 branch.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 161.4 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) (()
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;;; This handles the 1-bit overflow from addition/subtraction/unary negation
1246(define-x8664-vinsn set-bigits-and-header-for-fixnum-overflow
1247 (()
1248 ((val :lisp)
1249 (no-overflow
1250 :label))
1251 ((header (:u64 #.x8664::imm0))
1252 (scaled-size (:u64 #.x8664::imm1))))
1253 (jno no-overflow)
1254 (movq (:%q val) (:%q scaled-size))
1255 (sarq (:$ub x8664::fixnumshift) (:%q scaled-size))
1256 (movq (:$q #xe000000000000000) (:%q header))
1257 (xorq (:%q header) (:%q scaled-size))
1258 (movd (:%q scaled-size) (:%mmx x8664::mm0))
1259 (movq (:$l x8664::two-digit-bignum-header) (:%q header))
1260 (movq (:$l (- 16 x8664::fulltag-misc)) (:%q scaled-size)))
1261
1262(define-x8664-vinsn %set-z-flag-if-s64-fits-in-fixnum (((dest :imm))
1263 ((src :s64))
1264 ((temp :s64)))
1265 (movq (:%q src) (:%q temp))
1266 (shlq (:$ub x8664::fixnumshift) (:%q temp))
1267 (movq (:%q temp) (:%q dest)) ; tagged as a fixnum
1268 (sarq (:$ub x8664::fixnumshift) (:%q temp))
1269 (cmpq (:%q src) (:%q temp)))
1270
1271(define-x8664-vinsn %set-z-flag-if-u64-fits-in-fixnum (((dest :imm))
1272 ((src :u64))
1273 ((temp :u64)))
1274 (movq (:%q src) (:%q temp))
1275 (shlq (:$ub (1+ x8664::fixnumshift)) (:%q temp))
1276 (movq (:%q temp) (:%q dest)) ; tagged as an even fixnum
1277 (shrq (:$ub (1+ x8664::fixnumshift)) (:%q temp))
1278 (shrq (:%q dest))
1279 (cmpq (:%q src) (:%q temp))
1280 :done)
1281
1282
1283(define-x8664-vinsn setup-bignum-alloc-for-s64-overflow (()
1284 ((src :s64)))
1285 (movd (:%q src) (:%mmx x8664::mm0))
1286 (movl (:$l x8664::two-digit-bignum-header) (:%l x8664::imm0.l))
1287 (movl (:$l (- 16 x8664::fulltag-misc)) (:%l x8664::imm1.l)))
1288
1289
1290;;; If the sign bit is set in SRC, need to make a 3-digit bignum
1291;;; that requires 32 bytes of aligned memory
1292(define-x8664-vinsn setup-bignum-alloc-for-u64-overflow (()
1293 ((src :s64)))
1294 (testq (:%q src) (:%q src))
1295 (movd (:%q src) (:%mmx x8664::mm0))
1296 (movl (:$l x8664::two-digit-bignum-header) (:%l x8664::imm0.l))
1297 (movl (:$l (- 16 x8664::fulltag-misc)) (:%l x8664::imm1.l))
1298 (jns :done)
1299 (movl (:$l x8664::three-digit-bignum-header) (:%l x8664::imm0.l))
1300 (movl (:$l (- 32 x8664::fulltag-misc)) (:%l x8664::imm1.l))
1301 :done)
1302
1303
1304
1305(define-x8664-vinsn %allocate-uvector (((dest :lisp))
1306 ()
1307 ((header (:u64 #.x8664::imm0))
1308 (freeptr (:lisp #.x8664::allocptr))))
1309 (subq (:%q x8664::imm1) (:rcontext x8664::tcr.save-allocptr))
1310 (movq (:rcontext x8664::tcr.save-allocptr) (:%q freeptr))
1311 (rcmpq (:%q freeptr) (:rcontext x8664::tcr.save-allocbase))
1312 (:byte #x77) (:byte #x02) ;(ja :no-trap)
1313 (uuo-alloc)
1314 :no-trap
1315 (movq (:%q header) (:@ x8664::misc-header-offset (:%q freeptr)))
1316 (andb (:$b (lognot x8664::fulltagmask)) (:rcontext x8664::tcr.save-allocptr))
1317 ((:not (:pred = freeptr
1318 (:apply %hard-regspec-value dest)))
1319 (movq (:%q freeptr) (:%q dest))))
1320
1321(define-x8664-vinsn set-bigits-after-fixnum-overflow (()
1322 ((bignum :lisp)))
1323 (movq (:%mmx x8664::mm0) (:@ x8664::misc-data-offset (:%q bignum))))
1324
1325
1326(define-x8664-vinsn box-fixnum (((dest :imm))
1327 ((src :s8)))
1328 (imulq (:$b x8664::fixnumone) (:%q src)(:%q dest)))
1329
1330
1331(define-x8664-vinsn (fix-fixnum-overflow-ool :call)
1332 (((val :lisp))
1333 ((val :lisp))
1334 ((unboxed (:s64 #.x8664::imm1))
1335 (header (:u64 #.x8664::imm0))
1336 (entry (:label 1))))
1337 (jo :overflow)
1338 :done
1339 (:uuo-section)
1340 ((:not (:pred = x8664::arg_z
1341 (:apply %hard-regspec-value val)))
1342 :overflow
1343 (movq (:%q val) (:%q x8664::arg_z)))
1344 (:talign 4)
1345 ((:pred = x8664::arg_z
1346 (:apply %hard-regspec-value val))
1347 :overflow)
1348 (call (:@ .SPfix-overflow))
1349 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
1350 ((:not (:pred = x8664::arg_z
1351 (:apply %hard-regspec-value val)))
1352 (movq (:%q x8664::arg_z) (:%q val)))
1353 (jmp :done))
1354
1355(define-x8664-vinsn (fix-fixnum-overflow-ool-and-branch :call)
1356 (((val :lisp))
1357 ((val :lisp)
1358 (lab :label))
1359 ((unboxed (:s64 #.x8664::imm1))
1360 (header (:u64 #.x8664::imm0))
1361 (entry (:label 1))))
1362 (jo :overflow)
1363 (jmp lab)
1364 (:uuo-section)
1365 ((:not (:pred = x8664::arg_z
1366 (:apply %hard-regspec-value val)))
1367 :overflow
1368 (movq (:%q val) (:%q x8664::arg_z)))
1369 (:talign 4)
1370 ((:pred = x8664::arg_z
1371 (:apply %hard-regspec-value val))
1372 :overflow)
1373 (call (:@ .SPfix-overflow))
1374 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
1375 ((:not (:pred = x8664::arg_z
1376 (:apply %hard-regspec-value val)))
1377 (movq (:%q x8664::arg_z) (:%q val)))
1378 (jmp lab))
1379
1380(define-x8664-vinsn add-constant (((dest :imm))
1381 ((dest :imm)
1382 (const :s32const)))
1383 ((:and (:pred >= const -128) (:pred <= const 127))
1384 (addq (:$b const) (:%q dest)))
1385 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1386 (addq (:$l const) (:%q dest))))
1387
1388(define-x8664-vinsn add-constant3 (((dest :imm))
1389 ((src :imm)
1390 (const :s32const)))
1391 ((:pred = (:apply %hard-regspec-value dest)
1392 (:apply %hard-regspec-value src))
1393 ((:and (:pred >= const -128) (:pred <= const 127))
1394 (addq (:$b const) (:%q dest)))
1395 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1396 (addq (:$l const) (:%q dest))))
1397 ((:not (:pred = (:apply %hard-regspec-value dest)
1398 (:apply %hard-regspec-value src)))
1399 (leaq (:@ const (:%q src)) (:%q dest))))
1400
1401
1402
1403(define-x8664-vinsn fixnum-add2 (((dest :imm))
1404 ((dest :imm)
1405 (other :imm)))
1406 (addq (:%q other) (:%q dest)))
1407
1408(define-x8664-vinsn fixnum-sub2 (((dest :imm))
1409 ((x :imm)
1410 (y :imm))
1411 ((temp :imm)))
1412 (movq (:%q x) (:%q temp))
1413 (subq (:%q y) (:%q temp))
1414 (movq (:%q temp) (:%q dest)))
1415
1416
1417
1418(define-x8664-vinsn fixnum-add3 (((dest :imm))
1419 ((x :imm)
1420 (y :imm)))
1421
1422 ((:pred =
1423 (:apply %hard-regspec-value x)
1424 (:apply %hard-regspec-value dest))
1425 (addq (:%q y) (:%q dest)))
1426 ((:not (:pred =
1427 (:apply %hard-regspec-value x)
1428 (:apply %hard-regspec-value dest)))
1429 ((:pred =
1430 (:apply %hard-regspec-value y)
1431 (:apply %hard-regspec-value dest))
1432 (addq (:%q x) (:%q dest)))
1433 ((:not (:pred =
1434 (:apply %hard-regspec-value y)
1435 (:apply %hard-regspec-value dest)))
1436 (leaq (:@ (:%q x) (:%q y)) (:%q dest)))))
1437
1438(define-x8664-vinsn copy-gpr (((dest t))
1439 ((src t)))
1440 ((:not (:pred =
1441 (:apply %hard-regspec-value dest)
1442 (:apply %hard-regspec-value src)))
1443 (movq (:%q src) (:%q dest))))
1444
1445(define-x8664-vinsn (vpop-register :pop :node :vsp)
1446 (((dest :lisp))
1447 ())
1448 (popq (:%q dest)))
1449
1450
1451(define-x8664-vinsn (push-argregs :push :node :vsp) (()
1452 ())
1453 (testl (:%l x8664::nargs) (:%l x8664::nargs))
1454 (jz :done)
1455 (rcmpl (:%l x8664::nargs) (:$b (* 2 x8664::node-size)))
1456 (jb :one)
1457 (je :two)
1458 (pushq (:%q x8664::arg_x))
1459 :two
1460 (pushq (:%q x8664::arg_y))
1461 :one
1462 (pushq (:%q x8664::arg_z))
1463 :done)
1464
1465(define-x8664-vinsn (push-max-argregs :push :node :vsp) (()
1466 ((max :u32const)))
1467 ((:pred >= max 3)
1468 (testl (:%l x8664::nargs) (:%l x8664::nargs))
1469 (jz :done)
1470 (rcmpl (:%l x8664::nargs) (:$b (* 2 x8664::node-size)))
1471 (jb :one)
1472 (je :two)
1473 (pushq (:%q x8664::arg_x))
1474 :two
1475 (pushq (:%q x8664::arg_y))
1476 :one
1477 (pushq (:%q x8664::arg_z))
1478 :done)
1479 ((:pred = max 2)
1480 (rcmpl (:%l x8664::nargs) (:$b (* 1 x8664::node-size)))
1481 (jb :done)
1482 (je :one)
1483 (pushq (:%q x8664::arg_y))
1484 :one
1485 (pushq (:%q x8664::arg_z))
1486 :done)
1487 ((:pred = max 1)
1488 (testl (:%l x8664::nargs) (:%l x8664::nargs))
1489 (je :done)
1490 (pushq (:%q x8664::arg_z))
1491 :done))
1492
1493(define-x8664-vinsn (call-label :call) (()
1494 ((label :label))
1495 ((entry (:label 1))))
1496 (:talign 4)
1497 (call label)
1498 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1499
1500(define-x8664-vinsn double-float-compare (()
1501 ((arg0 :double-float)
1502 (arg1 :double-float)))
1503 (comisd (:%xmm arg1) (:%xmm arg0)))
1504
1505(define-x8664-vinsn single-float-compare (()
1506 ((arg0 :single-float)
1507 (arg1 :single-float)))
1508 (comiss (:%xmm arg1) (:%xmm arg0)))
1509
1510
1511(define-x8664-vinsn double-float+-2 (((result :double-float))
1512 ((x :double-float)
1513 (y :double-float)))
1514 ((:pred =
1515 (:apply %hard-regspec-value result)
1516 (:apply %hard-regspec-value x))
1517 (addsd (:%xmm y) (:%xmm result)))
1518 ((:and (:not (:pred =
1519 (:apply %hard-regspec-value result)
1520 (:apply %hard-regspec-value x)))
1521 (:pred =
1522 (:apply %hard-regspec-value result)
1523 (:apply %hard-regspec-value y)))
1524 (addsd (:%xmm x) (:%xmm result)))
1525 ((:and (:not (:pred =
1526 (:apply %hard-regspec-value result)
1527 (:apply %hard-regspec-value x)))
1528 (:not (:pred =
1529 (:apply %hard-regspec-value result)
1530 (:apply %hard-regspec-value y))))
1531 (movsd (:%xmm x) (:%xmm result))
1532 (addsd (:%xmm y) (:%xmm result))))
1533
1534;;; Caller guarantees (not (eq y result))
1535(define-x8664-vinsn double-float--2 (((result :double-float))
1536 ((x :double-float)
1537 (y :double-float)))
1538 ((:not (:pred = (:apply %hard-regspec-value result)
1539 (:apply %hard-regspec-value x)))
1540 (movsd (:%xmm x) (:%xmm result)))
1541 (subsd (:%xmm y) (:%xmm result)))
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 (mulsd (:%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 (mulsd (:%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 (mulsd (:%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 (divsd (:%xmm y) (:%xmm result)))
1574
1575(define-x8664-vinsn single-float+-2 (((result :single-float))
1576 ((x :single-float)
1577 (y :single-float)))
1578 ((:pred =
1579 (:apply %hard-regspec-value result)
1580 (:apply %hard-regspec-value x))
1581 (addss (:%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 (addss (:%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 (movss (:%xmm x) (:%xmm result))
1596 (addss (:%xmm y) (:%xmm result))))
1597
1598;;; Caller guarantees (not (eq y result))
1599(define-x8664-vinsn single-float--2 (((result :single-float))
1600 ((x :single-float)
1601 (y :single-float)))
1602 ((:not (:pred = (:apply %hard-regspec-value result)
1603 (:apply %hard-regspec-value x)))
1604 (movss (:%xmm x) (:%xmm result)))
1605 (subss (:%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 (mulss (:%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 (mulss (:%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 (mulss (:%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 (divss (:%xmm y) (:%xmm result)))
1638
1639(define-x8664-vinsn get-single (((result :single-float))
1640 ((source :lisp)))
1641 (movd (:%q source) (:%xmm result))
1642 (psrlq (:$ub 32) (:%xmm result)))
1643
1644(define-x8664-vinsn get-double (((result :double-float))
1645 ((source :lisp)))
1646 (movsd (:@ x8664::double-float.value (:%q source)) (:%xmm result)))
1647
1648;;; Extract a double-float value, typechecking in the process.
1649;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1650;;; instead of replicating it ..
1651
1652(define-x8664-vinsn get-double? (((target :double-float))
1653 ((source :lisp))
1654 ((tag :u8)))
1655 :resume
1656 (movl (:%l source) (:%l tag))
1657 (andl (:$b x8664::tagmask) (:%l tag))
1658 (cmpl (:$b x8664::tag-misc) (:%l tag))
1659 (jne :have-tag)
1660 (movsbl (:@ x8664::misc-subtag-offset (:%q source)) (:%l tag))
1661 :have-tag
1662 (cmpl (:$b x8664::subtag-double-float) (:%l tag))
1663 (jne :bad)
1664 (movsd (:@ x8664::double-float.value (:%q source)) (:%xmm target))
1665
1666 (:anchored-uuo-section :resume)
1667 :bad
1668 (:anchored-uuo (uuo-error-reg-not-tag (:%q source) (:$ub x8664::subtag-double-float))))
1669
1670(define-x8664-vinsn single->node (((result :lisp)
1671 (source :single-float))
1672 ((source :single-float)))
1673 (psllq (:$ub 32) (:%xmm source))
1674 (movd (:%xmm source) (:%q result))
1675 (movb (:$b x8664::tag-single-float) (:%b result)))
1676
1677(define-x8664-vinsn copy-double-float (((dest :double-float))
1678 ((src :double-float)))
1679 (movsd (:%xmm src) (:%xmm dest)))
1680
1681(define-x8664-vinsn copy-single-float (((dest :single-float))
1682 ((src :single-float)))
1683 (movss (:%xmm src) (:%xmm dest)))
1684
1685
1686(define-x8664-vinsn copy-single-to-double (((dest :double-float))
1687 ((src :single-float)))
1688 (cvtss2sd (:%xmm src) (:%xmm dest)))
1689
1690(define-x8664-vinsn copy-double-to-single (((dest :single-float))
1691 ((src :double-float)))
1692 (cvtsd2ss (:%xmm src) (:%xmm dest)))
1693
1694(define-x8664-vinsn u8->fixnum (((result :imm))
1695 ((val :u8))
1696 ())
1697 (leaq (:@ (:%q val) 8) (:%q result)))
1698
1699(define-x8664-vinsn fitvals (()
1700 ((n :u16const))
1701 ((imm :u16)))
1702 ((:pred = n 0)
1703 (xorl (:%l imm) (:%l imm)))
1704 ((:not (:pred = n 0))
1705 (movl (:$l (:apply ash n x8664::fixnumshift)) (:%l imm)))
1706 (subl (:%l x8664::nargs) (:%l imm))
1707 (jae :push-more)
1708 (movslq (:%l imm) (:%q imm))
1709 (subq (:%q imm) (:%q x8664::rsp))
1710 (jmp :done)
1711 :push-loop
1712 (pushq (:$l (:apply target-nil-value)))
1713 (addl (:$b x8664::node-size) (:%l x8664::nargs))
1714 (subl (:$b x8664::node-size) (:%l imm))
1715 :push-more
1716 (jne :push-loop)
1717 :done)
1718
1719(define-x8664-vinsn (nvalret :jumpLR) (()
1720 ())
1721
1722 (jmp (:@ .SPnvalret)))
1723
1724
1725(define-x8664-vinsn lisp-word-ref (((dest t))
1726 ((base t)
1727 (offset t)))
1728 (movq (:@ (:%q base) (:%q offset)) (:%q dest)))
1729
1730
1731(define-x8664-vinsn lisp-word-ref-c (((dest t))
1732 ((base t)
1733 (offset :s32const)))
1734 ((:pred = offset 0)
1735 (movq (:@ (:%q base)) (:%q dest)))
1736 ((:not (:pred = offset 0))
1737 (movq (:@ offset (:%q base)) (:%q dest))))
1738
1739
1740(define-x8664-vinsn (vpush-label :push :node :vsp) (()
1741 ((label :label)))
1742 (leaq (:@ (:^ label) (:%q x8664::fn)) (:%q x8664::ra0))
1743 (pushq (:%q x8664::ra0)))
1744
1745;; ????
1746(define-x8664-vinsn emit-aligned-label (()
1747 ((label :label)))
1748 (:align 3)
1749 (:long (:^ label)))
1750
1751;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1752(define-x8664-vinsn pass-multiple-values-symbol (()
1753 ())
1754 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
1755 (jmp (:@ x8664::symbol.fcell (:% x8664::fname))))
1756
1757;;; It'd be good to have a variant that deals with a known function
1758;;; as well as this.
1759(define-x8664-vinsn pass-multiple-values (()
1760 ()
1761 ((tag :u8)))
1762 :resume
1763 (movl (:%l x8664::temp0) (:%l tag))
1764 (andl (:$b x8664::fulltagmask) (:%l tag))
1765 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
1766 (cmovgq (:%q x8664::temp0) (:%q x8664::fn))
1767 (jl :bad)
1768 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::fn))
1769 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
1770 (jmp (:%q x8664::fn))
1771
1772 (:anchored-uuo-section :resume)
1773 :bad
1774 (:anchored-uuo (uuo-error-not-callable)))
1775
1776
1777
1778(define-x8664-vinsn reserve-outgoing-frame (()
1779 ())
1780 (pushq (:$b x8664::reserved-frame-marker))
1781 (pushq (:$b x8664::reserved-frame-marker)))
1782
1783
1784(define-x8664-vinsn (call-known-function :call) (()
1785 ()
1786 ((entry (:label 1))))
1787 (:talign 4)
1788 (call (:%q x8664::temp0))
1789 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1790
1791(define-x8664-vinsn (jump-known-function :jumplr) (()
1792 ())
1793 (movq (:%q x8664::fn) (:%q x8664::xfn))
1794 (movq (:%q x8664::temp0) (:%q x8664::fn))
1795 (jmp (:%q x8664::fn)))
1796
1797(define-x8664-vinsn (list :call) (()
1798 ()
1799 ((entry (:label 1))))
1800 (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
1801 (:talign 4)
1802 (jmp (:@ .SPconslist))
1803 :back
1804 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1805
1806
1807(define-x8664-vinsn make-tsp-cons (((dest :lisp))
1808 ((car :lisp) (cdr :lisp))
1809 ((temp :imm)))
1810 (subq (:$b (+ x8664::cons.size x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
1811 (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
1812 (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
1813 (movapd (:%xmm x8664::fpzero) (:@ 16 (:%q temp)))
1814 (movq (:rcontext x8664::tcr.save-tsp) (:%mmx x8664::stack-temp))
1815 (movq (:%mmx x8664::stack-temp) (:@ (:%q temp)))
1816 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
1817 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
1818 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-cons) (:%q temp)) (:%q temp))
1819 (movq (:%q car) (:@ x8664::cons.car (:%q temp)))
1820 (movq (:%q cdr) (:@ x8664::cons.cdr (:%q temp)))
1821 (movq (:%q temp) (:%q dest)))
1822
1823(define-x8664-vinsn make-fixed-stack-gvector (((dest :lisp))
1824 ((aligned-size :u32const)
1825 (header :s32const))
1826 ((tempa :imm)
1827 (tempb :imm)))
1828 ((:and (:pred >= (:apply + aligned-size x8664::dnode-size) -128)
1829 (:pred <= (:apply + aligned-size x8664::dnode-size) 127))
1830 (subq (:$b (:apply + aligned-size x8664::dnode-size))
1831 (:rcontext x8664::tcr.next-tsp)))
1832 ((:not (:and (:pred >= (:apply + aligned-size x8664::dnode-size) -128)
1833 (:pred <= (:apply + aligned-size x8664::dnode-size) 127)))
1834 (subq (:$l (:apply + aligned-size x8664::dnode-size))
1835 (:rcontext x8664::tcr.next-tsp)))
1836 (movq (:rcontext x8664::tcr.save-tsp) (:%q tempb))
1837 (movq (:rcontext x8664::tcr.next-tsp) (:%q tempa))
1838 (movd (:%q tempb) (:%mmx x8664::stack-temp))
1839 :loop
1840 (movapd (:%xmm x8664::fpzero) (:@ -16 (:%q tempb)))
1841 (subq (:$b x8664::dnode-size) (:%q tempb))
1842 (cmpq (:%q tempa) (:%q tempb))
1843 (jnz :loop)
1844 (movq (:%mmx x8664::stack-temp) (:@ (:%q tempa)))
1845 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q tempa)))
1846 (movq (:%q tempa) (:rcontext x8664::tcr.save-tsp))
1847 (movl (:$l header) (:@ x8664::dnode-size (:%q tempa)))
1848 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q tempa)) (:%q dest)))
1849
1850
1851(define-x8664-vinsn (discard-temp-frame :tsp :pop :discard) (()
1852 ()
1853 ((temp :imm)))
1854 (movq (:rcontext x8664::tcr.save-tsp) (:%q temp))
1855 (movq (:@ (:%q temp)) (:%q temp))
1856 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
1857 (movq (:%q temp) (:rcontext x8664::tcr.next-tsp))
1858 )
1859
1860(define-x8664-vinsn (discard-c-frame :csp :pop :discard) (()
1861 ()
1862 ((temp :imm)))
1863 (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
1864 (movq (:@ (:%q temp)) (:%q temp))
1865 (movq (:%q temp) (:rcontext x8664::tcr.foreign-sp)))
1866
1867
1868(define-x8664-vinsn (vstack-discard :vsp :pop :discard) (()
1869 ((nwords :u32const)))
1870 ((:not (:pred = nwords 0))
1871 ((:pred < nwords 16)
1872 (addq (:$b (:apply ash nwords x8664::word-shift)) (:%q x8664::rsp)))
1873 ((:not (:pred < nwords 16))
1874 (addq (:$l (:apply ash nwords x8664::word-shift)) (:%q x8664::rsp)))))
1875
1876
1877(defmacro define-x8664-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1878 `(define-x8664-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1879 (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
1880 (:talign 4)
1881 (jmp (:@ ,spno))
1882 :back
1883 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
1884
1885(defmacro define-x8664-subprim-call-vinsn ((name &rest other-attrs) spno)
1886 `(define-x8664-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1887 (:talign 4)
1888 (call (:@ ,spno))
1889 :back
1890 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
1891
1892(defmacro define-x8664-subprim-jump-vinsn ((name &rest other-attrs) spno)
1893 `(define-x8664-vinsn (,name :jumpLR ,@other-attrs) (() ())
1894 (jmp (:@ ,spno))))
1895
1896(define-x8664-vinsn (nthrowvalues :call :subprim-call) (()
1897 ((lab :label)))
1898 (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q x8664::ra0))
1899 (jmp (:@ .SPnthrowvalues)))
1900
1901(define-x8664-vinsn (nthrow1value :call :subprim-call) (()
1902 ((lab :label)))
1903 (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q x8664::ra0))
1904 (jmp (:@ .SPnthrow1value)))
1905
1906
1907(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1908
1909(define-x8664-vinsn bind-interrupt-level-0-inline (()
1910 ()
1911 ((temp :imm)))
1912 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
1913 (cmpq (:$b 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
1914 (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
1915 (pushq (:$b x8664::interrupt-level-binding-index))
1916 (pushq (:rcontext x8664::tcr.db-link))
1917 (movq (:$l 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
1918 (movq (:%q x8664::rsp) (:rcontext x8664::tcr.db-link))
1919 (jns :done)
1920 (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
1921 (jae :done)
1922 (ud2a)
1923 (:byte 2)
1924 :done)
1925
1926
1927
1928(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1929
1930(define-x8664-vinsn bind-interrupt-level-m1-inline (()
1931 ()
1932 ((temp :imm)))
1933 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
1934 (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
1935 (pushq (:$b x8664::interrupt-level-binding-index))
1936 (pushq (:rcontext x8664::tcr.db-link))
1937 (movq (:$l (ash -1 x8664::fixnumshift)) (:@ x8664::interrupt-level-binding-index (:%q temp)))
1938 (movq (:%q x8664::rsp) (:rcontext x8664::tcr.db-link)))
1939
1940(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1941
1942(define-x8664-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1943
1944(define-x8664-vinsn unbind-interrupt-level-inline (()
1945 ()
1946 ((link :imm)
1947 (curval :imm)
1948 (oldval :imm)
1949 (tlb :imm)))
1950 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q tlb))
1951 (movq (:rcontext x8664::tcr.db-link) (:%q link))
1952 (movq (:@ x8664::interrupt-level-binding-index (:%q tlb)) (:%q curval))
1953 (testq (:%q curval) (:%q curval))
1954 (movq (:@ 16 #|binding.val|# (:%q link)) (:%q oldval))
1955 (movq (:@ #|binding.link|# (:%q link)) (:%q link))
1956 (movq (:%q oldval) (:@ x8664::interrupt-level-binding-index (:%q tlb)))
1957 (movq (:%q link) (:rcontext x8664::tcr.db-link))
1958 (jns :done)
1959 (testq (:%q oldval) (:%q oldval))
1960 (js :done)
1961 (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
1962 (jae :done)
1963 (ud2a)
1964 (:byte 2)
1965 :done)
1966
1967(define-x8664-vinsn (jump-return-pc :jumpLR)
1968 (()
1969 ())
1970 (ret))
1971
1972(define-x8664-vinsn (nmkcatchmv :call :subprim-call) (()
1973 ((lab :label))
1974 ((entry (:label 1))))
1975 (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q x8664::xfn))
1976 (:talign 4)
1977 (call (:@ .SPmkcatchmv))
1978 :back
1979 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1980
1981(define-x8664-vinsn (nmkcatch1v :call :subprim-call) (()
1982 ((lab :label))
1983 ((entry (:label 1))))
1984 (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q x8664::xfn))
1985 (:talign 4)
1986 (call (:@ .SPmkcatch1v))
1987 :back
1988 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
1989
1990
1991(define-x8664-vinsn (make-simple-unwind :call :subprim-call) (()
1992 ((protform-lab :label)
1993 (cleanup-lab :label)))
1994 (leaq (:@ (:^ protform-lab) (:%q x8664::fn)) (:%q x8664::ra0))
1995 (leaq (:@ (:^ cleanup-lab) (:%q x8664::fn)) (:%q x8664::xfn))
1996 (jmp (:@ .SPmkunwind)))
1997
1998(define-x8664-vinsn (nmkunwind :call :subprim-call) (()
1999 ((protform-lab :label)
2000 (cleanup-lab :label)))
2001 (leaq (:@ (:^ protform-lab) (:%q x8664::fn)) (:%q x8664::ra0))
2002 (leaq (:@ (:^ cleanup-lab) (:%q x8664::fn)) (:%q x8664::xfn))
2003 (jmp (:@ .SPnmkunwind)))
2004
2005;;; "old" mkunwind. Used by PROGV, since the binding of *interrupt-level*
2006;;; on entry to the new mkunwind confuses the issue.
2007
2008(define-x8664-vinsn (mkunwind :call :subprim-call) (()
2009 ((protform-lab :label)
2010 (cleanup-lab :label)))
2011 (leaq (:@ (:^ protform-lab) (:%q x8664::fn)) (:%q x8664::ra0))
2012 (leaq (:@ (:^ cleanup-lab) (:%q x8664::fn)) (:%q x8664::xfn))
2013 (jmp (:@ .SPmkunwind)))
2014
2015(define-x8664-subprim-lea-jmp-vinsn (gvector) .SPgvector)
2016
2017(define-x8664-subprim-call-vinsn (getu64) .SPgetu64)
2018
2019;;; Call something callable and obtain the single value that it
2020;;; returns.
2021(define-x8664-vinsn funcall (()
2022 ()
2023 ((tag :u8)
2024 (entry (:label 1))))
2025 :resume
2026 (movl (:%l x8664::temp0) (:%l tag))
2027 (andl (:$b x8664::fulltagmask) (:%l tag))
2028 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2029 (cmovgq (:%q x8664::temp0) (:%q x8664::xfn))
2030 (jl :bad)
2031 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::xfn))
2032 (:talign 4)
2033 (call (:%q x8664::xfn))
2034 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
2035 (:anchored-uuo-section :resume)
2036 :bad
2037 (:anchored-uuo (uuo-error-not-callable)))
2038
2039(define-x8664-vinsn tail-funcall (()
2040 ()
2041 ((tag (:u8 #.x8664::imm0))))
2042 :resume
2043 (movl (:%l x8664::temp0) (:%l tag))
2044 (andl (:$b x8664::fulltagmask) (:%l tag))
2045 (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2046 (cmovgq (:%q x8664::temp0) (:%q x8664::xfn))
2047 (jl :bad)
2048 (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::xfn))
2049 (jmp (:%q x8664::xfn))
2050
2051 (:anchored-uuo-section :resume)
2052 :bad
2053 (:anchored-uuo (uuo-error-not-callable)))
2054
2055
2056
2057;;; Magic numbers in here include the address of .SPcall-closure.
2058(define-x8664-vinsn init-nclosure (()
2059 ((closure :lisp))
2060 ((imm0 :u64)))
2061 (movq (:$q #x24fffffffff92d8d) (:%q imm0))
2062 (movb (:$b 4) (:@ x8664::misc-data-offset (:%q closure))) ; code word count
2063 (movb (:$b #x4c) (:@ (+ x8664::misc-data-offset 7) (:%q closure))) ; 1st byte of lea
2064 (movq (:%q imm0) (:@ (+ x8664::misc-data-offset 8) (:%q closure))) ; rest of lea, start of jmp
2065 (movl (:$l #x01516825) (:@ (+ x8664::misc-data-offset 16) (:%q closure)))
2066 (movb (:$b x8664::function-boundary-marker) (:@ (+ x8664::misc-data-offset 24) (:%q closure))))
2067
2068
2069(define-x8664-vinsn finalize-closure (((closure :lisp))
2070 ((closure :lisp)))
2071 (addq (:$b (- x8664::fulltag-function x8664::fulltag-misc)) (:%q closure)))
2072
2073
2074(define-x8664-vinsn (ref-symbol-value :call :subprim-call)
2075 (((val :lisp))
2076 ((sym (:lisp (:ne val))))
2077 ((entry (:label 1))))
2078 (:talign 4)
2079 (call (:@ .SPspecrefcheck))
2080 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)) )
2081
2082(define-x8664-vinsn ref-symbol-value-inline (((dest :lisp))
2083 ((src (:lisp (:ne dest))))
2084 ((table :imm)
2085 (idx :imm)))
2086 :resume
2087 (movq (:@ x8664::symbol.binding-index (:%q src)) (:%q idx))
2088 (rcmpq (:%q idx) (:rcontext x8664::tcr.tlb-limit))
2089 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q table))
2090 (jae :symbol)
2091 (movq (:@ (:%q table) (:%q idx)) (:%q dest))
2092 (cmpl (:$b x8664::subtag-no-thread-local-binding) (:%l dest))
2093 (jne :test)
2094 :symbol
2095 (movq (:@ x8664::symbol.vcell (:%q src)) (:%q dest))
2096 :test
2097 (cmpl (:$b x8664::unbound-marker) (:%l dest))
2098 (je :bad)
2099
2100 (:anchored-uuo-section :resume)
2101 :bad
2102 (:anchored-uuo (uuo-error-unbound (:%q src))))
2103
2104
2105(define-x8664-vinsn (%ref-symbol-value :call :subprim-call)
2106 (((val :lisp))
2107 ((sym (:lisp (:ne val))))
2108 ((entry (:label 1))))
2109 (:talign 4)
2110 (call (:@ .SPspecref))
2111 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2112
2113(define-x8664-vinsn %ref-symbol-value-inline (((dest :lisp))
2114 ((src (:lisp (:ne dest))))
2115 ((table :imm)
2116 (idx :imm)))
2117 (movq (:@ x8664::symbol.binding-index (:%q src)) (:%q idx))
2118 (rcmpq (:%q idx) (:rcontext x8664::tcr.tlb-limit))
2119 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q table))
2120 (jae :symbol)
2121 (movq (:@ (:%q table) (:%q idx)) (:%q dest))
2122 (cmpb (:$b x8664::subtag-no-thread-local-binding) (:%b dest))
2123 (jne :done)
2124 :symbol
2125 (movq (:@ x8664::symbol.vcell (:%q src)) (:%q dest))
2126 :done)
2127
2128(define-x8664-vinsn ref-interrupt-level (((dest :imm))
2129 ()
2130 ((temp :u64)))
2131 (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2132 (movq (:@ x8664::INTERRUPT-LEVEL-BINDING-INDEX (:%q temp)) (:%q dest)))
2133
2134
2135
2136
2137(define-x8664-vinsn setup-double-float-allocation (()
2138 ())
2139 (movl (:$l (arch::make-vheader x8664::double-float.element-count x8664::subtag-double-float)) (:%l x8664::imm0.l))
2140 (movl (:$l (- x8664::double-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2141
2142(define-x8664-vinsn set-double-float-value (()
2143 ((node :lisp)
2144 (val :double-float)))
2145 (movsd (:%xmm val) (:@ x8664::double-float.value (:%q node))))
2146
2147(define-x8664-vinsn word-index-and-bitnum-from-index (((word-index :u64)
2148 (bitnum :u8))
2149 ((index :imm)))
2150 (movq (:%q index) (:%q word-index))
2151 (shrq (:$ub x8664::fixnumshift) (:%q word-index))
2152 (movl (:$l 63) (:%l bitnum))
2153 (andl (:%l word-index) (:%l bitnum))
2154 (shrq (:$ub 6) (:%q word-index)))
2155
2156(define-x8664-vinsn ref-bit-vector-fixnum (((dest :imm)
2157 (bitnum :u8))
2158 ((bitnum :u8)
2159 (bitvector :lisp)
2160 (word-index :u64)))
2161 (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector) (:%q word-index) 8))
2162 (setb (:%b bitnum))
2163 (negb (:%b bitnum))
2164 (andl (:$l x8664::fixnumone) (:%l bitnum))
2165 (movl (:%l bitnum) (:%l dest)))
2166
2167(define-x8664-vinsn nref-bit-vector-fixnum (((dest :imm)
2168 (bitnum :s64))
2169 ((bitnum :s64)
2170 (bitvector :lisp))
2171 ())
2172 (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector)))
2173 (setc (:%b bitnum))
2174 (movzbl (:%b bitnum) (:%l bitnum))
2175 (imull (:$b x8664::fixnumone) (:%l bitnum) (:%l dest)))
2176
2177
2178(define-x8664-vinsn nref-bit-vector-flags (()
2179 ((bitnum :s64)
2180 (bitvector :lisp))
2181 ())
2182 (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector))))
2183
2184(define-x8664-vinsn misc-ref-c-bit-fixnum (((dest :imm))
2185 ((src :lisp)
2186 (idx :u64const))
2187 ((temp :u8)))
2188 (btq (:$ub (:apply logand 63 idx))
2189 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
2190 (setc (:%b temp))
2191 (movzbl (:%b temp) (:%l temp))
2192 (imull (:$b x8664::fixnumone) (:%l temp) (:%l dest)))
2193
2194
2195(define-x8664-vinsn misc-ref-c-bit-flags (()
2196 ((src :lisp)
2197 (idx :u64const))
2198 )
2199 (btq (:$ub (:apply logand 63 idx))
2200 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
2201
2202(define-x8664-vinsn deref-macptr (((addr :address))
2203 ((src :lisp))
2204 ())
2205 (movq (:@ x8664::macptr.address (:%q src)) (:%q addr)))
2206
2207(define-x8664-vinsn (temp-push-unboxed-word :push :word :csp)
2208 (()
2209 ((w :u64)))
2210 (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
2211 (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp))
2212 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2213 (movq (:%mmx x8664::stack-temp) (:@ (:%q x8664::ra0)))
2214 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::ra0)))
2215 (movq (:%q w) (:@ x8664::dnode-size (:%q x8664::ra0))))
2216
2217
2218(define-x8664-vinsn (temp-push-node :push :word :tsp)
2219 (()
2220 ((w :lisp))
2221 ((temp :imm)))
2222 (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
2223 (movq (:rcontext x8664::tcr.save-tsp) (:%mmx x8664::stack-temp))
2224 (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
2225 (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
2226 (movapd (:%xmm x8664::fpzero) (:@ 16 (:%q temp)))
2227 (movq (:%mmx x8664::stack-temp) (:@ (:%q temp)))
2228 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
2229 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2230 (movq (:%q w) (:@ x8664::dnode-size (:%q temp))))
2231
2232(define-x8664-vinsn (temp-push-double-float :push :word :csp)
2233 (()
2234 ((f :double-float)))
2235 (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
2236 (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp))
2237 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2238 (movq (:%mmx x8664::stack-temp) (:@ (:%q x8664::ra0)))
2239 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::ra0)))
2240 (movapd (:%xmm f) (:@ x8664::dnode-size (:%q x8664::ra0))))
2241
2242
2243(define-x8664-vinsn (vpush-single-float :push :word :vsp)
2244 (()
2245 ((f :single-float)))
2246 (pushq (:$b x8664::tag-single-float))
2247 (movss (:%xmm f) (:@ 4 (:%q x8664::rsp))))
2248
2249(define-x8664-vinsn (vpop-single-float :pop :word :vsp)
2250 (()
2251 ((f :single-float)))
2252 (movss (:@ 4 (:%q x8664::rsp)) (:%xmm f))
2253 (addq (:$b x8664::node-size) (:%q x8664::rsp)))
2254
2255(define-x8664-vinsn (temp-pop-unboxed-word :pop :word :csp)
2256 (((w :u64))
2257 ())
2258 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2259 (movq (:@ x8664::dnode-size (:%q x8664::ra0)) (:%q w))
2260 (addq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp)))
2261
2262
2263(define-x8664-vinsn (temp-pop-node :pop :word :tsp)
2264 (((w :lisp))
2265 ()
2266 ((temp :imm)))
2267 (movq (:rcontext x8664::tcr.save-tsp) (:%q temp))
2268 (movq (:@ x8664::dnode-size (:%q temp)) (:%q w))
2269 (movq (:@ (:%q temp)) (:%q temp))
2270 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2271 (movq (:%q temp) (:rcontext x8664::tcr.next-tsp)))
2272
2273(define-x8664-vinsn (temp-pop-double-float :pop :word :csp)
2274 (((f :double-float))
2275 ())
2276 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2277 (movapd (:@ x8664::dnode-size (:%q x8664::ra0)) (:%xmm f))
2278 (addq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp)))
2279
2280
2281
2282(define-x8664-vinsn macptr->stack (((dest :lisp))
2283 ((ptr :address)))
2284 (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
2285 (subq (:$b (+ x8664::dnode-size x8664::macptr.size)) (:rcontext x8664::tcr.foreign-sp))
2286 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2287 (movq (:%mmx x8664::stack-temp) (:@ (:%q x8664::ra0)))
2288 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::ra0)))
2289 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q x8664::ra0)) (:%q dest))
2290 (movq (:$l x8664::macptr-header) (:@ x8664::macptr.header (:%q dest)))
2291 (movq (:%q ptr) (:@ x8664::macptr.address (:%q dest)))
2292 (movapd (:%xmm x8664::fpzero) (:@ x8664::macptr.domain (:%q dest))))
2293
2294(define-x8664-vinsn fixnum->signed-natural (((dest :s64))
2295 ((src :imm)))
2296 (movq (:%q src) (:%q dest))
2297 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
2298
2299(define-x8664-vinsn mem-set-double-float (()
2300 ((val :double-float)
2301 (src :address)
2302 (index :s64)))
2303 (movsd (:%xmm val) (:@ (:%q src) (:%q index))))
2304
2305(define-x8664-vinsn mem-set-single-float (()
2306 ((val :single-float)
2307 (src :address)
2308 (index :s64)))
2309 (movss (:%xmm val) (:@ (:%q src) (:%q index))))
2310
2311
2312
2313(define-x8664-vinsn mem-set-c-doubleword (()
2314 ((val :u64)
2315 (dest :address)
2316 (offset :s32const)))
2317 ((:pred = offset 0)
2318 (movq (:%q val) (:@ (:%q dest))))
2319 ((:not (:pred = offset 0))
2320 (movq (:%q val) (:@ offset (:%q dest)))))
2321
2322(define-x8664-vinsn mem-set-c-fullword (()
2323 ((val :u32)
2324 (dest :address)
2325 (offset :s32const)))
2326 ((:pred = offset 0)
2327 (movl (:%l val) (:@ (:%q dest))))
2328 ((:not (:pred = offset 0))
2329 (movl (:%l val) (:@ offset (:%q dest)))))
2330
2331(define-x8664-vinsn mem-set-c-halfword (()
2332 ((val :u16)
2333 (dest :address)
2334 (offset :s32const)))
2335 ((:pred = offset 0)
2336 (movw (:%w val) (:@ (:%q dest))))
2337 ((:not (:pred = offset 0))
2338 (movw (:%w val) (:@ offset (:%q dest)))))
2339
2340(define-x8664-vinsn mem-set-c-byte (()
2341 ((val :u8)
2342 (dest :address)
2343 (offset :s32const)))
2344 ((:pred = offset 0)
2345 (movb (:%b val) (:@ (:%q dest))))
2346 ((:not (:pred = offset 0))
2347 (movb (:%b val) (:@ offset (:%q dest)))))
2348
2349(define-x8664-vinsn mem-set-c-constant-doubleword (()
2350 ((val :s32const)
2351 (dest :address)
2352 (offset :s32const)))
2353 ((:pred = offset 0)
2354 (movq (:$l val) (:@ (:%q dest))))
2355 ((:not (:pred = offset 0))
2356 (movq (:$l val) (:@ offset (:%q dest)))))
2357
2358(define-x8664-vinsn mem-set-c-constant-fullword (()
2359 ((val :s32const)
2360 (dest :address)
2361 (offset :s32const)))
2362 ((:pred = offset 0)
2363 (movl (:$l val) (:@ (:%q dest))))
2364 ((:not (:pred = offset 0))
2365 (movl (:$l val) (:@ offset (:%q dest)))))
2366
2367(define-x8664-vinsn mem-set-c-constant-halfword (()
2368 ((val :s16const)
2369 (dest :address)
2370 (offset :s32const)))
2371 ((:pred = offset 0)
2372 (movw (:$w val) (:@ (:%q dest))))
2373 ((:not (:pred = offset 0))
2374 (movw (:$w val) (:@ offset (:%q dest)))))
2375
2376(define-x8664-vinsn mem-set-c-constant-byte (()
2377 ((val :s8const)
2378 (dest :address)
2379 (offset :s32const)))
2380 ((:pred = offset 0)
2381 (movb (:$b val) (:@ (:%q dest))))
2382 ((:not (:pred = offset 0))
2383 (movb (:$b val) (:@ offset (:%q dest)))))
2384
2385
2386
2387
2388
2389
2390(define-x8664-vinsn mem-ref-natural (((dest :u64))
2391 ((src :address)
2392 (index :s64)))
2393 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2394
2395(define-x8664-vinsn setup-macptr-allocation (()
2396 ((src :address)))
2397 (movd (:%q src) (:%mmx x8664::mm0))
2398 (movl (:$l x8664::macptr-header) (:%l x8664::imm0.l))
2399 (movl (:$l (- x8664::macptr.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2400
2401(define-x8664-vinsn %set-new-macptr-value (()
2402 ((ptr :lisp)))
2403 (movq (:%mmx x8664::mm0) (:@ x8664::macptr.address (:%q ptr))))
2404
2405(define-x8664-vinsn mem-ref-c-fullword (((dest :u32))
2406 ((src :address)
2407 (index :s32const)))
2408 ((:pred = index 0)
2409 (movl (:@ (:%q src)) (:%l dest)))
2410 ((:not (:pred = index 0))
2411 (movl (:@ index (:%q src)) (:%l dest))))
2412
2413(define-x8664-vinsn mem-ref-c-signed-fullword (((dest :s32))
2414 ((src :address)
2415 (index :s32const)))
2416 ((:pred = index 0)
2417 (movslq (:@ (:%q src)) (:%q dest)))
2418 ((:not (:pred = index 0))
2419 (movslq (:@ index (:%q src)) (:%q dest))))
2420
2421
2422(define-x8664-vinsn mem-ref-c-single-float (((dest :single-float))
2423 ((src :address)
2424 (index :s32const)))
2425 ((:pred = index 0)
2426 (movss (:@ (:%q src)) (:%xmm dest)))
2427 ((:not (:pred = index 0))
2428 (movss (:@ index (:%q src)) (:%xmm dest))))
2429
2430(define-x8664-vinsn mem-set-c-single-float (()
2431 ((val :single-float)
2432 (src :address)
2433 (index :s16const)))
2434 ((:pred = index 0)
2435 (movss (:%xmm val) (:@ (:%q src))))
2436 ((:not (:pred = index 0))
2437 (movss (:%xmm val) (:@ index (:%q src)))))
2438
2439(define-x8664-vinsn mem-ref-c-doubleword (((dest :u64))
2440 ((src :address)
2441 (index :s32const)))
2442 ((:pred = index 0)
2443 (movq (:@ (:%q src)) (:%q dest)))
2444 ((:not (:pred = index 0))
2445 (movq (:@ index (:%q src)) (:%q dest))))
2446
2447(define-x8664-vinsn mem-ref-c-signed-doubleword (((dest :s64))
2448 ((src :address)
2449 (index :s32const)))
2450 ((:pred = index 0)
2451 (movq (:@ (:%q src)) (:%q dest)))
2452 ((:not (:pred = index 0))
2453 (movq (:@ index (:%q src)) (:%q dest))))
2454
2455(define-x8664-vinsn mem-ref-c-natural (((dest :u64))
2456 ((src :address)
2457 (index :s32const)))
2458 ((:pred = index 0)
2459 (movq (:@ (:%q src)) (:%q dest)))
2460 ((:not (:pred = index 0))
2461 (movq (:@ index (:%q src)) (:%q dest))))
2462
2463(define-x8664-vinsn mem-ref-c-double-float (((dest :double-float))
2464 ((src :address)
2465 (index :s32const)))
2466 ((:pred = index 0)
2467 (movsd (:@ (:%q src)) (:%xmm dest)))
2468 ((:not (:pred = index 0))
2469 (movsd (:@ index (:%q src)) (:%xmm dest))))
2470
2471(define-x8664-vinsn mem-set-c-double-float (()
2472 ((val :double-float)
2473 (src :address)
2474 (index :s16const)))
2475 ((:pred = index 0)
2476 (movsd (:%xmm val) (:@ (:%q src))))
2477 ((:not (:pred = index 0))
2478 (movsd (:%xmm val) (:@ index (:%q src)))))
2479
2480(define-x8664-vinsn mem-ref-fullword (((dest :u32))
2481 ((src :address)
2482 (index :s64)))
2483 (movl (:@ (:%q src) (:%q index)) (:%l dest)))
2484
2485(define-x8664-vinsn mem-ref-signed-fullword (((dest :s32))
2486 ((src :address)
2487 (index :s64)))
2488 (movslq (:@ (:%q src) (:%q index)) (:%q dest)))
2489
2490(define-x8664-vinsn mem-ref-doubleword (((dest :u64))
2491 ((src :address)
2492 (index :s64)))
2493 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2494
2495(define-x8664-vinsn mem-ref-natural (((dest :u64))
2496 ((src :address)
2497 (index :s64)))
2498 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2499
2500(define-x8664-vinsn mem-ref-signed-doubleword (((dest :s64))
2501 ((src :address)
2502 (index :s64)))
2503 (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2504
2505(define-x8664-vinsn mem-ref-c-u16 (((dest :u16))
2506 ((src :address)
2507 (index :s32const)))
2508 ((:pred = index 0)
2509 (movzwq (:@ (:%q src)) (:%q dest)))
2510 ((:not (:pred = index 0))
2511 (movzwq (:@ index (:%q src)) (:%q dest))))
2512
2513(define-x8664-vinsn mem-ref-u16 (((dest :u16))
2514 ((src :address)
2515 (index :s64)))
2516 (movzwq (:@ (:%q src) (:%q index)) (:%q dest)))
2517
2518
2519(define-x8664-vinsn mem-ref-c-s16 (((dest :s16))
2520 ((src :address)
2521 (index :s32const)))
2522 ((:pred = index 0)
2523 (movswq (:@ (:%q src)) (:%q dest)))
2524 ((:not (:pred = index 0))
2525 (movswq (:@ index (:%q src)) (:%q dest))))
2526
2527(define-x8664-vinsn mem-ref-s16 (((dest :s16))
2528 ((src :address)
2529 (index :s32)))
2530 (movswq (:@ (:%q src) (:%q index)) (:%q dest)))
2531
2532(define-x8664-vinsn mem-ref-c-u8 (((dest :u8))
2533 ((src :address)
2534 (index :s16const)))
2535 ((:pred = index 0)
2536 (movzbq (:@ (:%q src)) (:%q dest)))
2537 ((:not (:pred = index 0))
2538 (movzbq (:@ index (:%q src)) (:%q dest))))
2539
2540(define-x8664-vinsn mem-ref-u8 (((dest :u8))
2541 ((src :address)
2542 (index :s32)))
2543 (movzbq (:@ (:%q src) (:%q index)) (:%q dest)))
2544
2545(define-x8664-vinsn mem-ref-c-s8 (((dest :s8))
2546 ((src :address)
2547 (index :s16const)))
2548 ((:pred = index 0)
2549 (movsbq (:@ (:%q src)) (:%q dest)))
2550 ((:not (:pred = index 0))
2551 (movsbq (:@ index (:%q src)) (:%q dest))))
2552
2553(define-x8664-vinsn misc-set-c-s8 (((val :s8))
2554 ((v :lisp)
2555 (idx :u32const))
2556 ())
2557 (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
2558
2559(define-x8664-vinsn misc-set-s8 (((val :s8))
2560 ((v :lisp)
2561 (scaled-idx :s64))
2562 ())
2563 (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2564
2565(define-x8664-vinsn mem-ref-s8 (((dest :s8))
2566 ((src :address)
2567 (index :s32)))
2568 (movsbq (:@ (:%q src) (:%q index)) (:%q dest)))
2569
2570(define-x8664-vinsn mem-set-constant-doubleword (()
2571 ((val :s32const)
2572 (ptr :address)
2573 (offset :s64)))
2574 (movq (:$l val) (:@ (:%q ptr) (:%q offset))))
2575
2576(define-x8664-vinsn mem-set-constant-fullword (()
2577 ((val :s32const)
2578 (ptr :address)
2579 (offset :s64)))
2580 (movl (:$l val) (:@ (:%q ptr) (:%q offset))))
2581
2582
2583(define-x8664-vinsn mem-set-constant-halfword (()
2584 ((val :s16const)
2585 (ptr :address)
2586 (offset :s64)))
2587 (movw (:$w val) (:@ (:%q ptr) (:%q offset))))
2588
2589(define-x8664-vinsn mem-set-constant-byte (()
2590 ((val :s8const)
2591 (ptr :address)
2592 (offset :s64)))
2593 (movb (:$b val) (:@ (:%q ptr) (:%q offset))))
2594
2595(define-x8664-vinsn misc-set-c-u8 (((val :u8))
2596 ((v :lisp)
2597 (idx :u32const))
2598 ())
2599 (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
2600
2601(define-x8664-vinsn misc-set-u8 (((val :u8))
2602 ((v :lisp)
2603 (scaled-idx :s64))
2604 ())
2605 (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2606
2607(define-x8664-vinsn misc-set-c-u8 (((val :u8))
2608 ((v :lisp)
2609 (idx :s32const))
2610 ())
2611 (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
2612
2613(define-x8664-vinsn misc-set-u8 (()
2614 ((val :u8)
2615 (v :lisp)
2616 (scaled-idx :s64))
2617 ())
2618 (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2619
2620(define-x8664-vinsn misc-set-c-u16 (()
2621 ((val :u16)
2622 (v :lisp)
2623 (idx :s32const))
2624 ())
2625 (movw (:%w val) (:@ (:apply + x8664::misc-data-offset (:apply * 2 idx)) (:%q v))))
2626
2627
2628(define-x8664-vinsn misc-set-u16 (()
2629 ((val :u16)
2630 (v :lisp)
2631 (scaled-idx :s64))
2632 ())
2633 (movw (:%w val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2634
2635(define-x8664-vinsn misc-set-c-s16 (()
2636 ((val :s16)
2637 (v :lisp)
2638 (idx :s32const))
2639 ())
2640 (movw (:%w val) (:@ (:apply + x8664::misc-data-offset (:apply * 2 idx)) (:%q v))))
2641
2642
2643(define-x8664-vinsn misc-set-s16 (()
2644 ((val :s16)
2645 (v :lisp)
2646 (scaled-idx :s64))
2647 ())
2648 (movw (:%w val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2649
2650(define-x8664-vinsn misc-set-c-u32 (()
2651 ((val :u32)
2652 (v :lisp)
2653 (idx :u32const)) ; sic
2654 ())
2655 (movl (:%l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
2656
2657(define-x8664-vinsn misc-set-u32 (()
2658 ((val :u32)
2659 (v :lisp)
2660 (scaled-idx :s64))
2661 ())
2662 (movl (:%l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2663
2664(define-x8664-vinsn misc-set-c-s32 (()
2665 ((val :s32)
2666 (v :lisp)
2667 (idx :u32const)) ; sic
2668 ())
2669 (movl (:%l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
2670
2671(define-x8664-vinsn misc-set-s32 (()
2672 ((val :s32)
2673 (v :lisp)
2674 (scaled-idx :s64))
2675 ())
2676 (movl (:%l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
2677
2678(define-x8664-vinsn %iasr (((dest :imm))
2679 ((count :imm)
2680 (src :imm))
2681 ((temp :s64)
2682 (shiftcount (:s64 #.x8664::rcx))))
2683 (movq (:%q count) (:%q temp))
2684 (sarq (:$ub x8664::fixnumshift) (:%q temp))
2685 (rcmpq (:%q temp) (:$l 63))
2686 (cmovbw (:%w temp) (:%w shiftcount))
2687 (movq (:%q src) (:%q temp))
2688 (jae :shift-max)
2689 (sarq (:%shift x8664::cl) (:%q temp))
2690 (jmp :done)
2691 :shift-max
2692 (sarq (:$ub 63) (:%q temp))
2693 :done
2694 (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
2695 (movq (:%q temp) (:%q dest)))
2696
2697(define-x8664-vinsn %ilsr (((dest :imm))
2698 ((count :imm)
2699 (src :imm))
2700 ((temp :s64)
2701 (shiftcount (:s64 #.x8664::rcx))))
2702 (movq (:%q count) (:%q temp))
2703 (sarq (:$ub x8664::fixnumshift) (:%q temp))
2704 (rcmpq (:%q temp) (:$l 63))
2705 (cmovbw (:%w temp) (:%w shiftcount))
2706 (movq (:%q src) (:%q temp))
2707 (jae :shift-max)
2708 (shrq (:%shift x8664::cl) (:%q temp))
2709 (jmp :done)
2710 :shift-max
2711 (shrq (:$ub 63) (:%q temp))
2712 :done
2713 (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
2714 (movq (:%q temp) (:%q dest)))
2715
2716(define-x8664-vinsn %iasr-c (((dest :imm))
2717 ((count :u8const)
2718 (src :imm))
2719 ((temp :s64)))
2720 (movq (:%q src) (:%q temp))
2721 (sarq (:$ub count) (:%q temp))
2722 (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
2723 (movq (:%q temp) (:%q dest)))
2724
2725(define-x8664-vinsn %ilsr-c (((dest :imm))
2726 ((count :u8const)
2727 (src :imm))
2728 ((temp :s64)))
2729 (movq (:%q src) (:%q temp))
2730 (shrq (:$ub count) (:%q temp))
2731 (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
2732 (movq (:%q temp) (:%q dest)))
2733
2734(define-x8664-vinsn %ilsl (((dest :imm))
2735 ((count :imm)
2736 (src :imm))
2737 ((temp :s64)
2738 (shiftcount (:s64 #.x8664::rcx))))
2739 (movq (:%q count) (:%q temp))
2740 (sarq (:$ub x8664::fixnumshift) (:%q temp))
2741 (rcmpq (:%q temp) (:$l 63))
2742 (cmovbw (:%w temp) (:%w shiftcount))
2743 (movq (:%q src) (:%q temp))
2744 (jae :shift-max)
2745 (shlq (:%shift x8664::cl) (:%q temp))
2746 (jmp :done)
2747 :shift-max
2748 (xorq (:%q temp) (:%q temp))
2749 :done
2750 (movq (:%q temp) (:%q dest)))
2751
2752(define-x8664-vinsn %ilsl-c (((dest :imm))
2753 ((count :u8const)
2754 (src :imm)))
2755 ((:not (:pred =
2756 (:apply %hard-regspec-value src)
2757 (:apply %hard-regspec-value dest)))
2758 (movq (:%q src) (:%q dest)))
2759 (shlq (:$ub count) (:%q dest)))
2760
2761;;; In safe code, something else has ensured that the value is of type
2762;;; BIT.
2763(define-x8664-vinsn set-variable-bit-to-variable-value (()
2764 ((vec :lisp)
2765 (word-index :s64)
2766 (bitnum :u8)
2767 (value :lisp)))
2768 (testb (:%b value) (:%b value))
2769 (je :clr)
2770 (btsq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8))
2771 (jmp :done)
2772 :clr
2773 (btrq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8))
2774 :done)
2775
2776(define-x8664-vinsn set-variable-bit-to-zero (()
2777 ((vec :lisp)
2778 (word-index :s64)
2779 (bitnum :u8)))
2780 (btrq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8)))
2781
2782(define-x8664-vinsn set-variable-bit-to-one (()
2783 ((vec :lisp)
2784 (word-index :s64)
2785 (bitnum :u8)))
2786 (btsq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8)))
2787
2788;;; In safe code, something else has ensured that the value is of type
2789;;; BIT.
2790(define-x8664-vinsn nset-variable-bit-to-variable-value (()
2791 ((vec :lisp)
2792 (index :s64)
2793 (value :lisp)))
2794 (testb (:%b value) (:%b value))
2795 (je :clr)
2796 (btsq (:%q index) (:@ x8664::misc-data-offset (:%q vec)))
2797 (jmp :done)
2798 :clr
2799 (btrq (:%q index) (:@ x8664::misc-data-offset (:%q vec)))
2800 :done)
2801
2802(define-x8664-vinsn nset-variable-bit-to-zero (()
2803 ((vec :lisp)
2804 (index :s64)))
2805 (btrq (:%q index) (:@ x8664::misc-data-offset (:%q vec))))
2806
2807(define-x8664-vinsn nset-variable-bit-to-one (()
2808 ((vec :lisp)
2809 (index :s64)))
2810 (btsq (:%q index) (:@ x8664::misc-data-offset (:%q vec))))
2811
2812(define-x8664-vinsn set-constant-bit-to-zero (()
2813 ((src :lisp)
2814 (idx :u64const)))
2815 (btrq (:$ub (:apply logand 63 idx))
2816 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
2817
2818(define-x8664-vinsn set-constant-bit-to-one (()
2819 ((src :lisp)
2820 (idx :u64const)))
2821 (btsq (:$ub (:apply logand 63 idx))
2822 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
2823
2824(define-x8664-vinsn set-constant-bit-to-variable-value (()
2825 ((src :lisp)
2826 (idx :u64const)
2827 (value :lisp)))
2828 (testb (:%b value) (:%b value))
2829 (je :clr)
2830 (btsq (:$ub (:apply logand 63 idx))
2831 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
2832 (jmp :done)
2833 :clr
2834 (btrq (:$ub (:apply logand 63 idx))
2835 (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
2836 :done)
2837
2838
2839(define-x8664-vinsn require-fixnum (()
2840 ((object :lisp)))
2841 :again
2842 (testl (:$l x8664::fixnummask) (:%l object))
2843 (jne :bad)
2844 (:anchored-uuo-section :again)
2845 :bad
2846 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-fixnum))))
2847
2848(define-x8664-vinsn require-integer (()
2849 ((object :lisp))
2850 ((tag :u8)))
2851 :again
2852 (movl (:%l object) (:%l tag))
2853 (andl (:$b x8664::fixnummask) (:%l tag))
2854 (je :got-it)
2855 (cmpl (:$b x8664::tag-misc) (:%l tag))
2856 (jne :bad)
2857 (cmpb (:$b x8664::subtag-bignum) (:@ x8664::misc-subtag-offset (:%q object)))
2858 (jne :bad)
2859 :got-it
2860
2861 (:anchored-uuo-section :again)
2862 :bad
2863 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-integer))))
2864
2865(define-x8664-vinsn require-simple-vector (()
2866 ((object :lisp))
2867 ((tag :u8)))
2868 :again
2869 (movl (:%l object) (:%l tag))
2870 (andl (:$b x8664::fixnummask) (:%l tag))
2871 (cmpl (:$b x8664::tag-misc) (:%l tag))
2872 (jne :bad)
2873 (cmpb (:$b x8664::subtag-simple-vector) (:@ x8664::misc-subtag-offset (:%q object)))
2874 (jne :bad)
2875
2876 (:anchored-uuo-section :again)
2877 :bad
2878 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-simple-vector))))
2879
2880(define-x8664-vinsn require-simple-string (()
2881 ((object :lisp))
2882 ((tag :u8)))
2883 :again
2884 (movl (:%l object) (:%l tag))
2885 (andl (:$b x8664::fixnummask) (:%l tag))
2886 (cmpl (:$b x8664::tag-misc) (:%l tag))
2887 (jne :bad)
2888 (cmpb (:$b x8664::subtag-simple-base-string) (:@ x8664::misc-subtag-offset (:%q object)))
2889 (jne :bad)
2890
2891 (:anchored-uuo-section :again)
2892 :bad
2893 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-simple-string))))
2894
2895(define-x8664-vinsn require-real (()
2896 ((object :lisp))
2897 ((tag :u8)
2898 (mask :u64)))
2899 (movq (:$q (logior (ash 1 x8664::tag-fixnum)
2900 (ash 1 x8664::tag-single-float)
2901 (ash 1 x8664::subtag-double-float)
2902 (ash 1 x8664::subtag-bignum)
2903 (ash 1 x8664::subtag-ratio)))
2904 (:%q mask))
2905 :again
2906 (movl (:%l object) (:%l tag))
2907 (andl (:$b x8664::tagmask) (:%l tag))
2908 (cmpl (:$b x8664::tag-misc) (:%l tag))
2909 (jne :have-tag)
2910 (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
2911 :have-tag
2912 (rcmpl (:%l tag) (:$b 64))
2913 (jae :bad)
2914 (btq (:%q tag) (:%q mask))
2915 (jae :bad)
2916
2917 (:anchored-uuo-section :again)
2918 :bad
2919 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-real))))
2920
2921(define-x8664-vinsn require-number (()
2922 ((object :lisp))
2923 ((tag :u8)
2924 (mask :u64)))
2925 (movq (:$q (logior (ash 1 x8664::tag-fixnum)
2926 (ash 1 x8664::tag-single-float)
2927 (ash 1 x8664::subtag-double-float)
2928 (ash 1 x8664::subtag-bignum)
2929 (ash 1 x8664::subtag-ratio)
2930 (ash 1 x8664::subtag-complex)))
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 (:anchored-uuo-section :again)
2944 :bad
2945 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-number))))
2946
2947(define-x8664-vinsn require-list (()
2948 ((object :lisp))
2949 ((tag :u8)))
2950 :again
2951 (movl (:%l object) (:%l tag))
2952 (andl (:$b x8664::tagmask) (:%l tag))
2953 (cmpl (:$b x8664::tag-list) (:%l tag))
2954 (jne :bad)
2955
2956 (:anchored-uuo-section :again)
2957 :bad
2958 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-list))))
2959
2960(define-x8664-vinsn require-symbol (()
2961 ((object :lisp))
2962 ((tag :u8)))
2963 :again
2964 (movzbl (:%b object) (:%l tag))
2965 (cmpl (:$b x8664::fulltag-nil) (:%l tag))
2966 (je :good)
2967 (andl (:$b x8664::tagmask) (:%l tag))
2968 (cmpl (:$b x8664::tag-symbol) (:%l tag))
2969 (jne :bad)
2970 :good
2971
2972 (:anchored-uuo-section :again)
2973 :bad
2974 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))))
2975
2976(define-x8664-vinsn require-character (()
2977 ((object :lisp)))
2978 :again
2979 (cmpb (:$b x8664::subtag-character) (:%b object))
2980 (jne :bad)
2981 (:anchored-uuo-section :again)
2982 :bad
2983 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-character))))
2984
2985(define-x8664-vinsn require-s8 (()
2986 ((object :lisp))
2987 ((tag :u32)))
2988 :again
2989 (movq (:%q object) (:%q tag))
2990 (shlq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q tag))
2991 (sarq (:$ub (- x8664::nbits-in-word 8)) (:%q tag))
2992 (shlq (:$ub x8664::fixnumshift) (:%q tag))
2993 (cmpq (:%q object) (:%q tag))
2994 (jne :bad)
2995
2996 (:anchored-uuo-section :again)
2997 :bad
2998 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-8))))
2999
3000(define-x8664-vinsn require-u8 (()
3001 ((object :lisp))
3002 ((tag :u32)))
3003 :again
3004 (movq (:$l (lognot (ash #xff x8664::fixnumshift))) (:%q tag))
3005 (andq (:% object) (:% tag))
3006 (jne :bad)
3007 (:anchored-uuo-section :again)
3008 :bad
3009 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-8))))
3010
3011(define-x8664-vinsn require-s16 (()
3012 ((object :lisp))
3013 ((tag :s64)))
3014 :again
3015 (movq (:%q object) (:%q tag))
3016 (shlq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q tag))
3017 (sarq (:$ub (- x8664::nbits-in-word 16)) (:%q tag))
3018 (shlq (:$ub x8664::fixnumshift) (:%q tag))
3019 (cmpq (:%q object) (:%q tag))
3020 (jne :bad)
3021 (:anchored-uuo-section :again)
3022 :bad
3023 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-16))))
3024
3025(define-x8664-vinsn require-u16 (()
3026 ((object :lisp))
3027 ((tag :u32)))
3028 :again
3029 (movq (:$l (lognot (ash #xffff x8664::fixnumshift))) (:%q tag))
3030 (andq (:% object) (:% tag))
3031 (jne :bad)
3032 (:anchored-uuo-section :again)
3033 :bad
3034 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-16))))
3035
3036(define-x8664-vinsn require-s32 (()
3037 ((object :lisp))
3038 ((tag :s64)))
3039 :again
3040 (movq (:%q object) (:%q tag))
3041 (shlq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q tag))
3042 (sarq (:$ub (- x8664::nbits-in-word 32)) (:%q tag))
3043 (shlq (:$ub x8664::fixnumshift) (:%q tag))
3044 (cmpq (:%q object) (:%q tag))
3045 (jne :bad)
3046 (testl (:$l x8664::fixnummask) (:%l object))
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-32))))
3051
3052(define-x8664-vinsn require-u32 (()
3053 ((object :lisp))
3054 ((tag :u32)))
3055 :again
3056 (movq (:$q (lognot (ash #xffffffff 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-32))))
3062
3063(define-x8664-vinsn require-s64 (()
3064 ((object :lisp))
3065 ((tag :s64)))
3066 :again
3067 (testl (:$l x8664::fixnummask) (:%l object))
3068 (movl (:%l object) (:%l tag))
3069 (je :ok)
3070 (andl (:$b x8664::fulltagmask) (:%l tag))
3071 (cmpl (:$b x8664::fulltag-misc) (:%l tag))
3072 (jne :bad)
3073 (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3074 (jne :bad)
3075 :ok
3076 (:anchored-uuo-section :again)
3077 :bad
3078 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-64))))
3079
3080(define-x8664-vinsn require-u64 (()
3081 ((object :lisp))
3082 ((tag :s64)))
3083 :again
3084 (testl (:$l x8664::fixnummask) (:%l object))
3085 (movq (:%q object) (:%q tag))
3086 (je :ok-if-non-negative)
3087 (andl (:$b x8664::fulltagmask) (:%l tag))
3088 (cmpl (:$b x8664::fulltag-misc) (:%l tag))
3089 (jne :bad)
3090 (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3091 (je :two)
3092 (cmpq (:$l x8664::three-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3093 (jne :bad)
3094 (cmpl (:$b 0) (:@ (+ x8664::misc-data-offset 8) (:%q object)))
3095 (je :ok)
3096 (jmp :bad)
3097 :two
3098 (movq (:@ x8664::misc-data-offset (:%q object)) (:%q tag))
3099 :ok-if-non-negative
3100 (testq (:%q tag) (:%q tag))
3101 (js :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-unsigned-byte-64))))
3106
3107(define-x8664-vinsn require-char-code (()
3108 ((object :lisp))
3109 ((tag :u32)))
3110 :again
3111 (testl (:$l x8664::fixnummask) (:%l object))
3112 (jne :bad)
3113 (cmpq (:$l (ash #x110000 x8664::fixnumshift)) (:%q object))
3114 (jae :bad)
3115 (:anchored-uuo-section :again)
3116 :bad
3117 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-mod-char-code-limit))))
3118
3119
3120;;; set DEST to
3121(define-x8664-vinsn mask-base-char (((dest :u8))
3122 ((src :lisp)))
3123 (movzbl (:%b src) (:%l dest)))
3124
3125(define-x8664-vinsn single-float-bits (((dest :u32))
3126 ((src :lisp)))
3127 (movq (:%q src) (:%q dest))
3128 (shrq (:$ub 32) (:%q dest)))
3129
3130(define-x8664-vinsn zero-double-float-register (((dest :double-float))
3131 ())
3132 (movsd (:%xmm x8664::fpzero) (:%xmm dest)))
3133
3134(define-x8664-vinsn zero-single-float-register (((dest :single-float))
3135 ())
3136 (movss (:%xmm x8664::fpzero) (:%xmm dest)))
3137
3138(define-x8664-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
3139(define-x8664-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
3140(define-x8664-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
3141
3142(define-x8664-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
3143
3144(define-x8664-vinsn misc-element-count-fixnum (((dest :imm))
3145 ((src :lisp))
3146 ((temp :u64)))
3147 (movq (:@ x8664::misc-header-offset (:%q src)) (:%q temp))
3148 (shrq (:$ub x8664::num-subtag-bits) (:%q temp))
3149 (imulq (:$b x8664::fixnumone) (:%q temp)(:%q dest)))
3150
3151(define-x8664-vinsn %logior2 (((dest :imm))
3152 ((x :imm)
3153 (y :imm)))
3154 ((:pred =
3155 (:apply %hard-regspec-value x)
3156 (:apply %hard-regspec-value dest))
3157 (orq (:%q y) (:%q dest)))
3158 ((:not (:pred =
3159 (:apply %hard-regspec-value x)
3160 (:apply %hard-regspec-value dest)))
3161 ((:pred =
3162 (:apply %hard-regspec-value y)
3163 (:apply %hard-regspec-value dest))
3164 (orq (:%q x) (:%q dest)))
3165 ((:not (:pred =
3166 (:apply %hard-regspec-value y)
3167 (:apply %hard-regspec-value dest)))
3168 (movq (:%q x) (:%q dest))
3169 (orq (:%q y) (:%q dest)))))
3170
3171(define-x8664-vinsn %logand2 (((dest :imm))
3172 ((x :imm)
3173 (y :imm)))
3174 ((:pred =
3175 (:apply %hard-regspec-value x)
3176 (:apply %hard-regspec-value dest))
3177 (andq (:%q y) (:%q dest)))
3178 ((:not (:pred =
3179 (:apply %hard-regspec-value x)
3180 (:apply %hard-regspec-value dest)))
3181 ((:pred =
3182 (:apply %hard-regspec-value y)
3183 (:apply %hard-regspec-value dest))
3184 (andq (:%q x) (:%q dest)))
3185 ((:not (:pred =
3186 (:apply %hard-regspec-value y)
3187 (:apply %hard-regspec-value dest)))
3188 (movq (:%q x) (:%q dest))
3189 (andq (:%q y) (:%q dest)))))
3190
3191(define-x8664-vinsn %logxor2 (((dest :imm))
3192 ((x :imm)
3193 (y :imm)))
3194 ((:pred =
3195 (:apply %hard-regspec-value x)
3196 (:apply %hard-regspec-value dest))
3197 (xorq (:%q y) (:%q dest)))
3198 ((:not (:pred =
3199 (:apply %hard-regspec-value x)
3200 (:apply %hard-regspec-value dest)))
3201 ((:pred =
3202 (:apply %hard-regspec-value y)
3203 (:apply %hard-regspec-value dest))
3204 (xorq (:%q x) (:%q dest)))
3205 ((:not (:pred =
3206 (:apply %hard-regspec-value y)
3207 (:apply %hard-regspec-value dest)))
3208 (movq (:%q x) (:%q dest))
3209 (xorq (:%q y) (:%q dest)))))
3210
3211(define-x8664-subprim-call-vinsn (integer-sign) .SPinteger-sign)
3212
3213(define-x8664-vinsn vcell-ref (((dest :lisp))
3214 ((vcell :lisp)))
3215 (movq (:@ x8664::misc-data-offset (:%q vcell)) (:%q dest)))
3216
3217(define-x8664-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
3218 ((spno :s32const)
3219 (x t)
3220 (y t)
3221 (z t))
3222 ((entry (:label 1))))
3223 (:talign 4)
3224 (call (:@ spno))
3225 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3226
3227(define-x8664-vinsn setup-vcell-allocation (()
3228 ())
3229 (movl (:$l x8664::value-cell-header) (:%l x8664::imm0))
3230 (movl (:$l (- x8664::value-cell.size x8664::fulltag-misc)) (:%l x8664::imm1)))
3231
3232(define-x8664-vinsn %init-vcell (()
3233 ((vcell :lisp)
3234 (closed :lisp)))
3235 (movq (:%q closed) (:@ x8664::value-cell.value (:%q vcell))))
3236
3237(define-x8664-subprim-call-vinsn (progvsave) .SPprogvsave)
3238
3239(define-x8664-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
3240
3241(define-x8664-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
3242
3243(define-x8664-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
3244
3245(define-x8664-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
3246
3247(define-x8664-vinsn scale-nargs (()
3248 ((nfixed :s16const)))
3249 ((:pred > nfixed 0)
3250 ((:pred < nfixed 16)
3251 (subl (:$b (:apply ash nfixed x8664::word-shift)) (:%l x8664::nargs)))
3252 ((:pred >= nfixed 16)
3253 (subl (:$l (:apply ash nfixed x8664::word-shift)) (:%l x8664::nargs)))))
3254
3255(define-x8664-vinsn opt-supplied-p (()
3256 ((num-opt :u16const))
3257 ((nargs (:u64 #.x8664::nargs))
3258 (imm :imm)))
3259 (xorl (:%l imm) (:%l imm))
3260 (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_y))
3261 :loop
3262 (rcmpl (:%l imm) (:%l nargs))
3263 (movl (:%l x8664::arg_y) (:%l x8664::arg_z))
3264 (cmovll (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l x8664::arg_y)) (:%l x8664::arg_z))
3265 (addl (:$b x8664::node-size) (:%l imm))
3266 (rcmpl (:%l imm) (:$l (:apply ash num-opt x8664::fixnumshift)))
3267 (pushq (:%q x8664::arg_z))
3268 (jne :loop))
3269
3270(define-x8664-vinsn one-opt-supplied-p (()
3271 ()
3272 ((temp :u64)))
3273 (testl (:%l x8664::nargs) (:%l x8664::nargs))
3274 (movl (:$l (:apply target-nil-value)) (:%l temp))
3275 (cmovnel (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp)) (:%l temp))
3276 (pushq (:%q temp)))
3277
3278(define-x8664-vinsn two-opt-supplied-p (()
3279 ()
3280 ((temp0 :u64)
3281 (temp1 :u64)))
3282 (rcmpl (:%l x8664::nargs) (:$b x8664::node-size))
3283 (movl (:$l (:apply target-nil-value)) (:%l temp0))
3284 (movl (:%l temp0) (:%l temp1))
3285 (cmovael (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp0)) (:%l temp0))
3286 (cmoval (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp1)) (:%l temp1))
3287 (pushq (:%q temp0))
3288 (pushq (:%q temp1)))
3289
3290
3291(define-x8664-vinsn set-c-flag-if-constant-logbitp (()
3292 ((bit :u8const)
3293 (int :imm)))
3294 (btq (:$ub bit) (:%q int)))
3295
3296(define-x8664-vinsn set-c-flag-if-variable-logbitp (()
3297 ((bit :imm)
3298 (int :imm))
3299 ((temp0 :u8)
3300 (temp1 :u8)))
3301 (movl (:$l 63) (:%l temp1))
3302 (movq (:%q bit) (:%q temp0))
3303 (sarq (:$ub x8664::fixnumshift) (:%q temp0))
3304 (addq (:$b x8664::fixnumshift) (:%q temp0))
3305 (rcmpq (:%q temp0) (:%q temp1))
3306 (cmoval (:%l temp1) (:%l temp0))
3307 (btq (:%q temp0) (:%q int)))
3308
3309(define-x8664-vinsn multiply-immediate (((dest :imm))
3310 ((src :imm)
3311 (const :s32const)))
3312 ((:and (:pred >= const -128) (:pred <= const 127))
3313 (imulq (:$b const) (:%q src) (:%q dest)))
3314 ((:not (:and (:pred >= const -128) (:pred <= const 127)))
3315 (imulq (:$l const) (:%q src) (:%q dest))))
3316
3317(define-x8664-vinsn multiply-fixnums (((dest :imm))
3318 ((x :imm)
3319 (y :imm))
3320 ((unboxed :s64)))
3321 ((:pred =
3322 (:apply %hard-regspec-value x)
3323 (:apply %hard-regspec-value dest))
3324 (movq (:%q y) (:%q unboxed))
3325 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3326 (imulq (:%q unboxed) (:%q dest)))
3327 ((:and (:not (:pred =
3328 (:apply %hard-regspec-value x)
3329 (:apply %hard-regspec-value dest)))
3330 (:pred =
3331 (:apply %hard-regspec-value y)
3332 (:apply %hard-regspec-value dest)))
3333 (movq (:%q x) (:%q unboxed))
3334 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3335 (imulq (:%q unboxed) (:%q dest)))
3336 ((:and (:not (:pred =
3337 (:apply %hard-regspec-value x)
3338 (:apply %hard-regspec-value dest)))
3339 (:not (:pred =
3340 (:apply %hard-regspec-value y)
3341 (:apply %hard-regspec-value dest))))
3342 (movq (:%q y) (:%q dest))
3343 (movq (:%q x) (:%q unboxed))
3344 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3345 (imulq (:%q unboxed) (:%q dest))))
3346
3347
3348(define-x8664-vinsn save-lexpr-argregs (()
3349 ((min-fixed :u16const)))
3350 ((:pred >= min-fixed $numx8664argregs)
3351 (pushq (:%q x8664::arg_x))
3352 (pushq (:%q x8664::arg_y))
3353 (pushq (:%q x8664::arg_z)))
3354 ((:pred = min-fixed 2) ; at least 2 args
3355 (cmpl (:$b (ash 2 x8664::word-shift)) (:%l x8664::nargs))
3356 (je :yz2) ; skip arg_x if exactly 2
3357 (pushq (:%q x8664::arg_x))
3358 :yz2
3359 (pushq (:%q x8664::arg_y))
3360 (pushq (:%q x8664::arg_z)))
3361 ((:pred = min-fixed 1) ; at least one arg
3362 (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
3363 (jl :z1) ; branch if exactly one
3364 (je :yz1) ; branch if exactly two
3365 (pushq (:%q x8664::arg_x))
3366 :yz1
3367 (pushq (:%q x8664::arg_y))
3368 :z1
3369 (pushq (:%q x8664::arg_z)))
3370 ((:pred = min-fixed 0)
3371 (testl (:%l x8664::nargs) (:%l x8664::nargs))
3372 (je :none) ; exactly zero
3373 (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
3374 (je :yz0) ; exactly two
3375 (jl :z0) ; one
3376 ; Three or more ...
3377 (pushq (:%q x8664::arg_x))
3378 :yz0
3379 (pushq (:%q x8664::arg_y))
3380 :z0
3381 (pushq (:%q x8664::arg_z))
3382 :none
3383 )
3384 ((:not (:pred = min-fixed 0))
3385 (leaq (:@ (:apply - (:apply ash min-fixed x8664::word-shift)) (:%q x8664::nargs))
3386 (:%q x8664::nargs)))
3387 (pushq (:%q x8664::nargs))
3388 (movq (:%q x8664::rsp) (:%q x8664::arg_z)))
3389
3390
3391
3392
3393;;; The frame that was built (by SAVE-LISP-CONTEXT-VARIABLE-ARG-COUNT
3394;;; and SAVE-LEXPR-ARGREGS) contains an unknown number of arguments
3395;;; followed by the count of non-required arguments; the count is on
3396;;; top of the stack and its address is in %arg_z. We need to build a
3397;;; frame so that the function can address its arguments (copies of
3398;;; the required arguments and the lexpr) and locals; when the
3399;;; function returns, it should one or more values (depending on how
3400;;; it was called) and discard the hidden lexpr frame. At this point,
3401;;; %ra0 still contains the "real" return address. If it's not the
3402;;; magic multiple-value address, we can make the function return to
3403;;; something that does a single-value return (.SPpopj); otherwise, we
3404;;; need to make it return multiple values to the real caller. (Unlike
3405;;; the PPC, this case only involves creating one frame here, but that
3406;;; frame has two return addresses.)
3407(define-x8664-vinsn build-lexpr-frame (()
3408 ()
3409 ((temp :imm)))
3410 (movq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr)))
3411 (:%q temp))
3412 (cmpq (:%q temp)
3413 (:%q x8664::ra0))
3414 (je :multiple)
3415 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::lexpr-return1v))))
3416 (jmp :finish)
3417 :multiple
3418 (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::lexpr-return))))
3419 (pushq (:%q temp))
3420 :finish
3421 (pushq (:%q x8664::rbp))
3422 (movq (:%q x8664::rsp) (:%q x8664::rbp)))
3423
3424
3425(define-x8664-vinsn copy-lexpr-argument (()
3426 ((n :u16const))
3427 ((temp :imm)))
3428 (movq (:@ (:%q x8664::arg_z)) (:%q temp))
3429 (pushq (:@ (:apply ash n x8664::word-shift) (:%q x8664::arg_z) (:%q temp))))
3430
3431
3432(define-x8664-vinsn %current-tcr (((dest :lisp))
3433 ())
3434 (movq (:rcontext x8664::tcr.linear) (:%q dest)))
3435
3436(define-x8664-vinsn (setq-special :call :subprim-call)
3437 (()
3438 ((sym :lisp)
3439 (val :lisp))
3440 ((entry (:label 1))))
3441 (:talign 4)
3442 (call (:@ .SPspecset))
3443 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3444
3445(define-x8664-vinsn set-z-flag-if-istruct-typep (()
3446 ((val :lisp)
3447 (type :lisp))
3448 ((tag :u8)
3449 (valtype :lisp)))
3450 (xorl (:%l valtype) (:%l valtype))
3451 (movl (:%l val) (:%l tag))
3452 (andl (:$b x8664::tagmask) (:%l tag))
3453 (cmpl (:$b x8664::tag-misc) (:%l tag))
3454 (jne :have-tag)
3455 (movzbl (:@ x8664::misc-subtag-offset (:%q val)) (:%l tag))
3456 :have-tag
3457 (cmpl (:$b x8664::subtag-istruct) (:%l tag))
3458 (jne :do-compare)
3459 (movq (:@ x8664::misc-data-offset (:%q val)) (:%q valtype))
3460 :do-compare
3461 (cmpq (:%q valtype) (:%q type)))
3462
3463(define-x8664-subprim-call-vinsn (misc-ref) .SPmisc-ref)
3464
3465(define-x8664-subprim-call-vinsn (ksignalerr) .SPksignalerr)
3466
3467(define-x8664-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
3468
3469(define-x8664-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
3470
3471(define-x8664-subprim-lea-jmp-vinsn (make-stack-gvector) .SPstkgvector)
3472
3473(define-x8664-vinsn load-character-constant (((dest :lisp))
3474 ((code :u32const))
3475 ())
3476 (movl (:$l (:apply logior (:apply ash code 8) x8664::subtag-character))
3477 (:%l dest)))
3478
3479(define-x8664-vinsn %scharcode8 (((code :imm))
3480 ((str :lisp)
3481 (idx :imm))
3482 ((imm :u64)))
3483 (movq (:%q idx) (:%q imm))
3484 (sarq (:$ub x8664::fixnumshift) (:%q imm))
3485 (movzbl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
3486 (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code)))
3487
3488(define-x8664-vinsn %scharcode32 (((code :imm))
3489 ((str :lisp)
3490 (idx :imm))
3491 ((imm :u64)))
3492 (movq (:%q idx) (:%q imm))
3493 (sarq (:$ub 1) (:%q imm))
3494 (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
3495 (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code)))
3496
3497(define-x8664-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
3498
3499(define-x8664-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
3500
3501
3502(define-x8664-vinsn character->code (((dest :u32))
3503 ((src :lisp)))
3504 (movq (:%q src) (:%q dest))
3505 (sarq (:$ub x8664::charcode-shift) (:%q dest)))
3506
3507(define-x8664-vinsn adjust-vsp (()
3508 ((amount :s32const)))
3509 ((:and (:pred >= amount -128) (:pred <= amount 127))
3510 (addq (:$b amount) (:%q x8664::rsp)))
3511 ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
3512 (addq (:$l amount) (:%q x8664::rsp))))
3513
3514(define-x8664-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
3515 ((spno :s32const)
3516 (y t)
3517 (z t))
3518 ((entry (:label 1))))
3519 (:talign 4)
3520 (call (:@ spno))
3521 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3522
3523
3524
3525(define-x8664-vinsn set-macptr-address (()
3526 ((addr :address)
3527 (src :lisp))
3528 ())
3529 (movq (:%q addr) (:@ x8664::macptr.address (:%q src))))
3530
3531(define-x8664-vinsn %symbol->symptr (((dest :lisp))
3532 ((src :lisp))
3533 ((tag :u8)))
3534 :begin
3535 (movl (:$l (:apply + (:apply target-nil-value) x8664::nilsym-offset)) (:%l tag))
3536 (cmpb (:$b x8664::fulltag-nil) (:%b src))
3537 (cmoveq (:%q tag) (:%q dest))
3538 (movl (:%l src) (:%l tag))
3539 (je :ok)
3540 (andl (:$b x8664::tagmask) (:%l tag))
3541 (cmpl (:$b x8664::tag-symbol) (:%l tag))
3542 (jne :bad)
3543
3544 ((:not (:pred =
3545 (:apply %hard-regspec-value dest)
3546 (:apply %hard-regspec-value src)))
3547 (movq (:% src) (:% dest)))
3548 :ok
3549 (:anchored-uuo-section :begin)
3550 :bad
3551 (:anchored-uuo (uuo-error-reg-not-tag (:%q src) (:$ub x8664::fulltag-symbol))))
3552
3553(define-x8664-vinsn symbol-function (((val :lisp))
3554 ((sym (:lisp (:ne val))))
3555 ((tag :u8)))
3556 :anchor
3557 (movq (:@ x8664::symbol.fcell (:%q sym)) (:%q val))
3558 (movl (:%l val) (:%l tag))
3559 (andl (:$b x8664::tagmask) (:%l tag))
3560 (cmpl (:$b x8664::tag-function) (:%l tag))
3561 (jne :bad)
3562
3563 (:anchored-uuo-section :anchor)
3564 :bad
3565 (:anchored-uuo (uuo-error-udf (:%q sym))))
3566
3567(define-x8664-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
3568
3569(define-x8664-vinsn load-double-float-constant (((dest :double-float))
3570 ((lab :label)
3571))
3572 (movsd (:@ (:^ lab) (:%q x8664::fn)) (:%xmm dest)))
3573
3574(define-x8664-vinsn load-single-float-constant (((dest :single-float))
3575 ((lab :label)
3576))
3577 (movss (:@ (:^ lab) (:%q x8664::fn)) (:%xmm dest)))
3578
3579(define-x8664-subprim-call-vinsn (misc-set) .SPmisc-set)
3580
3581(define-x8664-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
3582
3583(define-x8664-subprim-lea-jmp-vinsn (spread-list) .SPspreadargz)
3584
3585;;; Even though it's implemented by calling a subprim, THROW is really
3586;;; a JUMP (to a possibly unknown destination). If the destination's
3587;;; really known, it should probably be inlined (stack-cleanup, value
3588;;; transfer & jump ...)
3589(define-x8664-vinsn (throw :jump-unknown) (()
3590 ()
3591 ((entry (:label 1))))
3592 (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
3593 (:talign 4)
3594 (jmp (:@ .SPthrow))
3595 :back
3596 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
3597 (uuo-error-reg-not-tag (:%q x8664::temp0) (:$ub x8664::subtag-catch-frame)))
3598
3599
3600
3601(define-x8664-vinsn unbox-base-char (((dest :u64))
3602 ((src :lisp)))
3603 :anchor
3604 (movq (:%q src) (:%q dest))
3605 (shrq (:$ub x8664::charcode-shift) (:%q dest))
3606 (cmpb (:$b x8664::subtag-character) (:%b src))
3607 (jne :bad)
3608 (:anchored-uuo-section :anchor)
3609 :bad
3610 (:anchored-uuo (uuo-error-reg-not-tag (:%q src) (:$ub x8664::subtag-character))))
3611
3612(define-x8664-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
3613
3614(define-x8664-subprim-lea-jmp-vinsn (recover-values) .SPrecover-values)
3615
3616(define-x8664-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
3617
3618(define-x8664-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
3619
3620(define-x8664-subprim-call-vinsn (make-stack-block) .SPmakestackblock)
3621
3622(define-x8664-subprim-call-vinsn (make-stack-block0) .Spmakestackblock0)
3623
3624;;; "dest" is preallocated, presumably on a stack somewhere.
3625(define-x8664-vinsn store-double (()
3626 ((dest :lisp)
3627 (source :double-float))
3628 ())
3629 (movsd (:%xmm source) (:@ x8664::double-float.value (:%q dest))))
3630
3631(define-x8664-vinsn fixnum->char (((dest :lisp))
3632 ((src :imm))
3633 ((temp :u32)))
3634 (movl (:%l src) (:%l temp))
3635 (sarl (:$ub (+ x8664::fixnumshift 1)) (:%l temp))
3636 (cmpl (:$l (ash #xfffe -1)) (:%l temp))
3637 (je :bad-if-eq)
3638 (sarl (:$ub (- 11 1)) (:%l temp))
3639 (cmpl (:$b (ash #xd800 -11))(:%l temp))
3640 :bad-if-eq
3641 (movl (:$l (:apply target-nil-value)) (:%l temp))
3642 (cmovel (:%l temp) (:%l dest))
3643 (je :done)
3644 ((:not (:pred =
3645 (:apply %hard-regspec-value dest)
3646 (:apply %hard-regspec-value src)))
3647 (movl (:%l src) (:%l dest)))
3648 (shll (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%l dest))
3649 (addl (:$b x8664::subtag-character) (:%l dest))
3650 :done)
3651
3652;;; src is known to be a code for which CODE-CHAR returns non-nil.
3653(define-x8664-vinsn code-char->char (((dest :lisp))
3654 ((src :imm))
3655 ())
3656 ((:not (:pred =
3657 (:apply %hard-regspec-value dest)
3658 (:apply %hard-regspec-value src)))
3659 (movl (:%l src) (:%l dest)))
3660 (shll (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%l dest))
3661 (addl (:$b x8664::subtag-character) (:%l dest))
3662 :done)
3663
3664
3665(define-x8664-vinsn sign-extend-halfword (((dest :imm))
3666 ((src :imm)))
3667 (movq (:%q src ) (:%q dest))
3668 (shlq (:$ub (- 48 x8664::fixnumshift)) (:%q dest))
3669 (sarq (:$ub (- 48 x8664::fixnumshift)) (:%q dest)))
3670
3671(define-x8664-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
3672
3673(define-x8664-subprim-call-vinsn (gets64) .SPgets64)
3674
3675(define-x8664-subprim-call-vinsn (getu64) .SPgetu64)
3676
3677(define-x8664-vinsn %init-gvector (()
3678 ((v :lisp)
3679 (nbytes :u32const))
3680 ((count :imm)))
3681 (movl (:$l nbytes) (:%l count))
3682 (jmp :test)
3683 :loop
3684 (popq (:@ x8664::misc-data-offset (:%q v) (:%q count)))
3685 :test
3686 (subq (:$b x8664::node-size) (:%q count))
3687 (jge :loop))
3688
3689(define-x8664-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
3690
3691(define-x8664-vinsn nth-value (((result :lisp))
3692 ()
3693 ((imm0 :u64)))
3694 (leaq (:@ (:%q x8664::rsp) (:%q x8664::nargs)) (:%q imm0))
3695 (subq (:@ (:%q imm0)) (:%q x8664::nargs))
3696 (movl (:$l (:apply target-nil-value)) (:%l result))
3697 (jle :done)
3698 ;; I -think- that a CMOV would be safe here, assuming that N wasn't
3699 ;; extremely large. Don't know if we can assume that.
3700 (movq (:@ (- x8664::node-size) (:%q x8664::rsp) (:%q x8664::nargs)) (:%q result))
3701 :done
3702 (leaq (:@ x8664::node-size (:%q imm0)) (:%q x8664::rsp)))
3703
3704
3705(define-x8664-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
3706
3707(define-x8664-subprim-call-vinsn (stack-misc-alloc-init) .SPstack-misc-alloc-init)
3708
3709(define-x8664-vinsn fixnum->unsigned-natural (((dest :u64))
3710 ((src :imm)))
3711 (movq (:%q src) (:%q dest))
3712 (shrq (:$ub x8664::fixnumshift) (:%q dest)))
3713
3714(define-x8664-vinsn %debug-trap (()
3715 ())
3716 (uuo-error-debug-trap))
3717
3718(define-x8664-vinsn double-to-single (((result :single-float))
3719 ((arg :double-float)))
3720 (cvtsd2ss (:%xmm arg) (:%xmm result)))
3721
3722(define-x8664-vinsn single-to-double (((result :double-float))
3723 ((arg :single-float)))
3724 (cvtss2sd (:%xmm arg) (:%xmm result)))
3725
3726
3727(define-x8664-vinsn alloc-c-frame (()
3728 ((nwords :u32const)))
3729 (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
3730 ((:pred < (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift) 128)
3731 (subq (:$b (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift)) (:rcontext x8664::tcr.foreign-sp)))
3732 ((:not (:pred < (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift) 128))
3733 (subq (:$l (:apply ash (:apply logandc2 (:apply + nwords 9) 1) x8664::word-shift)) (:rcontext x8664::tcr.foreign-sp)))
3734 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3735 (movq (:%mmx x8664::stack-temp) (:@ (:%q x8664::ra0)))
3736 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::ra0))))
3737
3738(define-x8664-vinsn alloc-variable-c-frame (()
3739 ((nwords :imm))
3740 ((size :s64)))
3741 (leaq (:@ (* 9 x8664::node-size) (:%q nwords)) (:%q size))
3742 (andb (:$b (lognot x8664::fulltagmask)) (:%b size))
3743
3744 (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
3745 (subq (:%q size) (:rcontext x8664::tcr.foreign-sp))
3746 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3747 (movq (:%mmx x8664::stack-temp) (:@ (:%q x8664::ra0)))
3748 (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::ra0))))
3749
3750(define-x8664-vinsn set-c-arg (()
3751 ((arg :u64)
3752 (offset :u32const)))
3753 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3754 (movq (:%q arg) (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0))))
3755
3756(define-x8664-vinsn set-single-c-arg (()
3757 ((arg :single-float)
3758 (offset :u32const)))
3759 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3760 (movss (:%xmm arg) (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0))))
3761
3762(define-x8664-vinsn reload-single-c-arg (((arg :single-float))
3763 ((offset :u32const)))
3764 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3765 (movss (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0)) (:%xmm arg)))
3766
3767(define-x8664-vinsn set-double-c-arg (()
3768 ((arg :double-float)
3769 (offset :u32const)))
3770 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3771 (movsd (:%xmm arg) (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0))))
3772
3773(define-x8664-vinsn reload-double-c-arg (((arg :double-float))
3774 ((offset :u32const)))
3775 (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
3776 (movsd (:@ (:apply + 16 (:apply ash offset 3)) (:%q x8664::ra0)) (:%xmm arg)))
3777
3778(define-x8664-subprim-call-vinsn (ff-call) .SPffcall)
3779
3780(define-x8664-subprim-call-vinsn (ff-call-return-registers) .SPffcall-return-registers)
3781
3782(define-x8664-subprim-call-vinsn (syscall) .SPsyscall)
3783
3784(define-x8664-subprim-call-vinsn (setqsym) .SPsetqsym)
3785
3786(define-x8664-vinsn recover-fn-from-rip (()
3787 ())
3788 (leaq (:@ (:apply - (:^ :disp)) (:%q x8664::rip)) (:%q x8664::fn))
3789 :disp)
3790
3791
3792
3793(define-x8664-subprim-call-vinsn (makeu64) .SPmakeu64)
3794
3795(define-x8664-subprim-call-vinsn (makes64) .SPmakes64)
3796
3797(define-x8664-subprim-lea-jmp-vinsn (stack-cons-list*) .SPstkconslist-star)
3798
3799(define-x8664-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
3800
3801(define-x8664-vinsn make-tsp-vcell (((dest :lisp))
3802 ((closed :lisp))
3803 ((temp :imm)))
3804 (subq (:$b (+ x8664::value-cell.size x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
3805 (movq (:rcontext x8664::tcr.save-tsp) (:%mmx x8664::stack-temp))
3806 (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
3807 (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
3808 (movapd (:%xmm x8664::fpzero) (:@ x8664::dnode-size (:%q temp)))
3809 (movq (:%mmx x8664::stack-temp) (:@ (:%q temp)))
3810 (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
3811 (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
3812 (movq (:$l x8664::value-cell-header) (:@ x8664::dnode-size (:%q temp)))
3813 (movq (:%q closed) (:@ (+ x8664::dnode-size x8664::node-size) (:%q temp)))
3814 (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q temp)) (:%q dest)))
3815
3816(define-x8664-subprim-lea-jmp-vinsn (bind-nil) .SPbind-nil)
3817
3818(define-x8664-subprim-lea-jmp-vinsn (bind-self) .SPbind-self)
3819
3820(define-x8664-subprim-lea-jmp-vinsn (bind-self-boundp-check) .SPbind-self-boundp-check)
3821
3822(define-x8664-subprim-lea-jmp-vinsn (bind) .SPbind)
3823
3824(define-x8664-vinsn (dpayback :call :subprim-call) (()
3825 ((n :s16const))
3826 ((temp (:u32 #.x8664::imm0))
3827 (entry (:label 1))))
3828 ((:pred > n 0)
3829 ((:pred > n 1)
3830 (movl (:$l n) (:%l temp))
3831 (:talign 4)
3832 (call (:@ .SPunbind-n)))
3833 ((:pred = n 1)
3834 (:talign 4)
3835 (call (:@ .SPunbind)))
3836 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
3837
3838(define-x8664-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
3839
3840(define-x8664-subprim-call-vinsn (make-stack-list) .Spmakestacklist)
3841
3842(define-x8664-vinsn node-slot-ref (((dest :lisp))
3843 ((node :lisp)
3844 (cellno :u32const)))
3845 (movq (:@ (:apply + x8664::misc-data-offset (:apply ash cellno 3))
3846 (:%q node)) (:%q dest)))
3847
3848(define-x8664-subprim-lea-jmp-vinsn (stack-cons-list) .SPstkconslist)
3849
3850
3851(define-x8664-vinsn %slot-ref (((dest :lisp))
3852 ((instance (:lisp (:ne dest)))
3853 (index :lisp)))
3854 (movq (:@ x8664::misc-data-offset (:%q instance) (:%q index)) (:%q dest))
3855 (cmpl (:$b x8664::slot-unbound-marker) (:%l dest))
3856 (je :bad)
3857 :ok
3858 (:anchored-uuo-section :ok)
3859 :bad
3860 (:anchored-uuo (uuo-error-slot-unbound (:%q dest) (:%q instance) (:%q index))))
3861
3862(define-x8664-vinsn eep.address (((dest t))
3863 ((src (:lisp (:ne dest )))))
3864 (movq (:@ (+ (ash 1 x8664::word-shift) x8664::misc-data-offset) (:%q src))
3865 (:%q dest))
3866 (cmpb (:$b x8664::fulltag-nil) (:%b dest))
3867 (je :bad)
3868 :ok
3869 (:anchored-uuo-section :ok)
3870 :bad
3871 (:anchored-uuo (uuo-error-eep-unresolved (:%q src) (:%q dest))))
3872
3873
3874(define-x8664-subprim-lea-jmp-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
3875
3876(define-x8664-subprim-lea-jmp-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
3877
3878(define-x8664-subprim-lea-jmp-vinsn (make-stack-vector) .SPmkstackv)
3879
3880(define-x8664-vinsn %current-frame-ptr (((dest :imm))
3881 ())
3882 (movq (:%q x8664::rbp) (:%q dest)))
3883
3884(define-x8664-vinsn %foreign-stack-pointer (((dest :imm))
3885 ())
3886 (movq (:rcontext x8664::tcr.foreign-sp) (:%q dest)))
3887
3888
3889(define-x8664-vinsn %set-scharcode8 (()
3890 ((str :lisp)
3891 (idx :imm)
3892 (code :imm))
3893 ((imm :u64)
3894 (imm1 :u64)))
3895 (movq (:%q code) (:%q imm1))
3896 (movq (:%q idx) (:%q imm))
3897 (shrq (:$ub x8664::fixnumshift) (:%q imm1))
3898 (shrq (:$ub x8664::word-shift) (:%q imm))
3899 (movb (:%b imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm))))
3900
3901
3902(define-x8664-vinsn %set-scharcode32 (()
3903 ((str :lisp)
3904 (idx :imm)
3905 (code :imm))
3906 ((imm :u64)
3907 (imm1 :u64)))
3908 (movq (:%q code) (:%q imm1))
3909 (movq (:%q idx) (:%q imm))
3910 (shrq (:$ub x8664::fixnumshift) (:%q imm1))
3911 (shrq (:$ub 1) (:%q imm))
3912 (movl (:%l imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm))))
3913
3914
3915
3916
3917(define-x8664-vinsn pop-argument-registers (()
3918 ())
3919 (testl (:%l x8664::nargs) (:%l x8664::nargs))
3920 (je :done)
3921 (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
3922 (popq (:%q x8664::arg_z))
3923 (jb :done)
3924 (popq (:%q x8664::arg_y))
3925 (je :done)
3926 (popq (:%q x8664::arg_x))
3927 :done)
3928
3929(define-x8664-vinsn %symptr->symvector (((target :lisp))
3930 ((target :lisp)))
3931 (subb (:$b (- x8664::fulltag-symbol x8664::fulltag-misc)) (:%b target)))
3932
3933(define-x8664-vinsn %symvector->symptr (((target :lisp))
3934 ((target :lisp)))
3935 (addb (:$b (- x8664::fulltag-symbol x8664::fulltag-misc)) (:%b target)))
3936
3937
3938(define-x8664-subprim-lea-jmp-vinsn (spread-lexpr) .SPspread-lexpr-z)
3939
3940(define-x8664-vinsn mem-ref-double-float (((dest :double-float))
3941 ((src :address)
3942 (index :s64)))
3943 (movsd (:@ (:%q src) (:%q index)) (:%xmm dest)))
3944
3945(define-x8664-vinsn mem-ref-single-float (((dest :single-float))
3946 ((src :address)
3947 (index :s64)))
3948 (movss (:@ (:%q src) (:%q index)) (:%xmm dest)))
3949
3950(define-x8664-vinsn zero-extend-nargs (()
3951 ())
3952 (movzwl (:%w x8664::nargs) (:%l x8664::nargs)))
3953
3954(define-x8664-vinsn load-adl (()
3955 ((n :u32const)))
3956 (movl (:$l n) (:%l x8664::nargs)))
3957
3958(define-x8664-subprim-lea-jmp-vinsn (macro-bind) .SPmacro-bind)
3959
3960(define-x8664-subprim-lea-jmp-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
3961
3962(define-x8664-subprim-lea-jmp-vinsn (destructuring-bind) .SPdestructuring-bind)
3963
3964(define-x8664-vinsn symbol-ref (((dest :lisp))
3965 ((src :lisp)
3966 (cellno :u32const)))
3967 (movq (:@ (:apply + (- x8664::node-size x8664::fulltag-symbol)
3968 (:apply ash cellno 3))
3969 (:%q src)) (:%q dest)))
3970
3971(define-x8664-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
3972 ((src :address)
3973 (offset :s32const))
3974 ((temp :u32)))
3975 ((:pred = 0 (:apply ash offset -6))
3976 (btq (:$ub (:apply logand 63 offset))
3977 (:@ (:%q src))))
3978 ((:not (:pred = 0 (:apply ash offset -6)))
3979 (btq (:$ub (:apply logand 63 offset))
3980 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
3981 (movl (:$l x8664::fixnumone) (:%l temp))
3982 (leaq (:@ (- x8664::fixnumone) (:%q temp)) (:%q dest))
3983 (cmovbl (:%l temp) (:%l dest)))
3984
3985(define-x8664-vinsn mem-ref-c-bit (((dest :lisp))
3986 ((src :address)
3987 (offset :s32const))
3988 ((temp :u32)))
3989 ((:pred = 0 (:apply ash offset -6))
3990 (btq (:$ub (:apply logand 63 offset))
3991 (:@ (:%q src))))
3992 ((:not (:pred = 0 (:apply ash offset -6)))
3993 (btq (:$ub (:apply logand 63 offset))
3994 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
3995 (setb (:%b temp))
3996 (movzbl (:%b temp) (:%l dest)))
3997
3998(define-x8664-vinsn mem-ref-bit-fixnum (((dest :lisp)
3999 (src :address))
4000 ((src :address)
4001 (offset :lisp))
4002 ((temp :u32)))
4003 (movq (:%q offset) (:%q temp))
4004 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4005 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4006 (movq (:%q offset) (:%q temp))
4007 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4008 (andl (:$l 63) (:%l temp))
4009 (btq (:%q temp) (:@ (:%q src)))
4010 (movl (:$l x8664::fixnumone) (:%l temp))
4011 (leaq (:@ (- x8664::fixnumone) (:%q temp)) (:%q dest))
4012 (cmovbl (:%l temp) (:%l dest)))
4013
4014(define-x8664-vinsn mem-ref-bit (((dest :lisp)
4015 (src :address))
4016 ((src :address)
4017 (offset :lisp))
4018 ((temp :u32)))
4019 (movq (:%q offset) (:%q temp))
4020 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4021 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4022 (movq (:%q offset) (:%q temp))
4023 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4024 (andl (:$l 63) (:%l temp))
4025 (btq (:%q temp) (:@ (:%q src)))
4026 (setb (:%b temp))
4027 (movzbl (:%b temp) (:%l dest)))
4028
4029
4030(define-x8664-vinsn mem-set-c-bit-0 (()
4031 ((src :address)
4032 (offset :s32const)))
4033
4034 ((:pred = 0 (:apply ash offset -6))
4035 (btrq (:$ub (:apply logand 63 offset))
4036 (:@ (:%q src))))
4037 ((:not (:pred = 0 (:apply ash offset -6)))
4038 (btrq (:$ub (:apply logand 63 offset))
4039 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src)))))
4040
4041(define-x8664-vinsn mem-set-c-bit-1 (()
4042 ((src :address)
4043 (offset :s32const)))
4044
4045 ((:pred = 0 (:apply ash offset -6))
4046 (btsq (:$ub (:apply logand 63 offset))
4047 (:@ (:%q src))))
4048 ((:not (:pred = 0 (:apply ash offset -6)))
4049 (btsq (:$ub (:apply logand 63 offset))
4050 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src)))))
4051
4052(define-x8664-vinsn mem-set-c-bit-variable-value (()
4053 ((src :address)
4054 (offset :s32const)
4055 (value :lisp)))
4056 (testq (:%q value) (:%q value))
4057 (jne :set)
4058 ((:pred = 0 (:apply ash offset -6))
4059 (btrq (:$ub (:apply logand 63 offset))
4060 (:@ (:%q src))))
4061 ((:not (:pred = 0 (:apply ash offset -6)))
4062 (btrq (:$ub (:apply logand 63 offset))
4063 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
4064 (jmp :done)
4065 :set
4066 ((:pred = 0 (:apply ash offset -6))
4067 (btsq (:$ub (:apply logand 63 offset))
4068 (:@ (:%q src))))
4069 ((:not (:pred = 0 (:apply ash offset -6)))
4070 (btsq (:$ub (:apply logand 63 offset))
4071 (:@ (:apply ash (:apply ash offset -6) 3) (:%q src))))
4072 :done)
4073
4074
4075(define-x8664-vinsn mem-set-bit-0 (((src :address))
4076 ((src :address)
4077 (offset :lisp))
4078 ((temp :u32)))
4079 (movq (:%q offset) (:%q temp))
4080 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4081 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4082 (movq (:%q offset) (:%q temp))
4083 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4084 (andl (:$l 63) (:%l temp))
4085 (btrq (:%q temp) (:@ (:%q src))))
4086
4087(define-x8664-vinsn mem-set-bit-1 (((src :address))
4088 ((src :address)
4089 (offset :lisp))
4090 ((temp :u32)))
4091 (movq (:%q offset) (:%q temp))
4092 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4093 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4094 (movq (:%q offset) (:%q temp))
4095 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4096 (andl (:$l 63) (:%l temp))
4097 (btsq (:%q temp) (:@ (:%q src))))
4098
4099
4100(define-x8664-vinsn mem-set-bit-variable-value (((src :address))
4101 ((src :address)
4102 (offset :lisp)
4103 (value :lisp))
4104 ((temp :u32)))
4105 (movq (:%q offset) (:%q temp))
4106 (shrq (:$ub (+ 6 x8664::fixnumshift)) (:%q temp))
4107 (leaq (:@ (:%q src) (:%q temp) 8) (:%q src))
4108 (movq (:%q offset) (:%q temp))
4109 (shrq (:$ub x8664::fixnumshift) (:%q temp))
4110 (andl (:$l 63) (:%l temp))
4111 (testq (:%q value) (:%q value))
4112 (jne :set)
4113 (btrq (:%q temp) (:@ (:%q src)))
4114 (jmp :done)
4115 :set
4116 (btsq (:%q temp) (:@ (:%q src)))
4117 :done)
4118
4119(define-x8664-vinsn %natural+ (((result :u64))
4120 ((result :u64)
4121 (other :u64)))
4122 (addq (:%q other) (:%q result)))
4123
4124(define-x8664-vinsn %natural+-c (((result :u64))
4125 ((result :u64)
4126 (constant :s32const)))
4127 (addq (:$l constant) (:%q result)))
4128
4129(define-x8664-vinsn %natural- (((result :u64))
4130 ((result :u64)
4131 (other :u64)))
4132 (subq (:%q other) (:%q result)))
4133
4134(define-x8664-vinsn %natural--c (((result :u64))
4135 ((result :u64)
4136 (constant :s32const)))
4137 (subq (:$l constant) (:%q result)))
4138
4139(define-x8664-vinsn %natural-logior (((result :u64))
4140 ((result :u64)
4141 (other :u64)))
4142 (orq (:%q other) (:%q result)))
4143
4144(define-x8664-vinsn %natural-logior-c (((result :u64))
4145 ((result :u64)
4146 (constant :s32const)))
4147 (orq (:$l constant) (:%q result)))
4148
4149(define-x8664-vinsn %natural-logand (((result :u64))
4150 ((result :u64)
4151 (other :u64)))
4152 (andq (:%q other) (:%q result)))
4153
4154(define-x8664-vinsn %natural-logand-c (((result :u64))
4155 ((result :u64)
4156 (constant :s32const)))
4157 (andq (:$l constant) (:%q result)))
4158
4159(define-x8664-vinsn %natural-logxor (((result :u64))
4160 ((result :u64)
4161 (other :u64)))
4162 (xorq (:%q other) (:%q result)))
4163
4164(define-x8664-vinsn %natural-logxor-c (((result :u64))
4165 ((result :u64)
4166 (constant :s32const)))
4167 (xorq (:$l constant) (:%q result)))
4168
4169(define-x8664-vinsn natural-shift-left (((dest :u64))
4170 ((dest :u64)
4171 (amt :u8const)))
4172 (shlq (:$ub amt) (:%q dest)))
4173
4174(define-x8664-vinsn natural-shift-right (((dest :u64))
4175 ((dest :u64)
4176 (amt :u8const)))
4177 (shrq (:$ub amt) (:%q dest)))
4178
4179(define-x8664-vinsn trap-unless-simple-array-2 (()
4180 ((object :lisp)
4181 (expected-flags :u32const)
4182 (type-error :u8const))
4183 ((tag :u8)))
4184 :again
4185 (movl (:%l object) (:%l tag))
4186 (andl (:$b x8664::tagmask) (:%l tag))
4187 (cmpl (:$b x8664::tag-misc) (:%l tag))
4188 (jne :bad)
4189 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4190 (jne :bad)
4191 (cmpq (:$b (ash 2 x8664::fixnumshift)) (:@ x8664::arrayH.rank (:%q object)))
4192 (jne :bad)
4193 (cmpq (:$l (:apply ash expected-flags x8664::fixnumshift)) (:@ x8664::arrayH.flags (:%q object)))
4194 (jne :bad)
4195
4196 (:anchored-uuo-section :again)
4197 :bad
4198 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub type-error))))
4199
4200(define-x8664-vinsn trap-unless-simple-array-3 (()
4201 ((object :lisp)
4202 (expected-flags :u32const)
4203 (type-error :u8const))
4204 ((tag :u8)))
4205 :again
4206 (movl (:%l object) (:%l tag))
4207 (andl (:$b x8664::tagmask) (:%l tag))
4208 (cmpl (:$b x8664::tag-misc) (:%l tag))
4209 (jne :bad)
4210 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4211 (jne :bad)
4212 (cmpq (:$b (ash 3 x8664::fixnumshift)) (:@ x8664::arrayH.rank (:%q object)))
4213 (jne :bad)
4214 (cmpq (:$l (:apply ash expected-flags x8664::fixnumshift)) (:@ x8664::arrayH.flags (:%q object)))
4215 (jne :bad)
4216 (:anchored-uuo-section :again)
4217 :bad
4218 (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub type-error))))
4219
4220(define-x8664-vinsn trap-unless-array-header (()
4221 ((object :lisp))
4222 ((tag :u8)))
4223 :again
4224 (movl (:%l object) (:%l tag))
4225 (andl (:$b x8664::tagmask) (:%l tag))
4226 (cmpl (:$b x8664::tag-misc) (:%l tag))
4227 (jne :trap)
4228 (cmpb (:$b x8664::subtag-arrayH) (:@ x8664::misc-subtag-offset (:%q object)))
4229 (jne :trap)
4230
4231 (:anchored-uuo-section :again)
4232 :trap
4233 (:anchored-uuo (uuo-error-reg-not-tag (:%q object) (:$ub x8664::subtag-arrayH))))
4234
4235(define-x8664-vinsn check-arrayH-rank (()
4236 ((header :lisp)
4237 (expected :u32const))
4238 ((rank :imm)))
4239 :anchor
4240 (movl (:$l (:apply ash expected x8664::fixnumshift)) (:%l rank))
4241 (cmpq (:@ x8664::arrayH.rank (:%q header)) (:%q rank))
4242 (jne :bad)
4243 (:anchored-uuo-section :anchor)
4244 :bad
4245 (:anchored-uuo (uuo-error-array-rank (:%q header) (:%q rank))))
4246
4247(define-x8664-vinsn check-arrayH-flags (()
4248 ((header :lisp)
4249 (expected :u32const)
4250 (type-error :u8const)))
4251 :anchor
4252 (cmpq (:$l (:apply ash expected x8664::fixnumshift))
4253 (:@ x8664::arrayH.flags (:%q header)))
4254 (jne :bad)
4255 (:anchored-uuo-section :anchor)
4256 :bad
4257 (:anchored-uuo (uuo-error-reg-not-type (:%q header) (:$ub type-error))))
4258
4259(define-x8664-vinsn misc-ref-c-u16 (((dest :u16))
4260 ((v :lisp)
4261 (idx :u32const))
4262 ())
4263 (movzwl (:@ (:apply + x8664::misc-data-offset (:apply ash idx 1)) (:%q v)) (:%l dest)))
4264
4265(define-x8664-vinsn misc-ref-c-s16 (((dest :s16))
4266 ((v :lisp)
4267 (idx :u32const))
4268 ())
4269 (movswq (:@ (:apply + x8664::misc-data-offset (:apply ash idx 1)) (:%q v)) (:%q dest)))
4270
4271(define-x8664-vinsn misc-set-single-float (()
4272 ((val :single-float)
4273 (v :lisp)
4274 (scaled-idx :u32)))
4275 (movss (:%xmm val) (:@ x8664::misc-data-offset (:% v) (:% scaled-idx))))
4276
4277(define-x8664-vinsn u16->u32 (((dest :u32))
4278 ((src :u16)))
4279 (movzwl (:%w src) (:%l dest)))
4280
4281(define-x8664-vinsn u8->u32 (((dest :u32))
4282 ((src :u8)))
4283 (movzbl (:%b src) (:%l dest)))
4284
4285
4286(define-x8664-vinsn s16->s32 (((dest :s32))
4287 ((src :s16)))
4288 (movswl (:%w src) (:%l dest)))
4289
4290(define-x8664-vinsn s8->s32 (((dest :s32))
4291 ((src :s8)))
4292 (movsbl (:%b src) (:%l dest)))
4293
4294(define-x8664-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
4295
4296(define-x8664-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
4297
4298(define-x8664-vinsn set-eq-bit (()
4299 ())
4300 (testb (:%b x8664::arg_z) (:%b x8664::arg_z)))
4301
4302(define-x8664-vinsn %schar8 (((char :imm))
4303 ((str :lisp)
4304 (idx :imm))
4305 ((imm :u32)))
4306 (movq (:%q idx) (:%q imm))
4307 (shrq (:$ub x8664::fixnumshift) (:%q imm))
4308 (movzbl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
4309 (shll (:$ub x8664::charcode-shift) (:%l imm))
4310 (leaq (:@ x8664::subtag-character (:%q imm)) (:%q char)))
4311
4312(define-x8664-vinsn %schar32 (((char :imm))
4313 ((str :lisp)
4314 (idx :imm))
4315 ((imm :u32)))
4316 (movq (:%q idx) (:%q imm))
4317 (shrq (:$ub 1) (:%q imm))
4318 (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
4319 (shll (:$ub x8664::charcode-shift) (:%l imm))
4320 (leaq (:@ x8664::subtag-character (:%q imm)) (:%q char)))
4321
4322
4323(define-x8664-vinsn %set-schar8 (()
4324 ((str :lisp)
4325 (idx :imm)
4326 (char :imm))
4327 ((imm0 :u64)
4328 (imm1 :u64)))
4329 (movq (:%q idx) (:%q imm0))
4330 (movl (:%l char) (:%l imm1))
4331 (shrq (:$ub x8664::fixnumshift) (:%q imm0))
4332 (shrl (:$ub x8664::charcode-shift) (:%l imm1))
4333 (movb (:%b imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm0))))
4334
4335(define-x8664-vinsn %set-schar32 (()
4336 ((str :lisp)
4337 (idx :imm)
4338 (char :imm))
4339 ((imm0 :u64)
4340 (imm1 :u64)))
4341 (movq (:%q idx) (:%q imm0))
4342 (movl (:%l char) (:%l imm1))
4343 (shrq (:$ub 1) (:%q imm0))
4344 (shrl (:$ub x8664::charcode-shift) (:%l imm1))
4345 (movl (:%l imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm0))))
4346
4347(define-x8664-vinsn misc-set-c-single-float (((val :single-float))
4348 ((v :lisp)
4349 (idx :u32const)))
4350 (movss (:%xmm val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
4351
4352(define-x8664-vinsn array-data-vector-ref (((dest :lisp))
4353 ((header :lisp)))
4354 (movq (:@ x8664::arrayH.data-vector (:%q header)) (:%q dest)))
4355
4356(define-x8664-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
4357
4358(define-x8664-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
4359
4360(define-x8664-vinsn mem-ref-c-absolute-u8 (((dest :u8))
4361 ((addr :s32const)))
4362 (movzbl (:@ addr) (:%l dest)))
4363
4364(define-x8664-vinsn mem-ref-c-absolute-s8 (((dest :s8))
4365 ((addr :s32const)))
4366 (movsbq (:@ addr) (:%q dest)))
4367
4368(define-x8664-vinsn mem-ref-c-absolute-u16 (((dest :u16))
4369 ((addr :s32const)))
4370 (movzwl (:@ addr) (:%l dest)))
4371
4372(define-x8664-vinsn mem-ref-c-absolute-s16 (((dest :s16))
4373 ((addr :s32const)))
4374 (movswq (:@ addr) (:%q dest)))
4375
4376(define-x8664-vinsn mem-ref-c-absolute-fullword (((dest :u32))
4377 ((addr :s32const)))
4378 (movl (:@ addr) (:%l dest)))
4379
4380(define-x8664-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
4381 ((addr :s32const)))
4382 (movslq (:@ addr) (:%q dest)))
4383
4384(define-x8664-vinsn mem-ref-c-absolute-doubleword (((dest :s64))
4385 ((addr :s32const)))
4386 (movq (:@ addr) (:%q dest)))
4387
4388(define-x8664-vinsn mem-ref-c-absolute-signed-doubleword (((dest :s64))
4389 ((addr :s32const)))
4390 (movq (:@ addr) (:%q dest)))
4391
4392(define-x8664-vinsn mem-ref-c-absolute-natural (((dest :u64))
4393 ((addr :s32const)))
4394 (movq (:@ addr) (:%q dest)))
4395
4396(define-x8664-vinsn event-poll (()
4397 ())
4398 (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
4399 (jae :no-interrupt)
4400 (ud2a)
4401 (:byte 2)
4402 :no-interrupt)
4403
4404;;; Return dim1 (unboxed)
4405(define-x8664-vinsn check-2d-bound (((dim :u64))
4406 ((i :imm)
4407 (j :imm)
4408 (header :lisp)))
4409 :anchor
4410 (cmpq (:@ (+ x8664::misc-data-offset (* 8 x8664::arrayH.dim0-cell)) (:%q header)) (:%q i))
4411 (jae :bad-i)
4412 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header))
4413 (:%q dim))
4414 (cmpq (:%q dim) (:%q j))
4415 (jae :bad-j)
4416 (sarq (:$ub x8664::fixnumshift) (:%q dim))
4417 (:anchored-uuo-section :anchor)
4418 :bad-i
4419 (:anchored-uuo (uuo-error-array-bounds (:%q i) (:%q header)))
4420 (:anchored-uuo-section :anchor)
4421 :bad-j
4422 (:anchored-uuo (uuo-error-array-bounds (:%q j) (:%q header))))
4423
4424;;; Return dim1, dim2 (unboxed)
4425(define-x8664-vinsn check-3d-bound (((dim1 :u64)
4426 (dim2 :u64))
4427 ((i :imm)
4428 (j :imm)
4429 (k :imm)
4430 (header :lisp)))
4431 :anchor
4432 (cmpq (:@ (+ x8664::misc-data-offset (* 8 x8664::arrayH.dim0-cell)) (:%q header)) (:%q i))
4433 (jae :bad-i)
4434 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim1))
4435 (cmpq (:%q dim1) (:%q j))
4436 (jae :bad-j)
4437 (sarq (:$ub x8664::fixnumshift) (:%q dim1))
4438 (movq (:@ (+ x8664::misc-data-offset (* 8 (+ 2 x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim2))
4439 (cmpq (:%q dim2) (:%q k))
4440 (jae :bad-k)
4441 (sarq (:$ub x8664::fixnumshift) (:%q dim2))
4442 (:anchored-uuo-section :anchor)
4443 :bad-i
4444 (:anchored-uuo (uuo-error-array-bounds (:%q i) (:%q header)))
4445 (:anchored-uuo-section :anchor)
4446 :bad-j
4447 (:anchored-uuo (uuo-error-array-bounds (:%q j) (:%q header)))
4448 (:anchored-uuo-section :anchor)
4449 :bad-k
4450 (:anchored-uuo (uuo-error-array-bounds (:%q k) (:%q header)))
4451 )
4452
4453
4454(define-x8664-vinsn 2d-dim1 (((dest :u64))
4455 ((header :lisp)))
4456 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header))
4457 (:%q dest))
4458 (sarq (:$ub x8664::fixnumshift) (:%q dest)))
4459
4460
4461(define-x8664-vinsn 3d-dims (((dim1 :u64)
4462 (dim2 :u64))
4463 ((header :lisp)))
4464 (movq (:@ (+ x8664::misc-data-offset (* 8 (1+ x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim1))
4465 (movq (:@ (+ x8664::misc-data-offset (* 8 (+ 2 x8664::arrayH.dim0-cell))) (:%q header)) (:%q dim2))
4466 (sarq (:$ub x8664::fixnumshift) (:%q dim1))
4467 (sarq (:$ub x8664::fixnumshift) (:%q dim2)))
4468
4469(define-x8664-vinsn 2d-unscaled-index (((dest :imm)
4470 (dim1 :u64))
4471 ((dim1 :u64)
4472 (i :imm)
4473 (j :imm)))
4474
4475 (imulq (:%q i) (:%q dim1))
4476 (leaq (:@ (:%q j) (:%q dim1)) (:%q dest)))
4477
4478
4479;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
4480(define-x8664-vinsn 3d-unscaled-index (((dest :imm)
4481 (dim1 :u64)
4482 (dim2 :u64))
4483 ((dim1 :u64)
4484 (dim2 :u64)
4485 (i :imm)
4486 (j :imm)
4487 (k :imm)))
4488 (imulq (:%q dim2) (:%q dim1))
4489 (imulq (:%q j) (:%q dim2))
4490 (imulq (:%q i) (:%q dim1))
4491 (addq (:%q dim1) (:%q dim2))
4492 (leaq (:@ (:%q k) (:%q dim2)) (:%q dest)))
4493
4494(define-x8664-vinsn branch-unless-both-args-fixnums (()
4495 ((a :lisp)
4496 (b :lisp)
4497 (dest :label))
4498 ((tag :u8)))
4499 (movl (:%l a) (:%l tag))
4500 (orl (:%l b) (:%l tag))
4501 (testb (:$b x8664::fixnummask) (:%b tag))
4502 (jne dest))
4503
4504(define-x8664-vinsn branch-unless-arg-fixnum (()
4505 ((a :lisp)
4506 (dest :label)))
4507 (testb (:$b x8664::fixnummask) (:%b a))
4508 (jne dest))
4509
4510(define-x8664-vinsn fixnum->single-float (((f :single-float))
4511 ((arg :lisp))
4512 ((unboxed :s64)))
4513 (movq (:%q arg) (:%q unboxed))
4514 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
4515 (cvtsi2ssq (:%q unboxed) (:%xmm f)))
4516
4517(define-x8664-vinsn fixnum->double-float (((f :double-float))
4518 ((arg :lisp))
4519 ((unboxed :s64)))
4520 (movq (:%q arg) (:%q unboxed))
4521 (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
4522 (cvtsi2sdq (:%q unboxed) (:%xmm f)))
4523
4524
4525(define-x8664-vinsn xchg-registers (()
4526 ((a t)
4527 (b t)))
4528 (xchgq (:%q a) (:%q b)))
4529
4530(define-x8664-vinsn establish-fn (()
4531 ()
4532 ((entry (:label 1))))
4533 (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
4534
4535(define-x8664-vinsn align-loop-head (()
4536 ()
4537 ()))
4538
4539(queue-fixup
4540 (fixup-x86-vinsn-templates
4541 *x8664-vinsn-templates*
4542 x86::*x86-opcode-template-lists* *x8664-backend*))
4543
4544(provide "X8664-VINSNS")
4545
Note: See TracBrowser for help on using the repository browser.