source: branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp @ 7428

Last change on this file since 7428 was 7428, checked in by rme, 13 years ago

Implement assorted additional vinsns.

File size: 89.1 KB
Line 
1;;;-*- Mode: Lisp; Package: (CCL :use CL) -*-
2
3(in-package "CCL")
4
5(eval-when (:compile-toplevel :load-toplevel :execute)
6  (require "VINSN")
7  (require "X8632-BACKEND"))
8
9(eval-when (:compile-toplevel :execute)
10  (require "X8632ENV"))
11
12(defmacro define-x8632-vinsn (vinsn-name (results args &optional temps) &body body)
13  (%define-vinsn *x8632-backend* vinsn-name results args temps body))
14
15(define-x8632-vinsn scale-32bit-misc-index (((dest :u32))
16                                            ((idx :imm) ; A fixnum
17                                             )
18                                            ())
19  (movl (:%l idx) (:%l dest)))
20
21(define-x8632-vinsn scale-16bit-misc-index (((dest :u32))
22                                            ((idx :imm))) ; A fixnum
23  (movl (:%l idx) (:%l dest))
24  (shrl (:$ub 1) (:%l dest)))
25
26(define-x8632-vinsn scale-8bit-misc-index (((dest :u32))
27                                            ((idx :imm))) ; A fixnum
28  (movl (:%l idx) (:%l dest))
29  (shrl (:$ub 2) (:%l dest)))
30
31(define-x8632-vinsn misc-ref-u32 (((dest :u32))
32                                  ((v :lisp)
33                                   (scaled-idx :u32)))
34  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
35
36(define-x8632-vinsn misc-ref-double-float  (((dest :double-float))
37                                            ((v :lisp)
38                                             (scaled-idx :imm)))
39  (movsd (:@ x8632::misc-dfloat-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
40
41(define-x8632-vinsn misc-ref-c-double-float  (((dest :double-float))
42                                              ((v :lisp)
43                                               (idx :s32const)))
44  (movsd (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
45
46(define-x8632-vinsn misc-ref-node  (((dest :lisp))
47                                    ((v :lisp)
48                                     (scaled-idx :imm)))
49  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
50
51(define-x8632-vinsn (push-misc-ref-node :push :node :vsp) (()
52                                                           ((v :lisp)
53                                                            (scaled-idx :imm)))
54  (pushl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
55
56(define-x8632-vinsn misc-set-node (()
57                                   ((val :lisp)
58                                    (v :lisp)
59                                    (unscaled-idx :imm))
60                                   ())
61  (movl (:%l val) (:@ x8632::misc-data-offset (:%l  v) (:%l unscaled-idx))))
62
63(define-x8632-vinsn misc-set-immediate-node (()
64                                             ((val :s32const)
65                                              (v :lisp)
66                                              (unscaled-idx :imm))
67                                             ())
68  (movl (:$l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
69
70(define-x8632-vinsn misc-set-double-float (()
71                                   ((val :double-float)
72                                    (v :lisp)
73                                    (unscaled-idx :imm))
74                                   ())
75  (movsd (:%xmm val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
76
77(define-x8632-vinsn misc-ref-u8 (((dest :u8))
78                                 ((v :lisp)
79                                  (scaled-idx :s32)))
80  (movzbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
81
82(define-x8632-vinsn misc-ref-s8 (((dest :s8))
83                                 ((v :lisp)
84                                  (scaled-idx :s32)))
85  (movsbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
86
87(define-x8632-vinsn misc-ref-u16 (((dest :u16))
88                                  ((v :lisp)
89                                   (scaled-idx :s32)))
90  (movzwl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
91
92(define-x8632-vinsn misc-ref-u32 (((dest :u32))
93                                  ((v :lisp)
94                                   (scaled-idx :s32)))
95  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
96
97(define-x8632-vinsn misc-ref-single-float (((dest :single-float))
98                                           ((v :lisp)
99                                            (scaled-idx :s32)))
100  (movss (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
101
102(define-x8632-vinsn misc-ref-s32 (((dest :s32))
103                                  ((v :lisp)
104                                   (scaled-idx :s32)))
105  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
106
107(define-x8632-vinsn misc-ref-s16 (((dest :s16))
108                                  ((v :lisp)
109                                   (scaled-idx :s32)))
110  (movswl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
111
112(define-x8632-vinsn misc-ref-c-node  (((dest :lisp))
113                                     ((v :lisp)
114                                      (idx :u32const)) ; sic
115                                     ())
116  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
117
118(define-x8632-vinsn (push-misc-ref-c-node :push :node :vsp)
119    (()
120     ((v :lisp)
121      (idx :u32const)) ; sic
122     ())
123  (pushl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v))))
124
125(define-x8632-vinsn misc-ref-c-u32  (((dest :u32))
126                                     ((v :lisp)
127                                      (idx :u32const)) ; sic
128                                     ())
129  ;; xxx - should the 2 be x8632::word-shift?
130  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)) (:%l dest)))
131
132(define-x8632-vinsn misc-ref-c-s32  (((dest :s32))
133                                     ((v :lisp)
134                                      (idx :s32const)) ; sic
135                                     ())
136  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
137
138(define-x8632-vinsn misc-ref-c-single-float  (((dest :single-float))
139                                              ((v :lisp)
140                                               (idx :s32const)) ; sic
141                                              ())
142  (movss (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
143
144(define-x8632-vinsn misc-ref-c-u8  (((dest :u32))
145                                     ((v :lisp)
146                                      (idx :s32const)) ; sic
147                                     ())
148  (movzbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
149
150(define-x8632-vinsn misc-ref-c-s8  (((dest :s32))
151                                     ((v :lisp)
152                                      (idx :s32const)) ; sic
153                                     ())
154  (movsbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
155
156(define-x8632-vinsn misc-set-c-node (()
157                                     ((val :lisp)
158                                      (v :lisp)
159                                     (idx :s32const)))
160  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
161
162(define-x8632-vinsn misc-set-immediate-c-node (()
163                                               ((val :s32const)
164                                                (v :lisp)
165                                                (idx :s32const)))
166  (movl (:$l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
167
168;;; xxx don't know if this is right
169(define-x8632-vinsn set-closure-forward-reference (()
170                                                   ((val :lisp)
171                                                    (closure :lisp)
172                                                    (idx :s32const)))
173  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l closure))))
174
175(define-x8632-vinsn misc-set-c-double-float (()
176                                    ((val :double-float)
177                                     (v :lisp)
178                                     (idx :s32const)))
179  (movsd (:%xmm val) (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v))))
180
181(define-x8632-vinsn (call-known-symbol :call) (((result (:lisp x8632::arg_z)))
182                                               ()
183                                               ((entry (:label 1))))
184  (:talign x8632::fulltag-tra)
185  (call (:@ x8632::symbol.fcell (:% x8632::fname)))
186  (movl (:$self 0) (:%l x8632::fn)))
187
188(define-x8632-vinsn (jump-known-symbol :jumplr) (()
189                                                 ())
190
191  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
192
193(define-x8632-vinsn set-nargs (()
194                               ((n :s16const)))
195  ((:pred = n 0)
196   (xorw (:%w x8632::nargs ) (:%w x8632::nargs )))
197  ((:not (:pred = n 0))
198   (movw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs ))))
199
200(define-x8632-vinsn check-exact-nargs (()
201                                       ((n :u16const)))
202  ((:pred = n 0)
203   (testw (:%w x8632::nargs) (:%w x8632::nargs)))
204  ((:not (:pred = n 0))
205   (cmpw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs)))
206  (jz.pt :ok)
207  (uuo-error-wrong-number-of-args)
208  :ok)
209
210(define-x8632-vinsn check-min-nargs (()
211                                       ((n :u16const)))
212  (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
213  (jae.pt :ok)
214  (uuo-error-too-few-args)
215  :ok)
216
217(define-x8632-vinsn check-max-nargs (()
218                                       ((n :u16const)))
219  (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
220  (jbe.pt :ok)
221  (uuo-error-too-many-args)
222  :ok)
223
224(define-x8632-vinsn default-1-arg (()
225                                   ((min :u16const)))
226  (rcmpw (:%w x8632::nargs) (:$w (:apply ash min x8632::word-shift)))
227  (jne :done)
228  ((:pred >= min 2)
229   (pushl (:%l x8632::arg_y)))
230  ((:pred >= min 1)
231   (movl (:%l x8632::arg_z) (:%l x8632::arg_y)))
232  (movl (:$l x8632::nil-value) (:%l x8632::arg_z))
233  :done)
234
235(define-x8632-vinsn default-2-args (()
236                                    ((min :u16const)))
237  (rcmpw (:%w x8632::nargs ) (:$w (:apply ash (:apply 1+ min) x8632::word-shift)))
238  (ja :done)
239  (je :one)
240  ;; We got "min" args; arg_y & arg_z default to nil
241  ((:pred >= min 2)
242   (pushl (:%l x8632::arg_y)))
243  ((:pred >= min 1)
244   (pushl (:%l x8632::arg_z)))
245  (movl (:$l x8632::nil-value) (:%l x8632::arg_y))
246  (jmp :last)
247  :one
248  ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
249  ((:pred >= min 1)
250   (pushl (:%l x8632::arg_y)))
251  (movl (:%l x8632::arg_z) (:%l x8632::arg_y))
252  :last
253  (movl (:$l x8632::nil-value) (:%l x8632::arg_z))
254  :done)
255
256(define-x8632-vinsn default-optionals (()
257                                       ((n :u16const))
258                                       ((temp :u32)))
259  (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::word-shift)))
260  (movw (:%w x8632::nargs) (:%w temp))
261  (jae :done)
262  :loop
263  (addw (:$w x8632::fixnumone) (:%w temp))
264  (cmpw (:$w (:apply ash n x8632::word-shift)) (:%w temp))
265  (pushl (:$l x8632::nil-value))
266  (jne :loop)
267  :done)
268
269(define-x8632-vinsn save-lisp-context-no-stack-args (()
270                                                     ())
271  (pushl (:%l x8632::ebp))
272  (movl (:%l x8632::esp) (:%l x8632::ebp)))
273
274(define-x8632-vinsn save-lisp-context-offset (()
275                                              ((nbytes-pushed :s32const)))
276  (movl (:%l x8632::ebp) (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)))
277  (leal (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)) (:%l x8632::ebp))
278  (popl  (:@ x8632::node-size (:%l x8632::ebp))))
279
280(define-x8632-vinsn save-lisp-context-variable-arg-count (()
281                                                          ()
282                                                          ((temp :u32)))
283  (movzwl (:%w x8632::nargs) (:%l temp))
284  (subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
285  (jle :push)
286  (movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
287  (leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
288  (popl (:@ x8632::node-size (:%l x8632::ebp)))
289  (jmp :done)
290  :push
291  (pushl (:%l x8632::ebp))
292  (movl (:%l x8632::esp) (:%l x8632::ebp))
293  :done)
294
295;;; We know that some args were pushed, but don't know how many were
296;;; passed.
297(define-x8632-vinsn save-lisp-context-in-frame (()
298                                                ()
299                                                ((temp :u32)))
300  (movzwl (:%w x8632::nargs) (:%l temp))
301  (subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
302  (movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
303  (leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
304  (popl  (:@ x8632::node-size (:%l x8632::ebp))))
305
306(define-x8632-vinsn (vpush-register :push :node :vsp)
307    (()
308     ((reg :lisp)))
309  (pushl (:% reg)))
310
311(define-x8632-vinsn (vpush-fixnum :push :node :vsp)
312    (()
313     ((const :s32const)))
314  ((:and  (:pred < const 128) (:pred >= const -128))
315   (pushl (:$b const)))
316  ((:not (:and  (:pred < const 128) (:pred >= const -128)))
317   (pushl (:$l const))))
318
319(define-x8632-vinsn vframe-load (((dest :lisp))
320                                 ((frame-offset :u16const)
321                                  (cur-vsp :u16const)))
322  (movl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
323
324(define-x8632-vinsn compare-vframe-offset-to-nil (()
325                                                  ((frame-offset :u16const)
326                                                   (cur-vsp :u16const)))
327  (cmpl (:$l x8632::nil-value) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
328
329(define-x8632-vinsn compare-value-cell-to-nil (()
330                                               ((vcell :lisp)))
331  (cmpl (:$l x8632::nil-value) (:@ x8632::value-cell.value (:%l vcell))))
332
333(define-x8632-vinsn lcell-load (((dest :lisp))
334                                ((cell :lcell)
335                                 (top :lcell)))
336  (movl (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
337
338(define-x8632-vinsn (vframe-push :push :node :vsp)
339    (()
340     ((frame-offset :u16const)
341      (cur-vsp :u16const)))
342  (pushl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
343
344(define-x8632-vinsn vframe-store (()
345                                  ((src :lisp)
346                                   (frame-offset :u16const)
347                                   (cur-vsp :u16const)))
348  (movl (:%l src) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
349
350(define-x8632-vinsn lcell-store (()
351                                 ((src :lisp)
352                                  (cell :lcell)
353                                  (top :lcell)))
354  (movl (:%l src) (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp))))
355       
356(define-x8632-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
357    (()
358     ())
359  (leave)
360  (ret))
361
362(define-x8632-vinsn (restore-full-lisp-context :lispcontext :pop :vsp )
363    (()
364     ())
365  (leave))
366
367(define-x8632-vinsn compare-to-nil (()
368                                    ((arg0 t)))
369  (cmpl (:$l x8632::nil-value) (:%l arg0)))
370
371(define-x8632-vinsn ref-constant (((dest :lisp))
372                                  ((lab :label)))
373  (movl (:@ (:^ lab) (:%l x8632::fn)) (:%l dest)))
374
375(define-x8632-vinsn (vpush-constant :push :node :vsp) (()
376                                                       ((lab :label)))
377  (pushl (:@ (:^ lab) (:%l x8632::fn))))
378
379(define-x8632-vinsn (jump :jump)
380    (()
381     ((label :label)))
382  (jmp label))
383
384(define-x8632-vinsn (cbranch-true :branch) (()
385                                            ((label :label)
386                                             (crbit :u8const)))
387  (jcc (:$ub crbit) label))
388
389(define-x8632-vinsn (cbranch-false :branch) (()
390                                             ((label :label)
391                                              (crbit :u8const)))
392  (jcc (:$ub (:apply logxor 1 crbit)) label))
393
394(define-x8632-vinsn (lri :constant-ref) (((dest :imm))
395                                         ((intval :s32const))
396                                         ())
397  ((:pred = intval 0)
398   (xorl (:%l dest) (:%l dest)))
399  ((:not (:pred = intval 0))
400   (movl (:$l intval) (:%l dest))))
401
402;;; In the following trap/branch-unless vinsns, it might be worth
403;;; trying to use byte instructions when the args are known to be
404;;; accessible as byte regs.  It also might be possible to
405;;; special-case eax/ax/al.
406
407(define-x8632-vinsn trap-unless-bit (()
408                                     ((value :lisp)))
409  (testl (:$l (lognot x8632::fixnumone)) (:%l value))
410  (je.pt :ok)
411  (uuo-error-reg-not-type (:%l value) (:$ub arch::error-object-not-bit))
412  :ok
413  )
414
415;;; note that NIL is just a distinguished CONS.
416;;; the tag formerly known as fulltag-nil is now
417;;; for tagged return addresses.
418(define-x8632-vinsn trap-unless-list (()
419                                      ((object :lisp))
420                                      ((tag :u16)))
421  (movw (:%w object) (:%w tag))
422  (andw (:$w x8632::fulltagmask) (:%w tag))
423  (cmpw (:$w x8632::fulltag-cons) (:%w tag))
424  (je.pt :ok)
425  (uuo-error-reg-not-list (:%l object))
426  :ok)
427
428(define-x8632-vinsn trap-unless-cons (()
429                                      ((object :lisp))
430                                      ((tag :u16)))
431  ;; check for NIL
432  (cmpl (:$l x8632::nil-value) (:%l object))
433  (je.pn :bad)
434  (movw (:%w object) (:%w tag))
435  (andw (:$w x8632::fulltagmask) (:%w tag))
436  (cmpw (:$w x8632::fulltag-cons) (:%w tag))
437  (je.pt :ok)
438  :bad
439  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::fulltag-cons))
440  :ok)
441
442(define-x8632-vinsn trap-unless-uvector (()
443                                         ((object :lisp))
444                                         ((tag :u16)))
445  (movw (:%w object) (:%w tag))
446  (andw (:$w x8632::tagmask) (:%w tag))
447  (cmpw (:$w x8632::tag-misc) (:%w tag))
448  (jz.pt :ok)
449  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::tag-misc))
450  :ok)
451
452(define-x8632-vinsn trap-unless-character (()
453                                              ((object :lisp)))
454  (cmpw (:$w x8632::subtag-character) (:%w object))
455  (je.pt :ok)
456  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-character))
457  :ok)
458
459(define-x8632-vinsn trap-unless-fixnum (()
460                                        ((object :lisp))
461                                        ())
462  (testw (:$w x8632::tagmask) (:%w object))
463  (je.pt :ok)
464  (uuo-error-reg-not-fixnum (:%l object))
465  :ok)
466
467(define-x8632-vinsn set-flags-from-lisptag (()
468                                            ((reg :lisp)))
469  (testw (:$w x8632::tagmask) (:%w reg)))
470
471(define-x8632-vinsn trap-unless-typecode= (()
472                                           ((object :lisp)
473                                            (tagval :u8const))
474                                           ((tag :u8)))
475  (movl (:%l object) (:%l tag))
476  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
477   ;; accumulator
478   (andb (:$b x8632::tagmask) (:%accb tag))
479   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
480  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
481         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
482   ;; other register that can be treated as a byte
483   (andb (:$b x8632::tagmask) (:%b tag))
484   (cmpb (:$b x8632::tag-misc) (:%b tag)))
485  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
486   ;; non-byte register
487   (andl (:$l x8632::tagmask) (:%l tag))
488   (cmpl (:$b x8632::tag-misc) (:%l tag)))
489  (jne :have-tag)
490  (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
491  :have-tag
492  (cmpl (:$b tagval) (:%l tag))
493  (je.pt :ok)
494  (uuo-error-reg-not-tag (:%l object) (:$ub tagval))
495  :ok)
496
497(define-x8632-vinsn trap-unless-single-float (()
498                                              ((object :lisp))
499                                              ((tag :u16)))
500  (movw (:%w object) (:%w tag))
501  (andw (:$w x8632::tagmask) (:%w tag))
502  (cmpw (:$w x8632::tag-misc) (:%w tag))
503  (jne :have-tag)
504  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
505  :have-tag
506  (cmpw (:$w x8632::subtag-single-float) (:%w tag))
507  (je.pt :ok)
508  (uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-single-float))
509  :ok)
510
511(define-x8632-vinsn trap-unless-double-float (()
512                                              ((object :lisp))
513                                              ((tag :u16)))
514  (movw (:%w object) (:%w tag))
515  (andw (:$w x8632::tagmask) (:%w tag))
516  (cmpw (:$w x8632::tag-misc) (:%w tag))
517  (jne :have-tag)
518  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
519  :have-tag
520  (cmpw (:$w x8632::subtag-double-float) (:%w tag))
521  (je.pt :ok)
522  (uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-double-float))
523  :ok)
524
525(define-x8632-vinsn trap-unless-macptr (()
526                                        ((object :lisp))
527                                        ((tag :u16)))
528  (movw (:%w object) (:%w tag))
529  (andw (:$w x8632::tagmask) (:%w tag))
530  (cmpw (:$w x8632::tag-misc) (:%w tag))
531  (jne :have-tag)
532  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
533  :have-tag
534  (cmpw (:$w x8632::subtag-macptr) (:%w tag))
535  (je.pt :ok)
536  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-macptr))
537  :ok)
538
539(define-x8632-vinsn check-misc-bound (()
540                                      ((idx :imm)
541                                       (v :lisp))
542                                      ((temp :u32)))
543  (movl (:@ x8632::misc-header-offset (:%l v)) (:%l temp))
544  ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
545         (:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
546   (xorb (:%b temp) (:%b temp))
547   (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l temp)))
548  ((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
549   (shrl (:$ub x8632::num-subtag-bits) (:%l temp))
550   (shll (:$ub x8632::fixnumshift) (:%l temp)))
551  (rcmpl (:%l idx) (:%l temp))
552  (jb.pt :ok)
553  (uuo-error-vector-bounds (:%l idx) (:%l v))
554  :ok)
555
556(define-x8632-vinsn %cdr (((dest :lisp))
557                          ((src :lisp)))
558  (movl (:@ x8632::cons.cdr (:%l src)) (:%l dest)))
559
560(define-x8632-vinsn (%vpush-cdr :push :node :vsp)
561    (()
562     ((src :lisp)))
563  (pushl (:@ x8632::cons.cdr (:%l src))))
564
565(define-x8632-vinsn %car (((dest :lisp))
566                          ((src :lisp)))
567  (movl (:@ x8632::cons.car (:%l src)) (:%l dest)))
568
569(define-x8632-vinsn (%vpush-car :push :node :vsp)
570    (()
571     ((src :lisp)))
572  (pushl (:@ x8632::cons.car (:%l src))))
573
574(define-x8632-vinsn u32->char (((dest :lisp)
575                               (src :u8))
576                              ((src :u8))
577                              ())
578  (shll (:$ub x8632::charcode-shift) (:%l src))
579  (leal (:@ x8632::subtag-character (:%l src)) (:%l dest)))
580
581(define-x8632-vinsn (load-nil :constant-ref) (((dest t))
582                                              ())
583  (movl (:$l x8632::nil-value) (:%l dest)))
584
585
586(define-x8632-vinsn (load-t :constant-ref) (((dest t))
587                                            ())
588  (movl (:$l x8632::t-value) (:%l dest)))
589
590;;; use something like this for the other extract-whatevers, too,
591;;; once it's established that it works.
592(define-x8632-vinsn extract-tag (((tag :u8))
593                                 ((object :lisp)))
594  (movl (:%l object) (:%l tag))
595  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
596   ;; tag is the accumulator (2 bytes)
597   (andb (:$b x8632::tagmask) (:%accb tag)))
598  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
599         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
600   ;; tag is in a register whose low 8 bits can be accessed by byte
601   ;; insns (3 bytes)
602   (andb (:$b x8632::tagmask) (:%b tag)))
603  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
604   ;; tag is somewhere else (6 bytes) (could use andw and get a length
605   ;; of 5 bytes, but Intel's optimization manual advises avoiding
606   ;; length-changing prefixes to change the size of immediates.
607   ;; (section 3.4.2.3)
608   (andl (:$l x8632::tagmask) (:%l tag))))
609
610(define-x8632-vinsn extract-tag-fixnum (((tag :imm))
611                                        ((object :lisp)))
612  (leal (:@ (:%l object) 4) (:%l tag))
613  (andw (:$w (ash x8632::tagmask x8632::fixnumshift)) (:%w tag)))
614
615(define-x8632-vinsn extract-fulltag (((tag :u8))
616                                 ((object :lisp)))
617  (movl (:%l object) (:%l tag))
618  (andw (:$w x8632::fulltagmask) (:%w tag)))
619
620(define-x8632-vinsn extract-fulltag-fixnum (((tag :imm))
621                                            ((object :lisp)))
622  (leal (:@ (:%l object) 4) (:%l tag))
623  (andw (:$w (ash x8632::fulltagmask x8632::fixnumshift)) (:%w tag)))
624
625(define-x8632-vinsn extract-typecode (((tag :imm))
626                                      ((object :lisp)))
627  (movl (:%l object) (:%l tag))
628  ((:pred <= (:apply  %hard-regspec-value tag) x8632::ebx)
629   (andb (:$b x8632::tagmask) (:%b tag))
630   (cmpb (:$b x8632::tag-misc) (:%b tag)))
631  ((:pred > (:apply  %hard-regspec-value tag) x8632::ebx)
632   (andl (:$l x8632::tagmask) (:%l tag))
633   (cmpl (:$l x8632::tag-misc) (:%l tag)))
634  (jne :have-tag)
635  ((:pred <= (:apply  %hard-regspec-value tag) x8632::ebx)
636   (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag)))
637  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
638   (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag)))
639  :have-tag)
640
641(define-x8632-vinsn extract-typecode-fixnum (((tag :imm))
642                                             ((object :lisp))
643                                             ((temp :u32)))
644  (movl (:%l object) (:%l temp))
645  (andw (:$w x8632::tagmask) (:%w temp))
646  (cmpw (:$w x8632::tag-misc) (:%w temp))
647  (jne :have-tag)
648  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w temp))
649  :have-tag
650  (leal (:@ (:%l temp) 4) (:%l tag)))
651
652(define-x8632-vinsn compare-reg-to-zero (()
653                                         ((reg :imm)))
654  (testl (:%l reg) (:%l reg)))
655
656;;; life will be sad if reg isn't byte accessible
657(define-x8632-vinsn compare-u8-reg-to-zero (()
658                                            ((reg :u8)))
659  (testb (:%b reg) (:%b reg)))
660
661(define-x8632-vinsn cr-bit->boolean (((dest :lisp))
662                                     ((crbit :u8const))
663                                     ((temp :u32)))
664  (movl (:$l x8632::t-value) (:%l temp))
665  (leal (:@ (- x8632::t-offset) (:%l temp)) (:%l dest))
666  (cmovccl (:$ub crbit) (:%l temp) (:%l dest)))
667
668(define-x8632-vinsn compare-s32-constant (()
669                                            ((val :imm)
670                                             (const :s32const)))
671  ((:or  (:pred < const -128) (:pred > const 127))
672   (rcmpl (:%l val) (:$l const)))
673  ((:not (:or  (:pred < const -128) (:pred > const 127)))
674   (rcmpl (:%l val) (:$b const))))
675
676(define-x8632-vinsn compare-u31-constant (()
677                                          ((val :u32)
678                                           (const :u32const)))
679  ((:pred > const 127)
680   (rcmpl (:%l val) (:$l const)))
681  ((:not (:pred > const 127))
682   (rcmpl (:%l val) (:$b const))))
683
684(define-x8632-vinsn compare-u8-constant (()
685                                         ((val :u8)
686                                          (const :u8const)))
687  ((:pred = (:apply %hard-regspec-value val) x8632::eax)
688   (rcmpb (:%accb val) (:$b const)))
689  ((:and (:pred > (:apply %hard-regspec-value val) x8632::eax)
690         (:pred <= (:apply %hard-regspec-value val) x8632::ebx))
691   (rcmpb (:%b val) (:$b const)))
692  ((:pred > (:apply %hard-regspec-value val) x8632::ebx)
693   (rcmpl (:%l val) (:$l const)))
694  )
695
696(define-x8632-vinsn cons (((dest :lisp))
697                          ((car :lisp)
698                           (cdr :lisp))
699                          ((allocptr (:lisp #.x8632::allocptr))))
700  (subl (:$b (- x8632::cons.size x8632::fulltag-cons)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
701  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l x8632::allocptr))
702  (rcmpl (:%l x8632::allocptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
703  (jg :no-trap)
704  (uuo-alloc)
705  :no-trap
706  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
707  (movl (:%l car) (:@ x8632::cons.car (:%l x8632::allocptr)))
708  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l x8632::allocptr)))
709  (movl (:%l x8632::allocptr) (:%l dest)))
710
711(define-x8632-vinsn unbox-u8 (((dest :u8))
712                              ((src :lisp)))
713  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l dest))
714  (andl (:% src) (:% dest))
715  (je.pt :ok)
716  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-8))
717  :ok
718  (movl (:%l src) (:%l dest))
719  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
720
721(define-x8632-vinsn %unbox-u8 (((dest :u8))
722                              ((src :lisp)))
723  (movl (:%l src) (:%l dest))
724  (shrl (:$ub x8632::fixnumshift) (:%l dest))
725  (andl (:$l #xff) (:%l dest)))
726
727(define-x8632-vinsn unbox-s8 (((dest :s8))
728                              ((src :lisp)))
729  (movl (:%l src) (:%l dest))
730  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
731  (sarl (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
732  (cmpl (:%l src) (:%l dest))
733  (jne.pn :bad)
734  (testw (:$w x8632::fixnummask) (:%w dest))
735  (jne.pn :bad)
736  (sarl (:$ub x8632::fixnumshift) (:%l dest))
737  (jmp :got-it)
738  :bad
739  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-8))
740  :got-it)
741
742(define-x8632-vinsn unbox-u16 (((dest :u16))
743                              ((src :lisp)))
744  (testl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:% src))
745  (movl (:%l src) (:%l dest))
746  (je.pt :ok)
747  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-16))
748  :ok
749  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
750
751(define-x8632-vinsn %unbox-u16 (((dest :u16))
752                              ((src :lisp)))
753  (movl (:%l src) (:%l dest))
754  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
755
756(define-x8632-vinsn unbox-s16 (((dest :s16))
757                              ((src :lisp)))
758  (movl (:%l src) (:%l dest))
759  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
760  (sarl (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
761  (cmpl (:%l src) (:%l dest))
762  (jne.pn :bad)
763  (testw (:$w x8632::fixnummask) (:%w dest))
764  (je.pt :got-it)
765  :bad
766  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-16))
767  :got-it
768  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
769
770(define-x8632-vinsn %unbox-s16 (((dest :s16))
771                                ((src :lisp)))
772  (movl (:%l src) (:%l dest))
773  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
774
775;;; xxx -- review this again later
776(define-x8632-vinsn unbox-u32 (((dest :u32))
777                               ((src :lisp)))
778  (movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest))
779  (testl (:%l dest) (:%l src))
780  (movl (:%l src) (:%l dest))
781  (jnz :maybe-bignum)
782  (sarl (:$ub x8632::fixnumshift) (:%l dest))
783  (jmp :done)
784  :maybe-bignum
785  (andw (:$w x8632::tagmask) (:%w dest))
786  (cmpw (:$w x8632::tag-misc) (:%w dest))
787  (jne :have-tag)
788  (movw (:@ x8632::misc-subtag-offset (:%l src)) (:%w dest))
789  (andw (:$w #xff) (:%w dest))
790  :have-tag
791  (cmpw (:$w x8632::subtag-bignum) (:%w dest))
792  (jne :bad)
793  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest))
794  (cmpl (:$l x8632::three-digit-bignum-header) (:%l dest))
795  (je :three)
796  (cmpl (:$l x8632::two-digit-bignum-header) (:%l dest))
797  (jne :bad)
798  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
799  (testl (:%l dest) (:%l dest))
800  (jns :done)
801  :bad
802  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32))
803  :three
804  (movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest))
805  (testl (:%l dest) (:%l dest))
806  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
807  (jne :bad)
808  :done)
809
810;;; xxx -- review this again later
811(define-x8632-vinsn unbox-s32 (((dest :s32))
812                               ((src :lisp)))
813  (movl (:%l src) (:%l dest))
814  (sarl (:$ub x8632::fixnumshift) (:%l dest))
815  ;; Was it a fixnum ?
816  (testw (:$w x8632::fixnummask) (:%w src))
817  (je :done)
818  ;; May be a 2-digit bignum
819  (movw (:%w src) (:%w dest))
820  (andw (:$w x8632::tagmask) (:%w dest))
821  (cmpw (:$w x8632::tag-misc) (:%w dest))
822  (jne :bad)
823  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src)))
824  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
825  (je :done)
826  :bad
827  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32))
828  :done)
829
830
831;;; xxx -- sigh...
832(define-x8632-vinsn sign-extend-s8 (((dest :s32))
833                                    ((src :s8)))
834  ;; (movsbl (:%b temp) (:%l dest))
835  (movl (:%l src) (:%l dest))
836  (shll (:$ub 24) (:%l dest))
837  (sarl (:$ub 24) (:%l dest)))
838
839(define-x8632-vinsn sign-extend-s16 (((dest :s32))
840                                     ((src :s16)))
841  (movswl (:%w src) (:%l dest)))
842
843;;; xxx -- sigh...
844(define-x8632-vinsn zero-extend-u8 (((dest :s32))
845                                    ((src :u8)))
846  ;;(movzbl (:%b src) (:%l dest))
847  (movl (:%l src) (:%l dest))
848  (andl (:$l #xff) (:%l dest)))
849
850(define-x8632-vinsn zero-extend-u16 (((dest :s32))
851                                     ((src :u16)))
852  (movzwl (:%w src) (:%l dest)))
853
854(define-x8632-vinsn (jump-subprim :jumpLR) (()
855                                            ((spno :s32const)))
856  (jmp (:@ spno)))
857
858;;; Call a subprimitive using a tail-aligned CALL instruction.
859(define-x8632-vinsn (call-subprim :call)  (()
860                                           ((spno :s32const))
861                                           ((entry (:label 1))))
862  (:talign x8632::fulltag-tra)
863  (call (:@ spno))
864  (movl (:$self 0) (:% x8632::fn)))
865
866(define-x8632-vinsn fixnum-subtract-from (((dest t)
867                                           (y t))
868                                          ((y t)
869                                           (x t)))
870  (subl (:%l y) (:%l x)))
871
872(define-x8632-vinsn %logand-c (((dest t)
873                                (val t))
874                               ((val t)
875                                (const :s32const)))
876  ((:and (:pred >= const -128) (:pred <= const 127))
877   (andl (:$b const) (:%l val)))
878  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
879   (andl (:$l const) (:%l val))))
880
881(define-x8632-vinsn %logior-c (((dest t)
882                                (val t))
883                               ((val t)
884                                (const :s32const)))
885  ((:and (:pred >= const -128) (:pred <= const 127))
886   (orl (:$b const) (:%l val)))
887  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
888   (orl (:$l const) (:%l val))))
889
890(define-x8632-vinsn %logxor-c (((dest t)
891                                (val t))
892                               ((val t)
893                                (const :s32const)))
894  ((:and (:pred >= const -128) (:pred <= const 127))
895   (xorl (:$b const) (:%l val)))
896  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
897   (xorl (:$l const) (:%l val))))
898
899(define-x8632-vinsn character->fixnum (((dest :lisp))
900                                       ((src :lisp))
901                                       ())
902  ((:not (:pred =
903                (:apply %hard-regspec-value dest)
904                (:apply %hard-regspec-value src)))
905   (movl (:%l src) (:%l dest)))
906  (shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest)))
907
908(define-x8632-vinsn compare (()
909                             ((x t)
910                              (y t)))
911  (rcmpl (:%l x) (:%l y)))
912
913(define-x8632-vinsn negate-fixnum (((val :lisp))
914                                   ((val :imm)))
915  (negl (:% val)))
916
917;;; This handles the 1-bit overflow from addition/subtraction/unary negation
918(define-x8632-vinsn set-bigits-and-header-for-fixnum-overflow
919    (()
920     ((val :lisp)
921      (no-overflow
922       :label))
923     ((imm (:u32 #.x8632::imm0))))
924  (jno.pt no-overflow)
925  (movl (:%l val) (:%l imm))
926  (sarl (:$ub x8632::fixnumshift) (:%l imm))
927  (xorl (:$l #xc0000000) (:%l imm))
928  ;; stash bignum digit
929  (movd (:%l imm) (:%mmx x8632::mm1))
930  ;; set header
931  (movl (:$l x8632::one-digit-bignum-header) (:%l imm))
932  (movd (:%l imm) (:%mmx x8632::mm0))
933  ;; need 8 bytes of aligned memory for 1 digit bignum
934  (movl (:$l (- 8 x8632::fulltag-misc)) (:%l imm)))
935
936(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
937                                                      ((bignum :lisp)))
938  (movd (:%mmx x8632::mm1) (:@ x8632::misc-data-offset (:%l bignum)))) 
939
940
941(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
942                                                       ((src :s32))
943                                                       ((temp :s32)))
944  (movl (:%l src) (:%l temp))
945  (shll (:$ub x8632::fixnumshift) (:%l temp))
946  (movl (:%l temp) (:%l dest))          ; tagged as a fixnum
947  (sarl (:$ub x8632::fixnumshift) (:%l temp))
948  (cmpl (:%l src) (:%l temp)))
949
950(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
951                                                       ((src :u32))
952                                                       ((temp :u32)))
953  (movl (:%l src) (:%l temp))
954  (shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
955  (movl (:%l temp) (:%l dest))          ; tagged as an even fixnum
956  (shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
957  (shrl (:%l dest))
958  (cmpl (:%l src) (:%l temp))
959  :done)
960
961;;; setup-bignum-alloc-for-s32-overflow
962;;; setup-bignum-alloc-for-u32-overflow
963
964(define-x8632-vinsn setup-uvector-allocation (()
965                                              ((header :imm)))
966  (movd (:%l header) (:%mmx x8632::mm0)))
967
968;;; The code that runs in response to the uuo-alloc
969;;; expects a header in mm0, and a size in imm0.
970;;; mm0 is an implicit arg (it contains the uvector header)
971;;; size is actually an arg, not a temporary,
972;;; but it appears that there's isn't a way to enforce
973;;; register usage on vinsn args.
974(define-x8632-vinsn %allocate-uvector (((dest :lisp))
975                                       ()
976                                       ((size (:u32 #.x8632::imm0))
977                                        (freeptr (:lisp #.x8632::allocptr))))
978  (subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
979  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
980  (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
981  (jg :no-trap)
982  (uuo-alloc)
983  :no-trap
984  (movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
985  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
986  ((:not (:pred = freeptr
987                (:apply %hard-regspec-value dest)))
988   (movl (:%l freeptr) (:%l dest))))
989
990(define-x8632-vinsn box-fixnum (((dest :imm))
991                                ((src :s32)))
992  ;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
993  (leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
994
995;;; xxx
996(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
997    (((val :lisp))
998     ((val :lisp))
999     ((unboxed (:s32 #.x8632::edx))
1000      (header (:u32 #.x8632::imm0))
1001      (entry (:label 1))))
1002  (jno.pt :done)
1003  ((:not (:pred = x8632::arg_z
1004                (:apply %hard-regspec-value val)))
1005   (movl (:%l val) (:%l x8632::arg_z)))
1006  (:talign 5)
1007  (call (:@ .SPfix-overflow))
1008  (movl (:$self 0) (:%l x8632::fn))
1009  ((:not (:pred = x8632::arg_z
1010                (:apply %hard-regspec-value val)))
1011   (movl (:%l x8632::arg_z) (:%l val)))
1012  :done)
1013
1014;;; xxx
1015(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
1016    (((val :lisp))
1017     ((val :lisp)
1018      (lab :label))
1019     ((unboxed (:s32 #.x8664::imm1))
1020      (header (:u32 #.x8664::imm0))
1021      (entry (:label 1))))
1022  (jno.pt lab)
1023  ((:not (:pred = x8632::arg_z
1024                (:apply %hard-regspec-value val)))
1025   (movl (:%l val) (:%l x8632::arg_z)))
1026  (:talign 5)
1027  (call (:@ .SPfix-overflow))
1028  (movl (:$self 0) (:%l x8632::fn))
1029  ((:not (:pred = x8632::arg_z
1030                (:apply %hard-regspec-value val)))
1031   (movl (:%l x8632::arg_z) (:%l val)))
1032  (jmp lab))
1033
1034
1035(define-x8632-vinsn add-constant (((dest :imm))
1036                                  ((dest :imm)
1037                                   (const :s32const)))
1038  ((:and (:pred >= const -128) (:pred <= const 127))
1039   (addl (:$b const) (:%l dest)))
1040  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1041   (addl (:$l const) (:%l dest))))
1042
1043(define-x8632-vinsn add-constant3 (((dest :imm))
1044                                   ((src :imm)
1045                                    (const :s32const)))
1046  ((:pred = (:apply %hard-regspec-value dest)
1047          (:apply %hard-regspec-value src))
1048   ((:and (:pred >= const -128) (:pred <= const 127))
1049    (addl (:$b const) (:%l dest)))
1050   ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1051    (addl (:$l const) (:%l dest))))
1052  ((:not (:pred = (:apply %hard-regspec-value dest)
1053                (:apply %hard-regspec-value src)))
1054   (leal (:@ const (:%l src)) (:%l dest))))
1055
1056(define-x8632-vinsn fixnum-add2  (((dest :imm))
1057                                  ((dest :imm)
1058                                   (other :imm)))
1059  (addl (:%l other) (:%l dest)))
1060
1061(define-x8632-vinsn fixnum-sub2  (((dest :imm))
1062                                  ((x :imm)
1063                                   (y :imm))
1064                                  ((temp :imm)))
1065  (movl (:%l x) (:%l temp))
1066  (subl (:%l y) (:%l temp))
1067  (movl (:%l temp) (:%l dest)))
1068
1069(define-x8632-vinsn fixnum-add3 (((dest :imm))
1070                                 ((x :imm)
1071                                  (y :imm)))
1072 
1073  ((:pred =
1074          (:apply %hard-regspec-value x)
1075          (:apply %hard-regspec-value dest))
1076   (addl (:%l y) (:%l dest)))
1077  ((:not (:pred =
1078                (:apply %hard-regspec-value x)
1079                (:apply %hard-regspec-value dest)))
1080   ((:pred =
1081           (:apply %hard-regspec-value y)
1082           (:apply %hard-regspec-value dest))
1083    (addl (:%l x) (:%l dest)))
1084   ((:not (:pred =
1085                 (:apply %hard-regspec-value y)
1086                 (:apply %hard-regspec-value dest)))
1087    (leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1088
1089(define-x8632-vinsn copy-gpr (((dest t))
1090                              ((src t)))
1091  ((:not (:pred =
1092                (:apply %hard-regspec-value dest)
1093                (:apply %hard-regspec-value src)))
1094   (movl (:%l src) (:%l dest))))
1095
1096(define-x8632-vinsn (vpop-register :pop :node :vsp)
1097    (((dest :lisp))
1098     ())
1099  (popl (:%l dest)))
1100
1101(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1102                                                      ())
1103  (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1104  (jb :done)
1105  (je :one)
1106  (pushl (:%l x8632::arg_y))
1107  :one
1108  (pushl (:%l x8632::arg_z))
1109  :done)
1110
1111(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1112                                                         ((max :u32const)))
1113  ((:pred >= max 2)
1114   (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1115   (jb :done)
1116   (je :one)
1117   (pushl (:%l x8632::arg_y))
1118   :one
1119   (pushl (:%l x8632::arg_z))
1120   :done)
1121  ((:pred = max 1)
1122   (testw (:%w x8632::nargs) (:%w x8632::nargs))
1123   (je :done)
1124   (pushl (:%l x8632::arg_z))
1125   :done))
1126
1127(define-x8632-vinsn (call-label :call) (()
1128                                        ((label :label))
1129                                        ((entry (:label 1))))
1130  (:talign 5)
1131  (call label)
1132  (movl (:$self 0) (:%l x8632::fn)))
1133
1134(define-x8632-vinsn double-float-compare (()
1135                                          ((arg0 :double-float)
1136                                           (arg1 :double-float)))
1137  (comisd (:%xmm arg1) (:%xmm arg0)))
1138
1139(define-x8632-vinsn single-float-compare (()
1140                                          ((arg0 :single-float)
1141                                           (arg1 :single-float)))
1142  (comiss (:%xmm arg1) (:%xmm arg0)))
1143
1144(define-x8632-vinsn double-float+-2 (((result :double-float))
1145                                     ((x :double-float)
1146                                      (y :double-float)))
1147  ((:pred =
1148          (:apply %hard-regspec-value result)
1149          (:apply %hard-regspec-value x))
1150   (addsd (:%xmm y) (:%xmm result)))
1151  ((:and (:not (:pred =
1152                      (:apply %hard-regspec-value result)
1153                      (:apply %hard-regspec-value x)))
1154         (:pred =
1155                (:apply %hard-regspec-value result)
1156                (:apply %hard-regspec-value y)))
1157   (addsd (:%xmm x) (:%xmm result)))
1158  ((:and (:not (:pred =
1159                      (:apply %hard-regspec-value result)
1160                      (:apply %hard-regspec-value x)))
1161         (:not (:pred =
1162                      (:apply %hard-regspec-value result)
1163                      (:apply %hard-regspec-value y))))
1164   (movsd (:%xmm x) (:%xmm result))
1165   (addsd (:%xmm y) (:%xmm result))))
1166
1167;;; Caller guarantees (not (eq y result))
1168(define-x8632-vinsn double-float--2 (((result :double-float))
1169                                     ((x :double-float)
1170                                      (y :double-float)))
1171  ((:not (:pred = (:apply %hard-regspec-value result)
1172                (:apply %hard-regspec-value x)))
1173   (movsd (:%xmm x) (:%xmm result)))
1174  (subsd (:%xmm y) (:%xmm result)))
1175
1176(define-x8632-vinsn double-float*-2 (((result :double-float))
1177                                     ((x :double-float)
1178                                      (y :double-float)))
1179  ((:pred =
1180          (:apply %hard-regspec-value result)
1181          (:apply %hard-regspec-value x))
1182   (mulsd (:%xmm y) (:%xmm result)))
1183  ((:and (:not (:pred =
1184                      (:apply %hard-regspec-value result)
1185                      (:apply %hard-regspec-value x)))
1186         (:pred =
1187                (:apply %hard-regspec-value result)
1188                (:apply %hard-regspec-value y)))
1189   (mulsd (:%xmm x) (:%xmm result)))
1190  ((:and (:not (:pred =
1191                      (:apply %hard-regspec-value result)
1192                      (:apply %hard-regspec-value x)))
1193         (:not (:pred =
1194                      (:apply %hard-regspec-value result)
1195                      (:apply %hard-regspec-value y))))
1196   (movsd (:%xmm x) (:%xmm result))
1197   (mulsd (:%xmm y) (:%xmm result))))
1198
1199;;; Caller guarantees (not (eq y result))
1200(define-x8632-vinsn double-float/-2 (((result :double-float))
1201                                     ((x :double-float)
1202                                      (y :double-float)))
1203  ((:not (:pred = (:apply %hard-regspec-value result)
1204                (:apply %hard-regspec-value x)))
1205   (movsd (:%xmm x) (:%xmm result)))
1206  (divsd (:%xmm y) (:%xmm result)))
1207
1208(define-x8632-vinsn single-float+-2 (((result :single-float))
1209                                     ((x :single-float)
1210                                      (y :single-float)))
1211  ((:pred =
1212          (:apply %hard-regspec-value result)
1213          (:apply %hard-regspec-value x))
1214   (addss (:%xmm y) (:%xmm result)))
1215  ((:and (:not (:pred =
1216                      (:apply %hard-regspec-value result)
1217                      (:apply %hard-regspec-value x)))
1218         (:pred =
1219                (:apply %hard-regspec-value result)
1220                (:apply %hard-regspec-value y)))
1221   (addss (:%xmm x) (:%xmm result)))
1222  ((:and (:not (:pred =
1223                      (:apply %hard-regspec-value result)
1224                      (:apply %hard-regspec-value x)))
1225         (:not (:pred =
1226                      (:apply %hard-regspec-value result)
1227                      (:apply %hard-regspec-value y))))
1228   (movss (:%xmm x) (:%xmm result))
1229   (addss (:%xmm y) (:%xmm result))))
1230
1231;;; Caller guarantees (not (eq y result))
1232(define-x8632-vinsn single-float--2 (((result :single-float))
1233                                     ((x :single-float)
1234                                      (y :single-float)))
1235  ((:not (:pred = (:apply %hard-regspec-value result)
1236                (:apply %hard-regspec-value x)))
1237   (movss (:%xmm x) (:%xmm result)))
1238  (subss (:%xmm y) (:%xmm result)))
1239
1240(define-x8632-vinsn single-float*-2 (((result :single-float))
1241                                     ((x :single-float)
1242                                      (y :single-float)))
1243    ((:pred =
1244          (:apply %hard-regspec-value result)
1245          (:apply %hard-regspec-value x))
1246   (mulss (:%xmm y) (:%xmm result)))
1247  ((:and (:not (:pred =
1248                      (:apply %hard-regspec-value result)
1249                      (:apply %hard-regspec-value x)))
1250         (:pred =
1251                (:apply %hard-regspec-value result)
1252                (:apply %hard-regspec-value y)))
1253   (mulss (:%xmm x) (:%xmm result)))
1254  ((:and (:not (:pred =
1255                      (:apply %hard-regspec-value result)
1256                      (:apply %hard-regspec-value x)))
1257         (:not (:pred =
1258                      (:apply %hard-regspec-value result)
1259                      (:apply %hard-regspec-value y))))
1260   (movss (:%xmm x) (:%xmm result))
1261   (mulss (:%xmm y) (:%xmm result))))
1262
1263;;; Caller guarantees (not (eq y result))
1264(define-x8632-vinsn single-float/-2 (((result :single-float))
1265                                     ((x :single-float)
1266                                      (y :single-float)))
1267  ((:not (:pred = (:apply %hard-regspec-value result)
1268                (:apply %hard-regspec-value x)))
1269   (movss (:%xmm x) (:%xmm result)))
1270  (divss (:%xmm y) (:%xmm result)))
1271
1272(define-x8632-vinsn get-single (((result :single-float))
1273                                ((source :lisp)))
1274  (movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1275
1276(define-x8632-vinsn get-double (((result :double-float))
1277                                ((source :lisp)))
1278  (movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1279
1280;;; Extract a double-float value, typechecking in the process.
1281;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1282;;; instead of replicating it ..
1283;;; get-double?
1284
1285(define-x8632-vinsn copy-single-float (((dest :single-float))
1286                                       ((src :single-float)))
1287  (movss (:%xmm src) (:%xmm dest)))
1288
1289(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1290                                           ((src :single-float)))
1291  (cvtss2sd (:%xmm src) (:%xmm dest)))
1292
1293(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1294                                           ((src :double-float)))
1295  (cvtsd2ss (:%xmm src) (:%xmm dest)))
1296
1297(define-x8632-vinsn fitvals (()
1298                             ((n :u16const))
1299                             ((imm :u16)))
1300  ((:pred = n 0)
1301   (xorl (:%l imm) (:%l imm)))
1302  ((:not (:pred = n 0))
1303   (movw (:$w (:apply ash n x8632::fixnumshift)) (:%w imm)))
1304  (subw (:%w x8632::nargs) (:%w imm))
1305  (jae :push-more)
1306  (movswl (:%w imm) (:%l imm))
1307  (subl (:%l imm) (:%l x8632::esp))
1308  (jmp :done)
1309  :push-loop
1310  (pushl (:$l x8632::nil-value))
1311  (addw (:$b x8632::node-size) (:%w x8632::nargs))
1312  (subw (:$b x8632::node-size) (:%w imm))
1313  :push-more
1314  (jne :push-loop)
1315  :done)
1316
1317(define-x8632-vinsn (nvalret :jumpLR) (()
1318                                       ())
1319  (jmp (:@ .SPnvalret)))
1320
1321(define-x8632-vinsn lisp-word-ref (((dest t))
1322                                   ((base t)
1323                                    (offset t)))
1324  (movl (:@ (:%l base) (:%l offset)) (:%l  dest)))
1325
1326(define-x8632-vinsn lisp-word-ref-c (((dest t))
1327                                     ((base t)
1328                                      (offset :s32const)))
1329  ((:pred = offset 0)
1330   (movl (:@ (:%l base)) (:%l dest)))
1331  ((:not (:pred = offset 0))
1332   (movl (:@ offset (:%l base)) (:%l dest))))
1333
1334;; start-mv-call
1335
1336;; xxx check this
1337(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1338                                                 ((label :label)))
1339  (leal (:@ (:^ label) (:%l x8632::fn)) (:%l x8632::ra0))
1340  (pushl (:%l x8632::ra0)))
1341
1342;; ????
1343(define-x8632-vinsn emit-aligned-label (()
1344                                        ((label :label)))
1345  (:align 3)
1346  (:long (:^ label)))
1347
1348;; pass-multiple-values-symbol
1349;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1350(define-x8632-vinsn pass-multiple-values-symbol (()
1351                                                 ())
1352  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr)))) 
1353  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1354
1355
1356;;; It'd be good to have a variant that deals with a known function
1357;;; as well as this.
1358(define-x8632-vinsn pass-multiple-values (()
1359                                          ()
1360                                          ((tag :u8)))
1361  (movb (:%b x8632::temp0) (:%b tag))
1362  (andb (:$b x8632::tagmask) (:%b tag))
1363  (cmpb (:$b x8632::tag-misc) (:%b tag))
1364  (jne :bad)
1365  (cmpb (:$b x8632::subtag-function) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
1366  (cmovel (:%l x8632::temp0) (:%l x8632::fn))
1367  (je :go)
1368  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
1369  (cmovel (:@ x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::fn))
1370  (jne :bad)
1371  :go
1372  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr))))
1373  (jmp (:%l x8632::fn))
1374  :bad
1375  (uuo-error-not-callable)
1376  ;; If we don't do this (and leave %fn as a TRA into itself), reporting
1377  ;; the error is likely a little harder.  Tough.
1378  ;; (leaq (@ (:apply - (:^ :bad)) (:%q x8664::rn)) (:%q x8664::fn))
1379)
1380
1381
1382(define-x8632-vinsn reserve-outgoing-frame (()
1383                                            ())
1384  (pushl (:$b x8632::reserved-frame-marker))
1385  (pushl (:$b x8632::reserved-frame-marker)))
1386
1387;; implicit temp0 arg
1388(define-x8632-vinsn (call-known-function :call) (()
1389                                                 ()
1390                                                 ((entry (:label 1))))
1391  (:talign 5)
1392  (call (:%l x8632::temp0))
1393  (movl (:$self 0) (:%l x8632::fn)))
1394
1395(define-x8632-vinsn (jump-known-function :jumplr) (()
1396                                                   ())
1397  (movl (:%l x8632::fn) (:%l x8632::xfn))
1398  (movl (:%l x8632::temp0)  (:%l x8632::fn))
1399  (jmp (:%l x8632::fn)))
1400
1401(define-x8632-vinsn (list :call) (()
1402                                  ()
1403                                  ((entry (:label 1))))
1404  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1405  (:talign 5)
1406  (call (:@ .SPconslist))
1407  :back
1408  (movl (:$self 0) (:%l x8632::fn)))
1409
1410(define-x8632-vinsn make-fixed-stack-gvector (((dest :lisp))
1411                                              ((aligned-size :u32const)
1412                                               (header :s32const))
1413                                              ((tempa :imm)
1414                                               (tempb :imm)))
1415  ((:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1416         (:pred <= (:apply + aligned-size x8632::dnode-size) 127))
1417   (subl (:$b (:apply + aligned-size x8632::dnode-size))
1418         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1419  ((:not (:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1420               (:pred <= (:apply + aligned-size x8632::dnode-size) 127)))
1421   (subl (:$l (:apply + aligned-size x8632::dnode-size))
1422         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1423  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l tempb))
1424  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l tempa))
1425  (movd (:%l tempb) (:%mmx x8632::stack-temp))
1426  :loop
1427  (movapd (:%xmm x8632::fpzero) (:@ -16 (:%l tempb)))
1428  (subl (:$b x8632::dnode-size) (:%l tempb))
1429  (cmpl (:%l tempa) (:%l tempb))
1430  (jnz :loop)
1431  (movd (:%mmx x8632::stack-temp) (:@ (:%l tempa)))
1432  (movl (:%l tempa) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1433  (movl (:$l header) (:@ x8632::dnode-size (:%l tempa)))
1434  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l tempa)) (:%l dest)))
1435
1436
1437(define-x8632-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
1438
1439(define-x8632-vinsn make-tsp-vcell (((dest :lisp))
1440                                    ((closed :lisp))
1441                                    ((temp :imm)))
1442  (subl (:$b (+ x8632::value-cell.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1443  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1444  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1445  (movapd (:%xmm x8632::fpzero) (:@ (:%l temp)))
1446  (movapd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
1447  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))) 
1448  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
1449  (movl (:$l x8632::value-cell-header) (:@ x8632::dnode-size (:%l temp)))
1450  (movl (:%l closed) (:@ (+ x8632::dnode-size x8632::node-size) (:%l temp)))
1451  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l temp)) (:%l dest)))
1452
1453(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1454                                   ((car :lisp) (cdr :lisp))
1455                                   ((temp :imm)))
1456  (subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1457  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1458  (movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1459  (movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1460  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1461  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1462  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1463  (leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1464  (movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1465  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1466  (movl (:%l temp) (:%l dest)))
1467
1468
1469;; make-fixed-stack-gvector
1470
1471(define-x8632-vinsn discard-temp-frame (()
1472                                        ()
1473                                        ((temp :imm)))
1474  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1475  (movl (:@ (:%l temp)) (:%l temp))
1476  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1477  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1478  )
1479
1480(define-x8632-vinsn discard-c-frame (()
1481                                     ()
1482                                     ((temp :imm)))
1483  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1484  (movl (:@ (:%l temp)) (:%l temp))
1485  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1486
1487 
1488(define-x8632-vinsn vstack-discard (()
1489                                    ((nwords :u32const)))
1490  ((:not (:pred = nwords 0))
1491   ((:pred < nwords 16)
1492    (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1493   ((:not (:pred < nwords 16))
1494    (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1495
1496(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1497  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1498    (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1499    (:talign 5)
1500    (jmp (:@ ,spno))
1501    :back
1502    (movl (:$self 0) (:%l x8632::fn))))
1503
1504(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1505  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1506    (:talign 5)
1507    (call (:@ ,spno))
1508    :back
1509    (movl (:$self 0) (:%l x8632::fn))))
1510
1511(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1512  `(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ())
1513    (jmp (:@ ,spno))))
1514
1515(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1516                                                        ((lab :label)))
1517  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1518  (jmp (:@ .SPnthrowvalues)))
1519
1520(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1521                                                        ((lab :label)))
1522  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1523  (jmp (:@ .SPnthrow1value)))
1524
1525(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1526
1527(define-x8632-vinsn bind-interrupt-level-0-inline (()
1528                                                   ()
1529                                                   ((temp :imm)))
1530  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1531  (cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1532  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1533  (pushl (:$b x8632::interrupt-level-binding-index))
1534  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1535  (movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1536  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1537  (jns.pt :done)
1538  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1539  (jae.pt :done)
1540  (ud2a)
1541  (:byte 2)
1542  :done)
1543
1544(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1545
1546(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1547
1548(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1549
1550(define-x8632-vinsn (jump-return-pc :jumpLR) (()
1551                                              ())
1552  (ret))
1553
1554;;; xxx
1555(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
1556                                                      ((lab :label))
1557                                                      ((entry (:label 1))
1558                                                       (xfn (:lisp #.x8632::xfn))))
1559  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l xfn))
1560  (:talign 5)
1561  (call (:@ .SPmkcatchmv))
1562  :back
1563  (movl (:$self 0) (:%l x8632::fn)))
1564
1565(define-x8632-vinsn (nmkcatch1v :call :subprim-call) (()
1566                                                     ((lab :label))
1567                                                     ((entry (:label 1))))
1568  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1569  (:talign 5)
1570  (call (:@ .SPmkcatch1v))
1571  :back
1572  (movl (:$self 0) (:%l x8632::fn)))
1573
1574
1575(define-x8632-vinsn (make-simple-unwind :call :subprim-call) (()
1576                                                     ((protform-lab :label)
1577                                                      (cleanup-lab :label)))
1578  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1579  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1580  (jmp (:@ .SPmkunwind)))
1581
1582(define-x8632-vinsn (nmkunwind :call :subprim-call) (()
1583                                                     ((protform-lab :label)
1584                                                      (cleanup-lab :label)))
1585  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1586  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1587  (jmp (:@ .SPnmkunwind)))
1588
1589
1590(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1591
1592(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1593
1594(define-x8632-vinsn set-eq-bit (()
1595                                ())
1596  (testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1597
1598;;; %schar8
1599;;; %schar32
1600;;; %set-schar8
1601;;; %set-schar32
1602
1603(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1604                                             ((v :lisp)
1605                                              (idx :u32const)))
1606  (movsd (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1607
1608(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1609                                           ((header :lisp)))
1610  (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1611
1612(define-x8632-vinsn set-z-flag-if-istruct-typep (()
1613                                                 ((val :lisp)
1614                                                  (type :lisp))
1615                                                 ((tag :u8)
1616                                                  (valtype :lisp)))
1617  (xorl (:%l valtype) (:%l valtype))
1618  (movl (:%l val) (:%l tag))
1619  (andb (:$b x8632::tagmask) (:%b tag))
1620  (cmpb (:$b x8632::tag-misc) (:%b tag))
1621  (jne :have-tag)
1622  (movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
1623  :have-tag
1624  (cmpb (:$b x8632::subtag-istruct) (:%b tag))
1625  (jne :do-compare)
1626  (movl (:@ x8632::misc-data-offset (:%l val)) (:%l valtype))
1627  :do-compare
1628  (cmpl (:%l valtype) (:%l type)))
1629
1630(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1631
1632(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1633
1634(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1635                                           ((addr :s32const)))
1636  (movzbl (:@ addr) (:%l dest)))
1637
1638(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1639                                           ((addr :s32const)))
1640  (movsbl (:@ addr) (:%l dest)))
1641
1642(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1643                                           ((addr :s32const)))
1644  (movzwl (:@ addr) (:%l dest)))
1645
1646(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1647                                           ((addr :s32const)))
1648  (movswl (:@ addr) (:%l dest)))
1649
1650(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
1651                                                 ((addr :s32const)))
1652  (movl (:@ addr) (:%l dest)))
1653
1654(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
1655                                                        ((addr :s32const)))
1656  (movl (:@ addr) (:%l dest)))
1657
1658(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
1659                                                   ((addr :s32const)))
1660  (movl (:@ addr) (:%l dest)))
1661
1662(define-x8632-vinsn misc-set-u32  (()
1663                                   ((val :u32)
1664                                    (v :lisp)
1665                                    (scaled-idx :s32))
1666                                   ())
1667  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1668
1669(define-x8632-vinsn %iasr-c (((dest :imm))
1670                             ((count :u8const)
1671                              (src :imm))
1672                             ((temp :s32)))
1673  (movl (:%l src) (:%l temp))
1674  (sarl (:$ub count) (:%l temp))
1675  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
1676  (movl (:%l temp) (:%l dest)))
1677
1678(define-x8632-vinsn %ilsr-c (((dest :imm))
1679                             ((count :u8const)
1680                              (src :imm))
1681                             ((temp :s32)))
1682  (movl (:%l src) (:%l temp))
1683  (shrl (:$ub count) (:%l temp))
1684  ;; xxx --- use :%acc
1685  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
1686  (movl (:%l temp) (:%l dest)))
1687
1688(define-x8632-vinsn %ilsl (((dest :imm))
1689                           ((count :imm)
1690                            (src :imm))
1691                           ((temp (:s32 #.x8632::eax))
1692                            (shiftcount (:s32 #.x8632::ecx))))
1693  (movl (:%l count) (:%l temp))
1694  (sarl (:$ub x8632::fixnumshift) (:%l temp))
1695  (rcmpl (:%l temp) (:$l 31))
1696  (cmovbw (:%w temp) (:%w shiftcount))
1697  (movl (:%l src) (:%l temp))
1698  (jae :shift-max)
1699  (shll (:%shift x8632::cl) (:%l temp))
1700  (jmp :done)
1701  :shift-max
1702  (xorl (:%l temp) (:%l temp))
1703  :done
1704  (movl (:%l temp) (:%l dest)))
1705
1706(define-x8632-vinsn %ilsl-c (((dest :imm))
1707                             ((count :u8const)
1708                              (src :imm)))
1709  ((:not (:pred =
1710                (:apply %hard-regspec-value src)
1711                (:apply %hard-regspec-value dest)))
1712   (movl (:%l src) (:%l dest)))
1713  (shll (:$ub count) (:%l dest)))
1714
1715(define-x8632-vinsn require-fixnum (()
1716                                    ((object :lisp)))
1717  :again
1718  ((:and (:pred > (:apply %hard-regspec-value object) x8632::eax)
1719         (:pred <= (:apply %hard-regspec-value object) x8632::ebx))
1720   (testb (:%b x8632::fixnummask) (:%b object)))
1721  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
1722   (testl (:$l x8632::fixnummask) (:%l object)))
1723  (je.pt :got-it)
1724  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-fixnum))
1725  (jmp :again)
1726  :got-it)
1727
1728(define-x8632-vinsn require-integer (()
1729                                     ((object :lisp))
1730                                     ((tag :u8)))
1731  :again
1732  (movl (:%l object) (:%l tag))
1733  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1734   (andb (:$b x8632::fixnummask) (:%accb tag)))
1735  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1736         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1737   (andb (:$b x8632::fixnummask) (:%b tag)))
1738  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
1739   (andl (:$l x8632::fixnummask) (:%l tag)))
1740  (je.pt :got-it)
1741  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1742   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
1743  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1744         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1745   (cmpb (:$b x8632::tag-misc) (:%b tag)))
1746  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
1747   (cmpl (:$l x8632::tag-misc) (:%l tag)))
1748  (jne :bad)
1749  (cmpb (:$b x8632::subtag-bignum) (:@ x8632::misc-subtag-offset (:%l object)))
1750  (je :got-it)
1751  :bad
1752  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-integer))
1753  (jmp :again)
1754  :got-it)
1755
1756;;; naive
1757(define-x8632-vinsn require-real (()
1758                                    ((object :lisp))
1759                                    ((tag :u8)))
1760  :again
1761  (movl (:%l object) (:%l tag))
1762  (andb (:$b x8632::tagmask) (:%b tag))
1763  (cmpb (:$b x8632::tag-fixnum) (:%b tag))
1764  (je :good)
1765  (cmpb (:$b x8632::tag-misc) (:%b tag))
1766  (jne :bad)
1767  (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag))
1768  (cmpb (:$b x8632::subtag-single-float) (:%b tag))
1769  (je :good)
1770  (cmpb (:$b x8632::subtag-double-float) (:%b tag))
1771  (je :good)
1772  (cmpb (:$b x8632::subtag-bignum) (:%b tag))
1773  (je :good)
1774  (cmpb (:$b x8632::subtag-ratio) (:%b tag))
1775  (je :good)
1776  :bad
1777  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-real))
1778  (jmp :again)
1779  :good)
1780
1781(define-x8632-vinsn require-symbol (()
1782                                    ((object :lisp))
1783                                    ((tag :u8)))
1784  :again
1785  (cmpl (:$l x8632::nil-value) (:%l object))
1786  (je :got-it)
1787  (movl (:%l object) (:%l tag))
1788  (andb (:$b x8632::tagmask) (:%b tag))
1789  (cmpb (:$b x8632::tag-misc) (:%b tag))
1790  (jne :bad)
1791  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l object)))
1792  (je :got-it)
1793  :bad
1794  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))
1795  (jmp :again)
1796  :got-it)
1797
1798(define-x8632-vinsn mask-base-char (((dest :u8))
1799                                    ((src :lisp)))
1800  (movzbl (:%b src) (:%l dest)))
1801
1802(define-x8632-vinsn event-poll (()
1803                                ())
1804  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1805  (jae :no-interrupt)
1806  (ud2a)
1807  (:byte 2)
1808  :no-interrupt)
1809
1810;;; check-2d-bound
1811;;; check-3d-bound
1812
1813(define-x8632-vinsn 2d-dim1 (((dest :u32))
1814                             ((header :lisp)))
1815  (movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
1816            (:%l header)) (:%l dest))
1817  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
1818
1819;;; 3d-dims
1820
1821;;; xxx
1822(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
1823                                        (dim1 :u32))
1824                                       ((dim1 :u32)
1825                                        (i :imm)
1826                                        (j :imm)))
1827
1828  (imull (:%l i) (:%l dim1))
1829  (leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
1830
1831;;; 3d-unscaled-index
1832
1833(define-x8632-vinsn branch-unless-both-args-fixnums (()
1834                                                     ((a :lisp)
1835                                                      (b :lisp)
1836                                                      (dest :label))
1837                                                     ((tag :u8)))
1838  (movl (:%l a) (:%l tag))
1839  (orl (:%l b) (:%l tag))
1840  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1841   (testb (:$b x8632::fixnummask) (:%accb tag)))
1842  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1843         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1844   (testb (:$b x8632::fixnummask) (:%b tag)))
1845  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
1846   (testl (:$l x8632::fixnummask) (:%l tag)))
1847  (jne dest))
1848
1849(define-x8632-vinsn branch-unless-arg-fixnum (()
1850                                              ((a :lisp)
1851                                               (dest :label)))
1852  ((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
1853   (testb (:$b x8632::fixnummask) (:%b a)))
1854  ((:pred > (:apply %hard-regspec-value a) x8632::ebx)
1855   (testl (:$l x8632::fixnummask) (:%l a)))
1856  (jne dest))
1857
1858(define-x8632-vinsn fixnum->single-float (((f :single-float))
1859                                          ((arg :lisp))
1860                                          ((unboxed :s32)))
1861  (movl (:%l arg) (:%l unboxed))
1862  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1863  (cvtsi2ssl (:%l unboxed) (:%xmm f)))
1864
1865(define-x8632-vinsn fixnum->double-float (((f :double-float))
1866                                          ((arg :lisp))
1867                                          ((unboxed :s32)))
1868  (movl (:%l arg) (:%l unboxed))
1869  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1870  (cvtsi2sdl (:%l unboxed) (:%xmm f)))
1871
1872(define-x8632-vinsn xchg-registers (()
1873                                    ((a t)
1874                                     (b t)))
1875  (xchgl (:%l a) (:%l b)))
1876
1877(define-x8632-vinsn establish-fn (()
1878                                  ())
1879  (movl (:$self 0) (:%l x8632::fn)))
1880
1881
1882(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
1883
1884(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
1885
1886
1887(define-x8632-vinsn character->code (((dest :u32))
1888                                     ((src :lisp)))
1889  (movl (:%l src) (:%l dest))
1890  (sarl (:$ub x8632::charcode-shift) (:%l dest)))
1891
1892(define-x8632-vinsn adjust-vsp (()
1893                                ((amount :s32const)))
1894  ((:and (:pred >= amount -128) (:pred <= amount 127))
1895   (addl (:$b amount) (:%l x8632::esp)))
1896  ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
1897   (addl (:$l amount) (:%l x8632::esp))))
1898
1899
1900(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
1901                                                          ((spno :s32const)
1902                                                           (y t)
1903                                                           (z t))
1904                                                          ((entry (:label 1))))
1905  (:talign 5)
1906  (call (:@ spno))
1907  (movl (:$self 0) (:%l x8632::fn)))
1908
1909(define-x8632-vinsn zero-double-float-register (((dest :double-float))
1910                                                ())
1911  (movsd (:%xmm x8632::fpzero) (:%xmm dest)))
1912
1913(define-x8632-vinsn zero-single-float-register (((dest :single-float))
1914                                                ())
1915  (movss (:%xmm x8632::fpzero) (:%xmm dest)))
1916
1917(define-x8632-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
1918(define-x8632-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
1919(define-x8632-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
1920
1921
1922(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
1923
1924(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
1925                                               ((src :lisp))
1926                                               ((temp :u32)))
1927  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
1928  ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
1929         (:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
1930   (movb (:$b 0) (:%b temp)))
1931  ((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
1932   (andl (:$l #xffffff00) (:%l temp)))
1933  (movl (:%l temp) (:%l dest))
1934  (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l dest)))
1935
1936
1937
1938(define-x8632-vinsn %logior2 (((dest :imm))
1939                              ((x :imm)
1940                               (y :imm)))
1941  ((:pred =
1942          (:apply %hard-regspec-value x)
1943          (:apply %hard-regspec-value dest))
1944   (orl (:%l y) (:%l dest)))
1945  ((:not (:pred =
1946                (:apply %hard-regspec-value x)
1947                (:apply %hard-regspec-value dest)))
1948   ((:pred =
1949           (:apply %hard-regspec-value y)
1950           (:apply %hard-regspec-value dest))
1951    (orl (:%l x) (:%l dest)))
1952   ((:not (:pred =
1953                 (:apply %hard-regspec-value y)
1954                 (:apply %hard-regspec-value dest)))
1955    (movl (:%l x) (:%l dest))
1956    (orl (:%l y) (:%l dest)))))
1957
1958(define-x8632-vinsn %logand2 (((dest :imm))
1959                              ((x :imm)
1960                               (y :imm)))
1961  ((:pred =
1962          (:apply %hard-regspec-value x)
1963          (:apply %hard-regspec-value dest))
1964   (andl (:%l y) (:%l dest)))
1965  ((:not (:pred =
1966                (:apply %hard-regspec-value x)
1967                (:apply %hard-regspec-value dest)))
1968   ((:pred =
1969           (:apply %hard-regspec-value y)
1970           (:apply %hard-regspec-value dest))
1971    (andl (:%l x) (:%l dest)))
1972   ((:not (:pred =
1973                 (:apply %hard-regspec-value y)
1974                 (:apply %hard-regspec-value dest)))
1975    (movl (:%l x) (:%l dest))
1976    (andl (:%l y) (:%l dest)))))
1977
1978(define-x8632-vinsn %logxor2 (((dest :imm))
1979                              ((x :imm)
1980                               (y :imm)))
1981  ((:pred =
1982          (:apply %hard-regspec-value x)
1983          (:apply %hard-regspec-value dest))
1984   (xorl (:%l y) (:%l dest)))
1985  ((:not (:pred =
1986                (:apply %hard-regspec-value x)
1987                (:apply %hard-regspec-value dest)))
1988   ((:pred =
1989           (:apply %hard-regspec-value y)
1990           (:apply %hard-regspec-value dest))
1991    (xorl (:%l x) (:%l dest)))
1992   ((:not (:pred =
1993                 (:apply %hard-regspec-value y)
1994                 (:apply %hard-regspec-value dest)))
1995    (movl (:%l x) (:%l dest))
1996    (xorl (:%l y) (:%l dest)))))
1997
1998(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
1999
2000(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
2001
2002(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
2003
2004(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
2005
2006(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
2007
2008(define-x8632-subprim-lea-jmp-vinsn (make-stack-gvector)  .SPstkgvector)
2009
2010(define-x8632-vinsn load-character-constant (((dest :lisp))
2011                                             ((code :u32const))
2012                                             ())
2013  (movl (:$l (:apply logior (:apply ash code 8) x8632::subtag-character))
2014        (:%l dest)))
2015
2016
2017(define-x8632-vinsn setup-double-float-allocation (()
2018                                                   ())
2019  (movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
2020  (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8664::imm1.l)))
2021
2022(define-x8632-vinsn set-double-float-value (()
2023                                            ((node :lisp)
2024                                             (val :double-float)))
2025  (movsd (:%xmm val) (:@ x8664::double-float.value (:%l node))))
2026
2027(define-x8632-vinsn %natural+  (((result :u32))
2028                               ((result :u32)
2029                                (other :u32)))
2030  (addl (:%l other) (:%l result)))
2031
2032(define-x8632-vinsn %natural+-c (((result :u32))
2033                                ((result :u32)
2034                                 (constant :s32const)))
2035  (addl (:$l constant) (:%l result)))
2036
2037(define-x8632-vinsn %natural-  (((result :u32))
2038                               ((result :u32)
2039                                (other :u32)))
2040  (subl (:%l other) (:%l result)))
2041
2042(define-x8632-vinsn %natural--c (((result :u32))
2043                                ((result :u32)
2044                                 (constant :s32const)))
2045  (subl (:$l constant) (:%l result)))
2046
2047(define-x8632-vinsn %natural-logior (((result :u32))
2048                                    ((result :u32)
2049                                     (other :u32)))
2050  (orl (:%l other) (:%l result)))
2051
2052(define-x8632-vinsn %natural-logior-c (((result :u32))
2053                                      ((result :u32)
2054                                       (constant :s32const)))
2055  (orl (:$l constant) (:%l result)))
2056
2057(define-x8632-vinsn %natural-logand (((result :u32))
2058                                    ((result :u32)
2059                                     (other :u32)))
2060  (andl (:%l other) (:%l result)))
2061
2062(define-x8632-vinsn %natural-logand-c (((result :u32))
2063                                      ((result :u32)
2064                                       (constant :s32const)))
2065  (andl (:$l constant) (:%l result)))
2066
2067(define-x8632-vinsn %natural-logxor (((result :u32))
2068                                    ((result :u32)
2069                                     (other :u32)))
2070  (xorl (:%l other) (:%l result)))
2071
2072(define-x8632-vinsn %natural-logxor-c (((result :u32))
2073                                       ((result :u32)
2074                                        (constant :s32const)))
2075  (xorl (:$l constant) (:%l result)))
2076
2077(define-x8632-vinsn natural-shift-left (((dest :u32))
2078                                        ((dest :u32)
2079                                         (amt :u8const)))
2080  (shll (:$ub amt) (:%l dest)))
2081
2082(define-x8632-vinsn natural-shift-right (((dest :u32))
2083                                         ((dest :u32)
2084                                          (amt :u8const)))
2085  (shrl (:$ub amt) (:%l dest)))
2086
2087(define-x8632-vinsn recover-fn (()
2088                                ())
2089  (movl (:$self 0) (:%l x8632::fn)))
2090
2091;;; xxx probably wrong
2092(define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
2093                                                          ((spno :s32const)
2094                                                           (x t)
2095                                                           (y t)
2096                                                           (z t))
2097                                                          ((entry (:label 1))))
2098  (:talign 5)
2099  (call (:@ spno))
2100  (movl (:$self 0) (:%l x8632::fn)))
2101
2102(define-x8632-vinsn vcell-ref (((dest :lisp))
2103                               ((vcell :lisp)))
2104  (movl (:@ x8632::misc-data-offset (:%l vcell)) (:%l dest)))
2105
2106(define-x8632-vinsn setup-vcell-allocation (()
2107                                            ())
2108  (movl (:$l x8632::value-cell-header) (:%l x8632::imm0))
2109  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2110  (movl (:$l (- x8632::value-cell.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2111
2112(define-x8632-vinsn %init-vcell (()
2113                                 ((vcell :lisp)
2114                                  (closed :lisp)))
2115  (movl (:%l closed) (:@ x8632::value-cell.value (:%l vcell))))
2116
2117;;; "old" mkunwind.  Used by PROGV, since the binding of *interrupt-level*
2118;;; on entry to the new mkunwind confuses the issue.
2119
2120(define-x8632-vinsn (mkunwind :call :subprim-call) (()
2121                                                     ((protform-lab :label)
2122                                                      (cleanup-lab :label)))
2123  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
2124  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
2125  (jmp (:@ .SPmkunwind)))
2126
2127
2128;;; Funcall the function or symbol in temp0 and obtain the single
2129;;; value that it returns.
2130(define-x8632-vinsn funcall (()
2131                             ()
2132                             ((tag :u8)
2133                              (entry (:label 1))))
2134  (movl (:%l x8632::temp0) (:%l tag))
2135  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2136   ;; accumulator
2137   (andb (:$b x8632::tagmask) (:%accb tag))
2138   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
2139  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2140         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2141   ;; other register that can be treated as a byte
2142   (andb (:$b x8632::tagmask) (:%b tag))
2143   (cmpb (:$b x8632::tag-misc) (:%b tag)))
2144  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2145   ;; non-byte register
2146   (andl (:$l x8632::tagmask) (:%l tag))
2147   (cmpl (:$b x8632::tag-misc) (:%l tag)))
2148  (jne :bad)
2149  (movl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
2150  (cmpl (:$b x8632::subtag-function) (:%l tag))
2151  (cmovel (:%l x8632::temp0) (:%l x8632::xfn))
2152  (je :call)
2153  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
2154  (cmovel (:%l x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::xfn))
2155  (jne :bad)
2156  :call
2157  (:talign 5)
2158  (call (:%l x8632::xfn))
2159  (movl (:$self 0) (:%l x8632::fn))
2160  :bad
2161  (uuo-error-not-callable))
2162
2163(define-x8632-vinsn tail-funcall (()
2164                                  ()
2165                                  ((tag :u8)))
2166  (movl (:%l x8632::temp0) (:%l tag))
2167  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2168   ;; accumulator
2169   (andb (:$b x8632::tagmask) (:%accb tag))
2170   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
2171  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2172         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2173   ;; other register that can be treated as a byte
2174   (andb (:$b x8632::tagmask) (:%b tag))
2175   (cmpb (:$b x8632::tag-misc) (:%b tag)))
2176  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2177   ;; non-byte register
2178   (andl (:$l x8632::tagmask) (:%l tag))
2179   (cmpl (:$b x8632::tag-misc) (:%l tag)))
2180  (jne :bad)
2181  (movl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
2182  (cmpl (:$b x8632::subtag-function) (:%l tag))
2183  (cmovel (:%l x8632::temp0) (:%l x8632::xfn))
2184  (je :go)
2185  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
2186  (cmovel (:%l x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::xfn))
2187  (jne :bad)
2188  :go
2189  (jmp (:%l x8664::xfn))
2190  :bad
2191  (uuo-error-not-callable))
2192
2193;;; Magic numbers in here include the address of .SPcall-closure.
2194
2195;;; movl $self, %fn
2196;;; jmp *20660 (.SPcall-closure)
2197(define-x8632-vinsn init-nclosure (()
2198                                   ((closure :lisp)))
2199  (movb (:$b 4) (:@ x8632::misc-data-offset (:%l closure))) ;imm word count
2200  (movb (:$b #xbf) (:@ (+ x8632::misc-data-offset 2) (:%l closure))) ;movl $self, %fn
2201  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 3) (:%l closure)))
2202  (movb (:$b #xff) (:@ (+ x8632::misc-data-offset 7) (:%l closure))) ;jmp
2203  (movl (:$l #x0050b425) (:@ (+ x8632::misc-data-offset 8) (:%l closure))) ;.SPcall-closure
2204  ;; already aligned
2205  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 16) (:%l closure))) ;self-reference entry
2206  (movb (:$b x8632::function-boundary-marker) (:@ (+ x8632::misc-data-offset 20) (:%l closure))))
2207
2208(define-x8632-vinsn finalize-closure (((closure :lisp))
2209                                      ((closure :lisp)))
2210  (nop))
2211
2212
2213(define-x8632-vinsn (ref-symbol-value :call :subprim-call)
2214    (((val :lisp))
2215     ((sym (:lisp (:ne val)))))
2216  (:talign 5)
2217  (call (:@ .SPspecrefcheck))
2218  (movl (:$self 0) (:%l x8632::fn)))
2219
2220(define-x8632-vinsn %ref-symbol-value-inline (((dest :lisp))
2221                                              ((src (:lisp (:ne dest))))
2222                                              ((table :imm)
2223                                               (idx :imm)))
2224  (movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
2225  (rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
2226  (jae :symbol)
2227  (addl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l idx))
2228  (movl (:@ (:%l idx)) (:%l dest))
2229  (cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
2230  (jne :done)
2231  :symbol
2232  (movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
2233  :done)
2234
2235(define-x8632-subprim-lea-jmp-vinsn (bind-nil)  .SPbind-nil)
2236
2237(define-x8632-subprim-lea-jmp-vinsn (bind-self)  .SPbind-self)
2238
2239(define-x8632-subprim-lea-jmp-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
2240
2241(define-x8632-subprim-lea-jmp-vinsn (bind)  .SPbind)
2242
2243(define-x8632-vinsn (dpayback :call :subprim-call) (()
2244                                                    ((n :s16const))
2245                                                    ((temp (:u32 #.x8632::imm0))
2246                                                     (entry (:label 1))))
2247  ((:pred > n 0)
2248   ((:pred > n 1)
2249    (movl (:$l n) (:%l temp))
2250    (:talign 4)
2251    (call (:@ .SPunbind-n)))
2252   ((:pred = n 1)
2253    (:talign 5)
2254    (call (:@ .SPunbind)))
2255   (movl (:$self 0) (:%l x8632::fn))))
2256
2257(define-x8632-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
2258
2259(define-x8632-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
2260
2261(define-x8632-vinsn node-slot-ref  (((dest :lisp))
2262                                    ((node :lisp)
2263                                     (cellno :u32const)))
2264  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash cellno 2))
2265            (:%l node)) (:%l dest)))
2266
2267(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list)  .SPstkconslist)
2268
2269
2270(define-x8632-vinsn (setq-special :call :subprim-call)
2271    (()
2272     ((sym :lisp)
2273      (val :lisp))
2274     ((entry (:label 1))))
2275  (:talign 5)
2276  (call (:@ .SPspecset))
2277  (movl (:$self 0) (:%l x8632::fn)))
2278
2279(define-x8632-vinsn %symptr->symvector (((target :lisp))
2280                                        ((target :lisp)))
2281  (nop))
2282
2283(define-x8632-vinsn %symvector->symptr (((target :lisp))
2284                                        ((target :lisp)))
2285  (nop))
2286
2287(define-x8632-vinsn symbol-function (((val :lisp))
2288                                     ((sym (:lisp (:ne val))))
2289                                     ((tag :u8)))
2290  (movl (:@ x8632::symbol.fcell (:%l sym)) (:%l val))
2291  (movl (:%l val) (:%l tag))
2292  (andb (:$b x8632::tagmask) (:%b tag))
2293  (cmpb (:$b x8632::tag-misc) (:%b tag))
2294  (jne.pn :bad)
2295  (movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
2296  (cmpb (:$b x8632::subtag-function) (:%b tag))
2297  (je.pt :ok)
2298  :bad
2299  (uuo-error-udf (:%l sym))
2300  :ok)
2301
2302(define-x8632-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
2303
2304(define-x8632-vinsn load-double-float-constant (((dest :double-float))
2305                                                ((lab :label)))
2306  (movsd (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
2307
2308(define-x8632-vinsn load-single-float-constant (((dest :single-float))
2309                                                ((lab :label)))
2310  (movss (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
2311
2312(define-x8632-subprim-call-vinsn (misc-set) .SPmisc-set)
2313
2314(define-x8632-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
2315
2316(define-x8632-subprim-lea-jmp-vinsn (spread-list)  .SPspreadargz)
2317
2318(define-x8632-vinsn unbox-base-char (((dest :u32))
2319                                     ((src :lisp)))
2320  (movl (:%l src) (:%l dest))
2321  ((:pred = (:apply %hard-regspec-value dest) x8632::eax)
2322   (cmpb (:$b x8632::subtag-character) (:%accb dest)))
2323  ((:and (:pred > (:apply %hard-regspec-value dest) x8632::eax)
2324         (:pred <= (:apply %hard-regspec-value dest) x8632::ebx))
2325   (cmpb (:$b x8632::subtag-character) (:%b dest)))
2326  ((:pred > (:apply %hard-regspec-value dest) x8632::ebx)
2327   ;; very rare case, if even possible...
2328   (andl (:$l #xff) (:%l dest))
2329   (cmpl (:$b x8632::subtag-character) (:%l dest))
2330   (cmovel (:%l src) (:%l dest)))
2331  (je.pt ::got-it)
2332  (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-character))
2333  :got-it
2334  (shrl (:$ub x8632::charcode-shift) (:%l dest)))
2335
2336(define-x8632-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
2337
2338(define-x8632-subprim-lea-jmp-vinsn (recover-values)  .SPrecover-values)
2339
2340(define-x8632-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
2341
2342(define-x8632-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
2343
2344(define-x8632-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
2345
2346(define-x8632-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
2347
2348;;; "dest" is preallocated, presumably on a stack somewhere.
2349(define-x8632-vinsn store-double (()
2350                                  ((dest :lisp)
2351                                   (source :double-float))
2352                                  ())
2353  (movsd (:%xmm source) (:@  x8632::double-float.value (:%l dest))))
2354
2355
2356(define-x8632-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
2357
2358(define-x8632-vinsn %init-gvector (()
2359                                   ((v :lisp)
2360                                    (nbytes :u32const))
2361                                   ((count :imm)))
2362  (movl (:$l nbytes) (:%l count))
2363  (jmp :test)
2364  :loop
2365  (popl (:@ x8632::misc-data-offset (:%l v) (:%l count)))
2366  :test
2367  (subl (:$b x8632::node-size) (:%l count))
2368  (jge :loop))
2369
2370(define-x8632-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
2371
2372(define-x8632-vinsn nth-value (((result :lisp))
2373                               ()
2374                               ((temp :imm)))
2375  (movzwl (:%w x8632::nargs) (:%l x8632::nargs))
2376  (leal (:@ (:%l x8632::esp) (:%l x8632::nargs)) (:%l temp))
2377  (subl (:@ (:%l temp)) (:%l x8632::nargs))
2378  (movl (:$l x8632::nil-value) (:%l result))
2379  (jle :done)
2380  ;; I -think- that a CMOV would be safe here, assuming that N wasn't
2381  ;; extremely large.  Don't know if we can assume that.
2382  (movl (:@ (- x8632::node-size) (:%l x8632::esp) (:%l x8632::nargs)) (:%l result))
2383  :done
2384  (leal (:@ x8632::node-size (:%l temp)) (:%l x8632::esp)))
2385
2386
2387(define-x8632-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
2388
2389(define-x8632-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
2390
2391(define-x8632-vinsn fixnum->unsigned-natural (((dest :u32))
2392                                              ((src :imm)))
2393  (movl (:%l src) (:%l dest))
2394  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
2395
2396(define-x8632-vinsn %debug-trap (()
2397                                 ())
2398  (uuo-error-debug-trap))
2399
2400
2401
2402
2403
2404(define-x8632-vinsn  %slot-ref (((dest :lisp))
2405                                ((instance (:lisp (:ne dest)))
2406                                 (index :lisp)))
2407  (movl (:@ x8632::misc-data-offset (:%l instance) (:%l index)) (:%l dest))
2408  (cmpl (:$l x8664::slot-unbound-marker) (:%l dest))
2409  (jne.pt :ok)
2410  (uuo-error-slot-unbound (:%l dest) (:%l instance) (:%l index))
2411  :ok)
2412
2413(define-x8632-vinsn symbol-ref (((dest :lisp))
2414                                ((src :lisp)
2415                                 (cellno :u32const)))
2416  (movl (:@ (:apply + (- x8632::node-size x8632::fulltag-misc)
2417                    (:apply ash cellno 2))
2418              (:%l src)) (:%l dest)))
2419
2420(define-x8632-subprim-call-vinsn (progvsave) .SPprogvsave)
2421
2422(define-x8632-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
2423
2424(define-x8632-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
2425
2426(define-x8632-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
2427
2428(define-x8632-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
2429
2430(define-x8632-vinsn scale-nargs (()
2431                                 ((nfixed :s16const)))
2432  ((:pred > nfixed 0)
2433   (addw (:$w (:apply - (:apply ash nfixed x8632::word-shift))) (:%w x8632::nargs))))
2434
2435
2436;; num-opt in arg_z
2437(define-x8632-vinsn opt-supplied-p (()
2438                                    ())
2439  (subw (:%w x8632::nargs) (:%w x8632::arg_z))
2440  (jmp :push-t-test)
2441  :push-t-loop
2442  (pushl (:$l x8632::t-value))
2443  :push-t-test
2444  (subw (:$w x8632::node-size) (:%w x8632::nargs))
2445  (jge :push-t-loop)
2446  (jmp :push-nil-test)
2447  :push-nil-loop
2448  (pushl (:$l x8632::nil-value))
2449  :push-nil-test
2450  (subw (:$w x8632::node-size) (:%w x8632::arg_z))
2451  (jge :push-nil-loop))
2452
2453(define-x8632-vinsn one-opt-supplied-p (()
2454                                        ())
2455  (testw (:%w x8664::nargs) (:%w x8664::nargs))
2456  (je :one)
2457  (pushl (:$l x8632::nil-value))
2458  (jmp :done)
2459  :one
2460  (pushl (:$l x8632::t-value))
2461  :done)
2462
2463;; needs some love
2464(define-x8632-vinsn two-opt-supplied-p (()
2465                                        ())
2466  ;; note that nargs is imm0
2467  (rcmpw (:%w x8632::nargs) (:$w (:apply ash 2 x8632::word-shift)))
2468  (jge :two)
2469  (rcmpw (:%w x8632::nargs) (:$w (:apply ash 1 x8632::word-shift)))
2470  (je :one)
2471  ;; none
2472  (pushl (:$l x8632::nil-value))
2473  (pushl (:$l x8632::nil-value))
2474  (jmp :done)
2475  :one
2476  (pushl (:$l x8632::t-value))
2477  (pushl (:$l x8632::nil-value))
2478  (jmp :done)
2479  :two
2480  (pushl (:$l x8632::t-value))
2481  (pushl (:$l x8632::t-value))
2482  :done)
2483
2484(define-x8632-vinsn set-c-flag-if-constant-logbitp (()
2485                                                    ((bit :u8const)
2486                                                     (int :imm)))
2487  (btl (:$ub bit) (:%l int)))
2488
2489(define-x8632-vinsn mark-as-imm (()
2490                                 ((reg :lisp)))
2491  (btrl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
2492
2493(define-x8632-vinsn mark-as-node (()
2494                                  ((reg :lisp)))
2495  (xorl (:%l reg) (:%l reg))
2496  (btsl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
2497
2498(queue-fixup
2499 (fixup-x86-vinsn-templates
2500  *x8632-vinsn-templates*
2501  x86::*x86-opcode-template-lists*))
2502
Note: See TracBrowser for help on using the repository browser.