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

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

tail-funcall: fix typo affecting funcalling a symbol

init-nclosure: store correct self-reference offset in table

File size: 134.8 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.pt :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.pt :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.pt :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.pt :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.pt :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.pn :bad)
494  (movl (:%l object) (:%l tag))
495  (andl (:$b x8632::fulltagmask) (:%l tag))
496  (cmpl (:$b x8632::fulltag-cons) (:%l tag))
497  (je.pt :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.pt :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.pt :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.pt :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.pt :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.pt :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.pt :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.pt :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.pt :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.pt :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.pn :bad)
812  (testl (:$l x8632::fixnummask) (:%l dest))
813  (jne.pn :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.pt :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.pn :bad)
841  (testl (:$l x8632::fixnummask) (:%l dest))
842  (je.pt :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;;; xxx -- review this again later
854(define-x8632-vinsn unbox-u32 (((dest :u32))
855                               ((src :lisp)))
856  (movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest))
857  (testl (:%l dest) (:%l src))
858  (movl (:%l src) (:%l dest))
859  (jnz :maybe-bignum)
860  (sarl (:$ub x8632::fixnumshift) (:%l dest))
861  (jmp :done)
862  :maybe-bignum
863  (andl (:$b x8632::tagmask) (:%l dest))
864  (cmpl (:$b x8632::tag-misc) (:%l dest))
865  (jne :have-tag)
866  (movb (:@ x8632::misc-subtag-offset (:%l src)) (:%b dest))
867  (andl (:$l #xff) (:%l dest))
868  :have-tag
869  (cmpl (:$b x8632::subtag-bignum) (:%l dest))
870  (jne :bad)
871  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest))
872  (cmpl (:$l x8632::three-digit-bignum-header) (:%l dest))
873  (je :three)
874  (cmpl (:$l x8632::two-digit-bignum-header) (:%l dest))
875  (jne :bad)
876  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
877  (testl (:%l dest) (:%l dest))
878  (jns :done)
879  :bad
880  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32))
881  :three
882  (movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest))
883  (testl (:%l dest) (:%l dest))
884  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
885  (jne :bad)
886  :done)
887
888;;; xxx -- review this again later
889(define-x8632-vinsn unbox-s32 (((dest :s32))
890                               ((src :lisp)))
891  (movl (:%l src) (:%l dest))
892  (sarl (:$ub x8632::fixnumshift) (:%l dest))
893  ;; Was it a fixnum ?
894  (testl (:$l x8632::fixnummask) (:%l src))
895  (je :done)
896  ;; May be a 2-digit bignum
897  (movl (:%l src) (:%l dest))
898  (andl (:$b x8632::tagmask) (:%l dest))
899  (cmpl (:$b x8632::tag-misc) (:%l dest))
900  (jne :bad)
901  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src)))
902  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
903  (je :done)
904  :bad
905  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32))
906  :done)
907
908
909;;; xxx -- sigh...
910(define-x8632-vinsn sign-extend-s8 (((dest :s32))
911                                    ((src :s8)))
912  ;; (movsbl (:%b temp) (:%l dest))
913  (movl (:%l src) (:%l dest))
914  (shll (:$ub 24) (:%l dest))
915  (sarl (:$ub 24) (:%l dest)))
916
917(define-x8632-vinsn sign-extend-s16 (((dest :s32))
918                                     ((src :s16)))
919  (movswl (:%w src) (:%l dest)))
920
921;;; xxx -- sigh...
922(define-x8632-vinsn zero-extend-u8 (((dest :s32))
923                                    ((src :u8)))
924  ;;(movzbl (:%b src) (:%l dest))
925  (movl (:%l src) (:%l dest))
926  (andl (:$l #xff) (:%l dest)))
927
928(define-x8632-vinsn zero-extend-u16 (((dest :s32))
929                                     ((src :u16)))
930  (movzwl (:%w src) (:%l dest)))
931
932(define-x8632-vinsn (jump-subprim :jumpLR) (()
933                                            ((spno :s32const)))
934  (jmp (:@ spno)))
935
936;;; Call a subprimitive using a tail-aligned CALL instruction.
937(define-x8632-vinsn (call-subprim :call)  (()
938                                           ((spno :s32const))
939                                           ((entry (:label 1))))
940  (:talign x8632::fulltag-tra)
941  (call (:@ spno))
942  (movl (:$self 0) (:% x8632::fn)))
943
944(define-x8632-vinsn fixnum-subtract-from (((dest t)
945                                           (y t))
946                                          ((y t)
947                                           (x t)))
948  (subl (:%l y) (:%l x)))
949
950(define-x8632-vinsn %logand-c (((dest t)
951                                (val t))
952                               ((val t)
953                                (const :s32const)))
954  ((:and (:pred >= const -128) (:pred <= const 127))
955   (andl (:$b const) (:%l val)))
956  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
957   (andl (:$l const) (:%l val))))
958
959(define-x8632-vinsn %logior-c (((dest t)
960                                (val t))
961                               ((val t)
962                                (const :s32const)))
963  ((:and (:pred >= const -128) (:pred <= const 127))
964   (orl (:$b const) (:%l val)))
965  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
966   (orl (:$l const) (:%l val))))
967
968(define-x8632-vinsn %logxor-c (((dest t)
969                                (val t))
970                               ((val t)
971                                (const :s32const)))
972  ((:and (:pred >= const -128) (:pred <= const 127))
973   (xorl (:$b const) (:%l val)))
974  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
975   (xorl (:$l const) (:%l val))))
976
977(define-x8632-vinsn character->fixnum (((dest :lisp))
978                                       ((src :lisp))
979                                       ())
980  ((:not (:pred =
981                (:apply %hard-regspec-value dest)
982                (:apply %hard-regspec-value src)))
983   (movl (:%l src) (:%l dest)))
984  (shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest)))
985
986(define-x8632-vinsn compare (()
987                             ((x t)
988                              (y t)))
989  (rcmpl (:%l x) (:%l y)))
990
991(define-x8632-vinsn negate-fixnum (((val :lisp))
992                                   ((val :imm)))
993  (negl (:% val)))
994
995;;; This handles the 1-bit overflow from addition/subtraction/unary negation
996(define-x8632-vinsn set-bigits-and-header-for-fixnum-overflow
997    (()
998     ((val :lisp)
999      (no-overflow
1000       :label))
1001     ((imm (:u32 #.x8632::imm0))))
1002  (jno.pt no-overflow)
1003  (movl (:%l val) (:%l imm))
1004  (sarl (:$ub x8632::fixnumshift) (:%l imm))
1005  (xorl (:$l #xc0000000) (:%l imm))
1006  ;; stash bignum digit
1007  (movd (:%l imm) (:%mmx x8632::mm1))
1008  ;; set header
1009  (movl (:$l x8632::one-digit-bignum-header) (:%l imm))
1010  (movd (:%l imm) (:%mmx x8632::mm0))
1011  ;; need 8 bytes of aligned memory for 1 digit bignum
1012  (movl (:$l (- 8 x8632::fulltag-misc)) (:%l imm)))
1013
1014(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
1015                                                      ((bignum :lisp)))
1016  (movd (:%mmx x8632::mm1) (:@ x8632::misc-data-offset (:%l bignum)))) 
1017
1018
1019(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
1020                                                       ((src :s32))
1021                                                       ((temp :s32)))
1022  (movl (:%l src) (:%l temp))
1023  (shll (:$ub x8632::fixnumshift) (:%l temp))
1024  (movl (:%l temp) (:%l dest))          ; tagged as a fixnum
1025  (sarl (:$ub x8632::fixnumshift) (:%l temp))
1026  (cmpl (:%l src) (:%l temp)))
1027
1028(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
1029                                                       ((src :u32))
1030                                                       ((temp :u32)))
1031  (movl (:%l src) (:%l temp))
1032  (shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
1033  (movl (:%l temp) (:%l dest))          ; tagged as an even fixnum
1034  (shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
1035  (shrl (:%l dest))
1036  (cmpl (:%l src) (:%l temp))
1037  :done)
1038
1039;;; setup-bignum-alloc-for-s32-overflow
1040;;; setup-bignum-alloc-for-u32-overflow
1041
1042(define-x8632-vinsn setup-uvector-allocation (()
1043                                              ((header :imm)))
1044  (movd (:%l header) (:%mmx x8632::mm0)))
1045
1046;;; The code that runs in response to the uuo-alloc
1047;;; expects a header in mm0, and a size in imm0.
1048;;; mm0 is an implicit arg (it contains the uvector header)
1049;;; size is actually an arg, not a temporary,
1050;;; but it appears that there's isn't a way to enforce
1051;;; register usage on vinsn args.
1052(define-x8632-vinsn %allocate-uvector (((dest :lisp))
1053                                       ()
1054                                       ((size (:u32 #.x8632::imm0))
1055                                        (freeptr (:lisp #.x8632::allocptr))))
1056  (subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
1057  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
1058  (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
1059  (jg :no-trap)
1060  (uuo-alloc)
1061  :no-trap
1062  (movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
1063  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
1064  ((:not (:pred = freeptr
1065                (:apply %hard-regspec-value dest)))
1066   (movl (:%l freeptr) (:%l dest))))
1067
1068(define-x8632-vinsn box-fixnum (((dest :imm))
1069                                ((src :s32)))
1070  ;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
1071  (leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
1072
1073;;; xxx
1074(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
1075    (((val :lisp))
1076     ((val :lisp))
1077     ((unboxed (:s32 #.x8632::edx))
1078      (header (:u32 #.x8632::imm0))
1079      (entry (:label 1))))
1080  (jno.pt :done)
1081  ((:not (:pred = x8632::arg_z
1082                (:apply %hard-regspec-value val)))
1083   (movl (:%l val) (:%l x8632::arg_z)))
1084  (:talign 5)
1085  (call (:@ .SPfix-overflow))
1086  (movl (:$self 0) (:%l x8632::fn))
1087  ((:not (:pred = x8632::arg_z
1088                (:apply %hard-regspec-value val)))
1089   (movl (:%l x8632::arg_z) (:%l val)))
1090  :done)
1091
1092;;; xxx
1093(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
1094    (((val :lisp))
1095     ((val :lisp)
1096      (lab :label))
1097     ((unboxed (:s32 #.x8664::imm1))
1098      (header (:u32 #.x8664::imm0))
1099      (entry (:label 1))))
1100  (jno.pt lab)
1101  ((:not (:pred = x8632::arg_z
1102                (:apply %hard-regspec-value val)))
1103   (movl (:%l val) (:%l x8632::arg_z)))
1104  (:talign 5)
1105  (call (:@ .SPfix-overflow))
1106  (movl (:$self 0) (:%l x8632::fn))
1107  ((:not (:pred = x8632::arg_z
1108                (:apply %hard-regspec-value val)))
1109   (movl (:%l x8632::arg_z) (:%l val)))
1110  (jmp lab))
1111
1112
1113(define-x8632-vinsn add-constant (((dest :imm))
1114                                  ((dest :imm)
1115                                   (const :s32const)))
1116  ((:and (:pred >= const -128) (:pred <= const 127))
1117   (addl (:$b const) (:%l dest)))
1118  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1119   (addl (:$l const) (:%l dest))))
1120
1121(define-x8632-vinsn add-constant3 (((dest :imm))
1122                                   ((src :imm)
1123                                    (const :s32const)))
1124  ((:pred = (:apply %hard-regspec-value dest)
1125          (:apply %hard-regspec-value src))
1126   ((:and (:pred >= const -128) (:pred <= const 127))
1127    (addl (:$b const) (:%l dest)))
1128   ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1129    (addl (:$l const) (:%l dest))))
1130  ((:not (:pred = (:apply %hard-regspec-value dest)
1131                (:apply %hard-regspec-value src)))
1132   (leal (:@ const (:%l src)) (:%l dest))))
1133
1134(define-x8632-vinsn fixnum-add2  (((dest :imm))
1135                                  ((dest :imm)
1136                                   (other :imm)))
1137  (addl (:%l other) (:%l dest)))
1138
1139(define-x8632-vinsn fixnum-sub2  (((dest :imm))
1140                                  ((x :imm)
1141                                   (y :imm))
1142                                  ((temp :imm)))
1143  (movl (:%l x) (:%l temp))
1144  (subl (:%l y) (:%l temp))
1145  (movl (:%l temp) (:%l dest)))
1146
1147(define-x8632-vinsn fixnum-add3 (((dest :imm))
1148                                 ((x :imm)
1149                                  (y :imm)))
1150 
1151  ((:pred =
1152          (:apply %hard-regspec-value x)
1153          (:apply %hard-regspec-value dest))
1154   (addl (:%l y) (:%l dest)))
1155  ((:not (:pred =
1156                (:apply %hard-regspec-value x)
1157                (:apply %hard-regspec-value dest)))
1158   ((:pred =
1159           (:apply %hard-regspec-value y)
1160           (:apply %hard-regspec-value dest))
1161    (addl (:%l x) (:%l dest)))
1162   ((:not (:pred =
1163                 (:apply %hard-regspec-value y)
1164                 (:apply %hard-regspec-value dest)))
1165    (leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1166
1167(define-x8632-vinsn copy-gpr (((dest t))
1168                              ((src t)))
1169  ((:not (:pred =
1170                (:apply %hard-regspec-value dest)
1171                (:apply %hard-regspec-value src)))
1172   (movl (:%l src) (:%l dest))))
1173
1174(define-x8632-vinsn (vpop-register :pop :node :vsp)
1175    (((dest :lisp))
1176     ())
1177  (popl (:%l dest)))
1178
1179(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1180                                                     ())
1181  (rcmpl (:%l x8632::nargs) (:$b (* 1 x8632::node-size)))
1182  (jb :done)
1183  (je :one)
1184  (pushl (:%l x8632::arg_y))
1185  :one
1186  (pushl (:%l x8632::arg_z))
1187  :done)
1188
1189(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1190                                                         ((max :u32const)))
1191  ((:pred >= max 2)
1192   (rcmpl (:%l x8632::nargs) (:$b (* 1 x8632::node-size)))
1193   (jb :done)
1194   (je :one)
1195   (pushl (:%l x8632::arg_y))
1196   :one
1197   (pushl (:%l x8632::arg_z))
1198   :done)
1199  ((:pred = max 1)
1200   (testl (:%l x8632::nargs) (:%l x8632::nargs))
1201   (je :done)
1202   (pushl (:%l x8632::arg_z))
1203   :done))
1204
1205(define-x8632-vinsn (call-label :call) (()
1206                                        ((label :label))
1207                                        ((entry (:label 1))))
1208  (:talign 5)
1209  (call label)
1210  (movl (:$self 0) (:%l x8632::fn)))
1211
1212(define-x8632-vinsn double-float-compare (()
1213                                          ((arg0 :double-float)
1214                                           (arg1 :double-float)))
1215  (comisd (:%xmm arg1) (:%xmm arg0)))
1216
1217(define-x8632-vinsn single-float-compare (()
1218                                          ((arg0 :single-float)
1219                                           (arg1 :single-float)))
1220  (comiss (:%xmm arg1) (:%xmm arg0)))
1221
1222(define-x8632-vinsn double-float+-2 (((result :double-float))
1223                                     ((x :double-float)
1224                                      (y :double-float)))
1225  ((:pred =
1226          (:apply %hard-regspec-value result)
1227          (:apply %hard-regspec-value x))
1228   (addsd (:%xmm y) (:%xmm result)))
1229  ((:and (:not (:pred =
1230                      (:apply %hard-regspec-value result)
1231                      (:apply %hard-regspec-value x)))
1232         (:pred =
1233                (:apply %hard-regspec-value result)
1234                (:apply %hard-regspec-value y)))
1235   (addsd (:%xmm x) (:%xmm result)))
1236  ((:and (:not (:pred =
1237                      (:apply %hard-regspec-value result)
1238                      (:apply %hard-regspec-value x)))
1239         (:not (:pred =
1240                      (:apply %hard-regspec-value result)
1241                      (:apply %hard-regspec-value y))))
1242   (movsd (:%xmm x) (:%xmm result))
1243   (addsd (:%xmm y) (:%xmm result))))
1244
1245;;; Caller guarantees (not (eq y result))
1246(define-x8632-vinsn double-float--2 (((result :double-float))
1247                                     ((x :double-float)
1248                                      (y :double-float)))
1249  ((:not (:pred = (:apply %hard-regspec-value result)
1250                (:apply %hard-regspec-value x)))
1251   (movsd (:%xmm x) (:%xmm result)))
1252  (subsd (:%xmm y) (:%xmm result)))
1253
1254(define-x8632-vinsn double-float*-2 (((result :double-float))
1255                                     ((x :double-float)
1256                                      (y :double-float)))
1257  ((:pred =
1258          (:apply %hard-regspec-value result)
1259          (:apply %hard-regspec-value x))
1260   (mulsd (:%xmm y) (:%xmm result)))
1261  ((:and (:not (:pred =
1262                      (:apply %hard-regspec-value result)
1263                      (:apply %hard-regspec-value x)))
1264         (:pred =
1265                (:apply %hard-regspec-value result)
1266                (:apply %hard-regspec-value y)))
1267   (mulsd (:%xmm x) (:%xmm result)))
1268  ((:and (:not (:pred =
1269                      (:apply %hard-regspec-value result)
1270                      (:apply %hard-regspec-value x)))
1271         (:not (:pred =
1272                      (:apply %hard-regspec-value result)
1273                      (:apply %hard-regspec-value y))))
1274   (movsd (:%xmm x) (:%xmm result))
1275   (mulsd (:%xmm y) (:%xmm result))))
1276
1277;;; Caller guarantees (not (eq y result))
1278(define-x8632-vinsn double-float/-2 (((result :double-float))
1279                                     ((x :double-float)
1280                                      (y :double-float)))
1281  ((:not (:pred = (:apply %hard-regspec-value result)
1282                (:apply %hard-regspec-value x)))
1283   (movsd (:%xmm x) (:%xmm result)))
1284  (divsd (:%xmm y) (:%xmm result)))
1285
1286(define-x8632-vinsn single-float+-2 (((result :single-float))
1287                                     ((x :single-float)
1288                                      (y :single-float)))
1289  ((:pred =
1290          (:apply %hard-regspec-value result)
1291          (:apply %hard-regspec-value x))
1292   (addss (:%xmm y) (:%xmm result)))
1293  ((:and (:not (:pred =
1294                      (:apply %hard-regspec-value result)
1295                      (:apply %hard-regspec-value x)))
1296         (:pred =
1297                (:apply %hard-regspec-value result)
1298                (:apply %hard-regspec-value y)))
1299   (addss (:%xmm x) (:%xmm result)))
1300  ((:and (:not (:pred =
1301                      (:apply %hard-regspec-value result)
1302                      (:apply %hard-regspec-value x)))
1303         (:not (:pred =
1304                      (:apply %hard-regspec-value result)
1305                      (:apply %hard-regspec-value y))))
1306   (movss (:%xmm x) (:%xmm result))
1307   (addss (:%xmm y) (:%xmm result))))
1308
1309;;; Caller guarantees (not (eq y result))
1310(define-x8632-vinsn single-float--2 (((result :single-float))
1311                                     ((x :single-float)
1312                                      (y :single-float)))
1313  ((:not (:pred = (:apply %hard-regspec-value result)
1314                (:apply %hard-regspec-value x)))
1315   (movss (:%xmm x) (:%xmm result)))
1316  (subss (:%xmm y) (:%xmm result)))
1317
1318(define-x8632-vinsn single-float*-2 (((result :single-float))
1319                                     ((x :single-float)
1320                                      (y :single-float)))
1321    ((:pred =
1322          (:apply %hard-regspec-value result)
1323          (:apply %hard-regspec-value x))
1324   (mulss (:%xmm y) (:%xmm result)))
1325  ((:and (:not (:pred =
1326                      (:apply %hard-regspec-value result)
1327                      (:apply %hard-regspec-value x)))
1328         (:pred =
1329                (:apply %hard-regspec-value result)
1330                (:apply %hard-regspec-value y)))
1331   (mulss (:%xmm x) (:%xmm result)))
1332  ((:and (:not (:pred =
1333                      (:apply %hard-regspec-value result)
1334                      (:apply %hard-regspec-value x)))
1335         (:not (:pred =
1336                      (:apply %hard-regspec-value result)
1337                      (:apply %hard-regspec-value y))))
1338   (movss (:%xmm x) (:%xmm result))
1339   (mulss (:%xmm y) (:%xmm result))))
1340
1341;;; Caller guarantees (not (eq y result))
1342(define-x8632-vinsn single-float/-2 (((result :single-float))
1343                                     ((x :single-float)
1344                                      (y :single-float)))
1345  ((:not (:pred = (:apply %hard-regspec-value result)
1346                (:apply %hard-regspec-value x)))
1347   (movss (:%xmm x) (:%xmm result)))
1348  (divss (:%xmm y) (:%xmm result)))
1349
1350(define-x8632-vinsn get-single (((result :single-float))
1351                                ((source :lisp)))
1352  (movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1353
1354(define-x8632-vinsn get-double (((result :double-float))
1355                                ((source :lisp)))
1356  (movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1357
1358;;; Extract a double-float value, typechecking in the process.
1359;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1360;;; instead of replicating it ..
1361;;; get-double?
1362
1363
1364(define-x8632-vinsn copy-double-float (((dest :double-float))
1365                                       ((src :double-float)))
1366  (movsd (:%xmm src) (:%xmm dest)))
1367
1368(define-x8632-vinsn copy-single-float (((dest :single-float))
1369                                       ((src :single-float)))
1370  (movss (:%xmm src) (:%xmm dest)))
1371
1372(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1373                                           ((src :single-float)))
1374  (cvtss2sd (:%xmm src) (:%xmm dest)))
1375
1376(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1377                                           ((src :double-float)))
1378  (cvtsd2ss (:%xmm src) (:%xmm dest)))
1379
1380(define-x8632-vinsn fitvals (()
1381                             ((n :u16const))
1382                             ((imm :u32)))
1383  ((:pred = n 0)
1384   (xorl (:%l imm) (:%l imm)))
1385  ((:not (:pred = n 0))
1386   (movl (:$l (:apply ash n x8632::fixnumshift)) (:%l imm)))
1387  (subl (:%l x8632::nargs) (:%l imm))
1388  (jae :push-more)
1389  (subl (:%l imm) (:%l x8632::esp))
1390  (jmp :done)
1391  :push-loop
1392  (pushl (:$l x8632::nil-value))
1393  (addl (:$b x8632::node-size) (:%l x8632::nargs))
1394  (subl (:$b x8632::node-size) (:%l imm))
1395  :push-more
1396  (jne :push-loop)
1397  :done)
1398
1399(define-x8632-vinsn (nvalret :jumpLR) (()
1400                                       ())
1401  (jmp (:@ .SPnvalret)))
1402
1403(define-x8632-vinsn lisp-word-ref (((dest t))
1404                                   ((base t)
1405                                    (offset t)))
1406  (movl (:@ (:%l base) (:%l offset)) (:%l  dest)))
1407
1408(define-x8632-vinsn lisp-word-ref-c (((dest t))
1409                                     ((base t)
1410                                      (offset :s32const)))
1411  ((:pred = offset 0)
1412   (movl (:@ (:%l base)) (:%l dest)))
1413  ((:not (:pred = offset 0))
1414   (movl (:@ offset (:%l base)) (:%l dest))))
1415
1416;; start-mv-call
1417
1418(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1419                                                    ((label :label))
1420                                                    ((temp :lisp)))
1421  (leal (:@ (:^ label) (:%l x8632::fn)) (:%l temp))
1422  (pushl (:%l temp)))
1423
1424(define-x8632-vinsn emit-aligned-label (()
1425                                        ((label :label)))
1426  ;; We don't care about label.
1427  ;; We just want the label following this stuff to be tra-tagged.
1428  (:align 3)
1429  (nop) (nop) (nop) (nop) (nop))
1430
1431;; pass-multiple-values-symbol
1432;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1433(define-x8632-vinsn pass-multiple-values-symbol (()
1434                                                 ())
1435  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr)))) 
1436  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1437
1438
1439;;; It'd be good to have a variant that deals with a known function
1440;;; as well as this.
1441(define-x8632-vinsn pass-multiple-values (()
1442                                          ()
1443                                          ((tag :u8)))
1444  (movb (:%b x8632::temp0) (:%b tag))
1445  (andb (:$b x8632::tagmask) (:%b tag))
1446  (cmpb (:$b x8632::tag-misc) (:%b tag))
1447  (jne :bad)
1448  (cmpb (:$b x8632::subtag-function) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
1449  (cmovel (:%l x8632::temp0) (:%l x8632::fn))
1450  (je :go)
1451  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
1452  (cmovel (:@ x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::fn))
1453  (jne :bad)
1454  :go
1455  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr))))
1456  (jmp (:%l x8632::fn))
1457  :bad
1458  (uuo-error-not-callable)
1459  ;; If we don't do this (and leave %fn as a TRA into itself), reporting
1460  ;; the error is likely a little harder.  Tough.
1461  ;; (leaq (@ (:apply - (:^ :bad)) (:%q x8664::rn)) (:%q x8664::fn))
1462)
1463
1464
1465(define-x8632-vinsn reserve-outgoing-frame (()
1466                                            ())
1467  (pushl (:$b x8632::reserved-frame-marker))
1468  (pushl (:$b x8632::reserved-frame-marker)))
1469
1470;; implicit temp0 arg
1471(define-x8632-vinsn (call-known-function :call) (()
1472                                                 ()
1473                                                 ((entry (:label 1))))
1474  (:talign 5)
1475  (call (:%l x8632::temp0))
1476  (movl (:$self 0) (:%l x8632::fn)))
1477
1478(define-x8632-vinsn (jump-known-function :jumplr) (()
1479                                                   ())
1480  (jmp (:%l x8632::temp0)))
1481
1482(define-x8632-vinsn (list :call) (()
1483                                  ()
1484                                  ((entry (:label 1))
1485                                   (temp (:lisp #.x8632::temp0))))
1486  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::temp0))
1487  (:talign 5)
1488  (jmp (:@ .SPconslist))
1489  :back
1490  (movl (:$self 0) (:%l x8632::fn)))
1491
1492(define-x8632-vinsn make-fixed-stack-gvector (((dest :lisp))
1493                                              ((aligned-size :u32const)
1494                                               (header :s32const))
1495                                              ((tempa :imm)
1496                                               (tempb :imm)))
1497  ((:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1498         (:pred <= (:apply + aligned-size x8632::dnode-size) 127))
1499   (subl (:$b (:apply + aligned-size x8632::dnode-size))
1500         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1501  ((:not (:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1502               (:pred <= (:apply + aligned-size x8632::dnode-size) 127)))
1503   (subl (:$l (:apply + aligned-size x8632::dnode-size))
1504         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1505  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l tempb))
1506  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l tempa))
1507  (movd (:%l tempb) (:%mmx x8632::stack-temp))
1508  :loop
1509  (movsd (:%xmm x8632::fpzero) (:@ -8 (:%l tempb)))
1510  (subl (:$b x8632::dnode-size) (:%l tempb))
1511  (cmpl (:%l tempa) (:%l tempb))
1512  (jnz :loop)
1513  (movd (:%mmx x8632::stack-temp) (:@ (:%l tempa)))
1514  (movl (:%l tempa) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1515  (movl (:$l header) (:@ x8632::dnode-size (:%l tempa)))
1516  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l tempa)) (:%l dest)))
1517
1518
1519
1520
1521(define-x8632-vinsn make-tsp-vcell (((dest :lisp))
1522                                    ((closed :lisp))
1523                                    ((temp :imm)))
1524  (subl (:$b (+ x8632::value-cell.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1525  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1526  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1527  (movsd (:%xmm x8632::fpzero) (:@ (:%l temp)))
1528  (movsd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
1529  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))) 
1530  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
1531  (movl (:$l x8632::value-cell-header) (:@ x8632::dnode-size (:%l temp)))
1532  (movl (:%l closed) (:@ (+ x8632::dnode-size x8632::node-size) (:%l temp)))
1533  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l temp)) (:%l dest)))
1534
1535(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1536                                   ((car :lisp) (cdr :lisp))
1537                                   ((temp :imm)))
1538  (subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1539  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1540  (movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1541  (movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1542  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1543  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1544  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1545  (leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1546  (movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1547  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1548  (movl (:%l temp) (:%l dest)))
1549
1550
1551;; make-fixed-stack-gvector
1552
1553(define-x8632-vinsn discard-temp-frame (()
1554                                        ()
1555                                        ((temp :imm)))
1556  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1557  (movl (:@ (:%l temp)) (:%l temp))
1558  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1559  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1560  )
1561
1562(define-x8632-vinsn discard-c-frame (()
1563                                     ()
1564                                     ((temp :imm)))
1565  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1566  (movl (:@ (:%l temp)) (:%l temp))
1567  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1568
1569 
1570(define-x8632-vinsn vstack-discard (()
1571                                    ((nwords :u32const)))
1572  ((:not (:pred = nwords 0))
1573   ((:pred < nwords 16)
1574    (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1575   ((:not (:pred < nwords 16))
1576    (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1577
1578(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1579  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1580    (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1581    (:talign 5)
1582    (jmp (:@ ,spno))
1583    :back
1584    (movl (:$self 0) (:%l x8632::fn))))
1585
1586(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1587  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1588    (:talign 5)
1589    (call (:@ ,spno))
1590    :back
1591    (movl (:$self 0) (:%l x8632::fn))))
1592
1593(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1594  `(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ())
1595    (jmp (:@ ,spno))))
1596
1597(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1598                                                        ((lab :label)))
1599  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1600  (jmp (:@ .SPnthrowvalues)))
1601
1602(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1603                                                        ((lab :label)))
1604  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1605  (jmp (:@ .SPnthrow1value)))
1606
1607
1608;;; xxx I don't know what these next 4 are doing.
1609(define-x8632-vinsn set-single-c-arg (()
1610                                      ((arg :single-float)
1611                                       (offset :u32const)))
1612  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l x8632::ra0))
1613  (movss (:%xmm arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l x8632::ra0))))
1614
1615(define-x8632-vinsn reload-single-c-arg (((arg :single-float))
1616                                         ((offset :u32const)))
1617  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l x8632::ra0))
1618  (movss (:@ (:apply + 8 (:apply ash offset 2)) (:%l x8632::ra0)) (:%xmm arg)))
1619
1620(define-x8632-vinsn set-double-c-arg (()
1621                                      ((arg :double-float)
1622                                       (offset :u32const)))
1623  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l x8632::ra0))
1624  (movsd (:%xmm arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l x8632::ra0))))
1625
1626(define-x8632-vinsn reload-double-c-arg (((arg :double-float))
1627                                         ((offset :u32const)))
1628  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l x8632::ra0))
1629  (movsd (:@ (:apply + 8 (:apply ash offset 2)) (:%l x8632::ra0)) (:%xmm arg)))
1630
1631(define-x8632-subprim-call-vinsn (ff-call)  .SPffcall)
1632
1633(define-x8632-subprim-call-vinsn (syscall)  .SPsyscall)
1634
1635(define-x8632-subprim-call-vinsn (syscall2)  .SPsyscall2)
1636
1637(define-x8632-subprim-call-vinsn (gets32) .SPgets32)
1638
1639(define-x8632-subprim-call-vinsn (getu32) .SPgetu32)
1640
1641(define-x8632-subprim-call-vinsn (gets64) .SPgets64)
1642
1643(define-x8632-subprim-call-vinsn (getu64) .SPgetu64)
1644
1645(define-x8632-subprim-call-vinsn (makes64) .SPmakes64)
1646
1647(define-x8632-subprim-call-vinsn (makeu64) .SPmakeu64)
1648
1649(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list*)  .SPstkconslist-star)
1650
1651(define-x8632-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
1652
1653(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1654
1655(define-x8632-vinsn bind-interrupt-level-0-inline (()
1656                                                   ()
1657                                                   ((temp :imm)))
1658  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1659  (cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1660  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1661  (pushl (:$b x8632::interrupt-level-binding-index))
1662  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1663  (movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1664  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1665  (jns.pt :done)
1666  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1667  (jae.pt :done)
1668  (ud2a)
1669  (:byte 2)
1670  :done)
1671
1672(define-x8632-vinsn bind-interrupt-level-m1-inline (()
1673                                                    ()
1674                                                    ((temp :imm)))
1675  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1676  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1677  (pushl (:$b x8632::interrupt-level-binding-index))
1678  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1679  (movl (:$l (ash -1 x8632::fixnumshift)) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1680  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link)))
1681
1682(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1683
1684(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1685
1686(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1687
1688#||
1689(define-x8632-vinsn unbind-interrupt-level-inline (()
1690                                                   ()
1691                                                   ((link :imm)
1692                                                    (curval :imm)
1693                                                    (oldval :imm)
1694                                                    (tlb :imm)))
1695  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l tlb))
1696  (movl (:@ (:%seg :rcontext) x8632::tcr.db-link) (:%l link))
1697  (movl (:@ x8632::interrupt-level-binding-index (:%l tlb)) (:%l curval))
1698  (testl (:%l curval) (:%l curval))
1699  (movl (:@ 8 #|binding.val|# (:%l link)) (:%l oldval))
1700  (movl (:@ #|binding.link|# (:%l link)) (:%l link))
1701  (movl (:%l oldval) (:@ x8632::interrupt-level-binding-index (:%l tlb)))
1702  (movl (:%l link) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1703  (jns.pt :done)
1704  (testl (:%l oldval) (:%l oldval))
1705  (js.pt :done)
1706  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1707  (jae.pt :done)
1708  (ud2a)
1709  (:byte 2)
1710  :done)
1711||#
1712
1713(define-x8632-vinsn (jump-return-pc :jumpLR) (()
1714                                              ())
1715  (ret))
1716
1717;;; xxx
1718(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
1719                                                      ((lab :label))
1720                                                      ((entry (:label 1))
1721                                                       (xfn (:lisp #.x8632::xfn))))
1722  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l xfn))
1723  (:talign 5)
1724  (call (:@ .SPmkcatchmv))
1725  :back
1726  (movl (:$self 0) (:%l x8632::fn)))
1727
1728(define-x8632-vinsn (nmkcatch1v :call :subprim-call) (()
1729                                                     ((lab :label))
1730                                                     ((entry (:label 1))))
1731  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1732  (:talign 5)
1733  (call (:@ .SPmkcatch1v))
1734  :back
1735  (movl (:$self 0) (:%l x8632::fn)))
1736
1737
1738(define-x8632-vinsn (make-simple-unwind :call :subprim-call) (()
1739                                                     ((protform-lab :label)
1740                                                      (cleanup-lab :label)))
1741  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1742  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1743  (jmp (:@ .SPmkunwind)))
1744
1745(define-x8632-vinsn (nmkunwind :call :subprim-call) (()
1746                                                     ((protform-lab :label)
1747                                                      (cleanup-lab :label)))
1748  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1749  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1750  (jmp (:@ .SPnmkunwind)))
1751
1752
1753(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1754
1755(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1756
1757(define-x8632-vinsn set-eq-bit (()
1758                                ())
1759  (testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1760
1761;;; %schar8
1762;;; %schar32
1763;;; %set-schar8
1764;;; %set-schar32
1765
1766(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1767                                             ((v :lisp)
1768                                              (idx :u32const)))
1769  (movsd (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1770
1771(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1772                                           ((header :lisp)))
1773  (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1774
1775(define-x8632-vinsn set-z-flag-if-istruct-typep (()
1776                                                 ((val :lisp)
1777                                                  (type :lisp))
1778                                                 ((tag :u8)
1779                                                  (valtype :lisp)))
1780  (xorl (:%l valtype) (:%l valtype))
1781  (movl (:%l val) (:%l tag))
1782  (andb (:$b x8632::tagmask) (:%b tag))
1783  (cmpb (:$b x8632::tag-misc) (:%b tag))
1784  (jne :have-tag)
1785  (movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
1786  :have-tag
1787  (cmpb (:$b x8632::subtag-istruct) (:%b tag))
1788  (jne :do-compare)
1789  (movl (:@ x8632::misc-data-offset (:%l val)) (:%l valtype))
1790  :do-compare
1791  (cmpl (:%l valtype) (:%l type)))
1792
1793(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1794
1795(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1796
1797(define-x8632-vinsn mem-set-c-constant-fullword (()
1798                                                 ((val :s32const)
1799                                                  (dest :address)
1800                                                  (offset :s32const)))
1801  ((:pred = offset 0)
1802   (movl (:$l val) (:@ (:%l dest))))
1803  ((:not (:pred = offset 0))
1804   (movl (:$l val) (:@ offset (:%l dest)))))
1805
1806(define-x8632-vinsn mem-set-c-halfword (()
1807                                        ((val :u16)
1808                                         (dest :address)
1809                                         (offset :s32const)))
1810  ((:pred = offset 0)
1811   (movw (:%w val) (:@ (:%l dest))))
1812  ((:not (:pred = offset 0))
1813   (movw (:%w val) (:@ offset (:%l dest)))))
1814
1815(define-x8632-vinsn mem-set-c-constant-halfword (()
1816                                                 ((val :s16const)
1817                                                  (dest :address)
1818                                                  (offset :s32const)))
1819  ((:pred = offset 0)
1820   (movw (:$w val) (:@ (:%l dest))))
1821  ((:not (:pred = offset 0))
1822   (movw (:$w val) (:@ offset (:%l dest)))))
1823
1824(define-x8632-vinsn mem-set-c-constant-byte (()
1825                                                 ((val :s8const)
1826                                                  (dest :address)
1827                                                  (offset :s32const)))
1828  ((:pred = offset 0)
1829   (movb (:$b val) (:@ (:%l dest))))
1830  ((:not (:pred = offset 0))
1831   (movb (:$b val) (:@ offset (:%l dest)))))
1832
1833(define-x8632-vinsn mem-set-c-byte (()
1834                                    ((val :u8)
1835                                     (dest :address)
1836                                     (offset :s32const)))
1837  ((:pred = offset 0)
1838   (movb (:%b val) (:@ (:%l dest))))
1839  ((:not (:pred = offset 0))
1840   (movb (:%b val) (:@ offset (:%l dest)))))
1841
1842(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1843                                           ((addr :s32const)))
1844  (movzbl (:@ addr) (:%l dest)))
1845
1846(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1847                                           ((addr :s32const)))
1848  (movsbl (:@ addr) (:%l dest)))
1849
1850(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1851                                           ((addr :s32const)))
1852  (movzwl (:@ addr) (:%l dest)))
1853
1854(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1855                                           ((addr :s32const)))
1856  (movswl (:@ addr) (:%l dest)))
1857
1858(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
1859                                                 ((addr :s32const)))
1860  (movl (:@ addr) (:%l dest)))
1861
1862(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
1863                                                        ((addr :s32const)))
1864  (movl (:@ addr) (:%l dest)))
1865
1866(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
1867                                                   ((addr :s32const)))
1868  (movl (:@ addr) (:%l dest)))
1869
1870(define-x8632-vinsn mem-ref-u8 (((dest :u8))
1871                                ((src :address)
1872                                 (index :s32)))
1873  (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
1874
1875(define-x8632-vinsn mem-ref-c-u16 (((dest :u16))
1876                                   ((src :address)
1877                                    (index :s32const)))
1878  ((:pred = index 0) 
1879   (movzwl (:@ (:%l src)) (:%l dest)))
1880  ((:not (:pred = index 0))
1881   (movzwl (:@ index (:%l src)) (:%l dest))))
1882
1883(define-x8632-vinsn mem-ref-u16 (((dest :u16))
1884                                 ((src :address)
1885                                  (index :s32)))
1886  (movzwl (:@ (:%l src) (:%l index)) (:%l dest)))
1887
1888(define-x8632-vinsn mem-ref-c-s16 (((dest :s16))
1889                                   ((src :address)
1890                                    (index :s32const)))
1891  ((:pred = index 0)
1892   (movswl (:@ (:%l src)) (:%l dest)))
1893  ((:not (:pred = index 0))
1894   (movswl (:@ index (:%l src)) (:%l dest))))
1895
1896(define-x8632-vinsn mem-ref-s16 (((dest :s16))
1897                                 ((src :address)
1898                                  (index :s32)))
1899  (movswl (:@ (:%l src) (:%l index)) (:%l dest)))
1900
1901(define-x8632-vinsn mem-ref-c-u8 (((dest :u8))
1902                                  ((src :address)
1903                                   (index :s16const)))
1904  ((:pred = index 0)
1905   (movzbl (:@  (:%l src)) (:%l dest)))
1906  ((:not (:pred = index 0))
1907   (movzbl (:@ index (:%l src)) (:%l dest))))
1908
1909(define-x8632-vinsn mem-ref-u8 (((dest :u8))
1910                                ((src :address)
1911                                 (index :s32)))
1912  (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
1913
1914(define-x8632-vinsn mem-ref-c-s8 (((dest :s8))
1915                                  ((src :address)
1916                                   (index :s16const)))
1917  ((:pred = index 0)
1918   (movsbl (:@ (:%l src)) (:%l dest)))
1919  ((:not (:pred = index 0))
1920   (movsbl (:@ index (:%l src)) (:%l dest))))
1921
1922(define-x8632-vinsn misc-set-c-s8  (((val :s8))
1923                                    ((v :lisp)
1924                                     (idx :u32const))
1925                                    ())
1926  (movb (:%b val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
1927
1928(define-x8632-vinsn misc-set-s8  (((val :s8))
1929                                  ((v :lisp)
1930                                   (scaled-idx :s32))
1931                                  ())
1932  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1933
1934(define-x8632-vinsn mem-ref-s8 (((dest :s8))
1935                                ((src :address)
1936                                 (index :s32)))
1937  (movsbl (:@ (:%l src) (:%l index)) (:%l dest)))
1938
1939(define-x8632-vinsn mem-set-constant-fullword (()
1940                                               ((val :s32const)
1941                                                (ptr :address)
1942                                                (offset :s32)))
1943  (movl (:$l val) (:@ (:%l ptr) (:%l offset))))
1944
1945
1946(define-x8632-vinsn mem-set-constant-halfword (()
1947                                               ((val :s16const)
1948                                                (ptr :address)
1949                                                (offset :s32)))
1950  (movw (:$w val) (:@ (:%l ptr) (:%l offset))))
1951
1952(define-x8632-vinsn mem-set-constant-byte (()
1953                                           ((val :s8const)
1954                                            (ptr :address)
1955                                            (offset :s32)))
1956  (movb (:$b val) (:@ (:%l ptr) (:%l offset))))
1957
1958(define-x8632-vinsn misc-set-u8  (((val :u8))
1959                                  ((v :lisp)
1960                                   (scaled-idx :s32))
1961                                  ())
1962  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1963
1964(define-x8632-vinsn misc-set-u16  (()
1965                                   ((val :u16)
1966                                    (v :lisp)
1967                                    (scaled-idx :s32))
1968                                   ())
1969  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1970
1971(define-x8632-vinsn misc-set-c-s16  (()
1972                                    ((val :s16)
1973                                     (v :lisp)
1974                                     (idx :s32const))
1975                                    ())
1976  (movw (:%w val) (:@ (:apply + x8632::misc-data-offset (:apply * 2 idx)) (:%l v))))
1977
1978(define-x8632-vinsn misc-set-s16  (()
1979                                   ((val :s16)
1980                                    (v :lisp)
1981                                    (scaled-idx :s32))
1982                                   ())
1983  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1984
1985(define-x8632-vinsn misc-set-c-u32  (()
1986                                     ((val :u32)
1987                                      (v :lisp)
1988                                      (idx :u32const)) ; sic
1989                                     ())
1990  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
1991
1992(define-x8632-vinsn misc-set-u32  (()
1993                                   ((val :u32)
1994                                    (v :lisp)
1995                                    (scaled-idx :s32))
1996                                   ())
1997  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1998
1999(define-x8632-vinsn misc-set-c-s32  (()
2000                                     ((val :s32)
2001                                      (v :lisp)
2002                                      (idx :u32const)) ; sic
2003                                     ())
2004  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
2005
2006(define-x8632-vinsn misc-set-s32  (()
2007                                   ((val :s32)
2008                                    (v :lisp)
2009                                    (scaled-idx :s32))
2010                                   ())
2011  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2012
2013(define-x8632-vinsn %iasr (((dest :imm))
2014                           ((count :imm)
2015                            (src :imm))
2016                           ((temp :s32)
2017                            (shiftcount (:s32 #.x8632::ecx))))
2018  (movl (:%l count) (:%l temp))
2019  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2020  (rcmpl (:%l temp) (:$l 31))
2021  (cmovbw (:%w temp) (:%w shiftcount))
2022  (movl (:%l src) (:%l temp))
2023  (jae :shift-max)
2024  (sarl (:%shift x8632::cl) (:%l temp))
2025  (jmp :done)
2026  :shift-max
2027  (sarl (:$ub 31) (:%l temp))
2028  :done
2029  (andl (:$l (lognot x8632::fixnummask)) (:%l temp))
2030  (movl (:%l temp) (:%l dest)))
2031
2032(define-x8632-vinsn %ilsr (((dest :imm))
2033                           ((count :imm)
2034                            (src :imm))
2035                           ((temp :s32)
2036                            (shiftcount (:s32 #.x8632::ecx))))
2037  (movl (:%l count) (:%l temp))
2038  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2039  (rcmpl (:%l temp) (:$l 31))
2040  (cmovbw (:%w temp) (:%w shiftcount))
2041  (movl (:%l src) (:%l temp))
2042  (jae :shift-max)
2043  (shrl (:%shift x8632::cl) (:%l temp))
2044  (jmp :done)
2045  :shift-max
2046  (shrl (:$ub 31) (:%l temp))
2047  :done
2048  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2049  (movl (:%l temp) (:%l dest)))
2050
2051(define-x8632-vinsn %iasr-c (((dest :imm))
2052                             ((count :u8const)
2053                              (src :imm))
2054                             ((temp :s32)))
2055  (movl (:%l src) (:%l temp))
2056  (sarl (:$ub count) (:%l temp))
2057  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2058  (movl (:%l temp) (:%l dest)))
2059
2060(define-x8632-vinsn %ilsr-c (((dest :imm))
2061                             ((count :u8const)
2062                              (src :imm))
2063                             ((temp :s32)))
2064  (movl (:%l src) (:%l temp))
2065  (shrl (:$ub count) (:%l temp))
2066  ;; xxx --- use :%acc
2067  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2068  (movl (:%l temp) (:%l dest)))
2069
2070(define-x8632-vinsn %ilsl (((dest :imm))
2071                           ((count :imm)
2072                            (src :imm))
2073                           ((temp (:s32 #.x8632::eax))
2074                            (shiftcount (:s32 #.x8632::ecx))))
2075  (movl (:%l count) (:%l temp))
2076  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2077  (rcmpl (:%l temp) (:$l 31))
2078  (cmovbw (:%w temp) (:%w shiftcount))
2079  (movl (:%l src) (:%l temp))
2080  (jae :shift-max)
2081  (shll (:%shift x8632::cl) (:%l temp))
2082  (jmp :done)
2083  :shift-max
2084  (xorl (:%l temp) (:%l temp))
2085  :done
2086  (movl (:%l temp) (:%l dest)))
2087
2088(define-x8632-vinsn %ilsl-c (((dest :imm))
2089                             ((count :u8const)
2090                              (src :imm)))
2091  ((:not (:pred =
2092                (:apply %hard-regspec-value src)
2093                (:apply %hard-regspec-value dest)))
2094   (movl (:%l src) (:%l dest)))
2095  (shll (:$ub count) (:%l dest)))
2096
2097;;; In safe code, something else has ensured that the value is of type
2098;;; BIT.
2099(define-x8632-vinsn set-variable-bit-to-variable-value (()
2100                                                        ((vec :lisp)
2101                                                         (word-index :s32)
2102                                                         (bitnum :u8)
2103                                                         (value :lisp)))
2104  (testl (:%l value) (:%l value))
2105  (je :clr)
2106  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
2107  (jmp :done)
2108  :clr
2109  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
2110  :done)
2111
2112;;; In safe code, something else has ensured that the value is of type
2113;;; BIT.
2114(define-x8632-vinsn nset-variable-bit-to-variable-value (()
2115                                                         ((vec :lisp)
2116                                                          (index :s32)
2117                                                          (value :lisp)))
2118  (testl (:%l value) (:%l value))
2119  (je :clr)
2120  (btsl (:%l index) (:@ x8632::misc-data-offset (:%l vec)))
2121  (jmp :done)
2122  :clr
2123  (btrl (:%l index) (:@ x8632::misc-data-offset (:%l vec)))
2124  :done)
2125
2126(define-x8632-vinsn nset-variable-bit-to-zero (()
2127                                              ((vec :lisp)
2128                                               (index :s32)))
2129  (btrl (:%l index) (:@ x8632::misc-data-offset (:%l vec))))
2130
2131(define-x8632-vinsn nset-variable-bit-to-one (()
2132                                             ((vec :lisp)
2133                                              (index :s32)))
2134  (btsl (:%l index) (:@ x8632::misc-data-offset (:%l vec))))
2135
2136(define-x8632-vinsn set-variable-bit-to-zero (()
2137                                              ((vec :lisp)
2138                                               (word-index :s32)
2139                                               (bitnum :u8)))
2140  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
2141
2142(define-x8632-vinsn set-variable-bit-to-one (()
2143                                             ((vec :lisp)
2144                                              (word-index :s32)
2145                                              (bitnum :u8)))
2146  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
2147
2148(define-x8632-vinsn set-constant-bit-to-zero (()
2149                                              ((src :lisp)
2150                                               (idx :u32const)))
2151  (btrl (:$ub (:apply logand 31 idx))
2152        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2153
2154(define-x8632-vinsn set-constant-bit-to-one (()
2155                                             ((src :lisp)
2156                                              (idx :u32const)))
2157  (btsl (:$ub (:apply logand 31 idx))
2158        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2159
2160(define-x8632-vinsn set-constant-bit-to-variable-value (()
2161                                                        ((src :lisp)
2162                                                         (idx :u32const)
2163                                                         (value :lisp)))
2164  (testl (:%l value) (:%l value))
2165  (je :clr)
2166  (btsl (:$ub (:apply logand 31 idx))
2167        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2168  (jmp :done)
2169  :clr
2170  (btrl (:$ub (:apply logand 31 idx))
2171        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2172  :done)
2173
2174(define-x8632-vinsn require-fixnum (()
2175                                    ((object :lisp)))
2176  :again
2177  ((:and (:pred > (:apply %hard-regspec-value object) x8632::eax)
2178         (:pred <= (:apply %hard-regspec-value object) x8632::ebx))
2179   (testb (:%b x8632::fixnummask) (:%b object)))
2180  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2181   (testl (:$l x8632::fixnummask) (:%l object)))
2182  (je.pt :got-it)
2183  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-fixnum))
2184  (jmp :again)
2185  :got-it)
2186
2187(define-x8632-vinsn require-integer (()
2188                                     ((object :lisp))
2189                                     ((tag :u8)))
2190  :again
2191  (movl (:%l object) (:%l tag))
2192  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2193   (andb (:$b x8632::fixnummask) (:%accb tag)))
2194  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2195         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2196   (andb (:$b x8632::fixnummask) (:%b tag)))
2197  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2198   (andl (:$l x8632::fixnummask) (:%l tag)))
2199  (je.pt :got-it)
2200  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2201   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
2202  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2203         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2204   (cmpb (:$b x8632::tag-misc) (:%b tag)))
2205  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2206   (cmpl (:$l x8632::tag-misc) (:%l tag)))
2207  (jne :bad)
2208  (cmpb (:$b x8632::subtag-bignum) (:@ x8632::misc-subtag-offset (:%l object)))
2209  (je :got-it)
2210  :bad
2211  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-integer))
2212  (jmp :again)
2213  :got-it)
2214
2215(define-x8632-vinsn require-simple-vector (()
2216                                           ((object :lisp))
2217                                           ((tag :u8)))
2218  :again
2219  (movb (:%b object) (:%b tag))
2220  (andb (:$b x8632::fixnummask) (:%b tag))
2221  (cmpb (:$b x8632::tag-misc) (:%b tag))
2222  (jne :bad)
2223  (cmpb (:$b x8632::subtag-simple-vector) (:@ x8632::misc-subtag-offset (:%l object)))
2224  (je :got-it)
2225  :bad
2226  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-simple-vector))
2227  (jmp :again)
2228  :got-it)
2229
2230(define-x8632-vinsn require-simple-string (()
2231                                           ((object :lisp))
2232                                           ((tag :u8)))
2233  :again
2234  (movb (:%b object) (:%b tag))
2235  (andb (:$b x8632::fixnummask) (:%b tag))
2236  (cmpb (:$b x8632::tag-misc) (:%b tag))
2237  (jne :bad)
2238  (cmpb (:$b x8632::subtag-simple-base-string) (:@ 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-simple-string))
2242  (jmp :again)
2243  :got-it)
2244
2245
2246;;; naive
2247(define-x8632-vinsn require-real (()
2248                                    ((object :lisp))
2249                                    ((tag :u8)))
2250  :again
2251  (movl (:%l object) (:%l tag))
2252  (andb (:$b x8632::tagmask) (:%b tag))
2253  (cmpb (:$b x8632::tag-fixnum) (:%b tag))
2254  (je :good)
2255  (cmpb (:$b x8632::tag-misc) (:%b tag))
2256  (jne :bad)
2257  (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag))
2258  (cmpb (:$b x8632::subtag-single-float) (:%b tag))
2259  (je :good)
2260  (cmpb (:$b x8632::subtag-double-float) (:%b tag))
2261  (je :good)
2262  (cmpb (:$b x8632::subtag-bignum) (:%b tag))
2263  (je :good)
2264  (cmpb (:$b x8632::subtag-ratio) (:%b tag))
2265  (je :good)
2266  :bad
2267  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-real))
2268  (jmp :again)
2269  :good)
2270
2271;;; naive
2272(define-x8632-vinsn require-number (()
2273                                    ((object :lisp))
2274                                    ((tag :u8)))
2275  :again
2276  (movl (:%l object) (:%l tag))
2277  (andb (:$b x8632::tagmask) (:%b tag))
2278  (cmpb (:$b x8632::tag-fixnum) (:%b tag))
2279  (je :good)
2280  (cmpb (:$b x8632::tag-misc) (:%b tag))
2281  (jne :bad)
2282  (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag))
2283  (cmpb (:$b x8632::subtag-single-float) (:%b tag))
2284  (je :good)
2285  (cmpb (:$b x8632::subtag-double-float) (:%b tag))
2286  (je :good)
2287  (cmpb (:$b x8632::subtag-bignum) (:%b tag))
2288  (je :good)
2289  (cmpb (:$b x8632::subtag-ratio) (:%b tag))
2290  (je :good)
2291  (cmpb (:$b x8632::subtag-complex) (:%b tag))
2292  (je :good)
2293  :bad
2294  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-number))
2295  (jmp :again)
2296  :good)
2297
2298(define-x8632-vinsn require-list (()
2299                                  ((object :lisp))
2300                                  ((tag :u8)))
2301  :again
2302  (cmpl (:$l x8632::nil-value) (:%l object))
2303  (je :good)
2304  (movl (:%l object) (:%l tag))
2305  (andb (:$b x8632::fulltagmask) (:%b tag))
2306  (cmpb (:$b x8632::fulltag-cons) (:%b tag))
2307  (je :good)
2308  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-list))
2309  (jmp :again)
2310  :good)
2311
2312(define-x8632-vinsn require-symbol (()
2313                                    ((object :lisp))
2314                                    ((tag :u8)))
2315  :again
2316  (cmpl (:$l x8632::nil-value) (:%l object))
2317  (je :got-it)
2318  (movl (:%l object) (:%l tag))
2319  (andb (:$b x8632::tagmask) (:%b tag))
2320  (cmpb (:$b x8632::tag-misc) (:%b tag))
2321  (jne :bad)
2322  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l object)))
2323  (je :got-it)
2324  :bad
2325  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-symbol))
2326  (jmp :again)
2327  :got-it)
2328
2329(define-x8632-vinsn require-character (()
2330                                       ((object :lisp)))
2331  :again
2332  (cmpl (:$l x8632::subtag-character) (:%l object))
2333  (je.pt :ok)
2334  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-character))
2335  (jmp :again)
2336  :ok)
2337
2338(define-x8632-vinsn require-s8 (()
2339                                ((object :lisp))
2340                                ((tag :u32)))
2341  :again
2342  (movl (:%l object) (:%l tag))
2343  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l tag))
2344  (sarl (:$ub (- x8632::nbits-in-word 8)) (:%l tag))
2345  (shll (:$ub x8632::fixnumshift) (:%l tag))
2346  (cmpl (:%l object) (:%l tag))
2347  (je.pt :ok)
2348  :bad
2349  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-8))
2350  (jmp :again)
2351  :ok)
2352
2353(define-x8632-vinsn require-u8 (()
2354                                ((object :lisp))
2355                                ((tag :u32)))
2356  :again
2357  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l tag))
2358  (andl (:%l object) (:%l tag))
2359  (je.pt :ok)
2360  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-8))
2361  (jmp :again)
2362  :ok)
2363
2364(define-x8632-vinsn require-s16 (()
2365                                ((object :lisp))
2366                                ((tag :s32)))
2367  :again
2368  (movl (:%l object) (:%l tag))
2369  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l tag))
2370  (sarl (:$ub (- x8632::nbits-in-word 16)) (:%l tag))
2371  (shll (:$ub x8632::fixnumshift) (:%l tag))
2372  (cmpl (:%l object) (:%l tag))
2373  (je.pt :ok)
2374  :bad
2375  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-16))
2376  (jmp :again)
2377  :ok)
2378
2379(define-x8632-vinsn require-u16 (()
2380                                ((object :lisp))
2381                                ((tag :u32)))
2382  :again
2383  (movl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:%l tag))
2384  (andl (:%l object) (:%l tag))
2385  (je.pt :ok)
2386  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-16))
2387  (jmp :again)
2388  :ok)
2389
2390(define-x8632-vinsn require-s32 (()
2391                                 ((object :lisp))
2392                                 ((tag :s32)))
2393  :again
2394  (testl (:$l x8632::fixnummask) (:%l object))
2395  (movl (:%l object) (:%l tag))
2396  (je.pt :ok)
2397  (andl (:$l x8632::fulltagmask) (:%l tag))
2398  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2399  (jne.pn :bad)
2400  (cmpl (:$l x8632::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2401  (je.pt :ok)
2402  :bad
2403  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-32))
2404  (jmp :again)
2405  :ok)
2406
2407(define-x8632-vinsn require-u32 (()
2408                                 ((object :lisp))
2409                                 ((tag :s32)))
2410  :again
2411  (testl (:$l x8632::fixnummask) (:%l object))
2412  (movl (:%l object) (:%l tag))
2413  (je.pt :ok-if-non-negative)
2414  (andl (:$l x8632::fulltagmask) (:%l tag))
2415  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2416  (jne.pn :bad)
2417  (cmpl (:$l x8632::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2418  (je :one)
2419  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2420  (jne.pn :bad)
2421  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 4) (:%l object)))
2422  (je :ok)
2423  :bad
2424  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-32))
2425  (jmp :again)
2426  :one
2427  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
2428  :ok-if-non-negative
2429  (testl (:%l tag) (:%l tag))
2430  (js :bad)
2431  :ok)
2432
2433(define-x8632-vinsn require-s64 (()
2434                                 ((object :lisp))
2435                                 ((tag :s32)))
2436  :again
2437  (testl (:$l x8632::fixnummask) (:%l object))
2438  (movl (:%l object) (:%l tag))
2439  (je.pt :ok)
2440  (andl (:$l x8632::fulltagmask) (:%l tag))
2441  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2442  (jne.pn :bad)
2443  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2444  (jne.pt :ok)
2445  :bad
2446  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-64))
2447  (jmp :again)
2448  :ok)
2449
2450(define-x8632-vinsn require-u64 (()
2451                                 ((object :lisp))
2452                                 ((tag :s32)))
2453  :again
2454  (testl (:$l x8632::fixnummask) (:%l object))
2455  (movl (:%l object) (:%l tag))
2456  (je.pt :ok-if-non-negative)
2457  (andl (:$l x8632::fulltagmask) (:%l tag))
2458  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2459  (jne.pn :bad)
2460  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2461  (je :two)
2462  (cmpl (:$l x8632::three-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2463  (jne.pn :bad)
2464  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 8) (:%l object)))
2465  (je :ok)
2466  :bad
2467  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-64))
2468  (jmp :again)
2469  :two
2470  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
2471  :ok-if-non-negative
2472  (testl (:%l tag) (:%l tag))
2473  (js :bad)
2474  :ok)
2475
2476(define-x8632-vinsn require-char-code (()
2477                                       ((object :lisp))
2478                                       ((tag :u32)))
2479  :again
2480  (testb (:$b x8632::fixnummask) (:%b object))
2481  (jne.pn :bad)
2482  (cmpl (:$l (ash #x110000 x8632::fixnumshift)) (:%l object))
2483  (jb.pt :ok)
2484  :bad
2485  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-mod-char-code-limit))
2486  (jmp :again)
2487  :ok)
2488
2489(define-x8632-vinsn mask-base-char (((dest :u8))
2490                                    ((src :lisp)))
2491  (movzbl (:%b src) (:%l dest)))
2492
2493(define-x8632-vinsn event-poll (()
2494                                ())
2495  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
2496  (jae :no-interrupt)
2497  (ud2a)
2498  (:byte 2)
2499  :no-interrupt)
2500
2501;;; check-2d-bound
2502;;; check-3d-bound
2503
2504(define-x8632-vinsn 2d-dim1 (((dest :u32))
2505                             ((header :lisp)))
2506  (movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
2507            (:%l header)) (:%l dest))
2508  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
2509
2510;;; 3d-dims
2511
2512;;; xxx
2513(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
2514                                        (dim1 :u32))
2515                                       ((dim1 :u32)
2516                                        (i :imm)
2517                                        (j :imm)))
2518
2519  (imull (:%l i) (:%l dim1))
2520  (leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
2521
2522;;; 3d-unscaled-index
2523
2524(define-x8632-vinsn branch-unless-both-args-fixnums (()
2525                                                     ((a :lisp)
2526                                                      (b :lisp)
2527                                                      (dest :label))
2528                                                     ((tag :u8)))
2529  (movl (:%l a) (:%l tag))
2530  (orl (:%l b) (:%l tag))
2531  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2532   (testb (:$b x8632::fixnummask) (:%accb tag)))
2533  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2534         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2535   (testb (:$b x8632::fixnummask) (:%b tag)))
2536  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2537   (testl (:$l x8632::fixnummask) (:%l tag)))
2538  (jne dest))
2539
2540(define-x8632-vinsn branch-unless-arg-fixnum (()
2541                                              ((a :lisp)
2542                                               (dest :label)))
2543  ((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
2544   (testb (:$b x8632::fixnummask) (:%b a)))
2545  ((:pred > (:apply %hard-regspec-value a) x8632::ebx)
2546   (testl (:$l x8632::fixnummask) (:%l a)))
2547  (jne dest))
2548
2549(define-x8632-vinsn fixnum->single-float (((f :single-float))
2550                                          ((arg :lisp))
2551                                          ((unboxed :s32)))
2552  (movl (:%l arg) (:%l unboxed))
2553  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
2554  (cvtsi2ssl (:%l unboxed) (:%xmm f)))
2555
2556(define-x8632-vinsn fixnum->double-float (((f :double-float))
2557                                          ((arg :lisp))
2558                                          ((unboxed :s32)))
2559  (movl (:%l arg) (:%l unboxed))
2560  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
2561  (cvtsi2sdl (:%l unboxed) (:%xmm f)))
2562
2563(define-x8632-vinsn xchg-registers (()
2564                                    ((a t)
2565                                     (b t)))
2566  (xchgl (:%l a) (:%l b)))
2567
2568(define-x8632-vinsn establish-fn (()
2569                                  ())
2570  (movl (:$self 0) (:%l x8632::fn)))
2571
2572(define-x8632-vinsn %scharcode32 (((code :imm))
2573                                  ((str :lisp)
2574                                   (idx :imm))
2575                                  ((imm :u32)))
2576  (movl (:@ x8632::misc-data-offset (:%l str) (:%l idx)) (:%l imm))
2577  (imull (:$b x8632::fixnumone) (:%l imm) (:%l code)))
2578
2579(define-x8632-vinsn %set-scharcode32 (()
2580                                      ((str :lisp)
2581                                       (idx :imm)
2582                                       (code :imm))
2583                                      ((imm :u32)))
2584  (movl (:%l code) (:%l imm))
2585  (shrl (:$ub x8632::fixnumshift) (:%l imm))
2586  (movl (:%l imm) (:@ x8632::misc-data-offset (:%l str) (:%l idx))))
2587
2588
2589(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
2590
2591(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
2592
2593
2594(define-x8632-vinsn character->code (((dest :u32))
2595                                     ((src :lisp)))
2596  (movl (:%l src) (:%l dest))
2597  (sarl (:$ub x8632::charcode-shift) (:%l dest)))
2598
2599(define-x8632-vinsn adjust-vsp (()
2600                                ((amount :s32const)))
2601  ((:and (:pred >= amount -128) (:pred <= amount 127))
2602   (addl (:$b amount) (:%l x8632::esp)))
2603  ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
2604   (addl (:$l amount) (:%l x8632::esp))))
2605
2606
2607(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
2608                                                          ((spno :s32const)
2609                                                           (y t)
2610                                                           (z t))
2611                                                          ((entry (:label 1))))
2612  (:talign 5)
2613  (call (:@ spno))
2614  (movl (:$self 0) (:%l x8632::fn)))
2615
2616(define-x8632-vinsn %symbol->symptr (((dest :lisp))
2617                                     ((src :lisp))
2618                                     ((tag :u8)))
2619  (cmpl (:$l x8632::nil-value) (:%l src))
2620  (je :nilsym)
2621  (movl (:%l src) (:%l tag))
2622  (andb (:$b x8632::tagmask) (:%b tag))
2623  (cmpb (:$b x8632::tag-misc) (:%b tag))
2624  (jne :bad)
2625  (movb (:@ x8632::misc-subtag-offset (:%l src)) (:%b tag))
2626  (cmpb (:$b x8632::subtag-symbol) (:%b tag))
2627  (jne :bad)
2628  ((:not (:pred =
2629                (:apply %hard-regspec-value dest)
2630                (:apply %hard-regspec-value src)))
2631   (movl (:% src) (:% dest)))
2632  (jmp :ok)
2633  :bad
2634  (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-symbol))
2635  :nilsym
2636  (movl (:$l (+ x8632::nil-value x8632::nilsym-offset)) (:%l dest))
2637  :ok)
2638
2639(define-x8632-vinsn zero-double-float-register (((dest :double-float))
2640                                                ())
2641  (movsd (:%xmm x8632::fpzero) (:%xmm dest)))
2642
2643(define-x8632-vinsn zero-single-float-register (((dest :single-float))
2644                                                ())
2645  (movss (:%xmm x8632::fpzero) (:%xmm dest)))
2646
2647(define-x8632-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
2648(define-x8632-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
2649(define-x8632-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
2650
2651
2652(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
2653
2654(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
2655                                               ((src :lisp))
2656                                               ((temp :u32)))
2657  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
2658  ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
2659         (:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
2660   (movb (:$b 0) (:%b temp)))
2661  ((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
2662   (andl (:$l #xffffff00) (:%l temp)))
2663  (movl (:%l temp) (:%l dest))
2664  (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l dest)))
2665
2666
2667
2668(define-x8632-vinsn %logior2 (((dest :imm))
2669                              ((x :imm)
2670                               (y :imm)))
2671  ((:pred =
2672          (:apply %hard-regspec-value x)
2673          (:apply %hard-regspec-value dest))
2674   (orl (:%l y) (:%l dest)))
2675  ((:not (:pred =
2676                (:apply %hard-regspec-value x)
2677                (:apply %hard-regspec-value dest)))
2678   ((:pred =
2679           (:apply %hard-regspec-value y)
2680           (:apply %hard-regspec-value dest))
2681    (orl (:%l x) (:%l dest)))
2682   ((:not (:pred =
2683                 (:apply %hard-regspec-value y)
2684                 (:apply %hard-regspec-value dest)))
2685    (movl (:%l x) (:%l dest))
2686    (orl (:%l y) (:%l dest)))))
2687
2688(define-x8632-vinsn %logand2 (((dest :imm))
2689                              ((x :imm)
2690                               (y :imm)))
2691  ((:pred =
2692          (:apply %hard-regspec-value x)
2693          (:apply %hard-regspec-value dest))
2694   (andl (:%l y) (:%l dest)))
2695  ((:not (:pred =
2696                (:apply %hard-regspec-value x)
2697                (:apply %hard-regspec-value dest)))
2698   ((:pred =
2699           (:apply %hard-regspec-value y)
2700           (:apply %hard-regspec-value dest))
2701    (andl (:%l x) (:%l dest)))
2702   ((:not (:pred =
2703                 (:apply %hard-regspec-value y)
2704                 (:apply %hard-regspec-value dest)))
2705    (movl (:%l x) (:%l dest))
2706    (andl (:%l y) (:%l dest)))))
2707
2708(define-x8632-vinsn %logxor2 (((dest :imm))
2709                              ((x :imm)
2710                               (y :imm)))
2711  ((:pred =
2712          (:apply %hard-regspec-value x)
2713          (:apply %hard-regspec-value dest))
2714   (xorl (:%l y) (:%l dest)))
2715  ((:not (:pred =
2716                (:apply %hard-regspec-value x)
2717                (:apply %hard-regspec-value dest)))
2718   ((:pred =
2719           (:apply %hard-regspec-value y)
2720           (:apply %hard-regspec-value dest))
2721    (xorl (:%l x) (:%l dest)))
2722   ((:not (:pred =
2723                 (:apply %hard-regspec-value y)
2724                 (:apply %hard-regspec-value dest)))
2725    (movl (:%l x) (:%l dest))
2726    (xorl (:%l y) (:%l dest)))))
2727
2728
2729(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
2730
2731(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
2732
2733(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
2734
2735(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
2736
2737(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
2738
2739(define-x8632-subprim-lea-jmp-vinsn (make-stack-gvector)  .SPstkgvector)
2740
2741(define-x8632-vinsn load-character-constant (((dest :lisp))
2742                                             ((code :u32const))
2743                                             ())
2744  (movl (:$l (:apply logior (:apply ash code 8) x8632::subtag-character))
2745        (:%l dest)))
2746
2747
2748(define-x8632-vinsn setup-single-float-allocation (()
2749                                                   ())
2750  (movl (:$l (arch::make-vheader x8632::single-float.element-count x8632::subtag-single-float)) (:%l x8632::imm0))
2751  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2752  (movl (:$l (- x8632::single-float.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2753 
2754(define-x8632-vinsn setup-double-float-allocation (()
2755                                                   ())
2756  (movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
2757  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2758  (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2759
2760(define-x8632-vinsn set-single-float-value (()
2761                                            ((node :lisp)
2762                                             (val :single-float)))
2763  (movss (:%xmm val) (:@ x8632::single-float.value (:%l node))))
2764
2765(define-x8632-vinsn set-double-float-value (()
2766                                            ((node :lisp)
2767                                             (val :double-float)))
2768  (movsd (:%xmm val) (:@ x8632::double-float.value (:%l node))))
2769
2770(define-x8632-vinsn word-index-and-bitnum-from-index (((word-index :u32)
2771                                                       (bitnum :u8))
2772                                                      ((index :imm)))
2773  (movl (:%l index) (:%l word-index))
2774  (shrl (:$ub x8632::fixnumshift) (:%l word-index))
2775  (movl (:$l 31) (:%l bitnum))
2776  (andl (:%l word-index) (:%l bitnum))
2777  (shrl (:$ub 5) (:%l word-index)))
2778
2779(define-x8632-vinsn ref-bit-vector-fixnum (((dest :imm)
2780                                            (bitnum :u8))
2781                                           ((bitnum :u8)
2782                                            (bitvector :lisp)
2783                                            (word-index :u32)))
2784  (btl (:%l bitnum) (:@ x8632::misc-data-offset (:%l bitvector) (:%l word-index) 4))
2785  (setb (:%b bitnum))
2786  (negb (:%b bitnum))
2787  (andl (:$l x8632::fixnumone) (:%l bitnum))
2788  (movl (:%l bitnum) (:%l dest)))
2789
2790(define-x8632-vinsn nref-bit-vector-fixnum (((dest :imm)
2791                                             (bitnum :s32))
2792                                            ((bitnum :s32)
2793                                             (bitvector :lisp))
2794                                            ())
2795  (btl (:%l bitnum) (:@ x8632::misc-data-offset (:%l bitvector)))
2796  (setc (:%b bitnum))
2797  (movzbl (:%b bitnum) (:%l bitnum))
2798  (imull (:$b x8632::fixnumone) (:%l bitnum) (:%l dest)))
2799
2800(define-x8632-vinsn set-macptr-address (()
2801                                        ((addr :address)
2802                                         (src :lisp))
2803                                        ())
2804  (movl (:%l addr) (:@ x8632::macptr.address (:%l src))))
2805
2806(define-x8632-vinsn deref-macptr (((addr :address))
2807                                  ((src :lisp))
2808                                  ())
2809  (movl (:@ x8632::macptr.address (:%l src)) (:%l addr)))
2810
2811(define-x8632-vinsn setup-macptr-allocation (()
2812                                             ((src :address)))
2813  (movd (:%l src) (:%mmx x8632::mm1))   ;see %set-new-macptr-value, below
2814  (movl (:$l x8632::macptr-header) (:%l x8632::imm0))
2815  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2816  (movl (:$l (- x8632::macptr.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2817
2818(define-x8632-vinsn %set-new-macptr-value (()
2819                                           ((ptr :lisp)))
2820  (movd (:%mmx x8632::mm1) (:@ x8632::macptr.address (:%l ptr))))
2821
2822(define-x8632-vinsn mem-ref-natural (((dest :u32))
2823                                     ((src :address)
2824                                      (index :s32)))
2825  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
2826
2827(define-x8632-vinsn mem-ref-c-fullword (((dest :u32))
2828                                        ((src :address)
2829                                         (index :s32const)))
2830  ((:pred = index 0)
2831   (movl (:@ (:%l src)) (:%l dest)))
2832  ((:not (:pred = index 0))
2833   (movl (:@ index (:%l src)) (:%l dest))))
2834
2835(define-x8632-vinsn mem-ref-c-signed-fullword (((dest :s32))
2836                                               ((src :address)
2837                                                (index :s32const)))
2838  ((:pred = index 0)
2839   (movl (:@ (:%l src)) (:%l dest)))
2840  ((:not (:pred = index 0))
2841   (movl (:@ index (:%l src)) (:%l dest))))
2842
2843(define-x8632-vinsn mem-ref-c-single-float (((dest :single-float))
2844                                            ((src :address)
2845                                             (index :s32const)))
2846  ((:pred = index 0)
2847   (movss (:@ (:%l src)) (:%xmm dest)))
2848  ((:not (:pred = index 0))
2849   (movss (:@ index (:%l src)) (:%xmm dest))))
2850
2851(define-x8632-vinsn mem-set-c-single-float (()
2852                                            ((val :single-float)
2853                                             (src :address)
2854                                             (index :s16const)))
2855  ((:pred = index 0)
2856   (movss (:%xmm val) (:@ (:%l src))))
2857  ((:not (:pred = index 0))
2858   (movss (:%xmm val) (:@ index (:%l src)))))
2859
2860(define-x8632-vinsn mem-ref-c-natural (((dest :u32))
2861                                       ((src :address)
2862                                        (index :s32const)))
2863  ((:pred = index 0)
2864   (movl (:@ (:%l src)) (:%l dest)))
2865  ((:not (:pred = index 0))
2866   (movl (:@ index (:%l src)) (:%l dest))))
2867
2868(define-x8632-vinsn mem-ref-c-double-float (((dest :double-float))
2869                                            ((src :address)
2870                                             (index :s32const)))
2871  ((:pred = index 0)
2872   (movsd (:@ (:%l src)) (:%xmm dest)))
2873  ((:not (:pred = index 0))
2874   (movsd (:@ index (:%l src)) (:%xmm dest))))
2875
2876(define-x8632-vinsn mem-set-c-double-float (()
2877                                            ((val :double-float)
2878                                             (src :address)
2879                                             (index :s32const)))
2880  ((:pred = index 0)
2881   (movsd (:%xmm val) (:@ (:%l src))))
2882  ((:not (:pred = index 0))
2883   (movsd (:%xmm val) (:@ index (:%l src)))))
2884
2885(define-x8632-vinsn mem-ref-fullword (((dest :u32))
2886                                      ((src :address)
2887                                       (index :s32)))
2888  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
2889
2890(define-x8632-vinsn mem-ref-signed-fullword (((dest :s32))
2891                                             ((src :address)
2892                                              (index :s32)))
2893  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
2894
2895(define-x8632-vinsn macptr->stack (((dest :lisp))
2896                                   ((ptr :address))
2897                                   ((temp :imm)))
2898  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
2899  (subl (:$b (+ 8 x8632::macptr.size)) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
2900  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
2901  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
2902  (leal (:@ (+ 8 x8632::fulltag-misc) (:%l  temp)) (:%l dest))
2903  (movl (:$l x8632::macptr-header) (:@ x8632::macptr.header (:%l dest)))
2904  (movl (:%l ptr) (:@ x8632::macptr.address (:%l dest)))
2905  (movsd (:%xmm x8632::fpzero)  (:@ x8632::macptr.domain (:%l dest))))
2906
2907(define-x8632-vinsn fixnum->signed-natural (((dest :s32))
2908                                            ((src :imm)))
2909  (movl (:%l src) (:%l dest))
2910  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
2911
2912(define-x8632-vinsn fixnum->unsigned-natural (((dest :u32))
2913                                              ((src :imm)))
2914  (movl (:%l src) (:%l dest))
2915  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
2916
2917(define-x8632-vinsn mem-set-double-float (()
2918                                          ((val :double-float)
2919                                           (src :address)
2920                                           (index :s32)))
2921  (movsd (:%xmm val) (:@ (:%l src) (:%l index))))
2922
2923(define-x8632-vinsn mem-set-single-float (()
2924                                          ((val :single-float)
2925                                           (src :address)
2926                                           (index :s32)))
2927  (movss (:%xmm val) (:@ (:%l src) (:%l index))))
2928
2929(define-x8632-vinsn mem-set-c-fullword (()
2930                                          ((val :u32)
2931                                           (dest :address)
2932                                           (offset :s32const)))
2933  ((:pred = offset 0)
2934   (movl (:%l val) (:@ (:%l dest))))
2935  ((:not (:pred = offset 0))
2936   (movl (:%l val) (:@ offset (:%l dest)))))
2937
2938(define-x8632-vinsn mem-set-bit-variable-value (((src :address))
2939                                                ((src :address)
2940                                                 (offset :lisp)
2941                                                 (value :lisp))
2942                                                ((temp :u32)))
2943  (movl (:%l offset) (:%l temp))
2944  (shrl (:$ub (+ 5 x8632::fixnumshift)) (:%l temp))
2945  (leal (:@ (:%l src) (:%l temp) 4) (:%l src))
2946  (movl (:%l offset) (:%l temp))
2947  (shrl (:$ub x8632::fixnumshift) (:%l temp))
2948  (andl (:$l 31) (:%l temp))
2949  (testl (:%l value) (:%l value))
2950  (jne :set)
2951  (btrl (:%l temp) (:@ (:%l src)))
2952  (jmp :done)
2953  :set
2954  (btsl (:%l temp) (:@ (:%l src)))
2955  :done)
2956
2957(define-x8632-vinsn %natural+  (((result :u32))
2958                               ((result :u32)
2959                                (other :u32)))
2960  (addl (:%l other) (:%l result)))
2961
2962(define-x8632-vinsn %natural+-c (((result :u32))
2963                                ((result :u32)
2964                                 (constant :s32const)))
2965  (addl (:$l constant) (:%l result)))
2966
2967(define-x8632-vinsn %natural-  (((result :u32))
2968                                ((result :u32)
2969                                 (other :u32)))
2970  (subl (:%l other) (:%l result)))
2971
2972(define-x8632-vinsn %natural--c (((result :u32))
2973                                ((result :u32)
2974                                 (constant :s32const)))
2975  (subl (:$l constant) (:%l result)))
2976
2977(define-x8632-vinsn %natural-logior (((result :u32))
2978                                    ((result :u32)
2979                                     (other :u32)))
2980  (orl (:%l other) (:%l result)))
2981
2982(define-x8632-vinsn %natural-logior-c (((result :u32))
2983                                      ((result :u32)
2984                                       (constant :s32const)))
2985  (orl (:$l constant) (:%l result)))
2986
2987(define-x8632-vinsn %natural-logand (((result :u32))
2988                                    ((result :u32)
2989                                     (other :u32)))
2990  (andl (:%l other) (:%l result)))
2991
2992(define-x8632-vinsn %natural-logand-c (((result :u32))
2993                                      ((result :u32)
2994                                       (constant :s32const)))
2995  (andl (:$l constant) (:%l result)))
2996
2997(define-x8632-vinsn %natural-logxor (((result :u32))
2998                                    ((result :u32)
2999                                     (other :u32)))
3000  (xorl (:%l other) (:%l result)))
3001
3002(define-x8632-vinsn %natural-logxor-c (((result :u32))
3003                                       ((result :u32)
3004                                        (constant :s32const)))
3005  (xorl (:$l constant) (:%l result)))
3006
3007(define-x8632-vinsn natural-shift-left (((dest :u32))
3008                                        ((dest :u32)
3009                                         (amt :u8const)))
3010  (shll (:$ub amt) (:%l dest)))
3011
3012(define-x8632-vinsn natural-shift-right (((dest :u32))
3013                                         ((dest :u32)
3014                                          (amt :u8const)))
3015  (shrl (:$ub amt) (:%l dest)))
3016
3017(define-x8632-vinsn recover-fn (()
3018                                ())
3019  (movl (:$self 0) (:%l x8632::fn)))
3020
3021;;; xxx probably wrong
3022(define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
3023                                                          ((spno :s32const)
3024                                                           (x t)
3025                                                           (y t)
3026                                                           (z t))
3027                                                          ((entry (:label 1))))
3028  (:talign 5)
3029  (call (:@ spno))
3030  (movl (:$self 0) (:%l x8632::fn)))
3031
3032(define-x8632-vinsn vcell-ref (((dest :lisp))
3033                               ((vcell :lisp)))
3034  (movl (:@ x8632::misc-data-offset (:%l vcell)) (:%l dest)))
3035
3036(define-x8632-vinsn setup-vcell-allocation (()
3037                                            ())
3038  (movl (:$l x8632::value-cell-header) (:%l x8632::imm0))
3039  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
3040  (movl (:$l (- x8632::value-cell.size x8632::fulltag-misc)) (:%l x8632::imm0)))
3041
3042(define-x8632-vinsn %init-vcell (()
3043                                 ((vcell :lisp)
3044                                  (closed :lisp)))
3045  (movl (:%l closed) (:@ x8632::value-cell.value (:%l vcell))))
3046
3047;;; "old" mkunwind.  Used by PROGV, since the binding of *interrupt-level*
3048;;; on entry to the new mkunwind confuses the issue.
3049
3050(define-x8632-vinsn (mkunwind :call :subprim-call) (()
3051                                                     ((protform-lab :label)
3052                                                      (cleanup-lab :label)))
3053  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
3054  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
3055  (jmp (:@ .SPmkunwind)))
3056
3057;;; Funcall the function or symbol in temp0 and obtain the single
3058;;; value that it returns.
3059(define-x8632-subprim-call-vinsn (funcall) .SPfuncall)
3060
3061(define-x8632-vinsn tail-funcall (()
3062                                  ()
3063                                  ((tag :u8)))
3064  (movl (:%l x8632::temp0) (:%l tag))
3065  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
3066   (andl (:$b x8632::tagmask) (:%accl tag))
3067   (cmpl (:$b x8632::tag-misc) (:%accl tag)))
3068  ((:pred > (:apply %hard-regspec-value tag) x8632::eax)
3069   (andl (:$b x8632::tagmask) (:%l tag))
3070   (cmpl (:$b x8632::tag-misc) (:%l tag)))
3071  (jne :bad)
3072  (movb (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%b tag))
3073  (cmpb (:$b x8632::subtag-function) (:%b tag))
3074  (je :go)
3075  (cmpb (:$b x8632::subtag-symbol) (:%b tag))
3076  (cmovel (:@ x8632::symbol.fcell (:%l x8632::temp0)) (:%l x8632::temp0))
3077  (jne :bad)
3078  :go
3079  (jmp (:%l x8632::temp0))
3080  :bad
3081  (uuo-error-not-callable))
3082
3083;;; Magic numbers in here include the address of .SPcall-closure.
3084
3085;;; movl $self, %fn
3086;;; jmp *20660 (.SPcall-closure)
3087(define-x8632-vinsn init-nclosure (()
3088                                   ((closure :lisp)))
3089  (movb (:$b 6) (:@ x8632::misc-data-offset (:%l closure))) ;imm word count
3090  (movb (:$b #xbf) (:@ (+ x8632::misc-data-offset 2) (:%l closure))) ;movl $self, %fn
3091  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 3) (:%l closure)))
3092  (movb (:$b #xff) (:@ (+ x8632::misc-data-offset 7) (:%l closure))) ;jmp
3093  (movl (:$l #x0050b425) (:@ (+ x8632::misc-data-offset 8) (:%l closure))) ;.SPcall-closure
3094  ;; already aligned
3095  ;; (movl ($ 0) (:@ (+ x8632::misc-data-offset 12))) ;"end" of self-references
3096  (movb (:$b 7) (:@ (+ x8632::misc-data-offset 16) (:%l closure))) ;self-reference offset
3097  (movb (:$b x8632::function-boundary-marker) (:@ (+ x8632::misc-data-offset 20) (:%l closure))))
3098
3099(define-x8632-vinsn finalize-closure (((closure :lisp))
3100                                      ((closure :lisp)))
3101  (nop))
3102
3103
3104(define-x8632-vinsn (ref-symbol-value :call :subprim-call)
3105    (((val :lisp))
3106     ((sym (:lisp (:ne val)))))
3107  (:talign 5)
3108  (call (:@ .SPspecrefcheck))
3109  (movl (:$self 0) (:%l x8632::fn)))
3110
3111(define-x8632-vinsn ref-symbol-value-inline (((dest :lisp))
3112                                             ((src (:lisp (:ne dest))))
3113                                             ((table :imm)
3114                                              (idx :imm)))
3115  (movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
3116  (rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
3117  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l table))
3118  (jae :symbol)
3119  (movl (:@ (:%l table) (:%l idx)) (:%l dest))
3120  (cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
3121  (jne :test)
3122  :symbol
3123  (movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
3124  :test
3125  (cmpl (:$l x8632::unbound-marker) (:%l dest))
3126  (jne.pt :done)
3127  (uuo-error-unbound (:%l src))
3128  :done)
3129
3130(define-x8632-vinsn %ref-symbol-value-inline (((dest :lisp))
3131                                              ((src (:lisp (:ne dest))))
3132                                              ((table :imm)
3133                                               (idx :imm)))
3134  (movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
3135  (rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
3136  (jae :symbol)
3137  (addl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l idx))
3138  (movl (:@ (:%l idx)) (:%l dest))
3139  (cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
3140  (jne :done)
3141  :symbol
3142  (movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
3143  :done)
3144
3145(define-x8632-vinsn ref-interrupt-level (((dest :imm))
3146                                         ()
3147                                         ((temp :u32)))
3148  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
3149  (movl (:@ x8632::interrupt-level-binding-index (:%l temp)) (:%l dest)))
3150
3151(define-x8632-subprim-lea-jmp-vinsn (bind-nil)  .SPbind-nil)
3152
3153(define-x8632-subprim-lea-jmp-vinsn (bind-self)  .SPbind-self)
3154
3155(define-x8632-subprim-lea-jmp-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
3156
3157(define-x8632-subprim-lea-jmp-vinsn (bind)  .SPbind)
3158
3159(define-x8632-vinsn (dpayback :call :subprim-call) (()
3160                                                    ((n :s16const))
3161                                                    ((temp (:u32 #.x8632::imm0))
3162                                                     (entry (:label 1))))
3163  ((:pred > n 0)
3164   ((:pred > n 1)
3165    (movl (:$l n) (:%l temp))
3166    (:talign 5)
3167    (call (:@ .SPunbind-n)))
3168   ((:pred = n 1)
3169    (:talign 5)
3170    (call (:@ .SPunbind)))
3171   (movl (:$self 0) (:%l x8632::fn))))
3172
3173(define-x8632-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
3174
3175(define-x8632-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
3176
3177(define-x8632-vinsn node-slot-ref  (((dest :lisp))
3178                                    ((node :lisp)
3179                                     (cellno :u32const)))
3180  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash cellno 2))
3181            (:%l node)) (:%l dest)))
3182
3183(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list)  .SPstkconslist)
3184
3185(define-x8632-vinsn save-lexpr-argregs (()
3186                                        ((min-fixed :u16const)))
3187  ((:pred >= min-fixed $numx8632argregs)
3188   (pushl (:%l x8632::arg_y))
3189   (pushl (:%l x8632::arg_z)))
3190  ((:pred = min-fixed 1)                ; at least one arg
3191   (rcmpl (:%l x8632::nargs) (:$b (ash 1 x8632::word-shift)))
3192   (je :z1)                             ;skip arg_y if exactly 1
3193   (pushl (:%l x8632::arg_y))
3194   :z1
3195   (pushl (:%l x8632::arg_z)))
3196  ((:pred = min-fixed 0)
3197   (rcmpl (:%l x8632::nargs) (:$b (ash 1 x8632::word-shift)))
3198   (je :z0)                             ;exactly one
3199   (jl :none)                           ;none
3200                                        ;two or more...
3201   (pushl (:%l x8632::arg_y))
3202   :z0
3203   (pushl (:%l x8632::arg_z))
3204   :none
3205   )
3206  ((:not (:pred = min-fixed 0))
3207   (leal (:@ (:apply - (:apply ash min-fixed x8632::word-shift)) (:%l x8632::nargs))
3208         (:%l x8632::nargs)))
3209  (pushl (:%l x8632::nargs))
3210  (movl (:%l x8632::esp) (:%l x8632::arg_z)))
3211
3212;;; The frame that was built (by SAVE-LISP-CONTEXT-VARIABLE-ARG-COUNT
3213;;; and SAVE-LEXPR-ARGREGS) contains an unknown number of arguments
3214;;; followed by the count of non-required arguments; the count is on
3215;;; top of the stack and its address is in %arg_z.  We need to build a
3216;;; frame so that the function can address its arguments (copies of
3217;;; the required arguments and the lexpr) and locals; when the
3218;;; function returns, it should one or more values (depending on how
3219;;; it was called) and discard the hidden lexpr frame.  At this point,
3220;;; %ra0 still contains the "real" return address. If it's not the
3221;;; magic multiple-value address, we can make the function return to
3222;;; something that does a single-value return (.SPpopj); otherwise, we
3223;;; need to make it return multiple values to the real caller. (Unlike
3224;;; the PPC, this case only involves creating one frame here, but that
3225;;; frame has two return addresses.)
3226(define-x8632-vinsn build-lexpr-frame (()
3227                                       ()
3228                                       ((temp :imm)
3229                                        (ra0 (:lisp #.x8632::ra0))))
3230  (movl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr)))
3231        (:%l temp))
3232  (cmpl (:%l temp) (:%l ra0))
3233  (je :multiple)
3234  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::lexpr-return1v))))
3235  (jmp :finish)
3236  :multiple
3237  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::lexpr-return))))
3238  (pushl (:%l temp))
3239  :finish
3240  (pushl (:%l x8632::ebp))
3241  (movl (:%l x8632::esp) (:%l x8632::ebp)))
3242
3243(define-x8632-vinsn copy-lexpr-argument (()
3244                                         ((n :u16const))
3245                                         ((temp :imm)))
3246  (movl (:@ (:%l x8632::arg_z)) (:%l temp))
3247  (pushl (:@ (:apply ash n x8632::word-shift) (:%l x8632::arg_z) (:%l temp))))
3248
3249(define-x8632-vinsn %current-tcr (((dest :lisp))
3250                                 ())
3251  (movl (:@ (:%seg :rcontext) x8632::tcr.linear) (:%l dest)))
3252
3253(define-x8632-vinsn (setq-special :call :subprim-call)
3254    (()
3255     ((sym :lisp)
3256      (val :lisp))
3257     ((entry (:label 1))))
3258  (:talign 5)
3259  (call (:@ .SPspecset))
3260  (movl (:$self 0) (:%l x8632::fn)))
3261
3262(define-x8632-vinsn pop-argument-registers (()
3263                                            ())
3264  (testl (:%l x8632::nargs) (:%l x8632::nargs))
3265  (je :done)
3266  (rcmpl (:%l x8632::nargs) (:$l (ash 1 x8632::word-shift)))
3267  (popl (:%l x8632::arg_z))
3268  (je :done)
3269  (popl (:%l x8632::arg_y))
3270  :done)
3271
3272(define-x8632-vinsn %symptr->symvector (((target :lisp))
3273                                        ((target :lisp)))
3274  (nop))
3275
3276(define-x8632-vinsn %symvector->symptr (((target :lisp))
3277                                        ((target :lisp)))
3278  (nop))
3279
3280(define-x8632-subprim-lea-jmp-vinsn (spread-lexpr)  .SPspread-lexpr-z)
3281
3282(define-x8632-vinsn mem-ref-double-float (((dest :double-float))
3283                                          ((src :address)
3284                                           (index :s32)))
3285  (movsd (:@ (:%l src) (:%l index)) (:%xmm dest)))
3286
3287(define-x8632-vinsn mem-ref-single-float (((dest :single-float))
3288                                          ((src :address)
3289                                           (index :s32)))
3290  (movss (:@ (:%l src) (:%l index)) (:%xmm dest)))
3291
3292(define-x8632-vinsn load-adl (()
3293                              ((n :u32const)))
3294  (movl (:$l n) (:%l x8632::nargs)))
3295
3296(define-x8632-subprim-lea-jmp-vinsn (macro-bind) .SPmacro-bind)
3297
3298(define-x8632-subprim-lea-jmp-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
3299
3300(define-x8632-subprim-lea-jmp-vinsn  (destructuring-bind) .SPdestructuring-bind)
3301
3302
3303(define-x8632-vinsn symbol-function (((val :lisp))
3304                                     ((sym (:lisp (:ne val))))
3305                                     ((tag :u8)))
3306  (movl (:@ x8632::symbol.fcell (:%l sym)) (:%l val))
3307  (movl (:%l val) (:%l tag))
3308  (andb (:$b x8632::tagmask) (:%b tag))
3309  (cmpb (:$b x8632::tag-misc) (:%b tag))
3310  (jne.pn :bad)
3311  (movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
3312  (cmpb (:$b x8632::subtag-function) (:%b tag))
3313  (je.pt :ok)
3314  :bad
3315  (uuo-error-udf (:%l sym))
3316  :ok)
3317
3318(define-x8632-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
3319
3320(define-x8632-vinsn load-double-float-constant (((dest :double-float))
3321                                                ((lab :label)))
3322  (movsd (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
3323
3324(define-x8632-vinsn load-single-float-constant (((dest :single-float))
3325                                                ((lab :label)))
3326  (movss (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
3327
3328(define-x8632-subprim-call-vinsn (misc-set) .SPmisc-set)
3329
3330(define-x8632-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
3331
3332(define-x8632-subprim-lea-jmp-vinsn (spread-list)  .SPspreadargz)
3333
3334;;; Even though it's implemented by calling a subprim, THROW is really
3335;;; a JUMP (to a possibly unknown destination).  If the destination's
3336;;; really known, it should probably be inlined (stack-cleanup, value
3337;;; transfer & jump ...)
3338(define-x8632-vinsn (throw :jump :jump-unknown) (()
3339                                                 ()
3340                                                 ((entry (:label 1))))
3341  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
3342  (:talign 5)
3343  (jmp (:@ .SPthrow))
3344  :back
3345  (movl (:$self 0) (:%l x8632::fn)))
3346
3347(define-x8632-vinsn unbox-base-char (((dest :u32))
3348                                     ((src :lisp)))
3349  (movl (:%l src) (:%l dest))
3350  ((:pred = (:apply %hard-regspec-value dest) x8632::eax)
3351   (cmpb (:$b x8632::subtag-character) (:%accb dest)))
3352  ((:and (:pred > (:apply %hard-regspec-value dest) x8632::eax)
3353         (:pred <= (:apply %hard-regspec-value dest) x8632::ebx))
3354   (cmpb (:$b x8632::subtag-character) (:%b dest)))
3355  ((:pred > (:apply %hard-regspec-value dest) x8632::ebx)
3356   ;; very rare case, if even possible...
3357   (andl (:$l #xff) (:%l dest))
3358   (cmpl (:$b x8632::subtag-character) (:%l dest))
3359   (cmovel (:%l src) (:%l dest)))
3360  (je.pt ::got-it)
3361  (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-character))
3362  :got-it
3363  (shrl (:$ub x8632::charcode-shift) (:%l dest)))
3364
3365(define-x8632-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
3366
3367(define-x8632-subprim-lea-jmp-vinsn (recover-values)  .SPrecover-values)
3368
3369(define-x8632-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
3370
3371(define-x8632-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
3372
3373(define-x8632-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
3374
3375(define-x8632-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
3376
3377;;; "dest" is preallocated, presumably on a stack somewhere.
3378(define-x8632-vinsn store-single (()
3379                                  ((dest :lisp)
3380                                   (source :single-float))
3381                                  ())
3382  (movss (:%xmm source) (:@  x8632::single-float.value (:%l dest))))
3383
3384;;; "dest" is preallocated, presumably on a stack somewhere.
3385(define-x8632-vinsn store-double (()
3386                                  ((dest :lisp)
3387                                   (source :double-float))
3388                                  ())
3389  (movsd (:%xmm source) (:@  x8632::double-float.value (:%l dest))))
3390
3391(define-x8632-vinsn fixnum->char (((dest :lisp))
3392                                  ((src :imm))
3393                                  ((temp :u32)))
3394  (movl (:%l src) (:%l temp))
3395  (sarl (:$ub (+ x8632::fixnumshift 11)) (:%l temp))
3396  (cmpl (:$b (ash #xd800 -11))(:%l temp))
3397  (movl (:$l x8632::nil-value) (:%l temp))
3398  (cmovel (:%l temp) (:%l dest))
3399  (je :done)
3400  ((:not (:pred =
3401                (:apply %hard-regspec-value dest)
3402                (:apply %hard-regspec-value src)))
3403   (movl (:%l src) (:%l dest)))
3404  (shll (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest))
3405  (addb (:$b x8632::subtag-character) (:%b dest))
3406  :done)
3407
3408(define-x8632-vinsn sign-extend-halfword (((dest :imm))
3409                                          ((src :imm)))
3410  (movl (:%l src ) (:%l dest))
3411  (shll (:$ub (- 48 x8632::fixnumshift)) (:%l dest))
3412  (sarl (:$ub (- 48 x8632::fixnumshift)) (:%l dest)))
3413
3414(define-x8632-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
3415
3416(define-x8632-vinsn %init-gvector (()
3417                                   ((v :lisp)
3418                                    (nbytes :u32const))
3419                                   ((count :imm)))
3420  (movl (:$l nbytes) (:%l count))
3421  (jmp :test)
3422  :loop
3423  (popl (:@ x8632::misc-data-offset (:%l v) (:%l count)))
3424  :test
3425  (subl (:$b x8632::node-size) (:%l count))
3426  (jge :loop))
3427
3428(define-x8632-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
3429
3430(define-x8632-vinsn nth-value (((result :lisp))
3431                               ()
3432                               ((temp :u32)
3433                                (nargs (:lisp #.x8632::nargs))))
3434  (leal (:@ (:%l x8632::esp) (:%l x8632::nargs)) (:%l temp))
3435  (subl (:@ (:%l temp)) (:%l x8632::nargs))
3436  (movl (:$l x8632::nil-value) (:%l result))
3437  (jle :done)
3438  ;; I -think- that a CMOV would be safe here, assuming that N wasn't
3439  ;; extremely large.  Don't know if we can assume that.
3440  (movl (:@ (- x8632::node-size) (:%l x8632::esp) (:%l x8632::nargs)) (:%l result))
3441  :done
3442  (leal (:@ x8632::node-size (:%l temp)) (:%l x8632::esp)))
3443
3444
3445(define-x8632-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
3446
3447(define-x8632-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
3448
3449(define-x8632-vinsn %debug-trap (()
3450                                 ())
3451  (uuo-error-debug-trap))
3452
3453(define-x8632-vinsn double-to-single (((result :single-float))
3454                                      ((arg :double-float)))
3455  (cvtsd2ss (:%xmm arg) (:%xmm result)))
3456
3457(define-x8632-vinsn single-to-double (((result :double-float))
3458                                      ((arg :single-float)))
3459  (cvtss2sd (:%xmm arg) (:%xmm result)))
3460
3461(define-x8632-vinsn alloc-c-frame (()
3462                                   ((nwords :u32const))
3463                                   ((temp :imm)))
3464  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3465  (subl (:$l (:apply ash nwords x8632::word-shift))
3466        (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3467  ;; align stack to 16-byte boundary
3468  (andb (:$b -16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3469  (subl (:$b x8632::node-size) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3470  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3471  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))))
3472
3473(define-x8632-vinsn alloc-variable-c-frame (()
3474                                            ((nwords :imm))
3475                                            ((temp :imm)))
3476  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3477  (subl (:%l nwords) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3478  ;; align stack to 16-byte boundary
3479  (andb (:$b -16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3480  (subl (:$b x8632::node-size) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3481  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3482  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))))
3483
3484(define-x8632-vinsn set-c-arg (()
3485                               ((arg :u32)
3486                                (offset :u32const))
3487                               ((temp :imm)))
3488  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3489  (movl (:%l arg) (:@ (:apply + 4 (:apply ash offset 2)) (:%l temp))))
3490
3491;;; This is a pretty big crock.
3492(define-x8632-vinsn set-c-arg-from-mm0 (()
3493                                        ((offset :u32const))
3494                                        ((temp :imm)))
3495  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3496  (movq (:%mmx x8632::mm0) (:@ (:apply + 4 (:apply ash offset 2)) (:%l temp))))
3497
3498(define-x8632-vinsn eep.address (((dest t))
3499                                 ((src (:lisp (:ne dest )))))
3500  (movl (:@ (+ (ash 1 x8632::word-shift) x8632::misc-data-offset) (:%l src))
3501        (:%l dest))
3502  (cmpl (:$l x8632::nil-value) (:%l dest))
3503  (jne :ok)
3504  (uuo-error-eep-unresolved (:%l src) (:%l dest))
3505  :ok)
3506
3507(define-x8632-subprim-lea-jmp-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
3508
3509(define-x8632-subprim-lea-jmp-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
3510
3511(define-x8632-subprim-lea-jmp-vinsn (make-stack-vector)  .SPmkstackv)
3512
3513(define-x8632-vinsn %current-frame-ptr (((dest :imm))
3514                                        ())
3515  (movl (:%l x8632::ebp) (:%l dest)))
3516
3517(define-x8632-vinsn %foreign-stack-pointer (((dest :imm))
3518                                            ())
3519  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l dest)))
3520
3521
3522(define-x8632-vinsn  %slot-ref (((dest :lisp))
3523                                ((instance (:lisp (:ne dest)))
3524                                 (index :lisp)))
3525  (movl (:@ x8632::misc-data-offset (:%l instance) (:%l index)) (:%l dest))
3526  (cmpl (:$l x8632::slot-unbound-marker) (:%l dest))
3527  (jne.pt :ok)
3528  (uuo-error-slot-unbound (:%l dest) (:%l instance) (:%l index))
3529  :ok)
3530
3531
3532
3533(define-x8632-vinsn symbol-ref (((dest :lisp))
3534                                ((src :lisp)
3535                                 (cellno :u32const)))
3536  (movl (:@ (:apply + (- x8632::node-size x8632::fulltag-misc)
3537                    (:apply ash cellno 2))
3538              (:%l src)) (:%l dest)))
3539
3540(define-x8632-vinsn mem-ref-bit-fixnum (((dest :lisp)
3541                                         (src :address))
3542                                        ((src :address)
3543                                         (offset :lisp))
3544                                        ((temp :u32)))
3545  (movl (:%l offset) (:%l temp))
3546  (shrl (:$ub (+ 5 x8632::fixnumshift)) (:%l temp))
3547  (leal (:@ (:%l src) (:%l temp) 4) (:%l src))
3548  (movl (:%l offset) (:%l temp))
3549  (shrl (:$ub x8632::fixnumshift) (:%l temp))
3550  (andl (:$l 31) (:%l temp))
3551  (btl (:%l temp) (:@ (:%l src)))
3552  (movl (:$l x8632::fixnumone) (:%l temp))
3553  (leal (:@ (- x8632::fixnumone) (:%l temp)) (:%l dest))
3554  (cmovbl (:%l temp) (:%l dest)))
3555
3556(define-x8632-subprim-call-vinsn (progvsave) .SPprogvsave)
3557
3558(define-x8632-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
3559
3560(define-x8632-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
3561
3562(define-x8632-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
3563
3564(define-x8632-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
3565
3566(define-x8632-vinsn set-high-halfword (()
3567                                       ((dest :imm)
3568                                        (n :s16const)))
3569  (orl (:$l (:apply ash n 16)) (:%l dest)))
3570
3571(define-x8632-vinsn scale-nargs (()
3572                                 ((nfixed :s16const)))
3573  ((:pred > nfixed 0)
3574   ((:pred < nfixed 32)
3575    (subl (:$b (:apply ash nfixed x8632::word-shift)) (:%l x8632::nargs)))
3576   ((:pred >= nfixed 32)
3577    (subl (:$l (:apply ash nfixed x8632::word-shift)) (:%l x8632::nargs)))))
3578
3579;; num-opt in imm0
3580(define-x8632-vinsn opt-supplied-p (()
3581                                    ())
3582  (subl (:%l x8632::nargs) (:%l x8632::imm0))
3583  (jmp :push-t-test)
3584  :push-t-loop
3585  (pushl (:$l x8632::t-value))
3586  :push-t-test
3587  (subl (:$b x8632::node-size) (:%l x8632::nargs))
3588  (jge :push-t-loop)
3589  (jmp :push-nil-test)
3590  :push-nil-loop
3591  (pushl (:$l x8632::nil-value))
3592  :push-nil-test
3593  (subl (:$b x8632::node-size) (:%l x8632::imm0))
3594  (jge :push-nil-loop))
3595
3596(define-x8632-vinsn one-opt-supplied-p (()
3597                                        ()
3598                                        ((temp :u32)))
3599  (testl (:%l x8632::nargs) (:%l x8632::nargs))
3600  (setne (:%b temp))
3601  (negb (:%b temp))
3602  (andl (:$b x8632::t-offset) (:%l temp))
3603  (addl (:$l x8632::nil-value) (:%l temp))
3604  (pushl (:%l temp)))
3605
3606;; needs some love
3607(define-x8632-vinsn two-opt-supplied-p (()
3608                                        ())
3609  (rcmpl (:%l x8632::nargs) (:$b (:apply ash 2 x8632::word-shift)))
3610  (jge :two)
3611  (rcmpl (:%l x8632::nargs) (:$b (:apply ash 1 x8632::word-shift)))
3612  (je :one)
3613  ;; none
3614  (pushl (:$l x8632::nil-value))
3615  (pushl (:$l x8632::nil-value))
3616  (jmp :done)
3617  :one
3618  (pushl (:$l x8632::t-value))
3619  (pushl (:$l x8632::nil-value))
3620  (jmp :done)
3621  :two
3622  (pushl (:$l x8632::t-value))
3623  (pushl (:$l x8632::t-value))
3624  :done)
3625
3626(define-x8632-vinsn set-c-flag-if-constant-logbitp (()
3627                                                    ((bit :u8const)
3628                                                     (int :imm)))
3629  (btl (:$ub bit) (:%l int)))
3630
3631;; might be able to use al/ah here
3632(define-x8632-vinsn set-c-flag-if-variable-logbitp (()
3633                                                    ((bit :imm)
3634                                                     (int :imm))
3635                                                    ((temp0 :u8)
3636                                                     (temp1 :u8)))
3637  (movl (:$l 31) (:%l temp1))
3638  (movl (:%l bit) (:%l temp0))
3639  (sarl (:$ub x8632::fixnumshift) (:%l temp0))
3640  (addl (:$b x8632::fixnumshift) (:%l temp0))
3641  (rcmpl (:%l temp0) (:%l temp1))
3642  (cmoval (:%l temp1) (:%l temp0))
3643  (btl (:%l temp0) (:%l int)))
3644
3645(define-x8632-vinsn multiply-immediate (((dest :imm))
3646                                        ((src :imm)
3647                                         (const :s32const)))
3648  ((:and (:pred >= const -128) (:pred <= const 127))
3649   (imull (:$b const) (:%l src) (:%l dest)))
3650  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
3651   (imull (:$l const) (:%l src) (:%l dest))))
3652
3653(define-x8632-vinsn multiply-fixnums (((dest :imm))
3654                                      ((x :imm)
3655                                       (y :imm))
3656                                      ((unboxed :s32)))
3657  ((:pred =
3658          (:apply %hard-regspec-value x)
3659          (:apply %hard-regspec-value dest))
3660   (movl (:%l y) (:%l unboxed))
3661   (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
3662   (imull (:%l unboxed) (:%l dest)))
3663  ((:and (:not (:pred =
3664                      (:apply %hard-regspec-value x)
3665                      (:apply %hard-regspec-value dest)))
3666         (:pred =
3667                (:apply %hard-regspec-value y)
3668                (:apply %hard-regspec-value dest)))
3669   (movl (:%l x) (:%l unboxed))
3670   (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
3671   (imull (:%l unboxed) (:%l dest)))
3672  ((:and (:not (:pred =
3673                      (:apply %hard-regspec-value x)
3674                      (:apply %hard-regspec-value dest)))
3675         (:not (:pred =
3676                      (:apply %hard-regspec-value y)
3677                      (:apply %hard-regspec-value dest))))
3678   (movl (:%l y) (:%l dest))
3679   (movl (:%l x) (:%l unboxed))
3680   (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
3681   (imull (:%l unboxed) (:%l dest))))
3682
3683
3684(define-x8632-vinsn mark-as-imm (()
3685                                 ((reg :imm)))
3686  (btrl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
3687
3688(define-x8632-vinsn mark-as-node (()
3689                                  ((reg :imm)))
3690  (xorl (:%l reg) (:%l reg))
3691  (btsl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
3692
3693(define-x8632-vinsn (temp-push-unboxed-word :push :word :csp)
3694    (()
3695     ((w :u32))
3696     ((temp :imm)))
3697  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3698  (subl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3699  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3700  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3701  (movl (:%l w) (:@ 4 (:%l temp))))
3702
3703(define-x8632-vinsn (temp-pop-unboxed-word :pop :word :csp)
3704    (((w :u32))
3705     ())
3706  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l w))
3707  (movl (:@ 4 (:%l w)) (:%l w))
3708  (addl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
3709
3710(define-x8632-vinsn (temp-push-node :push :word :tsp)
3711    (()
3712     ((w :lisp))
3713     ((temp :imm)))
3714  (subl (:$b (* 2 x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
3715  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
3716  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
3717  (movsd (:%xmm x8632::fpzero) (:@ (:%l temp)))
3718  (movsd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
3719  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3720  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
3721  (movl (:%l w) (:@ x8632::dnode-size (:%l temp))))
3722
3723(define-x8632-vinsn (temp-pop-node :pop :word :tsp)
3724    (((w :lisp))
3725     ()
3726     ((temp :imm)))
3727  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
3728  (movl (:@ x8632::dnode-size (:%l temp)) (:%l w))
3729  (movl (:@ (:%l temp)) (:%l temp))
3730  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
3731  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
3732
3733(define-x8632-vinsn (temp-push-single-float :push :word :csp)
3734    (()
3735     ((f :single-float))
3736     ((temp :imm)))
3737  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3738  (subl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3739  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3740  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3741  (movss (:%xmm f) (:@ 4 (:%l temp))))
3742
3743(define-x8632-vinsn (temp-pop-single-float :pop :word :csp)
3744    (((f :single-float))
3745     ()
3746     ((temp :imm)))
3747  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3748  (movss (:@ 4 (:%l temp)) (:%xmm f))
3749  (addl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
3750
3751(define-x8632-vinsn (temp-push-double-float :push :word :csp)
3752    (()
3753     ((f :double-float))
3754     ((temp :imm)))
3755  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3756  (subl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3757  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3758  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3759  (movsd (:%xmm f) (:@ 8 (:%l temp))))
3760
3761(define-x8632-vinsn (temp-pop-double-float :pop :word :csp)
3762    (((f :double-float))
3763     ()
3764     ((temp :imm)))
3765  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3766  (movsd (:@ 8 (:%l temp)) (:%xmm f))
3767  (addl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
3768
3769(define-x8632-vinsn load-next-method-context (((dest :lisp))
3770                                              ())
3771  (movl (:@ (:%seg :rcontext) x8632::tcr.next-method-context) (:%l dest))
3772  (movl (:$l 0) (:@ (:%seg :rcontext) x8632::tcr.next-method-context)))
3773
3774(queue-fixup
3775 (fixup-x86-vinsn-templates
3776  *x8632-vinsn-templates*
3777  x86::*x86-opcode-template-lists*))
3778
Note: See TracBrowser for help on using the repository browser.