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

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

Add heretofore unimplemented vinsn get-double?.

File size: 146.6 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 3)) (:%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(define-x8632-vinsn get-double? (((target :double-float))
1440                                 ((source :lisp))
1441                                 ((tag :u8)))
1442  :resume
1443  (movl (:%l source) (:%l tag))
1444  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1445   (andl (:$b x8632::tagmask) (:%accl tag))
1446   (cmpl (:$b x8632::tag-misc) (:%accl tag)))
1447  ((:pred > (:apply %hard-regspec-value tag) x8632::eax)
1448   (andl (:$b x8632::tagmask) (:%l tag))
1449   (cmpl (:$b x8632::tag-misc) (:%l tag)))
1450  (jne :have-tag)
1451  (movsbl (:@ x8632::misc-subtag-offset (:%l source)) (:%l tag))
1452  :have-tag
1453  (cmpl (:$b x8632::subtag-double-float) (:%l tag))
1454  (jne :bad)
1455  (movsd (:@  x8632::double-float.value (:%l source)) (:%xmm target))
1456
1457  (:anchored-uuo-section :resume)
1458  :bad
1459  (:anchored-uuo (uuo-error-reg-not-tag (:%q source) (:$ub x8632::subtag-double-float))))
1460
1461(define-x8632-vinsn copy-double-float (((dest :double-float))
1462                                       ((src :double-float)))
1463  (movsd (:%xmm src) (:%xmm dest)))
1464
1465(define-x8632-vinsn copy-single-float (((dest :single-float))
1466                                       ((src :single-float)))
1467  (movss (:%xmm src) (:%xmm dest)))
1468
1469(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1470                                           ((src :single-float)))
1471  (cvtss2sd (:%xmm src) (:%xmm dest)))
1472
1473(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1474                                           ((src :double-float)))
1475  (cvtsd2ss (:%xmm src) (:%xmm dest)))
1476
1477;;; these two clobber unboxed0, unboxed1 in tcr
1478;;; (There's no way to move a value from the x87 stack to an xmm register,
1479;;; so we have to go through memory.)
1480(define-x8632-vinsn fp-stack-to-single (((dest :single-float))
1481                                        ())
1482  (fstps (:@ (:%seg :rcontext) x8632::tcr.unboxed0))
1483  (movss (:@ (:%seg :rcontext) x8632::tcr.unboxed0) (:%xmm dest)))
1484
1485(define-x8632-vinsn fp-stack-to-double (((dest :double-float))
1486                                        ())
1487  (fstpl (:@ (:%seg :rcontext) x8632::tcr.unboxed0))
1488  (movsd (:@ (:%seg :rcontext) x8632::tcr.unboxed0) (:%xmm dest)))
1489
1490(define-x8632-vinsn fitvals (()
1491                             ((n :u16const))
1492                             ((imm :u32)))
1493  ((:pred = n 0)
1494   (xorl (:%l imm) (:%l imm)))
1495  ((:not (:pred = n 0))
1496   (movl (:$l (:apply ash n x8632::fixnumshift)) (:%l imm)))
1497  (subl (:%l x8632::nargs) (:%l imm))
1498  (jae :push-more)
1499  (subl (:%l imm) (:%l x8632::esp))
1500  (jmp :done)
1501  :push-loop
1502  (pushl (:$l (:apply target-nil-value)))
1503  (addl (:$b x8632::node-size) (:%l x8632::nargs))
1504  (subl (:$b x8632::node-size) (:%l imm))
1505  :push-more
1506  (jne :push-loop)
1507  :done)
1508
1509(define-x8632-vinsn (nvalret :jumpLR) (()
1510                                       ())
1511  (jmp (:@ .SPnvalret)))
1512
1513(define-x8632-vinsn lisp-word-ref (((dest t))
1514                                   ((base t)
1515                                    (offset t)))
1516  (movl (:@ (:%l base) (:%l offset)) (:%l  dest)))
1517
1518(define-x8632-vinsn lisp-word-ref-c (((dest t))
1519                                     ((base t)
1520                                      (offset :s32const)))
1521  ((:pred = offset 0)
1522   (movl (:@ (:%l base)) (:%l dest)))
1523  ((:not (:pred = offset 0))
1524   (movl (:@ offset (:%l base)) (:%l dest))))
1525
1526;; start-mv-call
1527
1528(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1529                                                    ((label :label))
1530                                                    ((temp :lisp)))
1531  (leal (:@ (:^ label) (:%l x8632::fn)) (:%l temp))
1532  (pushl (:%l temp)))
1533
1534(define-x8632-vinsn emit-aligned-label (()
1535                                        ((label :label)))
1536  ;; We don't care about label.
1537  ;; We just want the label following this stuff to be tra-tagged.
1538  (:align 3)
1539  (nop) (nop) (nop) (nop) (nop))
1540
1541;; pass-multiple-values-symbol
1542;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1543(define-x8632-vinsn pass-multiple-values-symbol (()
1544                                                 ())
1545  (pushl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::ret1valaddr)))) 
1546  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1547
1548
1549;;; It'd be good to have a variant that deals with a known function
1550;;; as well as this.
1551(define-x8632-vinsn pass-multiple-values (()
1552                                          ()
1553                                          ((tag :u8)))
1554  :resume
1555  (movl (:%l x8632::temp0) (:%l tag))
1556  (andl (:$b x8632::tagmask) (:%l tag))
1557  (cmpl (:$b x8632::tag-misc) (:%l tag))
1558  (jne :bad)
1559  (movsbl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
1560  (cmpl (:$b x8632::subtag-function) (:%l tag))
1561  (cmovel (:%l x8632::temp0) (:%l x8632::fn))
1562  (je :go)
1563  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
1564  (cmovel (:@ x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::fn))
1565  (jne :bad)
1566  :go
1567  (pushl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::ret1valaddr))))
1568  (jmp (:%l x8632::fn))
1569  (:anchored-uuo-section :resume)
1570  :bad
1571  (:anchored-uuo (uuo-error-not-callable))
1572)
1573
1574
1575(define-x8632-vinsn reserve-outgoing-frame (()
1576                                            ())
1577  (pushl (:$b x8632::reserved-frame-marker))
1578  (pushl (:$b x8632::reserved-frame-marker)))
1579
1580;; implicit temp0 arg
1581(define-x8632-vinsn (call-known-function :call) (()
1582                                                 ()
1583                                                 ((entry (:label 1))))
1584  (:talign 5)
1585  (call (:%l x8632::temp0))
1586  (movl (:$self 0) (:%l x8632::fn)))
1587
1588(define-x8632-vinsn (jump-known-function :jumplr) (()
1589                                                   ())
1590  (jmp (:%l x8632::temp0)))
1591
1592(define-x8632-vinsn (list :call) (()
1593                                  ()
1594                                  ((entry (:label 1))
1595                                   (temp (:lisp #.x8632::temp0))))
1596  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::temp0))
1597  (:talign 5)
1598  (jmp (:@ .SPconslist))
1599  :back
1600  (movl (:$self 0) (:%l x8632::fn)))
1601
1602(define-x8632-vinsn make-fixed-stack-gvector (((dest :lisp))
1603                                              ((aligned-size :u32const)
1604                                               (header :s32const))
1605                                              ((tempa :imm)
1606                                               (tempb :imm)))
1607  ((:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1608         (:pred <= (:apply + aligned-size x8632::dnode-size) 127))
1609   (subl (:$b (:apply + aligned-size x8632::dnode-size))
1610         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1611  ((:not (:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1612               (:pred <= (:apply + aligned-size x8632::dnode-size) 127)))
1613   (subl (:$l (:apply + aligned-size x8632::dnode-size))
1614         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1615  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l tempb))
1616  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l tempa))
1617  (movd (:%l tempb) (:%mmx x8632::stack-temp))
1618  :loop
1619  (movsd (:%xmm x8632::fpzero) (:@ -8 (:%l tempb)))
1620  (subl (:$b x8632::dnode-size) (:%l tempb))
1621  (cmpl (:%l tempa) (:%l tempb))
1622  (jnz :loop)
1623  (movd (:%mmx x8632::stack-temp) (:@ (:%l tempa)))
1624  (movl (:%l tempa) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1625  (movl (:$l header) (:@ x8632::dnode-size (:%l tempa)))
1626  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l tempa)) (:%l dest)))
1627
1628
1629
1630
1631(define-x8632-vinsn make-tsp-vcell (((dest :lisp))
1632                                    ((closed :lisp))
1633                                    ((temp :imm)))
1634  (subl (:$b (+ x8632::value-cell.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1635  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1636  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1637  (movsd (:%xmm x8632::fpzero) (:@ (:%l temp)))
1638  (movsd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
1639  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))) 
1640  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
1641  (movl (:$l x8632::value-cell-header) (:@ x8632::dnode-size (:%l temp)))
1642  (movl (:%l closed) (:@ (+ x8632::dnode-size x8632::node-size) (:%l temp)))
1643  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l temp)) (:%l dest)))
1644
1645(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1646                                   ((car :lisp) (cdr :lisp))
1647                                   ((temp :imm)))
1648  (subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1649  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1650  (movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1651  (movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1652  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1653  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1654  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1655  (leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1656  (movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1657  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1658  (movl (:%l temp) (:%l dest)))
1659
1660
1661;; make-fixed-stack-gvector
1662
1663(define-x8632-vinsn (discard-temp-frame :tsp :pop :discard) (()
1664                                                             ()
1665                                                             ((temp :imm)))
1666  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1667  (movl (:@ (:%l temp)) (:%l temp))
1668  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1669  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1670  )
1671
1672(define-x8632-vinsn (discard-c-frame :csp :pop :discard) (()
1673                                                          ()
1674                                                          ((temp :imm)))
1675  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1676  (movl (:@ (:%l temp)) (:%l temp))
1677  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1678
1679 
1680(define-x8632-vinsn (vstack-discard :vsp :pop :discard) (()
1681                                    ((nwords :u32const)))
1682  ((:not (:pred = nwords 0))
1683   ((:pred < nwords 16)
1684    (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1685   ((:not (:pred < nwords 16))
1686    (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1687
1688(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1689  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (()
1690                                                                  ()
1691                                                                  ((entry (:label 1))
1692                                                                   (ra (:lisp #.x8632::ra0))))
1693    (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l ra))
1694    (:talign 5)
1695    (jmp (:@ ,spno))
1696    :back
1697    (movl (:$self 0) (:%l x8632::fn))))
1698
1699(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1700  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1701    (:talign 5)
1702    (call (:@ ,spno))
1703    :back
1704    (movl (:$self 0) (:%l x8632::fn))))
1705
1706(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1707  `(define-x8632-vinsn (,name :jumpLR ,@other-attrs) (() ())
1708    (jmp (:@ ,spno))))
1709
1710(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1711                                                        ((lab :label))
1712                                                        ((ra (:lisp #.x8632::ra0))))
1713  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l ra))
1714  (jmp (:@ .SPnthrowvalues)))
1715
1716(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1717                                                        ((lab :label))
1718                                                        ((ra (:lisp #.x8632::ra0))))
1719  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l ra))
1720  (jmp (:@ .SPnthrow1value)))
1721
1722(define-x8632-vinsn set-single-c-arg (()
1723                                      ((arg :single-float)
1724                                       (offset :u32const))
1725                                      ((temp :imm)))
1726  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1727  (movss (:%xmm arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp))))
1728
1729(define-x8632-vinsn reload-single-c-arg (((arg :single-float))
1730                                         ((offset :u32const))
1731                                         ((temp :imm)))
1732  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1733  (movss (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp)) (:%xmm arg)))
1734
1735(define-x8632-vinsn set-double-c-arg (()
1736                                      ((arg :double-float)
1737                                       (offset :u32const))
1738                                      ((temp :imm)))
1739  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1740  (movsd (:%xmm arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp))))
1741
1742(define-x8632-vinsn reload-double-c-arg (((arg :double-float))
1743                                         ((offset :u32const))
1744                                         ((temp :imm)))
1745  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1746  (movsd (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp)) (:%xmm arg)))
1747
1748;;; .SPffcall has stored %edx in tcr.unboxed1.  Load %mm0 with a
1749;;; 64-bit value composed from %edx:%eax.
1750(define-x8632-vinsn get-64-bit-ffcall-result (()
1751                                              ())
1752  (movl (:%l x8632::eax) (:@ (:%seg :rcontext) x8632::tcr.unboxed0))
1753  (movq (:@ (:%seg :rcontext) x8632::tcr.unboxed0) (:%mmx x8632::mm0)))
1754
1755(define-x8632-subprim-call-vinsn (ff-call)  .SPffcall)
1756
1757(define-x8632-subprim-call-vinsn (syscall)  .SPsyscall)
1758
1759(define-x8632-subprim-call-vinsn (syscall2)  .SPsyscall2)
1760
1761(define-x8632-subprim-call-vinsn (setqsym) .SPsetqsym)
1762
1763(define-x8632-subprim-call-vinsn (gets32) .SPgets32)
1764
1765(define-x8632-subprim-call-vinsn (getu32) .SPgetu32)
1766
1767(define-x8632-subprim-call-vinsn (gets64) .SPgets64)
1768
1769(define-x8632-subprim-call-vinsn (getu64) .SPgetu64)
1770
1771(define-x8632-subprim-call-vinsn (makes64) .SPmakes64)
1772
1773(define-x8632-subprim-call-vinsn (makeu64) .SPmakeu64)
1774
1775(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list*)  .SPstkconslist-star)
1776
1777(define-x8632-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
1778
1779(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1780
1781(define-x8632-vinsn bind-interrupt-level-0-inline (()
1782                                                   ()
1783                                                   ((temp :imm)))
1784  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1785  (cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1786  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1787  (pushl (:$b x8632::interrupt-level-binding-index))
1788  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1789  (movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1790  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1791  (jns :done)
1792  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1793  (jae :done)
1794  (ud2a)
1795  (:byte 2)
1796  :done)
1797
1798(define-x8632-vinsn bind-interrupt-level-m1-inline (()
1799                                                    ()
1800                                                    ((temp :imm)))
1801  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1802  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1803  (pushl (:$b x8632::interrupt-level-binding-index))
1804  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1805  (movl (:$l (ash -1 x8632::fixnumshift)) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1806  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link)))
1807
1808(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1809
1810(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1811
1812(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1813
1814#||
1815(define-x8632-vinsn unbind-interrupt-level-inline (()
1816                                                   ()
1817                                                   ((link :imm)
1818                                                    (curval :imm)
1819                                                    (oldval :imm)
1820                                                    (tlb :imm)))
1821  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l tlb))
1822  (movl (:@ (:%seg :rcontext) x8632::tcr.db-link) (:%l link))
1823  (movl (:@ x8632::interrupt-level-binding-index (:%l tlb)) (:%l curval))
1824  (testl (:%l curval) (:%l curval))
1825  (movl (:@ 8 #|binding.val|# (:%l link)) (:%l oldval))
1826  (movl (:@ #|binding.link|# (:%l link)) (:%l link))
1827  (movl (:%l oldval) (:@ x8632::interrupt-level-binding-index (:%l tlb)))
1828  (movl (:%l link) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1829  (jns :done)
1830  (testl (:%l oldval) (:%l oldval))
1831  (js :done)
1832  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1833  (jae :done)
1834  (ud2a)
1835  (:byte 2)
1836  :done)
1837||#
1838
1839(define-x8632-vinsn (jump-return-pc :jumpLR) (()
1840                                              ())
1841  (ret))
1842
1843;;; xxx
1844(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
1845                                                      ((lab :label))
1846                                                      ((entry (:label 1))
1847                                                       (xfn (:lisp #.x8632::xfn))))
1848  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l xfn))
1849  (:talign 5)
1850  (call (:@ .SPmkcatchmv))
1851  :back
1852  (movl (:$self 0) (:%l x8632::fn)))
1853
1854(define-x8632-vinsn (nmkcatch1v :call :subprim-call) (()
1855                                                     ((lab :label))
1856                                                     ((entry (:label 1))
1857                                                      (xfn (:lisp #.x8632::xfn))))
1858  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1859  (:talign 5)
1860  (call (:@ .SPmkcatch1v))
1861  :back
1862  (movl (:$self 0) (:%l x8632::fn)))
1863
1864
1865(define-x8632-vinsn (make-simple-unwind :call :subprim-call) (()
1866                                                     ((protform-lab :label)
1867                                                      (cleanup-lab :label)))
1868  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1869  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1870  (jmp (:@ .SPmkunwind)))
1871
1872(define-x8632-vinsn (nmkunwind :call :subprim-call) (()
1873                                                     ((protform-lab :label)
1874                                                      (cleanup-lab :label)))
1875  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1876  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1877  (jmp (:@ .SPnmkunwind)))
1878
1879(define-x8632-vinsn u16->u32 (((dest :u32))
1880                              ((src :u16)))
1881  (movzwl (:%w src) (:%l dest)))
1882
1883(define-x8632-vinsn u8->u32 (((dest :u32))
1884                             ((src :u8)))
1885  (movzbl (:%b src) (:%l dest)))
1886
1887(define-x8632-vinsn s16->s32 (((dest :s32))
1888                              ((src :s16)))
1889  (movswl (:%w src) (:%l dest)))
1890
1891(define-x8632-vinsn s8->s32 (((dest :s32))
1892                             ((src :s8)))
1893  (movsbl (:%b src) (:%l dest)))
1894
1895(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1896
1897(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1898
1899(define-x8632-vinsn set-eq-bit (()
1900                                ())
1901  (testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1902
1903;;; %schar8
1904;;; %schar32
1905;;; %set-schar8
1906;;; %set-schar32
1907
1908(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1909                                             ((v :lisp)
1910                                              (idx :u32const)))
1911  (movss (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1912
1913(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1914                                           ((header :lisp)))
1915  (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1916
1917(define-x8632-vinsn set-z-flag-if-istruct-typep (()
1918                                                 ((val :lisp)
1919                                                  (type :lisp))
1920                                                 ((tag :u8)
1921                                                  (valtype :lisp)))
1922  (xorl (:%l valtype) (:%l valtype))
1923  (movl (:%l val) (:%l tag))
1924  (andl (:$b x8632::tagmask) (:%l tag))
1925  (cmpl (:$b x8632::tag-misc) (:%l tag))
1926  (jne :have-tag)
1927  (movsbl (:@ x8632::misc-subtag-offset (:%l val)) (:%l tag))
1928  :have-tag
1929  (cmpl (:$b x8632::subtag-istruct) (:%l tag))
1930  (jne :do-compare)
1931  (movl (:@ x8632::misc-data-offset (:%l val)) (:%l valtype))
1932  :do-compare
1933  (cmpl (:%l valtype) (:%l type)))
1934
1935(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1936
1937(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1938
1939(define-x8632-vinsn mem-set-c-constant-fullword (()
1940                                                 ((val :s32const)
1941                                                  (dest :address)
1942                                                  (offset :s32const)))
1943  ((:pred = offset 0)
1944   (movl (:$l val) (:@ (:%l dest))))
1945  ((:not (:pred = offset 0))
1946   (movl (:$l val) (:@ offset (:%l dest)))))
1947
1948(define-x8632-vinsn mem-set-c-halfword (()
1949                                        ((val :u16)
1950                                         (dest :address)
1951                                         (offset :s32const)))
1952  ((:pred = offset 0)
1953   (movw (:%w val) (:@ (:%l dest))))
1954  ((:not (:pred = offset 0))
1955   (movw (:%w val) (:@ offset (:%l dest)))))
1956
1957(define-x8632-vinsn mem-set-c-constant-halfword (()
1958                                                 ((val :s16const)
1959                                                  (dest :address)
1960                                                  (offset :s32const)))
1961  ((:pred = offset 0)
1962   (movw (:$w val) (:@ (:%l dest))))
1963  ((:not (:pred = offset 0))
1964   (movw (:$w val) (:@ offset (:%l dest)))))
1965
1966(define-x8632-vinsn mem-set-c-constant-byte (()
1967                                                 ((val :s8const)
1968                                                  (dest :address)
1969                                                  (offset :s32const)))
1970  ((:pred = offset 0)
1971   (movb (:$b val) (:@ (:%l dest))))
1972  ((:not (:pred = offset 0))
1973   (movb (:$b val) (:@ offset (:%l dest)))))
1974
1975(define-x8632-vinsn mem-set-c-byte (()
1976                                    ((val :u8)
1977                                     (dest :address)
1978                                     (offset :s32const)))
1979  ((:pred = offset 0)
1980   (movb (:%b val) (:@ (:%l dest))))
1981  ((:not (:pred = offset 0))
1982   (movb (:%b val) (:@ offset (:%l dest)))))
1983
1984(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1985                                           ((addr :s32const)))
1986  (movzbl (:@ addr) (:%l dest)))
1987
1988(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1989                                           ((addr :s32const)))
1990  (movsbl (:@ addr) (:%l dest)))
1991
1992(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1993                                           ((addr :s32const)))
1994  (movzwl (:@ addr) (:%l dest)))
1995
1996(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1997                                           ((addr :s32const)))
1998  (movswl (:@ addr) (:%l dest)))
1999
2000(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
2001                                                 ((addr :s32const)))
2002  (movl (:@ addr) (:%l dest)))
2003
2004(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
2005                                                        ((addr :s32const)))
2006  (movl (:@ addr) (:%l dest)))
2007
2008(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
2009                                                   ((addr :s32const)))
2010  (movl (:@ addr) (:%l dest)))
2011
2012(define-x8632-vinsn mem-ref-u8 (((dest :u8))
2013                                ((src :address)
2014                                 (index :s32)))
2015  (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
2016
2017(define-x8632-vinsn mem-ref-c-u16 (((dest :u16))
2018                                   ((src :address)
2019                                    (index :s32const)))
2020  ((:pred = index 0) 
2021   (movzwl (:@ (:%l src)) (:%l dest)))
2022  ((:not (:pred = index 0))
2023   (movzwl (:@ index (:%l src)) (:%l dest))))
2024
2025(define-x8632-vinsn mem-ref-u16 (((dest :u16))
2026                                 ((src :address)
2027                                  (index :s32)))
2028  (movzwl (:@ (:%l src) (:%l index)) (:%l dest)))
2029
2030(define-x8632-vinsn mem-ref-c-s16 (((dest :s16))
2031                                   ((src :address)
2032                                    (index :s32const)))
2033  ((:pred = index 0)
2034   (movswl (:@ (:%l src)) (:%l dest)))
2035  ((:not (:pred = index 0))
2036   (movswl (:@ index (:%l src)) (:%l dest))))
2037
2038(define-x8632-vinsn mem-ref-s16 (((dest :s16))
2039                                 ((src :address)
2040                                  (index :s32)))
2041  (movswl (:@ (:%l src) (:%l index)) (:%l dest)))
2042
2043(define-x8632-vinsn mem-ref-c-u8 (((dest :u8))
2044                                  ((src :address)
2045                                   (index :s16const)))
2046  ((:pred = index 0)
2047   (movzbl (:@  (:%l src)) (:%l dest)))
2048  ((:not (:pred = index 0))
2049   (movzbl (:@ index (:%l src)) (:%l dest))))
2050
2051(define-x8632-vinsn mem-ref-u8 (((dest :u8))
2052                                ((src :address)
2053                                 (index :s32)))
2054  (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
2055
2056(define-x8632-vinsn mem-ref-c-s8 (((dest :s8))
2057                                  ((src :address)
2058                                   (index :s16const)))
2059  ((:pred = index 0)
2060   (movsbl (:@ (:%l src)) (:%l dest)))
2061  ((:not (:pred = index 0))
2062   (movsbl (:@ index (:%l src)) (:%l dest))))
2063
2064(define-x8632-vinsn misc-set-c-s8  (((val :s8))
2065                                    ((v :lisp)
2066                                     (idx :u32const))
2067                                    ())
2068  (movb (:%b val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
2069
2070(define-x8632-vinsn misc-set-s8  (((val :s8))
2071                                  ((v :lisp)
2072                                   (scaled-idx :s32))
2073                                  ())
2074  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2075
2076(define-x8632-vinsn mem-ref-s8 (((dest :s8))
2077                                ((src :address)
2078                                 (index :s32)))
2079  (movsbl (:@ (:%l src) (:%l index)) (:%l dest)))
2080
2081(define-x8632-vinsn mem-set-constant-fullword (()
2082                                               ((val :s32const)
2083                                                (ptr :address)
2084                                                (offset :s32)))
2085  (movl (:$l val) (:@ (:%l ptr) (:%l offset))))
2086
2087
2088(define-x8632-vinsn mem-set-constant-halfword (()
2089                                               ((val :s16const)
2090                                                (ptr :address)
2091                                                (offset :s32)))
2092  (movw (:$w val) (:@ (:%l ptr) (:%l offset))))
2093
2094(define-x8632-vinsn mem-set-constant-byte (()
2095                                           ((val :s8const)
2096                                            (ptr :address)
2097                                            (offset :s32)))
2098  (movb (:$b val) (:@ (:%l ptr) (:%l offset))))
2099
2100(define-x8632-vinsn misc-set-c-u8  (((val :u8))
2101                                    ((v :lisp)
2102                                     (idx :u32const))
2103                                    ())
2104  (movb (:%b val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
2105
2106(define-x8632-vinsn misc-set-u8  (((val :u8))
2107                                  ((v :lisp)
2108                                   (scaled-idx :s32))
2109                                  ())
2110  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2111
2112(define-x8632-vinsn misc-set-c-u16  (()
2113                                    ((val :u16)
2114                                     (v :lisp)
2115                                     (idx :s32const))
2116                                    ())
2117  (movw (:%w val) (:@ (:apply + x8632::misc-data-offset (:apply * 2 idx)) (:%l v))))
2118
2119(define-x8632-vinsn misc-set-u16  (()
2120                                   ((val :u16)
2121                                    (v :lisp)
2122                                    (scaled-idx :s32))
2123                                   ())
2124  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2125
2126(define-x8632-vinsn misc-set-c-s16  (()
2127                                    ((val :s16)
2128                                     (v :lisp)
2129                                     (idx :s32const))
2130                                    ())
2131  (movw (:%w val) (:@ (:apply + x8632::misc-data-offset (:apply * 2 idx)) (:%l v))))
2132
2133(define-x8632-vinsn misc-set-s16  (()
2134                                   ((val :s16)
2135                                    (v :lisp)
2136                                    (scaled-idx :s32))
2137                                   ())
2138  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2139
2140(define-x8632-vinsn misc-set-c-u32  (()
2141                                     ((val :u32)
2142                                      (v :lisp)
2143                                      (idx :u32const)) ; sic
2144                                     ())
2145  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
2146
2147(define-x8632-vinsn misc-set-u32  (()
2148                                   ((val :u32)
2149                                    (v :lisp)
2150                                    (scaled-idx :s32))
2151                                   ())
2152  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2153
2154(define-x8632-vinsn misc-set-c-s32  (()
2155                                     ((val :s32)
2156                                      (v :lisp)
2157                                      (idx :u32const)) ; sic
2158                                     ())
2159  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
2160
2161(define-x8632-vinsn misc-set-s32  (()
2162                                   ((val :s32)
2163                                    (v :lisp)
2164                                    (scaled-idx :s32))
2165                                   ())
2166  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2167
2168(define-x8632-vinsn %iasr (((dest :imm))
2169                           ((count :imm)
2170                            (src :imm))
2171                           ((temp :s32)
2172                            (shiftcount (:s32 #.x8632::ecx))))
2173  (movl (:%l count) (:%l temp))
2174  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2175  (rcmpl (:%l temp) (:$l 31))
2176  (cmovbw (:%w temp) (:%w shiftcount))
2177  (movl (:%l src) (:%l temp))
2178  (jae :shift-max)
2179  (sarl (:%shift x8632::cl) (:%l temp))
2180  (jmp :done)
2181  :shift-max
2182  (sarl (:$ub 31) (:%l temp))
2183  :done
2184  (andl (:$l (lognot x8632::fixnummask)) (:%l temp))
2185  (movl (:%l temp) (:%l dest)))
2186
2187(define-x8632-vinsn %ilsr (((dest :imm))
2188                           ((count :imm)
2189                            (src :imm))
2190                           ((temp :s32)
2191                            (shiftcount (:s32 #.x8632::ecx))))
2192  (movl (:%l count) (:%l temp))
2193  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2194  (rcmpl (:%l temp) (:$l 31))
2195  (cmovbw (:%w temp) (:%w shiftcount))
2196  (movl (:%l src) (:%l temp))
2197  (jae :shift-max)
2198  (shrl (:%shift x8632::cl) (:%l temp))
2199  (jmp :done)
2200  :shift-max
2201  (shrl (:$ub 31) (:%l temp))
2202  :done
2203  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2204  (movl (:%l temp) (:%l dest)))
2205
2206(define-x8632-vinsn %iasr-c (((dest :imm))
2207                             ((count :u8const)
2208                              (src :imm))
2209                             ((temp :s32)))
2210  (movl (:%l src) (:%l temp))
2211  (sarl (:$ub count) (:%l temp))
2212  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2213  (movl (:%l temp) (:%l dest)))
2214
2215(define-x8632-vinsn %ilsr-c (((dest :imm))
2216                             ((count :u8const)
2217                              (src :imm))
2218                             ((temp :s32)))
2219  (movl (:%l src) (:%l temp))
2220  (shrl (:$ub count) (:%l temp))
2221  ;; xxx --- use :%acc
2222  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2223  (movl (:%l temp) (:%l dest)))
2224
2225(define-x8632-vinsn %ilsl (((dest :imm))
2226                           ((count :imm)
2227                            (src :imm))
2228                           ((temp (:s32 #.x8632::eax))
2229                            (shiftcount (:s32 #.x8632::ecx))))
2230  (movl (:%l count) (:%l temp))
2231  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2232  (rcmpl (:%l temp) (:$l 31))
2233  (cmovbw (:%w temp) (:%w shiftcount))
2234  (movl (:%l src) (:%l temp))
2235  (jae :shift-max)
2236  (shll (:%shift x8632::cl) (:%l temp))
2237  (jmp :done)
2238  :shift-max
2239  (xorl (:%l temp) (:%l temp))
2240  :done
2241  (movl (:%l temp) (:%l dest)))
2242
2243(define-x8632-vinsn %ilsl-c (((dest :imm))
2244                             ((count :u8const)
2245                              (src :imm)))
2246  ((:not (:pred =
2247                (:apply %hard-regspec-value src)
2248                (:apply %hard-regspec-value dest)))
2249   (movl (:%l src) (:%l dest)))
2250  (shll (:$ub count) (:%l dest)))
2251
2252;;; In safe code, something else has ensured that the value is of type
2253;;; BIT.
2254(define-x8632-vinsn set-variable-bit-to-variable-value (()
2255                                                        ((vec :lisp)
2256                                                         (word-index :s32)
2257                                                         (bitnum :u8)
2258                                                         (value :lisp)))
2259  (testl (:%l value) (:%l value))
2260  (je :clr)
2261  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
2262  (jmp :done)
2263  :clr
2264  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
2265  :done)
2266
2267;;; In safe code, something else has ensured that the value is of type
2268;;; BIT.
2269(define-x8632-vinsn nset-variable-bit-to-variable-value (()
2270                                                         ((vec :lisp)
2271                                                          (index :s32)
2272                                                          (value :lisp)))
2273  (testl (:%l value) (:%l value))
2274  (je :clr)
2275  (btsl (:%l index) (:@ x8632::misc-data-offset (:%l vec)))
2276  (jmp :done)
2277  :clr
2278  (btrl (:%l index) (:@ x8632::misc-data-offset (:%l vec)))
2279  :done)
2280
2281(define-x8632-vinsn nset-variable-bit-to-zero (()
2282                                              ((vec :lisp)
2283                                               (index :s32)))
2284  (btrl (:%l index) (:@ x8632::misc-data-offset (:%l vec))))
2285
2286(define-x8632-vinsn nset-variable-bit-to-one (()
2287                                             ((vec :lisp)
2288                                              (index :s32)))
2289  (btsl (:%l index) (:@ x8632::misc-data-offset (:%l vec))))
2290
2291(define-x8632-vinsn set-variable-bit-to-zero (()
2292                                              ((vec :lisp)
2293                                               (word-index :s32)
2294                                               (bitnum :u8)))
2295  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
2296
2297(define-x8632-vinsn set-variable-bit-to-one (()
2298                                             ((vec :lisp)
2299                                              (word-index :s32)
2300                                              (bitnum :u8)))
2301  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
2302
2303(define-x8632-vinsn set-constant-bit-to-zero (()
2304                                              ((src :lisp)
2305                                               (idx :u32const)))
2306  (btrl (:$ub (:apply logand 31 idx))
2307        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2308
2309(define-x8632-vinsn set-constant-bit-to-one (()
2310                                             ((src :lisp)
2311                                              (idx :u32const)))
2312  (btsl (:$ub (:apply logand 31 idx))
2313        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2314
2315(define-x8632-vinsn set-constant-bit-to-variable-value (()
2316                                                        ((src :lisp)
2317                                                         (idx :u32const)
2318                                                         (value :lisp)))
2319  (testl (:%l value) (:%l value))
2320  (je :clr)
2321  (btsl (:$ub (:apply logand 31 idx))
2322        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2323  (jmp :done)
2324  :clr
2325  (btrl (:$ub (:apply logand 31 idx))
2326        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2327  :done)
2328
2329(define-x8632-vinsn require-fixnum (()
2330                                    ((object :lisp)))
2331  :again
2332  ((:and (:pred > (:apply %hard-regspec-value object) x8632::eax)
2333         (:pred <= (:apply %hard-regspec-value object) x8632::ebx))
2334   (testb (:$b x8632::fixnummask) (:%b object)))
2335  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2336   (testl (:$l x8632::fixnummask) (:%l object)))
2337  (jne :bad)
2338
2339  (:anchored-uuo-section :again)
2340  :bad
2341  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-fixnum))))
2342
2343(define-x8632-vinsn require-integer (()
2344                                     ((object :lisp))
2345                                     ((tag :u8)))
2346  :again
2347  (movl (:%l object) (:%l tag))
2348  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2349   (andb (:$b x8632::fixnummask) (:%accb tag)))
2350  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2351         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2352   (andb (:$b x8632::fixnummask) (:%b tag)))
2353  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2354   (andl (:$l x8632::fixnummask) (:%l tag)))
2355  (je :got-it)
2356  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2357   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
2358  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2359         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2360   (cmpb (:$b x8632::tag-misc) (:%b tag)))
2361  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2362   (cmpl (:$l x8632::tag-misc) (:%l tag)))
2363  (jne :bad)
2364  (cmpb (:$b x8632::subtag-bignum) (:@ x8632::misc-subtag-offset (:%l object)))
2365  (jne :bad)
2366  :got-it
2367
2368  (:anchored-uuo-section :again)
2369  :bad
2370  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-integer))))
2371
2372(define-x8632-vinsn require-simple-vector (()
2373                                           ((object :lisp))
2374                                           ((tag :u8)))
2375  :again
2376  (movl (:%l object) (:%l tag))
2377  (andl (:$b x8632::fixnummask) (:%l tag))
2378  (cmpl (:$b x8632::tag-misc) (:%l tag))
2379  (jne :bad)
2380  (cmpb (:$b x8632::subtag-simple-vector) (:@ x8632::misc-subtag-offset (:%l object)))
2381  (jne :bad)
2382
2383  (:anchored-uuo-section :again)
2384  :bad
2385  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-simple-vector))))
2386
2387(define-x8632-vinsn require-simple-string (()
2388                                           ((object :lisp))
2389                                           ((tag :u8)))
2390  :again
2391  (movl (:%l object) (:%l tag))
2392  (andl (:$b x8632::fixnummask) (:%l tag))
2393  (cmpl (:$b x8632::tag-misc) (:%l tag))
2394  (jne :bad)
2395  (cmpb (:$b x8632::subtag-simple-base-string) (:@ x8632::misc-subtag-offset (:%l object)))
2396  (jne :bad)
2397
2398  (:anchored-uuo-section :again)
2399  :bad
2400  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-simple-string))))
2401
2402
2403;;; naive
2404(define-x8632-vinsn require-real (()
2405                                    ((object :lisp))
2406                                    ((tag :u8)
2407                                     (mask :lisp)))
2408  :again
2409  (movl (:%l object) (:%l tag))
2410  (andl (:$b x8632::tagmask) (:%l tag))
2411  (cmpl (:$b x8632::tag-misc) (:%l tag))
2412  (jne :have-tag)
2413  (movzbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
2414  :have-tag
2415  (cmpl (:$b (1- (- x8632::nbits-in-word x8632::fixnumshift))) (:%l tag))
2416  (movl (:$l (ash (logior (ash 1 x8632::tag-fixnum)
2417                          (ash 1 x8632::subtag-single-float)
2418                          (ash 1 x8632::subtag-double-float)
2419                          (ash 1 x8632::subtag-bignum)
2420                          (ash 1 x8632::subtag-ratio))
2421                  x8632::fixnumshift)) (:%l mask))
2422  (ja :bad)
2423  (addl (:$b x8632::fixnumshift) (:%l tag))
2424  (btl (:%l tag) (:%l mask))
2425  (jnc :bad)
2426
2427  (:anchored-uuo-section :again)
2428  :bad
2429  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-real))))
2430
2431;;; naive
2432(define-x8632-vinsn require-number (()
2433                                    ((object :lisp))
2434                                    ((tag :u8)
2435                                     (mask :lisp)))
2436  :again
2437  (movl (:%l object) (:%l tag))
2438  (andl (:$b x8632::tagmask) (:%l tag))
2439  (cmpl (:$b x8632::tag-misc) (:%l tag))
2440  (jne :have-tag)
2441  (movzbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
2442  :have-tag
2443  (cmpl (:$b (1- (- x8632::nbits-in-word x8632::fixnumshift))) (:%l tag))
2444  (movl (:$l (ash (logior (ash 1 x8632::tag-fixnum)
2445                          (ash 1 x8632::subtag-single-float)
2446                          (ash 1 x8632::subtag-double-float)
2447                          (ash 1 x8632::subtag-bignum)
2448                          (ash 1 x8632::subtag-ratio)
2449                          (ash 1 x8632::subtag-complex))
2450                  x8632::fixnumshift)) (:%l mask))
2451  (ja :bad)
2452  (addl (:$b x8632::fixnumshift) (:%l tag))
2453  (btl (:%l tag) (:%l mask))
2454  (jnc :bad)
2455
2456  (:anchored-uuo-section :again)
2457  :bad
2458  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-number))))
2459
2460(define-x8632-vinsn require-list (()
2461                                  ((object :lisp))
2462                                  ((tag :u8)))
2463  :again
2464  (movl (:%l object) (:%l tag))
2465  (andl (:$b x8632::fulltagmask) (:%l tag))
2466  (cmpl (:$b x8632::fulltag-cons) (:%l tag))
2467  (jne :bad)
2468
2469  (:anchored-uuo-section :again)
2470  :bad
2471  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-list))))
2472
2473(define-x8632-vinsn require-symbol (()
2474                                    ((object :lisp))
2475                                    ((tag :u8)))
2476  :again
2477  (cmpl (:$l (:apply target-nil-value)) (:%l object))
2478  (je :got-it)
2479  (movl (:%l object) (:%l tag))
2480  (andl (:$b x8632::tagmask) (:%l tag))
2481  (cmpl (:$b x8632::tag-misc) (:%l tag))
2482  (jne :bad)
2483  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l object)))
2484  (jne :bad)
2485  :got-it
2486 
2487  (:anchored-uuo-section :again)
2488  :bad
2489  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-symbol)))
2490)
2491
2492(define-x8632-vinsn require-character (()
2493                                       ((object :lisp)))
2494  :again
2495  (cmpb (:$b x8632::subtag-character) (:%b object))
2496  (jne :bad)
2497
2498  (:anchored-uuo-section :again)
2499  :bad
2500  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-character))))
2501
2502(define-x8632-vinsn require-s8 (()
2503                                ((object :lisp))
2504                                ((tag :u32)))
2505  :again
2506  (movl (:%l object) (:%l tag))
2507  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l tag))
2508  (sarl (:$ub (- x8632::nbits-in-word 8)) (:%l tag))
2509  (shll (:$ub x8632::fixnumshift) (:%l tag))
2510  (cmpl (:%l object) (:%l tag))
2511  (jne :bad)
2512
2513  (:anchored-uuo-section :again)
2514  :bad
2515  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-8))))
2516
2517(define-x8632-vinsn require-u8 (()
2518                                ((object :lisp))
2519                                ((tag :u32)))
2520  :again
2521  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l tag))
2522  (andl (:%l object) (:%l tag))
2523  (jne :bad)
2524
2525  (:anchored-uuo-section :again)
2526  :bad
2527  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-8))))
2528
2529(define-x8632-vinsn require-s16 (()
2530                                ((object :lisp))
2531                                ((tag :s32)))
2532  :again
2533  (movl (:%l object) (:%l tag))
2534  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l tag))
2535  (sarl (:$ub (- x8632::nbits-in-word 16)) (:%l tag))
2536  (shll (:$ub x8632::fixnumshift) (:%l tag))
2537  (cmpl (:%l object) (:%l tag))
2538  (jne :bad)
2539
2540  (:anchored-uuo-section :again)
2541  :bad
2542  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-16))))
2543
2544(define-x8632-vinsn require-u16 (()
2545                                ((object :lisp))
2546                                ((tag :u32)))
2547  :again
2548  (movl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:%l tag))
2549  (andl (:%l object) (:%l tag))
2550  (jne :bad)
2551
2552  (:anchored-uuo-section :again)
2553  :bad
2554  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-16))))
2555
2556(define-x8632-vinsn require-s32 (()
2557                                 ((object :lisp))
2558                                 ((tag :s32)))
2559  :again
2560  (testl (:$l x8632::fixnummask) (:%l object))
2561  (movl (:%l object) (:%l tag))
2562  (je :ok)
2563  (andl (:$l x8632::fulltagmask) (:%l tag))
2564  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2565  (jne :bad)
2566  (cmpl (:$l x8632::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2567  (jne :bad)
2568  :ok
2569 
2570  (:anchored-uuo-section :again)
2571  :bad
2572  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-32))))
2573
2574(define-x8632-vinsn require-u32 (()
2575                                 ((object :lisp))
2576                                 ((tag :s32)))
2577  :again
2578  (testl (:$l x8632::fixnummask) (:%l object))
2579  (movl (:%l object) (:%l tag))
2580  (je :ok-if-non-negative)
2581  (andl (:$l x8632::fulltagmask) (:%l tag))
2582  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2583  (jne :bad)
2584  (cmpl (:$l x8632::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2585  (je :one)
2586  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2587  (jne :bad)
2588  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 4) (:%l object)))
2589  (je :ok)
2590  :bad
2591  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-32))
2592  (jmp :again)
2593  :one
2594  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
2595  :ok-if-non-negative
2596  (testl (:%l tag) (:%l tag))
2597  (js :bad)
2598  :ok)
2599
2600(define-x8632-vinsn require-s64 (()
2601                                 ((object :lisp))
2602                                 ((tag :s32)))
2603  :again
2604  (testl (:$l x8632::fixnummask) (:%l object))
2605  (movl (:%l object) (:%l tag))
2606  (je :ok)
2607  (andl (:$l x8632::fulltagmask) (:%l tag))
2608  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2609  (jne :bad)
2610  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2611  (jne :bad)
2612  :ok
2613
2614  (:anchored-uuo-section :again)
2615  :bad
2616  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-64))))
2617
2618(define-x8632-vinsn require-u64 (()
2619                                 ((object :lisp))
2620                                 ((tag :s32)))
2621  :again
2622  (testl (:$l x8632::fixnummask) (:%l object))
2623  (movl (:%l object) (:%l tag))
2624  (je :ok-if-non-negative)
2625  (andl (:$l x8632::fulltagmask) (:%l tag))
2626  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2627  (jne :bad)
2628  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2629  (je :two)
2630  (cmpl (:$l x8632::three-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2631  (jne :bad)
2632  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 8) (:%l object)))
2633  (je :ok)
2634  :bad
2635  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-64))
2636  (jmp :again)
2637  :two
2638  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
2639  :ok-if-non-negative
2640  (testl (:%l tag) (:%l tag))
2641  (js :bad)
2642  :ok)
2643
2644(define-x8632-vinsn require-char-code (()
2645                                       ((object :lisp))
2646                                       ((tag :u32)))
2647  :again
2648  (testb (:$b x8632::fixnummask) (:%b object))
2649  (jne :bad)
2650  (cmpl (:$l (ash #x110000 x8632::fixnumshift)) (:%l object))
2651  (jae :bad)
2652
2653  (:anchored-uuo-section :again)
2654  :bad
2655  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-mod-char-code-limit))))
2656
2657(define-x8632-vinsn mask-base-char (((dest :u8))
2658                                    ((src :lisp)))
2659  (movzbl (:%b src) (:%l dest)))
2660
2661(define-x8632-vinsn event-poll (()
2662                                ())
2663  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
2664  (jae :no-interrupt)
2665  (ud2a)
2666  (:byte 2)
2667  :no-interrupt)
2668
2669;;; check-2d-bound
2670;;; check-3d-bound
2671
2672(define-x8632-vinsn 2d-dim1 (((dest :u32))
2673                             ((header :lisp)))
2674  (movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
2675            (:%l header)) (:%l dest))
2676  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
2677
2678;;; 3d-dims
2679
2680;;; xxx
2681(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
2682                                        (dim1 :u32))
2683                                       ((dim1 :u32)
2684                                        (i :imm)
2685                                        (j :imm)))
2686
2687  (imull (:%l i) (:%l dim1))
2688  (leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
2689
2690;;; 3d-unscaled-index
2691
2692(define-x8632-vinsn branch-unless-both-args-fixnums (()
2693                                                     ((a :lisp)
2694                                                      (b :lisp)
2695                                                      (dest :label))
2696                                                     ((tag :u8)))
2697  (movl (:%l a) (:%l tag))
2698  (orl (:%l b) (:%l tag))
2699  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2700   (testb (:$b x8632::fixnummask) (:%accb tag)))
2701  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2702         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2703   (testb (:$b x8632::fixnummask) (:%b tag)))
2704  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2705   (testl (:$l x8632::fixnummask) (:%l tag)))
2706  (jne dest))
2707
2708(define-x8632-vinsn branch-unless-arg-fixnum (()
2709                                              ((a :lisp)
2710                                               (dest :label)))
2711  ((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
2712   (testb (:$b x8632::fixnummask) (:%b a)))
2713  ((:pred > (:apply %hard-regspec-value a) x8632::ebx)
2714   (testl (:$l x8632::fixnummask) (:%l a)))
2715  (jne dest))
2716
2717(define-x8632-vinsn fixnum->single-float (((f :single-float))
2718                                          ((arg :lisp))
2719                                          ((unboxed :s32)))
2720  (movl (:%l arg) (:%l unboxed))
2721  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
2722  (cvtsi2ssl (:%l unboxed) (:%xmm f)))
2723
2724(define-x8632-vinsn fixnum->double-float (((f :double-float))
2725                                          ((arg :lisp))
2726                                          ((unboxed :s32)))
2727  (movl (:%l arg) (:%l unboxed))
2728  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
2729  (cvtsi2sdl (:%l unboxed) (:%xmm f)))
2730
2731(define-x8632-vinsn xchg-registers (()
2732                                    ((a t)
2733                                     (b t)))
2734  (xchgl (:%l a) (:%l b)))
2735
2736(define-x8632-vinsn establish-fn (()
2737                                  ())
2738  (movl (:$self 0) (:%l x8632::fn)))
2739
2740(define-x8632-vinsn %scharcode32 (((code :imm))
2741                                  ((str :lisp)
2742                                   (idx :imm))
2743                                  ((imm :u32)))
2744  (movl (:@ x8632::misc-data-offset (:%l str) (:%l idx)) (:%l imm))
2745  (imull (:$b x8632::fixnumone) (:%l imm) (:%l code)))
2746
2747(define-x8632-vinsn %set-scharcode32 (()
2748                                      ((str :lisp)
2749                                       (idx :imm)
2750                                       (code :imm))
2751                                      ((imm :u32)))
2752  (movl (:%l code) (:%l imm))
2753  (shrl (:$ub x8632::fixnumshift) (:%l imm))
2754  (movl (:%l imm) (:@ x8632::misc-data-offset (:%l str) (:%l idx))))
2755
2756
2757(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
2758
2759(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
2760
2761
2762(define-x8632-vinsn character->code (((dest :u32))
2763                                     ((src :lisp)))
2764  (movl (:%l src) (:%l dest))
2765  (sarl (:$ub x8632::charcode-shift) (:%l dest)))
2766
2767(define-x8632-vinsn adjust-vsp (()
2768                                ((amount :s32const)))
2769  ((:and (:pred >= amount -128) (:pred <= amount 127))
2770   (addl (:$b amount) (:%l x8632::esp)))
2771  ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
2772   (addl (:$l amount) (:%l x8632::esp))))
2773
2774
2775(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
2776                                                          ((spno :s32const)
2777                                                           (y t)
2778                                                           (z t))
2779                                                          ((entry (:label 1))))
2780  (:talign 5)
2781  (call (:@ spno))
2782  (movl (:$self 0) (:%l x8632::fn)))
2783
2784(define-x8632-vinsn %symbol->symptr (((dest :lisp))
2785                                     ((src :lisp))
2786                                     ((tag :u8)))
2787  :resume
2788  (cmpl (:$l (:apply target-nil-value)) (:%l src))
2789  (je :nilsym)
2790  (movl (:%l src) (:%l tag))
2791  (andl (:$b x8632::tagmask) (:%l tag))
2792  (cmpl (:$b x8632::tag-misc) (:%l tag))
2793  (jne :bad)
2794  (movsbl (:@ x8632::misc-subtag-offset (:%l src)) (:%l tag))
2795  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
2796  (jne :bad)
2797  ((:not (:pred =
2798                (:apply %hard-regspec-value dest)
2799                (:apply %hard-regspec-value src)))
2800   (movl (:% src) (:% dest)))
2801  (jmp :ok)
2802  :nilsym
2803  (movl (:$l (:apply + (:apply target-nil-value) x8632::nilsym-offset)) (:%l dest))
2804  :ok
2805 
2806  (:anchored-uuo-section :resume)
2807  :bad
2808  (:anchored-uuo (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-symbol))))
2809
2810(define-x8632-vinsn single-float-bits (((dest :u32))
2811                                       ((src :lisp)))
2812  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest)))
2813
2814(define-x8632-vinsn zero-double-float-register (((dest :double-float))
2815                                                ())
2816  (movsd (:%xmm x8632::fpzero) (:%xmm dest)))
2817
2818(define-x8632-vinsn zero-single-float-register (((dest :single-float))
2819                                                ())
2820  (movss (:%xmm x8632::fpzero) (:%xmm dest)))
2821
2822(define-x8632-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
2823(define-x8632-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
2824(define-x8632-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
2825
2826
2827(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
2828
2829(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
2830                                               ((src :lisp))
2831                                               ((temp :u32)))
2832  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
2833  (shrl (:$ub x8632::num-subtag-bits) (:%l temp))
2834  (leal (:@ (:%l temp) 4) (:%l dest)))
2835
2836(define-x8632-vinsn %logior2 (((dest :imm))
2837                              ((x :imm)
2838                               (y :imm)))
2839  ((:pred =
2840          (:apply %hard-regspec-value x)
2841          (:apply %hard-regspec-value dest))
2842   (orl (:%l y) (:%l dest)))
2843  ((:not (:pred =
2844                (:apply %hard-regspec-value x)
2845                (:apply %hard-regspec-value dest)))
2846   ((:pred =
2847           (:apply %hard-regspec-value y)
2848           (:apply %hard-regspec-value dest))
2849    (orl (:%l x) (:%l dest)))
2850   ((:not (:pred =
2851                 (:apply %hard-regspec-value y)
2852                 (:apply %hard-regspec-value dest)))
2853    (movl (:%l x) (:%l dest))
2854    (orl (:%l y) (:%l dest)))))
2855
2856(define-x8632-vinsn %logand2 (((dest :imm))
2857                              ((x :imm)
2858                               (y :imm)))
2859  ((:pred =
2860          (:apply %hard-regspec-value x)
2861          (:apply %hard-regspec-value dest))
2862   (andl (:%l y) (:%l dest)))
2863  ((:not (:pred =
2864                (:apply %hard-regspec-value x)
2865                (:apply %hard-regspec-value dest)))
2866   ((:pred =
2867           (:apply %hard-regspec-value y)
2868           (:apply %hard-regspec-value dest))
2869    (andl (:%l x) (:%l dest)))
2870   ((:not (:pred =
2871                 (:apply %hard-regspec-value y)
2872                 (:apply %hard-regspec-value dest)))
2873    (movl (:%l x) (:%l dest))
2874    (andl (:%l y) (:%l dest)))))
2875
2876(define-x8632-vinsn %logxor2 (((dest :imm))
2877                              ((x :imm)
2878                               (y :imm)))
2879  ((:pred =
2880          (:apply %hard-regspec-value x)
2881          (:apply %hard-regspec-value dest))
2882   (xorl (:%l y) (:%l dest)))
2883  ((:not (:pred =
2884                (:apply %hard-regspec-value x)
2885                (:apply %hard-regspec-value dest)))
2886   ((:pred =
2887           (:apply %hard-regspec-value y)
2888           (:apply %hard-regspec-value dest))
2889    (xorl (:%l x) (:%l dest)))
2890   ((:not (:pred =
2891                 (:apply %hard-regspec-value y)
2892                 (:apply %hard-regspec-value dest)))
2893    (movl (:%l x) (:%l dest))
2894    (xorl (:%l y) (:%l dest)))))
2895
2896
2897(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
2898
2899(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
2900
2901(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
2902
2903(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
2904
2905(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
2906
2907(define-x8632-subprim-lea-jmp-vinsn (make-stack-gvector)  .SPstkgvector)
2908
2909(define-x8632-vinsn load-character-constant (((dest :lisp))
2910                                             ((code :u32const))
2911                                             ())
2912  (movl (:$l (:apply logior (:apply ash code 8) x8632::subtag-character))
2913        (:%l dest)))
2914
2915
2916(define-x8632-vinsn setup-single-float-allocation (()
2917                                                   ())
2918  (movl (:$l (arch::make-vheader x8632::single-float.element-count x8632::subtag-single-float)) (:%l x8632::imm0))
2919  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2920  (movl (:$l (- x8632::single-float.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2921 
2922(define-x8632-vinsn setup-double-float-allocation (()
2923                                                   ())
2924  (movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
2925  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2926  (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2927
2928(define-x8632-vinsn set-single-float-value (()
2929                                            ((node :lisp)
2930                                             (val :single-float)))
2931  (movss (:%xmm val) (:@ x8632::single-float.value (:%l node))))
2932
2933(define-x8632-vinsn set-double-float-value (()
2934                                            ((node :lisp)
2935                                             (val :double-float)))
2936  (movsd (:%xmm val) (:@ x8632::double-float.value (:%l node))))
2937
2938(define-x8632-vinsn word-index-and-bitnum-from-index (((word-index :u32)
2939                                                       (bitnum :u8))
2940                                                      ((index :imm)))
2941  (movl (:%l index) (:%l word-index))
2942  (shrl (:$ub x8632::fixnumshift) (:%l word-index))
2943  (movl (:$l 31) (:%l bitnum))
2944  (andl (:%l word-index) (:%l bitnum))
2945  (shrl (:$ub 5) (:%l word-index)))
2946
2947(define-x8632-vinsn ref-bit-vector-fixnum (((dest :imm)
2948                                            (bitnum :u8))
2949                                           ((bitnum :u8)
2950                                            (bitvector :lisp)
2951                                            (word-index :u32)))
2952  (btl (:%l bitnum) (:@ x8632::misc-data-offset (:%l bitvector) (:%l word-index) 4))
2953  (setb (:%b bitnum))
2954  (negb (:%b bitnum))
2955  (andl (:$l x8632::fixnumone) (:%l bitnum))
2956  (movl (:%l bitnum) (:%l dest)))
2957
2958(define-x8632-vinsn nref-bit-vector-fixnum (((dest :imm)
2959                                             (bitnum :s32))
2960                                            ((bitnum :s32)
2961                                             (bitvector :lisp))
2962                                            ())
2963  (btl (:%l bitnum) (:@ x8632::misc-data-offset (:%l bitvector)))
2964  (setc (:%b bitnum))
2965  (movzbl (:%b bitnum) (:%l bitnum))
2966  (imull (:$b x8632::fixnumone) (:%l bitnum) (:%l dest)))
2967
2968(define-x8632-vinsn nref-bit-vector-flags (()
2969                                           ((bitnum :s32)
2970                                            (bitvector :lisp))
2971                                           ())
2972  (btl (:%l bitnum) (:@ x8632::misc-data-offset (:%l bitvector))))
2973
2974(define-x8632-vinsn misc-ref-c-bit-fixnum (((dest :imm))
2975                                           ((src :lisp)
2976                                            (idx :u32const))
2977                                           ((temp :u8)))
2978  (btl (:$ub (:apply logand 31 idx))
2979       (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2980  (setc (:%b temp))
2981  (movzbl (:%b temp) (:%l temp))
2982  (imull (:$b x8632::fixnumone) (:%l temp) (:%l dest)))
2983
2984(define-x8632-vinsn misc-ref-c-bit-flags (()
2985                                          ((src :lisp)
2986                                           (idx :u64const)))
2987  (btl (:$ub (:apply logand 31 idx))
2988       (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2989
2990(define-x8632-vinsn set-macptr-address (()
2991                                        ((addr :address)
2992                                         (src :lisp))
2993                                        ())
2994  (movl (:%l addr) (:@ x8632::macptr.address (:%l src))))
2995
2996(define-x8632-vinsn deref-macptr (((addr :address))
2997                                  ((src :lisp))
2998                                  ())
2999  (movl (:@ x8632::macptr.address (:%l src)) (:%l addr)))
3000
3001(define-x8632-vinsn setup-macptr-allocation (()
3002                                             ((src :address)))
3003  (movd (:%l src) (:%mmx x8632::mm1))   ;see %set-new-macptr-value, below
3004  (movl (:$l x8632::macptr-header) (:%l x8632::imm0))
3005  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
3006  (movl (:$l (- x8632::macptr.size x8632::fulltag-misc)) (:%l x8632::imm0)))
3007
3008(define-x8632-vinsn %set-new-macptr-value (()
3009                                           ((ptr :lisp)))
3010  (movd (:%mmx x8632::mm1) (:@ x8632::macptr.address (:%l ptr))))
3011
3012(define-x8632-vinsn mem-ref-natural (((dest :u32))
3013                                     ((src :address)
3014                                      (index :s32)))
3015  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
3016
3017(define-x8632-vinsn mem-ref-c-fullword (((dest :u32))
3018                                        ((src :address)
3019                                         (index :s32const)))
3020  ((:pred = index 0)
3021   (movl (:@ (:%l src)) (:%l dest)))
3022  ((:not (:pred = index 0))
3023   (movl (:@ index (:%l src)) (:%l dest))))
3024
3025(define-x8632-vinsn mem-ref-c-signed-fullword (((dest :s32))
3026                                               ((src :address)
3027                                                (index :s32const)))
3028  ((:pred = index 0)
3029   (movl (:@ (:%l src)) (:%l dest)))
3030  ((:not (:pred = index 0))
3031   (movl (:@ index (:%l src)) (:%l dest))))
3032
3033(define-x8632-vinsn mem-ref-c-single-float (((dest :single-float))
3034                                            ((src :address)
3035                                             (index :s32const)))
3036  ((:pred = index 0)
3037   (movss (:@ (:%l src)) (:%xmm dest)))
3038  ((:not (:pred = index 0))
3039   (movss (:@ index (:%l src)) (:%xmm dest))))
3040
3041(define-x8632-vinsn mem-set-c-single-float (()
3042                                            ((val :single-float)
3043                                             (src :address)
3044                                             (index :s16const)))
3045  ((:pred = index 0)
3046   (movss (:%xmm val) (:@ (:%l src))))
3047  ((:not (:pred = index 0))
3048   (movss (:%xmm val) (:@ index (:%l src)))))
3049
3050(define-x8632-vinsn mem-ref-c-natural (((dest :u32))
3051                                       ((src :address)
3052                                        (index :s32const)))
3053  ((:pred = index 0)
3054   (movl (:@ (:%l src)) (:%l dest)))
3055  ((:not (:pred = index 0))
3056   (movl (:@ index (:%l src)) (:%l dest))))
3057
3058(define-x8632-vinsn mem-ref-c-double-float (((dest :double-float))
3059                                            ((src :address)
3060                                             (index :s32const)))
3061  ((:pred = index 0)
3062   (movsd (:@ (:%l src)) (:%xmm dest)))
3063  ((:not (:pred = index 0))
3064   (movsd (:@ index (:%l src)) (:%xmm dest))))
3065
3066(define-x8632-vinsn mem-set-c-double-float (()
3067                                            ((val :double-float)
3068                                             (src :address)
3069                                             (index :s32const)))
3070  ((:pred = index 0)
3071   (movsd (:%xmm val) (:@ (:%l src))))
3072  ((:not (:pred = index 0))
3073   (movsd (:%xmm val) (:@ index (:%l src)))))
3074
3075(define-x8632-vinsn mem-ref-fullword (((dest :u32))
3076                                      ((src :address)
3077                                       (index :s32)))
3078  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
3079
3080(define-x8632-vinsn mem-ref-signed-fullword (((dest :s32))
3081                                             ((src :address)
3082                                              (index :s32)))
3083  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
3084
3085(define-x8632-vinsn macptr->stack (((dest :lisp))
3086                                   ((ptr :address))
3087                                   ((temp :imm)))
3088  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3089  (subl (:$b (+ 8 x8632::macptr.size)) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3090  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3091  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3092  (movl (:%l x8632::ebp) (:@ 4 (:%l temp)))
3093  (leal (:@ (+ 8 x8632::fulltag-misc) (:%l  temp)) (:%l dest))
3094  (movl (:$l x8632::macptr-header) (:@ x8632::macptr.header (:%l dest)))
3095  (movl (:%l ptr) (:@ x8632::macptr.address (:%l dest)))
3096  (movsd (:%xmm x8632::fpzero)  (:@ x8632::macptr.domain (:%l dest))))
3097
3098(define-x8632-vinsn fixnum->signed-natural (((dest :s32))
3099                                            ((src :imm)))
3100  (movl (:%l src) (:%l dest))
3101  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
3102
3103(define-x8632-vinsn fixnum->unsigned-natural (((dest :u32))
3104                                              ((src :imm)))
3105  (movl (:%l src) (:%l dest))
3106  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
3107
3108(define-x8632-vinsn mem-set-double-float (()
3109                                          ((val :double-float)
3110                                           (src :address)
3111                                           (index :s32)))
3112  (movsd (:%xmm val) (:@ (:%l src) (:%l index))))
3113
3114(define-x8632-vinsn mem-set-single-float (()
3115                                          ((val :single-float)
3116                                           (src :address)
3117                                           (index :s32)))
3118  (movss (:%xmm val) (:@ (:%l src) (:%l index))))
3119
3120(define-x8632-vinsn mem-set-c-fullword (()
3121                                          ((val :u32)
3122                                           (dest :address)
3123                                           (offset :s32const)))
3124  ((:pred = offset 0)
3125   (movl (:%l val) (:@ (:%l dest))))
3126  ((:not (:pred = offset 0))
3127   (movl (:%l val) (:@ offset (:%l dest)))))
3128
3129(define-x8632-vinsn mem-set-bit-variable-value (((src :address))
3130                                                ((src :address)
3131                                                 (offset :lisp)
3132                                                 (value :lisp))
3133                                                ((temp :lisp)))
3134  ;; (mark-as-imm temp)
3135  (btrl (:$ub (:apply %hard-regspec-value temp))
3136        (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask))
3137  (movl (:%l offset) (:%l temp))
3138  (shrl (:$ub (+ 5 x8632::fixnumshift)) (:%l temp))
3139  (leal (:@ (:%l src) (:%l temp) 4) (:%l src))
3140  (movl (:%l offset) (:%l temp))
3141  (shrl (:$ub x8632::fixnumshift) (:%l temp))
3142  (andl (:$l 31) (:%l temp))
3143  (testl (:%l value) (:%l value))
3144  (jne :set)
3145  (btrl (:%l temp) (:@ (:%l src)))
3146  (jmp :done)
3147  :set
3148  (btsl (:%l temp) (:@ (:%l src)))
3149  :done
3150  ;; (mark-as-node temp)
3151  (xorl (:%l temp) (:%l temp))
3152  (btsl (:$ub (:apply %hard-regspec-value temp))
3153        (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
3154
3155
3156(define-x8632-vinsn mem-set-c-bit-variable-value (()
3157                                                  ((src :address)
3158                                                   (offset :s32const)
3159                                                   (value :lisp)))
3160  (testl (:%l value) (:%l value))
3161  (jne :set)
3162  ((:pred = 0 (:apply ash offset -5))
3163   (btrl (:$ub (:apply logand 31 offset))
3164        (:@  (:%l src))))
3165  ((:not (:pred = 0 (:apply ash offset -5)))
3166   (btrl (:$ub (:apply logand 31 offset))
3167         (:@ (:apply ash (:apply ash offset -5) 4) (:%l src))))
3168  (jmp :done)
3169  :set
3170  ((:pred = 0 (:apply ash offset -5))
3171   (btsl (:$ub (:apply logand 31 offset))
3172         (:@  (:%l src))))
3173  ((:not (:pred = 0 (:apply ash offset -5)))
3174   (btsl (:$ub (:apply logand 31 offset))
3175         (:@ (:apply ash (:apply ash offset -5) 2) (:%l src))))
3176  :done)
3177
3178(define-x8632-vinsn %natural+  (((result :u32))
3179                               ((result :u32)
3180                                (other :u32)))
3181  (addl (:%l other) (:%l result)))
3182
3183(define-x8632-vinsn %natural+-c (((result :u32))
3184                                ((result :u32)
3185                                 (constant :u32const)))
3186  (addl (:$l (:apply unsigned-to-signed constant 32)) (:%l result)))
3187
3188(define-x8632-vinsn %natural-  (((result :u32))
3189                                ((result :u32)
3190                                 (other :u32)))
3191  (subl (:%l other) (:%l result)))
3192
3193(define-x8632-vinsn %natural--c (((result :u32))
3194                                ((result :u32)
3195                                 (constant :u32const)))
3196  (subl (:$l (:apply unsigned-to-signed constant 32)) (:%l result)))
3197
3198(define-x8632-vinsn %natural-logior (((result :u32))
3199                                    ((result :u32)
3200                                     (other :u32)))
3201  (orl (:%l other) (:%l result)))
3202
3203(define-x8632-vinsn %natural-logior-c (((result :u32))
3204                                      ((result :u32)
3205                                       (constant :u32const)))
3206  (orl (:$l (:apply unsigned-to-signed constant 32)) (:%l result)))
3207
3208(define-x8632-vinsn %natural-logand (((result :u32))
3209                                    ((result :u32)
3210                                     (other :u32)))
3211  (andl (:%l other) (:%l result)))
3212
3213(define-x8632-vinsn %natural-logand-c (((result :u32))
3214                                      ((result :u32)
3215                                       (constant :u32const)))
3216  (andl (:$l (:apply unsigned-to-signed constant 32)) (:%l result)))
3217
3218(define-x8632-vinsn %natural-logxor (((result :u32))
3219                                    ((result :u32)
3220                                     (other :u32)))
3221  (xorl (:%l other) (:%l result)))
3222
3223(define-x8632-vinsn %natural-logxor-c (((result :u32))
3224                                       ((result :u32)
3225                                        (constant :u32const)))
3226  (xorl (:$l (:apply unsigned-to-signed constant 32)) (:%l result)))
3227
3228(define-x8632-vinsn natural-shift-left (((dest :u32))
3229                                        ((dest :u32)
3230                                         (amt :u8const)))
3231  (shll (:$ub amt) (:%l dest)))
3232
3233(define-x8632-vinsn natural-shift-right (((dest :u32))
3234                                         ((dest :u32)
3235                                          (amt :u8const)))
3236  (shrl (:$ub amt) (:%l dest)))
3237
3238(define-x8632-vinsn recover-fn (()
3239                                ())
3240  (movl (:$self 0) (:%l x8632::fn)))
3241
3242;;; xxx probably wrong
3243(define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
3244                                                          ((spno :s32const)
3245                                                           (x t)
3246                                                           (y t)
3247                                                           (z t))
3248                                                          ((entry (:label 1))))
3249  (:talign 5)
3250  (call (:@ spno))
3251  (movl (:$self 0) (:%l x8632::fn)))
3252
3253(define-x8632-vinsn vcell-ref (((dest :lisp))
3254                               ((vcell :lisp)))
3255  (movl (:@ x8632::misc-data-offset (:%l vcell)) (:%l dest)))
3256
3257(define-x8632-vinsn setup-vcell-allocation (()
3258                                            ())
3259  (movl (:$l x8632::value-cell-header) (:%l x8632::imm0))
3260  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
3261  (movl (:$l (- x8632::value-cell.size x8632::fulltag-misc)) (:%l x8632::imm0)))
3262
3263(define-x8632-vinsn %init-vcell (()
3264                                 ((vcell :lisp)
3265                                  (closed :lisp)))
3266  (movl (:%l closed) (:@ x8632::value-cell.value (:%l vcell))))
3267
3268;;; "old" mkunwind.  Used by PROGV, since the binding of *interrupt-level*
3269;;; on entry to the new mkunwind confuses the issue.
3270
3271(define-x8632-vinsn (mkunwind :call :subprim-call) (()
3272                                                     ((protform-lab :label)
3273                                                      (cleanup-lab :label)))
3274  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
3275  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
3276  (jmp (:@ .SPmkunwind)))
3277
3278;;; Funcall the function or symbol in temp0 and obtain the single
3279;;; value that it returns.
3280(define-x8632-subprim-call-vinsn (funcall) .SPfuncall)
3281
3282(define-x8632-vinsn tail-funcall (()
3283                                  ()
3284                                  ((tag :u8)))
3285  :resume
3286  (movl (:%l x8632::temp0) (:%l tag))
3287  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
3288   (andl (:$b x8632::tagmask) (:%accl tag))
3289   (cmpl (:$b x8632::tag-misc) (:%accl tag)))
3290  ((:pred > (:apply %hard-regspec-value tag) x8632::eax)
3291   (andl (:$b x8632::tagmask) (:%l tag))
3292   (cmpl (:$b x8632::tag-misc) (:%l tag)))
3293  (jne :bad)
3294  (movsbl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
3295  (cmpl (:$b x8632::subtag-function) (:%l tag))
3296  (je :go)
3297  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
3298  (cmovel (:@ x8632::symbol.fcell (:%l x8632::temp0)) (:%l x8632::temp0))
3299  (jne :bad)
3300  :go
3301  (jmp (:%l x8632::temp0))
3302
3303  (:anchored-uuo-section :resume)
3304  :bad
3305  (:anchored-uuo (uuo-error-not-callable)))
3306
3307;;; Magic numbers in here include the address of .SPcall-closure.
3308
3309;;; movl $self, %fn
3310;;; jmp *20660 (.SPcall-closure)
3311(define-x8632-vinsn init-nclosure (()
3312                                   ((closure :lisp)))
3313  (movb (:$b 6) (:@ x8632::misc-data-offset (:%l closure))) ;imm word count
3314  (movb (:$b #xbf) (:@ (+ x8632::misc-data-offset 2) (:%l closure))) ;movl $self, %fn
3315  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 3) (:%l closure)))
3316  (movb (:$b #xff) (:@ (+ x8632::misc-data-offset 7) (:%l closure))) ;jmp
3317  (movl (:$l #x0150b425) (:@ (+ x8632::misc-data-offset 8) (:%l closure))) ;.SPcall-closure
3318  ;; already aligned
3319  ;; (movl ($ 0) (:@ (+ x8632::misc-data-offset 12))) ;"end" of self-references
3320  (movb (:$b 7) (:@ (+ x8632::misc-data-offset 16) (:%l closure))) ;self-reference offset
3321  (movb (:$b x8632::function-boundary-marker) (:@ (+ x8632::misc-data-offset 20) (:%l closure))))
3322
3323(define-x8632-vinsn finalize-closure (((closure :lisp))
3324                                      ((closure :lisp)))
3325  (nop))
3326
3327
3328(define-x8632-vinsn (ref-symbol-value :call :subprim-call)
3329    (((val :lisp))
3330     ((sym (:lisp (:ne val)))))
3331  (:talign 5)
3332  (call (:@ .SPspecrefcheck))
3333  (movl (:$self 0) (:%l x8632::fn)))
3334
3335(define-x8632-vinsn ref-symbol-value-inline (((dest :lisp))
3336                                             ((src (:lisp (:ne dest))))
3337                                             ((table :imm)
3338                                              (idx :imm)))
3339  :resume
3340  (movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
3341  (rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
3342  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l table))
3343  (jae :symbol)
3344  (movl (:@ (:%l table) (:%l idx)) (:%l dest))
3345  (cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
3346  (jne :test)
3347  :symbol
3348  (movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
3349  :test
3350  (cmpl (:$l x8632::unbound-marker) (:%l dest))
3351  (je :bad)
3352
3353  (:anchored-uuo-section :resume)
3354  :bad
3355  (:anchored-uuo (uuo-error-unbound (:%l src))))
3356
3357(define-x8632-vinsn (%ref-symbol-value :call :subprim-call)
3358    (((val :lisp))
3359     ((sym (:lisp (:ne val)))))
3360  (:talign 5)
3361  (call (:@ .SPspecref))
3362  (movl (:$self 0) (:%l x8632::fn)))
3363
3364(define-x8632-vinsn %ref-symbol-value-inline (((dest :lisp))
3365                                              ((src (:lisp (:ne dest))))
3366                                              ((table :imm)
3367                                               (idx :imm)))
3368  (movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
3369  (rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
3370  (jae :symbol)
3371  (addl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l idx))
3372  (movl (:@ (:%l idx)) (:%l dest))
3373  (cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
3374  (jne :done)
3375  :symbol
3376  (movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
3377  :done)
3378
3379(define-x8632-vinsn ref-interrupt-level (((dest :imm))
3380                                         ()
3381                                         ((temp :u32)))
3382  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
3383  (movl (:@ x8632::interrupt-level-binding-index (:%l temp)) (:%l dest)))
3384
3385(define-x8632-subprim-lea-jmp-vinsn (bind-nil)  .SPbind-nil)
3386
3387(define-x8632-subprim-lea-jmp-vinsn (bind-self)  .SPbind-self)
3388
3389(define-x8632-subprim-lea-jmp-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
3390
3391(define-x8632-subprim-lea-jmp-vinsn (bind)  .SPbind)
3392
3393(define-x8632-vinsn (dpayback :call :subprim-call) (()
3394                                                    ((n :s16const))
3395                                                    ((temp (:u32 #.x8632::imm0))
3396                                                     (entry (:label 1))))
3397  ((:pred > n 0)
3398   ((:pred > n 1)
3399    (movl (:$l n) (:%l temp))
3400    (:talign 5)
3401    (call (:@ .SPunbind-n)))
3402   ((:pred = n 1)
3403    (:talign 5)
3404    (call (:@ .SPunbind)))
3405   (movl (:$self 0) (:%l x8632::fn))))
3406
3407(define-x8632-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
3408
3409(define-x8632-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
3410
3411(define-x8632-vinsn node-slot-ref  (((dest :lisp))
3412                                    ((node :lisp)
3413                                     (cellno :u32const)))
3414  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash cellno 2))
3415            (:%l node)) (:%l dest)))
3416
3417(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list)  .SPstkconslist)
3418
3419(define-x8632-vinsn save-lexpr-argregs (()
3420                                        ((min-fixed :u16const)))
3421  ((:pred >= min-fixed $numx8632argregs)
3422   (pushl (:%l x8632::arg_y))
3423   (pushl (:%l x8632::arg_z)))
3424  ((:pred = min-fixed 1)                ; at least one arg
3425   (rcmpl (:%l x8632::nargs) (:$b (ash 1 x8632::word-shift)))
3426   (je :z1)                             ;skip arg_y if exactly 1
3427   (pushl (:%l x8632::arg_y))
3428   :z1
3429   (pushl (:%l x8632::arg_z)))
3430  ((:pred = min-fixed 0)
3431   (rcmpl (:%l x8632::nargs) (:$b (ash 1 x8632::word-shift)))
3432   (je :z0)                             ;exactly one
3433   (jl :none)                           ;none
3434                                        ;two or more...
3435   (pushl (:%l x8632::arg_y))
3436   :z0
3437   (pushl (:%l x8632::arg_z))
3438   :none
3439   )
3440  ((:not (:pred = min-fixed 0))
3441   (leal (:@ (:apply - (:apply ash min-fixed x8632::word-shift)) (:%l x8632::nargs))
3442         (:%l x8632::nargs)))
3443  (pushl (:%l x8632::nargs))
3444  (movl (:%l x8632::esp) (:%l x8632::arg_z)))
3445
3446;;; The frame that was built (by SAVE-LISP-CONTEXT-VARIABLE-ARG-COUNT
3447;;; and SAVE-LEXPR-ARGREGS) contains an unknown number of arguments
3448;;; followed by the count of non-required arguments; the count is on
3449;;; top of the stack and its address is in %arg_z.  We need to build a
3450;;; frame so that the function can address its arguments (copies of
3451;;; the required arguments and the lexpr) and locals; when the
3452;;; function returns, it should one or more values (depending on how
3453;;; it was called) and discard the hidden lexpr frame.  At this point,
3454;;; %ra0 still contains the "real" return address. If it's not the
3455;;; magic multiple-value address, we can make the function return to
3456;;; something that does a single-value return (.SPpopj); otherwise, we
3457;;; need to make it return multiple values to the real caller. (Unlike
3458;;; the PPC, this case only involves creating one frame here, but that
3459;;; frame has two return addresses.)
3460(define-x8632-vinsn build-lexpr-frame (()
3461                                       ()
3462                                       ((temp :imm)
3463                                        (ra0 (:lisp #.x8632::ra0))))
3464  (movl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::ret1valaddr)))
3465        (:%l temp))
3466  (cmpl (:%l temp) (:%l ra0))
3467  (je :multiple)
3468  (pushl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::lexpr-return1v))))
3469  (jmp :finish)
3470  :multiple
3471  (pushl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::lexpr-return))))
3472  (pushl (:%l temp))
3473  :finish
3474  (pushl (:%l x8632::ebp))
3475  (movl (:%l x8632::esp) (:%l x8632::ebp)))
3476
3477(define-x8632-vinsn copy-lexpr-argument (()
3478                                         ((n :u16const))
3479                                         ((temp :imm)))
3480  (movl (:@ (:%l x8632::arg_z)) (:%l temp))
3481  (pushl (:@ (:apply ash n x8632::word-shift) (:%l x8632::arg_z) (:%l temp))))
3482
3483(define-x8632-vinsn %current-tcr (((dest :lisp))
3484                                 ())
3485  (movl (:@ (:%seg :rcontext) x8632::tcr.linear) (:%l dest)))
3486
3487(define-x8632-vinsn (setq-special :call :subprim-call)
3488    (()
3489     ((sym :lisp)
3490      (val :lisp))
3491     ((entry (:label 1))))
3492  (:talign 5)
3493  (call (:@ .SPspecset))
3494  (movl (:$self 0) (:%l x8632::fn)))
3495
3496(define-x8632-vinsn pop-argument-registers (()
3497                                            ())
3498  (testl (:%l x8632::nargs) (:%l x8632::nargs))
3499  (je :done)
3500  (rcmpl (:%l x8632::nargs) (:$l (ash 1 x8632::word-shift)))
3501  (popl (:%l x8632::arg_z))
3502  (je :done)
3503  (popl (:%l x8632::arg_y))
3504  :done)
3505
3506(define-x8632-vinsn %symptr->symvector (((target :lisp))
3507                                        ((target :lisp)))
3508  (nop))
3509
3510(define-x8632-vinsn %symvector->symptr (((target :lisp))
3511                                        ((target :lisp)))
3512  (nop))
3513
3514(define-x8632-subprim-lea-jmp-vinsn (spread-lexpr)  .SPspread-lexpr-z)
3515
3516(define-x8632-vinsn mem-ref-double-float (((dest :double-float))
3517                                          ((src :address)
3518                                           (index :s32)))
3519  (movsd (:@ (:%l src) (:%l index)) (:%xmm dest)))
3520
3521(define-x8632-vinsn mem-ref-single-float (((dest :single-float))
3522                                          ((src :address)
3523                                           (index :s32)))
3524  (movss (:@ (:%l src) (:%l index)) (:%xmm dest)))
3525
3526;;; This would normally be put in %nargs, but we need an
3527;;; extra node register for passing stuff into
3528;;; SPdestructuring_bind and friends.
3529(define-x8632-vinsn load-adl (()
3530                              ((n :u32const)))
3531  (movl (:$l n) (:%l x8632::imm0)))
3532
3533(define-x8632-subprim-lea-jmp-vinsn (macro-bind) .SPmacro-bind)
3534
3535(define-x8632-subprim-lea-jmp-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
3536
3537(define-x8632-subprim-lea-jmp-vinsn  (destructuring-bind) .SPdestructuring-bind)
3538
3539
3540(define-x8632-vinsn symbol-function (((val :lisp))
3541                                     ((sym (:lisp (:ne val))))
3542                                     ((tag :u8)))
3543  :resume
3544  (movl (:@ x8632::symbol.fcell (:%l sym)) (:%l val))
3545  (movl (:%l val) (:%l tag))
3546  (andl (:$b x8632::tagmask) (:%l tag))
3547  (cmpl (:$b x8632::tag-misc) (:%l tag))
3548  (jne :bad)
3549  (movsbl (:@ x8632::misc-subtag-offset (:%l val)) (:%l tag))
3550  (cmpl (:$b x8632::subtag-function) (:%l tag))
3551  (jne :bad)
3552
3553  (:anchored-uuo-section :resume)
3554  :bad
3555  (:anchored-uuo (uuo-error-udf (:%l sym))))
3556
3557(define-x8632-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
3558
3559(define-x8632-vinsn load-double-float-constant (((dest :double-float))
3560                                                ((lab :label)))
3561  (movsd (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
3562
3563(define-x8632-vinsn load-single-float-constant (((dest :single-float))
3564                                                ((lab :label)))
3565  (movss (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
3566
3567(define-x8632-subprim-call-vinsn (misc-set) .SPmisc-set)
3568
3569(define-x8632-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
3570
3571(define-x8632-subprim-lea-jmp-vinsn (spread-list)  .SPspreadargz)
3572
3573;;; Even though it's implemented by calling a subprim, THROW is really
3574;;; a JUMP (to a possibly unknown destination).  If the destination's
3575;;; really known, it should probably be inlined (stack-cleanup, value
3576;;; transfer & jump ...)
3577(define-x8632-vinsn (throw :jump-unknown) (()
3578                                                 ()
3579                                                 ((entry (:label 1))
3580                                                  (ra (:lisp #.x8632::ra0))))
3581  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l ra))
3582  (:talign 5)
3583  (jmp (:@ .SPthrow))
3584  :back
3585  (movl (:$self 0) (:%l x8632::fn))
3586  (uuo-error-reg-not-tag (:%l x8632::temp0) (:$ub x8632::subtag-catch-frame)))
3587
3588(define-x8632-vinsn unbox-base-char (((dest :u32))
3589                                     ((src :lisp)))
3590  (movl (:%l src) (:%l dest))
3591  ((:pred = (:apply %hard-regspec-value dest) x8632::eax)
3592   (cmpb (:$b x8632::subtag-character) (:%accb dest)))
3593  ((:and (:pred > (:apply %hard-regspec-value dest) x8632::eax)
3594         (:pred <= (:apply %hard-regspec-value dest) x8632::ebx))
3595   (cmpb (:$b x8632::subtag-character) (:%b dest)))
3596  ((:pred > (:apply %hard-regspec-value dest) x8632::ebx)
3597   ;; very rare case, if even possible...
3598   (andl (:$l #xff) (:%l dest))
3599   (cmpl (:$b x8632::subtag-character) (:%l dest))
3600   (cmovel (:%l src) (:%l dest)))
3601  (je ::got-it)
3602  (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-character))
3603  :got-it
3604  (shrl (:$ub x8632::charcode-shift) (:%l dest)))
3605
3606(define-x8632-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
3607
3608(define-x8632-subprim-lea-jmp-vinsn (recover-values)  .SPrecover-values)
3609
3610(define-x8632-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
3611
3612(define-x8632-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
3613
3614(define-x8632-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
3615
3616(define-x8632-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
3617
3618;;; "dest" is preallocated, presumably on a stack somewhere.
3619(define-x8632-vinsn store-single (()
3620                                  ((dest :lisp)
3621                                   (source :single-float))
3622                                  ())
3623  (movss (:%xmm source) (:@  x8632::single-float.value (:%l dest))))
3624
3625;;; "dest" is preallocated, presumably on a stack somewhere.
3626(define-x8632-vinsn store-double (()
3627                                  ((dest :lisp)
3628                                   (source :double-float))
3629                                  ())
3630  (movsd (:%xmm source) (:@  x8632::double-float.value (:%l dest))))
3631
3632(define-x8632-vinsn fixnum->char (((dest :lisp))
3633                                  ((src :imm))
3634                                  ((temp :u32)))
3635  (movl (:%l src) (:%l temp))
3636  (sarl (:$ub (+ x8632::fixnumshift 1)) (:%l temp))
3637  (cmpl (:$l (ash #xfffe -1)) (:%l temp))
3638  (je :bad-if-eq)
3639  (sarl (:$ub (- 11 1)) (:%l temp))
3640  (cmpl (:$b (ash #xd800 -11))(:%l temp))
3641  :bad-if-eq
3642  (movl (:$l (:apply target-nil-value)) (:%l temp))
3643  (cmovel (:%l temp) (:%l dest))
3644  (je :done)
3645  ((:not (:pred =
3646                (:apply %hard-regspec-value dest)
3647                (:apply %hard-regspec-value src)))
3648   (movl (:%l src) (:%l dest)))
3649  (shll (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest))
3650  (addl (:$b x8632::subtag-character) (:%l dest))
3651  :done)
3652
3653;;; src is known to be a code for which CODE-CHAR returns non-nil.
3654(define-x8632-vinsn code-char->char (((dest :lisp))
3655                                     ((src :imm))
3656                                     ())
3657  ((:not (:pred =
3658                (:apply %hard-regspec-value dest)
3659                (:apply %hard-regspec-value src)))
3660   (movl (:%l src) (:%l dest)))
3661  (shll (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest))
3662  (addl (:$b x8632::subtag-character) (:%l dest))
3663  :done)
3664
3665(define-x8632-vinsn sign-extend-halfword (((dest :imm))
3666                                          ((src :imm)))
3667  (movl (:%l src ) (:%l dest))
3668  (shll (:$ub (- 16 x8632::fixnumshift)) (:%l dest))
3669  (sarl (:$ub (- 16 x8632::fixnumshift)) (:%l dest)))
3670
3671(define-x8632-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
3672
3673(define-x8632-vinsn %init-gvector (()
3674                                   ((v :lisp)
3675                                    (nbytes :u32const))
3676                                   ((count :imm)))
3677  (movl (:$l nbytes) (:%l count))
3678  (jmp :test)
3679  :loop
3680  (popl (:@ x8632::misc-data-offset (:%l v) (:%l count)))
3681  :test
3682  (subl (:$b x8632::node-size) (:%l count))
3683  (jge :loop))
3684
3685(define-x8632-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
3686
3687(define-x8632-vinsn nth-value (((result :lisp))
3688                               ()
3689                               ((temp :u32)
3690                                (nargs (:lisp #.x8632::nargs))))
3691  (leal (:@ (:%l x8632::esp) (:%l x8632::nargs)) (:%l temp))
3692  (subl (:@ (:%l temp)) (:%l x8632::nargs))
3693  (movl (:$l (:apply target-nil-value)) (:%l result))
3694  (jle :done)
3695  ;; I -think- that a CMOV would be safe here, assuming that N wasn't
3696  ;; extremely large.  Don't know if we can assume that.
3697  (movl (:@ (- x8632::node-size) (:%l x8632::esp) (:%l x8632::nargs)) (:%l result))
3698  :done
3699  (leal (:@ x8632::node-size (:%l temp)) (:%l x8632::esp)))
3700
3701
3702(define-x8632-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
3703
3704(define-x8632-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
3705
3706(define-x8632-vinsn %debug-trap (()
3707                                 ())
3708  (uuo-error-debug-trap))
3709
3710(define-x8632-vinsn double-to-single (((result :single-float))
3711                                      ((arg :double-float)))
3712  (cvtsd2ss (:%xmm arg) (:%xmm result)))
3713
3714(define-x8632-vinsn single-to-double (((result :double-float))
3715                                      ((arg :single-float)))
3716  (cvtss2sd (:%xmm arg) (:%xmm result)))
3717
3718(define-x8632-vinsn alloc-c-frame (()
3719                                   ((nwords :u32const))
3720                                   ((temp :imm)))
3721  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3722  ;; Work around Apple bug number 6386516 (open stub may clobber stack)
3723  ;; by leaving an extra word of space in the parameter area.
3724  (subl (:$l (:apply ash (:apply 1+ nwords) x8632::word-shift))
3725        (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3726  ;; align stack to 16-byte boundary
3727  (andb (:$b -16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3728  (subl (:$b (* 2 x8632::node-size)) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3729  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3730  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3731  (movl (:% x8632::ebp) (:@ 4 (:%l temp))))
3732
3733(define-x8632-vinsn alloc-variable-c-frame (()
3734                                            ((nwords :imm))
3735                                            ((temp :imm)))
3736  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3737  ;; Work around Apple bug number 6386516 (open stub may clobber stack)
3738  ;; by leaving an extra word of space in the parameter area.
3739  ;; Note that nwords is a fixnum.
3740  (leal (:@ 4 (:%l nwords)) (:%l temp))
3741  (subl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3742  ;; align stack to 16-byte boundary
3743  (andb (:$b -16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3744  (subl (:$b (* 2 x8632::node-size)) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3745  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3746  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
3747  (movl (:% x8632::ebp) (:@ 4 (:%l temp))))
3748
3749(define-x8632-vinsn set-c-arg (()
3750                               ((arg :u32)
3751                                (offset :u32const))
3752                               ((temp :imm)))
3753  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3754  (movl (:%l arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp))))
3755
3756;;; This is a pretty big crock.
3757(define-x8632-vinsn set-c-arg-from-mm0 (()
3758                                        ((offset :u32const))
3759                                        ((temp :imm)))
3760  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3761  (movq (:%mmx x8632::mm0) (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp))))
3762
3763(define-x8632-vinsn eep.address (((dest t))
3764                                 ((src (:lisp (:ne dest )))))
3765  :resume
3766  (movl (:@ (+ (ash 1 x8632::word-shift) x8632::misc-data-offset) (:%l src))
3767        (:%l dest))
3768  (cmpl (:$l (:apply target-nil-value)) (:%l dest))
3769  (je :bad)
3770
3771  (:anchored-uuo-section :resume)
3772  :bad
3773  (:anchored-uuo (uuo-error-eep-unresolved (:%l src) (:%l dest))))
3774
3775(define-x8632-subprim-lea-jmp-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
3776
3777(define-x8632-subprim-lea-jmp-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
3778
3779(define-x8632-subprim-lea-jmp-vinsn (make-stack-vector)  .SPmkstackv)
3780
3781(define-x8632-vinsn %current-frame-ptr (((dest :imm))
3782                                        ())
3783  (movl (:%l x8632::ebp) (:%l dest)))
3784
3785(define-x8632-vinsn %foreign-stack-pointer (((dest :imm))
3786                                            ())
3787  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l dest)))
3788
3789
3790(define-x8632-vinsn  %slot-ref (((dest :lisp))
3791                                ((instance (:lisp (:ne dest)))
3792                                 (index :lisp)))
3793  (movl (:@ x8632::misc-data-offset (:%l instance) (:%l index)) (:%l dest))
3794  (cmpl (:$l x8632::slot-unbound-marker) (:%l dest))
3795  (je :bad)
3796  :resume
3797  (:anchored-uuo-section :resume)
3798  :bad
3799  (:anchored-uuo (uuo-error-slot-unbound (:%l dest) (:%l instance) (:%l index))))
3800
3801
3802
3803(define-x8632-vinsn symbol-ref (((dest :lisp))
3804                                ((src :lisp)
3805                                 (cellno :u32const)))
3806  (movl (:@ (:apply + (- x8632::node-size x8632::fulltag-misc)
3807                    (:apply ash cellno 2))
3808              (:%l src)) (:%l dest)))
3809
3810(define-x8632-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
3811                                          ((src :address)
3812                                           (offset :s32const))
3813                                          ((temp :imm)))
3814  ((:pred = 0 (:apply ash offset -5))
3815   (btl (:$ub (:apply logand 31 offset))
3816        (:@  (:%l src))))
3817  ((:not (:pred = 0 (:apply ash offset -5)))
3818   (btl (:$ub (:apply logand 31 offset))
3819        (:@ (:apply ash (:apply ash offset -5) 2) (:%l src))))
3820  (movl (:$l x8632::fixnumone) (:%l temp))
3821  (movl (:$l 0) (:%l dest))
3822  (cmovbl (:%l temp) (:%l dest)))
3823
3824(define-x8632-vinsn mem-ref-bit-fixnum (((dest :lisp)
3825                                         (src :address))
3826                                        ((src :address)
3827                                         (offset :lisp))
3828                                        ((temp :lisp)))
3829  ;; (mark-as-imm temp)
3830  (btrl (:$ub (:apply %hard-regspec-value temp))
3831        (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask))
3832  (movl (:%l offset) (:%l temp))
3833  (shrl (:$ub (+ 5 x8632::fixnumshift)) (:%l temp))
3834  (leal (:@ (:%l src) (:%l temp) 4) (:%l src))
3835  (movl (:%l offset) (:%l temp))
3836  (shrl (:$ub x8632::fixnumshift) (:%l temp))
3837  (andl (:$l 31) (:%l temp))
3838  (btl (:%l temp) (:@ (:%l src)))
3839  (movl (:$l x8632::fixnumone) (:%l temp))
3840  (leal (:@ (- x8632::fixnumone) (:%l temp)) (:%l dest))
3841  (cmovbl (:%l temp) (:%l dest))
3842  ;; (mark-as-node temp)
3843  (xorl (:%l temp) (:%l temp))
3844  (btsl (:$ub (:apply %hard-regspec-value temp))
3845        (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
3846
3847(define-x8632-subprim-call-vinsn (progvsave) .SPprogvsave)
3848
3849(define-x8632-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
3850
3851(define-x8632-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
3852
3853(define-x8632-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
3854
3855(define-x8632-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
3856
3857(define-x8632-vinsn set-high-halfword (()
3858                                       ((dest :imm)
3859                                        (n :s16const)))
3860  (orl (:$l (:apply ash n 16)) (:%l dest)))
3861
3862(define-x8632-vinsn scale-nargs (()
3863                                 ((nfixed :s16const)))
3864  ((:pred > nfixed 0)
3865   ((:pred < nfixed 32)
3866    (subl (:$b (:apply ash nfixed x8632::word-shift)) (:%l x8632::nargs)))
3867   ((:pred >= nfixed 32)
3868    (subl (:$l (:apply ash nfixed x8632::word-shift)) (:%l x8632::nargs)))))
3869
3870(define-x8632-vinsn opt-supplied-p (()
3871                                    ((num-opt :u16const))
3872                                    ((nargs (:u32 #.x8632::nargs))
3873                                     (imm :imm)))
3874  (xorl (:%l imm) (:%l imm))
3875  (movl (:$l (:apply target-nil-value)) (:%l x8632::arg_y))
3876  :loop
3877  (rcmpl (:%l imm) (:%l nargs))
3878  (movl (:%l x8632::arg_y) (:%l x8632::arg_z))
3879  (cmovll (:@ (+ x8632::t-offset x8632::symbol.vcell) (:%l x8632::arg_y)) (:%l  x8632::arg_z))
3880  (addl (:$b x8632::node-size) (:%l imm))
3881  (rcmpl (:%l imm) (:$l (:apply ash num-opt x8632::fixnumshift)))
3882  (pushl (:%l x8632::arg_z))
3883  (jne :loop))
3884
3885(define-x8632-vinsn one-opt-supplied-p (()
3886                                        ()
3887                                        ((temp :u32)))
3888  (testl (:%l x8632::nargs) (:%l x8632::nargs))
3889  (setne (:%b temp))
3890  (negb (:%b temp))
3891  (andl (:$b x8632::t-offset) (:%l temp))
3892  (addl (:$l (:apply target-nil-value)) (:%l temp))
3893  (pushl (:%l temp)))
3894
3895;; needs some love
3896(define-x8632-vinsn two-opt-supplied-p (()
3897                                        ())
3898  (rcmpl (:%l x8632::nargs) (:$b (:apply ash 2 x8632::word-shift)))
3899  (jge :two)
3900  (rcmpl (:%l x8632::nargs) (:$b (:apply ash 1 x8632::word-shift)))
3901  (je :one)
3902  ;; none
3903  (pushl (:$l (:apply target-nil-value)))
3904  (pushl (:$l (:apply target-nil-value)))
3905  (jmp :done)
3906  :one
3907  (pushl (:$l (:apply target-t-value)))
3908  (pushl (:$l (:apply target-nil-value)))
3909  (jmp :done)
3910  :two
3911  (pushl (:$l (:apply target-t-value)))
3912  (pushl (:$l (:apply target-t-value)))
3913  :done)
3914
3915(define-x8632-vinsn set-c-flag-if-constant-logbitp (()
3916                                                    ((bit :u8const)
3917                                                     (int :imm)))
3918  (btl (:$ub bit) (:%l int)))
3919
3920(define-x8632-vinsn set-c-flag-if-variable-logbitp (()
3921                                                    ((bit :imm)
3922                                                     (int :imm))
3923                                                    ((temp :u32)))
3924  (movl (:%l bit) (:%l temp))
3925  (sarl (:$ub x8632::fixnumshift) (:%l temp))
3926  (addl (:$b x8632::fixnumshift) (:%l temp))
3927  ;; Would be nice to use a cmov here, but the branch is probably
3928  ;; cheaper than trying to scare up an additional unboxed temporary.
3929  (cmpb (:$ub 31) (:%b temp))
3930  (jbe :test)
3931  (movl (:$l 31) (:%l temp))
3932  :test
3933  (btl (:%l temp) (:%l int)))
3934
3935(define-x8632-vinsn multiply-immediate (((dest :imm))
3936                                        ((src :imm)
3937                                         (const :s32const)))
3938  ((:and (:pred >= const -128) (:pred <= const 127))
3939   (imull (:$b const) (:%l src) (:%l dest)))
3940  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
3941   (imull (:$l const) (:%l src) (:%l dest))))
3942
3943(define-x8632-vinsn multiply-fixnums (((dest :imm))
3944                                      ((x :imm)
3945                                       (y :imm))
3946                                      ((unboxed :s32)))
3947  ((:pred =
3948          (:apply %hard-regspec-value x)
3949          (:apply %hard-regspec-value dest))
3950   (movl (:%l y) (:%l unboxed))
3951   (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
3952   (imull (:%l unboxed) (:%l dest)))
3953  ((:and (:not (:pred =
3954                      (:apply %hard-regspec-value x)
3955                      (:apply %hard-regspec-value dest)))
3956         (:pred =
3957                (:apply %hard-regspec-value y)
3958                (:apply %hard-regspec-value dest)))
3959   (movl (:%l x) (:%l unboxed))
3960   (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
3961   (imull (:%l unboxed) (:%l dest)))
3962  ((:and (:not (:pred =
3963                      (:apply %hard-regspec-value x)
3964                      (:apply %hard-regspec-value dest)))
3965         (:not (:pred =
3966                      (:apply %hard-regspec-value y)
3967                      (:apply %hard-regspec-value dest))))
3968   (movl (:%l y) (:%l dest))
3969   (movl (:%l x) (:%l unboxed))
3970   (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
3971   (imull (:%l unboxed) (:%l dest))))
3972
3973
3974(define-x8632-vinsn mark-as-imm (()
3975                                 ((reg :imm)))
3976  (btrl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
3977
3978(define-x8632-vinsn mark-as-node (()
3979                                  ((reg :imm)))
3980  (xorl (:%l reg) (:%l reg))
3981  (btsl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
3982
3983(define-x8632-vinsn mark-temp1-as-node-preserving-flags (()
3984                                                        ()
3985                                                        ((reg (:u32 #.x8632::temp1))))
3986  (movl (:$l 0) (:%l reg))              ;not xorl!
3987  (cld))                                ;well, preserving most flags.
3988
3989 
3990
3991 
3992(define-x8632-vinsn (temp-push-unboxed-word :push :word :csp)
3993    (()
3994     ((w :u32))
3995     ((temp :imm)))
3996  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
3997  (subl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
3998  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
3999  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
4000  (movl (:%l x8632::ebp) (:@ 4 (:%l temp)))
4001  (movl (:%l w) (:@ 8 (:%l temp))))
4002
4003(define-x8632-vinsn (temp-pop-unboxed-word :pop :word :csp)
4004    (((w :u32))
4005     ())
4006  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l w))
4007  (movl (:@ 8 (:%l w)) (:%l w))
4008  (addl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
4009
4010(define-x8632-vinsn (temp-pop-temp1-as-unboxed-word :pop :word :csp)
4011    (()
4012     ()
4013     ((w (:u32 #.x8632::temp1))))
4014  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l w))
4015  (std)
4016  (movl (:@ 8 (:%l w)) (:%l w))
4017  (addl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
4018
4019(define-x8632-vinsn (temp-push-node :push :word :tsp)
4020    (()
4021     ((w :lisp))
4022     ((temp :imm)))
4023  (subl (:$b (* 2 x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
4024  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
4025  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
4026  (movsd (:%xmm x8632::fpzero) (:@ (:%l temp)))
4027  (movsd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
4028  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
4029  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
4030  (movl (:%l w) (:@ x8632::dnode-size (:%l temp))))
4031
4032(define-x8632-vinsn (temp-pop-node :pop :word :tsp)
4033    (((w :lisp))
4034     ()
4035     ((temp :imm)))
4036  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
4037  (movl (:@ x8632::dnode-size (:%l temp)) (:%l w))
4038  (movl (:@ (:%l temp)) (:%l temp))
4039  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
4040  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
4041
4042(define-x8632-vinsn (temp-push-single-float :push :word :csp)
4043    (()
4044     ((f :single-float))
4045     ((temp :imm)))
4046  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
4047  (subl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
4048  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
4049  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
4050  (movl (:%l x8632::ebp) (:@ 4 (:%l temp)))
4051  (movss (:%xmm f) (:@ 8 (:%l temp))))
4052
4053(define-x8632-vinsn (temp-pop-single-float :pop :word :csp)
4054    (((f :single-float))
4055     ()
4056     ((temp :imm)))
4057  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
4058  (movss (:@ 8 (:%l temp)) (:%xmm f))
4059  (addl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
4060
4061(define-x8632-vinsn (temp-push-double-float :push :word :csp)
4062    (()
4063     ((f :double-float))
4064     ((temp :imm)))
4065  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
4066  (subl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
4067  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
4068  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
4069  (movl (:%l x8632::ebp) (:@ 4 (:%l temp)))
4070  (movsd (:%xmm f) (:@ 8 (:%l temp))))
4071
4072(define-x8632-vinsn (temp-pop-double-float :pop :word :csp)
4073    (((f :double-float))
4074     ()
4075     ((temp :imm)))
4076  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
4077  (movsd (:@ 8 (:%l temp)) (:%xmm f))
4078  (addl (:$b 16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
4079
4080(define-x8632-vinsn load-next-method-context (((dest :lisp))
4081                                              ())
4082  (movl (:@ (:%seg :rcontext) x8632::tcr.next-method-context) (:%l dest))
4083  (movl (:$l 0) (:@ (:%seg :rcontext) x8632::tcr.next-method-context)))
4084
4085(define-x8632-vinsn save-node-register-to-spill-area (()
4086                                         ((src :lisp)))
4087  ;; maybe add constant to index slot 0--3
4088  (movl (:%l src) (:@ (:%seg :rcontext) x8632::tcr.save3)))
4089
4090(define-x8632-vinsn load-node-register-from-spill-area (((dest :lisp))
4091                                                        ())
4092  (movl (:@ (:%seg :rcontext) x8632::tcr.save3) (:%l dest))
4093  (movss (:%xmm x8632::fpzero) (:@ (:%seg :rcontext) x8632::tcr.save3)))
4094
4095(define-x8632-vinsn align-loop-head (()
4096                                     ())
4097)
4098
4099(queue-fixup
4100 (fixup-x86-vinsn-templates
4101  *x8632-vinsn-templates*
4102  x86::*x86-opcode-template-lists* *x8632-backend*))
4103
4104(provide "X8632-VINSNS")
Note: See TracBrowser for help on using the repository browser.