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