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

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

More tweaks.

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