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

Last change on this file since 14969 was 14969, checked in by gb, 8 years ago

Try to speed up some cases involving self-calls where the number
of args is fixed, tail calls where some outgoing args are passed
on the stack, and the combination of those things. We generally
do the calls faster, but we don't really recognize that iteration's
being introduced (and that things are happening in a loop.)

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