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

Last change on this file since 10561 was 10561, checked in by gb, 12 years ago

In ALLOC-C-FRAME (and the variable-sized version): push 2 words
beyond the 16-byte aligned frame; store the cstack backlink and
lisp's %ebp in those two words.

Likewise, put a two-word "header" in things temp-pushed on the
cstack.

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