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

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

More.

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