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

Last change on this file since 11297 was 11297, checked in by gb, 13 years ago

Lose the speculative MARK-AS-NODE-PRESERVING-FLAGS.

Add a MARK-TEMP1-AS-NODE-PRESERVING-FLAGS, which doesn't clobber as many flage.

Add a TEMP-POP-TEMP1-AS-UNBOXED-WORD, which sets the direction flag to indicate the unboxed state of %temp1/%edx as it pops a word into that register.

ALIGN-LOOP-HEAD was a bad idea (adds NOPs but doesn't improve performance), but attempts to actually remove uses of it failed for some unknown reason. Make the vinsn a NOP for now.

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