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

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

x8664-vinsns: actually commit the file.
x8632-vinsns: in CJMP vinsn, don't shift temp.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 166.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  (jne :bad)
4213
4214  (