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

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

Improved compilation for some fixnum operations, %svref (r13247-r13253 from trunk)

File size: 148.4 KB
RevLine 
[10972]1;;;-*- Mode: Lisp; Package: (CCL :use CL) -*-
2
[13070]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
[10972]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)))
[11412]65  (movsd (:@ x8632::misc-dfloat-offset (:%l v) (:%l scaled-idx) 2) (:%xmm dest)))
[10972]66
67(define-x8632-vinsn misc-ref-c-double-float  (((dest :double-float))
68                                              ((v :lisp)
69                                               (idx :s32const)))
[12256]70  (movsd (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v)) (:%xmm dest)))
[10972]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
[11089]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
[10972]103(define-x8632-vinsn misc-set-double-float (()
104                                   ((val :double-float)
105                                    (v :lisp)
106                                    (unscaled-idx :imm))
107                                   ())
[11412]108  (movsd (:%xmm val) (:@ x8632::misc-dfloat-offset (:%l v) (:%l unscaled-idx) 2)))
[10972]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)))
[11089]339  (movl (:$l (:apply target-nil-value)) (:%l x8632::arg_z))
[10972]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)))
[11089]355  (movl (:$l (:apply target-nil-value)) (:%l x8632::arg_y))
[10972]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
[11089]363  (movl (:$l (:apply target-nil-value)) (:%l x8632::arg_z))
[10972]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))
[11089]378  (pushl (:$l (:apply target-nil-value)))
[10972]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)))
[11089]446  (cmpl (:$l (:apply target-nil-value)) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
[10972]447
448(define-x8632-vinsn compare-value-cell-to-nil (()
449                                               ((vcell :lisp)))
[11089]450  (cmpl (:$l (:apply target-nil-value)) (:@ x8632::value-cell.value (:%l vcell))))
[10972]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)))
[11089]488  (cmpl (:$l (:apply target-nil-value)) (:%l arg0)))
[10972]489
490(define-x8632-vinsn compare-to-t (()
491                                  ((arg0 t)))
[11089]492  (cmpl (:$l (:apply target-t-value)) (:%l arg0)))
[10972]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
[11089]574  (cmpl (:$l (:apply target-nil-value)) (:%l object))
[10972]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))
[11089]589  (andl (:$b x8632::fulltagmask) (:%accl tag))
[10972]590  (cmpb (:$b x8632::fulltag-cons) (:%accb tag))
591  (setne (:%b x8632::ah))
[11089]592  (cmpl (:$l (:apply target-nil-value)) (:% object))
[10972]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)
[11089]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))
[10972]654  :have-tag
[11089]655  (cmpl (:$b tagval) (:%l tag))
[10972]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)
[11089]670  (movsbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
671  (cmpl (:$b x8632::subtag-single-float) (:%l tag))
[10972]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)
[11089]686  (movsbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
687  (cmpl (:$b x8632::subtag-double-float) (:%l tag))
[10972]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)
[11089]702  (movsbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
[10972]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                                              ())
[11089]758  (movl (:$l (:apply target-nil-value)) (:%l dest)))
[10972]759
760
761(define-x8632-vinsn (load-t :constant-ref) (((dest t))
762                                            ())
[11089]763  (movl (:$l (:apply target-t-value)) (:%l dest)))
[10972]764
765(define-x8632-vinsn extract-tag (((tag :u8))
766                                 ((object :lisp)))
767  (movl (:%l object) (:%l tag))
[11089]768  (andl (:$b x8632::tagmask) (:%l tag)))
[10972]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
[11089]792(define-x8632-vinsn extract-typecode (((tag :u32))
[10972]793                                      ((object :lisp)))
794  (movl (:%l object) (:%l tag))
[11089]795  (andl (:$b x8632::tagmask) (:%l tag))
796  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]797  (jne :have-tag)
[11089]798  (movzbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
[10972]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)
[11089]808  (movzbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l temp))
[10972]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)))
[11089]824  (movl (:$l (:apply target-t-value)) (:%l temp))
[10972]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))
[12198]863  (ja :no-trap)
[10972]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)))
[11412]1007  (movsbl (:%b src) (:%l dest)))
[10972]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)))
[11412]1015  (movzbl (:%b src) (:%l dest)))
[10972]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
[13332]1108(define-x8632-vinsn handle-fixnum-overflow-inline
1109    (()
1110     ((val :lisp)
1111      (no-overflow
1112       :label))
1113     ((imm (:u32 #.x8632::imm0))
1114      (freeptr (:lisp #.x8632::allocptr))))
1115  (jo :overflow)
1116  (:uuo-section)
1117  :overflow
1118  (movl (:%l val) (:%l imm))
1119  (sarl (:$ub x8632::fixnumshift) (:%l imm))
1120  (xorl (:$l #xc0000000) (:%l imm))
1121  ;; stash bignum digit
1122  (movd (:%l imm) (:%mmx x8632::mm1))
1123  ;; set header
1124  (movl (:$l x8632::one-digit-bignum-header) (:%l imm))
1125  (movd (:%l imm) (:%mmx x8632::mm0))
1126  ;; need 8 bytes of aligned memory for 1 digit bignum
1127  (movl (:$l (- 8 x8632::fulltag-misc)) (:%l imm))
1128  (subl (:%l imm) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
1129  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
1130  (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
1131  (ja :no-trap)
1132  (uuo-alloc)
1133  :no-trap
1134  (movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
1135  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
1136  ((:not (:pred = freeptr
1137                (:apply %hard-regspec-value val)))
1138   (movl (:%l freeptr) (:%l val)))
1139  (movd (:%mmx x8632::mm1) (:@ x8632::misc-data-offset (:%l val)))
1140  (jmp no-overflow))
1141
1142 
[10972]1143(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
1144                                                      ((bignum :lisp)))
1145  (movd (:%mmx x8632::mm1) (:@ x8632::misc-data-offset (:%l bignum)))) 
1146
1147
1148(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
1149                                                       ((src :s32))
1150                                                       ((temp :s32)))
1151  (movl (:%l src) (:%l temp))
1152  (shll (:$ub x8632::fixnumshift) (:%l temp))
1153  (movl (:%l temp) (:%l dest))          ; tagged as a fixnum
1154  (sarl (:$ub x8632::fixnumshift) (:%l temp))
1155  (cmpl (:%l src) (:%l temp)))
1156
1157(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
1158                                                       ((src :u32))
1159                                                       ((temp :u32)))
1160  (movl (:%l src) (:%l temp))
1161  (shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
1162  (movl (:%l temp) (:%l dest))          ; tagged as an even fixnum
1163  (shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
1164  (shrl (:%l dest))
1165  (cmpl (:%l src) (:%l temp))
1166  :done)
1167
1168;;; setup-bignum-alloc-for-s32-overflow
1169;;; setup-bignum-alloc-for-u32-overflow
1170
1171(define-x8632-vinsn setup-uvector-allocation (()
1172                                              ((header :imm)))
1173  (movd (:%l header) (:%mmx x8632::mm0)))
1174
1175;;; The code that runs in response to the uuo-alloc
1176;;; expects a header in mm0, and a size in imm0.
1177;;; mm0 is an implicit arg (it contains the uvector header)
1178;;; size is actually an arg, not a temporary,
1179;;; but it appears that there's isn't a way to enforce
1180;;; register usage on vinsn args.
1181(define-x8632-vinsn %allocate-uvector (((dest :lisp))
1182                                       ()
1183                                       ((size (:u32 #.x8632::imm0))
1184                                        (freeptr (:lisp #.x8632::allocptr))))
1185  (subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
1186  (movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
1187  (rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
[12198]1188  (ja :no-trap)
[10972]1189  (uuo-alloc)
1190  :no-trap
1191  (movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
1192  (andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
1193  ((:not (:pred = freeptr
1194                (:apply %hard-regspec-value dest)))
1195   (movl (:%l freeptr) (:%l dest))))
1196
1197(define-x8632-vinsn box-fixnum (((dest :imm))
1198                                ((src :s32)))
1199  ;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
1200  (leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
1201
1202(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
1203    (((val :lisp))
1204     ((val :lisp))
1205     ((unboxed (:s32 #.x8632::imm0))
1206      ;; we use %mm0 for header in subprim
1207      (entry (:label 1))))
1208  (jno :done)
1209  ((:not (:pred = x8632::arg_z
1210                (:apply %hard-regspec-value val)))
1211   (movl (:%l val) (:%l x8632::arg_z)))
1212  (:talign 5)
1213  (call (:@ .SPfix-overflow))
1214  (movl (:$self 0) (:%l x8632::fn))
1215  ((:not (:pred = x8632::arg_z
1216                (:apply %hard-regspec-value val)))
1217   (movl (:%l x8632::arg_z) (:%l val)))
1218  :done)
1219
1220(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
1221    (((val :lisp))
1222     ((val :lisp)
1223      (lab :label))
1224     ((unboxed (:s32 #.x8632::imm0))
1225      ;; we use %mm0 for header in subprim
1226      (entry (:label 1))))
1227  (jno lab)
1228  ((:not (:pred = x8632::arg_z
1229                (:apply %hard-regspec-value val)))
1230   (movl (:%l val) (:%l x8632::arg_z)))
1231  (:talign 5)
1232  (call (:@ .SPfix-overflow))
1233  (movl (:$self 0) (:%l x8632::fn))
1234  ((:not (:pred = x8632::arg_z
1235                (:apply %hard-regspec-value val)))
1236   (movl (:%l x8632::arg_z) (:%l val)))
1237  (jmp lab))
1238
1239
1240(define-x8632-vinsn add-constant (((dest :imm))
1241                                  ((dest :imm)
1242                                   (const :s32const)))
1243  ((:and (:pred >= const -128) (:pred <= const 127))
1244   (addl (:$b const) (:%l dest)))
1245  ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1246   (addl (:$l const) (:%l dest))))
1247
1248(define-x8632-vinsn add-constant3 (((dest :imm))
1249                                   ((src :imm)
1250                                    (const :s32const)))
1251  ((:pred = (:apply %hard-regspec-value dest)
1252          (:apply %hard-regspec-value src))
1253   ((:and (:pred >= const -128) (:pred <= const 127))
1254    (addl (:$b const) (:%l dest)))
1255   ((:not (:and (:pred >= const -128) (:pred <= const 127)))
1256    (addl (:$l const) (:%l dest))))
1257  ((:not (:pred = (:apply %hard-regspec-value dest)
1258                (:apply %hard-regspec-value src)))
1259   (leal (:@ const (:%l src)) (:%l dest))))
1260
1261(define-x8632-vinsn fixnum-add2  (((dest :imm))
1262                                  ((dest :imm)
1263                                   (other :imm)))
1264  (addl (:%l other) (:%l dest)))
1265
1266(define-x8632-vinsn fixnum-sub2  (((dest :imm))
1267                                  ((x :imm)
1268                                   (y :imm))
1269                                  ((temp :imm)))
1270  (movl (:%l x) (:%l temp))
1271  (subl (:%l y) (:%l temp))
1272  (movl (:%l temp) (:%l dest)))
1273
1274(define-x8632-vinsn fixnum-add3 (((dest :imm))
1275                                 ((x :imm)
1276                                  (y :imm)))
1277 
1278  ((:pred =
1279          (:apply %hard-regspec-value x)
1280          (:apply %hard-regspec-value dest))
1281   (addl (:%l y) (:%l dest)))
1282  ((:not (:pred =
1283                (:apply %hard-regspec-value x)
1284                (:apply %hard-regspec-value dest)))
1285   ((:pred =
1286           (:apply %hard-regspec-value y)
1287           (:apply %hard-regspec-value dest))
1288    (addl (:%l x) (:%l dest)))
1289   ((:not (:pred =
1290                 (:apply %hard-regspec-value y)
1291                 (:apply %hard-regspec-value dest)))
1292    (leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1293
1294(define-x8632-vinsn copy-gpr (((dest t))
1295                              ((src t)))
1296  ((:not (:pred =
1297                (:apply %hard-regspec-value dest)
1298                (:apply %hard-regspec-value src)))
1299   (movl (:%l src) (:%l dest))))
1300
1301(define-x8632-vinsn (vpop-register :pop :node :vsp)
1302    (((dest :lisp))
1303     ())
1304  (popl (:%l dest)))
1305
1306(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1307                                                     ())
1308  (rcmpl (:%l x8632::nargs) (:$b (* 1 x8632::node-size)))
1309  (jb :done)
1310  (je :one)
1311  (pushl (:%l x8632::arg_y))
1312  :one
1313  (pushl (:%l x8632::arg_z))
1314  :done)
1315
1316(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1317                                                         ((max :u32const)))
1318  ((:pred >= max 2)
1319   (rcmpl (:%l x8632::nargs) (:$b (* 1 x8632::node-size)))
1320   (jb :done)
1321   (je :one)
1322   (pushl (:%l x8632::arg_y))
1323   :one
1324   (pushl (:%l x8632::arg_z))
1325   :done)
1326  ((:pred = max 1)
1327   (testl (:%l x8632::nargs) (:%l x8632::nargs))
1328   (je :done)
1329   (pushl (:%l x8632::arg_z))
1330   :done))
1331
1332(define-x8632-vinsn (call-label :call) (()
1333                                        ((label :label))
1334                                        ((entry (:label 1))))
1335  (:talign 5)
1336  (call label)
1337  (movl (:$self 0) (:%l x8632::fn)))
1338
1339(define-x8632-vinsn double-float-compare (()
1340                                          ((arg0 :double-float)
1341                                           (arg1 :double-float)))
1342  (comisd (:%xmm arg1) (:%xmm arg0)))
1343
1344(define-x8632-vinsn single-float-compare (()
1345                                          ((arg0 :single-float)
1346                                           (arg1 :single-float)))
1347  (comiss (:%xmm arg1) (:%xmm arg0)))
1348
1349(define-x8632-vinsn double-float+-2 (((result :double-float))
1350                                     ((x :double-float)
1351                                      (y :double-float)))
1352  ((:pred =
1353          (:apply %hard-regspec-value result)
1354          (:apply %hard-regspec-value x))
1355   (addsd (:%xmm y) (:%xmm result)))
1356  ((:and (:not (:pred =
1357                      (:apply %hard-regspec-value result)
1358                      (:apply %hard-regspec-value x)))
1359         (:pred =
1360                (:apply %hard-regspec-value result)
1361                (:apply %hard-regspec-value y)))
1362   (addsd (:%xmm x) (:%xmm result)))
1363  ((:and (:not (:pred =
1364                      (:apply %hard-regspec-value result)
1365                      (:apply %hard-regspec-value x)))
1366         (:not (:pred =
1367                      (:apply %hard-regspec-value result)
1368                      (:apply %hard-regspec-value y))))
1369   (movsd (:%xmm x) (:%xmm result))
1370   (addsd (:%xmm y) (:%xmm result))))
1371
1372;;; Caller guarantees (not (eq y result))
1373(define-x8632-vinsn double-float--2 (((result :double-float))
1374                                     ((x :double-float)
1375                                      (y :double-float)))
1376  ((:not (:pred = (:apply %hard-regspec-value result)
1377                (:apply %hard-regspec-value x)))
1378   (movsd (:%xmm x) (:%xmm result)))
1379  (subsd (:%xmm y) (:%xmm result)))
1380
1381(define-x8632-vinsn double-float*-2 (((result :double-float))
1382                                     ((x :double-float)
1383                                      (y :double-float)))
1384  ((:pred =
1385          (:apply %hard-regspec-value result)
1386          (:apply %hard-regspec-value x))
1387   (mulsd (:%xmm y) (:%xmm result)))
1388  ((:and (:not (:pred =
1389                      (:apply %hard-regspec-value result)
1390                      (:apply %hard-regspec-value x)))
1391         (:pred =
1392                (:apply %hard-regspec-value result)
1393                (:apply %hard-regspec-value y)))
1394   (mulsd (:%xmm x) (:%xmm result)))
1395  ((:and (:not (:pred =
1396                      (:apply %hard-regspec-value result)
1397                      (:apply %hard-regspec-value x)))
1398         (:not (:pred =
1399                      (:apply %hard-regspec-value result)
1400                      (:apply %hard-regspec-value y))))
1401   (movsd (:%xmm x) (:%xmm result))
1402   (mulsd (:%xmm y) (:%xmm result))))
1403
1404;;; Caller guarantees (not (eq y result))
1405(define-x8632-vinsn double-float/-2 (((result :double-float))
1406                                     ((x :double-float)
1407                                      (y :double-float)))
1408  ((:not (:pred = (:apply %hard-regspec-value result)
1409                (:apply %hard-regspec-value x)))
1410   (movsd (:%xmm x) (:%xmm result)))
1411  (divsd (:%xmm y) (:%xmm result)))
1412
1413(define-x8632-vinsn single-float+-2 (((result :single-float))
1414                                     ((x :single-float)
1415                                      (y :single-float)))
1416  ((:pred =
1417          (:apply %hard-regspec-value result)
1418          (:apply %hard-regspec-value x))
1419   (addss (:%xmm y) (:%xmm result)))
1420  ((:and (:not (:pred =
1421                      (:apply %hard-regspec-value result)
1422                      (:apply %hard-regspec-value x)))
1423         (:pred =
1424                (:apply %hard-regspec-value result)
1425                (:apply %hard-regspec-value y)))
1426   (addss (:%xmm x) (:%xmm result)))
1427  ((:and (:not (:pred =
1428                      (:apply %hard-regspec-value result)
1429                      (:apply %hard-regspec-value x)))
1430         (:not (:pred =
1431                      (:apply %hard-regspec-value result)
1432                      (:apply %hard-regspec-value y))))
1433   (movss (:%xmm x) (:%xmm result))
1434   (addss (:%xmm y) (:%xmm result))))
1435
1436;;; Caller guarantees (not (eq y result))
1437(define-x8632-vinsn single-float--2 (((result :single-float))
1438                                     ((x :single-float)
1439                                      (y :single-float)))
1440  ((:not (:pred = (:apply %hard-regspec-value result)
1441                (:apply %hard-regspec-value x)))
1442   (movss (:%xmm x) (:%xmm result)))
1443  (subss (:%xmm y) (:%xmm result)))
1444
1445(define-x8632-vinsn single-float*-2 (((result :single-float))
1446                                     ((x :single-float)
1447                                      (y :single-float)))
1448    ((:pred =
1449          (:apply %hard-regspec-value result)
1450          (:apply %hard-regspec-value x))
1451   (mulss (:%xmm y) (:%xmm result)))
1452  ((:and (:not (:pred =
1453                      (:apply %hard-regspec-value result)
1454                      (:apply %hard-regspec-value x)))
1455         (:pred =
1456                (:apply %hard-regspec-value result)
1457                (:apply %hard-regspec-value y)))
1458   (mulss (:%xmm x) (:%xmm result)))
1459  ((:and (:not (:pred =
1460                      (:apply %hard-regspec-value result)
1461                      (:apply %hard-regspec-value x)))
1462         (:not (:pred =
1463                      (:apply %hard-regspec-value result)
1464                      (:apply %hard-regspec-value y))))
1465   (movss (:%xmm x) (:%xmm result))
1466   (mulss (:%xmm y) (:%xmm result))))
1467
1468;;; Caller guarantees (not (eq y result))
1469(define-x8632-vinsn single-float/-2 (((result :single-float))
1470                                     ((x :single-float)
1471                                      (y :single-float)))
1472  ((:not (:pred = (:apply %hard-regspec-value result)
1473                (:apply %hard-regspec-value x)))
1474   (movss (:%xmm x) (:%xmm result)))
1475  (divss (:%xmm y) (:%xmm result)))
1476
1477(define-x8632-vinsn get-single (((result :single-float))
1478                                ((source :lisp)))
1479  (movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1480
1481(define-x8632-vinsn get-double (((result :double-float))
1482                                ((source :lisp)))
1483  (movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1484
1485;;; Extract a double-float value, typechecking in the process.
1486;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1487;;; instead of replicating it ..
[12256]1488(define-x8632-vinsn get-double? (((target :double-float))
1489                                 ((source :lisp))
1490                                 ((tag :u8)))
1491  :resume
1492  (movl (:%l source) (:%l tag))
1493  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1494   (andl (:$b x8632::tagmask) (:%accl tag))
1495   (cmpl (:$b x8632::tag-misc) (:%accl tag)))
1496  ((:pred > (:apply %hard-regspec-value tag) x8632::eax)
1497   (andl (:$b x8632::tagmask) (:%l tag))
1498   (cmpl (:$b x8632::tag-misc) (:%l tag)))
1499  (jne :have-tag)
1500  (movsbl (:@ x8632::misc-subtag-offset (:%l source)) (:%l tag))
1501  :have-tag
1502  (cmpl (:$b x8632::subtag-double-float) (:%l tag))
1503  (jne :bad)
1504  (movsd (:@  x8632::double-float.value (:%l source)) (:%xmm target))
[10972]1505
[12256]1506  (:anchored-uuo-section :resume)
1507  :bad
1508  (:anchored-uuo (uuo-error-reg-not-tag (:%q source) (:$ub x8632::subtag-double-float))))
[10972]1509
1510(define-x8632-vinsn copy-double-float (((dest :double-float))
1511                                       ((src :double-float)))
1512  (movsd (:%xmm src) (:%xmm dest)))
1513
1514(define-x8632-vinsn copy-single-float (((dest :single-float))
1515                                       ((src :single-float)))
1516  (movss (:%xmm src) (:%xmm dest)))
1517
1518(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1519                                           ((src :single-float)))
1520  (cvtss2sd (:%xmm src) (:%xmm dest)))
1521
1522(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1523                                           ((src :double-float)))
1524  (cvtsd2ss (:%xmm src) (:%xmm dest)))
1525
1526;;; these two clobber unboxed0, unboxed1 in tcr
1527;;; (There's no way to move a value from the x87 stack to an xmm register,
1528;;; so we have to go through memory.)
1529(define-x8632-vinsn fp-stack-to-single (((dest :single-float))
1530                                        ())
1531  (fstps (:@ (:%seg :rcontext) x8632::tcr.unboxed0))
1532  (movss (:@ (:%seg :rcontext) x8632::tcr.unboxed0) (:%xmm dest)))
1533
1534(define-x8632-vinsn fp-stack-to-double (((dest :double-float))
1535                                        ())
1536  (fstpl (:@ (:%seg :rcontext) x8632::tcr.unboxed0))
1537  (movsd (:@ (:%seg :rcontext) x8632::tcr.unboxed0) (:%xmm dest)))
1538
1539(define-x8632-vinsn fitvals (()
1540                             ((n :u16const))
1541                             ((imm :u32)))
1542  ((:pred = n 0)
1543   (xorl (:%l imm) (:%l imm)))
1544  ((:not (:pred = n 0))
1545   (movl (:$l (:apply ash n x8632::fixnumshift)) (:%l imm)))
1546  (subl (:%l x8632::nargs) (:%l imm))
1547  (jae :push-more)
1548  (subl (:%l imm) (:%l x8632::esp))
1549  (jmp :done)
1550  :push-loop
[11089]1551  (pushl (:$l (:apply target-nil-value)))
[10972]1552  (addl (:$b x8632::node-size) (:%l x8632::nargs))
1553  (subl (:$b x8632::node-size) (:%l imm))
1554  :push-more
1555  (jne :push-loop)
1556  :done)
1557
1558(define-x8632-vinsn (nvalret :jumpLR) (()
1559                                       ())
1560  (jmp (:@ .SPnvalret)))
1561
1562(define-x8632-vinsn lisp-word-ref (((dest t))
1563                                   ((base t)
1564                                    (offset t)))
1565  (movl (:@ (:%l base) (:%l offset)) (:%l  dest)))
1566
1567(define-x8632-vinsn lisp-word-ref-c (((dest t))
1568                                     ((base t)
1569                                      (offset :s32const)))
1570  ((:pred = offset 0)
1571   (movl (:@ (:%l base)) (:%l dest)))
1572  ((:not (:pred = offset 0))
1573   (movl (:@ offset (:%l base)) (:%l dest))))
1574
1575;; start-mv-call
1576
1577(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1578                                                    ((label :label))
1579                                                    ((temp :lisp)))
1580  (leal (:@ (:^ label) (:%l x8632::fn)) (:%l temp))
1581  (pushl (:%l temp)))
1582
1583(define-x8632-vinsn emit-aligned-label (()
1584                                        ((label :label)))
1585  ;; We don't care about label.
1586  ;; We just want the label following this stuff to be tra-tagged.
1587  (:align 3)
1588  (nop) (nop) (nop) (nop) (nop))
1589
1590;; pass-multiple-values-symbol
1591;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1592(define-x8632-vinsn pass-multiple-values-symbol (()
1593                                                 ())
[11089]1594  (pushl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::ret1valaddr)))) 
[10972]1595  (jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1596
1597
1598;;; It'd be good to have a variant that deals with a known function
1599;;; as well as this.
1600(define-x8632-vinsn pass-multiple-values (()
1601                                          ()
1602                                          ((tag :u8)))
1603  :resume
[11089]1604  (movl (:%l x8632::temp0) (:%l tag))
1605  (andl (:$b x8632::tagmask) (:%l tag))
1606  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]1607  (jne :bad)
[11089]1608  (movsbl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
1609  (cmpl (:$b x8632::subtag-function) (:%l tag))
[10972]1610  (cmovel (:%l x8632::temp0) (:%l x8632::fn))
1611  (je :go)
[11089]1612  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
[10972]1613  (cmovel (:@ x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::fn))
1614  (jne :bad)
1615  :go
[11089]1616  (pushl (:@ (:apply + (:apply target-nil-value) (x8632::%kernel-global 'x86::ret1valaddr))))
[10972]1617  (jmp (:%l x8632::fn))
1618  (:anchored-uuo-section :resume)
1619  :bad
1620  (:anchored-uuo (uuo-error-not-callable))
1621)
1622
1623
1624(define-x8632-vinsn reserve-outgoing-frame (()
1625                                            ())
1626  (pushl (:$b x8632::reserved-frame-marker))
1627  (pushl (:$b x8632::reserved-frame-marker)))
1628
1629;; implicit temp0 arg
1630(define-x8632-vinsn (call-known-function :call) (()
1631                                                 ()
1632                                                 ((entry (:label 1))))
1633  (:talign 5)
1634  (call (:%l x8632::temp0))
1635  (movl (:$self 0) (:%l x8632::fn)))
1636
1637(define-x8632-vinsn (jump-known-function :jumplr) (()
1638                                                   ())
1639  (jmp (:%l x8632::temp0)))
1640
1641(define-x8632-vinsn (list :call) (()
1642                                  ()
1643                                  ((entry (:label 1))
1644                                   (temp (:lisp #.x8632::temp0))))
1645  (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::temp0))
1646  (:talign 5)
1647  (jmp (:@ .SPconslist))
1648  :back
1649  (movl (:$self 0) (:%l x8632::fn)))
1650
1651(define-x8632-vinsn make-fixed-stack-gvector (((dest :lisp))
1652                                              ((aligned-size :u32const)
1653                                               (header :s32const))
1654                                              ((tempa :imm)
1655                                               (tempb :imm)))
1656  ((:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1657         (:pred <= (:apply + aligned-size x8632::dnode-size) 127))
1658   (subl (:$b (:apply + aligned-size x8632::dnode-size))
1659         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1660  ((:not (:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1661               (:pred <= (:apply + aligned-size x8632::dnode-size) 127)))
1662   (subl (:$l (:apply + aligned-size x8632::dnode-size))
1663         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1664  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l tempb))
1665  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l tempa))
1666  (movd (:%l tempb) (:%mmx x8632::stack-temp))
1667  :loop
1668  (movsd (:%xmm x8632::fpzero) (:@ -8 (:%l tempb)))
1669  (subl (:$b x8632::dnode-size) (:%l tempb))
1670  (cmpl (:%l tempa) (:%l tempb))
1671  (jnz :loop)
1672  (movd (:%mmx x8632::stack-temp) (:@ (:%l tempa)))
1673  (movl (:%l tempa) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1674  (movl (:$l header) (:@ x8632::dnode-size (:%l tempa)))
1675  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l tempa)) (:%l dest)))
1676
1677
1678
1679
1680(define-x8632-vinsn make-tsp-vcell (((dest :lisp))
1681                                    ((closed :lisp))
1682                                    ((temp :imm)))
1683  (subl (:$b (+ x8632::value-cell.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1684  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1685  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1686  (movsd (:%xmm x8632::fpzero) (:@ (:%l temp)))
1687  (movsd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
1688  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp))) 
1689  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
1690  (movl (:$l x8632::value-cell-header) (:@ x8632::dnode-size (:%l temp)))
1691  (movl (:%l closed) (:@ (+ x8632::dnode-size x8632::node-size) (:%l temp)))
1692  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l temp)) (:%l dest)))
1693
1694(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1695                                   ((car :lisp) (cdr :lisp))
1696                                   ((temp :imm)))
1697  (subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1698  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1699  (movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1700  (movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1701  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1702  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1703  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1704  (leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1705  (movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1706  (movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1707  (movl (:%l temp) (:%l dest)))
1708
1709
1710;; make-fixed-stack-gvector
1711
[11412]1712(define-x8632-vinsn (discard-temp-frame :tsp :pop :discard) (()
1713                                                             ()
1714                                                             ((temp :imm)))
[10972]1715  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1716  (movl (:@ (:%l temp)) (:%l temp))
1717  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1718  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1719  )
1720
[11412]1721(define-x8632-vinsn (discard-c-frame :csp :pop :discard) (()
1722                                                          ()
1723                                                          ((temp :imm)))
[10972]1724  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1725  (movl (:@ (:%l temp)) (:%l temp))
1726  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1727
1728 
[11412]1729(define-x8632-vinsn (vstack-discard :vsp :pop :discard) (()
[10972]1730                                    ((nwords :u32const)))
1731  ((:not (:pred = nwords 0))
1732   ((:pred < nwords 16)
1733    (addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1734   ((:not (:pred < nwords 16))
1735    (addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1736
1737(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1738  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (()
1739                                                                  ()
1740                                                                  ((entry (:label 1))
1741                                                                   (ra (:lisp #.x8632::ra0))))
1742    (leal (:@ (:^ :back) (:%l x8632::fn)) (:%l ra))
1743    (:talign 5)
1744    (jmp (:@ ,spno))
1745    :back
1746    (movl (:$self 0) (:%l x8632::fn))))
1747
1748(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1749  `(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1750    (:talign 5)
1751    (call (:@ ,spno))
1752    :back
1753    (movl (:$self 0) (:%l x8632::fn))))
1754
1755(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1756  `(define-x8632-vinsn (,name :jumpLR ,@other-attrs) (() ())
1757    (jmp (:@ ,spno))))
1758
1759(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1760                                                        ((lab :label))
1761                                                        ((ra (:lisp #.x8632::ra0))))
1762  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l ra))
1763  (jmp (:@ .SPnthrowvalues)))
1764
1765(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1766                                                        ((lab :label))
1767                                                        ((ra (:lisp #.x8632::ra0))))
1768  (leal (:@ (:^ lab) (:%l x8632::fn)) (:%l ra))
1769  (jmp (:@ .SPnthrow1value)))
1770
1771(define-x8632-vinsn set-single-c-arg (()
1772                                      ((arg :single-float)
1773                                       (offset :u32const))
1774                                      ((temp :imm)))
1775  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1776  (movss (:%xmm arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp))))
1777
1778(define-x8632-vinsn reload-single-c-arg (((arg :single-float))
1779                                         ((offset :u32const))
1780                                         ((temp :imm)))
1781  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1782  (movss (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp)) (:%xmm arg)))
1783
1784(define-x8632-vinsn set-double-c-arg (()
1785                                      ((arg :double-float)
1786                                       (offset :u32const))
1787                                      ((temp :imm)))
1788  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1789  (movsd (:%xmm arg) (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp))))
1790
1791(define-x8632-vinsn reload-double-c-arg (((arg :double-float))
1792                                         ((offset :u32const))
1793                                         ((temp :imm)))
1794  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1795  (movsd (:@ (:apply + 8 (:apply ash offset 2)) (:%l temp)) (:%xmm arg)))
1796
1797;;; .SPffcall has stored %edx in tcr.unboxed1.  Load %mm0 with a
1798;;; 64-bit value composed from %edx:%eax.
1799(define-x8632-vinsn get-64-bit-ffcall-result (()
1800                                              ())
1801  (movl (:%l x8632::eax) (:@ (:%seg :rcontext) x8632::tcr.unboxed0))
[11089]1802  (movq (:@ (:%seg :rcontext) x8632::tcr.unboxed0) (:%mmx x8632::mm0)))
[10972]1803
1804(define-x8632-subprim-call-vinsn (ff-call)  .SPffcall)
1805
1806(define-x8632-subprim-call-vinsn (syscall)  .SPsyscall)
1807
1808(define-x8632-subprim-call-vinsn (syscall2)  .SPsyscall2)
1809
1810(define-x8632-subprim-call-vinsn (setqsym) .SPsetqsym)
1811
1812(define-x8632-subprim-call-vinsn (gets32) .SPgets32)
1813
1814(define-x8632-subprim-call-vinsn (getu32) .SPgetu32)
1815
1816(define-x8632-subprim-call-vinsn (gets64) .SPgets64)
1817
1818(define-x8632-subprim-call-vinsn (getu64) .SPgetu64)
1819
1820(define-x8632-subprim-call-vinsn (makes64) .SPmakes64)
1821
1822(define-x8632-subprim-call-vinsn (makeu64) .SPmakeu64)
1823
1824(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list*)  .SPstkconslist-star)
1825
1826(define-x8632-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
1827
1828(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1829
1830(define-x8632-vinsn bind-interrupt-level-0-inline (()
1831                                                   ()
1832                                                   ((temp :imm)))
1833  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1834  (cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1835  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1836  (pushl (:$b x8632::interrupt-level-binding-index))
1837  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1838  (movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1839  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1840  (jns :done)
1841  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1842  (jae :done)
1843  (ud2a)
1844  (:byte 2)
1845  :done)
1846
1847(define-x8632-vinsn bind-interrupt-level-m1-inline (()
1848                                                    ()
1849                                                    ((temp :imm)))
1850  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1851  (pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1852  (pushl (:$b x8632::interrupt-level-binding-index))
1853  (pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1854  (movl (:$l (ash -1 x8632::fixnumshift)) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1855  (movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link)))
1856
1857(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1858
1859(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1860
1861(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1862
1863#||
1864(define-x8632-vinsn unbind-interrupt-level-inline (()
1865                                                   ()
1866                                                   ((link :imm)
1867                                                    (curval :imm)
1868                                                    (oldval :imm)
1869                                                    (tlb :imm)))
1870  (movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l tlb))
1871  (movl (:@ (:%seg :rcontext) x8632::tcr.db-link) (:%l link))
1872  (movl (:@ x8632::interrupt-level-binding-index (:%l tlb)) (:%l curval))
1873  (testl (:%l curval) (:%l curval))
1874  (movl (:@ 8 #|binding.val|# (:%l link)) (:%l oldval))
1875  (movl (:@ #|binding.link|# (:%l link)) (:%l link))
1876  (movl (:%l oldval) (:@ x8632::interrupt-level-binding-index (:%l tlb)))
1877  (movl (:%l link) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1878  (jns :done)
1879  (testl (:%l oldval) (:%l oldval))
1880  (js :done)
1881  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1882  (jae :done)
1883  (ud2a)
1884  (:byte 2)
1885  :done)
1886||#
1887
1888(define-x8632-vinsn (jump-return-pc :jumpLR) (()
1889                                              ())
1890  (ret))
1891
1892;;; xxx
1893(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
1894                                                      ((lab :label))
1895                                                      ((entry (:label 1))
1896                                                       (xfn (:lisp #.x8632::xfn))))
1897  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l xfn))
1898  (:talign 5)
1899  (call (:@ .SPmkcatchmv))
1900  :back
1901  (movl (:$self 0) (:%l x8632::fn)))
1902
1903(define-x8632-vinsn (nmkcatch1v :call :subprim-call) (()
1904                                                     ((lab :label))
1905                                                     ((entry (:label 1))
1906                                                      (xfn (:lisp #.x8632::xfn))))
1907  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1908  (:talign 5)
1909  (call (:@ .SPmkcatch1v))
1910  :back
1911  (movl (:$self 0) (:%l x8632::fn)))
1912
1913
1914(define-x8632-vinsn (make-simple-unwind :call :subprim-call) (()
1915                                                     ((protform-lab :label)
1916                                                      (cleanup-lab :label)))
1917  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1918  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1919  (jmp (:@ .SPmkunwind)))
1920
1921(define-x8632-vinsn (nmkunwind :call :subprim-call) (()
1922                                                     ((protform-lab :label)
1923                                                      (cleanup-lab :label)))
1924  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1925  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
1926  (jmp (:@ .SPnmkunwind)))
1927
[12256]1928(define-x8632-vinsn u16->u32 (((dest :u32))
1929                              ((src :u16)))
1930  (movzwl (:%w src) (:%l dest)))
[10972]1931
[12256]1932(define-x8632-vinsn u8->u32 (((dest :u32))
1933                             ((src :u8)))
1934  (movzbl (:%b src) (:%l dest)))
1935
1936(define-x8632-vinsn s16->s32 (((dest :s32))
1937                              ((src :s16)))
1938  (movswl (:%w src) (:%l dest)))
1939
1940(define-x8632-vinsn s8->s32 (((dest :s32))
1941                             ((src :s8)))
1942  (movsbl (:%b src) (:%l dest)))
1943
[10972]1944(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1945
1946(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1947
1948(define-x8632-vinsn set-eq-bit (()
1949                                ())
1950  (testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1951
1952;;; %schar8
1953;;; %schar32
1954;;; %set-schar8
1955;;; %set-schar32
1956
1957(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1958                                             ((v :lisp)
1959                                              (idx :u32const)))
1960  (movss (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1961
1962(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1963                                           ((header :lisp)))
1964  (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1965
1966(define-x8632-vinsn set-z-flag-if-istruct-typep (()
1967                                                 ((val :lisp)
1968                                                  (type :lisp))
1969                                                 ((tag :u8)
1970                                                  (valtype :lisp)))
1971  (xorl (:%l valtype) (:%l valtype))
1972  (movl (:%l val) (:%l tag))
[11089]1973  (andl (:$b x8632::tagmask) (:%l tag))
1974  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]1975  (jne :have-tag)
[11089]1976  (movsbl (:@ x8632::misc-subtag-offset (:%l val)) (:%l tag))
[10972]1977  :have-tag
[11089]1978  (cmpl (:$b x8632::subtag-istruct) (:%l tag))
[10972]1979  (jne :do-compare)
1980  (movl (:@ x8632::misc-data-offset (:%l val)) (:%l valtype))
1981  :do-compare
1982  (cmpl (:%l valtype) (:%l type)))
1983
1984(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1985
1986(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1987
1988(define-x8632-vinsn mem-set-c-constant-fullword (()
1989                                                 ((val :s32const)
1990                                                  (dest :address)
1991                                                  (offset :s32const)))
1992  ((:pred = offset 0)
1993   (movl (:$l val) (:@ (:%l dest))))
1994  ((:not (:pred = offset 0))
1995   (movl (:$l val) (:@ offset (:%l dest)))))
1996
1997(define-x8632-vinsn mem-set-c-halfword (()
1998                                        ((val :u16)
1999                                         (dest :address)
2000                                         (offset :s32const)))
2001  ((:pred = offset 0)
2002   (movw (:%w val) (:@ (:%l dest))))
2003  ((:not (:pred = offset 0))
2004   (movw (:%w val) (:@ offset (:%l dest)))))
2005
2006(define-x8632-vinsn mem-set-c-constant-halfword (()
2007                                                 ((val :s16const)
2008                                                  (dest :address)
2009                                                  (offset :s32const)))
2010  ((:pred = offset 0)
2011   (movw (:$w val) (:@ (:%l dest))))
2012  ((:not (:pred = offset 0))
2013   (movw (:$w val) (:@ offset (:%l dest)))))
2014
2015(define-x8632-vinsn mem-set-c-constant-byte (()
2016                                                 ((val :s8const)
2017                                                  (dest :address)
2018                                                  (offset :s32const)))
2019  ((:pred = offset 0)
2020   (movb (:$b val) (:@ (:%l dest))))
2021  ((:not (:pred = offset 0))
2022   (movb (:$b val) (:@ offset (:%l dest)))))
2023
2024(define-x8632-vinsn mem-set-c-byte (()
2025                                    ((val :u8)
2026                                     (dest :address)
2027                                     (offset :s32const)))
2028  ((:pred = offset 0)
2029   (movb (:%b val) (:@ (:%l dest))))
2030  ((:not (:pred = offset 0))
2031   (movb (:%b val) (:@ offset (:%l dest)))))
2032
2033(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
2034                                           ((addr :s32const)))
2035  (movzbl (:@ addr) (:%l dest)))
2036
2037(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
2038                                           ((addr :s32const)))
2039  (movsbl (:@ addr) (:%l dest)))
2040
2041(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
2042                                           ((addr :s32const)))
2043  (movzwl (:@ addr) (:%l dest)))
2044
2045(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
2046                                           ((addr :s32const)))
2047  (movswl (:@ addr) (:%l dest)))
2048
2049(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
2050                                                 ((addr :s32const)))
2051  (movl (:@ addr) (:%l dest)))
2052
2053(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
2054                                                        ((addr :s32const)))
2055  (movl (:@ addr) (:%l dest)))
2056
2057(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
2058                                                   ((addr :s32const)))
2059  (movl (:@ addr) (:%l dest)))
2060
2061(define-x8632-vinsn mem-ref-u8 (((dest :u8))
2062                                ((src :address)
2063                                 (index :s32)))
2064  (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
2065
2066(define-x8632-vinsn mem-ref-c-u16 (((dest :u16))
2067                                   ((src :address)
2068                                    (index :s32const)))
2069  ((:pred = index 0) 
2070   (movzwl (:@ (:%l src)) (:%l dest)))
2071  ((:not (:pred = index 0))
2072   (movzwl (:@ index (:%l src)) (:%l dest))))
2073
2074(define-x8632-vinsn mem-ref-u16 (((dest :u16))
2075                                 ((src :address)
2076                                  (index :s32)))
2077  (movzwl (:@ (:%l src) (:%l index)) (:%l dest)))
2078
2079(define-x8632-vinsn mem-ref-c-s16 (((dest :s16))
2080                                   ((src :address)
2081                                    (index :s32const)))
2082  ((:pred = index 0)
2083   (movswl (:@ (:%l src)) (:%l dest)))
2084  ((:not (:pred = index 0))
2085   (movswl (:@ index (:%l src)) (:%l dest))))
2086
2087(define-x8632-vinsn mem-ref-s16 (((dest :s16))
2088                                 ((src :address)
2089                                  (index :s32)))
2090  (movswl (:@ (:%l src) (:%l index)) (:%l dest)))
2091
2092(define-x8632-vinsn mem-ref-c-u8 (((dest :u8))
2093                                  ((src :address)
2094                                   (index :s16const)))
2095  ((:pred = index 0)
2096   (movzbl (:@  (:%l src)) (:%l dest)))
2097  ((:not (:pred = index 0))
2098   (movzbl (:@ index (:%l src)) (:%l dest))))
2099
2100(define-x8632-vinsn mem-ref-u8 (((dest :u8))
2101                                ((src :address)
2102                                 (index :s32)))
2103  (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
2104
2105(define-x8632-vinsn mem-ref-c-s8 (((dest :s8))
2106                                  ((src :address)
2107                                   (index :s16const)))
2108  ((:pred = index 0)
2109   (movsbl (:@ (:%l src)) (:%l dest)))
2110  ((:not (:pred = index 0))
2111   (movsbl (:@ index (:%l src)) (:%l dest))))
2112
2113(define-x8632-vinsn misc-set-c-s8  (((val :s8))
2114                                    ((v :lisp)
2115                                     (idx :u32const))
2116                                    ())
2117  (movb (:%b val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
2118
2119(define-x8632-vinsn misc-set-s8  (((val :s8))
2120                                  ((v :lisp)
2121                                   (scaled-idx :s32))
2122                                  ())
2123  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2124
2125(define-x8632-vinsn mem-ref-s8 (((dest :s8))
2126                                ((src :address)
2127                                 (index :s32)))
2128  (movsbl (:@ (:%l src) (:%l index)) (:%l dest)))
2129
2130(define-x8632-vinsn mem-set-constant-fullword (()
2131                                               ((val :s32const)
2132                                                (ptr :address)
2133                                                (offset :s32)))
2134  (movl (:$l val) (:@ (:%l ptr) (:%l offset))))
2135
2136
2137(define-x8632-vinsn mem-set-constant-halfword (()
2138                                               ((val :s16const)
2139                                                (ptr :address)
2140                                                (offset :s32)))
2141  (movw (:$w val) (:@ (:%l ptr) (:%l offset))))
2142
2143(define-x8632-vinsn mem-set-constant-byte (()
2144                                           ((val :s8const)
2145                                            (ptr :address)
2146                                            (offset :s32)))
2147  (movb (:$b val) (:@ (:%l ptr) (:%l offset))))
2148
2149(define-x8632-vinsn misc-set-c-u8  (((val :u8))
2150                                    ((v :lisp)
2151                                     (idx :u32const))
2152                                    ())
2153  (movb (:%b val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
2154
2155(define-x8632-vinsn misc-set-u8  (((val :u8))
2156                                  ((v :lisp)
2157                                   (scaled-idx :s32))
2158                                  ())
2159  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2160
2161(define-x8632-vinsn misc-set-c-u16  (()
2162                                    ((val :u16)
2163                                     (v :lisp)
2164                                     (idx :s32const))
2165                                    ())
2166  (movw (:%w val) (:@ (:apply + x8632::misc-data-offset (:apply * 2 idx)) (:%l v))))
2167
2168(define-x8632-vinsn misc-set-u16  (()
2169                                   ((val :u16)
2170                                    (v :lisp)
2171                                    (scaled-idx :s32))
2172                                   ())
2173  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2174
2175(define-x8632-vinsn misc-set-c-s16  (()
2176                                    ((val :s16)
2177                                     (v :lisp)
2178                                     (idx :s32const))
2179                                    ())
2180  (movw (:%w val) (:@ (:apply + x8632::misc-data-offset (:apply * 2 idx)) (:%l v))))
2181
2182(define-x8632-vinsn misc-set-s16  (()
2183                                   ((val :s16)
2184                                    (v :lisp)
2185                                    (scaled-idx :s32))
2186                                   ())
2187  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2188
2189(define-x8632-vinsn misc-set-c-u32  (()
2190                                     ((val :u32)
2191                                      (v :lisp)
2192                                      (idx :u32const)) ; sic
2193                                     ())
2194  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
2195
2196(define-x8632-vinsn misc-set-u32  (()
2197                                   ((val :u32)
2198                                    (v :lisp)
2199                                    (scaled-idx :s32))
2200                                   ())
2201  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2202
2203(define-x8632-vinsn misc-set-c-s32  (()
2204                                     ((val :s32)
2205                                      (v :lisp)
2206                                      (idx :u32const)) ; sic
2207                                     ())
2208  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
2209
2210(define-x8632-vinsn misc-set-s32  (()
2211                                   ((val :s32)
2212                                    (v :lisp)
2213                                    (scaled-idx :s32))
2214                                   ())
2215  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
2216
2217(define-x8632-vinsn %iasr (((dest :imm))
2218                           ((count :imm)
2219                            (src :imm))
2220                           ((temp :s32)
2221                            (shiftcount (:s32 #.x8632::ecx))))
2222  (movl (:%l count) (:%l temp))
2223  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2224  (rcmpl (:%l temp) (:$l 31))
2225  (cmovbw (:%w temp) (:%w shiftcount))
2226  (movl (:%l src) (:%l temp))
2227  (jae :shift-max)
2228  (sarl (:%shift x8632::cl) (:%l temp))
2229  (jmp :done)
2230  :shift-max
2231  (sarl (:$ub 31) (:%l temp))
2232  :done
2233  (andl (:$l (lognot x8632::fixnummask)) (:%l temp))
2234  (movl (:%l temp) (:%l dest)))
2235
2236(define-x8632-vinsn %ilsr (((dest :imm))
2237                           ((count :imm)
2238                            (src :imm))
2239                           ((temp :s32)
2240                            (shiftcount (:s32 #.x8632::ecx))))
2241  (movl (:%l count) (:%l temp))
2242  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2243  (rcmpl (:%l temp) (:$l 31))
2244  (cmovbw (:%w temp) (:%w shiftcount))
2245  (movl (:%l src) (:%l temp))
2246  (jae :shift-max)
2247  (shrl (:%shift x8632::cl) (:%l temp))
2248  (jmp :done)
2249  :shift-max
2250  (shrl (:$ub 31) (:%l temp))
2251  :done
2252  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2253  (movl (:%l temp) (:%l dest)))
2254
2255(define-x8632-vinsn %iasr-c (((dest :imm))
2256                             ((count :u8const)
2257                              (src :imm))
2258                             ((temp :s32)))
2259  (movl (:%l src) (:%l temp))
2260  (sarl (:$ub count) (:%l temp))
2261  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2262  (movl (:%l temp) (:%l dest)))
2263
2264(define-x8632-vinsn %ilsr-c (((dest :imm))
2265                             ((count :u8const)
2266                              (src :imm))
2267                             ((temp :s32)))
2268  (movl (:%l src) (:%l temp))
2269  (shrl (:$ub count) (:%l temp))
2270  ;; xxx --- use :%acc
2271  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
2272  (movl (:%l temp) (:%l dest)))
2273
2274(define-x8632-vinsn %ilsl (((dest :imm))
2275                           ((count :imm)
2276                            (src :imm))
2277                           ((temp (:s32 #.x8632::eax))
2278                            (shiftcount (:s32 #.x8632::ecx))))
2279  (movl (:%l count) (:%l temp))
2280  (sarl (:$ub x8632::fixnumshift) (:%l temp))
2281  (rcmpl (:%l temp) (:$l 31))
2282  (cmovbw (:%w temp) (:%w shiftcount))
2283  (movl (:%l src) (:%l temp))
2284  (jae :shift-max)
2285  (shll (:%shift x8632::cl) (:%l temp))
2286  (jmp :done)
2287  :shift-max
2288  (xorl (:%l temp) (:%l temp))
2289  :done
2290  (movl (:%l temp) (:%l dest)))
2291
2292(define-x8632-vinsn %ilsl-c (((dest :imm))
2293                             ((count :u8const)
2294                              (src :imm)))
2295  ((:not (:pred =
2296                (:apply %hard-regspec-value src)
2297                (:apply %hard-regspec-value dest)))
2298   (movl (:%l src) (:%l dest)))
2299  (shll (:$ub count) (:%l dest)))
2300
2301;;; In safe code, something else has ensured that the value is of type
2302;;; BIT.
2303(define-x8632-vinsn set-variable-bit-to-variable-value (()
2304                                                        ((vec :lisp)
2305                                                         (word-index :s32)
2306                                                         (bitnum :u8)
2307                                                         (value :lisp)))
2308  (testl (:%l value) (:%l value))
2309  (je :clr)
2310  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
2311  (jmp :done)
2312  :clr
2313  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
2314  :done)
2315
2316;;; In safe code, something else has ensured that the value is of type
2317;;; BIT.
2318(define-x8632-vinsn nset-variable-bit-to-variable-value (()
2319                                                         ((vec :lisp)
2320                                                          (index :s32)
2321                                                          (value :lisp)))
2322  (testl (:%l value) (:%l value))
2323  (je :clr)
2324  (btsl (:%l index) (:@ x8632::misc-data-offset (:%l vec)))
2325  (jmp :done)
2326  :clr
2327  (btrl (:%l index) (:@ x8632::misc-data-offset (:%l vec)))
2328  :done)
2329
2330(define-x8632-vinsn nset-variable-bit-to-zero (()
2331                                              ((vec :lisp)
2332                                               (index :s32)))
2333  (btrl (:%l index) (:@ x8632::misc-data-offset (:%l vec))))
2334
2335(define-x8632-vinsn nset-variable-bit-to-one (()
2336                                             ((vec :lisp)
2337                                              (index :s32)))
2338  (btsl (:%l index) (:@ x8632::misc-data-offset (:%l vec))))
2339
2340(define-x8632-vinsn set-variable-bit-to-zero (()
2341                                              ((vec :lisp)
2342                                               (word-index :s32)
2343                                               (bitnum :u8)))
2344  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
2345
2346(define-x8632-vinsn set-variable-bit-to-one (()
2347                                             ((vec :lisp)
2348                                              (word-index :s32)
2349                                              (bitnum :u8)))
2350  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
2351
2352(define-x8632-vinsn set-constant-bit-to-zero (()
2353                                              ((src :lisp)
2354                                               (idx :u32const)))
2355  (btrl (:$ub (:apply logand 31 idx))
2356        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2357
2358(define-x8632-vinsn set-constant-bit-to-one (()
2359                                             ((src :lisp)
2360                                              (idx :u32const)))
2361  (btsl (:$ub (:apply logand 31 idx))
2362        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
2363
2364(define-x8632-vinsn set-constant-bit-to-variable-value (()
2365                                                        ((src :lisp)
2366                                                         (idx :u32const)
2367                                                         (value :lisp)))
2368  (testl (:%l value) (:%l value))
2369  (je :clr)
2370  (btsl (:$ub (:apply logand 31 idx))
2371        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2372  (jmp :done)
2373  :clr
2374  (btrl (:$ub (:apply logand 31 idx))
2375        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
2376  :done)
2377
2378(define-x8632-vinsn require-fixnum (()
2379                                    ((object :lisp)))
2380  :again
2381  ((:and (:pred > (:apply %hard-regspec-value object) x8632::eax)
2382         (:pred <= (:apply %hard-regspec-value object) x8632::ebx))
2383   (testb (:$b x8632::fixnummask) (:%b object)))
2384  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2385   (testl (:$l x8632::fixnummask) (:%l object)))
2386  (jne :bad)
2387
2388  (:anchored-uuo-section :again)
2389  :bad
2390  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-fixnum))))
2391
2392(define-x8632-vinsn require-integer (()
2393                                     ((object :lisp))
2394                                     ((tag :u8)))
2395  :again
2396  (movl (:%l object) (:%l tag))
2397  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2398   (andb (:$b x8632::fixnummask) (:%accb tag)))
2399  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2400         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2401   (andb (:$b x8632::fixnummask) (:%b tag)))
2402  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2403   (andl (:$l x8632::fixnummask) (:%l tag)))
2404  (je :got-it)
2405  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2406   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
2407  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2408         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2409   (cmpb (:$b x8632::tag-misc) (:%b tag)))
2410  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
2411   (cmpl (:$l x8632::tag-misc) (:%l tag)))
2412  (jne :bad)
2413  (cmpb (:$b x8632::subtag-bignum) (:@ x8632::misc-subtag-offset (:%l object)))
2414  (jne :bad)
2415  :got-it
2416
2417  (:anchored-uuo-section :again)
2418  :bad
2419  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-integer))))
2420
2421(define-x8632-vinsn require-simple-vector (()
2422                                           ((object :lisp))
2423                                           ((tag :u8)))
2424  :again
[11089]2425  (movl (:%l object) (:%l tag))
2426  (andl (:$b x8632::fixnummask) (:%l tag))
2427  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]2428  (jne :bad)
2429  (cmpb (:$b x8632::subtag-simple-vector) (:@ x8632::misc-subtag-offset (:%l object)))
2430  (jne :bad)
2431
2432  (:anchored-uuo-section :again)
2433  :bad
2434  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-simple-vector))))
2435
2436(define-x8632-vinsn require-simple-string (()
2437                                           ((object :lisp))
2438                                           ((tag :u8)))
2439  :again
[11089]2440  (movl (:%l object) (:%l tag))
2441  (andl (:$b x8632::fixnummask) (:%l tag))
2442  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]2443  (jne :bad)
2444  (cmpb (:$b x8632::subtag-simple-base-string) (:@ x8632::misc-subtag-offset (:%l object)))
2445  (jne :bad)
2446
2447  (:anchored-uuo-section :again)
2448  :bad
2449  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-simple-string))))
2450
2451
2452;;; naive
2453(define-x8632-vinsn require-real (()
2454                                    ((object :lisp))
2455                                    ((tag :u8)
2456                                     (mask :lisp)))
2457  :again
2458  (movl (:%l object) (:%l tag))
2459  (andl (:$b x8632::tagmask) (:%l tag))
[11089]2460  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]2461  (jne :have-tag)
[11089]2462  (movzbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
[10972]2463  :have-tag
[11089]2464  (cmpl (:$b (1- (- x8632::nbits-in-word x8632::fixnumshift))) (:%l tag))
[10972]2465  (movl (:$l (ash (logior (ash 1 x8632::tag-fixnum)
2466                          (ash 1 x8632::subtag-single-float)
2467                          (ash 1 x8632::subtag-double-float)
2468                          (ash 1 x8632::subtag-bignum)
2469                          (ash 1 x8632::subtag-ratio))
2470                  x8632::fixnumshift)) (:%l mask))
2471  (ja :bad)
2472  (addl (:$b x8632::fixnumshift) (:%l tag))
2473  (btl (:%l tag) (:%l mask))
2474  (jnc :bad)
2475
2476  (:anchored-uuo-section :again)
2477  :bad
2478  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-real))))
2479
2480;;; naive
2481(define-x8632-vinsn require-number (()
2482                                    ((object :lisp))
2483                                    ((tag :u8)
2484                                     (mask :lisp)))
2485  :again
2486  (movl (:%l object) (:%l tag))
2487  (andl (:$b x8632::tagmask) (:%l tag))
[11089]2488  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]2489  (jne :have-tag)
[11089]2490  (movzbl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
[10972]2491  :have-tag
[11089]2492  (cmpl (:$b (1- (- x8632::nbits-in-word x8632::fixnumshift))) (:%l tag))
[10972]2493  (movl (:$l (ash (logior (ash 1 x8632::tag-fixnum)
2494                          (ash 1 x8632::subtag-single-float)
2495                          (ash 1 x8632::subtag-double-float)
2496                          (ash 1 x8632::subtag-bignum)
2497                          (ash 1 x8632::subtag-ratio)
2498                          (ash 1 x8632::subtag-complex))
2499                  x8632::fixnumshift)) (:%l mask))
2500  (ja :bad)
2501  (addl (:$b x8632::fixnumshift) (:%l tag))
2502  (btl (:%l tag) (:%l mask))
2503  (jnc :bad)
2504
2505  (:anchored-uuo-section :again)
2506  :bad
2507  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-number))))
2508
2509(define-x8632-vinsn require-list (()
2510                                  ((object :lisp))
2511                                  ((tag :u8)))
2512  :again
2513  (movl (:%l object) (:%l tag))
[11089]2514  (andl (:$b x8632::fulltagmask) (:%l tag))
2515  (cmpl (:$b x8632::fulltag-cons) (:%l tag))
[10972]2516  (jne :bad)
2517
2518  (:anchored-uuo-section :again)
2519  :bad
2520  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-list))))
2521
2522(define-x8632-vinsn require-symbol (()
2523                                    ((object :lisp))
2524                                    ((tag :u8)))
2525  :again
[11089]2526  (cmpl (:$l (:apply target-nil-value)) (:%l object))
[10972]2527  (je :got-it)
2528  (movl (:%l object) (:%l tag))
[11089]2529  (andl (:$b x8632::tagmask) (:%l tag))
2530  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]2531  (jne :bad)
2532  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l object)))
2533  (jne :bad)
2534  :got-it
2535 
2536  (:anchored-uuo-section :again)
2537  :bad
2538  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-symbol)))
2539)
2540
2541(define-x8632-vinsn require-character (()
2542                                       ((object :lisp)))
2543  :again
2544  (cmpb (:$b x8632::subtag-character) (:%b object))
2545  (jne :bad)
2546
2547  (:anchored-uuo-section :again)
2548  :bad
2549  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-character))))
2550
2551(define-x8632-vinsn require-s8 (()
2552                                ((object :lisp))
2553                                ((tag :u32)))
2554  :again
2555  (movl (:%l object) (:%l tag))
2556  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l tag))
2557  (sarl (:$ub (- x8632::nbits-in-word 8)) (:%l tag))
2558  (shll (:$ub x8632::fixnumshift) (:%l tag))
2559  (cmpl (:%l object) (:%l tag))
2560  (jne :bad)
2561
2562  (:anchored-uuo-section :again)
2563  :bad
2564  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-8))))
2565
2566(define-x8632-vinsn require-u8 (()
2567                                ((object :lisp))
2568                                ((tag :u32)))
2569  :again
2570  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l tag))
2571  (andl (:%l object) (:%l tag))
2572  (jne :bad)
2573
2574  (:anchored-uuo-section :again)
2575  :bad
2576  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-8))))
2577
2578(define-x8632-vinsn require-s16 (()
2579                                ((object :lisp))
2580                                ((tag :s32)))
2581  :again
2582  (movl (:%l object) (:%l tag))
2583  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l tag))
2584  (sarl (:$ub (- x8632::nbits-in-word 16)) (:%l tag))
2585  (shll (:$ub x8632::fixnumshift) (:%l tag))
2586  (cmpl (:%l object) (:%l tag))
2587  (jne :bad)
2588
2589  (:anchored-uuo-section :again)
2590  :bad
2591  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-16))))
2592
2593(define-x8632-vinsn require-u16 (()
2594                                ((object :lisp))
2595                                ((tag :u32)))
2596  :again
2597  (movl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:%l tag))
2598  (andl (:%l object) (:%l tag))
2599  (jne :bad)
2600
2601  (:anchored-uuo-section :again)
2602  :bad
2603  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-16))))
2604
2605(define-x8632-vinsn require-s32 (()
2606                                 ((object :lisp))
2607                                 ((tag :s32)))
2608  :again
2609  (testl (:$l x8632::fixnummask) (:%l object))
2610  (movl (:%l object) (:%l tag))
2611  (je :ok)
2612  (andl (:$l x8632::fulltagmask) (:%l tag))
2613  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2614  (jne :bad)
2615  (cmpl (:$l x8632::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2616  (jne :bad)
2617  :ok
2618 
2619  (:anchored-uuo-section :again)
2620  :bad
2621  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-32))))
2622
2623(define-x8632-vinsn require-u32 (()
2624                                 ((object :lisp))
2625                                 ((tag :s32)))
2626  :again
2627  (testl (:$l x8632::fixnummask) (:%l object))
2628  (movl (:%l object) (:%l tag))
2629  (je :ok-if-non-negative)
2630  (andl (:$l x8632::fulltagmask) (:%l tag))
2631  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2632  (jne :bad)
2633  (cmpl (:$l x8632::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2634  (je :one)
2635  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2636  (jne :bad)
2637  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 4) (:%l object)))
2638  (je :ok)
2639  :bad
2640  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-32))
2641  (jmp :again)
2642  :one
2643  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
2644  :ok-if-non-negative
2645  (testl (:%l tag) (:%l tag))
2646  (js :bad)
2647  :ok)
2648
2649(define-x8632-vinsn require-s64 (()
2650                                 ((object :lisp))
2651                                 ((tag :s32)))
2652  :again
2653  (testl (:$l x8632::fixnummask) (:%l object))
2654  (movl (:%l object) (:%l tag))
2655  (je :ok)
2656  (andl (:$l x8632::fulltagmask) (:%l tag))
2657  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2658  (jne :bad)
2659  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2660  (jne :bad)
2661  :ok
2662
2663  (:anchored-uuo-section :again)
2664  :bad
2665  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-64))))
2666
2667(define-x8632-vinsn require-u64 (()
2668                                 ((object :lisp))
2669                                 ((tag :s32)))
2670  :again
2671  (testl (:$l x8632::fixnummask) (:%l object))
2672  (movl (:%l object) (:%l tag))
2673  (je :ok-if-non-negative)
2674  (andl (:$l x8632::fulltagmask) (:%l tag))
2675  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
2676  (jne :bad)
2677  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2678  (je :two)
2679  (cmpl (:$l x8632::three-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
2680  (jne :bad)
2681  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 8) (:%l object)))
2682  (je :ok)
2683  :bad
2684  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-64))
2685  (jmp :again)
2686  :two
2687  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
2688  :ok-if-non-negative
2689  (testl (:%l tag) (:%l tag))
2690  (js :bad)
2691  :ok)
2692
2693(define-x8632-vinsn require-char-code (()
2694                                       ((object :lisp))
2695                                       ((tag :u32)))
2696  :again
2697  (testb (:$b x8632::fixnummask) (:%b object))
2698  (jne :bad)
2699  (cmpl (:$l (ash #x110000 x8632::fixnumshift)) (:%l object))
2700  (jae :bad)
2701
2702  (:anchored-uuo-section :again)
2703  :bad
2704  (:anchored-uuo (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-mod-char-code-limit))))
2705
2706(define-x8632-vinsn mask-base-char (((dest :u8))
2707                                    ((src :lisp)))
2708  (movzbl (:%b src) (:%l dest)))
2709
2710(define-x8632-vinsn event-poll (()
2711                                ())
2712  (btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
2713  (jae :no-interrupt)
2714  (ud2a)
2715  (:byte 2)
2716  :no-interrupt)
2717
2718;;; check-2d-bound
2719;;; check-3d-bound
2720
2721(define-x8632-vinsn 2d-dim1 (((dest :u32))
2722                             ((header :lisp)))
2723  (movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
2724            (:%l header)) (:%l dest))
2725  (sarl (:$ub x8632::fixnumshift) (:%l dest)))
2726
2727;;; 3d-dims
2728
2729;;; xxx
2730(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
2731                                        (dim1 :u32))
2732                                       ((dim1 :u32)
2733                                        (i :imm)
2734                                        (j :imm)))
2735
2736  (imull (:%l i) (:%l dim1))
2737  (leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
2738
2739;;; 3d-unscaled-index
2740
2741(define-x8632-vinsn branch-unless-both-args-fixnums (()
2742                                                     ((a :lisp)
2743                                                      (b :lisp)
2744                                                      (dest :label))
2745                                                     ((tag :u8)))
2746  (movl (:%l a) (:%l tag))
2747  (orl (:%l b) (:%l tag))
2748  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2749   (testb (:$b x8632::fixnummask) (:%accb tag)))
2750  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2751         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2752   (testb (:$b x8632::fixnummask) (:%b tag)))
2753  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2754   (testl (:$l x8632::fixnummask) (:%l tag)))
2755  (jne dest))
2756
2757(define-x8632-vinsn branch-unless-arg-fixnum (()
2758                                              ((a :lisp)
2759                                               (dest :label)))
2760  ((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
2761   (testb (:$b x8632::fixnummask) (:%b a)))
2762  ((:pred > (:apply %hard-regspec-value a) x8632::ebx)
2763   (testl (:$l x8632::fixnummask) (:%l a)))
2764  (jne dest))
2765
2766(define-x8632-vinsn fixnum->single-float (((f :single-float))
2767                                          ((arg :lisp))
2768                                          ((unboxed :s32)))
2769  (movl (:%l arg) (:%l unboxed))
2770  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
2771  (cvtsi2ssl (:%l unboxed) (:%xmm f)))
2772
2773(define-x8632-vinsn fixnum->double-float (((f :double-float))
2774                                          ((arg :lisp))
2775                                          ((unboxed :s32)))
2776  (movl (:%l arg) (:%l unboxed))
2777  (sarl (:$ub x8632::fixnumshift) (:%l unboxed))
2778  (cvtsi2sdl (:%l unboxed) (:%xmm f)))
2779
2780(define-x8632-vinsn xchg-registers (()
2781                                    ((a t)
2782                                     (b t)))
2783  (xchgl (:%l a) (:%l b)))
2784
2785(define-x8632-vinsn establish-fn (()
2786                                  ())
2787  (movl (:$self 0) (:%l x8632::fn)))
2788
2789(define-x8632-vinsn %scharcode32 (((code :imm))
2790                                  ((str :lisp)
2791                                   (idx :imm))
2792                                  ((imm :u32)))
2793  (movl (:@ x8632::misc-data-offset (:%l str) (:%l idx)) (:%l imm))
2794  (imull (:$b x8632::fixnumone) (:%l imm) (:%l code)))
2795
2796(define-x8632-vinsn %set-scharcode32 (()
2797                                      ((str :lisp)
2798                                       (idx :imm)
2799                                       (code :imm))
2800                                      ((imm :u32)))
2801  (movl (:%l code) (:%l imm))
2802  (shrl (:$ub x8632::fixnumshift) (:%l imm))
2803  (movl (:%l imm) (:@ x8632::misc-data-offset (:%l str) (:%l idx))))
2804
2805
2806(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
2807
2808(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
2809
2810
2811(define-x8632-vinsn character->code (((dest :u32))
2812                                     ((src :lisp)))
2813  (movl (:%l src) (:%l dest))
2814  (sarl (:$ub x8632::charcode-shift) (:%l dest)))
2815
2816(define-x8632-vinsn adjust-vsp (()
2817                                ((amount :s32const)))
2818  ((:and (:pred >= amount -128) (:pred <= amount 127))
2819   (addl (:$b amount) (:%l x8632::esp)))
2820  ((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
2821   (addl (:$l amount) (:%l x8632::esp))))
2822
2823
2824(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
2825                                                          ((spno :s32const)
2826                                                           (y t)
2827                                                           (z t))
2828                                                          ((entry (:label 1))))
2829  (:talign 5)
2830  (call (:@ spno))
2831  (movl (:$self 0) (:%l x8632::fn)))
2832
2833(define-x8632-vinsn %symbol->symptr (((dest :lisp))
2834                                     ((src :lisp))
2835                                     ((tag :u8)))
2836  :resume
[11089]2837  (cmpl (:$l (:apply target-nil-value)) (:%l src))
[10972]2838  (je :nilsym)
2839  (movl (:%l src) (:%l tag))
[11089]2840  (andl (:$b x8632::tagmask) (:%l tag))
2841  (cmpl (:$b x8632::tag-misc) (:%l tag))
[10972]2842  (jne :bad)
[11089]2843  (movsbl (:@ x8632::misc-subtag-offset (:%l src)) (:%l tag))
2844  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
[10972]2845  (jne :bad)
2846  ((:not (:pred =
2847                (:apply %hard-regspec-value dest)
2848                (:apply %hard-regspec-value src)))
2849   (movl (:% src) (:% dest)))
2850  (jmp :ok)
2851  :nilsym
[11089]2852  (movl (:$l (:apply + (:apply target-nil-value) x8632::nilsym-offset)) (:%l dest))
[10972]2853  :ok
2854 
2855  (:anchored-uuo-section :resume)
2856  :bad
2857  (:anchored-uuo (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-symbol))))
2858
[11089]2859(define-x8632-vinsn single-float-bits (((dest :u32))
2860                                       ((src :lisp)))
2861  (movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest)))
[10972]2862
2863(define-x8632-vinsn zero-double-float-register (((dest :double-float))
2864                                                ())
2865  (movsd (:%xmm x8632::fpzero) (:%xmm dest)))
2866
2867(define-x8632-vinsn zero-single-float-register (((dest :single-float))
2868                                                ())
2869  (movss (:%xmm x8632::fpzero) (:%xmm dest)))
2870
2871(define-x8632-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
2872(define-x8632-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
2873(define-x8632-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
2874
2875
2876(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
2877
2878(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
2879                                               ((src :lisp))
2880                                               ((temp :u32)))
2881  (movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
[11089]2882  (shrl (:$ub x8632::num-subtag-bits) (:%l temp))
2883  (leal (:@ (:%l temp) 4) (:%l dest)))
[10972]2884
2885(define-x8632-vinsn %logior2 (((dest :imm))
2886                              ((x :imm)
2887                               (y :imm)))
2888  ((:pred =
2889          (:apply %hard-regspec-value x)
2890          (:apply %hard-regspec-value dest))
2891   (orl (:%l y) (:%l dest)))
2892  ((:not (:pred =
2893                (:apply %hard-regspec-value x)
2894                (:apply %hard-regspec-value dest)))
2895   ((:pred =
2896           (:apply %hard-regspec-value y)
2897           (:apply %hard-regspec-value dest))
2898    (orl (:%l x) (:%l dest)))
2899   ((:not (:pred =
2900                 (:apply %hard-regspec-value y)
2901                 (:apply %hard-regspec-value dest)))
2902    (movl (:%l x) (:%l dest))
2903    (orl (:%l y) (:%l dest)))))
2904
2905(define-x8632-vinsn %logand2 (((dest :imm))
2906                              ((x :imm)
2907                               (y :imm)))
2908  ((:pred =
2909          (:apply %hard-regspec-value x)
2910          (:apply %hard-regspec-value dest))
2911   (andl (:%l y) (:%l dest)))
2912  ((:not (:pred =
2913                (:apply %hard-regspec-value x)
2914                (:apply %hard-regspec-value dest)))
2915   ((:pred =
2916           (:apply %hard-regspec-value y)
2917           (:apply %hard-regspec-value dest))
2918    (andl (:%l x) (:%l dest)))
2919   ((:not (:pred =
2920                 (:apply %hard-regspec-value y)
2921                 (:apply %hard-regspec-value dest)))
2922    (movl (:%l x) (:%l dest))
2923    (andl (:%l y) (:%l dest)))))
2924
2925(define-x8632-vinsn %logxor2 (((dest :imm))
2926                              ((x :imm)
2927                               (y :imm)))
2928  ((:pred =
2929          (:apply %hard-regspec-value x)
2930          (:apply %hard-regspec-value dest))
2931   (xorl (:%l y) (:%l dest)))
2932  ((:not (:pred =
2933                (:apply %hard-regspec-value x)
2934                (:apply %hard-regspec-value dest)))
2935   ((:pred =
2936           (:apply %hard-regspec-value y)
2937           (:apply %hard-regspec-value dest))
2938    (xorl (:%l x) (:%l dest)))
2939   ((:not (:pred =
2940                 (:apply %hard-regspec-value y)
2941                 (:apply %hard-regspec-value dest)))
2942    (movl (:%l x) (:%l dest))
2943    (xorl (:%l y) (:%l dest)))))
2944
2945
2946(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
2947
2948(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
2949
2950(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
2951
2952(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
2953
2954(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
2955
2956(define-x8632-subprim-lea-jmp-vinsn (make-stack-gvector)  .SPstkgvector)
2957
2958(define-x8632-vinsn load-character-constant (((dest :lisp))
2959                                             ((code :u32const))
2960                                             ())
2961  (movl (:$l (:apply logior (:apply ash code 8) x8632::subtag-character))
2962        (:%l dest)))
2963
2964
2965(define-x8632-vinsn setup-single-float-allocation (()
2966                                                   ())
2967  (movl (:$l (arch::make-vheader x8632::single-float.element-count x8632::subtag-single-float)) (:%l x8632::imm0))
2968  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
</