source: trunk/source/compiler/X86/X8632/x8632-vinsns.lisp @ 15772

Last change on this file since 15772 was 15772, checked in by gb, 9 years ago

REQUIRE-FIXNUM: can use testb of low byte of object reg if value <= ebx.
REQUIRE-CHAR-CODE: likewise, but bother to check to see if low byte of
register can be used ...

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