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

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

Merge ffcall, float tweaks (r13221, r13234, r13298, r13299)

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