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

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

More vinsns. Some wrong for sure.

File size: 69.2 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
16(define-x8632-vinsn scale-16bit-misc-index (((dest :u32))
17                                            ((idx :imm))) ; A fixnum
18  (movl (:%l idx) (:%l dest))
19  (shrl (:$ub 1) (:%l dest)))
20
21(define-x8632-vinsn scale-8bit-misc-index (((dest :u32))
22                                            ((idx :imm))) ; A fixnum
23  (movl (:%l idx) (:%l dest))
24  (shrl (:$ub 2) (:%l dest)))
25
26(define-x8632-vinsn misc-ref-u32 (((dest :u32))
27                                  ((v :lisp)
28                                   (scaled-idx :u32)))
29  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
30
31(define-x8632-vinsn misc-ref-double-float  (((dest :double-float))
32                                            ((v :lisp)
33                                             (scaled-idx :imm)))
34  (movsd (:@ x8632::misc-dfloat-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
35
36(define-x8632-vinsn misc-ref-c-double-float  (((dest :double-float))
37                                              ((v :lisp)
38                                               (idx :s32const)))
39  (movsd (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
40
41(define-x8632-vinsn misc-ref-node  (((dest :lisp))
42                                    ((v :lisp)
43                                     (scaled-idx :imm)))
44  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
45
46(define-x8632-vinsn (push-misc-ref-node :push :node :vsp) (()
47                                                           ((v :lisp)
48                                                            (scaled-idx :imm)))
49  (pushl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
50
51(define-x8632-vinsn misc-set-node (()
52                                   ((val :lisp)
53                                    (v :lisp)
54                                    (unscaled-idx :imm))
55                                   ())
56  (movl (:%l val) (:@ x8632::misc-data-offset (:%l  v) (:%l unscaled-idx))))
57
58(define-x8632-vinsn misc-set-immediate-node (()
59                                             ((val :s32const)
60                                              (v :lisp)
61                                              (unscaled-idx :imm))
62                                             ())
63  (movl (:$l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
64
65(define-x8632-vinsn misc-set-double-float (()
66                                   ((val :double-float)
67                                    (v :lisp)
68                                    (unscaled-idx :imm))
69                                   ())
70  (movsd (:%xmm val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
71
72(define-x8632-vinsn misc-ref-u8 (((dest :u8))
73                                 ((v :lisp)
74                                  (scaled-idx :s32)))
75  (movzbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
76
77(define-x8632-vinsn misc-ref-s8 (((dest :s8))
78                                 ((v :lisp)
79                                  (scaled-idx :s32)))
80  (movsbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
81
82(define-x8632-vinsn misc-ref-u16 (((dest :u16))
83                                  ((v :lisp)
84                                   (scaled-idx :s32)))
85  (movzwl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
86
87(define-x8632-vinsn misc-ref-u32 (((dest :u32))
88                                  ((v :lisp)
89                                   (scaled-idx :s32)))
90  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
91
92(define-x8632-vinsn misc-ref-single-float (((dest :single-float))
93                                           ((v :lisp)
94                                            (scaled-idx :s32)))
95  (movss (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
96
97(define-x8632-vinsn misc-ref-s32 (((dest :s32))
98                                  ((v :lisp)
99                                   (scaled-idx :s32)))
100  (movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
101
102(define-x8632-vinsn misc-ref-s16 (((dest :s16))
103                                  ((v :lisp)
104                                   (scaled-idx :s32)))
105  (movswl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
106
107(define-x8632-vinsn misc-ref-c-node  (((dest :lisp))
108                                     ((v :lisp)
109                                      (idx :u32const)) ; sic
110                                     ())
111  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
112
113(define-x8632-vinsn (push-misc-ref-c-node :push :node :vsp)
114    (()
115     ((v :lisp)
116      (idx :u32const)) ; sic
117     ())
118  (pushl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v))))
119
120(define-x8632-vinsn misc-ref-c-u32  (((dest :u32))
121                                     ((v :lisp)
122                                      (idx :u32const)) ; sic
123                                     ())
124  ;; xxx - should the 2 be x8632::word-shift?
125  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)) (:%l dest)))
126
127(define-x8632-vinsn misc-ref-c-s32  (((dest :s32))
128                                     ((v :lisp)
129                                      (idx :s32const)) ; sic
130                                     ())
131  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
132
133(define-x8632-vinsn misc-ref-c-single-float  (((dest :single-float))
134                                              ((v :lisp)
135                                               (idx :s32const)) ; sic
136                                              ())
137  (movss (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
138
139(define-x8632-vinsn misc-ref-c-u8  (((dest :u32))
140                                     ((v :lisp)
141                                      (idx :s32const)) ; sic
142                                     ())
143  (movzbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
144
145(define-x8632-vinsn misc-ref-c-s8  (((dest :s32))
146                                     ((v :lisp)
147                                      (idx :s32const)) ; sic
148                                     ())
149  (movsbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
150
151(define-x8632-vinsn misc-set-c-node (()
152                                     ((val :lisp)
153                                      (v :lisp)
154                                     (idx :s32const)))
155  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
156
157(define-x8632-vinsn misc-set-immediate-c-node (()
158                                               ((val :s32const)
159                                                (v :lisp)
160                                                (idx :s32const)))
161  (movl (:$l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
162
163;;; xxx don't know if this is right
164(define-x8632-vinsn set-closure-forward-reference (()
165                                                   ((val :lisp)
166                                                    (closure :lisp)
167                                                    (idx :s32const)))
168  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l closure))))
169
170(define-x8632-vinsn misc-set-c-double-float (()
171                                    ((val :double-float)
172                                     (v :lisp)
173                                     (idx :s32const)))
174  (movsd (:%xmm val) (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v))))
175
176(define-x8632-vinsn (call-known-symbol :call) (((result (:lisp x8632::arg_z)))
177                                               ()
178                                               ((entry (:label 1))))
179  (:talign x8632::fulltag-tra)
180  (call (:@ x8632::symbol.fcell (:% x8632::fname)))
181  (movl (:$self 0) (:%l x8632::fn)))
182
183(define-x8632-vinsn (jump-known-symbol :jumplr) (()
184                                                 ())
185
186  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
187
188(define-x8632-vinsn set-nargs (()
189                               ((n :s16const)))
190  ((:pred = n 0)
191   (xorw (:%w x8632::nargs ) (:%w x8632::nargs )))
192  ((:not (:pred = n 0))
193   (movw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs ))))
194
195(define-x8632-vinsn check-exact-nargs (()
196                                       ((n :u16const)))
197  ((:pred = n 0)
198   (testw (:%w x8632::nargs) (:%w x8632::nargs)))
199  ((:not (:pred = n 0))
200   (cmpw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs)))
201  (jz.pt :ok)
202  (uuo-error-wrong-number-of-args)
203  :ok)
204
205(define-x8632-vinsn check-min-nargs (()
206                                       ((n :u16const)))
207  (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
208  (jae.pt :ok)
209  (uuo-error-too-few-args)
210  :ok)
211
212(define-x8632-vinsn check-max-nargs (()
213                                       ((n :u16const)))
214  (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
215  (jbe.pt :ok)
216  (uuo-error-too-many-args)
217  :ok)
218
219(define-x8632-vinsn default-1-arg (()
220                                   ((min :u16const)))
221  (rcmpw (:%w x8632::nargs) (:$w (:apply ash min x8632::word-shift)))
222  (jne :done)
223  ((:pred >= min 2)
224   (pushl (:%l x8632::arg_y)))
225  ((:pred >= min 1)
226   (movl (:%l x8632::arg_z) (:%l x8632::arg_y)))
227  (movl (:$l x8632::nil-value) (:%l x8632::arg_z))
228  :done)
229
230(define-x8632-vinsn default-2-args (()
231                                    ((min :u16const)))
232  (rcmpw (:%w x8632::nargs ) (:$w (:apply ash (:apply 1+ min) x8632::word-shift)))
233  (ja :done)
234  (je :one)
235  ;; We got "min" args; arg_y & arg_z default to nil
236  ((:pred >= min 2)
237   (pushl (:%l x8632::arg_y)))
238  ((:pred >= min 1)
239   (pushl (:%l x8632::arg_z)))
240  (movl (:$l x8632::nil-value) (:%l x8632::arg_y))
241  (jmp :last)
242  :one
243  ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
244  ((:pred >= min 1)
245   (pushl (:%l x8632::arg_y)))
246  (movl (:%l x8632::arg_z) (:%l x8632::arg_y))
247  :last
248  (movl (:$l x8632::nil-value) (:%l x8632::arg_z))
249  :done)
250
251(define-x8632-vinsn default-optionals (()
252                                       ((n :u16const))
253                                       ((temp :u32)))
254  (rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::word-shift)))
255  (movw (:%w x8632::nargs) (:%w temp))
256  (jae :done)
257  :loop
258  (addw (:$w x8632::fixnumone) (:%w temp))
259  (cmpw (:$w (:apply ash n x8632::word-shift)) (:%w temp))
260  (pushl (:$l x8632::nil-value))
261  (jne :loop)
262  :done)
263
264(define-x8632-vinsn save-lisp-context-no-stack-args (()
265                                                     ())
266  (pushl (:%l x8632::ebp))
267  (movl (:%l x8632::esp) (:%l x8632::ebp)))
268
269(define-x8632-vinsn save-lisp-context-offset (()
270                                              ((nbytes-pushed :s32const)))
271  (movl (:%l x8632::ebp) (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)))
272  (leal (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)) (:%l x8632::ebp))
273  (popl  (:@ x8632::node-size (:%l x8632::ebp))))
274
275(define-x8632-vinsn save-lisp-context-variable-arg-count (()
276                                                          ()
277                                                          ((temp :u32)))
278  (movzwl (:%w x8632::nargs) (:%l temp))
279  (subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
280  (jle :push)
281  (movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
282  (leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
283  (popl (:@ x8632::node-size (:%l x8632::ebp)))
284  (jmp :done)
285  :push
286  (pushl (:%l x8632::ebp))
287  (movl (:%l x8632::esp) (:%l x8632::ebp))
288  :done)
289
290;;; We know that some args were pushed, but don't know how many were
291;;; passed.
292(define-x8632-vinsn save-lisp-context-in-frame (()
293                                                ()
294                                                ((temp :u32)))
295  (movzwl (:%w x8632::nargs) (:%l temp))
296  (subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
297  (movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
298  (leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
299  (popl  (:@ x8632::node-size (:%l x8632::ebp))))
300
301(define-x8632-vinsn (vpush-register :push :node :vsp)
302    (()
303     ((reg :lisp)))
304  (pushl (:% reg)))
305
306(define-x8632-vinsn (vpush-fixnum :push :node :vsp)
307    (()
308     ((const :s32const)))
309  ((:and  (:pred < const 128) (:pred >= const -128))
310   (pushl (:$b const)))
311  ((:not (:and  (:pred < const 128) (:pred >= const -128)))
312   (pushl (:$l const))))
313
314(define-x8632-vinsn vframe-load (((dest :lisp))
315                                 ((frame-offset :u16const)
316                                  (cur-vsp :u16const)))
317  (movl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
318
319(define-x8632-vinsn compare-vframe-offset-to-nil (()
320                                                  ((frame-offset :u16const)
321                                                   (cur-vsp :u16const)))
322  (cmpl (:$l x8632::nil-value) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
323
324(define-x8632-vinsn compare-value-cell-to-nil (()
325                                               ((vcell :lisp)))
326  (cmpl (:$l x8632::nil-value) (:@ x8632::value-cell.value (:%l vcell))))
327
328(define-x8632-vinsn lcell-load (((dest :lisp))
329                                ((cell :lcell)
330                                 (top :lcell)))
331  (movl (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
332
333(define-x8632-vinsn (vframe-push :push :node :vsp)
334    (()
335     ((frame-offset :u16const)
336      (cur-vsp :u16const)))
337  (pushl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
338
339(define-x8632-vinsn vframe-store (()
340                                  ((src :lisp)
341                                   (frame-offset :u16const)
342                                   (cur-vsp :u16const)))
343  (movl (:%l src) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
344
345(define-x8632-vinsn lcell-store (()
346                                 ((src :lisp)
347                                  (cell :lcell)
348                                  (top :lcell)))
349  (movl (:%l src) (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp))))
350       
351(define-x8632-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
352    (()
353     ())
354  (leave)
355  (ret))
356
357(define-x8632-vinsn (restore-full-lisp-context :lispcontext :pop :vsp )
358    (()
359     ())
360  (leave))
361
362(define-x8632-vinsn compare-to-nil (()
363                                    ((arg0 t)))
364  (cmpl (:$l x8632::nil-value) (:%l arg0)))
365
366(define-x8632-vinsn ref-constant (((dest :lisp))
367                                  ((lab :label)))
368  (movl (:@ (:^ lab) (:%l x8632::fn)) (:%l dest)))
369
370(define-x8632-vinsn (vpush-constant :push :node :vsp) (()
371                                                       ((lab :label)))
372  (pushl (:@ (:^ lab) (:%l x8632::fn))))
373
374(define-x8632-vinsn (jump :jump)
375    (()
376     ((label :label)))
377  (jmp label))
378
379(define-x8632-vinsn (cbranch-true :branch) (()
380                                            ((label :label)
381                                             (crbit :u8const)))
382  (jcc (:$ub crbit) label))
383
384(define-x8632-vinsn (cbranch-false :branch) (()
385                                             ((label :label)
386                                              (crbit :u8const)))
387  (jcc (:$ub (:apply logxor 1 crbit)) label))
388
389(define-x8632-vinsn (lri :constant-ref) (((dest :imm))
390                                         ((intval :s32const))
391                                         ())
392  ((:pred = intval 0)
393   (xorl (:%l dest) (:%l dest)))
394  ((:and (:pred /= intval 0)
395         (:pred >= intval  -2147483648)
396         (:pred <= intval 2147483647))
397   (movl (:$l intval) (:%l dest))))
398
399;;; In the following trap/branch-unless vinsns, it might be worth
400;;; trying to use byte instructions when the args are known to be
401;;; accessible as byte regs.  It also might be possible to
402;;; special-case eax/ax/al.
403
404(define-x8632-vinsn trap-unless-bit (()
405                                     ((value :lisp)))
406  (testl (:$l (lognot x8632::fixnumone)) (:%l value))
407  (je.pt :ok)
408  (uuo-error-reg-not-type (:%l value) (:$ub arch::error-object-not-bit))
409  :ok
410  )
411
412;;; note that NIL is just a distinguished CONS.
413;;; the tag formerly known as fulltag-nil is now
414;;; for tagged return addresses.
415(define-x8632-vinsn trap-unless-list (()
416                                      ((object :lisp))
417                                      ((tag :u16)))
418  (movw (:%w object) (:%w tag))
419  (andw (:$w x8632::fulltagmask) (:%w tag))
420  (cmpw (:$w x8632::fulltag-cons) (:%w tag))
421  (je.pt :ok)
422  (uuo-error-reg-not-list (:%l object))
423  :ok)
424
425(define-x8632-vinsn trap-unless-cons (()
426                                      ((object :lisp))
427                                      ((tag :u16)))
428  ;; check for NIL
429  (cmpl (:$l x8632::nil-value) (:%l object))
430  (je.pn :bad)
431  (movw (:%w object) (:%w tag))
432  (andw (:$w x8632::fulltagmask) (:%w tag))
433  (cmpw (:$w x8632::fulltag-cons) (:%w tag))
434  (je.pt :ok)
435  :bad
436  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::fulltag-cons))
437  :ok)
438
439(define-x8632-vinsn trap-unless-uvector (()
440                                         ((object :lisp))
441                                         ((tag :u16)))
442  (movw (:%w object) (:%w tag))
443  (andw (:$w x8632::tagmask) (:%w tag))
444  (cmpw (:$w x8632::tag-misc) (:%w tag))
445  (jz.pt :ok)
446  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::tag-misc))
447  :ok)
448
449(define-x8632-vinsn trap-unless-character (()
450                                              ((object :lisp)))
451  (cmpw (:$w x8632::subtag-character) (:%w object))
452  (je.pt :ok)
453  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-character))
454  :ok)
455
456(define-x8632-vinsn trap-unless-fixnum (()
457                                        ((object :lisp))
458                                        ())
459  (testw (:$w x8632::tagmask) (:%w object))
460  (je.pt :ok)
461  (uuo-error-reg-not-fixnum (:%l object))
462  :ok)
463
464(define-x8632-vinsn set-flags-from-lisptag (()
465                                            ((reg :lisp)))
466  (testw (:$w x8632::tagmask) (:%w reg)))
467
468(define-x8632-vinsn trap-unless-typecode= (()
469                                           ((object :lisp)
470                                            (tagval :u8const))
471                                           ((tag :u8)))
472  (movl (:%l object) (:%l tag))
473  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
474   ;; accumulator
475   (andb (:$b x8632::tagmask) (:%accb tag))
476   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
477  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
478         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
479   ;; other register that can be treated as a byte
480   (andb (:$b x8632::tagmask) (:%b tag))
481   (cmpb (:$b x8632::tag-misc) (:%b tag)))
482  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
483   ;; non-byte register
484   (andl (:$l x8632::tagmask) (:%l tag))
485   (cmpl (:$b x8632::tag-misc) (:%l tag)))
486  (jne :have-tag)
487  (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
488  :have-tag
489  (cmpl (:$b tagval) (:%l tag))
490  (je.pt :ok)
491  (uuo-error-reg-not-tag (:%l object) (:$ub tagval))
492  :ok)
493
494(define-x8632-vinsn trap-unless-single-float (()
495                                              ((object :lisp))
496                                              ((tag :u16)))
497  (movw (:%w object) (:%w tag))
498  (andw (:$w x8632::tagmask) (:%w tag))
499  (cmpw (:$w x8632::tag-misc) (:%w tag))
500  (jne :have-tag)
501  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
502  :have-tag
503  (cmpw (:$w x8632::subtag-single-float) (:%w tag))
504  (je.pt :ok)
505  (uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-single-float))
506  :ok)
507
508(define-x8632-vinsn trap-unless-double-float (()
509                                              ((object :lisp))
510                                              ((tag :u16)))
511  (movw (:%w object) (:%w tag))
512  (andw (:$w x8632::tagmask) (:%w tag))
513  (cmpw (:$w x8632::tag-misc) (:%w tag))
514  (jne :have-tag)
515  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
516  :have-tag
517  (cmpw (:$w x8632::subtag-double-float) (:%w tag))
518  (je.pt :ok)
519  (uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-double-float))
520  :ok)
521
522(define-x8632-vinsn trap-unless-macptr (()
523                                        ((object :lisp))
524                                        ((tag :u16)))
525  (movw (:%w object) (:%w tag))
526  (andw (:$w x8632::tagmask) (:%w tag))
527  (cmpw (:$w x8632::tag-misc) (:%w tag))
528  (jne :have-tag)
529  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
530  :have-tag
531  (cmpw (:$w x8632::subtag-macptr) (:%w tag))
532  (je.pt :ok)
533  (uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-macptr))
534  :ok)
535
536(define-x8632-vinsn check-misc-bound (()
537                                      ((idx :imm)
538                                       (v :lisp))
539                                      ((temp :u32)))
540  (movl (:@ x8632::misc-header-offset (:%l v)) (:%l temp))
541  ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
542         (:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
543   (xorb (:%b temp) (:%b temp))
544   (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l temp)))
545  ((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
546   (shrl (:$ub x8632::num-subtag-bits) (:%l temp))
547   (shll (:$ub x8632::fixnumshift) (:%l temp)))
548  (rcmpl (:%l idx) (:%l temp))
549  (jb.pt :ok)
550  (uuo-error-vector-bounds (:%l idx) (:%l v))
551  :ok)
552
553(define-x8632-vinsn %cdr (((dest :lisp))
554                          ((src :lisp)))
555  (movl (:@ x8632::cons.cdr (:%l src)) (:%l dest)))
556
557(define-x8632-vinsn (%vpush-cdr :push :node :vsp)
558    (()
559     ((src :lisp)))
560  (pushl (:@ x8632::cons.cdr (:%l src))))
561
562(define-x8632-vinsn %car (((dest :lisp))
563                          ((src :lisp)))
564  (movl (:@ x8632::cons.car (:%l src)) (:%l dest)))
565
566(define-x8632-vinsn (%vpush-car :push :node :vsp)
567    (()
568     ((src :lisp)))
569  (pushl (:@ x8632::cons.car (:%l src))))
570
571(define-x8632-vinsn u32->char (((dest :lisp)
572                               (src :u8))
573                              ((src :u8))
574                              ())
575  (shll (:$ub x8632::charcode-shift) (:%l src))
576  (leal (:@ x8632::subtag-character (:%l src)) (:%l dest)))
577
578(define-x8632-vinsn (load-nil :constant-ref) (((dest t))
579                                              ())
580  (movl (:$l x8632::nil-value) (:%l dest)))
581
582
583(define-x8632-vinsn (load-t :constant-ref) (((dest t))
584                                            ())
585  (movl (:$l x8632::t-value) (:%l dest)))
586
587;;; use something like this for the other extract-whatevers, too,
588;;; once it's established that it works.
589(define-x8632-vinsn extract-tag (((tag :u8))
590                                 ((object :lisp)))
591  (movl (:%l object) (:%l tag))
592  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
593   ;; tag is the accumulator (2 bytes)
594   (andb (:$b x8632::tagmask) (:%accb tag)))
595  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
596         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
597   ;; tag is in a register whose low 8 bits can be accessed by byte
598   ;; insns (3 bytes)
599   (andb (:$b x8632::tagmask) (:%b tag)))
600  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
601   ;; tag is somewhere else (6 bytes) (could use andw and get a length
602   ;; of 5 bytes, but Intel's optimization manual advises avoiding
603   ;; length-changing prefixes to change the size of immediates.
604   ;; (section 3.4.2.3)
605   (andl (:$l x8632::tagmask) (:%l tag))))
606
607(define-x8632-vinsn extract-tag-fixnum (((tag :imm))
608                                        ((object :lisp)))
609  (leal (:@ (:%l object) 4) (:%l tag))
610  (andw (:$w (ash x8632::tagmask x8632::fixnumshift)) (:%w tag)))
611
612(define-x8632-vinsn extract-fulltag (((tag :u8))
613                                 ((object :lisp)))
614  (movl (:%l object) (:%l tag))
615  (andw (:$w x8632::fulltagmask) (:%w tag)))
616
617(define-x8632-vinsn extract-fulltag-fixnum (((tag :imm))
618                                            ((object :lisp)))
619  (leal (:@ (:%l object) 4) (:%l tag))
620  (andw (:$w (ash x8632::fulltagmask x8632::fixnumshift)) (:%w tag)))
621
622(define-x8632-vinsn extract-typecode (((tag :imm))
623                                      ((object :lisp)))
624  (movl (:%l object) (:%l tag))
625  ((:pred <= (:apply  %hard-regspec-value tag) x8632::ebx)
626   (andb (:$b x8632::tagmask) (:%b tag))
627   (cmpb (:$b x8632::tag-misc) (:%b tag)))
628  ((:pred > (:apply  %hard-regspec-value tag) x8632::ebx)
629   (andl (:$l x8632::tagmask) (:%l tag))
630   (cmpl (:$l x8632::tag-misc) (:%l tag)))
631  (jne :have-tag)
632  ((:pred <= (:apply  %hard-regspec-value tag) x8632::ebx)
633   (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag)))
634  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
635   (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag)))
636  :have-tag)
637
638(define-x8632-vinsn extract-typecode-fixnum (((tag :imm))
639                                             ((object :lisp))
640                                             ((temp :u32)))
641  (movl (:%l object) (:%l temp))
642  (andw (:$w x8632::tagmask) (:%w temp))
643  (cmpw (:$w x8632::tag-misc) (:%w temp))
644  (jne :have-tag)
645  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w temp))
646  :have-tag
647  (leal (:@ (:%l temp) 4) (:%l tag)))
648
649(define-x8632-vinsn compare-reg-to-zero (()
650                                         ((reg :imm)))
651  (testl (:%l reg) (:%l reg)))
652
653;;; life will be sad if reg isn't byte accessible
654(define-x8632-vinsn compare-u8-reg-to-zero (()
655                                            ((reg :u8)))
656  (testb (:%b reg) (:%b reg)))
657
658(define-x8632-vinsn cr-bit->boolean (((dest :lisp))
659                                     ((crbit :u8const))
660                                     ((temp :u32)))
661  (movl (:$l x8632::t-value) (:%l temp))
662  (leal (:@ (- x8632::t-offset) (:%l temp)) (:%l dest))
663  (cmovccl (:$ub crbit) (:%l temp) (:%l dest)))
664
665(define-x8632-vinsn compare-s32-constant (()
666                                            ((val :imm)
667                                             (const :s32const)))
668  ((:or  (:pred < const -128) (:pred > const 127))
669   (rcmpl (:%l val) (:$l const)))
670  ((:not (:or  (:pred < const -128) (:pred > const 127)))
671   (rcmpl (:%l val) (:$b const))))
672
673(define-x8632-vinsn compare-u31-constant (()
674                                          ((val :u32)
675                                           (const :u32const)))
676  ((:pred > const 127)
677   (rcmpl (:%l val) (:$l const)))
678  ((:not (:pred > const 127))
679   (rcmpl (:%l val) (:$b const))))
680
681(define-x8632-vinsn compare-u8-constant (()
682                                         ((val :u8)
683                                          (const :u8const)))
684  ((:pred = (:apply %hard-regspec-value val) x8632::eax)
685   (rcmpb (:%accb val) (:$b const)))
686  ((:and (:pred > (:apply %hard-regspec-value val) x8632::eax)
687         (:pred <= (:apply %hard-regspec-value val) x8632::ebx))
688   (rcmpb (:%b val) (:$b const)))
689  ((:pred > (:apply %hard-regspec-value val) x8632::ebx)
690   (rcmpl (:%l val) (:$l const)))
691  )
692
693(define-x8632-vinsn cons (((dest :lisp))
694                          ((car :lisp)
695                           (cdr :lisp))
696                          ((allocptr (:lisp #.x8632::allocptr))))
697  (subl (:$b (- x8632::cons.size x8632::fulltag-cons)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
698  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l x8632::allocptr))
699  (rcmpl (:%l x8632::allocptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
700  (jg :no-trap)
701  (uuo-alloc)
702  :no-trap
703  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
704  (movl (:%l car) (:@ x8632::cons.car (:%l x8632::allocptr)))
705  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l x8632::allocptr)))
706  (movl (:%l x8632::allocptr) (:%l dest)))
707
708(define-x8632-vinsn unbox-u8 (((dest :u8))
709                              ((src :lisp)))
710  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l dest))
711  (andl (:% src) (:% dest))
712  (je.pt :ok)
713  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-8))
714  :ok
715  (movl (:%l src) (:%l dest))
716  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
717
718(define-x8632-vinsn %unbox-u8 (((dest :u8))
719                              ((src :lisp)))
720  (movl (:%l src) (:%l dest))
721  (shrl (:$ub x8632::fixnumshift) (:%l dest))
722  (andl (:$l #xff) (:%l dest)))
723
724(define-x8632-vinsn unbox-s8 (((dest :s8))
725                              ((src :lisp)))
726  (movl (:%l src) (:%l dest))
727  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
728  (sarl (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
729  (cmpl (:%l src) (:%l dest))
730  (jne.pn :bad)
731  (testw (:$w x8632::fixnummask) (:%w dest))
732  (jne.pn :bad)
733  (sarl (:$ub x8632::fixnumshift) (:%l dest))
734  (jmp :got-it)
735  :bad
736  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-8))
737  :got-it)
738
739(define-x8632-vinsn unbox-u16 (((dest :u16))
740                              ((src :lisp)))
741  (testl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:% src))
742  (movl (:%l src) (:%l dest))
743  (je.pt :ok)
744  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-16))
745  :ok
746  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
747
748(define-x8632-vinsn %unbox-u16 (((dest :u16))
749                              ((src :lisp)))
750  (movl (:%l src) (:%l dest))
751  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
752
753(define-x8632-vinsn unbox-s16 (((dest :s16))
754                              ((src :lisp)))
755  (movl (:%l src) (:%l dest))
756  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
757  (sarl (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
758  (cmpl (:%l src) (:%l dest))
759  (jne.pn :bad)
760  (testw (:$w x8632::fixnummask) (:%w dest))
761  (je.pt :got-it)
762  :bad
763  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-16))
764  :got-it
765  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
766
767(define-x8632-vinsn %unbox-s16 (((dest :s16))
768                                ((src :lisp)))
769  (movl (:%l src) (:%l dest))
770  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
771
772;;; xxx -- review this again later
773(define-x8632-vinsn unbox-u32 (((dest :u32))
774                               ((src :lisp)))
775  (movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest))
776  (testl (:%l dest) (:%l src))
777  (movl (:%l src) (:%l dest))
778  (jnz :maybe-bignum)
779  (sarl (:$ub x8632::fixnumshift) (:%l dest))
780  (jmp :done)
781  :maybe-bignum
782  (andw (:$w x8632::tagmask) (:%w dest))
783  (cmpw (:$w x8632::tag-misc) (:%w dest))
784  (jne :have-tag)
785  (movw (:@ x8632::misc-subtag-offset (:%l src)) (:%w dest))
786  (andw (:$w #xff) (:%w dest))
787  :have-tag
788  (cmpw (:$w x8632::subtag-bignum) (:%w dest))
789  (jne :bad)
790  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest))
791  (cmpl (:$l x8632::three-digit-bignum-header) (:%l dest))
792  (je :three)
793  (cmpl (:$l x8632::two-digit-bignum-header) (:%l dest))
794  (jne :bad)
795  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
796  (testl (:%l dest) (:%l dest))
797  (jns :done)
798  :bad
799  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32))
800  :three
801  (movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest))
802  (testl (:%l dest) (:%l dest))
803  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
804  (jne :bad)
805  :done)
806
807;;; xxx -- review this again later
808(define-x8632-vinsn unbox-s32 (((dest :s32))
809                               ((src :lisp)))
810  (movl (:%l src) (:%l dest))
811  (sarl (:$ub x8632::fixnumshift) (:%l dest))
812  ;; Was it a fixnum ?
813  (testw (:$w x8632::fixnummask) (:%w src))
814  (je :done)
815  ;; May be a 2-digit bignum
816  (movw (:%w src) (:%w dest))
817  (andw (:$w x8632::tagmask) (:%w dest))
818  (cmpw (:$w x8632::tag-misc) (:%w dest))
819  (jne :bad)
820  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src)))
821  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
822  (je :done)
823  :bad
824  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32))
825  :done)
826
827
828;;; xxx -- sigh...
829(define-x8632-vinsn sign-extend-s8 (((dest :s32))
830                                    ((src :s8)))
831  ;; (movsbl (:%b temp) (:%l dest))
832  (movl (:%l src) (:%l dest))
833  (shll (:$ub 24) (:%l dest))
834  (sarl (:$ub 24) (:%l dest)))
835
836(define-x8632-vinsn sign-extend-s16 (((dest :s32))
837                                     ((src :s16)))
838  (movswl (:%w src) (:%l dest)))
839
840;;; xxx -- sigh...
841(define-x8632-vinsn zero-extend-u8 (((dest :s32))
842                                    ((src :u8)))
843  ;;(movzbl (:%b src) (:%l dest))
844  (movl (:%l src) (:%l dest))
845  (andl (:$l #xff) (:%l dest)))
846
847(define-x8632-vinsn zero-extend-u16 (((dest :s32))
848                                     ((src :u16)))
849  (movzwl (:%w src) (:%l dest)))
850
851(define-x8632-vinsn (jump-subprim :jumpLR) (()
852                                            ((spno :s32const)))
853  (jmp (:@ spno)))
854
855;;; Call a subprimitive using a tail-aligned CALL instruction.
856(define-x8632-vinsn (call-subprim :call)  (()
857                                           ((spno :s32const))
858                                           ((entry (:label 1))))
859  (:talign x8632::fulltag-tra)
860  (call (:@ spno))
861  (movl (:$self 0) (:% x8632::fn)))
862
863(define-x8632-vinsn fixnum-subtract-from (((dest t)
864                                           (y t))
865                                          ((y t)
866                                           (x t)))
867  (subl (:%l y) (:%l x)))
868
869(define-x8632-vinsn %logand-c (((dest t)
870                                (val t))
871                               ((val t)
872                                (const :s32const)))
873  ((:and (:pred >= const -128) (:pred <= const 127))
874   (andl (:$b const) (:%l val)))
875  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
876   (andl (:$l const) (:%l val))))
877
878(define-x8632-vinsn %logior-c (((dest t)
879                                (val t))
880                               ((val t)
881                                (const :s32const)))
882  ((:and (:pred >= const -128) (:pred <= const 127))
883   (orl (:$b const) (:%l val)))
884  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
885   (orl (:$l const) (:%l val))))
886
887(define-x8632-vinsn %logxor-c (((dest t)
888                                (val t))
889                               ((val t)
890                                (const :s32const)))
891  ((:and (:pred >= const -128) (:pred <= const 127))
892   (xorl (:$b const) (:%l val)))
893  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
894   (xorl (:$l const) (:%l val))))
895
896(define-x8632-vinsn character->fixnum (((dest :lisp))
897                                       ((src :lisp))
898                                       ())
899  ((:not (:pred =
900                (:apply %hard-regspec-value dest)
901                (:apply %hard-regspec-value src)))
902   (movl (:%l src) (:%l dest)))
903  (shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest)))
904
905(define-x8632-vinsn compare (()
906                             ((x t)
907                              (y t)))
908  (rcmpl (:%l x) (:%l y)))
909
910(define-x8632-vinsn negate-fixnum (((val :lisp))
911                                   ((val :imm)))
912  (negl (:% val)))
913
914;;; set-bigits-and-header-for-fixnum-overflow
915
916(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
917                                                       ((src :s32))
918                                                       ((temp :s32)))
919  (movl (:%l src) (:%l temp))
920  (shll (:$ub x8632::fixnumshift) (:%l temp))
921  (movl (:%l temp) (:%l dest))          ; tagged as a fixnum
922  (sarl (:$ub x8632::fixnumshift) (:%l temp))
923  (cmpl (:%l src) (:%l temp)))
924
925(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
926                                                       ((src :u32))
927                                                       ((temp :u32)))
928  (movl (:%l src) (:%l temp))
929  (shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
930  (movl (:%l temp) (:%l dest))          ; tagged as an even fixnum
931  (shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
932  (shrl (:%l dest))
933  (cmpl (:%l src) (:%l temp))
934  :done)
935
936;;; setup-bignum-alloc-for-s32-overflow
937;;; setup-bignum-alloc-for-u32-overflow
938
939(define-x8632-vinsn setup-uvector-allocation (()
940                                              ((header :imm)))
941  (movd (:%l header) (:%mmx x8632::mm0)))
942
943;;; The code that runs in response to the uuo-alloc
944;;; expects a header in mm0, and a size in imm0.
945;;; mm0 is an implicit arg (it contains the uvector header)
946;;; size is actually an arg, not a temporary,
947;;; but it appears that there's isn't a way to enforce
948;;; register usage on vinsn args.
949(define-x8632-vinsn %allocate-uvector (((dest :lisp))
950                                       ()
951                                       ((size (:u32 #.x8632::imm0))
952                                        (freeptr (:lisp #.x8632::allocptr))))
953  (subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
954  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
955  (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
956  (jg :no-trap)
957  (uuo-alloc)
958  :no-trap
959  (movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
960  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
961  ((:not (:pred = freeptr
962                (:apply %hard-regspec-value dest)))
963   (movl (:%l freeptr) (:%l dest))))
964
965(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
966                                                      ((bignum :lisp)))
967  (movq (:%mmx x8632::mm0) (:@ x8632::misc-data-offset (:%l bignum))))
968 
969(define-x8632-vinsn box-fixnum (((dest :imm))
970                                ((src :s32)))
971  ;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
972  (leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
973
974;;; xxx
975(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
976    (((val :lisp))
977     ((val :lisp))
978     ((unboxed (:s32 #.x8632::edx))
979      (header (:u32 #.x8632::imm0))
980      (entry (:label 1))))
981  (jno.pt :done)
982  ((:not (:pred = x8632::arg_z
983                (:apply %hard-regspec-value val)))
984   (movl (:%l val) (:%l x8632::arg_z)))
985  (:talign 5)
986  (call (:@ .SPfix-overflow))
987  (movl (:$self 0) (:%l x8632::fn))
988  ((:not (:pred = x8632::arg_z
989                (:apply %hard-regspec-value val)))
990   (movl (:%l x8632::arg_z) (:%l val)))
991  :done)
992
993;;; xxx
994(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
995    (((val :lisp))
996     ((val :lisp)
997      (lab :label))
998     ((unboxed (:s32 #.x8664::imm1))
999      (header (:u32 #.x8664::imm0))
1000      (entry (:label 1))))
1001  (jno.pt lab)
1002  ((:not (:pred = x8632::arg_z
1003                (:apply %hard-regspec-value val)))
1004   (movl (:%l val) (:%l x8632::arg_z)))
1005  (:talign 5)
1006  (call (:@ .SPfix-overflow))
1007  (movl (:$self 0) (:%l x8632::fn))
1008  ((:not (:pred = x8632::arg_z
1009                (:apply %hard-regspec-value val)))
1010   (movl (:%l x8632::arg_z) (:%l val)))
1011  (jmp lab))
1012
1013
1014(define-x8632-vinsn add-constant (((dest :imm))
1015                                  ((dest :imm)
1016                                   (const :s32const)))
1017  ((:and (:pred >= const -128) (:pred <= const 127))
1018   (addl (:$b const) (:%l dest)))
1019  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1020   (addl (:$l const) (:%l dest))))
1021
1022(define-x8632-vinsn add-constant3 (((dest :imm))
1023                                   ((src :imm)
1024                                    (const :s32const)))
1025  ((:pred = (:apply %hard-regspec-value dest)
1026          (:apply %hard-regspec-value src))
1027   ((:and (:pred >= const -128) (:pred <= const 127))
1028    (addl (:$b const) (:%l dest)))
1029   ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1030    (addl (:$l const) (:%l dest))))
1031  ((:not (:pred = (:apply %hard-regspec-value dest)
1032                (:apply %hard-regspec-value src)))
1033   (leal (:@ const (:%l src)) (:%l dest))))
1034
1035(define-x8632-vinsn fixnum-add2  (((dest :imm))
1036                                  ((dest :imm)
1037                                   (other :imm)))
1038  (addl (:%l other) (:%l dest)))
1039
1040(define-x8632-vinsn fixnum-sub2  (((dest :imm))
1041                                  ((x :imm)
1042                                   (y :imm))
1043                                  ((temp :imm)))
1044  (movl (:%l x) (:%l temp))
1045  (subl (:%l y) (:%l temp))
1046  (movl (:%l temp) (:%l dest)))
1047
1048(define-x8632-vinsn fixnum-add3 (((dest :imm))
1049                                 ((x :imm)
1050                                  (y :imm)))
1051 
1052  ((:pred =
1053          (:apply %hard-regspec-value x)
1054          (:apply %hard-regspec-value dest))
1055   (addl (:%l y) (:%l dest)))
1056  ((:not (:pred =
1057                (:apply %hard-regspec-value x)
1058                (:apply %hard-regspec-value dest)))
1059   ((:pred =
1060           (:apply %hard-regspec-value y)
1061           (:apply %hard-regspec-value dest))
1062    (addl (:%l x) (:%l dest)))
1063   ((:not (:pred =
1064                 (:apply %hard-regspec-value y)
1065                 (:apply %hard-regspec-value dest)))
1066    (leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1067
1068(define-x8632-vinsn copy-gpr (((dest t))
1069                              ((src t)))
1070  ((:not (:pred =
1071                (:apply %hard-regspec-value dest)
1072                (:apply %hard-regspec-value src)))
1073   (movl (:%l src) (:%l dest))))
1074
1075(define-x8632-vinsn (vpop-register :pop :node :vsp)
1076    (((dest :lisp))
1077     ())
1078  (popl (:%l dest)))
1079
1080(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1081                                                      ())
1082  (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1083  (jb :done)
1084  (je :one)
1085  (pushl (:%l x8632::arg_y))
1086  :one
1087  (pushl (:%l x8632::arg_z))
1088  :done)
1089
1090(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1091                                                         ((max :u32const)))
1092  ((:pred >= max 2)
1093   (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1094   (jb :done)
1095   (je :one)
1096   (pushl (:%l x8632::arg_y))
1097   :one
1098   (pushl (:%l x8632::arg_z))
1099   :done)
1100  ((:pred = max 1)
1101   (testw (:%w x8632::nargs) (:%w x8632::nargs))
1102   (je :done)
1103   (pushl (:%l x8632::arg_z))
1104   :done))
1105
1106(define-x8632-vinsn (call-label :call) (()
1107                                        ((label :label))
1108                                        ((entry (:label 1))))
1109  (:talign 5)
1110  (call label)
1111  (movl (:$self 0) (:%l x8632::fn)))
1112
1113(define-x8632-vinsn double-float-compare (()
1114                                          ((arg0 :double-float)
1115                                           (arg1 :double-float)))
1116  (comisd (:%xmm arg1) (:%xmm arg0)))
1117
1118(define-x8632-vinsn single-float-compare (()
1119                                          ((arg0 :single-float)
1120                                           (arg1 :single-float)))
1121  (comiss (:%xmm arg1) (:%xmm arg0)))
1122
1123(define-x8632-vinsn double-float+-2 (((result :double-float))
1124                                     ((x :double-float)
1125                                      (y :double-float)))
1126  ((:pred =
1127          (:apply %hard-regspec-value result)
1128          (:apply %hard-regspec-value x))
1129   (addsd (:%xmm y) (:%xmm result)))
1130  ((:and (:not (:pred =
1131                      (:apply %hard-regspec-value result)
1132                      (:apply %hard-regspec-value x)))
1133         (:pred =
1134                (:apply %hard-regspec-value result)
1135                (:apply %hard-regspec-value y)))
1136   (addsd (:%xmm x) (:%xmm result)))
1137  ((:and (:not (:pred =
1138                      (:apply %hard-regspec-value result)
1139                      (:apply %hard-regspec-value x)))
1140         (:not (:pred =
1141                      (:apply %hard-regspec-value result)
1142                      (:apply %hard-regspec-value y))))
1143   (movsd (:%xmm x) (:%xmm result))
1144   (addsd (:%xmm y) (:%xmm result))))
1145
1146;;; Caller guarantees (not (eq y result))
1147(define-x8632-vinsn double-float--2 (((result :double-float))
1148                                     ((x :double-float)
1149                                      (y :double-float)))
1150  ((:not (:pred = (:apply %hard-regspec-value result)
1151                (:apply %hard-regspec-value x)))
1152   (movsd (:%xmm x) (:%xmm result)))
1153  (subsd (:%xmm y) (:%xmm result)))
1154
1155(define-x8632-vinsn double-float*-2 (((result :double-float))
1156                                     ((x :double-float)
1157                                      (y :double-float)))
1158  ((:pred =
1159          (:apply %hard-regspec-value result)
1160          (:apply %hard-regspec-value x))
1161   (mulsd (:%xmm y) (:%xmm result)))
1162  ((:and (:not (:pred =
1163                      (:apply %hard-regspec-value result)
1164                      (:apply %hard-regspec-value x)))
1165         (:pred =
1166                (:apply %hard-regspec-value result)
1167                (:apply %hard-regspec-value y)))
1168   (mulsd (:%xmm x) (:%xmm result)))
1169  ((:and (:not (:pred =
1170                      (:apply %hard-regspec-value result)
1171                      (:apply %hard-regspec-value x)))
1172         (:not (:pred =
1173                      (:apply %hard-regspec-value result)
1174                      (:apply %hard-regspec-value y))))
1175   (movsd (:%xmm x) (:%xmm result))
1176   (mulsd (:%xmm y) (:%xmm result))))
1177
1178;;; Caller guarantees (not (eq y result))
1179(define-x8632-vinsn double-float/-2 (((result :double-float))
1180                                     ((x :double-float)
1181                                      (y :double-float)))
1182  ((:not (:pred = (:apply %hard-regspec-value result)
1183                (:apply %hard-regspec-value x)))
1184   (movsd (:%xmm x) (:%xmm result)))
1185  (divsd (:%xmm y) (:%xmm result)))
1186
1187(define-x8632-vinsn single-float+-2 (((result :single-float))
1188                                     ((x :single-float)
1189                                      (y :single-float)))
1190  ((:pred =
1191          (:apply %hard-regspec-value result)
1192          (:apply %hard-regspec-value x))
1193   (addss (:%xmm y) (:%xmm result)))
1194  ((:and (:not (:pred =
1195                      (:apply %hard-regspec-value result)
1196                      (:apply %hard-regspec-value x)))
1197         (:pred =
1198                (:apply %hard-regspec-value result)
1199                (:apply %hard-regspec-value y)))
1200   (addss (:%xmm x) (:%xmm result)))
1201  ((:and (:not (:pred =
1202                      (:apply %hard-regspec-value result)
1203                      (:apply %hard-regspec-value x)))
1204         (:not (:pred =
1205                      (:apply %hard-regspec-value result)
1206                      (:apply %hard-regspec-value y))))
1207   (movss (:%xmm x) (:%xmm result))
1208   (addss (:%xmm y) (:%xmm result))))
1209
1210;;; Caller guarantees (not (eq y result))
1211(define-x8632-vinsn single-float--2 (((result :single-float))
1212                                     ((x :single-float)
1213                                      (y :single-float)))
1214  ((:not (:pred = (:apply %hard-regspec-value result)
1215                (:apply %hard-regspec-value x)))
1216   (movss (:%xmm x) (:%xmm result)))
1217  (subss (:%xmm y) (:%xmm result)))
1218
1219(define-x8632-vinsn single-float*-2 (((result :single-float))
1220                                     ((x :single-float)
1221                                      (y :single-float)))
1222    ((:pred =
1223          (:apply %hard-regspec-value result)
1224          (:apply %hard-regspec-value x))
1225   (mulss (:%xmm y) (:%xmm result)))
1226  ((:and (:not (:pred =
1227                      (:apply %hard-regspec-value result)
1228                      (:apply %hard-regspec-value x)))
1229         (:pred =
1230                (:apply %hard-regspec-value result)
1231                (:apply %hard-regspec-value y)))
1232   (mulss (:%xmm x) (:%xmm result)))
1233  ((:and (:not (:pred =
1234                      (:apply %hard-regspec-value result)
1235                      (:apply %hard-regspec-value x)))
1236         (:not (:pred =
1237                      (:apply %hard-regspec-value result)
1238                      (:apply %hard-regspec-value y))))
1239   (movss (:%xmm x) (:%xmm result))
1240   (mulss (:%xmm y) (:%xmm result))))
1241
1242;;; Caller guarantees (not (eq y result))
1243(define-x8632-vinsn single-float/-2 (((result :single-float))
1244                                     ((x :single-float)
1245                                      (y :single-float)))
1246  ((:not (:pred = (:apply %hard-regspec-value result)
1247                (:apply %hard-regspec-value x)))
1248   (movss (:%xmm x) (:%xmm result)))
1249  (divss (:%xmm y) (:%xmm result)))
1250
1251(define-x8632-vinsn get-single (((result :single-float))
1252                                ((source :lisp)))
1253  (movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1254
1255(define-x8632-vinsn get-double (((result :double-float))
1256                                ((source :lisp)))
1257  (movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1258
1259;;; Extract a double-float value, typechecking in the process.
1260;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1261;;; instead of replicating it ..
1262;;; get-double?
1263
1264(define-x8632-vinsn copy-single-float (((dest :single-float))
1265                                       ((src :single-float)))
1266  (movss (:%xmm src) (:%xmm dest)))
1267
1268(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1269                                           ((src :single-float)))
1270  (cvtss2sd (:%xmm src) (:%xmm dest)))
1271
1272(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1273                                           ((src :double-float)))
1274  (cvtsd2ss (:%xmm src) (:%xmm dest)))
1275
1276(define-x8632-vinsn fitvals (()
1277                             ((n :u16const))
1278                             ((imm :u16)))
1279  ((:pred = n 0)
1280   (xorl (:%l imm) (:%l imm)))
1281  ((:not (:pred = n 0))
1282   (movw (:$w (:apply ash n x8632::fixnumshift)) (:%w imm)))
1283  (subw (:%w x8632::nargs) (:%w imm))
1284  (jae :push-more)
1285  (movswl (:%w imm) (:%l imm))
1286  (subl (:%l imm) (:%l x8632::esp))
1287  (jmp :done)
1288  :push-loop
1289  (pushl (:$l x8632::nil-value))
1290  (addw (:$b x8632::node-size) (:%w x8632::nargs))
1291  (subw (:$b x8632::node-size) (:%w imm))
1292  :push-more
1293  (jne :push-loop)
1294  :done)
1295
1296(define-x8632-vinsn (nvalret :jumpLR) (()
1297                                       ())
1298  (jmp (:@ .SPnvalret)))
1299
1300(define-x8632-vinsn lisp-word-ref (((dest t))
1301                                   ((base t)
1302                                    (offset t)))
1303  (movl (:@ (:%l base) (:%l offset)) (:%l  dest)))
1304
1305(define-x8632-vinsn lisp-word-ref-c (((dest t))
1306                                     ((base t)
1307                                      (offset :s32const)))
1308  ((:pred = offset 0)
1309   (movl (:@ (:%l base)) (:%l dest)))
1310  ((:not (:pred = offset 0))
1311   (movl (:@ offset (:%l base)) (:%l dest))))
1312
1313;; start-mv-call
1314
1315;; xxx check this
1316(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1317                                                 ((label :label)))
1318  (leal (:@ (:^ label) (:%l x8632::fn)) (:%l x8632::ra0))
1319  (pushl (:%l x8632::ra0)))
1320
1321;; ????
1322(define-x8632-vinsn emit-aligned-label (()
1323                                        ((label :label)))
1324  (:align 3)
1325  (:long (:^ label)))
1326
1327;; pass-multiple-values-symbol
1328;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1329(define-x8632-vinsn pass-multiple-values-symbol (()
1330                                                 ())
1331  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr)))) 
1332  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1333
1334
1335;; pass-multiple-values
1336
1337(define-x8632-vinsn reserve-outgoing-frame (()
1338                                            ())
1339  (pushl (:$b x8632::reserved-frame-marker))
1340  (pushl (:$b x8632::reserved-frame-marker)))
1341
1342;; implicit temp0 arg
1343(define-x8632-vinsn (call-known-function :call) (()
1344                                                 ()
1345                                                 ((entry (:label 1))))
1346  (:talign 5)
1347  (call (:%l x8632::temp0))
1348  (movl (:$self 0) (:%l x8632::fn)))
1349
1350(define-x8632-vinsn (jump-known-function :jumplr) (()
1351                                                   ())
1352  (movl (:%l x8632::fn) (:%l x8632::xfn))
1353  (movl (:%l x8632::temp0)  (:%l x8632::fn))
1354  (jmp (:%l x8632::fn)))
1355
1356(define-x8632-vinsn (list :call) (()
1357                                  ()
1358                                  ((entry (:label 1))))
1359  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1360  (:talign 5)
1361  (call (:@ .SPconslist))
1362  :back
1363  (movl (:$self 0) (:%l x8632::fn)))
1364
1365(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1366                                   ((car :lisp) (cdr :lisp))
1367                                   ((temp :imm)))
1368  (subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1369  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1370  (movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1371  (movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1372  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1373  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1374  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1375  (leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1376  (movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1377  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1378  (movl (:%l temp) (:%l dest)))
1379
1380
1381;; make-fixed-stack-gvector
1382
1383(define-x8632-vinsn discard-temp-frame (()
1384                                        ()
1385                                        ((temp :imm)))
1386  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1387  (movl (:@ (:%l temp)) (:%l temp))
1388  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1389  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1390  )
1391
1392(define-x8632-vinsn discard-c-frame (()
1393                                     ()
1394                                     ((temp :imm)))
1395  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1396  (movl (:@ (:%l temp)) (:%l temp))
1397  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1398
1399 
1400(define-x8632-vinsn vstack-discard (()
1401                                    ((nwords :u32const)))
1402  ((:not (:pred = nwords 0))
1403   ((:pred < nwords 16)
1404    (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1405   ((:not (:pred < nwords 16))
1406    (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1407
1408(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1409  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1410    (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1411    (:talign 5)
1412    (jmp (:@ ,spno))
1413    :back
1414    (movl (:$self 0) (:%l x8632::fn))))
1415
1416(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1417  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1418    (:talign 5)
1419    (call (:@ ,spno))
1420    :back
1421    (movl (:$self 0) (:%l x8632::fn))))
1422
1423(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1424  `(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ())
1425    (jmp (:@ ,spno))))
1426
1427(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1428                                                        ((lab :label)))
1429  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1430  (jmp (:@ .SPnthrowvalues)))
1431
1432(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1433                                                        ((lab :label)))
1434  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1435  (jmp (:@ .SPnthrow1value)))
1436
1437(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1438
1439(define-x8632-vinsn bind-interrupt-level-0-inline (()
1440                                                   ()
1441                                                   ((temp :imm)))
1442  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1443  (cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1444  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1445  (pushl (:$b x8632::interrupt-level-binding-index))
1446  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1447  (movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1448  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1449  (jns.pt :done)
1450  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1451  (jae.pt :done)
1452  (ud2a)
1453  (:byte 2)
1454  :done)
1455
1456(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1457
1458(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1459
1460(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1461
1462;;; xxx
1463(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
1464                                                      ((lab :label))
1465                                                      ((entry (:label 1))
1466                                                       (xfn (:lisp #.x8632::xfn))))
1467  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l xfn))
1468  (:talign 5)
1469  (call (:@ .SPmkcatchmv))
1470  :back
1471  (movl (:$self 0) (:%l x8632::fn)))
1472
1473
1474(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1475
1476(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1477
1478(define-x8632-vinsn set-eq-bit (()
1479                                ())
1480  (testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1481
1482;;; %schar8
1483;;; %schar32
1484;;; %set-schar8
1485;;; %set-schar32
1486
1487(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1488                                             ((v :lisp)
1489                                              (idx :u32const)))
1490  (movsd (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1491
1492(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1493                                           ((header :lisp)))
1494  (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1495
1496
1497(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1498
1499(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1500
1501(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1502                                           ((addr :s32const)))
1503  (movzbl (:@ addr) (:%l dest)))
1504
1505(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1506                                           ((addr :s32const)))
1507  (movsbl (:@ addr) (:%l dest)))
1508
1509(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1510                                           ((addr :s32const)))
1511  (movzwl (:@ addr) (:%l dest)))
1512
1513(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1514                                           ((addr :s32const)))
1515  (movswl (:@ addr) (:%l dest)))
1516
1517(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
1518                                                 ((addr :s32const)))
1519  (movl (:@ addr) (:%l dest)))
1520
1521(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
1522                                                        ((addr :s32const)))
1523  (movl (:@ addr) (:%l dest)))
1524
1525(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
1526                                                   ((addr :s32const)))
1527  (movl (:@ addr) (:%l dest)))
1528
1529(define-x8632-vinsn event-poll (()
1530                                ())
1531  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1532  (jae :no-interrupt)
1533  (ud2a)
1534  (:byte 2)
1535  :no-interrupt)
1536
1537;;; check-2d-bound
1538;;; check-3d-bound
1539
1540(define-x8632-vinsn 2d-dim1 (((dest :u32))
1541                             ((header :lisp)))
1542  (movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
1543            (:%l header)) (:%l dest))
1544  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
1545
1546;;; 3d-dims
1547
1548;;; xxx
1549(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
1550                                        (dim1 :u32))
1551                                       ((dim1 :u32)
1552                                        (i :imm)
1553                                        (j :imm)))
1554
1555  (imull (:%l i) (:%l dim1))
1556  (leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
1557
1558;;; 3d-unscaled-index
1559
1560(define-x8632-vinsn branch-unless-both-args-fixnums (()
1561                                                     ((a :lisp)
1562                                                      (b :lisp)
1563                                                      (dest :label))
1564                                                     ((tag :u8)))
1565  (movl (:%l a) (:%l tag))
1566  (orl (:%l b) (:%l tag))
1567  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1568   (testb (:$b x8632::fixnummask) (:%accb tag)))
1569  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1570         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1571   (testb (:$b x8632::fixnummask) (:%b tag)))
1572  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
1573   (testl (:$l x8632::fixnummask) (:%l tag)))
1574  (jne dest))
1575
1576(define-x8632-vinsn branch-unless-arg-fixnum (()
1577                                              ((a :lisp)
1578                                               (dest :label)))
1579  ((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
1580   (testb (:$b x8632::fixnummask) (:%b a)))
1581  ((:pred > (:apply %hard-regspec-value a) x8632::ebx)
1582   (testl (:$l x8632::fixnummask) (:%l a)))
1583  (jne dest))
1584
1585(define-x8632-vinsn fixnum->single-float (((f :single-float))
1586                                          ((arg :lisp))
1587                                          ((unboxed :s32)))
1588  (movl (:%l arg) (:%l unboxed))
1589  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1590  (cvtsi2ssl (:%l unboxed) (:%xmm f)))
1591
1592(define-x8632-vinsn fixnum->double-float (((f :double-float))
1593                                          ((arg :lisp))
1594                                          ((unboxed :s32)))
1595  (movl (:%l arg) (:%l unboxed))
1596  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1597  (cvtsi2sdl (:%l unboxed) (:%xmm f)))
1598
1599(define-x8632-vinsn xchg-registers (()
1600                                    ((a t)
1601                                     (b t)))
1602  (xchgl (:%l a) (:%l b)))
1603
1604(define-x8632-vinsn establish-fn (()
1605                                  ())
1606  (movl (:$self 0) (:%l x8632::fn)))
1607
1608
1609(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
1610
1611(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
1612
1613
1614(define-x8632-vinsn character->code (((dest :u32))
1615                                     ((src :lisp)))
1616  (movl (:%l src) (:%l dest))
1617  (sarl (:$ub x8632::charcode-shift) (:%l dest)))
1618
1619(define-x8632-vinsn adjust-vsp (()
1620                                ((amount :s32const)))
1621  ((:and (:pred >= amount -128) (:pred <= amount 127))
1622   (addl (:$b amount) (:%l x8632::esp)))
1623  ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
1624   (addl (:$l amount) (:%l x8632::esp))))
1625
1626
1627(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
1628                                                          ((spno :s32const)
1629                                                           (y t)
1630                                                           (z t))
1631                                                          ((entry (:label 1))))
1632  (:talign 5)
1633  (call (:@ spno))
1634  (movl (:$self 0) (:%l x8632::fn)))
1635
1636(define-x8632-vinsn zero-double-float-register (((dest :double-float))
1637                                                ())
1638  (movsd (:%xmm x8632::fpzero) (:%xmm dest)))
1639
1640(define-x8632-vinsn zero-single-float-register (((dest :single-float))
1641                                                ())
1642  (movss (:%xmm x8632::fpzero) (:%xmm dest)))
1643
1644(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
1645
1646(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
1647                                               ((src :lisp))
1648                                               ((temp :u32)))
1649  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
1650  ((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
1651         (:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
1652   (movb (:$b 0) (:%b temp)))
1653  ((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
1654   (andl (:$l #xffffff00) (:%l temp)))
1655  (movl (:%l temp) (:%l dest))
1656  (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l dest)))
1657
1658
1659
1660(define-x8632-vinsn %logior2 (((dest :imm))
1661                              ((x :imm)
1662                               (y :imm)))
1663  ((:pred =
1664          (:apply %hard-regspec-value x)
1665          (:apply %hard-regspec-value dest))
1666   (orl (:%l y) (:%l dest)))
1667  ((:not (:pred =
1668                (:apply %hard-regspec-value x)
1669                (:apply %hard-regspec-value dest)))
1670   ((:pred =
1671           (:apply %hard-regspec-value y)
1672           (:apply %hard-regspec-value dest))
1673    (orl (:%l x) (:%l dest)))
1674   ((:not (:pred =
1675                 (:apply %hard-regspec-value y)
1676                 (:apply %hard-regspec-value dest)))
1677    (movl (:%l x) (:%l dest))
1678    (orl (:%l y) (:%l dest)))))
1679
1680(define-x8632-vinsn %logand2 (((dest :imm))
1681                              ((x :imm)
1682                               (y :imm)))
1683  ((:pred =
1684          (:apply %hard-regspec-value x)
1685          (:apply %hard-regspec-value dest))
1686   (andl (:%l y) (:%l dest)))
1687  ((:not (:pred =
1688                (:apply %hard-regspec-value x)
1689                (:apply %hard-regspec-value dest)))
1690   ((:pred =
1691           (:apply %hard-regspec-value y)
1692           (:apply %hard-regspec-value dest))
1693    (andl (:%l x) (:%l dest)))
1694   ((:not (:pred =
1695                 (:apply %hard-regspec-value y)
1696                 (:apply %hard-regspec-value dest)))
1697    (movl (:%l x) (:%l dest))
1698    (andl (:%l y) (:%l dest)))))
1699
1700(define-x8632-vinsn %logxor2 (((dest :imm))
1701                              ((x :imm)
1702                               (y :imm)))
1703  ((:pred =
1704          (:apply %hard-regspec-value x)
1705          (:apply %hard-regspec-value dest))
1706   (xorl (:%l y) (:%l dest)))
1707  ((:not (:pred =
1708                (:apply %hard-regspec-value x)
1709                (:apply %hard-regspec-value dest)))
1710   ((:pred =
1711           (:apply %hard-regspec-value y)
1712           (:apply %hard-regspec-value dest))
1713    (xorl (:%l x) (:%l dest)))
1714   ((:not (:pred =
1715                 (:apply %hard-regspec-value y)
1716                 (:apply %hard-regspec-value dest)))
1717    (movl (:%l x) (:%l dest))
1718    (xorl (:%l y) (:%l dest)))))
1719
1720(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
1721
1722(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
1723
1724(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
1725
1726(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
1727
1728(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc) 
1729
1730(define-x8632-vinsn setup-double-float-allocation (()
1731                                                   ())
1732  (movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
1733  (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8664::imm1.l)))
1734
1735(define-x8632-vinsn set-double-float-value (()
1736                                            ((node :lisp)
1737                                             (val :double-float)))
1738  (movsd (:%xmm val) (:@ x8664::double-float.value (:%l node))))
1739
1740(define-x8632-vinsn %natural+  (((result :u32))
1741                               ((result :u32)
1742                                (other :u32)))
1743  (addl (:%l other) (:%l result)))
1744
1745(define-x8632-vinsn %natural+-c (((result :u32))
1746                                ((result :u32)
1747                                 (constant :s32const)))
1748  (addl (:$l constant) (:%l result)))
1749
1750(define-x8632-vinsn %natural-  (((result :u32))
1751                               ((result :u32)
1752                                (other :u32)))
1753  (subl (:%l other) (:%l result)))
1754
1755(define-x8632-vinsn %natural--c (((result :u32))
1756                                ((result :u32)
1757                                 (constant :s32const)))
1758  (subl (:$l constant) (:%l result)))
1759
1760(define-x8632-vinsn %natural-logior (((result :u32))
1761                                    ((result :u32)
1762                                     (other :u32)))
1763  (orl (:%l other) (:%l result)))
1764
1765(define-x8632-vinsn %natural-logior-c (((result :u32))
1766                                      ((result :u32)
1767                                       (constant :s32const)))
1768  (orl (:$l constant) (:%l result)))
1769
1770(define-x8632-vinsn %natural-logand (((result :u32))
1771                                    ((result :u32)
1772                                     (other :u32)))
1773  (andl (:%l other) (:%l result)))
1774
1775(define-x8632-vinsn %natural-logand-c (((result :u32))
1776                                      ((result :u32)
1777                                       (constant :s32const)))
1778  (andl (:$l constant) (:%l result)))
1779
1780(define-x8632-vinsn %natural-logxor (((result :u32))
1781                                    ((result :u32)
1782                                     (other :u32)))
1783  (xorl (:%l other) (:%l result)))
1784
1785(define-x8632-vinsn %natural-logxor-c (((result :u32))
1786                                       ((result :u32)
1787                                        (constant :s32const)))
1788  (xorl (:$l constant) (:%l result)))
1789
1790(define-x8632-vinsn natural-shift-left (((dest :u32))
1791                                        ((dest :u32)
1792                                         (amt :u8const)))
1793  (shll (:$ub amt) (:%l dest)))
1794
1795(define-x8632-vinsn natural-shift-right (((dest :u32))
1796                                         ((dest :u32)
1797                                          (amt :u8const)))
1798  (shrl (:$ub amt) (:%l dest)))
1799
1800(define-x8632-vinsn recover-fn (()
1801                                ())
1802  (movl (:$self 0) (:%l x8632::fn)))
1803
1804;;; xxx probably wrong
1805(define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
1806                                                          ((spno :s32const)
1807                                                           (x t)
1808                                                           (y t)
1809                                                           (z t))
1810                                                          ((entry (:label 1))))
1811  (:talign 5)
1812  (call (:@ spno))
1813  (movl (:$self 0) (:%l x8632::fn)))
1814
1815(define-x8632-vinsn vcell-ref (((dest :lisp))
1816                               ((vcell :lisp)))
1817  (movl (:@ x8632::misc-data-offset (:%l vcell)) (:%l dest)))
1818
1819(define-x8632-vinsn setup-vcell-allocation (()
1820                                            ())
1821  (movl (:$l x8632::value-cell-header) (:%l x8632::imm0))
1822  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
1823  (movl (:$l (- x8632::value-cell.size x8632::fulltag-misc)) (:%l x8632::imm0)))
1824
1825(define-x8632-vinsn %init-vcell (()
1826                                 ((vcell :lisp)
1827                                  (closed :lisp)))
1828  (movl (:%l closed) (:@ x8632::value-cell.value (:%l vcell))))
1829
1830;;; Magic numbers in here include the address of .SPcall-closure.
1831
1832;;; movl $self, %fn
1833;;; jmp *20660 (.SPcall-closure)
1834(define-x8632-vinsn init-nclosure (()
1835                                   ((closure :lisp)))
1836  (movb (:$b 4) (:@ x8632::misc-data-offset (:%l closure))) ;imm word count
1837  (movb (:$b #xbf) (:@ (+ x8632::misc-data-offset 2) (:%l closure))) ;movl $self, %fn
1838  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 3) (:%l closure)))
1839  (movb (:$b #xff) (:@ (+ x8632::misc-data-offset 7) (:%l closure))) ;jmp
1840  (movl (:$l #x0050b425) (:@ (+ x8632::misc-data-offset 8) (:%l closure))) ;.SPcall-closure
1841  ;; already aligned
1842  (movl (:%l closure) (:@ (+ x8632::misc-data-offset 16) (:%l closure))) ;self-reference entry
1843  (movb (:$b x8632::function-boundary-marker) (:@ (+ x8632::misc-data-offset 20) (:%l closure))))
1844
1845(define-x8632-vinsn finalize-closure (((closure :lisp))
1846                                      ((closure :lisp)))
1847  (nop))
1848
1849
1850(define-x8632-vinsn (ref-symbol-value :call :subprim-call)
1851    (((val :lisp))
1852     ((sym (:lisp (:ne val)))))
1853  (:talign 5)
1854  (call (:@ .SPspecrefcheck))
1855  (movl (:$self 0) (:%l x8632::fn)))
1856
1857(define-x8632-subprim-lea-jmp-vinsn (bind-nil)  .SPbind-nil)
1858
1859(define-x8632-subprim-lea-jmp-vinsn (bind-self)  .SPbind-self)
1860
1861(define-x8632-subprim-lea-jmp-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
1862
1863(define-x8632-subprim-lea-jmp-vinsn (bind)  .SPbind)
1864
1865(define-x8632-vinsn (dpayback :call :subprim-call) (()
1866                                                    ((n :s16const))
1867                                                    ((temp (:u32 #.x8632::imm0))
1868                                                     (entry (:label 1))))
1869  ((:pred > n 0)
1870   ((:pred > n 1)
1871    (movl (:$l n) (:%l temp))
1872    (:talign 4)
1873    (call (:@ .SPunbind-n)))
1874   ((:pred = n 1)
1875    (:talign 5)
1876    (call (:@ .SPunbind)))
1877   (movl (:$self 0) (:%l x8632::fn))))
1878
1879(define-x8632-vinsn (setq-special :call :subprim-call)
1880    (()
1881     ((sym :lisp)
1882      (val :lisp))
1883     ((entry (:label 1))))
1884  (:talign 5)
1885  (call (:@ .SPspecset))
1886  (movl (:$self 0) (:%l x8632::fn)))
1887
1888(define-x8632-vinsn %symptr->symvector (((target :lisp))
1889                                        ((target :lisp)))
1890  (nop))
1891
1892(define-x8632-vinsn %symvector->symptr (((target :lisp))
1893                                        ((target :lisp)))
1894  (nop))
1895
1896(define-x8632-vinsn symbol-function (((val :lisp))
1897                                     ((sym (:lisp (:ne val))))
1898                                     ((tag :u8)))
1899  (movl (:@ x8632::symbol.fcell (:%l sym)) (:%l val))
1900  (movl (:%l val) (:%l tag))
1901  (andb (:$b x8632::tagmask) (:%b tag))
1902  (cmpb (:$b x8632::tag-misc) (:%b tag))
1903  (jne.pn :bad)
1904  (movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
1905  (cmpb (:$b x8632::subtag-function) (:%b tag))
1906  (je.pt :ok)
1907  :bad
1908  (uuo-error-udf (:%l sym))
1909  :ok)
1910
1911(define-x8632-vinsn  %slot-ref (((dest :lisp))
1912                                ((instance (:lisp (:ne dest)))
1913                                 (index :lisp)))
1914  (movl (:@ x8632::misc-data-offset (:%l instance) (:%l index)) (:%l dest))
1915  (cmpl (:$l x8664::slot-unbound-marker) (:%l dest))
1916  (jne.pt :ok)
1917  (uuo-error-slot-unbound (:%l dest) (:%l instance) (:%l index))
1918  :ok)
1919
1920(define-x8632-vinsn symbol-ref (((dest :lisp))
1921                                ((src :lisp)
1922                                 (cellno :u32const)))
1923  (movl (:@ (:apply + (- x8632::node-size x8632::fulltag-misc)
1924                    (:apply ash cellno 2))
1925              (:%l src)) (:%l dest)))
1926
1927(define-x8632-vinsn scale-nargs (()
1928                                 ((nfixed :s16const)))
1929  ((:pred > nfixed 0)
1930   (addw (:$w (:apply - (:apply ash nfixed x8632::word-shift))) (:%w x8632::nargs))))
1931
1932;; xxx wrong for sure
1933(define-x8632-vinsn two-opt-supplied-p (()
1934                                        ()
1935                                        ((temp0 :u32)
1936                                         (temp1 :u32)))
1937  (rcmpw (:%w x8632::nargs) (:$w x8632::node-size))
1938  (setae (:%b temp0))
1939  (seta (:%b temp1))
1940  (negb (:%b temp0))
1941  (negb (:%b temp1))
1942  (andl (:$b x8632::t-offset) (:%l temp0))
1943  (andl (:$b x8632::t-offset) (:%l temp1))
1944  (addl (:$l x8632::nil-value) (:%l temp0))
1945  (addl (:$l x8632::nil-value) (:%l temp1))
1946  (pushl (:%l temp0))
1947  (pushl (:%l temp1)))
1948
1949(queue-fixup
1950 (fixup-x86-vinsn-templates
1951  *x8632-vinsn-templates*
1952  x86::*x86-opcode-template-lists*))
1953
Note: See TracBrowser for help on using the repository browser.