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

Last change on this file since 9630 was 9630, checked in by gb, 12 years ago

Avoid a few cases of partial register writes (assignments to the low
16 bits of a register), which can have a surprisingly severe negative
effect on performance. (Catching more cases involves some bootstrapping
of kernel changes from the trunk, to guarantee that "set_nargs()" always
zero-extends the argument count through all bits in the register.)

Make CODE-CHAR return NIL for codes #xFFFE and #xFFFF, which are defined
(along with things in the surrogate-pair range) to be invalid. This
slows down CODE-CHAR a little (obviously), but avoids problems and
keeps higher-level things from having to worry about that.

(Note that (CODE-CHAR (THE CCL::VALID-CHAR-CODE x)) skips this checking
when it's safe to do so.)


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