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

Last change on this file since 9802 was 9802, checked in by rme, 11 years ago

New function UNSIGNED-TO-SIGNED. Add missing vinsns misc-ref-c-u16,
misc-ref-c-s16, misc-set-c-u16.

In several vinsns for doing natural operations with a constant
operand, change spec of constant arg to :u32const, and use
UNSIGNED-TO-SIGNED to transform it into an imm32s for the assembler.

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