source: branches/1.2-devel/ccl/compiler/X86/X8664/x8664-vinsns.lisp @ 7980

Last change on this file since 7980 was 7980, checked in by gb, 14 years ago

COMPARE-TO-T, COMPARE-CONSTANT-TO-REGISTER.

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