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

Last change on this file since 13332 was 13332, checked in by gz, 10 years ago

Improved compilation for some fixnum operations, %svref (r13247-r13253 from trunk)

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