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

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

Change the x86 consing sequence to use ja (instead of jg) after comparing
tcr.save_allocptr and tcr.save_allocbase. (If we can manage to reserve
a bigger chunk of heap space, it might happen that these two values differ
in sign, i.e., tcr.save_allocptr might be above #x80000000 and
tcr.save_allocbase below. Of course, it may be a few years yet
before we have to start worrying about crossing #x8000000000000000 on
the x86-64 port...)

Update %ALLOCATE-UVECTOR and CONS vinsns, the Cons and Misc_Alloc_Internal
macros used in subprims, and the %WALK-DYNAMIC-AREA LAP function.

Also change pc_luser_xp() to recognize the ja instruction. (It still
recognizes the jg too, but treats it as ja when emulating it.)

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