source: branches/lscan/source/compiler/X86/X8664/x8664-vinsns.lisp @ 16463

Last change on this file since 16463 was 16463, checked in by gb, 5 years ago

use :spill and :reload attrbutes instead of :late and :csp.

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