Context Navigation

x8664-vinsns.lisp @ 7208

Visit:

Last change on this file since 7208 was 7208, checked in by gb, 13 years ago
er, a mishap
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 151.7 KB

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