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

Last change on this file since 13457 was 13457, checked in by gb, 10 years ago

Try to tighten up %IASR, %ILSR vinsns: use CMOV instead of branching,
avoid partial register writes.

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