source: trunk/ccl/compiler/X86/X8664/x8664-vinsns.lisp @ 6464

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

Use "tail-aligned" calls for most things, except calls to subprims
that manipulate the stack.

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