source: release/1.2/source/compiler/X86/X8664/x8664-vinsns.lisp @ 11283

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

Propagate r11282 to 1.2:

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