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

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

x8664-vinsns: actually commit the file.
x8632-vinsns: in CJMP vinsn, don't shift temp.

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)))
4178  (movsd (:@ (:%l base) (:%l idx) 2) (:%xmm dest)))