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

Last change on this file since 8009 was 8009, checked in by gb, 13 years ago

check-min-max-args: use the same anchor in both anchored UUOs.

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