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

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

unbind-interrupt-level-inline: figure out what the 16 was for.

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