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

Last change on this file since 7659 was 7659, checked in by rme, 12 years ago

Add more vinsns.

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