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

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

Don't try to use movapd instruction to clear memory on tstack, since the
tstack isn't always 16-byte aligned on x8632.

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 (:%l 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  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 16) (:%l closure))) ;self-reference entry
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.