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

Last change on this file since 10859 was 10859, checked in by gb, 11 years ago

UNBOX-S32: check for 1-digit bignum, not 2.

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