source: branches/working-0711/ccl/compiler/X86/X8632/x8632-vinsns.lisp @ 13070

Last change on this file since 13070 was 13070, checked in by gz, 10 years ago

r13066, r13067 from trunk: copyrights etc

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