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

Last change on this file since 9934 was 9934, checked in by gb, 12 years ago

Use 32-bit comparisons when checking nargs (depends on kernel changes
to always set all bits of nargs, not just the low 16).

COMPARE-CONSTANT-TO-REGISTER.

Rename TRAP-UNLESS-TYPECODE= to TRAP-UNLESS-SUBTAG= : all callers
want a vector subtag, and we can trap earlier on non-misc-tagged
things.

Do some inlined shifts a little differently.

Remove branch-prediction suffices, which take a little space and
have no real effect.

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