source: release/1.10/source/compiler/X86/X8632/x8632-vinsns.lisp

Last change on this file was 16235, checked in by R. Matthew Emerson, 10 years ago

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