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

Last change on this file since 9756 was 9756, checked in by rme, 11 years ago

Not ready for vinsn aset1 yet.

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