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

Last change on this file since 16432 was 16432, checked in by gb, 4 years ago

ttributes in keyword package.
COPY-GPR simpler.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 191.3 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-offset dest)  (:%q x8664::rbp))))
1131   
1132 
1133  )
1134
1135(define-x8664-vinsn 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 :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 :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 :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 :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 :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 (((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 = 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))
2036  (jmp :done)
2037  :push-loop
2038  (pushq (:$l (:apply target-nil-value)))
2039  (addl (:$b x8664::node-size) (:%l x8664::nargs))
2040  (subl (:$b x8664::node-size) (:%l imm))
2041  :push-more
2042  (jne :push-loop)
2043  :done)
2044 
2045(define-x8664-vinsn (nvalret :jumpLR) (()
2046                                       ())
2047 
2048  (jmp (:@ .SPnvalret)))
2049
2050
2051(define-x8664-vinsn lisp-word-ref (((dest t))
2052                                   ((base t)
2053                                    (offset t)))
2054  (movq (:@ (:%q base) (:%q offset)) (:%q  dest)))
2055
2056
2057(define-x8664-vinsn lisp-word-ref-c (((dest t))
2058                                     ((base t)
2059                                      (offset :s32const)))
2060  ((:pred = offset 0)
2061   (movq (:@ (:%q base)) (:%q dest)))
2062  ((:not (:pred = offset 0))
2063   (movq (:@ offset (:%q base)) (:%q dest))))
2064
2065
2066(define-x8664-vinsn (vpush-label :push :node :vsp) (()
2067                                                    ((label :label))
2068                                                    ((temp :lisp)))
2069  (leaq (:@ (:^ label) (:%q x8664::fn)) (:%q temp))
2070  (pushq (:%q temp)))
2071
2072;; ????
2073(define-x8664-vinsn (emit-aligned-label :align) (()
2074                                                 ((label :label)))
2075  (:align 3)
2076  (:long (:^ label)))
2077
2078;;; %ra0 is pointing into %fn, so no need to copy %fn here.
2079(define-x8664-vinsn (pass-multiple-values-symbol :jumplr) (()
2080                                                         ())
2081  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr)))) 
2082  (jmp (:@ x8664::symbol.fcell (:% x8664::fname))))
2083
2084;;; It'd be good to have a variant that deals with a known function
2085;;; as well as this.
2086(define-x8664-vinsn (pass-multiple-values :jumplr) (()
2087                                                    ()
2088                                                    ((tag :u8)))
2089  :resume
2090  (movl (:%l x8664::temp0) (:%l tag))
2091  (andl (:$b x8664::fulltagmask) (:%l tag))
2092  (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2093  (cmovgq (:%q x8664::temp0) (:%q x8664::fn))
2094  (jl :bad)
2095  (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::fn))
2096  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
2097  (jmp (:%q x8664::fn))
2098
2099  (:anchored-uuo-section :resume)
2100  :bad
2101  (:anchored-uuo (uuo-error-not-callable)))
2102
2103(define-x8664-vinsn (pass-multiple-values-known-function :jumplr) (((fnreg :lisp))
2104                                                                    ())
2105  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr)))) 
2106  (jmp (:%q fnreg)))
2107
2108
2109(define-x8664-vinsn reserve-outgoing-frame (()
2110                                            ())
2111  (pushq (:$b x8664::reserved-frame-marker))
2112  (pushq (:$b x8664::reserved-frame-marker)))
2113
2114
2115(define-x8664-vinsn (call-known-function :call) (()
2116                                                 ()
2117                                                 ((entry (:label 1))))
2118  (:talign 4)
2119  (call (:%q x8664::temp0))
2120  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2121
2122(define-x8664-vinsn (jump-known-function :jumplr) (()
2123                                                   ()
2124                                                   ((xfn (:lisp #.x8664::xfn))))
2125  (movq (:%q x8664::fn) (:%q x8664::xfn))
2126  (movq (:%q x8664::temp0)  (:%q x8664::fn))
2127  (jmp (:%q x8664::fn)))
2128
2129(define-x8664-vinsn (list :call) (()
2130                                  ()
2131                                  ((entry (:label 1))))
2132  (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
2133  (:talign 4)
2134  (jmp (:@ .SPconslist))
2135  :back
2136  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2137
2138
2139(define-x8664-vinsn make-tsp-cons (((dest :lisp))
2140                                   ((car :lisp) (cdr :lisp))
2141                                   ((temp :imm)
2142                                    (stack-temp :imm)))
2143  (subq (:$b (+ x8664::cons.size x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
2144  (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
2145  (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
2146  (movapd (:%xmm x8664::fpzero) (:@ 16 (:%q temp)))
2147  (movq (:rcontext x8664::tcr.save-tsp) (:%q stack-temp))
2148  (movq (:%q stack-temp) (:@ (:%q temp)))
2149  (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp)))
2150  (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2151  (leaq (:@ (+ x8664::dnode-size x8664::fulltag-cons) (:%q temp)) (:%q temp))
2152  (movq (:%q car) (:@ x8664::cons.car (:%q temp)))
2153  (movq (:%q cdr) (:@ x8664::cons.cdr (:%q temp)))
2154  (movq (:%q temp) (:%q dest)))
2155
2156(define-x8664-vinsn make-fixed-stack-gvector (((dest :lisp))
2157                                              ((aligned-size :u32const)
2158                                               (header :s32const))
2159                                              ((tempa :imm)
2160                                               (tempb :imm)
2161                                               (stack-temp :imm)))
2162  ((:and (:pred >= (:apply + aligned-size x8664::dnode-size) -128)
2163         (:pred <= (:apply + aligned-size x8664::dnode-size) 127))
2164   (subq (:$b (:apply + aligned-size x8664::dnode-size))
2165         (:rcontext x8664::tcr.next-tsp)))
2166  ((:not (:and (:pred >= (:apply + aligned-size x8664::dnode-size) -128)
2167               (:pred <= (:apply + aligned-size x8664::dnode-size) 127)))
2168   (subq (:$l (:apply + aligned-size x8664::dnode-size))
2169         (:rcontext x8664::tcr.next-tsp)))
2170  (movq (:rcontext x8664::tcr.save-tsp) (:%q tempb))
2171  (movq (:rcontext x8664::tcr.next-tsp) (:%q tempa))
2172  (movq (:%q tempb) (:%q stack-temp))
2173  :loop
2174  (movapd (:%xmm x8664::fpzero) (:@ -16 (:%q tempb)))
2175  (subq (:$b x8664::dnode-size) (:%q tempb))
2176  (cmpq (:%q tempa) (:%q tempb))
2177  (jnz :loop)
2178  (movq (:%q stack-temp) (:@ (:%q tempa)))
2179  (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q tempa)))
2180  (movq (:%q tempa) (:rcontext x8664::tcr.save-tsp))
2181  (movl (:$l header) (:@ x8664::dnode-size (:%q tempa)))
2182  (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q tempa)) (:%q dest)))
2183
2184
2185(define-x8664-vinsn (discard-temp-frame :tsp :pop :discard) (()
2186                                        ()
2187                                        ((temp :imm)))
2188  (movq (:rcontext x8664::tcr.save-tsp) (:%q temp))
2189  (movq (:@ (:%q temp)) (:%q temp))
2190  (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2191  (movq (:%q temp) (:rcontext x8664::tcr.next-tsp))
2192  )
2193
2194(define-x8664-vinsn (discard-c-frame :csp :pop :discard) (()
2195                                     ()
2196                                     ((temp :imm)))
2197  (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
2198  (movq (:@ (:%q temp)) (:%q temp))
2199  (movq (:%q temp) (:rcontext x8664::tcr.foreign-sp)))
2200
2201 
2202(define-x8664-vinsn (vstack-discard :vsp :pop :discard) (()
2203                                    ((nwords :u32const)))
2204  ((:not (:pred = nwords 0))
2205   ((:pred < nwords 16)
2206    (addq (:$b (:apply ash nwords x8664::word-shift)) (:%q x8664::rsp)))
2207   ((:not (:pred < nwords 16))
2208    (addq (:$l (:apply ash nwords x8664::word-shift)) (:%q x8664::rsp)))))
2209
2210
2211(defmacro define-x8664-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
2212  `(define-x8664-vinsn (,name :call :subprim ,@other-attrs) (() () ((entry (:label 1))))
2213    (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
2214    (:talign 4)
2215    (jmp (:@ ,spno))
2216    :back
2217    (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
2218
2219(defmacro define-x8664-subprim-call-vinsn ((name &rest other-attrs) spno)
2220  `(define-x8664-vinsn (,name :call :subprim ,@other-attrs) (() () ((entry (:label 1))))
2221    (:talign 4)
2222    (call (:@ ,spno))
2223    :back
2224    (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))))
2225
2226(defmacro define-x8664-subprim-jump-vinsn ((name &rest other-attrs) spno)
2227  `(define-x8664-vinsn (,name :jumpLR ,@other-attrs) (() ())
2228    (jmp (:@ ,spno))))
2229
2230(define-x8664-vinsn (nthrowvalues :call :subprim) (()
2231                                                        ((lab :label)))
2232  (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q x8664::ra0))
2233  (jmp (:@ .SPnthrowvalues)))
2234
2235(define-x8664-vinsn (nthrow1value :call :subprim) (()
2236                                                        ((lab :label)))
2237  (leaq (:@ (:^ lab) (:%q x8664::fn)) (:%q x8664::ra0))
2238  (jmp (:@ .SPnthrow1value)))
2239
2240
2241
2242(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
2243
2244
2245(define-x8664-vinsn bind-interrupt-level-0-inline (()
2246                                                   ()
2247                                                   ((temp :imm)))
2248  (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2249  (cmpq (:$b 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
2250  (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
2251  (pushq (:$b x8664::interrupt-level-binding-index))
2252  (pushq (:rcontext x8664::tcr.db-link))
2253  (movq (:$l 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
2254  (movq (:%q x8664::rsp) (:rcontext x8664::tcr.db-link))
2255  (jns :done)
2256  (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
2257  (jae :done)
2258  (ud2a)
2259  (:byte 2)
2260  :done)
2261 
2262 
2263
2264(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
2265
2266(define-x8664-vinsn bind-interrupt-level-m1-inline (()
2267                                                   ()
2268                                                   ((temp :imm)))
2269  (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2270  (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
2271  (pushq (:$b x8664::interrupt-level-binding-index))
2272  (pushq (:rcontext x8664::tcr.db-link))
2273  (movq (:$l (ash -1 x8664::fixnumshift)) (:@ x8664::interrupt-level-binding-index (:%q temp)))
2274  (movq (:%q x8664::rsp) (:rcontext x8664::tcr.db-link)))
2275
2276(define-x8664-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
2277
2278(define-x8664-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
2279
2280(define-x8664-vinsn unbind-interrupt-level-inline (()
2281                                                   ()
2282                                                   ((link :imm)
2283                                                    (curval :imm)
2284                                                    (oldval :imm)
2285                                                    (tlb :imm)))
2286  (movq (:rcontext x8664::tcr.tlb-pointer) (:%q tlb))
2287  (movq (:rcontext x8664::tcr.db-link) (:%q link))
2288  (movq (:@ x8664::interrupt-level-binding-index (:%q tlb)) (:%q curval))
2289  (testq (:%q curval) (:%q curval))
2290  (movq (:@ 16 #|binding.val|# (:%q link)) (:%q oldval))
2291  (movq (:@ #|binding.link|# (:%q link)) (:%q link))
2292  (movq (:%q oldval) (:@ x8664::interrupt-level-binding-index (:%q tlb)))
2293  (movq (:%q link) (:rcontext x8664::tcr.db-link))
2294  (jns :done)
2295  (testq (:%q oldval) (:%q oldval))
2296  (js :done)
2297  (btrq (:$ub 63) (:rcontext x8664::tcr.interrupt-pending))
2298  (jae :done)
2299  (ud2a)
2300  (:byte 2)
2301  :done) 
2302
2303(define-x8664-vinsn (jump-return-pc :jumpLR)
2304    (()
2305     ())
2306  (ret))
2307
2308(define-x8664-vinsn (nmkcatchmv :call :subprim) (()
2309                                                     ((lab :label))
2310                                                     ((entry (:label 1))))
2311  (leaq (:@ (:^ lab)  (:%q x8664::fn)) (:%q x8664::xfn))
2312  (:talign 4)
2313  (call (:@ .SPmkcatchmv))
2314  :back
2315  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2316
2317(define-x8664-vinsn (nmkcatch1v :call :subprim) (()
2318                                                     ((lab :label))
2319                                                     ((entry (:label 1))))
2320  (leaq (:@ (:^ lab)  (:%q x8664::fn)) (:%q x8664::xfn))
2321  (:talign 4)
2322  (call (:@ .SPmkcatch1v))
2323  :back
2324  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2325
2326
2327(define-x8664-vinsn (make-simple-unwind :call :subprim) (()
2328                                                     ((protform-lab :label)
2329                                                      (cleanup-lab :label)))
2330  (leaq (:@ (:^ protform-lab) (:%q x8664::fn)) (:%q x8664::ra0))
2331  (leaq (:@ (:^ cleanup-lab)  (:%q x8664::fn)) (:%q x8664::xfn))
2332  (jmp (:@ .SPmkunwind)))
2333
2334(define-x8664-vinsn (nmkunwind :call :subprim) (()
2335                                                     ((protform-lab :label)
2336                                                      (cleanup-lab :label)))
2337  (leaq (:@ (:^ protform-lab) (:%q x8664::fn)) (:%q x8664::ra0))
2338  (leaq (:@ (:^ cleanup-lab)  (:%q x8664::fn)) (:%q x8664::xfn))
2339  (jmp (:@ .SPnmkunwind)))
2340
2341;;; "old" mkunwind.  Used by PROGV, since the binding of *interrupt-level*
2342;;; on entry to the new mkunwind confuses the issue.
2343
2344(define-x8664-vinsn (mkunwind :call :subprim) (()
2345                                                     ((protform-lab :label)
2346                                                      (cleanup-lab :label)))
2347  (leaq (:@ (:^ protform-lab) (:%q x8664::fn)) (:%q x8664::ra0))
2348  (leaq (:@ (:^ cleanup-lab)  (:%q x8664::fn)) (:%q x8664::xfn))
2349  (jmp (:@ .SPmkunwind)))
2350
2351(define-x8664-subprim-lea-jmp-vinsn (gvector) .SPgvector)
2352
2353(define-x8664-subprim-call-vinsn (getu64) .SPgetu64)
2354
2355;;; Call something callable and obtain the single value that it
2356;;; returns.
2357(define-x8664-vinsn (funcall :call) (()
2358                                     ()
2359                                     ((tag :u8)
2360                                      (entry (:label 1))))
2361  :resume
2362  (movl (:%l x8664::temp0) (:%l tag))
2363  (andl (:$b x8664::fulltagmask) (:%l tag))
2364  (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2365  (cmovgq (:%q x8664::temp0) (:%q x8664::xfn))
2366  (jl :bad)
2367  (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::xfn))
2368  (:talign 4)
2369  (call (:%q x8664::xfn))
2370  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
2371  (:anchored-uuo-section :resume)
2372  :bad
2373  (:anchored-uuo (uuo-error-not-callable)))
2374
2375(define-x8664-vinsn (tail-funcall :jumplr) (()
2376                                            ()
2377                                            ((tag (:u8 #.x8664::imm0))))
2378  :resume
2379  (movl (:%l x8664::temp0) (:%l tag))
2380  (andl (:$b x8664::fulltagmask) (:%l tag))
2381  (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
2382  (cmovgq (:%q x8664::temp0) (:%q x8664::xfn))
2383  (jl :bad)
2384  (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::xfn))
2385  (jmp (:%q x8664::xfn))
2386
2387  (:anchored-uuo-section :resume)
2388  :bad
2389  (:anchored-uuo (uuo-error-not-callable)))
2390                             
2391
2392
2393;;; Magic numbers in here include the address of .SPcall-closure.
2394(define-x8664-vinsn init-nclosure (()
2395                                   ((closure :lisp))
2396                                   ((imm0 :u64)))
2397  (movq (:$q #x24fffffffff92d8d) (:%q imm0))
2398  (movb (:$b 4) (:@ x8664::misc-data-offset (:%q closure))) ; code word count
2399  (movb (:$b #x4c) (:@ (+ x8664::misc-data-offset 7) (:%q closure))) ; 1st byte of lea
2400  (movq (:%q imm0) (:@ (+ x8664::misc-data-offset 8) (:%q closure))) ; rest of lea, start of jmp
2401  (movl (:$l #x01516825) (:@ (+ x8664::misc-data-offset 16) (:%q closure)))
2402  (movb (:$b x8664::function-boundary-marker) (:@ (+ x8664::misc-data-offset 24)  (:%q closure))))
2403
2404
2405(define-x8664-vinsn finalize-closure (((closure :lisp))
2406                                      ((closure :lisp)))
2407  (addq (:$b (- x8664::fulltag-function x8664::fulltag-misc)) (:%q closure)))
2408
2409
2410(define-x8664-vinsn (ref-symbol-value :call :subprim)
2411    (((val :lisp))
2412     ((sym (:lisp (:ne val))))
2413     ((entry (:label 1))))
2414  (:talign 4)
2415  (call (:@ .SPspecrefcheck))
2416  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)) )
2417
2418(define-x8664-vinsn ref-symbol-value-inline (((dest :lisp))
2419                                              ((src (:lisp (:ne dest))))
2420                                              ((table :imm)
2421                                               (idx :imm)))
2422  :resume
2423  (movq (:@ x8664::symbol.binding-index (:%q src)) (:%q idx))
2424  ;; The entry for binding-index 0 in the table always
2425  ;; contains a no-thread-local-binding marker; treat
2426  ;; out-of-bounds indices as 0 to avoid branches
2427  (xorl (:%l table) (:%l table))
2428  (rcmpq (:%q idx) (:rcontext x8664::tcr.tlb-limit))
2429  (cmovael (:%l table) (:%l idx))
2430  (movq (:rcontext x8664::tcr.tlb-pointer) (:%q table))
2431  (movq (:@ (:%q table) (:%q idx)) (:%q dest))
2432  (cmpl (:$b x8664::subtag-no-thread-local-binding) (:%l dest))
2433  (cmoveq (:@ x8664::symbol.vcell (:%q src)) (:%q dest))
2434  :test
2435  (cmpl (:$b x8664::unbound-marker) (:%l dest))
2436  (je :bad)
2437
2438  (:anchored-uuo-section :resume)
2439  :bad
2440  (:anchored-uuo (uuo-error-unbound (:%q src))))
2441
2442
2443(define-x8664-vinsn (%ref-symbol-value :call :subprim)
2444    (((val :lisp))
2445     ((sym (:lisp (:ne val))))
2446     ((entry (:label 1))))
2447  (:talign 4)
2448  (call (:@ .SPspecref))
2449  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
2450
2451(define-x8664-vinsn %ref-symbol-value-inline (((dest :lisp))
2452                                              ((src (:lisp (:ne dest))))
2453                                              ((table :imm)
2454                                               (idx :imm)))
2455  ;; Treat out-of-bounds indices as index 0
2456  (movq (:@ x8664::symbol.binding-index (:%q src)) (:%q idx))
2457  (xorl (:%l table) (:%l table))
2458  (rcmpq (:%q idx) (:rcontext x8664::tcr.tlb-limit))
2459  (cmovael (:%l table) (:%l idx))
2460  (movq (:rcontext x8664::tcr.tlb-pointer) (:%q table))
2461  (movq (:@ (:%q table) (:%q idx)) (:%q dest))
2462  (cmpb (:$b x8664::subtag-no-thread-local-binding) (:%b dest))
2463  (cmoveq (:@ x8664::symbol.vcell (:%q src)) (:%q dest)))
2464
2465(define-x8664-vinsn ref-interrupt-level (((dest :imm))
2466                                         ()
2467                                         ((temp :u64)))
2468  (movq (:rcontext x8664::tcr.tlb-pointer) (:%q temp))
2469  (movq (:@ x8664::INTERRUPT-LEVEL-BINDING-INDEX (:%q temp)) (:%q dest)))
2470
2471
2472
2473
2474(define-x8664-vinsn setup-double-float-allocation (()
2475                                                   ())
2476  (movl (:$l (arch::make-vheader x8664::double-float.element-count x8664::subtag-double-float)) (:%l x8664::imm0.l))
2477  (movl (:$l (- x8664::double-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2478
2479(define-x8664-vinsn setup-complex-double-float-allocation (()
2480                                                   ())
2481  (movl (:$l (arch::make-vheader 6 x8664::subtag-complex-double-float)) (:%l x8664::imm0.l))
2482  (movl (:$l (- x8664::complex-double-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2483
2484(define-x8664-vinsn setup-complex-single-float-allocation (()
2485                                                   ())
2486  (movl (:$l (arch::make-vheader 2 x8664::subtag-complex-single-float)) (:%l x8664::imm0.l))
2487  (movl (:$l (- x8664::complex-single-float.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2488
2489(define-x8664-vinsn set-double-float-value (()
2490                                            ((node :lisp)
2491                                             (val :double-float)))
2492  (movsd (:%xmm val) (:@ x8664::double-float.value (:%q node))))
2493
2494(define-x8664-vinsn set-complex-double-float-value (()
2495                                                    ((node :lisp)
2496                                                     (val :complex-double-float)))
2497  (movdqa (:%xmm val) (:@ x8664::complex-double-float.realpart (:%q node))))
2498
2499(define-x8664-vinsn set-complex-single-float-value (()
2500                                                    ((node :lisp)
2501                                                     (val :complex-single-float)))
2502  (movq (:%xmm val) (:@ x8664::complex-single-float.realpart (:%q node))))
2503
2504
2505(define-x8664-vinsn word-index-and-bitnum-from-index (((word-index :u64)
2506                                                       (bitnum :u8))
2507                                                      ((index :imm)))
2508  (movq (:%q index) (:%q word-index))
2509  (shrq (:$ub x8664::fixnumshift) (:%q word-index))
2510  (movl (:$l 63) (:%l bitnum))
2511  (andl (:%l word-index) (:%l bitnum))
2512  (shrq (:$ub 6) (:%q word-index)))
2513
2514(define-x8664-vinsn ref-bit-vector-fixnum (((dest :imm)
2515                                            (bitnum :u8))
2516                                           ((bitnum :u8)
2517                                            (bitvector :lisp)
2518                                            (word-index :u64)))
2519  (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector) (:%q word-index) 8))
2520  (setb (:%b bitnum))
2521  (negb (:%b bitnum))
2522  (andl (:$l x8664::fixnumone) (:%l bitnum))
2523  (movl (:%l bitnum) (:%l dest)))
2524
2525(define-x8664-vinsn nref-bit-vector-fixnum (((dest :imm)
2526                                             (bitnum :s64))
2527                                            ((bitnum :s64)
2528                                             (bitvector :lisp))
2529                                            ())
2530  (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector)))
2531  (setc (:%b bitnum))
2532  (movzbl (:%b bitnum) (:%l bitnum))
2533  (imull (:$b x8664::fixnumone) (:%l bitnum) (:%l dest)))
2534
2535
2536(define-x8664-vinsn nref-bit-vector-flags (()
2537                                            ((bitnum :s64)
2538                                             (bitvector :lisp))
2539                                            ())
2540  (btq (:%q bitnum) (:@ x8664::misc-data-offset (:%q bitvector))))
2541
2542(define-x8664-vinsn misc-ref-c-bit-fixnum (((dest :imm))
2543                                           ((src :lisp)
2544                                            (idx :u64const))
2545                                           ((temp :u8)))
2546  (btq (:$ub (:apply logand 63 idx))
2547       (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
2548  (setc (:%b temp))
2549  (movzbl (:%b temp) (:%l temp))
2550  (imull (:$b x8664::fixnumone) (:%l temp) (:%l dest)))
2551
2552
2553(define-x8664-vinsn misc-ref-c-bit-flags (()
2554                                           ((src :lisp)
2555                                            (idx :u64const))
2556                                          )
2557  (btq (:$ub (:apply logand 63 idx))
2558       (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
2559
2560(define-x8664-vinsn deref-macptr (((addr :address))
2561                                  ((src :lisp))
2562                                  ())
2563  (movq (:@ x8664::macptr.address (:%q src)) (:%q addr)))
2564
2565(define-x8664-vinsn reserve-spill-area (() () ((count :u32)))
2566  ((:pred > (:apply  x8664-spill-area-needed) 0)
2567   ((:pred = (:apply  x8664-spill-area-needed) 1)
2568    (pushq (:$b 0)))
2569   ((:pred = (:apply  x8664-spill-area-needed) 2)
2570    (pushq (:$b 0))
2571    (pushq (:$b 0)))
2572  ((:pred = (:apply  x8664-spill-area-needed) 3)
2573   (pushq (:$b 0))
2574   (pushq (:$b 0))
2575   (pushq (:$b 0)))
2576   ((:pred = (:apply  x8664-spill-area-needed) 4)
2577    (pushq (:$b 0))
2578    (pushq (:$b 0))
2579    (pushq (:$b 0))
2580    (pushq (:$b 0)))
2581   ((:pred = (:apply  x8664-spill-area-needed) 5)
2582    (pushq (:$b 0))
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    (movl (:$l (:apply  x8664-spill-area-needed)) (:%l count))
2589    :loop
2590    (pushq (:$b 0))
2591    (subl (:$b 1) (:%l count))
2592    (jge :loop))))
2593           
2594           
2595           
2596 
2597(define-x8664-vinsn save-nfp (()
2598                              ()
2599                            )
2600  ((:pred > (:apply x862-max-nfp-depth) 0)
2601   (movq (:rcontext x8664::tcr.foreign-sp) (:%mmx x8664::stack-temp))
2602   (:if (:pred < (:apply + 16 (:apply x862-max-nfp-depth)) 128)
2603     (subq (:$b (:apply + 16 (:apply x862-max-nfp-depth))) (:rcontext x8664::tcr.foreign-sp))
2604     (subq (:$l (:apply + 16 (:apply x862-max-nfp-depth))) (:rcontext x8664::tcr.foreign-sp)))
2605   (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::temp5))
2606   (movq (:%mmx x8664::stack-temp) (:@ (:%q x8664::temp5)))
2607   (movq (:rcontext x8664::tcr.nfp) (:%mmx x8664::stack-temp))
2608   (movq (:%mmx x8664::stack-temp) (:@ 8 (:%q x8664::temp5)))
2609   (movq (:%q x8664::temp5) (:rcontext x8664::tcr.nfp))))
2610
2611
2612
2613
2614(define-x8664-vinsn restore-nfp (()
2615                                 ()
2616                                 ())
2617  ((:pred > (:apply x862-max-nfp-depth) 0)
2618   (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2619   (movq (:@ 8 (:%q x8664::temp5)) (:%mmx x8664::stack-temp))
2620   (movq (:@ (:%q x8664::temp5)) (:%q x8664::temp5))
2621   (movq (:%q x8664::temp5) (:rcontext x8664::tcr.foreign-sp))
2622   (movq (:%mmx x8664::stack-temp)(:rcontext x8664::tcr.nfp))))
2623
2624
2625
2626
2627
2628
2629
2630
2631(define-x8664-vinsn (reload-natural :nfp :ref) (((val :u64))
2632                                                       ((offset :u16const)))
2633  (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2634  (movq (:@ (:apply + 16 offset) (:%q x8664::temp5)) (:%q val)))
2635
2636
2637
2638
2639(define-x8664-vinsn (reload-double-float :nfp :ref) (((val :double-float))
2640                                                       ((offset :u16const)))
2641  (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2642  (movsd (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2643
2644
2645
2646
2647
2648
2649
2650(define-x8664-vinsn (reload-single-float :nfp :ref) (((val :single-float))
2651                                           ((offset :u16const)
2652                                            ))
2653  (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2654  (movss (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2655
2656
2657
2658
2659(define-x8664-vinsn (reload-complex-single-float :nfp :ref) (((val :complex-single-float))
2660                                                               ((offset :u16const)
2661                                                                (nfp :imm)))
2662  (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2663  (movq (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2664
2665
2666
2667
2668(define-x8664-vinsn (reload-complex-double-float :nfp :ref) (((val :complex-double-float))
2669                                                               ((offset :u16const)
2670                                                                ))
2671  (movq (:rcontext x8664::tcr.nfp) (:%q x8664::temp5))
2672  (movdqu (:@ (:apply + 16 offset) (:% x8664::temp5)) (:%xmm val)))
2673
2674(define-x8664-vinsn (temp-push-unboxed-word :push :word :csp)
2675    (()
2676     ((w :u64))
2677     ((temp :imm)
2678      (stack-temp :imm)))
2679  (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
2680  (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp))
2681  (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::temp5))
2682  (movq (:%q stack-temp) (:@ (:%q x8664::temp5)))
2683  (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q x8664::temp5)))
2684  (movq (:%q w) (:@ x8664::dnode-size (:%q x8664::temp5))))
2685
2686
2687(define-x8664-vinsn (temp-push-node :push :word :tsp)
2688        (()
2689         ((w :lisp))
2690         ((temp :imm)
2691          (stack-temp :imm)))
2692  (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.next-tsp))
2693  (movq (:rcontext x8664::tcr.save-tsp) (:%q stack-temp))
2694  (movq (:rcontext x8664::tcr.next-tsp) (:%q temp))
2695  (movapd (:%xmm x8664::fpzero) (:@ (:%q temp)))
2696  (movapd (:%xmm x8664::fpzero) (:@ 16 (:%q temp)))
2697  (movq (:%q stack-temp) (:@ (:%q temp)))
2698  (movq (:% x8664::rbp) (:@ x8664::tsp-frame.rbp (:%q temp))) 
2699  (movq (:%q temp) (:rcontext x8664::tcr.save-tsp))
2700  (movq (:%q w) (:@ x8664::dnode-size (:%q temp))))
2701
2702(define-x8664-vinsn (temp-push-double-float :push :word :csp)
2703    (()
2704     ((f :double-float))
2705     ((temp :imm)
2706      (stack-temp :imm)))
2707  (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp)) 
2708  (subq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp))
2709  (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp)) 
2710  (movq (:%q stack-temp) (:@ (:%q temp)))
2711  (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q temp)))
2712  (movapd (:%xmm f) (:@ x8664::dnode-size (:%q temp))))
2713
2714
2715(define-x8664-vinsn (vpush-single-float :push :word :vsp)
2716    (()
2717     ((f :single-float)))
2718  (pushq (:$b x8664::tag-single-float))
2719  (movss (:%xmm f) (:@ 4 (:%q x8664::rsp))))
2720
2721(define-x8664-vinsn (vpop-single-float :pop :word :vsp)
2722    (()
2723     ((f :single-float)))
2724  (movss (:@ 4 (:%q x8664::rsp)) (:%xmm f))
2725  (addq (:$b x8664::node-size) (:%q x8664::rsp)))
2726
2727(define-x8664-vinsn (temp-pop-unboxed-word :pop :word :csp)
2728    (((w :u64))
2729     ()
2730     ((temp (:u64 #.x8664::ra0))))
2731  (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2732  (movq (:@ x8664::dnode-size (:%q x8664::ra0)) (:%q w))
2733  (addq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp)))
2734
2735
2736(define-x8664-vinsn (temp-pop-node :pop :word :tsp)
2737        (((w :lisp))
2738         ()
2739         ((temp :imm)))
2740  (movq (:rcontext x8664::tcr.save-tsp) (:%q temp))
2741  (movq (:@ x8664::dnode-size (:%q temp)) (:%q w))
2742  (movq (:@ (:%q temp)) (:%q temp))
2743  (movq (:%q temp) (:rcontext x8664::tcr.save-tsp)) 
2744  (movq (:%q temp) (:rcontext x8664::tcr.next-tsp)))
2745
2746(define-x8664-vinsn (temp-pop-double-float :pop :word :csp)
2747    (((f :double-float))
2748     ()
2749     ((temp (:u64 #.x8664::ra0))))
2750  (movq (:rcontext x8664::tcr.foreign-sp) (:%q x8664::ra0))
2751  (movapd (:@ x8664::dnode-size (:%q x8664::ra0)) (:%xmm f))
2752  (addq (:$b (* 2 x8664::dnode-size)) (:rcontext x8664::tcr.foreign-sp)))
2753
2754
2755
2756(define-x8664-vinsn macptr->stack (((dest :lisp))
2757                                   ((ptr :address))
2758                                   ((temp :imm)
2759                                    (stack-temp :imm)))
2760  (movq (:rcontext x8664::tcr.foreign-sp) (:%q stack-temp))
2761  (subq (:$b (+ x8664::dnode-size x8664::macptr.size)) (:rcontext x8664::tcr.foreign-sp))
2762  (movq (:rcontext x8664::tcr.foreign-sp) (:%q temp))
2763  (movq (:%q stack-temp) (:@ (:%q temp)))
2764  (movq (:% x8664::rbp) (:@ x8664::csp-frame.rbp (:%q temp)))
2765  (leaq (:@ (+ x8664::dnode-size x8664::fulltag-misc) (:%q temp)) (:%q dest))
2766  (movq (:$l x8664::macptr-header) (:@ x8664::macptr.header (:%q dest)))
2767  (movq (:%q ptr) (:@ x8664::macptr.address (:%q dest)))
2768  (movapd (:%xmm x8664::fpzero)  (:@ x8664::macptr.domain (:%q dest))))
2769
2770(define-x8664-vinsn fixnum->signed-natural (((dest :s64))
2771                                            ((src :imm)))
2772  (movq (:%q src) (:%q dest))
2773  (sarq (:$ub x8664::fixnumshift) (:%q dest)))
2774
2775(define-x8664-vinsn mem-set-double-float (()
2776                                          ((val :double-float)
2777                                           (src :address)
2778                                           (index :s64)))
2779  (movsd (:%xmm val) (:@ (:%q src) (:%q  index))))
2780
2781(define-x8664-vinsn mem-set-single-float (()
2782                                          ((val :single-float)
2783                                           (src :address)
2784                                           (index :s64)))
2785  (movss (:%xmm val) (:@ (:%q src) (:%q  index))))
2786
2787
2788
2789(define-x8664-vinsn mem-set-c-doubleword (()
2790                                          ((val :u64)
2791                                           (dest :address)
2792                                           (offset :s32const)))
2793  ((:pred = offset 0)
2794   (movq (:%q val) (:@ (:%q dest))))
2795  ((:not (:pred = offset 0))
2796   (movq (:%q val) (:@ offset (:%q dest)))))
2797
2798(define-x8664-vinsn mem-set-c-fullword (()
2799                                          ((val :u32)
2800                                           (dest :address)
2801                                           (offset :s32const)))
2802  ((:pred = offset 0)
2803   (movl (:%l val) (:@ (:%q dest))))
2804  ((:not (:pred = offset 0))
2805   (movl (:%l val) (:@ offset (:%q dest)))))
2806
2807(define-x8664-vinsn mem-set-c-halfword (()
2808                                          ((val :u16)
2809                                           (dest :address)
2810                                           (offset :s32const)))
2811  ((:pred = offset 0)
2812   (movw (:%w val) (:@ (:%q dest))))
2813  ((:not (:pred = offset 0))
2814   (movw (:%w val) (:@ offset (:%q dest)))))
2815
2816(define-x8664-vinsn mem-set-c-byte (()
2817                                          ((val :u8)
2818                                           (dest :address)
2819                                           (offset :s32const)))
2820  ((:pred = offset 0)
2821   (movb (:%b val) (:@ (:%q dest))))
2822  ((:not (:pred = offset 0))
2823   (movb (:%b val) (:@ offset (:%q dest)))))
2824
2825(define-x8664-vinsn mem-set-c-constant-doubleword (()
2826                                                   ((val :s32const)
2827                                                    (dest :address)
2828                                                    (offset :s32const)))
2829  ((:pred = offset 0)
2830   (movq (:$l val) (:@ (:%q dest))))
2831  ((:not (:pred = offset 0))
2832   (movq (:$l val) (:@ offset (:%q dest)))))
2833
2834(define-x8664-vinsn mem-set-c-constant-fullword (()
2835                                                 ((val :s32const)
2836                                                  (dest :address)
2837                                                  (offset :s32const)))
2838  ((:pred = offset 0)
2839   (movl (:$l val) (:@ (:%q dest))))
2840  ((:not (:pred = offset 0))
2841   (movl (:$l val) (:@ offset (:%q dest)))))
2842
2843(define-x8664-vinsn mem-set-c-constant-halfword (()
2844                                                 ((val :s16const)
2845                                                  (dest :address)
2846                                                  (offset :s32const)))
2847  ((:pred = offset 0)
2848   (movw (:$w val) (:@ (:%q dest))))
2849  ((:not (:pred = offset 0))
2850   (movw (:$w val) (:@ offset (:%q dest)))))
2851
2852(define-x8664-vinsn mem-set-c-constant-byte (()
2853                                                 ((val :s8const)
2854                                                  (dest :address)
2855                                                  (offset :s32const)))
2856  ((:pred = offset 0)
2857   (movb (:$b val) (:@ (:%q dest))))
2858  ((:not (:pred = offset 0))
2859   (movb (:$b val) (:@ offset (:%q dest)))))
2860
2861
2862
2863
2864
2865
2866(define-x8664-vinsn mem-ref-natural (((dest :u64))
2867                                        ((src :address)
2868                                         (index :s64)))
2869  (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2870
2871(define-x8664-vinsn setup-macptr-allocation (()
2872                                             ((src :address)))
2873  (movq (:%q src) (:%q x8664::imm2))
2874  (movl (:$l x8664::macptr-header) (:%l x8664::imm0.l))
2875  (movl (:$l (- x8664::macptr.size x8664::fulltag-misc)) (:%l x8664::imm1.l)))
2876
2877(define-x8664-vinsn %set-new-macptr-value (()
2878                                           ((ptr :lisp)))
2879  (movq (:%q x8664::imm2) (:@ x8664::macptr.address (:%q ptr))))
2880
2881(define-x8664-vinsn mem-ref-c-fullword (((dest :u32))
2882                                        ((src :address)
2883                                         (index :s32const)))
2884  ((:pred = index 0)
2885   (movl (:@ (:%q src)) (:%l dest)))
2886  ((:not (:pred = index 0))
2887   (movl (:@ index (:%q src)) (:%l dest))))
2888
2889(define-x8664-vinsn mem-ref-c-signed-fullword (((dest :s32))
2890                                               ((src :address)
2891                                                (index :s32const)))
2892  ((:pred = index 0)
2893   (movslq (:@ (:%q src)) (:%q dest)))
2894  ((:not (:pred = index 0))
2895   (movslq (:@ index (:%q src)) (:%q dest))))
2896
2897
2898(define-x8664-vinsn mem-ref-c-single-float (((dest :single-float))
2899                                           ((src :address)
2900                                            (index :s32const)))
2901  ((:pred = index 0)
2902   (movss (:@ (:%q src)) (:%xmm dest)))
2903  ((:not (:pred = index 0))
2904   (movss (:@ index (:%q src)) (:%xmm dest))))
2905
2906(define-x8664-vinsn mem-set-c-single-float (()
2907                                            ((val :single-float)
2908                                             (src :address)
2909                                             (index :s16const)))
2910  ((:pred = index 0)
2911   (movss (:%xmm val) (:@ (:%q src))))
2912  ((:not (:pred = index 0))
2913   (movss (:%xmm val) (:@ index (:%q src)))))
2914
2915(define-x8664-vinsn mem-ref-c-doubleword (((dest :u64))
2916                                          ((src :address)
2917                                           (index :s32const)))
2918  ((:pred = index 0)
2919   (movq (:@ (:%q src)) (:%q dest)))
2920  ((:not (:pred = index 0))
2921   (movq (:@ index (:%q src)) (:%q dest))))
2922
2923(define-x8664-vinsn mem-ref-c-signed-doubleword (((dest :s64))
2924                                                 ((src :address)
2925                                                  (index :s32const)))
2926  ((:pred = index 0)
2927   (movq (:@ (:%q src)) (:%q dest)))
2928  ((:not (:pred = index 0))
2929   (movq (:@ index (:%q src)) (:%q dest))))
2930
2931(define-x8664-vinsn mem-ref-c-natural (((dest :u64))
2932                                       ((src :address)
2933                                        (index :s32const)))
2934  ((:pred = index 0)
2935   (movq (:@ (:%q src)) (:%q dest)))
2936  ((:not (:pred = index 0))
2937   (movq (:@ index (:%q src)) (:%q dest))))
2938
2939(define-x8664-vinsn mem-ref-c-double-float (((dest :double-float))
2940                                            ((src :address)
2941                                             (index :s32const)))
2942  ((:pred = index 0)
2943   (movsd (:@ (:%q src)) (:%xmm dest)))
2944  ((:not (:pred = index 0))
2945   (movsd (:@ index (:%q src)) (:%xmm dest))))
2946
2947(define-x8664-vinsn mem-set-c-double-float (()
2948                                            ((val :double-float)
2949                                             (src :address)
2950                                             (index :s16const)))
2951  ((:pred = index 0)
2952   (movsd (:%xmm val) (:@ (:%q src))))
2953  ((:not (:pred = index 0))
2954   (movsd (:%xmm val) (:@ index (:%q src)))))
2955
2956(define-x8664-vinsn mem-ref-fullword (((dest :u32))
2957                                      ((src :address)
2958                                       (index :s64)))
2959  (movl (:@ (:%q src) (:%q index)) (:%l dest)))
2960
2961(define-x8664-vinsn mem-ref-signed-fullword (((dest :s32))
2962                                             ((src :address)
2963                                              (index :s64)))
2964  (movslq (:@ (:%q src) (:%q index)) (:%q dest)))
2965
2966(define-x8664-vinsn mem-ref-doubleword (((dest :u64))
2967                                        ((src :address)
2968                                         (index :s64)))
2969  (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2970
2971(define-x8664-vinsn mem-ref-natural (((dest :u64))
2972                                        ((src :address)
2973                                         (index :s64)))
2974  (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2975
2976(define-x8664-vinsn mem-ref-signed-doubleword (((dest :s64))
2977                                               ((src :address)
2978                                                (index :s64)))
2979  (movq (:@ (:%q src) (:%q index)) (:%q dest)))
2980
2981(define-x8664-vinsn mem-ref-c-u16 (((dest :u16))
2982                                   ((src :address)
2983                                    (index :s32const)))
2984  ((:pred = index 0) 
2985   (movzwq (:@ (:%q src)) (:%q dest)))
2986  ((:not (:pred = index 0))
2987   (movzwq (:@ index (:%q src)) (:%q dest))))
2988
2989(define-x8664-vinsn mem-ref-u16 (((dest :u16))
2990                                 ((src :address)
2991                                  (index :s64)))
2992  (movzwq (:@ (:%q src) (:%q index)) (:%q dest)))
2993
2994
2995(define-x8664-vinsn mem-ref-c-s16 (((dest :s16))
2996                                   ((src :address)
2997                                    (index :s32const)))
2998  ((:pred = index 0)
2999   (movswq (:@ (:%q src)) (:%q dest)))
3000  ((:not (:pred = index 0))
3001   (movswq (:@ index (:%q src)) (:%q dest))))
3002
3003(define-x8664-vinsn mem-ref-s16 (((dest :s16))
3004                                 ((src :address)
3005                                  (index :s32)))
3006  (movswq (:@ (:%q src) (:%q index)) (:%q dest)))
3007
3008(define-x8664-vinsn mem-ref-c-u8 (((dest :u8))
3009                                  ((src :address)
3010                                   (index :s16const)))
3011  ((:pred = index 0)
3012   (movzbq (:@  (:%q src)) (:%q dest)))
3013  ((:not (:pred = index 0))
3014   (movzbq (:@ index (:%q src)) (:%q dest))))
3015
3016(define-x8664-vinsn mem-ref-u8 (((dest :u8))
3017                                ((src :address)
3018                                 (index :s32)))
3019  (movzbq (:@ (:%q src) (:%q index)) (:%q dest)))
3020
3021(define-x8664-vinsn mem-ref-c-s8 (((dest :s8))
3022                                  ((src :address)
3023                                   (index :s16const)))
3024  ((:pred = index 0)
3025   (movsbq (:@ (:%q src)) (:%q dest)))
3026  ((:not (:pred = index 0))
3027   (movsbq (:@ index (:%q src)) (:%q dest))))
3028
3029(define-x8664-vinsn misc-set-c-s8  (((val :s8))
3030                                    ((v :lisp)
3031                                     (idx :u32const))
3032                                    ())
3033  (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
3034
3035(define-x8664-vinsn misc-set-s8  (((val :s8))
3036                                  ((v :lisp)
3037                                   (scaled-idx :s64))
3038                                  ())
3039  (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3040
3041(define-x8664-vinsn mem-ref-s8 (((dest :s8))
3042                                ((src :address)
3043                                 (index :s32)))
3044  (movsbq (:@ (:%q src) (:%q index)) (:%q dest)))
3045
3046(define-x8664-vinsn mem-set-constant-doubleword (()
3047                                                 ((val :s32const)
3048                                                  (ptr :address)
3049                                                  (offset :s64)))
3050  (movq (:$l val) (:@ (:%q ptr) (:%q offset))))
3051
3052(define-x8664-vinsn mem-set-constant-fullword (()
3053                                               ((val :s32const)
3054                                                (ptr :address)
3055                                                (offset :s64)))
3056  (movl (:$l val) (:@ (:%q ptr) (:%q offset))))
3057
3058
3059(define-x8664-vinsn mem-set-constant-halfword (()
3060                                               ((val :s16const)
3061                                                (ptr :address)
3062                                                (offset :s64)))
3063  (movw (:$w val) (:@ (:%q ptr) (:%q offset))))
3064
3065(define-x8664-vinsn mem-set-constant-byte (()
3066                                           ((val :s8const)
3067                                            (ptr :address)
3068                                            (offset :s64)))
3069  (movb (:$b val) (:@ (:%q ptr) (:%q offset))))
3070
3071(define-x8664-vinsn misc-set-c-u8  (((val :u8))
3072                                    ((v :lisp)
3073                                     (idx :u32const))
3074                                    ())
3075  (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
3076
3077(define-x8664-vinsn misc-set-u8  (((val :u8))
3078                                  ((v :lisp)
3079                                   (scaled-idx :s64))
3080                                  ())
3081  (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3082
3083(define-x8664-vinsn misc-set-c-u8  (((val :u8))
3084                                    ((v :lisp)
3085                                     (idx :s32const))
3086                                    ())
3087  (movb (:%b val) (:@ (:apply + x8664::misc-data-offset idx) (:%q v))))
3088
3089(define-x8664-vinsn misc-set-u8  (()
3090                                  ((val :u8)
3091                                   (v :lisp)
3092                                   (scaled-idx :s64))
3093                                  ())
3094  (movb (:%b val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3095
3096(define-x8664-vinsn misc-set-c-u16  (()
3097                                    ((val :u16)
3098                                     (v :lisp)
3099                                     (idx :s32const))
3100                                    ())
3101  (movw (:%w val) (:@ (:apply + x8664::misc-data-offset (:apply * 2 idx)) (:%q v))))
3102
3103
3104(define-x8664-vinsn misc-set-u16  (()
3105                                   ((val :u16)
3106                                    (v :lisp)
3107                                    (scaled-idx :s64))
3108                                   ())
3109  (movw (:%w val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3110
3111(define-x8664-vinsn misc-set-c-s16  (()
3112                                    ((val :s16)
3113                                     (v :lisp)
3114                                     (idx :s32const))
3115                                    ())
3116  (movw (:%w val) (:@ (:apply + x8664::misc-data-offset (:apply * 2 idx)) (:%q v))))
3117
3118
3119(define-x8664-vinsn misc-set-s16  (()
3120                                   ((val :s16)
3121                                    (v :lisp)
3122                                    (scaled-idx :s64))
3123                                   ())
3124  (movw (:%w val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3125
3126(define-x8664-vinsn misc-set-c-u32  (()
3127                                     ((val :u32)
3128                                      (v :lisp)
3129                                      (idx :u32const)) ; sic
3130                                     ())
3131  (movl (:%l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
3132
3133(define-x8664-vinsn misc-set-u32  (()
3134                                   ((val :u32)
3135                                    (v :lisp)
3136                                    (scaled-idx :s64))
3137                                   ())
3138  (movl (:%l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3139
3140(define-x8664-vinsn misc-set-c-s32  (()
3141                                     ((val :s32)
3142                                      (v :lisp)
3143                                      (idx :u32const)) ; sic
3144                                     ())
3145  (movl (:%l val) (:@ (:apply + x8664::misc-data-offset (:apply ash idx 2)) (:%q v))))
3146
3147(define-x8664-vinsn misc-set-s32  (()
3148                                   ((val :s32)
3149                                    (v :lisp)
3150                                    (scaled-idx :s64))
3151                                   ())
3152  (movl (:%l val) (:@ x8664::misc-data-offset (:%q v) (:%q scaled-idx))))
3153
3154(define-x8664-vinsn %iasr (((dest :imm))
3155                           ((count :imm)
3156                            (src :imm))
3157                           ((temp :s64)
3158                            (shiftcount (:s64 #.x8664::rcx))))
3159  (movq (:%q count) (:%q temp))
3160  (sarq (:$ub x8664::fixnumshift) (:%q temp))
3161  (movl (:$l 63) (:%l shiftcount))
3162  (rcmpq (:%q temp) (:%q shiftcount))
3163  (cmovbel (:%l temp) (:%l shiftcount))
3164  (movq (:%q src) (:%q temp))
3165  (sarq (:%shift x8664::cl) (:%q temp))
3166  (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
3167  (movq (:%q temp) (:%q dest)))
3168
3169(define-x8664-vinsn %ilsr (((dest :imm))
3170                           ((count :imm)
3171                            (src :imm))
3172                           ((temp :s64)
3173                            (shiftcount (:s64 #.x8664::rcx))))
3174  (movq (:%q count) (:%q temp))
3175  (sarq (:$ub x8664::fixnumshift) (:%q temp))
3176  (movl (:$l 63) (:%l shiftcount))
3177  (rcmpq (:%q temp) (:%q shiftcount))
3178  (cmovbel (:%l temp) (:%l shiftcount))
3179  (movq (:%q src) (:%q temp))
3180  (shrq (:%shift x8664::cl) (:%q temp))
3181  (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
3182  (movq (:%q temp) (:%q dest)))
3183
3184
3185(define-x8664-vinsn %iasr-c (((dest :imm))
3186                             ((count :u8const)
3187                              (src :imm))
3188                             ((temp :s64)))
3189  (movq (:%q src) (:%q temp))
3190  (sarq (:$ub count) (:%q temp))
3191  (andq (:$b (lognot x8664::fixnummask)) (:%q temp))
3192  (movq (:%q temp) (:%q dest)))
3193
3194(define-x8664-vinsn %ilsr-c (((dest :imm))
3195                             ((count :u8const)
3196                              (src :imm))
3197                             ((temp :s64)))
3198  (movq (:%q src) (:%q temp))
3199  (shrq (:$ub count) (:%q temp))
3200  (andb (:$b (lognot x8664::fixnummask)) (:%b temp))
3201  (movq (:%q temp) (:%q dest)))
3202
3203(define-x8664-vinsn %ilsl (((dest :imm))
3204                           ((count :imm)
3205                            (src :imm))
3206                           ((shiftcount (:s64 #.x8664::rcx))))
3207  (movl (:$l (ash 63 x8664::fixnumshift)) (:%l shiftcount))
3208  (rcmpq (:%q count) (:%q shiftcount))
3209  (cmovbl (:%l count) (:%l shiftcount))
3210  (sarl (:$ub x8664::fixnumshift) (:%l shiftcount))
3211  ((:not (:pred =
3212                (:apply %hard-regspec-value src)
3213                (:apply %hard-regspec-value dest)))
3214   (movq (:%q src) (:%q dest)))
3215  (shlq (:%shift x8664::cl) (:%q dest)))
3216
3217(define-x8664-vinsn %ilsl-c (((dest :imm))
3218                             ((count :u8const)
3219                              (src :imm)))
3220  ((:not (:pred =
3221                (:apply %hard-regspec-value src)
3222                (:apply %hard-regspec-value dest)))
3223   (movq (:%q src) (:%q dest)))
3224  (shlq (:$ub count) (:%q dest)))
3225
3226(define-x8664-vinsn fixnum-ash-left (((dest :lisp))
3227                                     ((num :lisp)
3228                                      (amt :lisp))
3229                                     ((shiftcount (:s64 #.x8664::rcx))))
3230  (movq (:%q amt) (:%q shiftcount))
3231  (sarq (:$ub x8664::fixnumshift) (:%q shiftcount))
3232  ((:not (:pred =
3233                (:apply %hard-regspec-value num)
3234                (:apply %hard-regspec-value dest)))
3235   (movq (:%q num) (:%q dest)))
3236  (shlq (:%shift x8664::cl) (:%q dest)))
3237
3238(define-x8664-vinsn fixnum-ash (((dest :lisp))
3239                                ((num :lisp)
3240                                 (amt :lisp))
3241                                ((shiftcount (:s64 #.x8664::rcx))
3242                                 (temp (:s64))))
3243  (movq (:%q amt) (:%q shiftcount))
3244  (sarq (:$ub x8664::fixnumshift) (:%q shiftcount))
3245  (jns :left)
3246  (negq (:%q shiftcount))
3247  (movq (:%q num) (:%q temp))
3248  (sarq (:$ub x8664::fixnumshift) (:%q temp))
3249  (sarq (:%shift x8664::cl) (:%q temp))
3250  (imulq  (:$b x8664::fixnumone) (:%q temp)(:%q dest))
3251  (jmp :done)
3252  :left
3253  ((:not (:pred =
3254                (:apply %hard-regspec-value num)
3255                (:apply %hard-regspec-value dest)))
3256   (movq (:%q num) (:%q dest)))
3257  (shlq (:%shift x8664::cl) (:%q dest))
3258  :done)
3259                                   
3260
3261;;; In safe code, something else has ensured that the value is of type
3262;;; BIT.
3263(define-x8664-vinsn set-variable-bit-to-variable-value (()
3264                                                        ((vec :lisp)
3265                                                         (word-index :s64)
3266                                                         (bitnum :u8)
3267                                                         (value :lisp)))
3268  (testb (:%b value) (:%b value))
3269  (je :clr)
3270  (btsq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8))
3271  (jmp :done)
3272  :clr
3273  (btrq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8))
3274  :done)
3275
3276(define-x8664-vinsn set-variable-bit-to-zero (()
3277                                              ((vec :lisp)
3278                                               (word-index :s64)
3279                                               (bitnum :u8)))
3280  (btrq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8)))
3281
3282(define-x8664-vinsn set-variable-bit-to-one (()
3283                                              ((vec :lisp)
3284                                               (word-index :s64)
3285                                               (bitnum :u8)))
3286  (btsq (:%q bitnum) (:@ x8664::misc-data-offset (:%q vec) (:%q word-index) 8)))
3287
3288;;; In safe code, something else has ensured that the value is of type
3289;;; BIT.
3290(define-x8664-vinsn nset-variable-bit-to-variable-value (()
3291                                                        ((vec :lisp)
3292                                                         (index :s64)
3293                                                         (value :lisp)))
3294  (testb (:%b value) (:%b value))
3295  (je :clr)
3296  (btsq (:%q index) (:@ x8664::misc-data-offset (:%q vec)))
3297  (jmp :done)
3298  :clr
3299  (btrq (:%q index) (:@ x8664::misc-data-offset (:%q vec)))
3300  :done)
3301
3302(define-x8664-vinsn nset-variable-bit-to-zero (()
3303                                              ((vec :lisp)
3304                                               (index :s64)))
3305  (btrq (:%q index) (:@ x8664::misc-data-offset (:%q vec))))
3306
3307(define-x8664-vinsn nset-variable-bit-to-one (()
3308                                              ((vec :lisp)
3309                                               (index :s64)))
3310  (btsq (:%q index) (:@ x8664::misc-data-offset (:%q vec))))
3311
3312(define-x8664-vinsn set-constant-bit-to-zero (()
3313                                              ((src :lisp)
3314                                               (idx :u64const)))
3315  (btrq (:$ub (:apply logand 63 idx))
3316        (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src))))
3317
3318(define-x8664-vinsn set-constant-bit-to-one (()
3319                                             ((src :lisp)
3320                                              (idx :u64const)))
3321  (btsq (:$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-variable-value (()
3325                                                        ((src :lisp)
3326                                                         (idx :u64const)
3327                                                         (value :lisp)))
3328  (testb (:%b value) (:%b value))
3329  (je :clr)
3330  (btsq (:$ub (:apply logand 63 idx))
3331        (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
3332  (jmp :done)
3333  :clr
3334  (btrq (:$ub (:apply logand 63 idx))
3335        (:@ (:apply + x8664::misc-data-offset (:apply ash (:apply ash idx -6) x8664::word-shift)) (:%q src)))
3336  :done)
3337
3338
3339(define-x8664-vinsn require-fixnum (()
3340                                    ((object :lisp)))
3341  :again
3342  (testl (:$l x8664::fixnummask) (:%l object))
3343  (jne :bad)
3344  (:anchored-uuo-section :again)
3345  :bad
3346  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-fixnum))))
3347
3348(define-x8664-vinsn require-integer (()
3349                                     ((object :lisp))
3350                                     ((tag :u8)))
3351  :again
3352  (movl (:%l object) (:%l tag))
3353  (andl (:$b x8664::fixnummask) (:%l tag))
3354  (je :got-it)
3355  (cmpl (:$b x8664::tag-misc) (:%l tag))
3356  (jne :bad)
3357  (cmpb (:$b x8664::subtag-bignum) (:@ x8664::misc-subtag-offset (:%q object)))
3358  (jne :bad)
3359  :got-it
3360
3361  (:anchored-uuo-section :again)
3362  :bad
3363  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-integer))))
3364
3365(define-x8664-vinsn require-simple-vector (()
3366                                           ((object :lisp))
3367                                           ((tag :u8)))
3368  :again
3369  (movl (:%l object) (:%l tag))
3370  (andl (:$b x8664::fixnummask) (:%l tag))
3371  (cmpl (:$b x8664::tag-misc) (:%l tag))
3372  (jne :bad)
3373  (cmpb (:$b x8664::subtag-simple-vector) (:@ x8664::misc-subtag-offset (:%q object)))
3374  (jne :bad)
3375
3376  (:anchored-uuo-section :again)
3377  :bad
3378  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-simple-vector))))
3379
3380(define-x8664-vinsn require-simple-string (()
3381                                           ((object :lisp))
3382                                           ((tag :u8)))
3383  :again
3384  (movl (:%l object) (:%l tag))
3385  (andl (:$b x8664::fixnummask) (:%l tag))
3386  (cmpl (:$b x8664::tag-misc) (:%l tag))
3387  (jne :bad)
3388  (cmpb (:$b x8664::subtag-simple-base-string) (:@ x8664::misc-subtag-offset (:%q object)))
3389  (jne :bad)
3390
3391  (:anchored-uuo-section :again)
3392  :bad
3393  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-simple-string))))
3394                                   
3395(define-x8664-vinsn require-real (()
3396                                    ((object :lisp))
3397                                    ((tag :u8)
3398                                     (mask :u64)))
3399  (movq (:$q (logior (ash 1 x8664::tag-fixnum)
3400                     (ash 1 x8664::tag-single-float)
3401                     (ash 1 x8664::subtag-double-float)
3402                     (ash 1 x8664::subtag-bignum)
3403                     (ash 1 x8664::subtag-ratio)))
3404        (:%q mask))
3405  :again
3406  (movl (:%l object) (:%l tag))
3407  (andl (:$b x8664::tagmask) (:%l tag))
3408  (cmpl (:$b x8664::tag-misc) (:%l tag))
3409  (jne :have-tag)
3410  (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
3411  :have-tag
3412  (rcmpl (:%l tag) (:$b 64))
3413  (jae :bad)
3414  (btq (:%q tag) (:%q mask))
3415  (jae :bad)
3416
3417  (:anchored-uuo-section :again)
3418  :bad
3419  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-real))))
3420
3421(define-x8664-vinsn require-number (()
3422                                    ((object :lisp))
3423                                    ((tag :u8)
3424                                     (mask :u64)))
3425  (movq (:$q (logior (ash 1 x8664::tag-fixnum)
3426                     (ash 1 x8664::tag-single-float)
3427                     (ash 1 x8664::subtag-double-float)
3428                     (ash 1 x8664::subtag-bignum)
3429                     (ash 1 x8664::subtag-ratio)
3430                     (ash 1 x8664::subtag-complex)))
3431        (:%q mask))
3432  :again
3433  (movl (:%l object) (:%l tag)) 
3434  (andl (:$b x8664::tagmask) (:%l tag))
3435  (cmpl (:$b x8664::tag-misc) (:%l tag))
3436  (jne :have-tag)
3437  (movzbl (:@ x8664::misc-subtag-offset (:%q object)) (:%l tag))
3438  :have-tag
3439  (cmpl (:$b x8664::subtag-complex-single-float) (:%l tag))
3440  (jz :good)
3441  (cmpl (:$b x8664::subtag-complex-double-float) (:%l tag))
3442  (jz :good)
3443  (rcmpl (:%l tag) (:$b 64))
3444  (jae :bad)
3445  (btq (:%q tag) (:%q mask))
3446  (jae :bad)
3447  :good
3448  (:anchored-uuo-section :again)
3449  :bad
3450  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-number))))
3451
3452(define-x8664-vinsn require-list (()
3453                                  ((object :lisp))
3454                                  ((tag :u8)))
3455  :again
3456  (movl (:%l object) (:%l tag))
3457  (andl (:$b x8664::tagmask) (:%l tag))
3458  (cmpl (:$b x8664::tag-list) (:%l tag))
3459  (jne :bad)
3460
3461  (:anchored-uuo-section :again)
3462  :bad
3463  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-list))))
3464
3465(define-x8664-vinsn require-symbol (()
3466                                    ((object :lisp))
3467                                    ((tag :u8)))
3468  :again
3469  (movzbl (:%b object) (:%l tag))
3470  (cmpl (:$b x8664::fulltag-nil) (:%l tag))
3471  (je :good)
3472  (andl (:$b x8664::tagmask) (:%l tag))
3473  (cmpl (:$b x8664::tag-symbol) (:%l tag))
3474  (jne :bad)
3475  :good
3476
3477  (:anchored-uuo-section :again)
3478  :bad
3479  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))))
3480
3481(define-x8664-vinsn require-character (()
3482                                ((object :lisp)))
3483  :again
3484  (cmpb (:$b x8664::subtag-character) (:%b object))
3485  (jne :bad)
3486  (:anchored-uuo-section :again)
3487  :bad
3488  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-character))))
3489
3490(define-x8664-vinsn require-s8 (()
3491                                ((object :lisp))
3492                                ((tag :u32)))
3493  :again
3494  (movq (:%q object) (:%q tag))
3495  (shlq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q tag))
3496  (sarq (:$ub (- x8664::nbits-in-word 8)) (:%q tag))
3497  (shlq (:$ub x8664::fixnumshift) (:%q tag))
3498  (cmpq (:%q object) (:%q tag))
3499  (jne :bad)
3500
3501  (:anchored-uuo-section :again)
3502  :bad
3503  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-8))))
3504
3505(define-x8664-vinsn require-u8 (()
3506                                ((object :lisp))
3507                                ((tag :u32)))
3508  :again
3509  (movq (:$l (lognot (ash #xff x8664::fixnumshift))) (:%q tag))
3510  (andq (:% object) (:% tag))
3511  (jne :bad)
3512  (:anchored-uuo-section :again)
3513  :bad
3514  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-8))))
3515
3516(define-x8664-vinsn require-s16 (()
3517                                ((object :lisp))
3518                                ((tag :s64)))
3519  :again
3520  (movq (:%q object) (:%q tag))
3521  (shlq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q tag))
3522  (sarq (:$ub (- x8664::nbits-in-word 16)) (:%q tag))
3523  (shlq (:$ub x8664::fixnumshift) (:%q tag))
3524  (cmpq (:%q object) (:%q tag))
3525  (jne :bad)
3526  (:anchored-uuo-section :again)
3527  :bad
3528  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-16))))
3529
3530(define-x8664-vinsn require-u16 (()
3531                                ((object :lisp))
3532                                ((tag :u32)))
3533  :again
3534  (movq (:$l (lognot (ash #xffff x8664::fixnumshift))) (:%q tag))
3535  (andq (:% object) (:% tag))
3536  (jne :bad)
3537  (:anchored-uuo-section :again)
3538  :bad
3539  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-16))))
3540
3541(define-x8664-vinsn require-s32 (()
3542                                ((object :lisp))
3543                                ((tag :s64)))
3544  :again
3545  (movq (:%q object) (:%q tag))
3546  (shlq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q tag))
3547  (sarq (:$ub (- x8664::nbits-in-word 32)) (:%q tag))
3548  (shlq (:$ub x8664::fixnumshift) (:%q tag))
3549  (cmpq (:%q object) (:%q tag))
3550  (jne :bad)
3551  (testl (:$l x8664::fixnummask) (:%l object))
3552  (jne :bad)
3553  (:anchored-uuo-section :again)
3554  :bad
3555  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-32))))
3556
3557(define-x8664-vinsn require-u32 (()
3558                                 ((object :lisp))
3559                                 ((tag :u32)))
3560  :again
3561  (movq (:$q (lognot (ash #xffffffff x8664::fixnumshift))) (:%q tag))
3562  (andq (:% object) (:% tag))
3563  (jne :bad)
3564  (:anchored-uuo-section :again)
3565  :bad
3566  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-32))))
3567
3568(define-x8664-vinsn require-s64 (()
3569                                ((object :lisp))
3570                                ((tag :s64)))
3571  :again
3572  (testl (:$l x8664::fixnummask) (:%l object))
3573  (movl (:%l object) (:%l tag))
3574  (je :ok)
3575  (andl (:$b x8664::fulltagmask) (:%l tag))
3576  (cmpl (:$b x8664::fulltag-misc) (:%l tag))
3577  (jne :bad)
3578  (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3579  (jne :bad)
3580  :ok
3581  (:anchored-uuo-section :again)
3582  :bad
3583  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-64))))
3584
3585(define-x8664-vinsn require-u64 (()
3586                                ((object :lisp))
3587                                ((tag :s64)))
3588  :again
3589  (testl (:$l x8664::fixnummask) (:%l object))
3590  (movq (:%q object) (:%q tag))
3591  (je :ok-if-non-negative)
3592  (andl (:$b x8664::fulltagmask) (:%l tag))
3593  (cmpl (:$b x8664::fulltag-misc) (:%l tag))
3594  (jne :bad)
3595  (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3596  (je :two)
3597  (cmpq (:$l x8664::three-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
3598  (jne :bad)
3599  (cmpl (:$b 0) (:@ (+ x8664::misc-data-offset 8) (:%q object)))
3600  (je :ok)
3601  (jmp :bad)
3602  :two
3603  (movq (:@ x8664::misc-data-offset (:%q object)) (:%q tag))
3604  :ok-if-non-negative
3605  (testq (:%q tag) (:%q tag))
3606  (js :bad)
3607  :ok
3608  (:anchored-uuo-section :again)
3609  :bad
3610  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-64))))
3611
3612(define-x8664-vinsn require-char-code (()
3613                                       ((object :lisp))
3614                                       ((tag :u32)))
3615  :again
3616  (testl (:$l x8664::fixnummask) (:%l object))
3617  (jne :bad)
3618  (cmpq (:$l (ash #x110000 x8664::fixnumshift)) (:%q object))
3619  (jae :bad)
3620  (:anchored-uuo-section :again)
3621  :bad
3622  (:anchored-uuo (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-mod-char-code-limit))))
3623
3624
3625;;; set DEST to
3626(define-x8664-vinsn mask-base-char (((dest :u8))
3627                                    ((src :lisp)))
3628  (movzbl (:%b src) (:%l dest))) 
3629
3630(define-x8664-vinsn single-float-bits (((dest :u32))
3631                                       ((src :lisp)))
3632  (movq (:%q src) (:%q dest))
3633  (shrq (:$ub 32) (:%q dest)))
3634
3635(define-x8664-vinsn zero-double-float-register (((dest :double-float))
3636                                                ())
3637  (movsd (:%xmm x8664::fpzero) (:%xmm dest)))
3638
3639(define-x8664-vinsn zero-single-float-register (((dest :single-float))
3640                                                ())
3641  (movss (:%xmm x8664::fpzero) (:%xmm dest)))
3642
3643(define-x8664-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
3644(define-x8664-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
3645(define-x8664-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
3646
3647(define-x8664-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
3648
3649(define-x8664-vinsn misc-element-count-fixnum (((dest :imm))
3650                                               ((src :lisp))
3651                                               ((temp :u64)))
3652  (movq (:@ x8664::misc-header-offset (:%q src)) (:%q temp))
3653  (shrq (:$ub x8664::num-subtag-bits) (:%q temp))
3654  (imulq (:$b x8664::fixnumone) (:%q temp)(:%q dest)))
3655
3656(define-x8664-vinsn %logior2 (((dest :imm))
3657                              ((x :imm)
3658                               (y :imm)))
3659  ((:pred =
3660          (:apply %hard-regspec-value x)
3661          (:apply %hard-regspec-value dest))
3662   (orq (:%q y) (:%q dest)))
3663  ((:not (:pred =
3664                (:apply %hard-regspec-value x)
3665                (:apply %hard-regspec-value dest)))
3666   ((:pred =
3667           (:apply %hard-regspec-value y)
3668           (:apply %hard-regspec-value dest))
3669    (orq (:%q x) (:%q dest)))
3670   ((:not (:pred =
3671                 (:apply %hard-regspec-value y)
3672                 (:apply %hard-regspec-value dest)))
3673    (movq (:%q x) (:%q dest))
3674    (orq (:%q y) (:%q dest)))))
3675
3676(define-x8664-vinsn %logand2 (((dest :imm))
3677                              ((x :imm)
3678                               (y :imm)))
3679  ((:pred =
3680          (:apply %hard-regspec-value x)
3681          (:apply %hard-regspec-value dest))
3682   (andq (:%q y) (:%q dest)))
3683  ((:not (:pred =
3684                (:apply %hard-regspec-value x)
3685                (:apply %hard-regspec-value dest)))
3686   ((:pred =
3687           (:apply %hard-regspec-value y)
3688           (:apply %hard-regspec-value dest))
3689    (andq (:%q x) (:%q dest)))
3690   ((:not (:pred =
3691                 (:apply %hard-regspec-value y)
3692                 (:apply %hard-regspec-value dest)))
3693    (movq (:%q x) (:%q dest))
3694    (andq (:%q y) (:%q dest)))))
3695
3696(define-x8664-vinsn %logxor2 (((dest :imm))
3697                              ((x :imm)
3698                               (y :imm)))
3699  ((:pred =
3700          (:apply %hard-regspec-value x)
3701          (:apply %hard-regspec-value dest))
3702   (xorq (:%q y) (:%q dest)))
3703  ((:not (:pred =
3704                (:apply %hard-regspec-value x)
3705                (:apply %hard-regspec-value dest)))
3706   ((:pred =
3707           (:apply %hard-regspec-value y)
3708           (:apply %hard-regspec-value dest))
3709    (xorq (:%q x) (:%q dest)))
3710   ((:not (:pred =
3711                 (:apply %hard-regspec-value y)
3712                 (:apply %hard-regspec-value dest)))
3713    (movq (:%q x) (:%q dest))
3714    (xorq (:%q y) (:%q dest)))))
3715
3716
3717(define-x8664-vinsn vcell-ref (((dest :lisp))
3718                               ((vcell :lisp)))
3719  (movq (:@ x8664::misc-data-offset (:%q vcell)) (:%q dest)))
3720
3721(define-x8664-vinsn (call-subprim-3 :call :subprim) (((dest t))
3722                                                          ((spno :s32const)
3723                                                           (x t)
3724                                                           (y t)
3725                                                           (z t))
3726                                                          ((entry (:label 1))))
3727  (:talign 4)
3728  (call (:@ spno))
3729  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3730
3731(define-x8664-vinsn setup-vcell-allocation (()
3732                                            ())
3733  (movl (:$l x8664::value-cell-header) (:%l x8664::imm0))
3734  (movl (:$l (- x8664::value-cell.size x8664::fulltag-misc)) (:%l x8664::imm1)))
3735
3736(define-x8664-vinsn %init-vcell (()
3737                                 ((vcell :lisp)
3738                                  (closed :lisp)))
3739  (movq (:%q closed) (:@ x8664::value-cell.value (:%q vcell))))
3740
3741(define-x8664-subprim-call-vinsn (progvsave) .SPprogvsave)
3742
3743(define-x8664-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
3744
3745(define-x8664-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
3746
3747(define-x8664-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
3748
3749(define-x8664-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
3750
3751(define-x8664-vinsn scale-nargs (()
3752                                 ((nfixed :s16const)))
3753  ((:pred > nfixed 0)
3754   ((:pred < nfixed 16)
3755    (subl (:$b (:apply ash nfixed x8664::word-shift)) (:%l x8664::nargs)))
3756   ((:pred >= nfixed 16)
3757    (subl (:$l (:apply ash nfixed x8664::word-shift)) (:%l x8664::nargs)))))
3758
3759(define-x8664-vinsn opt-supplied-p (()
3760                                    ((num-opt :u16const))
3761                                    ((nargs (:u64 #.x8664::nargs))
3762                                     (imm :imm)))
3763  (xorl (:%l imm) (:%l imm))
3764  (movl (:$l (:apply target-nil-value)) (:%l x8664::arg_y))
3765  :loop
3766  (rcmpl (:%l imm) (:%l nargs))
3767  (movl (:%l x8664::arg_y) (:%l x8664::arg_z))
3768  (cmovll (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l x8664::arg_y)) (:%l  x8664::arg_z))
3769  (addl (:$b x8664::node-size) (:%l imm))
3770  (rcmpl (:%l imm) (:$l (:apply ash num-opt x8664::fixnumshift)))
3771  (pushq (:%q x8664::arg_z))
3772  (jne :loop))
3773
3774(define-x8664-vinsn one-opt-supplied-p (()
3775                                        ()
3776                                        ((temp :u64)))
3777  (testl (:%l x8664::nargs) (:%l x8664::nargs))
3778  (movl (:$l (:apply target-nil-value)) (:%l temp))
3779  (cmovnel (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp)) (:%l temp))
3780  (pushq (:%q temp)))
3781
3782(define-x8664-vinsn two-opt-supplied-p (()
3783                                        ()
3784                                        ((temp0 :u64)
3785                                         (temp1 :u64)))
3786  (rcmpl (:%l x8664::nargs) (:$b x8664::node-size))
3787  (movl (:$l (:apply target-nil-value)) (:%l temp0))
3788  (movl (:%l temp0) (:%l temp1))
3789  (cmovael (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp0)) (:%l temp0))
3790  (cmoval (:@ (+ x8664::t-offset x8664::symbol.vcell) (:%l temp1)) (:%l temp1))
3791  (pushq (:%q temp0))
3792  (pushq (:%q temp1)))
3793
3794
3795(define-x8664-vinsn set-c-flag-if-constant-logbitp (()
3796                                                    ((bit :u8const)
3797                                                     (int :imm)))
3798  (btq (:$ub bit) (:%q int)))
3799
3800(define-x8664-vinsn set-c-flag-if-variable-logbitp (()
3801                                                    ((bit :imm)
3802                                                     (int :imm))
3803                                                    ((temp0 :u8)
3804                                                     (temp1 :u8)))
3805  (movl (:$l 63) (:%l temp1))
3806  (movq (:%q bit) (:%q temp0))
3807  (sarq (:$ub x8664::fixnumshift) (:%q temp0))
3808  (addq (:$b x8664::fixnumshift) (:%q temp0))
3809  (rcmpq (:%q temp0) (:%q temp1))
3810  (cmoval (:%l temp1) (:%l temp0))
3811  (btq (:%q temp0) (:%q int)))
3812
3813(define-x8664-vinsn multiply-immediate (((dest :imm))
3814                                        ((src :imm)
3815                                         (const :s32const)))
3816  ((:and (:pred >= const -128) (:pred <= const 127))
3817   (imulq (:$b const) (:%q src) (:%q dest)))
3818  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
3819   (imulq (:$l const) (:%q src) (:%q dest))))
3820
3821(define-x8664-vinsn multiply-fixnums (((dest :imm))
3822                                      ((x :imm)
3823                                       (y :imm))
3824                                      ((unboxed :s64)))
3825  ((:pred =
3826          (:apply %hard-regspec-value x)
3827          (:apply %hard-regspec-value dest))
3828   (movq (:%q y) (:%q unboxed))
3829   (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3830   (imulq (:%q unboxed) (:%q dest)))
3831  ((:and (:not (:pred =
3832                      (:apply %hard-regspec-value x)
3833                      (:apply %hard-regspec-value dest)))
3834         (:pred =
3835                (:apply %hard-regspec-value y)
3836                (:apply %hard-regspec-value dest)))
3837   (movq (:%q x) (:%q unboxed))
3838   (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3839   (imulq (:%q unboxed) (:%q dest)))
3840  ((:and (:not (:pred =
3841                      (:apply %hard-regspec-value x)
3842                      (:apply %hard-regspec-value dest)))
3843         (:not (:pred =
3844                      (:apply %hard-regspec-value y)
3845                      (:apply %hard-regspec-value dest))))
3846   (movq (:%q y) (:%q dest))
3847   (movq (:%q x) (:%q unboxed))
3848   (sarq (:$ub x8664::fixnumshift) (:%q unboxed))
3849   (imulq (:%q unboxed) (:%q dest))))
3850
3851   
3852(define-x8664-vinsn save-lexpr-argregs (()
3853                                        ((min-fixed :u16const)))
3854  ((:pred >= min-fixed $numx8664argregs)
3855   (pushq (:%q x8664::arg_x))
3856   (pushq (:%q x8664::arg_y))
3857   (pushq (:%q x8664::arg_z)))
3858  ((:pred = min-fixed 2)                ; at least 2 args
3859   (cmpl (:$b (ash 2 x8664::word-shift)) (:%l x8664::nargs))
3860   (je :yz2)                      ; skip arg_x if exactly 2
3861   (pushq (:%q x8664::arg_x))
3862   :yz2
3863   (pushq (:%q x8664::arg_y))
3864   (pushq (:%q x8664::arg_z)))
3865  ((:pred = min-fixed 1)                ; at least one arg
3866   (rcmpl (:%l x8664::nargs) (:$b  (ash 2 x8664::word-shift)))
3867   (jl :z1)                       ; branch if exactly one
3868   (je :yz1)                      ; branch if exactly two
3869   (pushq (:%q x8664::arg_x))
3870   :yz1
3871   (pushq (:%q x8664::arg_y))
3872   :z1
3873   (pushq (:%q x8664::arg_z)))
3874  ((:pred = min-fixed 0)
3875   (testl (:%l x8664::nargs) (:%l x8664::nargs))
3876   (je  :none)                     ; exactly zero
3877   (rcmpl (:%l x8664::nargs) (:$b (ash 2 x8664::word-shift)))
3878   (je :yz0)                      ; exactly two
3879   (jl :z0)                       ; one
3880                                        ; Three or more ...
3881   (pushq (:%q x8664::arg_x))
3882   :yz0
3883   (pushq (:%q x8664::arg_y))
3884   :z0
3885   (pushq (:%q x8664::arg_z))
3886   :none
3887   )
3888  ((:not (:pred = min-fixed 0))
3889   (leaq (:@ (:apply - (:apply ash min-fixed x8664::word-shift)) (:%q x8664::nargs))
3890         (:%q x8664::nargs)))
3891  (pushq (:%q x8664::nargs))
3892  (movq (:%q x8664::rsp) (:%q x8664::arg_z)))
3893
3894
3895
3896
3897;;; The frame that was built (by SAVE-LISP-CONTEXT-VARIABLE-ARG-COUNT
3898;;; and SAVE-LEXPR-ARGREGS) contains an unknown number of arguments
3899;;; followed by the count of non-required arguments; the count is on
3900;;; top of the stack and its address is in %arg_z.  We need to build a
3901;;; frame so that the function can address its arguments (copies of
3902;;; the required arguments and the lexpr) and locals; when the
3903;;; function returns, it should one or more values (depending on how
3904;;; it was called) and discard the hidden lexpr frame.  At this point,
3905;;; %ra0 still contains the "real" return address. If it's not the
3906;;; magic multiple-value address, we can make the function return to
3907;;; something that does a single-value return (.SPpopj); otherwise, we
3908;;; need to make it return multiple values to the real caller. (Unlike
3909;;; the PPC, this case only involves creating one frame here, but that
3910;;; frame has two return addresses.)
3911(define-x8664-vinsn build-lexpr-frame (()
3912                                       ()
3913                                       ((temp :imm)))
3914  (movq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr)))
3915        (:%q temp))
3916  (cmpq (:%q temp)
3917        (:%q x8664::ra0))
3918  (je :multiple)
3919  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::lexpr-return1v))))
3920  (jmp :finish)
3921  :multiple
3922  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::lexpr-return))))
3923  (pushq (:%q temp))
3924  :finish
3925  (pushq (:%q x8664::rbp))
3926  (movq (:%q x8664::rsp) (:%q x8664::rbp)))
3927
3928
3929(define-x8664-vinsn copy-lexpr-argument (()
3930                                         ((n :u16const))
3931                                         ((temp :imm)))
3932  (movq (:@ (:%q x8664::arg_z)) (:%q temp))
3933  (pushq (:@ (:apply ash n x8664::word-shift) (:%q x8664::arg_z) (:%q temp))))
3934
3935
3936(define-x8664-vinsn %current-tcr (((dest :lisp))
3937                                 ())
3938  (movq (:rcontext x8664::tcr.linear) (:%q dest)))
3939
3940(define-x8664-vinsn (setq-special :call :subprim)
3941    (()
3942     ((sym :lisp)
3943      (val :lisp))
3944     ((entry (:label 1))))
3945  (:talign 4)
3946  (call (:@ .SPspecset))
3947  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
3948
3949(define-x8664-vinsn set-z-flag-if-istruct-typep (()
3950                                                 ((val :lisp)
3951                                                  (type :lisp))
3952                                                 ((tag :u8)
3953                                                  (valtype :lisp)))
3954  (xorl (:%l valtype) (:%l valtype))
3955  (movl (:%l val) (:%l tag))
3956  (andl (:$b x8664::tagmask) (:%l tag))
3957  (cmpl (:$b x8664::tag-misc) (:%l tag))
3958  (jne :have-tag)
3959  (movzbl (:@ x8664::misc-subtag-offset (:%q val)) (:%l tag))
3960  :have-tag
3961  (cmpl (:$b x8664::subtag-istruct) (:%l tag))
3962  (jne :do-compare)
3963  (movq (:@ x8664::misc-data-offset (:%q val)) (:%q valtype))
3964  :do-compare
3965  (cmpq (:%q valtype) (:%q type)))
3966
3967(define-x8664-subprim-call-vinsn (misc-ref) .SPmisc-ref)
3968
3969(define-x8664-subprim-call-vinsn (ksignalerr) .SPksignalerr)
3970
3971(define-x8664-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
3972
3973(define-x8664-subprim-call-vinsn (misc-alloc) .SPmisc-alloc) 
3974
3975(define-x8664-subprim-lea-jmp-vinsn (make-stack-gvector)  .SPstkgvector)
3976
3977(define-x8664-vinsn load-character-constant (((dest :lisp))
3978                                             ((code :u32const))
3979                                             ())
3980  (movl (:$l (:apply logior (:apply ash code 8) x8664::subtag-character))
3981        (:%l dest)))
3982
3983(define-x8664-vinsn %scharcode8 (((code :imm))
3984                                ((str :lisp)
3985                                 (idx :imm))
3986                                ((imm :u64)))
3987  (movq (:%q idx) (:%q imm))
3988  (sarq (:$ub x8664::fixnumshift) (:%q imm))
3989  (movzbl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
3990  (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code)))
3991
3992(define-x8664-vinsn %scharcode32 (((code :imm))
3993                                ((str :lisp)
3994                                 (idx :imm))
3995                                ((imm :u64)))
3996  (movq (:%q idx) (:%q imm))
3997  (sarq (:$ub 1) (:%q imm))
3998  (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm))
3999  (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code)))
4000
4001(define-x8664-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
4002
4003(define-x8664-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
4004
4005
4006(define-x8664-vinsn character->code (((dest :u32))
4007                                     ((src :lisp)))
4008  (movq (:%q src) (:%q dest))
4009  (sarq (:$ub x8664::charcode-shift) (:%q  dest)))
4010
4011(define-x8664-vinsn (adjust-vsp :vsp :pop :discard)
4012    (()
4013     ((amount :s32const)))
4014  ((:and (:pred >= amount -128) (:pred <= amount 127))
4015   (addq (:$b amount) (:%q x8664::rsp)))
4016  ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
4017   (addq (:$l amount) (:%q x8664::rsp))))
4018
4019(define-x8664-vinsn (call-subprim-2 :call :subprim) (((dest t))
4020                                                          ((spno :s32const)
4021                                                           (y t)
4022                                                           (z t))
4023                                                          ((entry (:label 1))))
4024  (:talign 4)
4025  (call (:@ spno))
4026  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
4027
4028(define-x8664-vinsn (call-subprim-1 :call :subprim) (((dest t))
4029                                                          ((spno :s32const)
4030                                                           (x t))
4031                                                          ((entry (:label 1))))
4032  (:talign 4)
4033  (call (:@ spno))
4034  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn)))
4035
4036
4037
4038(define-x8664-vinsn set-macptr-address (()
4039                                        ((addr :address)
4040                                         (src :lisp))
4041                                        ())
4042  (movq (:%q addr) (:@ x8664::macptr.address (:%q src))))
4043
4044(define-x8664-vinsn %symbol->symptr (((dest :lisp))
4045                                     ((src :lisp))
4046                                     ((tag :u8)))
4047  :begin
4048  (movl (:$l (:apply + (:apply target-nil-value) x8664::nilsym-offset)) (:%l tag))
4049  (cmpb (:$b x8664::fulltag-nil) (:%b src))
4050  (cmoveq (:%q tag) (:%q dest))
4051  (movl (:%l src) (:%l tag))
4052  (je :ok)
4053  (andl (:$b x8664::tagmask) (:%l tag))
4054  (cmpl (:$b x8664::tag-symbol) (:%l tag))
4055  (jne :bad)
4056
4057  ((:not (:pred =
4058                (:apply %hard-regspec-value dest)
4059                (:apply %hard-regspec-value src)))
4060   (movq (:% src) (:% dest)))
4061  :ok
4062  (:anchored-uuo-section :begin)
4063  :bad
4064  (:anchored-uuo (uuo-error-reg-not-tag (:%q src) (:$ub x8664::fulltag-symbol))))
4065
4066(define-x8664-vinsn symbol-function (((val :lisp))
4067                                     ((sym (:lisp (:ne val))))
4068                                     ((tag :u8)))
4069  :anchor
4070  (movq (:@ x8664::symbol.fcell (:%q sym)) (:%q val))
4071  (movl (:%l val) (:%l tag))
4072  (andl (:$b x8664::tagmask) (:%l tag))
4073  (cmpl (:$b x8664::tag-function) (:%l tag))
4074  (jne :bad)
4075 
4076  (:anchored-uuo-section :anchor)
4077  :bad
4078  (:anchored-uuo (uuo-error-udf (:%q sym))))
4079
4080(define-x8664-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
4081
4082(define-x8664-vinsn load-double-float-constant (((dest :double-float))
4083                                                ((lab :label)
4084))
4085  (movsd (:@ (:^ lab) (:%q x8664::fn)) (:%xmm dest)))
4086
4087(define-x8664-vinsn load-single-float-constant (((dest :single-float))
4088                                                ((lab :label)
4089))
4090  (movss (:@ (:^ lab) (:%q x8664::fn)) (:%xmm dest)))
4091
4092(define-x8664-subprim-call-vinsn (misc-set) .SPmisc-set)
4093
4094(define-x8664-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
4095
4096(define-x8664-subprim-lea-jmp-vinsn (spread-list)  .SPspreadargz)
4097
4098;;; Even though it's implemented by calling a subprim, THROW is really
4099;;; a JUMP (to a possibly unknown destination).  If the destination's
4100;;; really known, it should probably be inlined (stack-cleanup, value
4101;;; transfer & jump ...)
4102(define-x8664-vinsn (throw :jump-unknown) (()
4103                                           ()
4104                                           ((entry (:label 1))))
4105  (leaq (:@ (:^ :back) (:%q x8664::fn)) (:%q x8664::ra0))
4106  (:talign 4)
4107  (jmp (:@ .SPthrow))
4108  :back
4109  (leaq (:@ (:^ entry) (:% x8664::rip)) (:%q x8664::fn))
4110  (uuo-error-reg-not-tag (:%q x8664::temp0) (:$ub x8664::subtag-catch-frame)))
4111
4112
4113
4114(define-x8664-vinsn unbox-base-char (((dest :u64))
4115                                     ((src :lisp)))
4116  :anchor
4117  (movq (:%q src) (:%q dest))
4118  (shrq (:$ub x8664::charcode-shift) (:%q dest))
4119  (cmpb (:$b x8664::subtag-character) (:%b src))
4120  (jne :bad)
4121  (:anchored-uuo-section :anchor)
4122  :bad
4123  (:anchored-uuo (uuo-error-reg-not-tag (:%q src) (:$ub x8664::subtag-character))))
4124
4125(define-x8664-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
4126
4127(define-x8664-subprim-lea-jmp-vinsn (recover-values)  .SPrecover-values)
4128
4129(define-x8664-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
4130
4131(define-x8664-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
4132
4133(define-x8664-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
4134
4135(define-x8664-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
4136
4137;;; "dest" is preallocated, presumably on a stack somewhere.
4138(define-x8664-vinsn store-double (()
4139                                  ((dest :lisp)
4140                                   (source :double-float))
4141                                  ())
4142  (movsd (:%xmm source) (:@  x8664::double-float.value (:%q dest))))
4143
4144(define-x8664-vinsn fixnum->char (((dest :lisp))
4145                                  ((src :imm))
4146                                  ((temp :u32)))
4147  (movl (:%l src) (:%l temp))
4148  (sarl (:$ub (+ x8664::fixnumshift 1)) (:%l temp))
4149  (cmpl (:$l (ash #xfffe -1)) (:%l temp))
4150  (je :bad-if-eq)
4151  (sarl (:$ub (- 11 1)) (:%l temp))
4152  (cmpl (:$b (ash #xd800 -11))(:%l temp))
4153  :bad-if-eq
4154  (movl (:$l (:apply target-nil-value)) (:%l temp))
4155  (cmovel (:%l temp) (:%l dest))
4156  (je :done)
4157  ((:not (:pred =
4158                (:apply %hard-regspec-value dest)
4159                (:apply %hard-regspec-value src)))
4160   (movl (:%l src) (:%l dest)))
4161  (shll (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%l dest))
4162  (addl (:$b x8664::subtag-character) (:%l dest))
4163  :done)
4164
4165;;; src is known to be a code for which CODE-CHAR returns non-nil.
4166(define-x8664-vinsn code-char->char (((dest :lisp))
4167                                  ((src :imm))
4168                                  ())
4169  ((:not (:pred =
4170                (:apply %hard-regspec-value dest)
4171                (:apply %hard-regspec-value src)))
4172   (movl (:%l src) (:%l dest)))
4173  (shll (:$ub (- x8664::charcode-shift x8664::fixnumshift)) (:%l dest))
4174  (addl (:$b x8664::subtag-character) (:%l dest))
4175  :done)
4176
4177
4178(define-x8664-vinsn sign-extend-halfword (((dest :imm))
4179                                          ((src :imm)))
4180  (movq (:%q src ) (:%q dest))
4181  (shlq (:$ub (- 48 x8664::fixnumshift)) (:%q dest))
4182  (sarq (:$ub (- 48 x8664::fixnumshift)) (:%q dest)))
4183
4184(define-x8664-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
4185
4186(define-x8664-subprim-call-vinsn (gets64) .SPgets64)
4187
4188(define-x8664-subprim-call-vinsn (getu64) .SPgetu64)
4189
4190(define-x8664-vinsn %init-gvector (()
4191                                   ((v :lisp)
4192                                    (nbytes :u32const))
4193                                   ((count :imm)))
4194  (movl (:$l nbytes) (:%l count))
4195  (jmp :test)
4196  :loop
4197  (popq (:@ x8664::misc-data-offset (:%q v) (:%q count)))
4198  :test
4199  (subq (:$b x8664::node-size) (:%q count))
4200  (jge :loop))
4201
4202(define-x8664-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
4203
4204(define-x8664-vinsn nth-value (((result :lisp))
4205                               ()
4206                               ((imm0 :u64)))
4207  (leaq (:@ (:%q x8664::rsp) (:%q x8664::nargs)) (:%q imm0))
4208  (subq (:@ (:%q imm0)) (:%q x8664::nargs))
4209  (movl (:$l (:apply target-nil-value)) (:%l result))
4210  (jle :done)
4211  ;; I -think- that a CMOV would be safe here, assuming that N wasn't
4212  ;; extremely large.  Don't know if we can assume that.
4213  (movq (:@ (- x8664::node-size) (:%q x8664::rsp) (:%q x8664::nargs)) (:%q result))
4214  :done
4215  (leaq (:@ x8664::node-size (:%q imm0)) (:%q x8664::rsp)))
4216
4217
4218(define-x8664-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
4219
4220(define-x8664-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
4221
4222(define-x8664-vinsn fixnum->unsigned-natural (((dest :u64))
4223                                              ((src :imm)))
4224  (movq (:%q src) (:%q dest))
4225  (shrq (:$ub x8664::fixnumshift) (:%q dest)))
4226
4227(define-x8664-vinsn %debug-trap (()
4228                                 ())
4229  (uuo-error-debug-trap))
4230
4231(define-x8664-vinsn double-to-single (((result :single-float))
4232                                      ((arg :double-float)))
4233  (cvtsd2ss (:%xmm arg) (:%xmm result)))
4234
4235(define-x8664-vinsn single-to-double (((result :double-float))
4236                                      ((arg :single-float)))
4237  (cvtss2sd (:%xmm arg) (:%xmm result)))
4238