source: branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp @ 8858

Last change on this file since 8858 was 8858, checked in by rme, 12 years ago

Add vinsns gets32 and getu32.

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