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

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

Port r10361, more or less.

(update set-nargs, fixnum->char; new nref-bitvector-flags,
misc-ref-c-bit-fixnum, misc-ref-c-bit-flags, code-char->char)

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