source: trunk/source/compiler/X86/X8632/x8632-vinsns.lisp @ 10339

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

Update macro DEFINE-X8632-SUBPRIM-JUMP-VINSN, vinsn THROW.

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