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

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

A couple more little tweaks to avoid partial register writes.

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