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

Last change on this file since 9589 was 9589, checked in by gz, 12 years ago

Do unsigned comparison in check-misc-bound

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