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

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

Hairy trap-unless-typecode-= and some other additional vinsns.

File size: 51.8 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  (xorl (:%l temp) (:%l temp))
542  (shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l temp))
543  (rcmpl (:%l idx) (:%l temp))
544  (jb.pt :ok)
545  (uuo-error-vector-bounds (:%l idx) (:%l v))
546  :ok)
547
548(define-x8632-vinsn %cdr (((dest :lisp))
549                          ((src :lisp)))
550  (movl (:@ x8632::cons.cdr (:%l src)) (:%l dest)))
551
552(define-x8632-vinsn (%vpush-cdr :push :node :vsp)
553    (()
554     ((src :lisp)))
555  (pushl (:@ x8632::cons.cdr (:%l src))))
556
557(define-x8632-vinsn %car (((dest :lisp))
558                          ((src :lisp)))
559  (movl (:@ x8632::cons.car (:%l src)) (:%l dest)))
560
561(define-x8632-vinsn (%vpush-car :push :node :vsp)
562    (()
563     ((src :lisp)))
564  (pushl (:@ x8632::cons.car (:%l src))))
565
566(define-x8632-vinsn u32->char (((dest :lisp)
567                               (src :u8))
568                              ((src :u8))
569                              ())
570  (shll (:$ub x8632::charcode-shift) (:%l src))
571  (leal (:@ x8632::subtag-character (:%l src)) (:%l dest)))
572
573(define-x8632-vinsn (load-nil :constant-ref) (((dest t))
574                                              ())
575  (movl (:$l x8632::nil-value) (:%l dest)))
576
577
578(define-x8632-vinsn (load-t :constant-ref) (((dest t))
579                                            ())
580  (movl (:$l x8632::t-value) (:%l dest)))
581
582;;; use something like this for the other extract-whatevers, too,
583;;; once it's established that it works.
584(define-x8632-vinsn extract-tag (((tag :u8))
585                                 ((object :lisp)))
586  (movl (:%l object) (:%l tag))
587  ((:pred = (:apply %hard-regspec-value tag) x8632::al)
588   ;; tag is the accumulator (2 bytes)
589   (andb (:$b x8632::tagmask) (:%accb tag)))
590  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::al)
591         (:pred <= (:apply %hard-regspec-value tag) x8632::bl))
592   ;; tag is in a register whose low 8 bits can be accessed by byte
593   ;; insns (3 bytes)
594   (andb (:$b x8632::tagmask) (:%b tag)))
595  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
596   ;; tag is somewhere else (6 bytes) (could use andw and get a length
597   ;; of 5 bytes, but Intel's optimization manual advises avoiding
598   ;; length-changing prefixes to change the size of immediates.
599   ;; (section 3.4.2.3)
600   (andl (:$l x8632::tagmask) (:%l tag))))
601
602(define-x8632-vinsn extract-tag-fixnum (((tag :imm))
603                                        ((object :lisp)))
604  (leal (:@ (:%l object) 4) (:%l tag))
605  (andw (:$w (ash x8632::tagmask x8632::fixnumshift)) (:%w tag)))
606
607(define-x8632-vinsn extract-fulltag (((tag :u8))
608                                 ((object :lisp)))
609  (movl (:%l object) (:%l tag))
610  (andw (:$w x8632::fulltagmask) (:%w tag)))
611
612(define-x8632-vinsn extract-fulltag-fixnum (((tag :imm))
613                                            ((object :lisp)))
614  (leal (:@ (:%l object) 4) (:%l tag))
615  (andw (:$w (ash x8632::fulltagmask x8632::fixnumshift)) (:%w tag)))
616
617(define-x8632-vinsn extract-typecode (((tag :imm))
618                                      ((object :lisp)))
619  (movl (:%l object) (:%l tag))
620  ((:pred <= (:apply  %hard-regspec-value tag) x8632::ebx)
621   (andb (:$b x8632::tagmask) (:%b tag))
622   (cmpb (:$b x8632::tag-misc) (:%b tag)))
623  ((:pred > (:apply  %hard-regspec-value tag) x8632::ebx)
624   (andl (:$l x8632::tagmask) (:%l tag))
625   (cmpl (:$l x8632::tag-misc) (:%l tag)))
626  (jne :have-tag)
627  ((:pred <= (:apply  %hard-regspec-value tag) x8632::ebx)
628   (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag)))
629  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
630   (movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag)))
631  :have-tag)
632
633(define-x8632-vinsn extract-typecode-fixnum (((tag :imm))
634                                             ((object :lisp))
635                                             ((temp :u32)))
636  (movl (:%l object) (:%l temp))
637  (andw (:$w x8632::tagmask) (:%w temp))
638  (cmpw (:$w x8632::tag-misc) (:%w temp))
639  (jne :have-tag)
640  (movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w temp))
641  :have-tag
642  (leal (:@ (:%l temp) 4) (:%l tag)))
643
644(define-x8632-vinsn compare-reg-to-zero (()
645                                         ((reg :imm)))
646  (testl (:%l reg) (:%l reg)))
647
648;;; life will be sad if reg isn't byte accessible
649(define-x8632-vinsn compare-u8-reg-to-zero (()
650                                            ((reg :u8)))
651  (testb (:%b reg) (:%b reg)))
652
653(define-x8632-vinsn cr-bit->boolean (((dest :lisp))
654                                     ((crbit :u8const))
655                                     ((temp :u32)))
656  (movl (:$l x8632::t-value) (:%l temp))
657  (leal (:@ (- x8632::t-offset) (:%l temp)) (:%l dest))
658  (cmovccl (:$ub crbit) (:%l temp) (:%l dest)))
659
660(define-x8632-vinsn compare-s32-constant (()
661                                            ((val :imm)
662                                             (const :s32const)))
663  ((:or  (:pred < const -128) (:pred > const 127))
664   (rcmpl (:%l val) (:$l const)))
665  ((:not (:or  (:pred < const -128) (:pred > const 127)))
666   (rcmpl (:%l val) (:$b const))))
667
668(define-x8632-vinsn compare-u31-constant (()
669                                          ((val :u32)
670                                           (const :u32const)))
671  ((:pred > const 127)
672   (rcmpl (:%l val) (:$l const)))
673  ((:not (:pred > const 127))
674   (rcmpl (:%l val) (:$b const))))
675
676;;;life will be sad if val isn't accesible as a byte reg
677(define-x8632-vinsn compare-u8-constant (()
678                                         ((val :u8)
679                                          (const :u8const)))
680  (rcmpb (:%b val) (:$b const))
681  )
682
683(define-x8632-vinsn cons (((dest :lisp))
684                          ((car :lisp)
685                           (cdr :lisp))
686                          ((allocptr (:lisp #.x8632::allocptr))))
687  (subl (:$b (- x8632::cons.size x8632::fulltag-cons)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
688  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l x8632::allocptr))
689  (rcmpl (:%l x8632::allocptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
690  (jg :no-trap)
691  (uuo-alloc)
692  :no-trap
693  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
694  (movl (:%l car) (:@ x8632::cons.car (:%l x8632::allocptr)))
695  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l x8632::allocptr)))
696  (movl (:%l x8632::allocptr) (:%l dest)))
697
698(define-x8632-vinsn unbox-u8 (((dest :u8))
699                              ((src :lisp)))
700  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l dest))
701  (andl (:% src) (:% dest))
702  (je.pt :ok)
703  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-8))
704  :ok
705  (movl (:%l src) (:%l dest))
706  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
707
708(define-x8632-vinsn %unbox-u8 (((dest :u8))
709                              ((src :lisp)))
710  (movl (:%l src) (:%l dest))
711  (shrl (:$ub x8632::fixnumshift) (:%l dest))
712  (andl (:$l #xff) (:%l dest)))
713
714(define-x8632-vinsn unbox-s8 (((dest :s8))
715                              ((src :lisp)))
716  (movl (:%l src) (:%l dest))
717  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
718  (sarl (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
719  (cmpl (:%l src) (:%l dest))
720  (jne.pn :bad)
721  (testw (:$w x8632::fixnummask) (:%w dest))
722  (jne.pn :bad)
723  (sarl (:$ub x8632::fixnumshift) (:%l dest))
724  (jmp :got-it)
725  :bad
726  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-8))
727  :got-it)
728
729(define-x8632-vinsn unbox-u16 (((dest :u16))
730                              ((src :lisp)))
731  (testl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:% src))
732  (movl (:%l src) (:%l dest))
733  (je.pt :ok)
734  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-16))
735  :ok
736  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
737
738(define-x8632-vinsn %unbox-u16 (((dest :u16))
739                              ((src :lisp)))
740  (movl (:%l src) (:%l dest))
741  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
742
743(define-x8632-vinsn unbox-s16 (((dest :s16))
744                              ((src :lisp)))
745  (movl (:%l src) (:%l dest))
746  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
747  (sarl (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
748  (cmpl (:%l src) (:%l dest))
749  (jne.pn :bad)
750  (testw (:$w x8632::fixnummask) (:%w dest))
751  (je.pt :got-it)
752  :bad
753  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-16))
754  :got-it
755  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
756
757(define-x8632-vinsn %unbox-s16 (((dest :s16))
758                                ((src :lisp)))
759  (movl (:%l src) (:%l dest))
760  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
761
762;;; xxx -- review this again later
763(define-x8632-vinsn unbox-u32 (((dest :u32))
764                               ((src :lisp)))
765  (movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest))
766  (testl (:%l dest) (:%l src))
767  (movl (:%l src) (:%l dest))
768  (jnz :maybe-bignum)
769  (sarl (:$ub x8632::fixnumshift) (:%l dest))
770  (jmp :done)
771  :maybe-bignum
772  (andw (:$w x8632::tagmask) (:%w dest))
773  (cmpw (:$w x8632::tag-misc) (:%w dest))
774  (jne :have-tag)
775  (movw (:@ x8632::misc-subtag-offset (:%l src)) (:%w dest))
776  (andw (:$w #xff) (:%w dest))
777  :have-tag
778  (cmpw (:$w x8632::subtag-bignum) (:%w dest))
779  (jne :bad)
780  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest))
781  (cmpl (:$l x8632::three-digit-bignum-header) (:%l dest))
782  (je :three)
783  (cmpl (:$l x8632::two-digit-bignum-header) (:%l dest))
784  (jne :bad)
785  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
786  (testl (:%l dest) (:%l dest))
787  (jns :done)
788  :bad
789  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32))
790  :three
791  (movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest))
792  (testl (:%l dest) (:%l dest))
793  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
794  (jne :bad)
795  :done)
796
797;;; xxx -- review this again later
798(define-x8632-vinsn unbox-s32 (((dest :s32))
799                               ((src :lisp)))
800  (movl (:%l src) (:%l dest))
801  (sarl (:$ub x8632::fixnumshift) (:%l dest))
802  ;; Was it a fixnum ?
803  (testw (:$w x8632::fixnummask) (:%w src))
804  (je :done)
805  ;; May be a 2-digit bignum
806  (movw (:%w src) (:%w dest))
807  (andw (:$w x8632::tagmask) (:%w dest))
808  (cmpw (:$w x8632::tag-misc) (:%w dest))
809  (jne :bad)
810  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src)))
811  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
812  (je :done)
813  :bad
814  (uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32))
815  :done)
816
817
818;;; xxx -- sigh...
819(define-x8632-vinsn sign-extend-s8 (((dest :s32))
820                                    ((src :s8)))
821  ;; (movsbl (:%b temp) (:%l dest))
822  (movl (:%l src) (:%l dest))
823  (shll (:$ub 24) (:%l dest))
824  (sarl (:$ub 24) (:%l dest)))
825
826(define-x8632-vinsn sign-extend-s16 (((dest :s32))
827                                     ((src :s16)))
828  (movswl (:%w src) (:%l dest)))
829
830;;; xxx -- sigh...
831(define-x8632-vinsn zero-extend-u8 (((dest :s32))
832                                    ((src :u8)))
833  ;;(movzbl (:%b src) (:%l dest))
834  (movl (:%l src) (:%l dest))
835  (andl (:$l #xff) (:%l dest)))
836
837(define-x8632-vinsn zero-extend-u16 (((dest :s32))
838                                     ((src :u16)))
839  (movzwl (:%w src) (:%l dest)))
840
841(define-x8632-vinsn (jump-subprim :jumpLR) (()
842                                            ((spno :s32const)))
843  (jmp (:@ spno)))
844
845;;; Call a subprimitive using a tail-aligned CALL instruction.
846(define-x8632-vinsn (call-subprim :call)  (()
847                                           ((spno :s32const))
848                                           ((entry (:label 1))))
849  (:talign x8632::fulltag-tra)
850  (call (:@ spno))
851  (movl (:$self 0) (:% x8632::fn)))
852
853(define-x8632-vinsn fixnum-subtract-from (((dest t)
854                                           (y t))
855                                          ((y t)
856                                           (x t)))
857  (subl (:%l y) (:%l x)))
858
859(define-x8632-vinsn %logand-c (((dest t)
860                                (val t))
861                               ((val t)
862                                (const :s32const)))
863  ((:and (:pred >= const -128) (:pred <= const 127))
864   (andl (:$b const) (:%l val)))
865  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
866   (andl (:$l const) (:%l val))))
867
868(define-x8632-vinsn %logior-c (((dest t)
869                                (val t))
870                               ((val t)
871                                (const :s32const)))
872  ((:and (:pred >= const -128) (:pred <= const 127))
873   (orl (:$b const) (:%l val)))
874  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
875   (orl (:$l const) (:%l val))))
876
877(define-x8632-vinsn %logxor-c (((dest t)
878                                (val t))
879                               ((val t)
880                                (const :s32const)))
881  ((:and (:pred >= const -128) (:pred <= const 127))
882   (xorl (:$b const) (:%l val)))
883  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
884   (xorl (:$l const) (:%l val))))
885
886(define-x8632-vinsn character->fixnum (((dest :lisp))
887                                       ((src :lisp))
888                                       ())
889  ((:not (:pred =
890                (:apply %hard-regspec-value dest)
891                (:apply %hard-regspec-value src)))
892   (movl (:%l src) (:%l dest)))
893  (shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest)))
894
895(define-x8632-vinsn compare (()
896                             ((x t)
897                              (y t)))
898  (rcmpl (:%l x) (:%l y)))
899
900(define-x8632-vinsn negate-fixnum (((val :lisp))
901                                   ((val :imm)))
902  (negl (:% val)))
903
904;;; set-bigits-and-header-for-fixnum-overflow
905
906(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
907                                                       ((src :s32))
908                                                       ((temp :s32)))
909  (movl (:%l src) (:%l temp))
910  (shll (:$ub x8632::fixnumshift) (:%l temp))
911  (movl (:%l temp) (:%l dest))          ; tagged as a fixnum
912  (sarl (:$ub x8632::fixnumshift) (:%l temp))
913  (cmpl (:%l src) (:%l temp)))
914
915(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
916                                                       ((src :u32))
917                                                       ((temp :u32)))
918  (movl (:%l src) (:%l temp))
919  (shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
920  (movl (:%l temp) (:%l dest))          ; tagged as an even fixnum
921  (shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
922  (shrl (:%l dest))
923  (cmpl (:%l src) (:%l temp))
924  :done)
925
926;;; setup-bignum-alloc-for-s32-overflow
927;;; setup-bignum-alloc-for-u32-overflow
928
929;;; the uuo-alloc code looks at these exact registers
930;;; header and size are actually args, not temporaries,
931;;; but it appears that there's isn't a way to enforce
932;;; register usage on vinsn args.
933(define-x8632-vinsn %allocate-uvector (((dest :lisp))
934                                      ()
935                                      ((header (:u32 #.x8632::eax))
936                                       (size (:u32 #.x8632::edx))
937                                       (freeptr (:lisp #.x8632::allocptr))))
938  (subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
939  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
940  (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
941  (jg :no-trap)
942  (uuo-alloc)
943  :no-trap
944  (movl (:%l header) (:@ x8632::misc-header-offset (:%l freeptr)))
945  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
946  ((:not (:pred = freeptr
947                (:apply %hard-regspec-value dest)))
948   (movl (:%l freeptr) (:%l dest))))
949
950(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
951                                                      ((bignum :lisp)))
952  (movq (:%mmx x8664::mm0) (:@ x8632::misc-data-offset (:%l bignum))))
953 
954(define-x8632-vinsn box-fixnum (((dest :imm))
955                                ((src :s32)))
956  ;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
957  (leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
958
959;;; xxx
960(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
961    (((val :lisp))
962     ((val :lisp))
963     ((unboxed (:s32 #.x8632::edx))
964      (header (:u32 #.x8632::imm0))
965      (entry (:label 1))))
966  (jno.pt :done)
967  ((:not (:pred = x8632::arg_z
968                (:apply %hard-regspec-value val)))
969   (movl (:%l val) (:%l x8632::arg_z)))
970  (:talign 5)
971  (call (:@ .SPfix-overflow))
972  (movl (:$self 0) (:%l x8632::fn))
973  ((:not (:pred = x8632::arg_z
974                (:apply %hard-regspec-value val)))
975   (movl (:%l x8632::arg_z) (:%l val)))
976  :done)
977
978;;; xxx
979(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
980    (((val :lisp))
981     ((val :lisp)
982      (lab :label))
983     ((unboxed (:s32 #.x8664::imm1))
984      (header (:u32 #.x8664::imm0))
985      (entry (:label 1))))
986  (jno.pt lab)
987  ((:not (:pred = x8632::arg_z
988                (:apply %hard-regspec-value val)))
989   (movl (:%l val) (:%l x8632::arg_z)))
990  (:talign 5)
991  (call (:@ .SPfix-overflow))
992  (movl (:$self 0) (:%l x8632::fn))
993  ((:not (:pred = x8632::arg_z
994                (:apply %hard-regspec-value val)))
995   (movl (:%l x8632::arg_z) (:%l val)))
996  (jmp lab))
997
998
999(define-x8632-vinsn add-constant (((dest :imm))
1000                                  ((dest :imm)
1001                                   (const :s32const)))
1002  ((:and (:pred >= const -128) (:pred <= const 127))
1003   (addl (:$b const) (:%l dest)))
1004  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1005   (addl (:$l const) (:%l dest))))
1006
1007(define-x8632-vinsn add-constant3 (((dest :imm))
1008                                   ((src :imm)
1009                                    (const :s32const)))
1010  ((:pred = (:apply %hard-regspec-value dest)
1011          (:apply %hard-regspec-value src))
1012   ((:and (:pred >= const -128) (:pred <= const 127))
1013    (addl (:$b const) (:%l dest)))
1014   ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1015    (addl (:$l const) (:%l dest))))
1016  ((:not (:pred = (:apply %hard-regspec-value dest)
1017                (:apply %hard-regspec-value src)))
1018   (leal (:@ const (:%l src)) (:%l dest))))
1019
1020(define-x8632-vinsn fixnum-add2  (((dest :imm))
1021                                  ((dest :imm)
1022                                   (other :imm)))
1023  (addl (:%l other) (:%l dest)))
1024
1025(define-x8632-vinsn fixnum-sub2  (((dest :imm))
1026                                  ((x :imm)
1027                                   (y :imm))
1028                                  ((temp :imm)))
1029  (movl (:%l x) (:%l temp))
1030  (subl (:%l y) (:%l temp))
1031  (movl (:%l temp) (:%l dest)))
1032
1033(define-x8632-vinsn fixnum-add3 (((dest :imm))
1034                                 ((x :imm)
1035                                  (y :imm)))
1036 
1037  ((:pred =
1038          (:apply %hard-regspec-value x)
1039          (:apply %hard-regspec-value dest))
1040   (addl (:%l y) (:%l dest)))
1041  ((:not (:pred =
1042                (:apply %hard-regspec-value x)
1043                (:apply %hard-regspec-value dest)))
1044   ((:pred =
1045           (:apply %hard-regspec-value y)
1046           (:apply %hard-regspec-value dest))
1047    (addl (:%l x) (:%l dest)))
1048   ((:not (:pred =
1049                 (:apply %hard-regspec-value y)
1050                 (:apply %hard-regspec-value dest)))
1051    (leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1052
1053(define-x8632-vinsn copy-gpr (((dest t))
1054                              ((src t)))
1055  ((:not (:pred =
1056                (:apply %hard-regspec-value dest)
1057                (:apply %hard-regspec-value src)))
1058   (movl (:%l src) (:%l dest))))
1059
1060(define-x8632-vinsn (vpop-register :pop :node :vsp)
1061    (((dest :lisp))
1062     ())
1063  (popl (:%l dest)))
1064
1065(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1066                                                      ())
1067  (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1068  (jb :done)
1069  (je :one)
1070  (pushl (:%l x8632::arg_y))
1071  :one
1072  (pushl (:%l x8632::arg_z))
1073  :done)
1074
1075(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1076                                                         ((max :u32const)))
1077  ((:pred >= max 2)
1078   (rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1079   (jb :done)
1080   (je :one)
1081   (pushl (:%l x8632::arg_y))
1082   :one
1083   (pushl (:%l x8632::arg_z))
1084   :done)
1085  ((:pred = max 1)
1086   (testw (:%w x8632::nargs) (:%w x8632::nargs))
1087   (je :done)
1088   (pushl (:%l x8632::arg_z))
1089   :done))
1090
1091(define-x8632-vinsn (call-label :call) (()
1092                                        ((label :label))
1093                                        ((entry (:label 1))))
1094  (:talign 5)
1095  (call label)
1096  (movl (:$self 0) (:%l x8632::fn)))
1097
1098(define-x8632-vinsn double-float-compare (()
1099                                          ((arg0 :double-float)
1100                                           (arg1 :double-float)))
1101  (comisd (:%xmm arg1) (:%xmm arg0)))
1102
1103(define-x8632-vinsn single-float-compare (()
1104                                          ((arg0 :single-float)
1105                                           (arg1 :single-float)))
1106  (comiss (:%xmm arg1) (:%xmm arg0)))
1107
1108(define-x8632-vinsn double-float+-2 (((result :double-float))
1109                                     ((x :double-float)
1110                                      (y :double-float)))
1111  ((:pred =
1112          (:apply %hard-regspec-value result)
1113          (:apply %hard-regspec-value x))
1114   (addsd (:%xmm y) (:%xmm result)))
1115  ((:and (:not (:pred =
1116                      (:apply %hard-regspec-value result)
1117                      (:apply %hard-regspec-value x)))
1118         (:pred =
1119                (:apply %hard-regspec-value result)
1120                (:apply %hard-regspec-value y)))
1121   (addsd (:%xmm x) (:%xmm result)))
1122  ((:and (:not (:pred =
1123                      (:apply %hard-regspec-value result)
1124                      (:apply %hard-regspec-value x)))
1125         (:not (:pred =
1126                      (:apply %hard-regspec-value result)
1127                      (:apply %hard-regspec-value y))))
1128   (movsd (:%xmm x) (:%xmm result))
1129   (addsd (:%xmm y) (:%xmm result))))
1130
1131;;; Caller guarantees (not (eq y result))
1132(define-x8632-vinsn double-float--2 (((result :double-float))
1133                                     ((x :double-float)
1134                                      (y :double-float)))
1135  ((:not (:pred = (:apply %hard-regspec-value result)
1136                (:apply %hard-regspec-value x)))
1137   (movsd (:%xmm x) (:%xmm result)))
1138  (subsd (:%xmm y) (:%xmm result)))
1139
1140(define-x8632-vinsn double-float*-2 (((result :double-float))
1141                                     ((x :double-float)
1142                                      (y :double-float)))
1143  ((:pred =
1144          (:apply %hard-regspec-value result)
1145          (:apply %hard-regspec-value x))
1146   (mulsd (:%xmm y) (:%xmm result)))
1147  ((:and (:not (:pred =
1148                      (:apply %hard-regspec-value result)
1149                      (:apply %hard-regspec-value x)))
1150         (:pred =
1151                (:apply %hard-regspec-value result)
1152                (:apply %hard-regspec-value y)))
1153   (mulsd (:%xmm x) (:%xmm result)))
1154  ((:and (:not (:pred =
1155                      (:apply %hard-regspec-value result)
1156                      (:apply %hard-regspec-value x)))
1157         (:not (:pred =
1158                      (:apply %hard-regspec-value result)
1159                      (:apply %hard-regspec-value y))))
1160   (movsd (:%xmm x) (:%xmm result))
1161   (mulsd (:%xmm y) (:%xmm result))))
1162
1163;;; Caller guarantees (not (eq y result))
1164(define-x8632-vinsn double-float/-2 (((result :double-float))
1165                                     ((x :double-float)
1166                                      (y :double-float)))
1167  ((:not (:pred = (:apply %hard-regspec-value result)
1168                (:apply %hard-regspec-value x)))
1169   (movsd (:%xmm x) (:%xmm result)))
1170  (divsd (:%xmm y) (:%xmm result)))
1171
1172(define-x8632-vinsn single-float+-2 (((result :single-float))
1173                                     ((x :single-float)
1174                                      (y :single-float)))
1175  ((:pred =
1176          (:apply %hard-regspec-value result)
1177          (:apply %hard-regspec-value x))
1178   (addss (:%xmm y) (:%xmm result)))
1179  ((:and (:not (:pred =
1180                      (:apply %hard-regspec-value result)
1181                      (:apply %hard-regspec-value x)))
1182         (:pred =
1183                (:apply %hard-regspec-value result)
1184                (:apply %hard-regspec-value y)))
1185   (addss (:%xmm x) (:%xmm result)))
1186  ((:and (:not (:pred =
1187                      (:apply %hard-regspec-value result)
1188                      (:apply %hard-regspec-value x)))
1189         (:not (:pred =
1190                      (:apply %hard-regspec-value result)
1191                      (:apply %hard-regspec-value y))))
1192   (movss (:%xmm x) (:%xmm result))
1193   (addss (:%xmm y) (:%xmm result))))
1194
1195;;; Caller guarantees (not (eq y result))
1196(define-x8632-vinsn single-float--2 (((result :single-float))
1197                                     ((x :single-float)
1198                                      (y :single-float)))
1199  ((:not (:pred = (:apply %hard-regspec-value result)
1200                (:apply %hard-regspec-value x)))
1201   (movss (:%xmm x) (:%xmm result)))
1202  (subss (:%xmm y) (:%xmm result)))
1203
1204(define-x8632-vinsn single-float*-2 (((result :single-float))
1205                                     ((x :single-float)
1206                                      (y :single-float)))
1207    ((:pred =
1208          (:apply %hard-regspec-value result)
1209          (:apply %hard-regspec-value x))
1210   (mulss (:%xmm y) (:%xmm result)))
1211  ((:and (:not (:pred =
1212                      (:apply %hard-regspec-value result)
1213                      (:apply %hard-regspec-value x)))
1214         (:pred =
1215                (:apply %hard-regspec-value result)
1216                (:apply %hard-regspec-value y)))
1217   (mulss (:%xmm x) (:%xmm result)))
1218  ((:and (:not (:pred =
1219                      (:apply %hard-regspec-value result)
1220                      (:apply %hard-regspec-value x)))
1221         (:not (:pred =
1222                      (:apply %hard-regspec-value result)
1223                      (:apply %hard-regspec-value y))))
1224   (movss (:%xmm x) (:%xmm result))
1225   (mulss (:%xmm y) (:%xmm result))))
1226
1227;;; Caller guarantees (not (eq y result))
1228(define-x8632-vinsn single-float/-2 (((result :single-float))
1229                                     ((x :single-float)
1230                                      (y :single-float)))
1231  ((:not (:pred = (:apply %hard-regspec-value result)
1232                (:apply %hard-regspec-value x)))
1233   (movss (:%xmm x) (:%xmm result)))
1234  (divss (:%xmm y) (:%xmm result)))
1235
1236(define-x8632-vinsn get-single (((result :single-float))
1237                                ((source :lisp)))
1238  (movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1239
1240(define-x8632-vinsn get-double (((result :double-float))
1241                                ((source :lisp)))
1242  (movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1243
1244;;; Extract a double-float value, typechecking in the process.
1245;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1246;;; instead of replicating it ..
1247;;; get-double?
1248
1249(define-x8632-vinsn copy-single-float (((dest :single-float))
1250                                       ((src :single-float)))
1251  (movss (:%xmm src) (:%xmm dest)))
1252
1253(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1254                                           ((src :single-float)))
1255  (cvtss2sd (:%xmm src) (:%xmm dest)))
1256
1257(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1258                                           ((src :double-float)))
1259  (cvtsd2ss (:%xmm src) (:%xmm dest)))
1260
1261(define-x8632-vinsn fitvals (()
1262                             ((n :u16const))
1263                             ((imm :u16)))
1264  ((:pred = n 0)
1265   (xorl (:%l imm) (:%l imm)))
1266  ((:not (:pred = n 0))
1267   (movw (:$w (:apply ash n x8632::fixnumshift)) (:%w imm)))
1268  (subw (:%w x8632::nargs) (:%w imm))
1269  (jae :push-more)
1270  (movswl (:%w imm) (:%l imm))
1271  (subl (:%l imm) (:%l x8632::esp))
1272  (jmp :done)
1273  :push-loop
1274  (pushl (:$l x8632::nil-value))
1275  (addw (:$b x8632::node-size) (:%w x8632::nargs))
1276  (subw (:$b x8632::node-size) (:%w imm))
1277  :push-more
1278  (jne :push-loop)
1279  :done)
1280
1281(define-x8632-vinsn (nvalret :jumpLR) (()
1282                                       ())
1283  (jmp (:@ .SPnvalret)))
1284
1285(define-x8632-vinsn lisp-word-ref (((dest t))
1286                                   ((base t)
1287                                    (offset t)))
1288  (movl (:@ (:%l base) (:%l offset)) (:%l  dest)))
1289
1290(define-x8632-vinsn lisp-word-ref-c (((dest t))
1291                                     ((base t)
1292                                      (offset :s32const)))
1293  ((:pred = offset 0)
1294   (movl (:@ (:%l base)) (:%l dest)))
1295  ((:not (:pred = offset 0))
1296   (movl (:@ offset (:%l base)) (:%l dest))))
1297
1298;; start-mv-call
1299
1300;; ????
1301(define-x8632-vinsn emit-aligned-label (()
1302                                        ((label :label)))
1303  (:align 3)
1304  (:long (:^ label)))
1305
1306;; pass-multiple-values-symbol
1307;; pass-multiple-values
1308
1309(define-x8632-vinsn reserve-outgoing-frame (()
1310                                            ())
1311  (pushl (:$b x8632::reserved-frame-marker))
1312  (pushl (:$b x8632::reserved-frame-marker)))
1313
1314;; implicit temp0 arg
1315(define-x8632-vinsn (call-known-function :call) (()
1316                                                 ()
1317                                                 ((entry (:label 1))))
1318  (:talign 5)
1319  (call (:%l x8632::temp0))
1320  (movl (:$self 0) (:%l x8632::fn)))
1321
1322;; jump-known-function
1323;; list
1324;; make-tsp-cons
1325;; make-fixed-stack-gvector
1326
1327(define-x8632-vinsn discard-temp-frame (()
1328                                        ()
1329                                        ((temp :imm)))
1330  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1331  (movl (:@ (:%l temp)) (:%l temp))
1332  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1333  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1334  )
1335
1336(define-x8632-vinsn discard-c-frame (()
1337                                     ()
1338                                     ((temp :imm)))
1339  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1340  (movl (:@ (:%l temp)) (:%l temp))
1341  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1342
1343 
1344(define-x8632-vinsn vstack-discard (()
1345                                    ((nwords :u32const)))
1346  ((:not (:pred = nwords 0))
1347   ((:pred < nwords 16)
1348    (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1349   ((:not (:pred < nwords 16))
1350    (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1351
1352(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1353  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1354    (:talign 5)
1355    (call (:@ ,spno))
1356    :back
1357    (movl (:$self 0) (:%l x8632::fn))))
1358
1359(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1360  `(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ())
1361    (jmp (:@ ,spno))))
1362
1363
1364
1365
1366
1367
1368
1369(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1370
1371(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1372
1373(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1374                                           ((addr :s32const)))
1375  (movzbl (:@ addr) (:%l dest)))
1376
1377(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1378                                           ((addr :s32const)))
1379  (movsbl (:@ addr) (:%l dest)))
1380
1381(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1382                                           ((addr :s32const)))
1383  (movzwl (:@ addr) (:%l dest)))
1384
1385(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1386                                           ((addr :s32const)))
1387  (movswl (:@ addr) (:%l dest)))
1388
1389(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
1390                                                 ((addr :s32const)))
1391  (movl (:@ addr) (:%l dest)))
1392
1393(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
1394                                                        ((addr :s32const)))
1395  (movl (:@ addr) (:%l dest)))
1396
1397(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
1398                                                   ((addr :s32const)))
1399  (movl (:@ addr) (:%l dest)))
1400
1401(define-x8632-vinsn event-poll (()
1402                                ())
1403  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1404  (jae :no-interrupt)
1405  (ud2a)
1406  (:byte 2)
1407  :no-interrupt)
1408
1409;;; check-2d-bound
1410;;; check-3d-bound
1411;;; 2d-dim1
1412;;; 3d-dims
1413;;; 2d-unscaled-index
1414
1415;;; 3d-unscaled-index
1416
1417(define-x8632-vinsn branch-unless-both-args-fixnums (()
1418                                                     ((a :lisp)
1419                                                      (b :lisp)
1420                                                      (dest :label))
1421                                                     ((tag :u8)))
1422  (movl (:%l a) (:%l tag))
1423  (orl (:%l b) (:%l tag))
1424  (testl (:$l x8632::fixnummask) (:%l tag))
1425  (jne dest))
1426
1427(define-x8632-vinsn branch-unless-arg-fixnum (()
1428                                              ((a :lisp)
1429                                               (dest :label)))
1430  ((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
1431   (testb (:$b x8632::fixnummask) (:%b a)))
1432  ((:pred > (:apply %hard-regspec-value a) x8632::ebx)
1433   (testl (:$l x8632::fixnummask) (:%l a)))
1434  (jne dest))
1435
1436(define-x8632-vinsn fixnum->single-float (((f :single-float))
1437                                          ((arg :lisp))
1438                                          ((unboxed :s32)))
1439  (movl (:%l arg) (:%l unboxed))
1440  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1441  (cvtsi2ssl (:%l unboxed) (:%xmm f)))
1442
1443(define-x8632-vinsn fixnum->double-float (((f :double-float))
1444                                          ((arg :lisp))
1445                                          ((unboxed :s32)))
1446  (movl (:%l arg) (:%l unboxed))
1447  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1448  (cvtsi2sdl (:%l unboxed) (:%xmm f)))
1449
1450(define-x8632-vinsn xchg-registers (()
1451                                    ((a t)
1452                                     (b t)))
1453  (xchgl (:%l a) (:%l b)))
1454
1455(define-x8632-vinsn establish-fn (()
1456                                  ())
1457  (movl (:$self 0) (:%l x8632::fn)))
1458
1459
1460(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
1461                                                          ((spno :s32const)
1462                                                           (y t)
1463                                                           (z t))
1464                                                          ((entry (:label 1))))
1465  (:talign 5)
1466  (call (:@ spno))
1467  (movl (:$self 0) (:%l x8632::fn)))
1468
1469(queue-fixup
1470 (fixup-x86-vinsn-templates
1471  *x8632-vinsn-templates*
1472  x86::*x86-opcode-template-lists*))
1473
1474(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
1475
1476(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
1477
1478(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
1479
1480(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
1481
1482(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc) 
1483
Note: See TracBrowser for help on using the repository browser.