source: branches/working-0711/ccl/compiler/X86/X8664/x8664-vinsns.lisp @ 7896

Last change on this file since 7896 was 7896, checked in by gb, 13 years ago

Revert eep.adress to old (anchored UUO out-of-line) behavior, since
the bug in the kernel's ability to resart anchored UUOs should be
fixed now.

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