Context Navigation

source: branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp @ 7339

Visit:

Last change on this file since 7339 was 7339, checked in by rme, 14 years ago
IA-32 stuff
File size: 64.2 KB

Line
1	;;;-- Mode: Lisp; Package: (CCL :use CL) --
2
3	(in-package "CCL")
4
5	(eval-when (:compile-toplevel :load-toplevel :execute)
6	(require "VINSN")
7	(require "X8632-BACKEND"))
8
9	(eval-when (:compile-toplevel :execute)
10	(require "X8632ENV"))
11
12	(defmacro define-x8632-vinsn (vinsn-name (results args &optional temps) &body body)
13	(%define-vinsn x8632-backend vinsn-name results args temps body))
14
15
16	(define-x8632-vinsn scale-16bit-misc-index (((dest :u32))
17	((idx :imm))) ; A fixnum
18	(movl (:%l idx) (:%l dest))
19	(shrl (:$ub 1) (:%l dest)))
20
21	(define-x8632-vinsn scale-8bit-misc-index (((dest :u32))
22	((idx :imm))) ; A fixnum
23	(movl (:%l idx) (:%l dest))
24	(shrl (:$ub 2) (:%l dest)))
25
26	(define-x8632-vinsn misc-ref-u32 (((dest :u32))
27	((v :lisp)
28	(scaled-idx :u32)))
29	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
30
31	(define-x8632-vinsn misc-ref-double-float (((dest :double-float))
32	((v :lisp)
33	(scaled-idx :imm)))
34	(movsd (:@ x8632::misc-dfloat-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
35
36	(define-x8632-vinsn misc-ref-c-double-float (((dest :double-float))
37	((v :lisp)
38	(idx :s32const)))
39	(movsd (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
40
41	(define-x8632-vinsn misc-ref-node (((dest :lisp))
42	((v :lisp)
43	(scaled-idx :imm)))
44	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
45
46	(define-x8632-vinsn (push-misc-ref-node :push :node :vsp) (()
47	((v :lisp)
48	(scaled-idx :imm)))
49	(pushl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
50
51	(define-x8632-vinsn misc-set-node (()
52	((val :lisp)
53	(v :lisp)
54	(unscaled-idx :imm))
55	())
56	(movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
57
58	(define-x8632-vinsn misc-set-immediate-node (()
59	((val :s32const)
60	(v :lisp)
61	(unscaled-idx :imm))
62	())
63	(movl (:$l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
64
65	(define-x8632-vinsn misc-set-double-float (()
66	((val :double-float)
67	(v :lisp)
68	(unscaled-idx :imm))
69	())
70	(movsd (:%xmm val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
71
72	(define-x8632-vinsn misc-ref-u8 (((dest :u8))
73	((v :lisp)
74	(scaled-idx :s32)))
75	(movzbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
76
77	(define-x8632-vinsn misc-ref-s8 (((dest :s8))
78	((v :lisp)
79	(scaled-idx :s32)))
80	(movsbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
81
82	(define-x8632-vinsn misc-ref-u16 (((dest :u16))
83	((v :lisp)
84	(scaled-idx :s32)))
85	(movzwl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
86
87	(define-x8632-vinsn misc-ref-u32 (((dest :u32))
88	((v :lisp)
89	(scaled-idx :s32)))
90	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
91
92	(define-x8632-vinsn misc-ref-single-float (((dest :single-float))
93	((v :lisp)
94	(scaled-idx :s32)))
95	(movss (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
96
97	(define-x8632-vinsn misc-ref-s32 (((dest :s32))
98	((v :lisp)
99	(scaled-idx :s32)))
100	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
101
102	(define-x8632-vinsn misc-ref-s16 (((dest :s16))
103	((v :lisp)
104	(scaled-idx :s32)))
105	(movswl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
106
107	(define-x8632-vinsn misc-ref-c-node (((dest :lisp))
108	((v :lisp)
109	(idx :u32const)) ; sic
110	())
111	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
112
113	(define-x8632-vinsn (push-misc-ref-c-node :push :node :vsp)
114	(()
115	((v :lisp)
116	(idx :u32const)) ; sic
117	())
118	(pushl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v))))
119
120	(define-x8632-vinsn misc-ref-c-u32 (((dest :u32))
121	((v :lisp)
122	(idx :u32const)) ; sic
123	())
124	;; xxx - should the 2 be x8632::word-shift?
125	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)) (:%l dest)))
126
127	(define-x8632-vinsn misc-ref-c-s32 (((dest :s32))
128	((v :lisp)
129	(idx :s32const)) ; sic
130	())
131	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
132
133	(define-x8632-vinsn misc-ref-c-single-float (((dest :single-float))
134	((v :lisp)
135	(idx :s32const)) ; sic
136	())
137	(movss (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
138
139	(define-x8632-vinsn misc-ref-c-u8 (((dest :u32))
140	((v :lisp)
141	(idx :s32const)) ; sic
142	())
143	(movzbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
144
145	(define-x8632-vinsn misc-ref-c-s8 (((dest :s32))
146	((v :lisp)
147	(idx :s32const)) ; sic
148	())
149	(movsbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
150
151	(define-x8632-vinsn misc-set-c-node (()
152	((val :lisp)
153	(v :lisp)
154	(idx :s32const)))
155	(movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
156
157	(define-x8632-vinsn misc-set-immediate-c-node (()
158	((val :s32const)
159	(v :lisp)
160	(idx :s32const)))
161	(movl (:$l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
162
163	;;; xxx don't know if this is right
164	(define-x8632-vinsn set-closure-forward-reference (()
165	((val :lisp)
166	(closure :lisp)
167	(idx :s32const)))
168	(movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l closure))))
169
170	(define-x8632-vinsn misc-set-c-double-float (()
171	((val :double-float)
172	(v :lisp)
173	(idx :s32const)))
174	(movsd (:%xmm val) (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v))))
175
176	(define-x8632-vinsn (call-known-symbol :call) (((result (:lisp x8632::arg_z)))
177	()
178	((entry (:label 1))))
179	(:talign x8632::fulltag-tra)
180	(call (:@ x8632::symbol.fcell (:% x8632::fname)))
181	(movl (:$self 0) (:%l x8632::fn)))
182
183	(define-x8632-vinsn (jump-known-symbol :jumplr) (()
184	())
185
186	(jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
187
188	(define-x8632-vinsn set-nargs (()
189	((n :s16const)))
190	((:pred = n 0)
191	(xorw (:%w x8632::nargs ) (:%w x8632::nargs )))
192	((:not (:pred = n 0))
193	(movw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs ))))
194
195	(define-x8632-vinsn check-exact-nargs (()
196	((n :u16const)))
197	((:pred = n 0)
198	(testw (:%w x8632::nargs) (:%w x8632::nargs)))
199	((:not (:pred = n 0))
200	(cmpw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs)))
201	(jz.pt :ok)
202	(uuo-error-wrong-number-of-args)
203	:ok)
204
205	(define-x8632-vinsn check-min-nargs (()
206	((n :u16const)))
207	(rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
208	(jae.pt :ok)
209	(uuo-error-too-few-args)
210	:ok)
211
212	(define-x8632-vinsn check-max-nargs (()
213	((n :u16const)))
214	(rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
215	(jbe.pt :ok)
216	(uuo-error-too-many-args)
217	:ok)
218
219	(define-x8632-vinsn default-1-arg (()
220	((min :u16const)))
221	(rcmpw (:%w x8632::nargs) (:$w (:apply ash min x8632::word-shift)))
222	(jne :done)
223	((:pred >= min 2)
224	(pushl (:%l x8632::arg_y)))
225	((:pred >= min 1)
226	(movl (:%l x8632::arg_z) (:%l x8632::arg_y)))
227	(movl (:$l x8632::nil-value) (:%l x8632::arg_z))
228	:done)
229
230	(define-x8632-vinsn default-2-args (()
231	((min :u16const)))
232	(rcmpw (:%w x8632::nargs ) (:$w (:apply ash (:apply 1+ min) x8632::word-shift)))
233	(ja :done)
234	(je :one)
235	;; We got "min" args; arg_y & arg_z default to nil
236	((:pred >= min 2)
237	(pushl (:%l x8632::arg_y)))
238	((:pred >= min 1)
239	(pushl (:%l x8632::arg_z)))
240	(movl (:$l x8632::nil-value) (:%l x8632::arg_y))
241	(jmp :last)
242	:one
243	;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
244	((:pred >= min 1)
245	(pushl (:%l x8632::arg_y)))
246	(movl (:%l x8632::arg_z) (:%l x8632::arg_y))
247	:last
248	(movl (:$l x8632::nil-value) (:%l x8632::arg_z))
249	:done)
250
251	(define-x8632-vinsn default-optionals (()
252	((n :u16const))
253	((temp :u32)))
254	(rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::word-shift)))
255	(movw (:%w x8632::nargs) (:%w temp))
256	(jae :done)
257	:loop
258	(addw (:$w x8632::fixnumone) (:%w temp))
259	(cmpw (:$w (:apply ash n x8632::word-shift)) (:%w temp))
260	(pushl (:$l x8632::nil-value))
261	(jne :loop)
262	:done)
263
264	(define-x8632-vinsn save-lisp-context-no-stack-args (()
265	())
266	(pushl (:%l x8632::ebp))
267	(movl (:%l x8632::esp) (:%l x8632::ebp)))
268
269	(define-x8632-vinsn save-lisp-context-offset (()
270	((nbytes-pushed :s32const)))
271	(movl (:%l x8632::ebp) (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)))
272	(leal (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)) (:%l x8632::ebp))
273	(popl (:@ x8632::node-size (:%l x8632::ebp))))
274
275	(define-x8632-vinsn save-lisp-context-variable-arg-count (()
276	()
277	((temp :u32)))
278	(movzwl (:%w x8632::nargs) (:%l temp))
279	(subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
280	(jle :push)
281	(movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
282	(leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
283	(popl (:@ x8632::node-size (:%l x8632::ebp)))
284	(jmp :done)
285	:push
286	(pushl (:%l x8632::ebp))
287	(movl (:%l x8632::esp) (:%l x8632::ebp))
288	:done)
289
290	;;; We know that some args were pushed, but don't know how many were
291	;;; passed.
292	(define-x8632-vinsn save-lisp-context-in-frame (()
293	()
294	((temp :u32)))
295	(movzwl (:%w x8632::nargs) (:%l temp))
296	(subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
297	(movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
298	(leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
299	(popl (:@ x8632::node-size (:%l x8632::ebp))))
300
301	(define-x8632-vinsn (vpush-register :push :node :vsp)
302	(()
303	((reg :lisp)))
304	(pushl (:% reg)))
305
306	(define-x8632-vinsn (vpush-fixnum :push :node :vsp)
307	(()
308	((const :s32const)))
309	((:and (:pred < const 128) (:pred >= const -128))
310	(pushl (:$b const)))
311	((:not (:and (:pred < const 128) (:pred >= const -128)))
312	(pushl (:$l const))))
313
314	(define-x8632-vinsn vframe-load (((dest :lisp))
315	((frame-offset :u16const)
316	(cur-vsp :u16const)))
317	(movl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
318
319	(define-x8632-vinsn compare-vframe-offset-to-nil (()
320	((frame-offset :u16const)
321	(cur-vsp :u16const)))
322	(cmpl (:$l x8632::nil-value) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
323
324	(define-x8632-vinsn compare-value-cell-to-nil (()
325	((vcell :lisp)))
326	(cmpl (:$l x8632::nil-value) (:@ x8632::value-cell.value (:%l vcell))))
327
328	(define-x8632-vinsn lcell-load (((dest :lisp))
329	((cell :lcell)
330	(top :lcell)))
331	(movl (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
332
333	(define-x8632-vinsn (vframe-push :push :node :vsp)
334	(()
335	((frame-offset :u16const)
336	(cur-vsp :u16const)))
337	(pushl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
338
339	(define-x8632-vinsn vframe-store (()
340	((src :lisp)
341	(frame-offset :u16const)
342	(cur-vsp :u16const)))
343	(movl (:%l src) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
344
345	(define-x8632-vinsn lcell-store (()
346	((src :lisp)
347	(cell :lcell)
348	(top :lcell)))
349	(movl (:%l src) (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp))))
350
351	(define-x8632-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
352	(()
353	())
354	(leave)
355	(ret))
356
357	(define-x8632-vinsn (restore-full-lisp-context :lispcontext :pop :vsp )
358	(()
359	())
360	(leave))
361
362	(define-x8632-vinsn compare-to-nil (()
363	((arg0 t)))
364	(cmpl (:$l x8632::nil-value) (:%l arg0)))
365
366	(define-x8632-vinsn ref-constant (((dest :lisp))
367	((lab :label)))
368	(movl (:@ (:^ lab) (:%l x8632::fn)) (:%l dest)))
369
370	(define-x8632-vinsn (vpush-constant :push :node :vsp) (()
371	((lab :label)))
372	(pushl (:@ (:^ lab) (:%l x8632::fn))))
373
374	(define-x8632-vinsn (jump :jump)
375	(()
376	((label :label)))
377	(jmp label))
378
379	(define-x8632-vinsn (cbranch-true :branch) (()
380	((label :label)
381	(crbit :u8const)))
382	(jcc (:$ub crbit) label))
383
384	(define-x8632-vinsn (cbranch-false :branch) (()
385	((label :label)
386	(crbit :u8const)))
387	(jcc (:$ub (:apply logxor 1 crbit)) label))
388
389	(define-x8632-vinsn (lri :constant-ref) (((dest :imm))
390	((intval :s32const))
391	())
392	((:pred = intval 0)
393	(xorl (:%l dest) (:%l dest)))
394	((:and (:pred /= intval 0)
395	(:pred >= intval -2147483648)
396	(:pred <= intval 2147483647))
397	(movl (:$l intval) (:%l dest))))
398
399	;;; In the following trap/branch-unless vinsns, it might be worth
400	;;; trying to use byte instructions when the args are known to be
401	;;; accessible as byte regs. It also might be possible to
402	;;; special-case eax/ax/al.
403
404	(define-x8632-vinsn trap-unless-bit (()
405	((value :lisp)))
406	(testl (:$l (lognot x8632::fixnumone)) (:%l value))
407	(je.pt :ok)
408	(uuo-error-reg-not-type (:%l value) (:$ub arch::error-object-not-bit))
409	:ok
410	)
411
412	;;; note that NIL is just a distinguished CONS.
413	;;; the tag formerly known as fulltag-nil is now
414	;;; for tagged return addresses.
415	(define-x8632-vinsn trap-unless-list (()
416	((object :lisp))
417	((tag :u16)))
418	(movw (:%w object) (:%w tag))
419	(andw (:$w x8632::fulltagmask) (:%w tag))
420	(cmpw (:$w x8632::fulltag-cons) (:%w tag))
421	(je.pt :ok)
422	(uuo-error-reg-not-list (:%l object))
423	:ok)
424
425	(define-x8632-vinsn trap-unless-cons (()
426	((object :lisp))
427	((tag :u16)))
428	;; check for NIL
429	(cmpl (:$l x8632::nil-value) (:%l object))
430	(je.pn :bad)
431	(movw (:%w object) (:%w tag))
432	(andw (:$w x8632::fulltagmask) (:%w tag))
433	(cmpw (:$w x8632::fulltag-cons) (:%w tag))
434	(je.pt :ok)
435	:bad
436	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::fulltag-cons))
437	:ok)
438
439	(define-x8632-vinsn trap-unless-uvector (()
440	((object :lisp))
441	((tag :u16)))
442	(movw (:%w object) (:%w tag))
443	(andw (:$w x8632::tagmask) (:%w tag))
444	(cmpw (:$w x8632::tag-misc) (:%w tag))
445	(jz.pt :ok)
446	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::tag-misc))
447	:ok)
448
449	(define-x8632-vinsn trap-unless-character (()
450	((object :lisp)))
451	(cmpw (:$w x8632::subtag-character) (:%w object))
452	(je.pt :ok)
453	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-character))
454	:ok)
455
456	(define-x8632-vinsn trap-unless-fixnum (()
457	((object :lisp))
458	())
459	(testw (:$w x8632::tagmask) (:%w object))
460	(je.pt :ok)
461	(uuo-error-reg-not-fixnum (:%l object))
462	:ok)
463
464	(define-x8632-vinsn set-flags-from-lisptag (()
465	((reg :lisp)))
466	(testw (:$w x8632::tagmask) (:%w reg)))
467
468	(define-x8632-vinsn trap-unless-typecode= (()
469	((object :lisp)
470	(tagval :u8const))
471	((tag :u8)))
472	(movl (:%l object) (:%l tag))
473	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
474	;; accumulator
475	(andb (:$b x8632::tagmask) (:%accb tag))
476	(cmpb (:$b x8632::tag-misc) (:%accb tag)))
477	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
478	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
479	;; other register that can be treated as a byte
480	(andb (:$b x8632::tagmask) (:%b tag))
481	(cmpb (:$b x8632::tag-misc) (:%b tag)))
482	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
483	;; non-byte register
484	(andl (:$l x8632::tagmask) (:%l tag))
485	(cmpl (:$b x8632::tag-misc) (:%l tag)))
486	(jne :have-tag)
487	(movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
488	:have-tag
489	(cmpl (:$b tagval) (:%l tag))
490	(je.pt :ok)
491	(uuo-error-reg-not-tag (:%l object) (:$ub tagval))
492	:ok)
493
494	(define-x8632-vinsn trap-unless-single-float (()
495	((object :lisp))
496	((tag :u16)))
497	(movw (:%w object) (:%w tag))
498	(andw (:$w x8632::tagmask) (:%w tag))
499	(cmpw (:$w x8632::tag-misc) (:%w tag))
500	(jne :have-tag)
501	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
502	:have-tag
503	(cmpw (:$w x8632::subtag-single-float) (:%w tag))
504	(je.pt :ok)
505	(uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-single-float))
506	:ok)
507
508	(define-x8632-vinsn trap-unless-double-float (()
509	((object :lisp))
510	((tag :u16)))
511	(movw (:%w object) (:%w tag))
512	(andw (:$w x8632::tagmask) (:%w tag))
513	(cmpw (:$w x8632::tag-misc) (:%w tag))
514	(jne :have-tag)
515	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
516	:have-tag
517	(cmpw (:$w x8632::subtag-double-float) (:%w tag))
518	(je.pt :ok)
519	(uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-double-float))
520	:ok)
521
522	(define-x8632-vinsn trap-unless-macptr (()
523	((object :lisp))
524	((tag :u16)))
525	(movw (:%w object) (:%w tag))
526	(andw (:$w x8632::tagmask) (:%w tag))
527	(cmpw (:$w x8632::tag-misc) (:%w tag))
528	(jne :have-tag)
529	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
530	:have-tag
531	(cmpw (:$w x8632::subtag-macptr) (:%w tag))
532	(je.pt :ok)
533	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-macptr))
534	:ok)
535
536	(define-x8632-vinsn check-misc-bound (()
537	((idx :imm)
538	(v :lisp))
539	((temp :u32)))
540	(movl (:@ x8632::misc-header-offset (:%l v)) (:%l temp))
541	((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
542	(:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
543	(xorb (:%b temp) (:%b temp))
544	(shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l temp)))
545	((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
546	(shrl (:$ub x8632::num-subtag-bits) (:%l temp))
547	(shll (:$ub x8632::fixnumshift) (:%l temp)))
548	(rcmpl (:%l idx) (:%l temp))
549	(jb.pt :ok)
550	(uuo-error-vector-bounds (:%l idx) (:%l v))
551	:ok)
552
553	(define-x8632-vinsn %cdr (((dest :lisp))
554	((src :lisp)))
555	(movl (:@ x8632::cons.cdr (:%l src)) (:%l dest)))
556
557	(define-x8632-vinsn (%vpush-cdr :push :node :vsp)
558	(()
559	((src :lisp)))
560	(pushl (:@ x8632::cons.cdr (:%l src))))
561
562	(define-x8632-vinsn %car (((dest :lisp))
563	((src :lisp)))
564	(movl (:@ x8632::cons.car (:%l src)) (:%l dest)))
565
566	(define-x8632-vinsn (%vpush-car :push :node :vsp)
567	(()
568	((src :lisp)))
569	(pushl (:@ x8632::cons.car (:%l src))))
570
571	(define-x8632-vinsn u32->char (((dest :lisp)
572	(src :u8))
573	((src :u8))
574	())
575	(shll (:$ub x8632::charcode-shift) (:%l src))
576	(leal (:@ x8632::subtag-character (:%l src)) (:%l dest)))
577
578	(define-x8632-vinsn (load-nil :constant-ref) (((dest t))
579	())
580	(movl (:$l x8632::nil-value) (:%l dest)))
581
582
583	(define-x8632-vinsn (load-t :constant-ref) (((dest t))
584	())
585	(movl (:$l x8632::t-value) (:%l dest)))
586
587	;;; use something like this for the other extract-whatevers, too,
588	;;; once it's established that it works.
589	(define-x8632-vinsn extract-tag (((tag :u8))
590	((object :lisp)))
591	(movl (:%l object) (:%l tag))
592	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
593	;; tag is the accumulator (2 bytes)
594	(andb (:$b x8632::tagmask) (:%accb tag)))
595	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
596	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
597	;; tag is in a register whose low 8 bits can be accessed by byte
598	;; insns (3 bytes)
599	(andb (:$b x8632::tagmask) (:%b tag)))
600	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
601	;; tag is somewhere else (6 bytes) (could use andw and get a length
602	;; of 5 bytes, but Intel's optimization manual advises avoiding
603	;; length-changing prefixes to change the size of immediates.
604	;; (section 3.4.2.3)
605	(andl (:$l x8632::tagmask) (:%l tag))))
606
607	(define-x8632-vinsn extract-tag-fixnum (((tag :imm))
608	((object :lisp)))
609	(leal (:@ (:%l object) 4) (:%l tag))
610	(andw (:$w (ash x8632::tagmask x8632::fixnumshift)) (:%w tag)))
611
612	(define-x8632-vinsn extract-fulltag (((tag :u8))
613	((object :lisp)))
614	(movl (:%l object) (:%l tag))
615	(andw (:$w x8632::fulltagmask) (:%w tag)))
616
617	(define-x8632-vinsn extract-fulltag-fixnum (((tag :imm))
618	((object :lisp)))
619	(leal (:@ (:%l object) 4) (:%l tag))
620	(andw (:$w (ash x8632::fulltagmask x8632::fixnumshift)) (:%w tag)))
621
622	(define-x8632-vinsn extract-typecode (((tag :imm))
623	((object :lisp)))
624	(movl (:%l object) (:%l tag))
625	((:pred <= (:apply %hard-regspec-value tag) x8632::ebx)
626	(andb (:$b x8632::tagmask) (:%b tag))
627	(cmpb (:$b x8632::tag-misc) (:%b tag)))
628	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
629	(andl (:$l x8632::tagmask) (:%l tag))
630	(cmpl (:$l x8632::tag-misc) (:%l tag)))
631	(jne :have-tag)
632	((:pred <= (:apply %hard-regspec-value tag) x8632::ebx)
633	(movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag)))
634	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
635	(movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag)))
636	:have-tag)
637
638	(define-x8632-vinsn extract-typecode-fixnum (((tag :imm))
639	((object :lisp))
640	((temp :u32)))
641	(movl (:%l object) (:%l temp))
642	(andw (:$w x8632::tagmask) (:%w temp))
643	(cmpw (:$w x8632::tag-misc) (:%w temp))
644	(jne :have-tag)
645	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w temp))
646	:have-tag
647	(leal (:@ (:%l temp) 4) (:%l tag)))
648
649	(define-x8632-vinsn compare-reg-to-zero (()
650	((reg :imm)))
651	(testl (:%l reg) (:%l reg)))
652
653	;;; life will be sad if reg isn't byte accessible
654	(define-x8632-vinsn compare-u8-reg-to-zero (()
655	((reg :u8)))
656	(testb (:%b reg) (:%b reg)))
657
658	(define-x8632-vinsn cr-bit->boolean (((dest :lisp))
659	((crbit :u8const))
660	((temp :u32)))
661	(movl (:$l x8632::t-value) (:%l temp))
662	(leal (:@ (- x8632::t-offset) (:%l temp)) (:%l dest))
663	(cmovccl (:$ub crbit) (:%l temp) (:%l dest)))
664
665	(define-x8632-vinsn compare-s32-constant (()
666	((val :imm)
667	(const :s32const)))
668	((:or (:pred < const -128) (:pred > const 127))
669	(rcmpl (:%l val) (:$l const)))
670	((:not (:or (:pred < const -128) (:pred > const 127)))
671	(rcmpl (:%l val) (:$b const))))
672
673	(define-x8632-vinsn compare-u31-constant (()
674	((val :u32)
675	(const :u32const)))
676	((:pred > const 127)
677	(rcmpl (:%l val) (:$l const)))
678	((:not (:pred > const 127))
679	(rcmpl (:%l val) (:$b const))))
680
681	(define-x8632-vinsn compare-u8-constant (()
682	((val :u8)
683	(const :u8const)))
684	((:pred = (:apply %hard-regspec-value val) x8632::eax)
685	(rcmpb (:%accb val) (:$b const)))
686	((:and (:pred > (:apply %hard-regspec-value val) x8632::eax)
687	(:pred <= (:apply %hard-regspec-value val) x8632::ebx))
688	(rcmpb (:%b val) (:$b const)))
689	((:pred > (:apply %hard-regspec-value val) x8632::ebx)
690	(rcmpl (:%l val) (:$l const)))
691	)
692
693	(define-x8632-vinsn cons (((dest :lisp))
694	((car :lisp)
695	(cdr :lisp))
696	((allocptr (:lisp #.x8632::allocptr))))
697	(subl (:$b (- x8632::cons.size x8632::fulltag-cons)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
698	(movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l x8632::allocptr))
699	(rcmpl (:%l x8632::allocptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
700	(jg :no-trap)
701	(uuo-alloc)
702	:no-trap
703	(andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
704	(movl (:%l car) (:@ x8632::cons.car (:%l x8632::allocptr)))
705	(movl (:%l cdr) (:@ x8632::cons.cdr (:%l x8632::allocptr)))
706	(movl (:%l x8632::allocptr) (:%l dest)))
707
708	(define-x8632-vinsn unbox-u8 (((dest :u8))
709	((src :lisp)))
710	(movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l dest))
711	(andl (:% src) (:% dest))
712	(je.pt :ok)
713	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-8))
714	:ok
715	(movl (:%l src) (:%l dest))
716	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
717
718	(define-x8632-vinsn %unbox-u8 (((dest :u8))
719	((src :lisp)))
720	(movl (:%l src) (:%l dest))
721	(shrl (:$ub x8632::fixnumshift) (:%l dest))
722	(andl (:$l #xff) (:%l dest)))
723
724	(define-x8632-vinsn unbox-s8 (((dest :s8))
725	((src :lisp)))
726	(movl (:%l src) (:%l dest))
727	(shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
728	(sarl (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
729	(cmpl (:%l src) (:%l dest))
730	(jne.pn :bad)
731	(testw (:$w x8632::fixnummask) (:%w dest))
732	(jne.pn :bad)
733	(sarl (:$ub x8632::fixnumshift) (:%l dest))
734	(jmp :got-it)
735	:bad
736	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-8))
737	:got-it)
738
739	(define-x8632-vinsn unbox-u16 (((dest :u16))
740	((src :lisp)))
741	(testl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:% src))
742	(movl (:%l src) (:%l dest))
743	(je.pt :ok)
744	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-16))
745	:ok
746	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
747
748	(define-x8632-vinsn %unbox-u16 (((dest :u16))
749	((src :lisp)))
750	(movl (:%l src) (:%l dest))
751	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
752
753	(define-x8632-vinsn unbox-s16 (((dest :s16))
754	((src :lisp)))
755	(movl (:%l src) (:%l dest))
756	(shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
757	(sarl (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
758	(cmpl (:%l src) (:%l dest))
759	(jne.pn :bad)
760	(testw (:$w x8632::fixnummask) (:%w dest))
761	(je.pt :got-it)
762	:bad
763	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-16))
764	:got-it
765	(sarl (:$ub x8632::fixnumshift) (:%l dest)))
766
767	(define-x8632-vinsn %unbox-s16 (((dest :s16))
768	((src :lisp)))
769	(movl (:%l src) (:%l dest))
770	(sarl (:$ub x8632::fixnumshift) (:%l dest)))
771
772	;;; xxx -- review this again later
773	(define-x8632-vinsn unbox-u32 (((dest :u32))
774	((src :lisp)))
775	(movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest))
776	(testl (:%l dest) (:%l src))
777	(movl (:%l src) (:%l dest))
778	(jnz :maybe-bignum)
779	(sarl (:$ub x8632::fixnumshift) (:%l dest))
780	(jmp :done)
781	:maybe-bignum
782	(andw (:$w x8632::tagmask) (:%w dest))
783	(cmpw (:$w x8632::tag-misc) (:%w dest))
784	(jne :have-tag)
785	(movw (:@ x8632::misc-subtag-offset (:%l src)) (:%w dest))
786	(andw (:$w #xff) (:%w dest))
787	:have-tag
788	(cmpw (:$w x8632::subtag-bignum) (:%w dest))
789	(jne :bad)
790	(movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest))
791	(cmpl (:$l x8632::three-digit-bignum-header) (:%l dest))
792	(je :three)
793	(cmpl (:$l x8632::two-digit-bignum-header) (:%l dest))
794	(jne :bad)
795	(movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
796	(testl (:%l dest) (:%l dest))
797	(jns :done)
798	:bad
799	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32))
800	:three
801	(movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest))
802	(testl (:%l dest) (:%l dest))
803	(movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
804	(jne :bad)
805	:done)
806
807	;;; xxx -- review this again later
808	(define-x8632-vinsn unbox-s32 (((dest :s32))
809	((src :lisp)))
810	(movl (:%l src) (:%l dest))
811	(sarl (:$ub x8632::fixnumshift) (:%l dest))
812	;; Was it a fixnum ?
813	(testw (:$w x8632::fixnummask) (:%w src))
814	(je :done)
815	;; May be a 2-digit bignum
816	(movw (:%w src) (:%w dest))
817	(andw (:$w x8632::tagmask) (:%w dest))
818	(cmpw (:$w x8632::tag-misc) (:%w dest))
819	(jne :bad)
820	(cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src)))
821	(movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
822	(je :done)
823	:bad
824	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32))
825	:done)
826
827
828	;;; xxx -- sigh...
829	(define-x8632-vinsn sign-extend-s8 (((dest :s32))
830	((src :s8)))
831	;; (movsbl (:%b temp) (:%l dest))
832	(movl (:%l src) (:%l dest))
833	(shll (:$ub 24) (:%l dest))
834	(sarl (:$ub 24) (:%l dest)))
835
836	(define-x8632-vinsn sign-extend-s16 (((dest :s32))
837	((src :s16)))
838	(movswl (:%w src) (:%l dest)))
839
840	;;; xxx -- sigh...
841	(define-x8632-vinsn zero-extend-u8 (((dest :s32))
842	((src :u8)))
843	;;(movzbl (:%b src) (:%l dest))
844	(movl (:%l src) (:%l dest))
845	(andl (:$l #xff) (:%l dest)))
846
847	(define-x8632-vinsn zero-extend-u16 (((dest :s32))
848	((src :u16)))
849	(movzwl (:%w src) (:%l dest)))
850
851	(define-x8632-vinsn (jump-subprim :jumpLR) (()
852	((spno :s32const)))
853	(jmp (:@ spno)))
854
855	;;; Call a subprimitive using a tail-aligned CALL instruction.
856	(define-x8632-vinsn (call-subprim :call) (()
857	((spno :s32const))
858	((entry (:label 1))))
859	(:talign x8632::fulltag-tra)
860	(call (:@ spno))
861	(movl (:$self 0) (:% x8632::fn)))
862
863	(define-x8632-vinsn fixnum-subtract-from (((dest t)
864	(y t))
865	((y t)
866	(x t)))
867	(subl (:%l y) (:%l x)))
868
869	(define-x8632-vinsn %logand-c (((dest t)
870	(val t))
871	((val t)
872	(const :s32const)))
873	((:and (:pred >= const -128) (:pred <= const 127))
874	(andl (:$b const) (:%l val)))
875	((:not (:and (:pred >= const -128) (:pred <= const 127)))
876	(andl (:$l const) (:%l val))))
877
878	(define-x8632-vinsn %logior-c (((dest t)
879	(val t))
880	((val t)
881	(const :s32const)))
882	((:and (:pred >= const -128) (:pred <= const 127))
883	(orl (:$b const) (:%l val)))
884	((:not (:and (:pred >= const -128) (:pred <= const 127)))
885	(orl (:$l const) (:%l val))))
886
887	(define-x8632-vinsn %logxor-c (((dest t)
888	(val t))
889	((val t)
890	(const :s32const)))
891	((:and (:pred >= const -128) (:pred <= const 127))
892	(xorl (:$b const) (:%l val)))
893	((:not (:and (:pred >= const -128) (:pred <= const 127)))
894	(xorl (:$l const) (:%l val))))
895
896	(define-x8632-vinsn character->fixnum (((dest :lisp))
897	((src :lisp))
898	())
899	((:not (:pred =
900	(:apply %hard-regspec-value dest)
901	(:apply %hard-regspec-value src)))
902	(movl (:%l src) (:%l dest)))
903	(shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest)))
904
905	(define-x8632-vinsn compare (()
906	((x t)
907	(y t)))
908	(rcmpl (:%l x) (:%l y)))
909
910	(define-x8632-vinsn negate-fixnum (((val :lisp))
911	((val :imm)))
912	(negl (:% val)))
913
914	;;; set-bigits-and-header-for-fixnum-overflow
915
916	(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
917	((src :s32))
918	((temp :s32)))
919	(movl (:%l src) (:%l temp))
920	(shll (:$ub x8632::fixnumshift) (:%l temp))
921	(movl (:%l temp) (:%l dest)) ; tagged as a fixnum
922	(sarl (:$ub x8632::fixnumshift) (:%l temp))
923	(cmpl (:%l src) (:%l temp)))
924
925	(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
926	((src :u32))
927	((temp :u32)))
928	(movl (:%l src) (:%l temp))
929	(shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
930	(movl (:%l temp) (:%l dest)) ; tagged as an even fixnum
931	(shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
932	(shrl (:%l dest))
933	(cmpl (:%l src) (:%l temp))
934	:done)
935
936	;;; setup-bignum-alloc-for-s32-overflow
937	;;; setup-bignum-alloc-for-u32-overflow
938
939	(define-x8632-vinsn setup-uvector-allocation (()
940	((header :imm)))
941	(movd (:%l header) (:%mmx x8632::mm0)))
942
943	;;; The code that runs in response to the uuo-alloc
944	;;; expects a header in mm0, and a size in imm0.
945	;;; mm0 is an implicit arg (it contains the uvector header)
946	;;; size is actually an arg, not a temporary,
947	;;; but it appears that there's isn't a way to enforce
948	;;; register usage on vinsn args.
949	(define-x8632-vinsn %allocate-uvector (((dest :lisp))
950	()
951	((size (:u32 #.x8632::imm0))
952	(freeptr (:lisp #.x8632::allocptr))))
953	(subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
954	(movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
955	(rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
956	(jg :no-trap)
957	(uuo-alloc)
958	:no-trap
959	(movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
960	(andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
961	((:not (:pred = freeptr
962	(:apply %hard-regspec-value dest)))
963	(movl (:%l freeptr) (:%l dest))))
964
965	(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
966	((bignum :lisp)))
967	(movq (:%mmx x8632::mm0) (:@ x8632::misc-data-offset (:%l bignum))))
968
969	(define-x8632-vinsn box-fixnum (((dest :imm))
970	((src :s32)))
971	;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
972	(leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
973
974	;;; xxx
975	(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
976	(((val :lisp))
977	((val :lisp))
978	((unboxed (:s32 #.x8632::edx))
979	(header (:u32 #.x8632::imm0))
980	(entry (:label 1))))
981	(jno.pt :done)
982	((:not (:pred = x8632::arg_z
983	(:apply %hard-regspec-value val)))
984	(movl (:%l val) (:%l x8632::arg_z)))
985	(:talign 5)
986	(call (:@ .SPfix-overflow))
987	(movl (:$self 0) (:%l x8632::fn))
988	((:not (:pred = x8632::arg_z
989	(:apply %hard-regspec-value val)))
990	(movl (:%l x8632::arg_z) (:%l val)))
991	:done)
992
993	;;; xxx
994	(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
995	(((val :lisp))
996	((val :lisp)
997	(lab :label))
998	((unboxed (:s32 #.x8664::imm1))
999	(header (:u32 #.x8664::imm0))
1000	(entry (:label 1))))
1001	(jno.pt lab)
1002	((:not (:pred = x8632::arg_z
1003	(:apply %hard-regspec-value val)))
1004	(movl (:%l val) (:%l x8632::arg_z)))
1005	(:talign 5)
1006	(call (:@ .SPfix-overflow))
1007	(movl (:$self 0) (:%l x8632::fn))
1008	((:not (:pred = x8632::arg_z
1009	(:apply %hard-regspec-value val)))
1010	(movl (:%l x8632::arg_z) (:%l val)))
1011	(jmp lab))
1012
1013
1014	(define-x8632-vinsn add-constant (((dest :imm))
1015	((dest :imm)
1016	(const :s32const)))
1017	((:and (:pred >= const -128) (:pred <= const 127))
1018	(addl (:$b const) (:%l dest)))
1019	((:not (:and (:pred >= const -128) (:pred <= const 127)))
1020	(addl (:$l const) (:%l dest))))
1021
1022	(define-x8632-vinsn add-constant3 (((dest :imm))
1023	((src :imm)
1024	(const :s32const)))
1025	((:pred = (:apply %hard-regspec-value dest)
1026	(:apply %hard-regspec-value src))
1027	((:and (:pred >= const -128) (:pred <= const 127))
1028	(addl (:$b const) (:%l dest)))
1029	((:not (:and (:pred >= const -128) (:pred <= const 127)))
1030	(addl (:$l const) (:%l dest))))
1031	((:not (:pred = (:apply %hard-regspec-value dest)
1032	(:apply %hard-regspec-value src)))
1033	(leal (:@ const (:%l src)) (:%l dest))))
1034
1035	(define-x8632-vinsn fixnum-add2 (((dest :imm))
1036	((dest :imm)
1037	(other :imm)))
1038	(addl (:%l other) (:%l dest)))
1039
1040	(define-x8632-vinsn fixnum-sub2 (((dest :imm))
1041	((x :imm)
1042	(y :imm))
1043	((temp :imm)))
1044	(movl (:%l x) (:%l temp))
1045	(subl (:%l y) (:%l temp))
1046	(movl (:%l temp) (:%l dest)))
1047
1048	(define-x8632-vinsn fixnum-add3 (((dest :imm))
1049	((x :imm)
1050	(y :imm)))
1051
1052	((:pred =
1053	(:apply %hard-regspec-value x)
1054	(:apply %hard-regspec-value dest))
1055	(addl (:%l y) (:%l dest)))
1056	((:not (:pred =
1057	(:apply %hard-regspec-value x)
1058	(:apply %hard-regspec-value dest)))
1059	((:pred =
1060	(:apply %hard-regspec-value y)
1061	(:apply %hard-regspec-value dest))
1062	(addl (:%l x) (:%l dest)))
1063	((:not (:pred =
1064	(:apply %hard-regspec-value y)
1065	(:apply %hard-regspec-value dest)))
1066	(leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1067
1068	(define-x8632-vinsn copy-gpr (((dest t))
1069	((src t)))
1070	((:not (:pred =
1071	(:apply %hard-regspec-value dest)
1072	(:apply %hard-regspec-value src)))
1073	(movl (:%l src) (:%l dest))))
1074
1075	(define-x8632-vinsn (vpop-register :pop :node :vsp)
1076	(((dest :lisp))
1077	())
1078	(popl (:%l dest)))
1079
1080	(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1081	())
1082	(rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1083	(jb :done)
1084	(je :one)
1085	(pushl (:%l x8632::arg_y))
1086	:one
1087	(pushl (:%l x8632::arg_z))
1088	:done)
1089
1090	(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1091	((max :u32const)))
1092	((:pred >= max 2)
1093	(rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1094	(jb :done)
1095	(je :one)
1096	(pushl (:%l x8632::arg_y))
1097	:one
1098	(pushl (:%l x8632::arg_z))
1099	:done)
1100	((:pred = max 1)
1101	(testw (:%w x8632::nargs) (:%w x8632::nargs))
1102	(je :done)
1103	(pushl (:%l x8632::arg_z))
1104	:done))
1105
1106	(define-x8632-vinsn (call-label :call) (()
1107	((label :label))
1108	((entry (:label 1))))
1109	(:talign 5)
1110	(call label)
1111	(movl (:$self 0) (:%l x8632::fn)))
1112
1113	(define-x8632-vinsn double-float-compare (()
1114	((arg0 :double-float)
1115	(arg1 :double-float)))
1116	(comisd (:%xmm arg1) (:%xmm arg0)))
1117
1118	(define-x8632-vinsn single-float-compare (()
1119	((arg0 :single-float)
1120	(arg1 :single-float)))
1121	(comiss (:%xmm arg1) (:%xmm arg0)))
1122
1123	(define-x8632-vinsn double-float+-2 (((result :double-float))
1124	((x :double-float)
1125	(y :double-float)))
1126	((:pred =
1127	(:apply %hard-regspec-value result)
1128	(:apply %hard-regspec-value x))
1129	(addsd (:%xmm y) (:%xmm result)))
1130	((:and (:not (:pred =
1131	(:apply %hard-regspec-value result)
1132	(:apply %hard-regspec-value x)))
1133	(:pred =
1134	(:apply %hard-regspec-value result)
1135	(:apply %hard-regspec-value y)))
1136	(addsd (:%xmm x) (:%xmm result)))
1137	((:and (:not (:pred =
1138	(:apply %hard-regspec-value result)
1139	(:apply %hard-regspec-value x)))
1140	(:not (:pred =
1141	(:apply %hard-regspec-value result)
1142	(:apply %hard-regspec-value y))))
1143	(movsd (:%xmm x) (:%xmm result))
1144	(addsd (:%xmm y) (:%xmm result))))
1145
1146	;;; Caller guarantees (not (eq y result))
1147	(define-x8632-vinsn double-float--2 (((result :double-float))
1148	((x :double-float)
1149	(y :double-float)))
1150	((:not (:pred = (:apply %hard-regspec-value result)
1151	(:apply %hard-regspec-value x)))
1152	(movsd (:%xmm x) (:%xmm result)))
1153	(subsd (:%xmm y) (:%xmm result)))
1154
1155	(define-x8632-vinsn double-float*-2 (((result :double-float))
1156	((x :double-float)
1157	(y :double-float)))
1158	((:pred =
1159	(:apply %hard-regspec-value result)
1160	(:apply %hard-regspec-value x))
1161	(mulsd (:%xmm y) (:%xmm result)))
1162	((:and (:not (:pred =
1163	(:apply %hard-regspec-value result)
1164	(:apply %hard-regspec-value x)))
1165	(:pred =
1166	(:apply %hard-regspec-value result)
1167	(:apply %hard-regspec-value y)))
1168	(mulsd (:%xmm x) (:%xmm result)))
1169	((:and (:not (:pred =
1170	(:apply %hard-regspec-value result)
1171	(:apply %hard-regspec-value x)))
1172	(:not (:pred =
1173	(:apply %hard-regspec-value result)
1174	(:apply %hard-regspec-value y))))
1175	(movsd (:%xmm x) (:%xmm result))
1176	(mulsd (:%xmm y) (:%xmm result))))
1177
1178	;;; Caller guarantees (not (eq y result))
1179	(define-x8632-vinsn double-float/-2 (((result :double-float))
1180	((x :double-float)
1181	(y :double-float)))
1182	((:not (:pred = (:apply %hard-regspec-value result)
1183	(:apply %hard-regspec-value x)))
1184	(movsd (:%xmm x) (:%xmm result)))
1185	(divsd (:%xmm y) (:%xmm result)))
1186
1187	(define-x8632-vinsn single-float+-2 (((result :single-float))
1188	((x :single-float)
1189	(y :single-float)))
1190	((:pred =
1191	(:apply %hard-regspec-value result)
1192	(:apply %hard-regspec-value x))
1193	(addss (:%xmm y) (:%xmm result)))
1194	((:and (:not (:pred =
1195	(:apply %hard-regspec-value result)
1196	(:apply %hard-regspec-value x)))
1197	(:pred =
1198	(:apply %hard-regspec-value result)
1199	(:apply %hard-regspec-value y)))
1200	(addss (:%xmm x) (:%xmm result)))
1201	((:and (:not (:pred =
1202	(:apply %hard-regspec-value result)
1203	(:apply %hard-regspec-value x)))
1204	(:not (:pred =
1205	(:apply %hard-regspec-value result)
1206	(:apply %hard-regspec-value y))))
1207	(movss (:%xmm x) (:%xmm result))
1208	(addss (:%xmm y) (:%xmm result))))
1209
1210	;;; Caller guarantees (not (eq y result))
1211	(define-x8632-vinsn single-float--2 (((result :single-float))
1212	((x :single-float)
1213	(y :single-float)))
1214	((:not (:pred = (:apply %hard-regspec-value result)
1215	(:apply %hard-regspec-value x)))
1216	(movss (:%xmm x) (:%xmm result)))
1217	(subss (:%xmm y) (:%xmm result)))
1218
1219	(define-x8632-vinsn single-float*-2 (((result :single-float))
1220	((x :single-float)
1221	(y :single-float)))
1222	((:pred =
1223	(:apply %hard-regspec-value result)
1224	(:apply %hard-regspec-value x))
1225	(mulss (:%xmm y) (:%xmm result)))
1226	((:and (:not (:pred =
1227	(:apply %hard-regspec-value result)
1228	(:apply %hard-regspec-value x)))
1229	(:pred =
1230	(:apply %hard-regspec-value result)
1231	(:apply %hard-regspec-value y)))
1232	(mulss (:%xmm x) (:%xmm result)))
1233	((:and (:not (:pred =
1234	(:apply %hard-regspec-value result)
1235	(:apply %hard-regspec-value x)))
1236	(:not (:pred =
1237	(:apply %hard-regspec-value result)
1238	(:apply %hard-regspec-value y))))
1239	(movss (:%xmm x) (:%xmm result))
1240	(mulss (:%xmm y) (:%xmm result))))
1241
1242	;;; Caller guarantees (not (eq y result))
1243	(define-x8632-vinsn single-float/-2 (((result :single-float))
1244	((x :single-float)
1245	(y :single-float)))
1246	((:not (:pred = (:apply %hard-regspec-value result)
1247	(:apply %hard-regspec-value x)))
1248	(movss (:%xmm x) (:%xmm result)))
1249	(divss (:%xmm y) (:%xmm result)))
1250
1251	(define-x8632-vinsn get-single (((result :single-float))
1252	((source :lisp)))
1253	(movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1254
1255	(define-x8632-vinsn get-double (((result :double-float))
1256	((source :lisp)))
1257	(movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1258
1259	;;; Extract a double-float value, typechecking in the process.
1260	;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1261	;;; instead of replicating it ..
1262	;;; get-double?
1263
1264	(define-x8632-vinsn copy-single-float (((dest :single-float))
1265	((src :single-float)))
1266	(movss (:%xmm src) (:%xmm dest)))
1267
1268	(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1269	((src :single-float)))
1270	(cvtss2sd (:%xmm src) (:%xmm dest)))
1271
1272	(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1273	((src :double-float)))
1274	(cvtsd2ss (:%xmm src) (:%xmm dest)))
1275
1276	(define-x8632-vinsn fitvals (()
1277	((n :u16const))
1278	((imm :u16)))
1279	((:pred = n 0)
1280	(xorl (:%l imm) (:%l imm)))
1281	((:not (:pred = n 0))
1282	(movw (:$w (:apply ash n x8632::fixnumshift)) (:%w imm)))
1283	(subw (:%w x8632::nargs) (:%w imm))
1284	(jae :push-more)
1285	(movswl (:%w imm) (:%l imm))
1286	(subl (:%l imm) (:%l x8632::esp))
1287	(jmp :done)
1288	:push-loop
1289	(pushl (:$l x8632::nil-value))
1290	(addw (:$b x8632::node-size) (:%w x8632::nargs))
1291	(subw (:$b x8632::node-size) (:%w imm))
1292	:push-more
1293	(jne :push-loop)
1294	:done)
1295
1296	(define-x8632-vinsn (nvalret :jumpLR) (()
1297	())
1298	(jmp (:@ .SPnvalret)))
1299
1300	(define-x8632-vinsn lisp-word-ref (((dest t))
1301	((base t)
1302	(offset t)))
1303	(movl (:@ (:%l base) (:%l offset)) (:%l dest)))
1304
1305	(define-x8632-vinsn lisp-word-ref-c (((dest t))
1306	((base t)
1307	(offset :s32const)))
1308	((:pred = offset 0)
1309	(movl (:@ (:%l base)) (:%l dest)))
1310	((:not (:pred = offset 0))
1311	(movl (:@ offset (:%l base)) (:%l dest))))
1312
1313	;; start-mv-call
1314
1315	;; xxx check this
1316	(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1317	((label :label)))
1318	(leal (:@ (:^ label) (:%l x8632::fn)) (:%l x8632::ra0))
1319	(pushl (:%l x8632::ra0)))
1320
1321	;; ????
1322	(define-x8632-vinsn emit-aligned-label (()
1323	((label :label)))
1324	(:align 3)
1325	(:long (:^ label)))
1326
1327	;; pass-multiple-values-symbol
1328	;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1329	(define-x8632-vinsn pass-multiple-values-symbol (()
1330	())
1331	(pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr))))
1332	(jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1333
1334
1335	;; pass-multiple-values
1336
1337	(define-x8632-vinsn reserve-outgoing-frame (()
1338	())
1339	(pushl (:$b x8632::reserved-frame-marker))
1340	(pushl (:$b x8632::reserved-frame-marker)))
1341
1342	;; implicit temp0 arg
1343	(define-x8632-vinsn (call-known-function :call) (()
1344	()
1345	((entry (:label 1))))
1346	(:talign 5)
1347	(call (:%l x8632::temp0))
1348	(movl (:$self 0) (:%l x8632::fn)))
1349
1350	(define-x8632-vinsn (jump-known-function :jumplr) (()
1351	())
1352	(movl (:%l x8632::fn) (:%l x8632::xfn))
1353	(movl (:%l x8632::temp0) (:%l x8632::fn))
1354	(jmp (:%l x8632::fn)))
1355
1356	(define-x8632-vinsn (list :call) (()
1357	()
1358	((entry (:label 1))))
1359	(leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1360	(:talign 5)
1361	(call (:@ .SPconslist))
1362	:back
1363	(movl (:$self 0) (:%l x8632::fn)))
1364
1365	(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1366	((car :lisp) (cdr :lisp))
1367	((temp :imm)))
1368	(subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1369	(movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1370	(movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1371	(movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1372	(movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1373	(movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1374	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1375	(leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1376	(movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1377	(movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1378	(movl (:%l temp) (:%l dest)))
1379
1380
1381	;; make-fixed-stack-gvector
1382
1383	(define-x8632-vinsn discard-temp-frame (()
1384	()
1385	((temp :imm)))
1386	(movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1387	(movl (:@ (:%l temp)) (:%l temp))
1388	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1389	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1390	)
1391
1392	(define-x8632-vinsn discard-c-frame (()
1393	()
1394	((temp :imm)))
1395	(movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1396	(movl (:@ (:%l temp)) (:%l temp))
1397	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1398
1399
1400	(define-x8632-vinsn vstack-discard (()
1401	((nwords :u32const)))
1402	((:not (:pred = nwords 0))
1403	((:pred < nwords 16)
1404	(addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1405	((:not (:pred < nwords 16))
1406	(addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1407
1408	(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1409	`(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1410	(leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1411	(:talign 5)
1412	(jmp (:@ ,spno))
1413	:back
1414	(movl (:$self 0) (:%l x8632::fn))))
1415
1416	(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1417	`(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1418	(:talign 5)
1419	(call (:@ ,spno))
1420	:back
1421	(movl (:$self 0) (:%l x8632::fn))))
1422
1423	(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1424	`(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ())
1425	(jmp (:@ ,spno))))
1426
1427	(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1428	((lab :label)))
1429	(leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1430	(jmp (:@ .SPnthrowvalues)))
1431
1432	(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1433	((lab :label)))
1434	(leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1435	(jmp (:@ .SPnthrow1value)))
1436
1437	(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1438
1439	(define-x8632-vinsn bind-interrupt-level-0-inline (()
1440	()
1441	((temp :imm)))
1442	(movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1443	(cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1444	(pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1445	(pushl (:$b x8632::interrupt-level-binding-index))
1446	(pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1447	(movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1448	(movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1449	(jns.pt :done)
1450	(btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1451	(jae.pt :done)
1452	(ud2a)
1453	(:byte 2)
1454	:done)
1455
1456	(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1457
1458	(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1459
1460	(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1461
1462	(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1463
1464	(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1465
1466	(define-x8632-vinsn set-eq-bit (()
1467	())
1468	(testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1469
1470	;;; %schar8
1471	;;; %schar32
1472	;;; %set-schar8
1473	;;; %set-schar32
1474
1475	(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1476	((v :lisp)
1477	(idx :u32const)))
1478	(movsd (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1479
1480	(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1481	((header :lisp)))
1482	(movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1483
1484
1485	(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1486
1487	(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1488
1489	(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1490	((addr :s32const)))
1491	(movzbl (:@ addr) (:%l dest)))
1492
1493	(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1494	((addr :s32const)))
1495	(movsbl (:@ addr) (:%l dest)))
1496
1497	(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1498	((addr :s32const)))
1499	(movzwl (:@ addr) (:%l dest)))
1500
1501	(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1502	((addr :s32const)))
1503	(movswl (:@ addr) (:%l dest)))
1504
1505	(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
1506	((addr :s32const)))
1507	(movl (:@ addr) (:%l dest)))
1508
1509	(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
1510	((addr :s32const)))
1511	(movl (:@ addr) (:%l dest)))
1512
1513	(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
1514	((addr :s32const)))
1515	(movl (:@ addr) (:%l dest)))
1516
1517	(define-x8632-vinsn event-poll (()
1518	())
1519	(btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1520	(jae :no-interrupt)
1521	(ud2a)
1522	(:byte 2)
1523	:no-interrupt)
1524
1525	;;; check-2d-bound
1526	;;; check-3d-bound
1527
1528	(define-x8632-vinsn 2d-dim1 (((dest :u32))
1529	((header :lisp)))
1530	(movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
1531	(:%l header)) (:%l dest))
1532	(sarl (:$ub x8632::fixnumshift) (:%l dest)))
1533
1534	;;; 3d-dims
1535
1536	;;; xxx
1537	(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
1538	(dim1 :u32))
1539	((dim1 :u32)
1540	(i :imm)
1541	(j :imm)))
1542
1543	(imull (:%l i) (:%l dim1))
1544	(leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
1545
1546	;;; 3d-unscaled-index
1547
1548	(define-x8632-vinsn branch-unless-both-args-fixnums (()
1549	((a :lisp)
1550	(b :lisp)
1551	(dest :label))
1552	((tag :u8)))
1553	(movl (:%l a) (:%l tag))
1554	(orl (:%l b) (:%l tag))
1555	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1556	(testb (:$b x8632::fixnummask) (:%accb tag)))
1557	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1558	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1559	(testb (:$b x8632::fixnummask) (:%b tag)))
1560	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
1561	(testl (:$l x8632::fixnummask) (:%l tag)))
1562	(jne dest))
1563
1564	(define-x8632-vinsn branch-unless-arg-fixnum (()
1565	((a :lisp)
1566	(dest :label)))
1567	((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
1568	(testb (:$b x8632::fixnummask) (:%b a)))
1569	((:pred > (:apply %hard-regspec-value a) x8632::ebx)
1570	(testl (:$l x8632::fixnummask) (:%l a)))
1571	(jne dest))
1572
1573	(define-x8632-vinsn fixnum->single-float (((f :single-float))
1574	((arg :lisp))
1575	((unboxed :s32)))
1576	(movl (:%l arg) (:%l unboxed))
1577	(sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1578	(cvtsi2ssl (:%l unboxed) (:%xmm f)))
1579
1580	(define-x8632-vinsn fixnum->double-float (((f :double-float))
1581	((arg :lisp))
1582	((unboxed :s32)))
1583	(movl (:%l arg) (:%l unboxed))
1584	(sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1585	(cvtsi2sdl (:%l unboxed) (:%xmm f)))
1586
1587	(define-x8632-vinsn xchg-registers (()
1588	((a t)
1589	(b t)))
1590	(xchgl (:%l a) (:%l b)))
1591
1592	(define-x8632-vinsn establish-fn (()
1593	())
1594	(movl (:$self 0) (:%l x8632::fn)))
1595
1596
1597	(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
1598
1599	(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
1600
1601
1602	(define-x8632-vinsn character->code (((dest :u32))
1603	((src :lisp)))
1604	(movl (:%l src) (:%l dest))
1605	(sarl (:$ub x8632::charcode-shift) (:%l dest)))
1606
1607	(define-x8632-vinsn adjust-vsp (()
1608	((amount :s32const)))
1609	((:and (:pred >= amount -128) (:pred <= amount 127))
1610	(addl (:$b amount) (:%l x8632::esp)))
1611	((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
1612	(addl (:$l amount) (:%l x8632::esp))))
1613
1614
1615	(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
1616	((spno :s32const)
1617	(y t)
1618	(z t))
1619	((entry (:label 1))))
1620	(:talign 5)
1621	(call (:@ spno))
1622	(movl (:$self 0) (:%l x8632::fn)))
1623
1624	(define-x8632-vinsn zero-double-float-register (((dest :double-float))
1625	())
1626	(movsd (:%xmm x8632::fpzero) (:%xmm dest)))
1627
1628	(define-x8632-vinsn zero-single-float-register (((dest :single-float))
1629	())
1630	(movss (:%xmm x8632::fpzero) (:%xmm dest)))
1631
1632	(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
1633
1634	(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
1635	((src :lisp))
1636	((temp :u32)))
1637	(movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
1638	((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
1639	(:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
1640	(movb (:$b 0) (:%b temp)))
1641	((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
1642	(andl (:$l #xffffff00) (:%l temp)))
1643	(movl (:%l temp) (:%l dest))
1644	(shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l dest)))
1645
1646
1647
1648	(define-x8632-vinsn %logior2 (((dest :imm))
1649	((x :imm)
1650	(y :imm)))
1651	((:pred =
1652	(:apply %hard-regspec-value x)
1653	(:apply %hard-regspec-value dest))
1654	(orl (:%l y) (:%l dest)))
1655	((:not (:pred =
1656	(:apply %hard-regspec-value x)
1657	(:apply %hard-regspec-value dest)))
1658	((:pred =
1659	(:apply %hard-regspec-value y)
1660	(:apply %hard-regspec-value dest))
1661	(orl (:%l x) (:%l dest)))
1662	((:not (:pred =
1663	(:apply %hard-regspec-value y)
1664	(:apply %hard-regspec-value dest)))
1665	(movl (:%l x) (:%l dest))
1666	(orl (:%l y) (:%l dest)))))
1667
1668	(define-x8632-vinsn %logand2 (((dest :imm))
1669	((x :imm)
1670	(y :imm)))
1671	((:pred =
1672	(:apply %hard-regspec-value x)
1673	(:apply %hard-regspec-value dest))
1674	(andl (:%l y) (:%l dest)))
1675	((:not (:pred =
1676	(:apply %hard-regspec-value x)
1677	(:apply %hard-regspec-value dest)))
1678	((:pred =
1679	(:apply %hard-regspec-value y)
1680	(:apply %hard-regspec-value dest))
1681	(andl (:%l x) (:%l dest)))
1682	((:not (:pred =
1683	(:apply %hard-regspec-value y)
1684	(:apply %hard-regspec-value dest)))
1685	(movl (:%l x) (:%l dest))
1686	(andl (:%l y) (:%l dest)))))
1687
1688	(define-x8632-vinsn %logxor2 (((dest :imm))
1689	((x :imm)
1690	(y :imm)))
1691	((:pred =
1692	(:apply %hard-regspec-value x)
1693	(:apply %hard-regspec-value dest))
1694	(xorl (:%l y) (:%l dest)))
1695	((:not (:pred =
1696	(:apply %hard-regspec-value x)
1697	(:apply %hard-regspec-value dest)))
1698	((:pred =
1699	(:apply %hard-regspec-value y)
1700	(:apply %hard-regspec-value dest))
1701	(xorl (:%l x) (:%l dest)))
1702	((:not (:pred =
1703	(:apply %hard-regspec-value y)
1704	(:apply %hard-regspec-value dest)))
1705	(movl (:%l x) (:%l dest))
1706	(xorl (:%l y) (:%l dest)))))
1707
1708	(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
1709
1710	(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
1711
1712	(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
1713
1714	(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
1715
1716	(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
1717
1718	(define-x8632-vinsn setup-double-float-allocation (()
1719	())
1720	(movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
1721	(movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8664::imm1.l)))
1722
1723	(define-x8632-vinsn set-double-float-value (()
1724	((node :lisp)
1725	(val :double-float)))
1726	(movsd (:%xmm val) (:@ x8664::double-float.value (:%l node))))
1727
1728	(define-x8632-vinsn %natural+ (((result :u32))
1729	((result :u32)
1730	(other :u32)))
1731	(addl (:%l other) (:%l result)))
1732
1733	(define-x8632-vinsn %natural+-c (((result :u32))
1734	((result :u32)
1735	(constant :s32const)))
1736	(addl (:$l constant) (:%l result)))
1737
1738	(define-x8632-vinsn %natural- (((result :u32))
1739	((result :u32)
1740	(other :u32)))
1741	(subl (:%l other) (:%l result)))
1742
1743	(define-x8632-vinsn %natural--c (((result :u32))
1744	((result :u32)
1745	(constant :s32const)))
1746	(subl (:$l constant) (:%l result)))
1747
1748	(define-x8632-vinsn %natural-logior (((result :u32))
1749	((result :u32)
1750	(other :u32)))
1751	(orl (:%l other) (:%l result)))
1752
1753	(define-x8632-vinsn %natural-logior-c (((result :u32))
1754	((result :u32)
1755	(constant :s32const)))
1756	(orl (:$l constant) (:%l result)))
1757
1758	(define-x8632-vinsn %natural-logand (((result :u32))
1759	((result :u32)
1760	(other :u32)))
1761	(andl (:%l other) (:%l result)))
1762
1763	(define-x8632-vinsn %natural-logand-c (((result :u32))
1764	((result :u32)
1765	(constant :s32const)))
1766	(andl (:$l constant) (:%l result)))
1767
1768	(define-x8632-vinsn %natural-logxor (((result :u32))
1769	((result :u32)
1770	(other :u32)))
1771	(xorl (:%l other) (:%l result)))
1772
1773	(define-x8632-vinsn %natural-logxor-c (((result :u32))
1774	((result :u32)
1775	(constant :s32const)))
1776	(xorl (:$l constant) (:%l result)))
1777
1778	(define-x8632-vinsn natural-shift-left (((dest :u32))
1779	((dest :u32)
1780	(amt :u8const)))
1781	(shll (:$ub amt) (:%l dest)))
1782
1783	(define-x8632-vinsn natural-shift-right (((dest :u32))
1784	((dest :u32)
1785	(amt :u8const)))
1786	(shrl (:$ub amt) (:%l dest)))
1787
1788	(define-x8632-vinsn recover-fn (()
1789	())
1790	(movl (:$self 0) (:%l x8632::fn)))
1791
1792	;;; xxx probably wrong
1793	(define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
1794	((spno :s32const)
1795	(x t)
1796	(y t)
1797	(z t))
1798	((entry (:label 1))))
1799	(:talign 5)
1800	(call (:@ spno))
1801	(movl (:$self 0) (:%l x8632::fn)))
1802
1803	(queue-fixup
1804	(fixup-x86-vinsn-templates
1805	x8632-vinsn-templates
1806	x86::x86-opcode-template-lists))
1807

Note: See TracBrowser for help on using the repository browser.

Download in other formats: