source: trunk/source/compiler/X86/X8664/x8664-vinsns.lisp @ 8549

Last change on this file since 8549 was 8549, checked in by rme, 13 years ago

Make compiler use CISC-y get/set/test bit instructions when
referencing/setting bits in a bit vector.

In order to avoid minor bootstrapping problems, define a few new
bit referencing and bit testing vinsns with an "n" prefix, leaving
the old ones around for now.

The x86 BT/BTS/BTR instructions take two operands: a bit base and
bit offset. When the bit base is a memory location, the bit offset
(in a register) is a signed 16/32/64 bit quantity (depending on
operand size). There's no need to limit the bit offset to
(1- TARGET::NBITS-IN-WORD).

This is shorter and removes the need to use a register for a word index.
(The register saving is no big deal on x86-64, but it matters a lot on
32-bit x86.)

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