Context Navigation

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

Visit:

Last change on this file since 7428 was 7428, checked in by rme, 13 years ago
Implement assorted additional vinsns.
File size: 89.1 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	(define-x8632-vinsn scale-32bit-misc-index (((dest :u32))
16	((idx :imm) ; A fixnum
17	)
18	())
19	(movl (:%l idx) (:%l dest)))
20
21	(define-x8632-vinsn scale-16bit-misc-index (((dest :u32))
22	((idx :imm))) ; A fixnum
23	(movl (:%l idx) (:%l dest))
24	(shrl (:$ub 1) (:%l dest)))
25
26	(define-x8632-vinsn scale-8bit-misc-index (((dest :u32))
27	((idx :imm))) ; A fixnum
28	(movl (:%l idx) (:%l dest))
29	(shrl (:$ub 2) (:%l dest)))
30
31	(define-x8632-vinsn misc-ref-u32 (((dest :u32))
32	((v :lisp)
33	(scaled-idx :u32)))
34	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
35
36	(define-x8632-vinsn misc-ref-double-float (((dest :double-float))
37	((v :lisp)
38	(scaled-idx :imm)))
39	(movsd (:@ x8632::misc-dfloat-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
40
41	(define-x8632-vinsn misc-ref-c-double-float (((dest :double-float))
42	((v :lisp)
43	(idx :s32const)))
44	(movsd (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
45
46	(define-x8632-vinsn misc-ref-node (((dest :lisp))
47	((v :lisp)
48	(scaled-idx :imm)))
49	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
50
51	(define-x8632-vinsn (push-misc-ref-node :push :node :vsp) (()
52	((v :lisp)
53	(scaled-idx :imm)))
54	(pushl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
55
56	(define-x8632-vinsn misc-set-node (()
57	((val :lisp)
58	(v :lisp)
59	(unscaled-idx :imm))
60	())
61	(movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
62
63	(define-x8632-vinsn misc-set-immediate-node (()
64	((val :s32const)
65	(v :lisp)
66	(unscaled-idx :imm))
67	())
68	(movl (:$l val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
69
70	(define-x8632-vinsn misc-set-double-float (()
71	((val :double-float)
72	(v :lisp)
73	(unscaled-idx :imm))
74	())
75	(movsd (:%xmm val) (:@ x8632::misc-data-offset (:%l v) (:%l unscaled-idx))))
76
77	(define-x8632-vinsn misc-ref-u8 (((dest :u8))
78	((v :lisp)
79	(scaled-idx :s32)))
80	(movzbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
81
82	(define-x8632-vinsn misc-ref-s8 (((dest :s8))
83	((v :lisp)
84	(scaled-idx :s32)))
85	(movsbl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
86
87	(define-x8632-vinsn misc-ref-u16 (((dest :u16))
88	((v :lisp)
89	(scaled-idx :s32)))
90	(movzwl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
91
92	(define-x8632-vinsn misc-ref-u32 (((dest :u32))
93	((v :lisp)
94	(scaled-idx :s32)))
95	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
96
97	(define-x8632-vinsn misc-ref-single-float (((dest :single-float))
98	((v :lisp)
99	(scaled-idx :s32)))
100	(movss (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%xmm dest)))
101
102	(define-x8632-vinsn misc-ref-s32 (((dest :s32))
103	((v :lisp)
104	(scaled-idx :s32)))
105	(movl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
106
107	(define-x8632-vinsn misc-ref-s16 (((dest :s16))
108	((v :lisp)
109	(scaled-idx :s32)))
110	(movswl (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx)) (:%l dest)))
111
112	(define-x8632-vinsn misc-ref-c-node (((dest :lisp))
113	((v :lisp)
114	(idx :u32const)) ; sic
115	())
116	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
117
118	(define-x8632-vinsn (push-misc-ref-c-node :push :node :vsp)
119	(()
120	((v :lisp)
121	(idx :u32const)) ; sic
122	())
123	(pushl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v))))
124
125	(define-x8632-vinsn misc-ref-c-u32 (((dest :u32))
126	((v :lisp)
127	(idx :u32const)) ; sic
128	())
129	;; xxx - should the 2 be x8632::word-shift?
130	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v)) (:%l dest)))
131
132	(define-x8632-vinsn misc-ref-c-s32 (((dest :s32))
133	((v :lisp)
134	(idx :s32const)) ; sic
135	())
136	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%l dest)))
137
138	(define-x8632-vinsn misc-ref-c-single-float (((dest :single-float))
139	((v :lisp)
140	(idx :s32const)) ; sic
141	())
142	(movss (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
143
144	(define-x8632-vinsn misc-ref-c-u8 (((dest :u32))
145	((v :lisp)
146	(idx :s32const)) ; sic
147	())
148	(movzbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
149
150	(define-x8632-vinsn misc-ref-c-s8 (((dest :s32))
151	((v :lisp)
152	(idx :s32const)) ; sic
153	())
154	(movsbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
155
156	(define-x8632-vinsn misc-set-c-node (()
157	((val :lisp)
158	(v :lisp)
159	(idx :s32const)))
160	(movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
161
162	(define-x8632-vinsn misc-set-immediate-c-node (()
163	((val :s32const)
164	(v :lisp)
165	(idx :s32const)))
166	(movl (:$l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
167
168	;;; xxx don't know if this is right
169	(define-x8632-vinsn set-closure-forward-reference (()
170	((val :lisp)
171	(closure :lisp)
172	(idx :s32const)))
173	(movl (:%l val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx x8632::word-shift)) (:%l closure))))
174
175	(define-x8632-vinsn misc-set-c-double-float (()
176	((val :double-float)
177	(v :lisp)
178	(idx :s32const)))
179	(movsd (:%xmm val) (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v))))
180
181	(define-x8632-vinsn (call-known-symbol :call) (((result (:lisp x8632::arg_z)))
182	()
183	((entry (:label 1))))
184	(:talign x8632::fulltag-tra)
185	(call (:@ x8632::symbol.fcell (:% x8632::fname)))
186	(movl (:$self 0) (:%l x8632::fn)))
187
188	(define-x8632-vinsn (jump-known-symbol :jumplr) (()
189	())
190
191	(jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
192
193	(define-x8632-vinsn set-nargs (()
194	((n :s16const)))
195	((:pred = n 0)
196	(xorw (:%w x8632::nargs ) (:%w x8632::nargs )))
197	((:not (:pred = n 0))
198	(movw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs ))))
199
200	(define-x8632-vinsn check-exact-nargs (()
201	((n :u16const)))
202	((:pred = n 0)
203	(testw (:%w x8632::nargs) (:%w x8632::nargs)))
204	((:not (:pred = n 0))
205	(cmpw (:$w (:apply ash n x8632::fixnum-shift)) (:%w x8632::nargs)))
206	(jz.pt :ok)
207	(uuo-error-wrong-number-of-args)
208	:ok)
209
210	(define-x8632-vinsn check-min-nargs (()
211	((n :u16const)))
212	(rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
213	(jae.pt :ok)
214	(uuo-error-too-few-args)
215	:ok)
216
217	(define-x8632-vinsn check-max-nargs (()
218	((n :u16const)))
219	(rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::fixnum-shift)))
220	(jbe.pt :ok)
221	(uuo-error-too-many-args)
222	:ok)
223
224	(define-x8632-vinsn default-1-arg (()
225	((min :u16const)))
226	(rcmpw (:%w x8632::nargs) (:$w (:apply ash min x8632::word-shift)))
227	(jne :done)
228	((:pred >= min 2)
229	(pushl (:%l x8632::arg_y)))
230	((:pred >= min 1)
231	(movl (:%l x8632::arg_z) (:%l x8632::arg_y)))
232	(movl (:$l x8632::nil-value) (:%l x8632::arg_z))
233	:done)
234
235	(define-x8632-vinsn default-2-args (()
236	((min :u16const)))
237	(rcmpw (:%w x8632::nargs ) (:$w (:apply ash (:apply 1+ min) x8632::word-shift)))
238	(ja :done)
239	(je :one)
240	;; We got "min" args; arg_y & arg_z default to nil
241	((:pred >= min 2)
242	(pushl (:%l x8632::arg_y)))
243	((:pred >= min 1)
244	(pushl (:%l x8632::arg_z)))
245	(movl (:$l x8632::nil-value) (:%l x8632::arg_y))
246	(jmp :last)
247	:one
248	;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
249	((:pred >= min 1)
250	(pushl (:%l x8632::arg_y)))
251	(movl (:%l x8632::arg_z) (:%l x8632::arg_y))
252	:last
253	(movl (:$l x8632::nil-value) (:%l x8632::arg_z))
254	:done)
255
256	(define-x8632-vinsn default-optionals (()
257	((n :u16const))
258	((temp :u32)))
259	(rcmpw (:%w x8632::nargs) (:$w (:apply ash n x8632::word-shift)))
260	(movw (:%w x8632::nargs) (:%w temp))
261	(jae :done)
262	:loop
263	(addw (:$w x8632::fixnumone) (:%w temp))
264	(cmpw (:$w (:apply ash n x8632::word-shift)) (:%w temp))
265	(pushl (:$l x8632::nil-value))
266	(jne :loop)
267	:done)
268
269	(define-x8632-vinsn save-lisp-context-no-stack-args (()
270	())
271	(pushl (:%l x8632::ebp))
272	(movl (:%l x8632::esp) (:%l x8632::ebp)))
273
274	(define-x8632-vinsn save-lisp-context-offset (()
275	((nbytes-pushed :s32const)))
276	(movl (:%l x8632::ebp) (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)))
277	(leal (:@ (:apply + nbytes-pushed x8632::node-size) (:%l x8632::esp)) (:%l x8632::ebp))
278	(popl (:@ x8632::node-size (:%l x8632::ebp))))
279
280	(define-x8632-vinsn save-lisp-context-variable-arg-count (()
281	()
282	((temp :u32)))
283	(movzwl (:%w x8632::nargs) (:%l temp))
284	(subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
285	(jle :push)
286	(movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
287	(leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
288	(popl (:@ x8632::node-size (:%l x8632::ebp)))
289	(jmp :done)
290	:push
291	(pushl (:%l x8632::ebp))
292	(movl (:%l x8632::esp) (:%l x8632::ebp))
293	:done)
294
295	;;; We know that some args were pushed, but don't know how many were
296	;;; passed.
297	(define-x8632-vinsn save-lisp-context-in-frame (()
298	()
299	((temp :u32)))
300	(movzwl (:%w x8632::nargs) (:%l temp))
301	(subl (:$b (* $numx8632argregs x8632::node-size)) (:%l temp))
302	(movl (:%l x8632::ebp) (:@ x8632::node-size (:%l x8632::esp) (:%l temp)))
303	(leal (:@ x8632::node-size (:%l x8632::esp) (:%l temp)) (:%l x8632::ebp))
304	(popl (:@ x8632::node-size (:%l x8632::ebp))))
305
306	(define-x8632-vinsn (vpush-register :push :node :vsp)
307	(()
308	((reg :lisp)))
309	(pushl (:% reg)))
310
311	(define-x8632-vinsn (vpush-fixnum :push :node :vsp)
312	(()
313	((const :s32const)))
314	((:and (:pred < const 128) (:pred >= const -128))
315	(pushl (:$b const)))
316	((:not (:and (:pred < const 128) (:pred >= const -128)))
317	(pushl (:$l const))))
318
319	(define-x8632-vinsn vframe-load (((dest :lisp))
320	((frame-offset :u16const)
321	(cur-vsp :u16const)))
322	(movl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
323
324	(define-x8632-vinsn compare-vframe-offset-to-nil (()
325	((frame-offset :u16const)
326	(cur-vsp :u16const)))
327	(cmpl (:$l x8632::nil-value) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
328
329	(define-x8632-vinsn compare-value-cell-to-nil (()
330	((vcell :lisp)))
331	(cmpl (:$l x8632::nil-value) (:@ x8632::value-cell.value (:%l vcell))))
332
333	(define-x8632-vinsn lcell-load (((dest :lisp))
334	((cell :lcell)
335	(top :lcell)))
336	(movl (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp)) (:%l dest)))
337
338	(define-x8632-vinsn (vframe-push :push :node :vsp)
339	(()
340	((frame-offset :u16const)
341	(cur-vsp :u16const)))
342	(pushl (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
343
344	(define-x8632-vinsn vframe-store (()
345	((src :lisp)
346	(frame-offset :u16const)
347	(cur-vsp :u16const)))
348	(movl (:%l src) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
349
350	(define-x8632-vinsn lcell-store (()
351	((src :lisp)
352	(cell :lcell)
353	(top :lcell)))
354	(movl (:%l src) (:@ (:apply - (:apply + (:apply calc-lcell-offset cell) x8632::word-size-in-bytes)) (:%l x8632::ebp))))
355
356	(define-x8632-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
357	(()
358	())
359	(leave)
360	(ret))
361
362	(define-x8632-vinsn (restore-full-lisp-context :lispcontext :pop :vsp )
363	(()
364	())
365	(leave))
366
367	(define-x8632-vinsn compare-to-nil (()
368	((arg0 t)))
369	(cmpl (:$l x8632::nil-value) (:%l arg0)))
370
371	(define-x8632-vinsn ref-constant (((dest :lisp))
372	((lab :label)))
373	(movl (:@ (:^ lab) (:%l x8632::fn)) (:%l dest)))
374
375	(define-x8632-vinsn (vpush-constant :push :node :vsp) (()
376	((lab :label)))
377	(pushl (:@ (:^ lab) (:%l x8632::fn))))
378
379	(define-x8632-vinsn (jump :jump)
380	(()
381	((label :label)))
382	(jmp label))
383
384	(define-x8632-vinsn (cbranch-true :branch) (()
385	((label :label)
386	(crbit :u8const)))
387	(jcc (:$ub crbit) label))
388
389	(define-x8632-vinsn (cbranch-false :branch) (()
390	((label :label)
391	(crbit :u8const)))
392	(jcc (:$ub (:apply logxor 1 crbit)) label))
393
394	(define-x8632-vinsn (lri :constant-ref) (((dest :imm))
395	((intval :s32const))
396	())
397	((:pred = intval 0)
398	(xorl (:%l dest) (:%l dest)))
399	((:not (:pred = intval 0))
400	(movl (:$l intval) (:%l dest))))
401
402	;;; In the following trap/branch-unless vinsns, it might be worth
403	;;; trying to use byte instructions when the args are known to be
404	;;; accessible as byte regs. It also might be possible to
405	;;; special-case eax/ax/al.
406
407	(define-x8632-vinsn trap-unless-bit (()
408	((value :lisp)))
409	(testl (:$l (lognot x8632::fixnumone)) (:%l value))
410	(je.pt :ok)
411	(uuo-error-reg-not-type (:%l value) (:$ub arch::error-object-not-bit))
412	:ok
413	)
414
415	;;; note that NIL is just a distinguished CONS.
416	;;; the tag formerly known as fulltag-nil is now
417	;;; for tagged return addresses.
418	(define-x8632-vinsn trap-unless-list (()
419	((object :lisp))
420	((tag :u16)))
421	(movw (:%w object) (:%w tag))
422	(andw (:$w x8632::fulltagmask) (:%w tag))
423	(cmpw (:$w x8632::fulltag-cons) (:%w tag))
424	(je.pt :ok)
425	(uuo-error-reg-not-list (:%l object))
426	:ok)
427
428	(define-x8632-vinsn trap-unless-cons (()
429	((object :lisp))
430	((tag :u16)))
431	;; check for NIL
432	(cmpl (:$l x8632::nil-value) (:%l object))
433	(je.pn :bad)
434	(movw (:%w object) (:%w tag))
435	(andw (:$w x8632::fulltagmask) (:%w tag))
436	(cmpw (:$w x8632::fulltag-cons) (:%w tag))
437	(je.pt :ok)
438	:bad
439	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::fulltag-cons))
440	:ok)
441
442	(define-x8632-vinsn trap-unless-uvector (()
443	((object :lisp))
444	((tag :u16)))
445	(movw (:%w object) (:%w tag))
446	(andw (:$w x8632::tagmask) (:%w tag))
447	(cmpw (:$w x8632::tag-misc) (:%w tag))
448	(jz.pt :ok)
449	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::tag-misc))
450	:ok)
451
452	(define-x8632-vinsn trap-unless-character (()
453	((object :lisp)))
454	(cmpw (:$w x8632::subtag-character) (:%w object))
455	(je.pt :ok)
456	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-character))
457	:ok)
458
459	(define-x8632-vinsn trap-unless-fixnum (()
460	((object :lisp))
461	())
462	(testw (:$w x8632::tagmask) (:%w object))
463	(je.pt :ok)
464	(uuo-error-reg-not-fixnum (:%l object))
465	:ok)
466
467	(define-x8632-vinsn set-flags-from-lisptag (()
468	((reg :lisp)))
469	(testw (:$w x8632::tagmask) (:%w reg)))
470
471	(define-x8632-vinsn trap-unless-typecode= (()
472	((object :lisp)
473	(tagval :u8const))
474	((tag :u8)))
475	(movl (:%l object) (:%l tag))
476	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
477	;; accumulator
478	(andb (:$b x8632::tagmask) (:%accb tag))
479	(cmpb (:$b x8632::tag-misc) (:%accb tag)))
480	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
481	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
482	;; other register that can be treated as a byte
483	(andb (:$b x8632::tagmask) (:%b tag))
484	(cmpb (:$b x8632::tag-misc) (:%b tag)))
485	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
486	;; non-byte register
487	(andl (:$l x8632::tagmask) (:%l tag))
488	(cmpl (:$b x8632::tag-misc) (:%l tag)))
489	(jne :have-tag)
490	(movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag))
491	:have-tag
492	(cmpl (:$b tagval) (:%l tag))
493	(je.pt :ok)
494	(uuo-error-reg-not-tag (:%l object) (:$ub tagval))
495	:ok)
496
497	(define-x8632-vinsn trap-unless-single-float (()
498	((object :lisp))
499	((tag :u16)))
500	(movw (:%w object) (:%w tag))
501	(andw (:$w x8632::tagmask) (:%w tag))
502	(cmpw (:$w x8632::tag-misc) (:%w tag))
503	(jne :have-tag)
504	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
505	:have-tag
506	(cmpw (:$w x8632::subtag-single-float) (:%w tag))
507	(je.pt :ok)
508	(uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-single-float))
509	:ok)
510
511	(define-x8632-vinsn trap-unless-double-float (()
512	((object :lisp))
513	((tag :u16)))
514	(movw (:%w object) (:%w tag))
515	(andw (:$w x8632::tagmask) (:%w tag))
516	(cmpw (:$w x8632::tag-misc) (:%w tag))
517	(jne :have-tag)
518	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
519	:have-tag
520	(cmpw (:$w x8632::subtag-double-float) (:%w tag))
521	(je.pt :ok)
522	(uuo-error-reg-not-tag (:%w object) (:$ub x8632::subtag-double-float))
523	:ok)
524
525	(define-x8632-vinsn trap-unless-macptr (()
526	((object :lisp))
527	((tag :u16)))
528	(movw (:%w object) (:%w tag))
529	(andw (:$w x8632::tagmask) (:%w tag))
530	(cmpw (:$w x8632::tag-misc) (:%w tag))
531	(jne :have-tag)
532	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w tag))
533	:have-tag
534	(cmpw (:$w x8632::subtag-macptr) (:%w tag))
535	(je.pt :ok)
536	(uuo-error-reg-not-tag (:%l object) (:$ub x8632::subtag-macptr))
537	:ok)
538
539	(define-x8632-vinsn check-misc-bound (()
540	((idx :imm)
541	(v :lisp))
542	((temp :u32)))
543	(movl (:@ x8632::misc-header-offset (:%l v)) (:%l temp))
544	((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
545	(:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
546	(xorb (:%b temp) (:%b temp))
547	(shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l temp)))
548	((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
549	(shrl (:$ub x8632::num-subtag-bits) (:%l temp))
550	(shll (:$ub x8632::fixnumshift) (:%l temp)))
551	(rcmpl (:%l idx) (:%l temp))
552	(jb.pt :ok)
553	(uuo-error-vector-bounds (:%l idx) (:%l v))
554	:ok)
555
556	(define-x8632-vinsn %cdr (((dest :lisp))
557	((src :lisp)))
558	(movl (:@ x8632::cons.cdr (:%l src)) (:%l dest)))
559
560	(define-x8632-vinsn (%vpush-cdr :push :node :vsp)
561	(()
562	((src :lisp)))
563	(pushl (:@ x8632::cons.cdr (:%l src))))
564
565	(define-x8632-vinsn %car (((dest :lisp))
566	((src :lisp)))
567	(movl (:@ x8632::cons.car (:%l src)) (:%l dest)))
568
569	(define-x8632-vinsn (%vpush-car :push :node :vsp)
570	(()
571	((src :lisp)))
572	(pushl (:@ x8632::cons.car (:%l src))))
573
574	(define-x8632-vinsn u32->char (((dest :lisp)
575	(src :u8))
576	((src :u8))
577	())
578	(shll (:$ub x8632::charcode-shift) (:%l src))
579	(leal (:@ x8632::subtag-character (:%l src)) (:%l dest)))
580
581	(define-x8632-vinsn (load-nil :constant-ref) (((dest t))
582	())
583	(movl (:$l x8632::nil-value) (:%l dest)))
584
585
586	(define-x8632-vinsn (load-t :constant-ref) (((dest t))
587	())
588	(movl (:$l x8632::t-value) (:%l dest)))
589
590	;;; use something like this for the other extract-whatevers, too,
591	;;; once it's established that it works.
592	(define-x8632-vinsn extract-tag (((tag :u8))
593	((object :lisp)))
594	(movl (:%l object) (:%l tag))
595	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
596	;; tag is the accumulator (2 bytes)
597	(andb (:$b x8632::tagmask) (:%accb tag)))
598	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
599	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
600	;; tag is in a register whose low 8 bits can be accessed by byte
601	;; insns (3 bytes)
602	(andb (:$b x8632::tagmask) (:%b tag)))
603	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
604	;; tag is somewhere else (6 bytes) (could use andw and get a length
605	;; of 5 bytes, but Intel's optimization manual advises avoiding
606	;; length-changing prefixes to change the size of immediates.
607	;; (section 3.4.2.3)
608	(andl (:$l x8632::tagmask) (:%l tag))))
609
610	(define-x8632-vinsn extract-tag-fixnum (((tag :imm))
611	((object :lisp)))
612	(leal (:@ (:%l object) 4) (:%l tag))
613	(andw (:$w (ash x8632::tagmask x8632::fixnumshift)) (:%w tag)))
614
615	(define-x8632-vinsn extract-fulltag (((tag :u8))
616	((object :lisp)))
617	(movl (:%l object) (:%l tag))
618	(andw (:$w x8632::fulltagmask) (:%w tag)))
619
620	(define-x8632-vinsn extract-fulltag-fixnum (((tag :imm))
621	((object :lisp)))
622	(leal (:@ (:%l object) 4) (:%l tag))
623	(andw (:$w (ash x8632::fulltagmask x8632::fixnumshift)) (:%w tag)))
624
625	(define-x8632-vinsn extract-typecode (((tag :imm))
626	((object :lisp)))
627	(movl (:%l object) (:%l tag))
628	((:pred <= (:apply %hard-regspec-value tag) x8632::ebx)
629	(andb (:$b x8632::tagmask) (:%b tag))
630	(cmpb (:$b x8632::tag-misc) (:%b tag)))
631	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
632	(andl (:$l x8632::tagmask) (:%l tag))
633	(cmpl (:$l x8632::tag-misc) (:%l tag)))
634	(jne :have-tag)
635	((:pred <= (:apply %hard-regspec-value tag) x8632::ebx)
636	(movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag)))
637	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
638	(movl (:@ x8632::misc-subtag-offset (:%l object)) (:%l tag)))
639	:have-tag)
640
641	(define-x8632-vinsn extract-typecode-fixnum (((tag :imm))
642	((object :lisp))
643	((temp :u32)))
644	(movl (:%l object) (:%l temp))
645	(andw (:$w x8632::tagmask) (:%w temp))
646	(cmpw (:$w x8632::tag-misc) (:%w temp))
647	(jne :have-tag)
648	(movw (:@ x8632::misc-subtag-offset (:%l object)) (:%w temp))
649	:have-tag
650	(leal (:@ (:%l temp) 4) (:%l tag)))
651
652	(define-x8632-vinsn compare-reg-to-zero (()
653	((reg :imm)))
654	(testl (:%l reg) (:%l reg)))
655
656	;;; life will be sad if reg isn't byte accessible
657	(define-x8632-vinsn compare-u8-reg-to-zero (()
658	((reg :u8)))
659	(testb (:%b reg) (:%b reg)))
660
661	(define-x8632-vinsn cr-bit->boolean (((dest :lisp))
662	((crbit :u8const))
663	((temp :u32)))
664	(movl (:$l x8632::t-value) (:%l temp))
665	(leal (:@ (- x8632::t-offset) (:%l temp)) (:%l dest))
666	(cmovccl (:$ub crbit) (:%l temp) (:%l dest)))
667
668	(define-x8632-vinsn compare-s32-constant (()
669	((val :imm)
670	(const :s32const)))
671	((:or (:pred < const -128) (:pred > const 127))
672	(rcmpl (:%l val) (:$l const)))
673	((:not (:or (:pred < const -128) (:pred > const 127)))
674	(rcmpl (:%l val) (:$b const))))
675
676	(define-x8632-vinsn compare-u31-constant (()
677	((val :u32)
678	(const :u32const)))
679	((:pred > const 127)
680	(rcmpl (:%l val) (:$l const)))
681	((:not (:pred > const 127))
682	(rcmpl (:%l val) (:$b const))))
683
684	(define-x8632-vinsn compare-u8-constant (()
685	((val :u8)
686	(const :u8const)))
687	((:pred = (:apply %hard-regspec-value val) x8632::eax)
688	(rcmpb (:%accb val) (:$b const)))
689	((:and (:pred > (:apply %hard-regspec-value val) x8632::eax)
690	(:pred <= (:apply %hard-regspec-value val) x8632::ebx))
691	(rcmpb (:%b val) (:$b const)))
692	((:pred > (:apply %hard-regspec-value val) x8632::ebx)
693	(rcmpl (:%l val) (:$l const)))
694	)
695
696	(define-x8632-vinsn cons (((dest :lisp))
697	((car :lisp)
698	(cdr :lisp))
699	((allocptr (:lisp #.x8632::allocptr))))
700	(subl (:$b (- x8632::cons.size x8632::fulltag-cons)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
701	(movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l x8632::allocptr))
702	(rcmpl (:%l x8632::allocptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
703	(jg :no-trap)
704	(uuo-alloc)
705	:no-trap
706	(andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
707	(movl (:%l car) (:@ x8632::cons.car (:%l x8632::allocptr)))
708	(movl (:%l cdr) (:@ x8632::cons.cdr (:%l x8632::allocptr)))
709	(movl (:%l x8632::allocptr) (:%l dest)))
710
711	(define-x8632-vinsn unbox-u8 (((dest :u8))
712	((src :lisp)))
713	(movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l dest))
714	(andl (:% src) (:% dest))
715	(je.pt :ok)
716	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-8))
717	:ok
718	(movl (:%l src) (:%l dest))
719	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
720
721	(define-x8632-vinsn %unbox-u8 (((dest :u8))
722	((src :lisp)))
723	(movl (:%l src) (:%l dest))
724	(shrl (:$ub x8632::fixnumshift) (:%l dest))
725	(andl (:$l #xff) (:%l dest)))
726
727	(define-x8632-vinsn unbox-s8 (((dest :s8))
728	((src :lisp)))
729	(movl (:%l src) (:%l dest))
730	(shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
731	(sarl (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l dest))
732	(cmpl (:%l src) (:%l dest))
733	(jne.pn :bad)
734	(testw (:$w x8632::fixnummask) (:%w dest))
735	(jne.pn :bad)
736	(sarl (:$ub x8632::fixnumshift) (:%l dest))
737	(jmp :got-it)
738	:bad
739	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-8))
740	:got-it)
741
742	(define-x8632-vinsn unbox-u16 (((dest :u16))
743	((src :lisp)))
744	(testl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:% src))
745	(movl (:%l src) (:%l dest))
746	(je.pt :ok)
747	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-16))
748	:ok
749	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
750
751	(define-x8632-vinsn %unbox-u16 (((dest :u16))
752	((src :lisp)))
753	(movl (:%l src) (:%l dest))
754	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
755
756	(define-x8632-vinsn unbox-s16 (((dest :s16))
757	((src :lisp)))
758	(movl (:%l src) (:%l dest))
759	(shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
760	(sarl (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l dest))
761	(cmpl (:%l src) (:%l dest))
762	(jne.pn :bad)
763	(testw (:$w x8632::fixnummask) (:%w dest))
764	(je.pt :got-it)
765	:bad
766	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-16))
767	:got-it
768	(sarl (:$ub x8632::fixnumshift) (:%l dest)))
769
770	(define-x8632-vinsn %unbox-s16 (((dest :s16))
771	((src :lisp)))
772	(movl (:%l src) (:%l dest))
773	(sarl (:$ub x8632::fixnumshift) (:%l dest)))
774
775	;;; xxx -- review this again later
776	(define-x8632-vinsn unbox-u32 (((dest :u32))
777	((src :lisp)))
778	(movl (:$l (lognot (ash x8632::target-most-positive-fixnum x8632::fixnumshift))) (:%l dest))
779	(testl (:%l dest) (:%l src))
780	(movl (:%l src) (:%l dest))
781	(jnz :maybe-bignum)
782	(sarl (:$ub x8632::fixnumshift) (:%l dest))
783	(jmp :done)
784	:maybe-bignum
785	(andw (:$w x8632::tagmask) (:%w dest))
786	(cmpw (:$w x8632::tag-misc) (:%w dest))
787	(jne :have-tag)
788	(movw (:@ x8632::misc-subtag-offset (:%l src)) (:%w dest))
789	(andw (:$w #xff) (:%w dest))
790	:have-tag
791	(cmpw (:$w x8632::subtag-bignum) (:%w dest))
792	(jne :bad)
793	(movl (:@ x8632::misc-header-offset (:%l src)) (:%l dest))
794	(cmpl (:$l x8632::three-digit-bignum-header) (:%l dest))
795	(je :three)
796	(cmpl (:$l x8632::two-digit-bignum-header) (:%l dest))
797	(jne :bad)
798	(movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
799	(testl (:%l dest) (:%l dest))
800	(jns :done)
801	:bad
802	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-unsigned-byte-32))
803	:three
804	(movl (:@ (+ 4 x8632::misc-data-offset) (:%l src)) (:%l dest))
805	(testl (:%l dest) (:%l dest))
806	(movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
807	(jne :bad)
808	:done)
809
810	;;; xxx -- review this again later
811	(define-x8632-vinsn unbox-s32 (((dest :s32))
812	((src :lisp)))
813	(movl (:%l src) (:%l dest))
814	(sarl (:$ub x8632::fixnumshift) (:%l dest))
815	;; Was it a fixnum ?
816	(testw (:$w x8632::fixnummask) (:%w src))
817	(je :done)
818	;; May be a 2-digit bignum
819	(movw (:%w src) (:%w dest))
820	(andw (:$w x8632::tagmask) (:%w dest))
821	(cmpw (:$w x8632::tag-misc) (:%w dest))
822	(jne :bad)
823	(cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l src)))
824	(movl (:@ x8632::misc-data-offset (:%l src)) (:%l dest))
825	(je :done)
826	:bad
827	(uuo-error-reg-not-type (:%l src) (:$ub arch::error-object-not-signed-byte-32))
828	:done)
829
830
831	;;; xxx -- sigh...
832	(define-x8632-vinsn sign-extend-s8 (((dest :s32))
833	((src :s8)))
834	;; (movsbl (:%b temp) (:%l dest))
835	(movl (:%l src) (:%l dest))
836	(shll (:$ub 24) (:%l dest))
837	(sarl (:$ub 24) (:%l dest)))
838
839	(define-x8632-vinsn sign-extend-s16 (((dest :s32))
840	((src :s16)))
841	(movswl (:%w src) (:%l dest)))
842
843	;;; xxx -- sigh...
844	(define-x8632-vinsn zero-extend-u8 (((dest :s32))
845	((src :u8)))
846	;;(movzbl (:%b src) (:%l dest))
847	(movl (:%l src) (:%l dest))
848	(andl (:$l #xff) (:%l dest)))
849
850	(define-x8632-vinsn zero-extend-u16 (((dest :s32))
851	((src :u16)))
852	(movzwl (:%w src) (:%l dest)))
853
854	(define-x8632-vinsn (jump-subprim :jumpLR) (()
855	((spno :s32const)))
856	(jmp (:@ spno)))
857
858	;;; Call a subprimitive using a tail-aligned CALL instruction.
859	(define-x8632-vinsn (call-subprim :call) (()
860	((spno :s32const))
861	((entry (:label 1))))
862	(:talign x8632::fulltag-tra)
863	(call (:@ spno))
864	(movl (:$self 0) (:% x8632::fn)))
865
866	(define-x8632-vinsn fixnum-subtract-from (((dest t)
867	(y t))
868	((y t)
869	(x t)))
870	(subl (:%l y) (:%l x)))
871
872	(define-x8632-vinsn %logand-c (((dest t)
873	(val t))
874	((val t)
875	(const :s32const)))
876	((:and (:pred >= const -128) (:pred <= const 127))
877	(andl (:$b const) (:%l val)))
878	((:not (:and (:pred >= const -128) (:pred <= const 127)))
879	(andl (:$l const) (:%l val))))
880
881	(define-x8632-vinsn %logior-c (((dest t)
882	(val t))
883	((val t)
884	(const :s32const)))
885	((:and (:pred >= const -128) (:pred <= const 127))
886	(orl (:$b const) (:%l val)))
887	((:not (:and (:pred >= const -128) (:pred <= const 127)))
888	(orl (:$l const) (:%l val))))
889
890	(define-x8632-vinsn %logxor-c (((dest t)
891	(val t))
892	((val t)
893	(const :s32const)))
894	((:and (:pred >= const -128) (:pred <= const 127))
895	(xorl (:$b const) (:%l val)))
896	((:not (:and (:pred >= const -128) (:pred <= const 127)))
897	(xorl (:$l const) (:%l val))))
898
899	(define-x8632-vinsn character->fixnum (((dest :lisp))
900	((src :lisp))
901	())
902	((:not (:pred =
903	(:apply %hard-regspec-value dest)
904	(:apply %hard-regspec-value src)))
905	(movl (:%l src) (:%l dest)))
906	(shrl (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest)))
907
908	(define-x8632-vinsn compare (()
909	((x t)
910	(y t)))
911	(rcmpl (:%l x) (:%l y)))
912
913	(define-x8632-vinsn negate-fixnum (((val :lisp))
914	((val :imm)))
915	(negl (:% val)))
916
917	;;; This handles the 1-bit overflow from addition/subtraction/unary negation
918	(define-x8632-vinsn set-bigits-and-header-for-fixnum-overflow
919	(()
920	((val :lisp)
921	(no-overflow
922	:label))
923	((imm (:u32 #.x8632::imm0))))
924	(jno.pt no-overflow)
925	(movl (:%l val) (:%l imm))
926	(sarl (:$ub x8632::fixnumshift) (:%l imm))
927	(xorl (:$l #xc0000000) (:%l imm))
928	;; stash bignum digit
929	(movd (:%l imm) (:%mmx x8632::mm1))
930	;; set header
931	(movl (:$l x8632::one-digit-bignum-header) (:%l imm))
932	(movd (:%l imm) (:%mmx x8632::mm0))
933	;; need 8 bytes of aligned memory for 1 digit bignum
934	(movl (:$l (- 8 x8632::fulltag-misc)) (:%l imm)))
935
936	(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
937	((bignum :lisp)))
938	(movd (:%mmx x8632::mm1) (:@ x8632::misc-data-offset (:%l bignum))))
939
940
941	(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
942	((src :s32))
943	((temp :s32)))
944	(movl (:%l src) (:%l temp))
945	(shll (:$ub x8632::fixnumshift) (:%l temp))
946	(movl (:%l temp) (:%l dest)) ; tagged as a fixnum
947	(sarl (:$ub x8632::fixnumshift) (:%l temp))
948	(cmpl (:%l src) (:%l temp)))
949
950	(define-x8632-vinsn %set-z-flag-if-u32-fits-in-fixnum (((dest :imm))
951	((src :u32))
952	((temp :u32)))
953	(movl (:%l src) (:%l temp))
954	(shll (:$ub (1+ x8632::fixnumshift)) (:%l temp))
955	(movl (:%l temp) (:%l dest)) ; tagged as an even fixnum
956	(shrl (:$ub (1+ x8632::fixnumshift)) (:%l temp))
957	(shrl (:%l dest))
958	(cmpl (:%l src) (:%l temp))
959	:done)
960
961	;;; setup-bignum-alloc-for-s32-overflow
962	;;; setup-bignum-alloc-for-u32-overflow
963
964	(define-x8632-vinsn setup-uvector-allocation (()
965	((header :imm)))
966	(movd (:%l header) (:%mmx x8632::mm0)))
967
968	;;; The code that runs in response to the uuo-alloc
969	;;; expects a header in mm0, and a size in imm0.
970	;;; mm0 is an implicit arg (it contains the uvector header)
971	;;; size is actually an arg, not a temporary,
972	;;; but it appears that there's isn't a way to enforce
973	;;; register usage on vinsn args.
974	(define-x8632-vinsn %allocate-uvector (((dest :lisp))
975	()
976	((size (:u32 #.x8632::imm0))
977	(freeptr (:lisp #.x8632::allocptr))))
978	(subl (:%l size) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
979	(movl (:@ (:%seg :rcontext) x8632::tcr.save-allocptr) (:%l freeptr))
980	(rcmpl (:%l freeptr) (:@ (:%seg :rcontext) x8632::tcr.save-allocbase))
981	(jg :no-trap)
982	(uuo-alloc)
983	:no-trap
984	(movd (:%mmx x8632::mm0) (:@ x8632::misc-header-offset (:%l freeptr)))
985	(andb (:$b (lognot x8632::fulltagmask)) (:@ (:%seg :rcontext) x8632::tcr.save-allocptr))
986	((:not (:pred = freeptr
987	(:apply %hard-regspec-value dest)))
988	(movl (:%l freeptr) (:%l dest))))
989
990	(define-x8632-vinsn box-fixnum (((dest :imm))
991	((src :s32)))
992	;;(imull (:$b x8632::fixnumone) (:%l src) (:%l dest))
993	(leal (:@ (:%l src) x8632::fixnumone) (:%l dest)))
994
995	;;; xxx
996	(define-x8632-vinsn (fix-fixnum-overflow-ool :call)
997	(((val :lisp))
998	((val :lisp))
999	((unboxed (:s32 #.x8632::edx))
1000	(header (:u32 #.x8632::imm0))
1001	(entry (:label 1))))
1002	(jno.pt :done)
1003	((:not (:pred = x8632::arg_z
1004	(:apply %hard-regspec-value val)))
1005	(movl (:%l val) (:%l x8632::arg_z)))
1006	(:talign 5)
1007	(call (:@ .SPfix-overflow))
1008	(movl (:$self 0) (:%l x8632::fn))
1009	((:not (:pred = x8632::arg_z
1010	(:apply %hard-regspec-value val)))
1011	(movl (:%l x8632::arg_z) (:%l val)))
1012	:done)
1013
1014	;;; xxx
1015	(define-x8632-vinsn (fix-fixnum-overflow-ool-and-branch :call)
1016	(((val :lisp))
1017	((val :lisp)
1018	(lab :label))
1019	((unboxed (:s32 #.x8664::imm1))
1020	(header (:u32 #.x8664::imm0))
1021	(entry (:label 1))))
1022	(jno.pt lab)
1023	((:not (:pred = x8632::arg_z
1024	(:apply %hard-regspec-value val)))
1025	(movl (:%l val) (:%l x8632::arg_z)))
1026	(:talign 5)
1027	(call (:@ .SPfix-overflow))
1028	(movl (:$self 0) (:%l x8632::fn))
1029	((:not (:pred = x8632::arg_z
1030	(:apply %hard-regspec-value val)))
1031	(movl (:%l x8632::arg_z) (:%l val)))
1032	(jmp lab))
1033
1034
1035	(define-x8632-vinsn add-constant (((dest :imm))
1036	((dest :imm)
1037	(const :s32const)))
1038	((:and (:pred >= const -128) (:pred <= const 127))
1039	(addl (:$b const) (:%l dest)))
1040	((:not (:and (:pred >= const -128) (:pred <= const 127)))
1041	(addl (:$l const) (:%l dest))))
1042
1043	(define-x8632-vinsn add-constant3 (((dest :imm))
1044	((src :imm)
1045	(const :s32const)))
1046	((:pred = (:apply %hard-regspec-value dest)
1047	(:apply %hard-regspec-value src))
1048	((:and (:pred >= const -128) (:pred <= const 127))
1049	(addl (:$b const) (:%l dest)))
1050	((:not (:and (:pred >= const -128) (:pred <= const 127)))
1051	(addl (:$l const) (:%l dest))))
1052	((:not (:pred = (:apply %hard-regspec-value dest)
1053	(:apply %hard-regspec-value src)))
1054	(leal (:@ const (:%l src)) (:%l dest))))
1055
1056	(define-x8632-vinsn fixnum-add2 (((dest :imm))
1057	((dest :imm)
1058	(other :imm)))
1059	(addl (:%l other) (:%l dest)))
1060
1061	(define-x8632-vinsn fixnum-sub2 (((dest :imm))
1062	((x :imm)
1063	(y :imm))
1064	((temp :imm)))
1065	(movl (:%l x) (:%l temp))
1066	(subl (:%l y) (:%l temp))
1067	(movl (:%l temp) (:%l dest)))
1068
1069	(define-x8632-vinsn fixnum-add3 (((dest :imm))
1070	((x :imm)
1071	(y :imm)))
1072
1073	((:pred =
1074	(:apply %hard-regspec-value x)
1075	(:apply %hard-regspec-value dest))
1076	(addl (:%l y) (:%l dest)))
1077	((:not (:pred =
1078	(:apply %hard-regspec-value x)
1079	(:apply %hard-regspec-value dest)))
1080	((:pred =
1081	(:apply %hard-regspec-value y)
1082	(:apply %hard-regspec-value dest))
1083	(addl (:%l x) (:%l dest)))
1084	((:not (:pred =
1085	(:apply %hard-regspec-value y)
1086	(:apply %hard-regspec-value dest)))
1087	(leal (:@ (:%l x) (:%l y)) (:%l dest)))))
1088
1089	(define-x8632-vinsn copy-gpr (((dest t))
1090	((src t)))
1091	((:not (:pred =
1092	(:apply %hard-regspec-value dest)
1093	(:apply %hard-regspec-value src)))
1094	(movl (:%l src) (:%l dest))))
1095
1096	(define-x8632-vinsn (vpop-register :pop :node :vsp)
1097	(((dest :lisp))
1098	())
1099	(popl (:%l dest)))
1100
1101	(define-x8632-vinsn (push-argregs :push :node :vsp) (()
1102	())
1103	(rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1104	(jb :done)
1105	(je :one)
1106	(pushl (:%l x8632::arg_y))
1107	:one
1108	(pushl (:%l x8632::arg_z))
1109	:done)
1110
1111	(define-x8632-vinsn (push-max-argregs :push :node :vsp) (()
1112	((max :u32const)))
1113	((:pred >= max 2)
1114	(rcmpw (:%w x8632::nargs) (:$w (* 1 x8632::node-size)))
1115	(jb :done)
1116	(je :one)
1117	(pushl (:%l x8632::arg_y))
1118	:one
1119	(pushl (:%l x8632::arg_z))
1120	:done)
1121	((:pred = max 1)
1122	(testw (:%w x8632::nargs) (:%w x8632::nargs))
1123	(je :done)
1124	(pushl (:%l x8632::arg_z))
1125	:done))
1126
1127	(define-x8632-vinsn (call-label :call) (()
1128	((label :label))
1129	((entry (:label 1))))
1130	(:talign 5)
1131	(call label)
1132	(movl (:$self 0) (:%l x8632::fn)))
1133
1134	(define-x8632-vinsn double-float-compare (()
1135	((arg0 :double-float)
1136	(arg1 :double-float)))
1137	(comisd (:%xmm arg1) (:%xmm arg0)))
1138
1139	(define-x8632-vinsn single-float-compare (()
1140	((arg0 :single-float)
1141	(arg1 :single-float)))
1142	(comiss (:%xmm arg1) (:%xmm arg0)))
1143
1144	(define-x8632-vinsn double-float+-2 (((result :double-float))
1145	((x :double-float)
1146	(y :double-float)))
1147	((:pred =
1148	(:apply %hard-regspec-value result)
1149	(:apply %hard-regspec-value x))
1150	(addsd (:%xmm y) (:%xmm result)))
1151	((:and (:not (:pred =
1152	(:apply %hard-regspec-value result)
1153	(:apply %hard-regspec-value x)))
1154	(:pred =
1155	(:apply %hard-regspec-value result)
1156	(:apply %hard-regspec-value y)))
1157	(addsd (:%xmm x) (:%xmm result)))
1158	((:and (:not (:pred =
1159	(:apply %hard-regspec-value result)
1160	(:apply %hard-regspec-value x)))
1161	(:not (:pred =
1162	(:apply %hard-regspec-value result)
1163	(:apply %hard-regspec-value y))))
1164	(movsd (:%xmm x) (:%xmm result))
1165	(addsd (:%xmm y) (:%xmm result))))
1166
1167	;;; Caller guarantees (not (eq y result))
1168	(define-x8632-vinsn double-float--2 (((result :double-float))
1169	((x :double-float)
1170	(y :double-float)))
1171	((:not (:pred = (:apply %hard-regspec-value result)
1172	(:apply %hard-regspec-value x)))
1173	(movsd (:%xmm x) (:%xmm result)))
1174	(subsd (:%xmm y) (:%xmm result)))
1175
1176	(define-x8632-vinsn double-float*-2 (((result :double-float))
1177	((x :double-float)
1178	(y :double-float)))
1179	((:pred =
1180	(:apply %hard-regspec-value result)
1181	(:apply %hard-regspec-value x))
1182	(mulsd (:%xmm y) (:%xmm result)))
1183	((:and (:not (:pred =
1184	(:apply %hard-regspec-value result)
1185	(:apply %hard-regspec-value x)))
1186	(:pred =
1187	(:apply %hard-regspec-value result)
1188	(:apply %hard-regspec-value y)))
1189	(mulsd (:%xmm x) (:%xmm result)))
1190	((:and (:not (:pred =
1191	(:apply %hard-regspec-value result)
1192	(:apply %hard-regspec-value x)))
1193	(:not (:pred =
1194	(:apply %hard-regspec-value result)
1195	(:apply %hard-regspec-value y))))
1196	(movsd (:%xmm x) (:%xmm result))
1197	(mulsd (:%xmm y) (:%xmm result))))
1198
1199	;;; Caller guarantees (not (eq y result))
1200	(define-x8632-vinsn double-float/-2 (((result :double-float))
1201	((x :double-float)
1202	(y :double-float)))
1203	((:not (:pred = (:apply %hard-regspec-value result)
1204	(:apply %hard-regspec-value x)))
1205	(movsd (:%xmm x) (:%xmm result)))
1206	(divsd (:%xmm y) (:%xmm result)))
1207
1208	(define-x8632-vinsn single-float+-2 (((result :single-float))
1209	((x :single-float)
1210	(y :single-float)))
1211	((:pred =
1212	(:apply %hard-regspec-value result)
1213	(:apply %hard-regspec-value x))
1214	(addss (:%xmm y) (:%xmm result)))
1215	((:and (:not (:pred =
1216	(:apply %hard-regspec-value result)
1217	(:apply %hard-regspec-value x)))
1218	(:pred =
1219	(:apply %hard-regspec-value result)
1220	(:apply %hard-regspec-value y)))
1221	(addss (:%xmm x) (:%xmm result)))
1222	((:and (:not (:pred =
1223	(:apply %hard-regspec-value result)
1224	(:apply %hard-regspec-value x)))
1225	(:not (:pred =
1226	(:apply %hard-regspec-value result)
1227	(:apply %hard-regspec-value y))))
1228	(movss (:%xmm x) (:%xmm result))
1229	(addss (:%xmm y) (:%xmm result))))
1230
1231	;;; Caller guarantees (not (eq y result))
1232	(define-x8632-vinsn single-float--2 (((result :single-float))
1233	((x :single-float)
1234	(y :single-float)))
1235	((:not (:pred = (:apply %hard-regspec-value result)
1236	(:apply %hard-regspec-value x)))
1237	(movss (:%xmm x) (:%xmm result)))
1238	(subss (:%xmm y) (:%xmm result)))
1239
1240	(define-x8632-vinsn single-float*-2 (((result :single-float))
1241	((x :single-float)
1242	(y :single-float)))
1243	((:pred =
1244	(:apply %hard-regspec-value result)
1245	(:apply %hard-regspec-value x))
1246	(mulss (:%xmm y) (:%xmm result)))
1247	((:and (:not (:pred =
1248	(:apply %hard-regspec-value result)
1249	(:apply %hard-regspec-value x)))
1250	(:pred =
1251	(:apply %hard-regspec-value result)
1252	(:apply %hard-regspec-value y)))
1253	(mulss (:%xmm x) (:%xmm result)))
1254	((:and (:not (:pred =
1255	(:apply %hard-regspec-value result)
1256	(:apply %hard-regspec-value x)))
1257	(:not (:pred =
1258	(:apply %hard-regspec-value result)
1259	(:apply %hard-regspec-value y))))
1260	(movss (:%xmm x) (:%xmm result))
1261	(mulss (:%xmm y) (:%xmm result))))
1262
1263	;;; Caller guarantees (not (eq y result))
1264	(define-x8632-vinsn single-float/-2 (((result :single-float))
1265	((x :single-float)
1266	(y :single-float)))
1267	((:not (:pred = (:apply %hard-regspec-value result)
1268	(:apply %hard-regspec-value x)))
1269	(movss (:%xmm x) (:%xmm result)))
1270	(divss (:%xmm y) (:%xmm result)))
1271
1272	(define-x8632-vinsn get-single (((result :single-float))
1273	((source :lisp)))
1274	(movss (:@ x8632::single-float.value (:%l source)) (:%xmm result)))
1275
1276	(define-x8632-vinsn get-double (((result :double-float))
1277	((source :lisp)))
1278	(movsd (:@ x8632::double-float.value (:%l source)) (:%xmm result)))
1279
1280	;;; Extract a double-float value, typechecking in the process.
1281	;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
1282	;;; instead of replicating it ..
1283	;;; get-double?
1284
1285	(define-x8632-vinsn copy-single-float (((dest :single-float))
1286	((src :single-float)))
1287	(movss (:%xmm src) (:%xmm dest)))
1288
1289	(define-x8632-vinsn copy-single-to-double (((dest :double-float))
1290	((src :single-float)))
1291	(cvtss2sd (:%xmm src) (:%xmm dest)))
1292
1293	(define-x8632-vinsn copy-double-to-single (((dest :single-float))
1294	((src :double-float)))
1295	(cvtsd2ss (:%xmm src) (:%xmm dest)))
1296
1297	(define-x8632-vinsn fitvals (()
1298	((n :u16const))
1299	((imm :u16)))
1300	((:pred = n 0)
1301	(xorl (:%l imm) (:%l imm)))
1302	((:not (:pred = n 0))
1303	(movw (:$w (:apply ash n x8632::fixnumshift)) (:%w imm)))
1304	(subw (:%w x8632::nargs) (:%w imm))
1305	(jae :push-more)
1306	(movswl (:%w imm) (:%l imm))
1307	(subl (:%l imm) (:%l x8632::esp))
1308	(jmp :done)
1309	:push-loop
1310	(pushl (:$l x8632::nil-value))
1311	(addw (:$b x8632::node-size) (:%w x8632::nargs))
1312	(subw (:$b x8632::node-size) (:%w imm))
1313	:push-more
1314	(jne :push-loop)
1315	:done)
1316
1317	(define-x8632-vinsn (nvalret :jumpLR) (()
1318	())
1319	(jmp (:@ .SPnvalret)))
1320
1321	(define-x8632-vinsn lisp-word-ref (((dest t))
1322	((base t)
1323	(offset t)))
1324	(movl (:@ (:%l base) (:%l offset)) (:%l dest)))
1325
1326	(define-x8632-vinsn lisp-word-ref-c (((dest t))
1327	((base t)
1328	(offset :s32const)))
1329	((:pred = offset 0)
1330	(movl (:@ (:%l base)) (:%l dest)))
1331	((:not (:pred = offset 0))
1332	(movl (:@ offset (:%l base)) (:%l dest))))
1333
1334	;; start-mv-call
1335
1336	;; xxx check this
1337	(define-x8632-vinsn (vpush-label :push :node :vsp) (()
1338	((label :label)))
1339	(leal (:@ (:^ label) (:%l x8632::fn)) (:%l x8632::ra0))
1340	(pushl (:%l x8632::ra0)))
1341
1342	;; ????
1343	(define-x8632-vinsn emit-aligned-label (()
1344	((label :label)))
1345	(:align 3)
1346	(:long (:^ label)))
1347
1348	;; pass-multiple-values-symbol
1349	;;; %ra0 is pointing into %fn, so no need to copy %fn here.
1350	(define-x8632-vinsn pass-multiple-values-symbol (()
1351	())
1352	(pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr))))
1353	(jmp (:@ x8632::symbol.fcell (:% x8632::fname))))
1354
1355
1356	;;; It'd be good to have a variant that deals with a known function
1357	;;; as well as this.
1358	(define-x8632-vinsn pass-multiple-values (()
1359	()
1360	((tag :u8)))
1361	(movb (:%b x8632::temp0) (:%b tag))
1362	(andb (:$b x8632::tagmask) (:%b tag))
1363	(cmpb (:$b x8632::tag-misc) (:%b tag))
1364	(jne :bad)
1365	(cmpb (:$b x8632::subtag-function) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
1366	(cmovel (:%l x8632::temp0) (:%l x8632::fn))
1367	(je :go)
1368	(cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
1369	(cmovel (:@ x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::fn))
1370	(jne :bad)
1371	:go
1372	(pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr))))
1373	(jmp (:%l x8632::fn))
1374	:bad
1375	(uuo-error-not-callable)
1376	;; If we don't do this (and leave %fn as a TRA into itself), reporting
1377	;; the error is likely a little harder. Tough.
1378	;; (leaq (@ (:apply - (:^ :bad)) (:%q x8664::rn)) (:%q x8664::fn))
1379	)
1380
1381
1382	(define-x8632-vinsn reserve-outgoing-frame (()
1383	())
1384	(pushl (:$b x8632::reserved-frame-marker))
1385	(pushl (:$b x8632::reserved-frame-marker)))
1386
1387	;; implicit temp0 arg
1388	(define-x8632-vinsn (call-known-function :call) (()
1389	()
1390	((entry (:label 1))))
1391	(:talign 5)
1392	(call (:%l x8632::temp0))
1393	(movl (:$self 0) (:%l x8632::fn)))
1394
1395	(define-x8632-vinsn (jump-known-function :jumplr) (()
1396	())
1397	(movl (:%l x8632::fn) (:%l x8632::xfn))
1398	(movl (:%l x8632::temp0) (:%l x8632::fn))
1399	(jmp (:%l x8632::fn)))
1400
1401	(define-x8632-vinsn (list :call) (()
1402	()
1403	((entry (:label 1))))
1404	(leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1405	(:talign 5)
1406	(call (:@ .SPconslist))
1407	:back
1408	(movl (:$self 0) (:%l x8632::fn)))
1409
1410	(define-x8632-vinsn make-fixed-stack-gvector (((dest :lisp))
1411	((aligned-size :u32const)
1412	(header :s32const))
1413	((tempa :imm)
1414	(tempb :imm)))
1415	((:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1416	(:pred <= (:apply + aligned-size x8632::dnode-size) 127))
1417	(subl (:$b (:apply + aligned-size x8632::dnode-size))
1418	(:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1419	((:not (:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
1420	(:pred <= (:apply + aligned-size x8632::dnode-size) 127)))
1421	(subl (:$l (:apply + aligned-size x8632::dnode-size))
1422	(:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
1423	(movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l tempb))
1424	(movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l tempa))
1425	(movd (:%l tempb) (:%mmx x8632::stack-temp))
1426	:loop
1427	(movapd (:%xmm x8632::fpzero) (:@ -16 (:%l tempb)))
1428	(subl (:$b x8632::dnode-size) (:%l tempb))
1429	(cmpl (:%l tempa) (:%l tempb))
1430	(jnz :loop)
1431	(movd (:%mmx x8632::stack-temp) (:@ (:%l tempa)))
1432	(movl (:%l tempa) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1433	(movl (:$l header) (:@ x8632::dnode-size (:%l tempa)))
1434	(leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l tempa)) (:%l dest)))
1435
1436
1437	(define-x8632-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
1438
1439	(define-x8632-vinsn make-tsp-vcell (((dest :lisp))
1440	((closed :lisp))
1441	((temp :imm)))
1442	(subl (:$b (+ x8632::value-cell.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1443	(movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1444	(movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1445	(movapd (:%xmm x8632::fpzero) (:@ (:%l temp)))
1446	(movapd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
1447	(movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1448	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1449	(movl (:$l x8632::value-cell-header) (:@ x8632::dnode-size (:%l temp)))
1450	(movl (:%l closed) (:@ (+ x8632::dnode-size x8632::node-size) (:%l temp)))
1451	(leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l temp)) (:%l dest)))
1452
1453	(define-x8632-vinsn make-tsp-cons (((dest :lisp))
1454	((car :lisp) (cdr :lisp))
1455	((temp :imm)))
1456	(subl (:$b (+ x8632::cons.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1457	(movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
1458	(movq (:%xmm x8632::fpzero) (:@ (:%l temp)))
1459	(movq (:%xmm x8632::fpzero) (:@ 8 (:%l temp)))
1460	(movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
1461	(movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
1462	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1463	(leal (:@ (+ x8632::dnode-size x8632::fulltag-cons) (:%l temp)) (:%l temp))
1464	(movl (:%l car) (:@ x8632::cons.car (:%l temp)))
1465	(movl (:%l cdr) (:@ x8632::cons.cdr (:%l temp)))
1466	(movl (:%l temp) (:%l dest)))
1467
1468
1469	;; make-fixed-stack-gvector
1470
1471	(define-x8632-vinsn discard-temp-frame (()
1472	()
1473	((temp :imm)))
1474	(movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
1475	(movl (:@ (:%l temp)) (:%l temp))
1476	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
1477	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
1478	)
1479
1480	(define-x8632-vinsn discard-c-frame (()
1481	()
1482	((temp :imm)))
1483	(movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l temp))
1484	(movl (:@ (:%l temp)) (:%l temp))
1485	(movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
1486
1487
1488	(define-x8632-vinsn vstack-discard (()
1489	((nwords :u32const)))
1490	((:not (:pred = nwords 0))
1491	((:pred < nwords 16)
1492	(addl (:$b (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))
1493	((:not (:pred < nwords 16))
1494	(addl (:$l (:apply ash nwords x8632::word-shift)) (:%l x8632::esp)))))
1495
1496	(defmacro define-x8632-subprim-lea-jmp-vinsn ((name &rest other-attrs) spno)
1497	`(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1498	(leal (:@ (:^ :back) (:%l x8632::fn)) (:%l x8632::ra0))
1499	(:talign 5)
1500	(jmp (:@ ,spno))
1501	:back
1502	(movl (:$self 0) (:%l x8632::fn))))
1503
1504	(defmacro define-x8632-subprim-call-vinsn ((name &rest other-attrs) spno)
1505	`(define-x8632-vinsn (,name :call :subprim-call ,@other-attrs) (() () ((entry (:label 1))))
1506	(:talign 5)
1507	(call (:@ ,spno))
1508	:back
1509	(movl (:$self 0) (:%l x8632::fn))))
1510
1511	(defmacro define-x8632-subprim-jump-vinsn ((name &rest other-attrs) spno)
1512	`(define-x8632-vinsn (,name :jump :jumpLR ,@other-attrs) (() ())
1513	(jmp (:@ ,spno))))
1514
1515	(define-x8632-vinsn (nthrowvalues :call :subprim-call) (()
1516	((lab :label)))
1517	(leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1518	(jmp (:@ .SPnthrowvalues)))
1519
1520	(define-x8632-vinsn (nthrow1value :call :subprim-call) (()
1521	((lab :label)))
1522	(leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::ra0))
1523	(jmp (:@ .SPnthrow1value)))
1524
1525	(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
1526
1527	(define-x8632-vinsn bind-interrupt-level-0-inline (()
1528	()
1529	((temp :imm)))
1530	(movl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l temp))
1531	(cmpl (:$b 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1532	(pushl (:@ x8632::interrupt-level-binding-index (:%l temp)))
1533	(pushl (:$b x8632::interrupt-level-binding-index))
1534	(pushl (:@ (:%seg :rcontext) x8632::tcr.db-link))
1535	(movl (:$l 0) (:@ x8632::interrupt-level-binding-index (:%l temp)))
1536	(movl (:%l x8632::esp) (:@ (:%seg :rcontext) x8632::tcr.db-link))
1537	(jns.pt :done)
1538	(btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1539	(jae.pt :done)
1540	(ud2a)
1541	(:byte 2)
1542	:done)
1543
1544	(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
1545
1546	(define-x8632-subprim-lea-jmp-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
1547
1548	(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
1549
1550	(define-x8632-vinsn (jump-return-pc :jumpLR) (()
1551	())
1552	(ret))
1553
1554	;;; xxx
1555	(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
1556	((lab :label))
1557	((entry (:label 1))
1558	(xfn (:lisp #.x8632::xfn))))
1559	(leal (:@ (:^ lab) (:%l x8632::fn)) (:%l xfn))
1560	(:talign 5)
1561	(call (:@ .SPmkcatchmv))
1562	:back
1563	(movl (:$self 0) (:%l x8632::fn)))
1564
1565	(define-x8632-vinsn (nmkcatch1v :call :subprim-call) (()
1566	((lab :label))
1567	((entry (:label 1))))
1568	(leal (:@ (:^ lab) (:%l x8632::fn)) (:%l x8632::xfn))
1569	(:talign 5)
1570	(call (:@ .SPmkcatch1v))
1571	:back
1572	(movl (:$self 0) (:%l x8632::fn)))
1573
1574
1575	(define-x8632-vinsn (make-simple-unwind :call :subprim-call) (()
1576	((protform-lab :label)
1577	(cleanup-lab :label)))
1578	(leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1579	(leal (:@ (:^ cleanup-lab) (:%l x8632::fn)) (:%l x8632::xfn))
1580	(jmp (:@ .SPmkunwind)))
1581
1582	(define-x8632-vinsn (nmkunwind :call :subprim-call) (()
1583	((protform-lab :label)
1584	(cleanup-lab :label)))
1585	(leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
1586	(leal (:@ (:^ cleanup-lab) (:%l x8632::fn)) (:%l x8632::xfn))
1587	(jmp (:@ .SPnmkunwind)))
1588
1589
1590	(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
1591
1592	(define-x8632-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
1593
1594	(define-x8632-vinsn set-eq-bit (()
1595	())
1596	(testb (:%b x8632::arg_z) (:%b x8632::arg_z)))
1597
1598	;;; %schar8
1599	;;; %schar32
1600	;;; %set-schar8
1601	;;; %set-schar32
1602
1603	(define-x8632-vinsn misc-set-c-single-float (((val :single-float))
1604	((v :lisp)
1605	(idx :u32const)))
1606	(movsd (:%xmm val) (:@ (:apply + x8632::misc-data-offset (:apply ash idx 2)) (:%l v))))
1607
1608	(define-x8632-vinsn array-data-vector-ref (((dest :lisp))
1609	((header :lisp)))
1610	(movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
1611
1612	(define-x8632-vinsn set-z-flag-if-istruct-typep (()
1613	((val :lisp)
1614	(type :lisp))
1615	((tag :u8)
1616	(valtype :lisp)))
1617	(xorl (:%l valtype) (:%l valtype))
1618	(movl (:%l val) (:%l tag))
1619	(andb (:$b x8632::tagmask) (:%b tag))
1620	(cmpb (:$b x8632::tag-misc) (:%b tag))
1621	(jne :have-tag)
1622	(movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
1623	:have-tag
1624	(cmpb (:$b x8632::subtag-istruct) (:%b tag))
1625	(jne :do-compare)
1626	(movl (:@ x8632::misc-data-offset (:%l val)) (:%l valtype))
1627	:do-compare
1628	(cmpl (:%l valtype) (:%l type)))
1629
1630	(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
1631
1632	(define-x8632-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
1633
1634	(define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
1635	((addr :s32const)))
1636	(movzbl (:@ addr) (:%l dest)))
1637
1638	(define-x8632-vinsn mem-ref-c-absolute-s8 (((dest :s8))
1639	((addr :s32const)))
1640	(movsbl (:@ addr) (:%l dest)))
1641
1642	(define-x8632-vinsn mem-ref-c-absolute-u16 (((dest :u16))
1643	((addr :s32const)))
1644	(movzwl (:@ addr) (:%l dest)))
1645
1646	(define-x8632-vinsn mem-ref-c-absolute-s16 (((dest :s16))
1647	((addr :s32const)))
1648	(movswl (:@ addr) (:%l dest)))
1649
1650	(define-x8632-vinsn mem-ref-c-absolute-fullword (((dest :u32))
1651	((addr :s32const)))
1652	(movl (:@ addr) (:%l dest)))
1653
1654	(define-x8632-vinsn mem-ref-c-absolute-signed-fullword (((dest :s32))
1655	((addr :s32const)))
1656	(movl (:@ addr) (:%l dest)))
1657
1658	(define-x8632-vinsn mem-ref-c-absolute-natural (((dest :u32))
1659	((addr :s32const)))
1660	(movl (:@ addr) (:%l dest)))
1661
1662	(define-x8632-vinsn misc-set-u32 (()
1663	((val :u32)
1664	(v :lisp)
1665	(scaled-idx :s32))
1666	())
1667	(movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
1668
1669	(define-x8632-vinsn %iasr-c (((dest :imm))
1670	((count :u8const)
1671	(src :imm))
1672	((temp :s32)))
1673	(movl (:%l src) (:%l temp))
1674	(sarl (:$ub count) (:%l temp))
1675	(andb (:$b (lognot x8632::fixnummask)) (:%b temp))
1676	(movl (:%l temp) (:%l dest)))
1677
1678	(define-x8632-vinsn %ilsr-c (((dest :imm))
1679	((count :u8const)
1680	(src :imm))
1681	((temp :s32)))
1682	(movl (:%l src) (:%l temp))
1683	(shrl (:$ub count) (:%l temp))
1684	;; xxx --- use :%acc
1685	(andb (:$b (lognot x8632::fixnummask)) (:%b temp))
1686	(movl (:%l temp) (:%l dest)))
1687
1688	(define-x8632-vinsn %ilsl (((dest :imm))
1689	((count :imm)
1690	(src :imm))
1691	((temp (:s32 #.x8632::eax))
1692	(shiftcount (:s32 #.x8632::ecx))))
1693	(movl (:%l count) (:%l temp))
1694	(sarl (:$ub x8632::fixnumshift) (:%l temp))
1695	(rcmpl (:%l temp) (:$l 31))
1696	(cmovbw (:%w temp) (:%w shiftcount))
1697	(movl (:%l src) (:%l temp))
1698	(jae :shift-max)
1699	(shll (:%shift x8632::cl) (:%l temp))
1700	(jmp :done)
1701	:shift-max
1702	(xorl (:%l temp) (:%l temp))
1703	:done
1704	(movl (:%l temp) (:%l dest)))
1705
1706	(define-x8632-vinsn %ilsl-c (((dest :imm))
1707	((count :u8const)
1708	(src :imm)))
1709	((:not (:pred =
1710	(:apply %hard-regspec-value src)
1711	(:apply %hard-regspec-value dest)))
1712	(movl (:%l src) (:%l dest)))
1713	(shll (:$ub count) (:%l dest)))
1714
1715	(define-x8632-vinsn require-fixnum (()
1716	((object :lisp)))
1717	:again
1718	((:and (:pred > (:apply %hard-regspec-value object) x8632::eax)
1719	(:pred <= (:apply %hard-regspec-value object) x8632::ebx))
1720	(testb (:%b x8632::fixnummask) (:%b object)))
1721	((:pred > (:apply %hard-regspec-value object) x8632::ebx)
1722	(testl (:$l x8632::fixnummask) (:%l object)))
1723	(je.pt :got-it)
1724	(uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-fixnum))
1725	(jmp :again)
1726	:got-it)
1727
1728	(define-x8632-vinsn require-integer (()
1729	((object :lisp))
1730	((tag :u8)))
1731	:again
1732	(movl (:%l object) (:%l tag))
1733	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1734	(andb (:$b x8632::fixnummask) (:%accb tag)))
1735	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1736	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1737	(andb (:$b x8632::fixnummask) (:%b tag)))
1738	((:pred > (:apply %hard-regspec-value object) x8632::ebx)
1739	(andl (:$l x8632::fixnummask) (:%l tag)))
1740	(je.pt :got-it)
1741	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1742	(cmpb (:$b x8632::tag-misc) (:%accb tag)))
1743	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1744	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1745	(cmpb (:$b x8632::tag-misc) (:%b tag)))
1746	((:pred > (:apply %hard-regspec-value object) x8632::ebx)
1747	(cmpl (:$l x8632::tag-misc) (:%l tag)))
1748	(jne :bad)
1749	(cmpb (:$b x8632::subtag-bignum) (:@ x8632::misc-subtag-offset (:%l object)))
1750	(je :got-it)
1751	:bad
1752	(uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-integer))
1753	(jmp :again)
1754	:got-it)
1755
1756	;;; naive
1757	(define-x8632-vinsn require-real (()
1758	((object :lisp))
1759	((tag :u8)))
1760	:again
1761	(movl (:%l object) (:%l tag))
1762	(andb (:$b x8632::tagmask) (:%b tag))
1763	(cmpb (:$b x8632::tag-fixnum) (:%b tag))
1764	(je :good)
1765	(cmpb (:$b x8632::tag-misc) (:%b tag))
1766	(jne :bad)
1767	(movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag))
1768	(cmpb (:$b x8632::subtag-single-float) (:%b tag))
1769	(je :good)
1770	(cmpb (:$b x8632::subtag-double-float) (:%b tag))
1771	(je :good)
1772	(cmpb (:$b x8632::subtag-bignum) (:%b tag))
1773	(je :good)
1774	(cmpb (:$b x8632::subtag-ratio) (:%b tag))
1775	(je :good)
1776	:bad
1777	(uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-real))
1778	(jmp :again)
1779	:good)
1780
1781	(define-x8632-vinsn require-symbol (()
1782	((object :lisp))
1783	((tag :u8)))
1784	:again
1785	(cmpl (:$l x8632::nil-value) (:%l object))
1786	(je :got-it)
1787	(movl (:%l object) (:%l tag))
1788	(andb (:$b x8632::tagmask) (:%b tag))
1789	(cmpb (:$b x8632::tag-misc) (:%b tag))
1790	(jne :bad)
1791	(cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l object)))
1792	(je :got-it)
1793	:bad
1794	(uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))
1795	(jmp :again)
1796	:got-it)
1797
1798	(define-x8632-vinsn mask-base-char (((dest :u8))
1799	((src :lisp)))
1800	(movzbl (:%b src) (:%l dest)))
1801
1802	(define-x8632-vinsn event-poll (()
1803	())
1804	(btrl (:$ub 31) (:@ (:%seg :rcontext) x8632::tcr.interrupt-pending))
1805	(jae :no-interrupt)
1806	(ud2a)
1807	(:byte 2)
1808	:no-interrupt)
1809
1810	;;; check-2d-bound
1811	;;; check-3d-bound
1812
1813	(define-x8632-vinsn 2d-dim1 (((dest :u32))
1814	((header :lisp)))
1815	(movl (:@ (+ x8632::misc-data-offset (* 4 (1+ x8632::arrayH.dim0-cell)))
1816	(:%l header)) (:%l dest))
1817	(sarl (:$ub x8632::fixnumshift) (:%l dest)))
1818
1819	;;; 3d-dims
1820
1821	;;; xxx
1822	(define-x8632-vinsn 2d-unscaled-index (((dest :imm)
1823	(dim1 :u32))
1824	((dim1 :u32)
1825	(i :imm)
1826	(j :imm)))
1827
1828	(imull (:%l i) (:%l dim1))
1829	(leal (:@ (:%l j) (:%l dim1)) (:%l dest)))
1830
1831	;;; 3d-unscaled-index
1832
1833	(define-x8632-vinsn branch-unless-both-args-fixnums (()
1834	((a :lisp)
1835	(b :lisp)
1836	(dest :label))
1837	((tag :u8)))
1838	(movl (:%l a) (:%l tag))
1839	(orl (:%l b) (:%l tag))
1840	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
1841	(testb (:$b x8632::fixnummask) (:%accb tag)))
1842	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
1843	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
1844	(testb (:$b x8632::fixnummask) (:%b tag)))
1845	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
1846	(testl (:$l x8632::fixnummask) (:%l tag)))
1847	(jne dest))
1848
1849	(define-x8632-vinsn branch-unless-arg-fixnum (()
1850	((a :lisp)
1851	(dest :label)))
1852	((:pred <= (:apply %hard-regspec-value a) x8632::ebx)
1853	(testb (:$b x8632::fixnummask) (:%b a)))
1854	((:pred > (:apply %hard-regspec-value a) x8632::ebx)
1855	(testl (:$l x8632::fixnummask) (:%l a)))
1856	(jne dest))
1857
1858	(define-x8632-vinsn fixnum->single-float (((f :single-float))
1859	((arg :lisp))
1860	((unboxed :s32)))
1861	(movl (:%l arg) (:%l unboxed))
1862	(sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1863	(cvtsi2ssl (:%l unboxed) (:%xmm f)))
1864
1865	(define-x8632-vinsn fixnum->double-float (((f :double-float))
1866	((arg :lisp))
1867	((unboxed :s32)))
1868	(movl (:%l arg) (:%l unboxed))
1869	(sarl (:$ub x8632::fixnumshift) (:%l unboxed))
1870	(cvtsi2sdl (:%l unboxed) (:%xmm f)))
1871
1872	(define-x8632-vinsn xchg-registers (()
1873	((a t)
1874	(b t)))
1875	(xchgl (:%l a) (:%l b)))
1876
1877	(define-x8632-vinsn establish-fn (()
1878	())
1879	(movl (:$self 0) (:%l x8632::fn)))
1880
1881
1882	(define-x8632-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
1883
1884	(define-x8632-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
1885
1886
1887	(define-x8632-vinsn character->code (((dest :u32))
1888	((src :lisp)))
1889	(movl (:%l src) (:%l dest))
1890	(sarl (:$ub x8632::charcode-shift) (:%l dest)))
1891
1892	(define-x8632-vinsn adjust-vsp (()
1893	((amount :s32const)))
1894	((:and (:pred >= amount -128) (:pred <= amount 127))
1895	(addl (:$b amount) (:%l x8632::esp)))
1896	((:not (:and (:pred >= amount -128) (:pred <= amount 127)))
1897	(addl (:$l amount) (:%l x8632::esp))))
1898
1899
1900	(define-x8632-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
1901	((spno :s32const)
1902	(y t)
1903	(z t))
1904	((entry (:label 1))))
1905	(:talign 5)
1906	(call (:@ spno))
1907	(movl (:$self 0) (:%l x8632::fn)))
1908
1909	(define-x8632-vinsn zero-double-float-register (((dest :double-float))
1910	())
1911	(movsd (:%xmm x8632::fpzero) (:%xmm dest)))
1912
1913	(define-x8632-vinsn zero-single-float-register (((dest :single-float))
1914	())
1915	(movss (:%xmm x8632::fpzero) (:%xmm dest)))
1916
1917	(define-x8632-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
1918	(define-x8632-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
1919	(define-x8632-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
1920
1921
1922	(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
1923
1924	(define-x8632-vinsn misc-element-count-fixnum (((dest :imm))
1925	((src :lisp))
1926	((temp :u32)))
1927	(movl (:@ x8632::misc-header-offset (:%l src)) (:%l temp))
1928	((:and (:pred >= (:apply %hard-regspec-value temp) x8632::eax)
1929	(:pred <= (:apply %hard-regspec-value temp) x8632::ebx))
1930	(movb (:$b 0) (:%b temp)))
1931	((:pred > (:apply %hard-regspec-value temp) x8632::ebx)
1932	(andl (:$l #xffffff00) (:%l temp)))
1933	(movl (:%l temp) (:%l dest))
1934	(shrl (:$ub (- x8632::num-subtag-bits x8632::fixnumshift)) (:%l dest)))
1935
1936
1937
1938	(define-x8632-vinsn %logior2 (((dest :imm))
1939	((x :imm)
1940	(y :imm)))
1941	((:pred =
1942	(:apply %hard-regspec-value x)
1943	(:apply %hard-regspec-value dest))
1944	(orl (:%l y) (:%l dest)))
1945	((:not (:pred =
1946	(:apply %hard-regspec-value x)
1947	(:apply %hard-regspec-value dest)))
1948	((:pred =
1949	(:apply %hard-regspec-value y)
1950	(:apply %hard-regspec-value dest))
1951	(orl (:%l x) (:%l dest)))
1952	((:not (:pred =
1953	(:apply %hard-regspec-value y)
1954	(:apply %hard-regspec-value dest)))
1955	(movl (:%l x) (:%l dest))
1956	(orl (:%l y) (:%l dest)))))
1957
1958	(define-x8632-vinsn %logand2 (((dest :imm))
1959	((x :imm)
1960	(y :imm)))
1961	((:pred =
1962	(:apply %hard-regspec-value x)
1963	(:apply %hard-regspec-value dest))
1964	(andl (:%l y) (:%l dest)))
1965	((:not (:pred =
1966	(:apply %hard-regspec-value x)
1967	(:apply %hard-regspec-value dest)))
1968	((:pred =
1969	(:apply %hard-regspec-value y)
1970	(:apply %hard-regspec-value dest))
1971	(andl (:%l x) (:%l dest)))
1972	((:not (:pred =
1973	(:apply %hard-regspec-value y)
1974	(:apply %hard-regspec-value dest)))
1975	(movl (:%l x) (:%l dest))
1976	(andl (:%l y) (:%l dest)))))
1977
1978	(define-x8632-vinsn %logxor2 (((dest :imm))
1979	((x :imm)
1980	(y :imm)))
1981	((:pred =
1982	(:apply %hard-regspec-value x)
1983	(:apply %hard-regspec-value dest))
1984	(xorl (:%l y) (:%l dest)))
1985	((:not (:pred =
1986	(:apply %hard-regspec-value x)
1987	(:apply %hard-regspec-value dest)))
1988	((:pred =
1989	(:apply %hard-regspec-value y)
1990	(:apply %hard-regspec-value dest))
1991	(xorl (:%l x) (:%l dest)))
1992	((:not (:pred =
1993	(:apply %hard-regspec-value y)
1994	(:apply %hard-regspec-value dest)))
1995	(movl (:%l x) (:%l dest))
1996	(xorl (:%l y) (:%l dest)))))
1997
1998	(define-x8632-subprim-call-vinsn (integer-sign) .SPinteger-sign)
1999
2000	(define-x8632-subprim-call-vinsn (misc-ref) .SPmisc-ref)
2001
2002	(define-x8632-subprim-call-vinsn (ksignalerr) .SPksignalerr)
2003
2004	(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
2005
2006	(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
2007
2008	(define-x8632-subprim-lea-jmp-vinsn (make-stack-gvector) .SPstkgvector)
2009
2010	(define-x8632-vinsn load-character-constant (((dest :lisp))
2011	((code :u32const))
2012	())
2013	(movl (:$l (:apply logior (:apply ash code 8) x8632::subtag-character))
2014	(:%l dest)))
2015
2016
2017	(define-x8632-vinsn setup-double-float-allocation (()
2018	())
2019	(movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
2020	(movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8664::imm1.l)))
2021
2022	(define-x8632-vinsn set-double-float-value (()
2023	((node :lisp)
2024	(val :double-float)))
2025	(movsd (:%xmm val) (:@ x8664::double-float.value (:%l node))))
2026
2027	(define-x8632-vinsn %natural+ (((result :u32))
2028	((result :u32)
2029	(other :u32)))
2030	(addl (:%l other) (:%l result)))
2031
2032	(define-x8632-vinsn %natural+-c (((result :u32))
2033	((result :u32)
2034	(constant :s32const)))
2035	(addl (:$l constant) (:%l result)))
2036
2037	(define-x8632-vinsn %natural- (((result :u32))
2038	((result :u32)
2039	(other :u32)))
2040	(subl (:%l other) (:%l result)))
2041
2042	(define-x8632-vinsn %natural--c (((result :u32))
2043	((result :u32)
2044	(constant :s32const)))
2045	(subl (:$l constant) (:%l result)))
2046
2047	(define-x8632-vinsn %natural-logior (((result :u32))
2048	((result :u32)
2049	(other :u32)))
2050	(orl (:%l other) (:%l result)))
2051
2052	(define-x8632-vinsn %natural-logior-c (((result :u32))
2053	((result :u32)
2054	(constant :s32const)))
2055	(orl (:$l constant) (:%l result)))
2056
2057	(define-x8632-vinsn %natural-logand (((result :u32))
2058	((result :u32)
2059	(other :u32)))
2060	(andl (:%l other) (:%l result)))
2061
2062	(define-x8632-vinsn %natural-logand-c (((result :u32))
2063	((result :u32)
2064	(constant :s32const)))
2065	(andl (:$l constant) (:%l result)))
2066
2067	(define-x8632-vinsn %natural-logxor (((result :u32))
2068	((result :u32)
2069	(other :u32)))
2070	(xorl (:%l other) (:%l result)))
2071
2072	(define-x8632-vinsn %natural-logxor-c (((result :u32))
2073	((result :u32)
2074	(constant :s32const)))
2075	(xorl (:$l constant) (:%l result)))
2076
2077	(define-x8632-vinsn natural-shift-left (((dest :u32))
2078	((dest :u32)
2079	(amt :u8const)))
2080	(shll (:$ub amt) (:%l dest)))
2081
2082	(define-x8632-vinsn natural-shift-right (((dest :u32))
2083	((dest :u32)
2084	(amt :u8const)))
2085	(shrl (:$ub amt) (:%l dest)))
2086
2087	(define-x8632-vinsn recover-fn (()
2088	())
2089	(movl (:$self 0) (:%l x8632::fn)))
2090
2091	;;; xxx probably wrong
2092	(define-x8632-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
2093	((spno :s32const)
2094	(x t)
2095	(y t)
2096	(z t))
2097	((entry (:label 1))))
2098	(:talign 5)
2099	(call (:@ spno))
2100	(movl (:$self 0) (:%l x8632::fn)))
2101
2102	(define-x8632-vinsn vcell-ref (((dest :lisp))
2103	((vcell :lisp)))
2104	(movl (:@ x8632::misc-data-offset (:%l vcell)) (:%l dest)))
2105
2106	(define-x8632-vinsn setup-vcell-allocation (()
2107	())
2108	(movl (:$l x8632::value-cell-header) (:%l x8632::imm0))
2109	(movd (:%l x8632::imm0) (:%mmx x8632::mm0))
2110	(movl (:$l (- x8632::value-cell.size x8632::fulltag-misc)) (:%l x8632::imm0)))
2111
2112	(define-x8632-vinsn %init-vcell (()
2113	((vcell :lisp)
2114	(closed :lisp)))
2115	(movl (:%l closed) (:@ x8632::value-cell.value (:%l vcell))))
2116
2117	;;; "old" mkunwind. Used by PROGV, since the binding of interrupt-level
2118	;;; on entry to the new mkunwind confuses the issue.
2119
2120	(define-x8632-vinsn (mkunwind :call :subprim-call) (()
2121	((protform-lab :label)
2122	(cleanup-lab :label)))
2123	(leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
2124	(leal (:@ (:^ cleanup-lab) (:%l x8632::fn)) (:%l x8632::xfn))
2125	(jmp (:@ .SPmkunwind)))
2126
2127
2128	;;; Funcall the function or symbol in temp0 and obtain the single
2129	;;; value that it returns.
2130	(define-x8632-vinsn funcall (()
2131	()
2132	((tag :u8)
2133	(entry (:label 1))))
2134	(movl (:%l x8632::temp0) (:%l tag))
2135	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2136	;; accumulator
2137	(andb (:$b x8632::tagmask) (:%accb tag))
2138	(cmpb (:$b x8632::tag-misc) (:%accb tag)))
2139	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2140	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2141	;; other register that can be treated as a byte
2142	(andb (:$b x8632::tagmask) (:%b tag))
2143	(cmpb (:$b x8632::tag-misc) (:%b tag)))
2144	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2145	;; non-byte register
2146	(andl (:$l x8632::tagmask) (:%l tag))
2147	(cmpl (:$b x8632::tag-misc) (:%l tag)))
2148	(jne :bad)
2149	(movl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
2150	(cmpl (:$b x8632::subtag-function) (:%l tag))
2151	(cmovel (:%l x8632::temp0) (:%l x8632::xfn))
2152	(je :call)
2153	(cmpl (:$b x8632::subtag-symbol) (:%l tag))
2154	(cmovel (:%l x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::xfn))
2155	(jne :bad)
2156	:call
2157	(:talign 5)
2158	(call (:%l x8632::xfn))
2159	(movl (:$self 0) (:%l x8632::fn))
2160	:bad
2161	(uuo-error-not-callable))
2162
2163	(define-x8632-vinsn tail-funcall (()
2164	()
2165	((tag :u8)))
2166	(movl (:%l x8632::temp0) (:%l tag))
2167	((:pred = (:apply %hard-regspec-value tag) x8632::eax)
2168	;; accumulator
2169	(andb (:$b x8632::tagmask) (:%accb tag))
2170	(cmpb (:$b x8632::tag-misc) (:%accb tag)))
2171	((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
2172	(:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
2173	;; other register that can be treated as a byte
2174	(andb (:$b x8632::tagmask) (:%b tag))
2175	(cmpb (:$b x8632::tag-misc) (:%b tag)))
2176	((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
2177	;; non-byte register
2178	(andl (:$l x8632::tagmask) (:%l tag))
2179	(cmpl (:$b x8632::tag-misc) (:%l tag)))
2180	(jne :bad)
2181	(movl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
2182	(cmpl (:$b x8632::subtag-function) (:%l tag))
2183	(cmovel (:%l x8632::temp0) (:%l x8632::xfn))
2184	(je :go)
2185	(cmpl (:$b x8632::subtag-symbol) (:%l tag))
2186	(cmovel (:%l x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::xfn))
2187	(jne :bad)
2188	:go
2189	(jmp (:%l x8664::xfn))
2190	:bad
2191	(uuo-error-not-callable))
2192
2193	;;; Magic numbers in here include the address of .SPcall-closure.
2194
2195	;;; movl $self, %fn
2196	;;; jmp *20660 (.SPcall-closure)
2197	(define-x8632-vinsn init-nclosure (()
2198	((closure :lisp)))
2199	(movb (:$b 4) (:@ x8632::misc-data-offset (:%l closure))) ;imm word count
2200	(movb (:$b #xbf) (:@ (+ x8632::misc-data-offset 2) (:%l closure))) ;movl $self, %fn
2201	(movl (:%l closure) (:@ (+ x8632::misc-data-offset 3) (:%l closure)))
2202	(movb (:$b #xff) (:@ (+ x8632::misc-data-offset 7) (:%l closure))) ;jmp
2203	(movl (:$l #x0050b425) (:@ (+ x8632::misc-data-offset 8) (:%l closure))) ;.SPcall-closure
2204	;; already aligned
2205	(movl (:%l closure) (:@ (+ x8632::misc-data-offset 16) (:%l closure))) ;self-reference entry
2206	(movb (:$b x8632::function-boundary-marker) (:@ (+ x8632::misc-data-offset 20) (:%l closure))))
2207
2208	(define-x8632-vinsn finalize-closure (((closure :lisp))
2209	((closure :lisp)))
2210	(nop))
2211
2212
2213	(define-x8632-vinsn (ref-symbol-value :call :subprim-call)
2214	(((val :lisp))
2215	((sym (:lisp (:ne val)))))
2216	(:talign 5)
2217	(call (:@ .SPspecrefcheck))
2218	(movl (:$self 0) (:%l x8632::fn)))
2219
2220	(define-x8632-vinsn %ref-symbol-value-inline (((dest :lisp))
2221	((src (:lisp (:ne dest))))
2222	((table :imm)
2223	(idx :imm)))
2224	(movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
2225	(rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
2226	(jae :symbol)
2227	(addl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l idx))
2228	(movl (:@ (:%l idx)) (:%l dest))
2229	(cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
2230	(jne :done)
2231	:symbol
2232	(movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
2233	:done)
2234
2235	(define-x8632-subprim-lea-jmp-vinsn (bind-nil) .SPbind-nil)
2236
2237	(define-x8632-subprim-lea-jmp-vinsn (bind-self) .SPbind-self)
2238
2239	(define-x8632-subprim-lea-jmp-vinsn (bind-self-boundp-check) .SPbind-self-boundp-check)
2240
2241	(define-x8632-subprim-lea-jmp-vinsn (bind) .SPbind)
2242
2243	(define-x8632-vinsn (dpayback :call :subprim-call) (()
2244	((n :s16const))
2245	((temp (:u32 #.x8632::imm0))
2246	(entry (:label 1))))
2247	((:pred > n 0)
2248	((:pred > n 1)
2249	(movl (:$l n) (:%l temp))
2250	(:talign 4)
2251	(call (:@ .SPunbind-n)))
2252	((:pred = n 1)
2253	(:talign 5)
2254	(call (:@ .SPunbind)))
2255	(movl (:$self 0) (:%l x8632::fn))))
2256
2257	(define-x8632-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
2258
2259	(define-x8632-subprim-call-vinsn (make-stack-list) .Spmakestacklist)
2260
2261	(define-x8632-vinsn node-slot-ref (((dest :lisp))
2262	((node :lisp)
2263	(cellno :u32const)))
2264	(movl (:@ (:apply + x8632::misc-data-offset (:apply ash cellno 2))
2265	(:%l node)) (:%l dest)))
2266
2267	(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list) .SPstkconslist)
2268
2269
2270	(define-x8632-vinsn (setq-special :call :subprim-call)
2271	(()
2272	((sym :lisp)
2273	(val :lisp))
2274	((entry (:label 1))))
2275	(:talign 5)
2276	(call (:@ .SPspecset))
2277	(movl (:$self 0) (:%l x8632::fn)))
2278
2279	(define-x8632-vinsn %symptr->symvector (((target :lisp))
2280	((target :lisp)))
2281	(nop))
2282
2283	(define-x8632-vinsn %symvector->symptr (((target :lisp))
2284	((target :lisp)))
2285	(nop))
2286
2287	(define-x8632-vinsn symbol-function (((val :lisp))
2288	((sym (:lisp (:ne val))))
2289	((tag :u8)))
2290	(movl (:@ x8632::symbol.fcell (:%l sym)) (:%l val))
2291	(movl (:%l val) (:%l tag))
2292	(andb (:$b x8632::tagmask) (:%b tag))
2293	(cmpb (:$b x8632::tag-misc) (:%b tag))
2294	(jne.pn :bad)
2295	(movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
2296	(cmpb (:$b x8632::subtag-function) (:%b tag))
2297	(je.pt :ok)
2298	:bad
2299	(uuo-error-udf (:%l sym))
2300	:ok)
2301
2302	(define-x8632-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
2303
2304	(define-x8632-vinsn load-double-float-constant (((dest :double-float))
2305	((lab :label)))
2306	(movsd (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
2307
2308	(define-x8632-vinsn load-single-float-constant (((dest :single-float))
2309	((lab :label)))
2310	(movss (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
2311
2312	(define-x8632-subprim-call-vinsn (misc-set) .SPmisc-set)
2313
2314	(define-x8632-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
2315
2316	(define-x8632-subprim-lea-jmp-vinsn (spread-list) .SPspreadargz)
2317
2318	(define-x8632-vinsn unbox-base-char (((dest :u32))
2319	((src :lisp)))
2320	(movl (:%l src) (:%l dest))
2321	((:pred = (:apply %hard-regspec-value dest) x8632::eax)
2322	(cmpb (:$b x8632::subtag-character) (:%accb dest)))
2323	((:and (:pred > (:apply %hard-regspec-value dest) x8632::eax)
2324	(:pred <= (:apply %hard-regspec-value dest) x8632::ebx))
2325	(cmpb (:$b x8632::subtag-character) (:%b dest)))
2326	((:pred > (:apply %hard-regspec-value dest) x8632::ebx)
2327	;; very rare case, if even possible...
2328	(andl (:$l #xff) (:%l dest))
2329	(cmpl (:$b x8632::subtag-character) (:%l dest))
2330	(cmovel (:%l src) (:%l dest)))
2331	(je.pt ::got-it)
2332	(uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-character))
2333	:got-it
2334	(shrl (:$ub x8632::charcode-shift) (:%l dest)))
2335
2336	(define-x8632-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
2337
2338	(define-x8632-subprim-lea-jmp-vinsn (recover-values) .SPrecover-values)
2339
2340	(define-x8632-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
2341
2342	(define-x8632-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
2343
2344	(define-x8632-subprim-call-vinsn (make-stack-block) .SPmakestackblock)
2345
2346	(define-x8632-subprim-call-vinsn (make-stack-block0) .Spmakestackblock0)
2347
2348	;;; "dest" is preallocated, presumably on a stack somewhere.
2349	(define-x8632-vinsn store-double (()
2350	((dest :lisp)
2351	(source :double-float))
2352	())
2353	(movsd (:%xmm source) (:@ x8632::double-float.value (:%l dest))))
2354
2355
2356	(define-x8632-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
2357
2358	(define-x8632-vinsn %init-gvector (()
2359	((v :lisp)
2360	(nbytes :u32const))
2361	((count :imm)))
2362	(movl (:$l nbytes) (:%l count))
2363	(jmp :test)
2364	:loop
2365	(popl (:@ x8632::misc-data-offset (:%l v) (:%l count)))
2366	:test
2367	(subl (:$b x8632::node-size) (:%l count))
2368	(jge :loop))
2369
2370	(define-x8632-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
2371
2372	(define-x8632-vinsn nth-value (((result :lisp))
2373	()
2374	((temp :imm)))
2375	(movzwl (:%w x8632::nargs) (:%l x8632::nargs))
2376	(leal (:@ (:%l x8632::esp) (:%l x8632::nargs)) (:%l temp))
2377	(subl (:@ (:%l temp)) (:%l x8632::nargs))
2378	(movl (:$l x8632::nil-value) (:%l result))
2379	(jle :done)
2380	;; I -think- that a CMOV would be safe here, assuming that N wasn't
2381	;; extremely large. Don't know if we can assume that.
2382	(movl (:@ (- x8632::node-size) (:%l x8632::esp) (:%l x8632::nargs)) (:%l result))
2383	:done
2384	(leal (:@ x8632::node-size (:%l temp)) (:%l x8632::esp)))
2385
2386
2387	(define-x8632-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
2388
2389	(define-x8632-subprim-call-vinsn (stack-misc-alloc-init) .SPstack-misc-alloc-init)
2390
2391	(define-x8632-vinsn fixnum->unsigned-natural (((dest :u32))
2392	((src :imm)))
2393	(movl (:%l src) (:%l dest))
2394	(shrl (:$ub x8632::fixnumshift) (:%l dest)))
2395
2396	(define-x8632-vinsn %debug-trap (()
2397	())
2398	(uuo-error-debug-trap))
2399
2400
2401
2402
2403
2404	(define-x8632-vinsn %slot-ref (((dest :lisp))
2405	((instance (:lisp (:ne dest)))
2406	(index :lisp)))
2407	(movl (:@ x8632::misc-data-offset (:%l instance) (:%l index)) (:%l dest))
2408	(cmpl (:$l x8664::slot-unbound-marker) (:%l dest))
2409	(jne.pt :ok)
2410	(uuo-error-slot-unbound (:%l dest) (:%l instance) (:%l index))
2411	:ok)
2412
2413	(define-x8632-vinsn symbol-ref (((dest :lisp))
2414	((src :lisp)
2415	(cellno :u32const)))
2416	(movl (:@ (:apply + (- x8632::node-size x8632::fulltag-misc)
2417	(:apply ash cellno 2))
2418	(:%l src)) (:%l dest)))
2419
2420	(define-x8632-subprim-call-vinsn (progvsave) .SPprogvsave)
2421
2422	(define-x8632-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
2423
2424	(define-x8632-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
2425
2426	(define-x8632-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
2427
2428	(define-x8632-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
2429
2430	(define-x8632-vinsn scale-nargs (()
2431	((nfixed :s16const)))
2432	((:pred > nfixed 0)
2433	(addw (:$w (:apply - (:apply ash nfixed x8632::word-shift))) (:%w x8632::nargs))))
2434
2435
2436	;; num-opt in arg_z
2437	(define-x8632-vinsn opt-supplied-p (()
2438	())
2439	(subw (:%w x8632::nargs) (:%w x8632::arg_z))
2440	(jmp :push-t-test)
2441	:push-t-loop
2442	(pushl (:$l x8632::t-value))
2443	:push-t-test
2444	(subw (:$w x8632::node-size) (:%w x8632::nargs))
2445	(jge :push-t-loop)
2446	(jmp :push-nil-test)
2447	:push-nil-loop
2448	(pushl (:$l x8632::nil-value))
2449	:push-nil-test
2450	(subw (:$w x8632::node-size) (:%w x8632::arg_z))
2451	(jge :push-nil-loop))
2452
2453	(define-x8632-vinsn one-opt-supplied-p (()
2454	())
2455	(testw (:%w x8664::nargs) (:%w x8664::nargs))
2456	(je :one)
2457	(pushl (:$l x8632::nil-value))
2458	(jmp :done)
2459	:one
2460	(pushl (:$l x8632::t-value))
2461	:done)
2462
2463	;; needs some love
2464	(define-x8632-vinsn two-opt-supplied-p (()
2465	())
2466	;; note that nargs is imm0
2467	(rcmpw (:%w x8632::nargs) (:$w (:apply ash 2 x8632::word-shift)))
2468	(jge :two)
2469	(rcmpw (:%w x8632::nargs) (:$w (:apply ash 1 x8632::word-shift)))
2470	(je :one)
2471	;; none
2472	(pushl (:$l x8632::nil-value))
2473	(pushl (:$l x8632::nil-value))
2474	(jmp :done)
2475	:one
2476	(pushl (:$l x8632::t-value))
2477	(pushl (:$l x8632::nil-value))
2478	(jmp :done)
2479	:two
2480	(pushl (:$l x8632::t-value))
2481	(pushl (:$l x8632::t-value))
2482	:done)
2483
2484	(define-x8632-vinsn set-c-flag-if-constant-logbitp (()
2485	((bit :u8const)
2486	(int :imm)))
2487	(btl (:$ub bit) (:%l int)))
2488
2489	(define-x8632-vinsn mark-as-imm (()
2490	((reg :lisp)))
2491	(btrl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
2492
2493	(define-x8632-vinsn mark-as-node (()
2494	((reg :lisp)))
2495	(xorl (:%l reg) (:%l reg))
2496	(btsl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
2497
2498	(queue-fixup
2499	(fixup-x86-vinsn-templates
2500	x8632-vinsn-templates
2501	x86::x86-opcode-template-lists))
2502

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

Download in other formats: