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

Last change on this file since 10495 was 10495, checked in by gb, 11 years ago

There were 2 versions of X862-LONG-CONSTANT-P. The one that we in
effect (the second one defined in this file) was leftover from MCL,
and allowed strings of length 4 (and symbols whose pnames were of
length 4) to be interpreted as "long" constants (this was leftover
support for "OSTypes"); it also allowed integer constants of unspecified
width and signedness.

Replace that with (and change the one caller to use) X862-INTEGER-CONSTANT-P,
which takes an acode form and a mode name and returns an integer if the
form represents an constant integer of the indicated type.

(In other words:

? (#_malloc :four)

Error: value :FOUR is not of the expected type (UNSIGNED-BYTE 64).

? (defun foo ()

(#_malloc :four))

FOO

shouldn't work (in compiled code) as an obscure way to allocate
#x666F7572 bytes, and

? (defun foo ()

(#_malloc -10))

  • and other cases involving integer constants of the wrong width/

signedness - shouldn't work at all.)

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