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

Last change on this file since 14998 was 14998, checked in by gb, 8 years ago

Conditionally (using *x862-generate-casejump*, which defaults to false
for now) enable code to do constant-time CASE for certain types/ranges
of keys via a jump table.

Make the X86 disassembler recognize references to labels referenced from
the jump table (though it doesn't yet do anything to show the jump table
itself.)

This is about as far along as the ARM backend has been for the last few
months; the mechanics of dispatching through the jump table seem to be
correct, but the code generated at each case label is only correct in
certain circumstances.

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