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

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

Use :$self instead of :self; add some more vinsns.

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