source: trunk/source/level-0/X86/X8632/x8632-misc.lisp @ 10575

Last change on this file since 10575 was 10575, checked in by gb, 11 years ago

Use (:rcontext ..) syntax.

File size: 24.3 KB
Line 
1(in-package "CCL")
2
3;;; Copy N bytes from pointer src, starting at byte offset src-offset,
4;;; to ivector dest, starting at offset dest-offset.
5;;; It's fine to leave this in lap.
6;;; Depending on alignment, it might make sense to move more than
7;;; a byte at a time.
8;;; Does no arg checking of any kind.  Really.
9
10;;; I went ahead and used the INC and DEC instructions here, since
11;;; they're shorter than the equivalent ADD/SUB.  Intel's optimization
12;;; manual advises avoiding INC and DEC because they might cause
13;;; dependencies on earlier instructions that set the flags.  So, if
14;;; these functions end up being hot, replacing the inc/dec insns
15;;; might be worth a try.
16
17(defx8632lapfunction %copy-ptr-to-ivector ((src 12)
18                                           (src-byte-offset 8)
19                                           (dest 4)
20                                           #|(ra 0)|#
21                                           (dest-byte-offset arg_y)
22                                           (nbytes arg_z))
23  (mark-as-imm temp0)
24  (mark-as-imm arg_y)
25  (let ((foreign-ptr temp0)             ;raw foreign pointer
26        (ivector temp1)                 ;destination ivector
27        (j arg_y))                      ;unboxed index into ivector
28    (movl (@ src (% esp)) (% temp1))
29    (macptr-ptr temp1 foreign-ptr)
30    (movl (@ src-byte-offset (% esp)) (% temp1))
31    (unbox-fixnum temp1 imm0)
32    (addl (% imm0) (% foreign-ptr))     ;point to starting byte in src
33    (movl (@ dest (% esp)) (% ivector))
34    (sarl ($ x8632::fixnumshift) (% j)) ;unbox dest-byte-offset
35    (testl (% nbytes) (% nbytes))
36    (jmp @test)
37    @loop
38    (movb (@ (% foreign-ptr)) (%b imm0))
39    (incl (% foreign-ptr))
40    (movb (%b imm0) (@ x8632::misc-data-offset (% ivector) (% j)))
41    (incl (% j))
42    (subl ($ '1) (% nbytes))
43    @test
44    (jne @loop)
45    (movl (% ivector) (% arg_z)))
46  (mark-as-node temp0)
47  (mark-as-node arg_y)
48  (single-value-return 5))
49
50(defx8632lapfunction %copy-ivector-to-ptr ((src 12)
51                                           (src-byte-offset 8)
52                                           (dest 4)
53                                           #|(ra 0)|#
54                                           (dest-byte-offset arg_y)
55                                           (nbytes arg_z))
56  (mark-as-imm temp0)
57  (mark-as-imm arg_y)
58  (let ((foreign-ptr temp0)             ;raw foreign pointer
59        (ivector temp1)                 ;source ivector
60        (j arg_y))                      ;unboxed index into ivector
61    (movl (@ dest (% esp)) (% temp1))
62    (macptr-ptr temp1 foreign-ptr)
63    (unbox-fixnum dest-byte-offset imm0)
64    (addl (% imm0) (% foreign-ptr))     ;point to starting byte in dest
65    (movl (@ src (% esp)) (% ivector))
66    (movl (@ src-byte-offset (% esp)) (% j))
67    (sarl ($ x8632::fixnumshift) (% j)) ;unbox src-byte-offset
68    (test (% nbytes) (% nbytes))
69    (jmp @test)
70    @loop
71    (movb (@ x8632::misc-data-offset (% ivector) (% j)) (%b imm0))
72    (incl (% j))
73    (movb (%b imm0) (@ (% foreign-ptr)))
74    (incl (% foreign-ptr))
75    (subl ($ '1) (% nbytes))
76    @test
77    (jne @loop)
78    (movl (@ dest (% esp)) (% arg_z)))
79  (mark-as-node temp0)
80  (mark-as-node arg_y)
81  (single-value-return 5))
82
83(defx8632lapfunction %copy-ivector-to-ivector ((src 12) 
84                                               (src-byte-offset 8)
85                                               (dest 4)
86                                               #|(ra 0)|#
87                                               (dest-byte-offset arg_y)
88                                               (nbytes arg_z))
89  (movl (@ src (% esp)) (% temp0))
90  (movl (@ src-byte-offset (% esp)) (% temp1))
91  (unbox-fixnum nbytes imm0)            ;will be used below
92  (push (% nbytes))                     ;put loop counter on stack
93  (movl (@ (+ 4 dest) (% esp)) (% arg_z))
94  (mark-as-imm temp1)
95  (mark-as-imm arg_y)
96  (sarl ($ x8632::fixnumshift) (% temp1)) ;unboxed src index
97  (sarl ($ x8632::fixnumshift) (% arg_y)) ;unboxed dest index
98  (let ((a temp0)
99        (i temp1)
100        (b arg_z)
101        (j arg_y))
102    ;; copy nbytes starting at a[i] to b[j]
103    (cmpl (% b) (% a))
104    (jne @front)
105    (cmpl (% i) (% j))
106    (jg @back)
107    @front
108    (testl (% imm0) (% imm0))           ;test nbytes
109    (jmp @front-test)
110    @front-loop
111    (movb (@ x8632::misc-data-offset (% a) (% i)) (%b imm0))
112    (movb (%b imm0) (@ x8632::misc-data-offset (% b) (% j)))
113    (incl (% i))
114    (incl (% j))
115    (subl ($ '1) (@ (% esp)))
116    @front-test
117    (jne @front-loop)
118    (jmp @done)
119    @back
120    ;; unboxed nbytes in imm0
121    (addl (% imm0) (% i))
122    (addl (% imm0) (% j))
123    (testl (% imm0) (% imm0))
124    (jmp @back-test)
125    @back-loop
126    (decl (% i))
127    (decl (% j))
128    (movb (@ x8632::misc-data-offset (% a) (% i)) (%b imm0))
129    (movb (%b imm0) (@ x8632::misc-data-offset (% b) (% j)))
130    (subl ($ '1) (@ (% esp)))
131    @back-test
132    (jne @back-loop)
133    @done
134    ;; dest already in arg_z
135    (addl ($ 4) (% esp))                ;pop nbytes
136    (mark-as-node temp1)
137    (mark-as-node arg_y)
138    (single-value-return 5)))
139
140(defx8632lapfunction %copy-gvector-to-gvector ((src 12)
141                                               (src-element 8)
142                                               (dest 4)
143                                               #|(ra 0)|#
144                                               (dest-element arg_y)
145                                               (nelements arg_z))
146  (let ((a temp0)
147        (i imm0)
148        (b arg_z)
149        (j arg_y)
150        (val temp1))
151    (movl (% nelements) (% val))     ;will be used below
152    (push (% nelements))             ;loop counter on stack (use ebp?)
153    (movl (@ (+ 4 src) (% esp)) (% a))
154    (movl (@ (+ 4 src-element) (% esp)) (% i))
155    (movl (@ (+ 4 dest) (% esp)) (% b))
156    ;; j/arg_y already set
157    (cmpl (% a) (% b))
158    (jne @front)
159    (rcmp (% i) (% j))
160    (jl @back)
161    @front
162    (testl (% val) (% val))             ;test nelements
163    (jmp @front-test)
164    @front-loop
165    (movl (@ x8632::misc-data-offset (% a) (% i)) (% val))
166    (movl (% val) (@ x8632::misc-data-offset (% b) (% j)))
167    (addl ($ '1) (% i))
168    (addl ($ '1) (% j))
169    (subl ($ '1) (@ (% esp)))
170    @front-test
171    (jne @front-loop)
172    (jmp @done)
173    @back
174    ;; nelements in val (from above)
175    (addl (% val) (% i))
176    (addl (% val) (% j))
177    (testl (% val) (% val))
178    (jmp @back-test)
179    @back-loop
180    (subl ($ '1) (% i))
181    (subl ($ '1) (% j))
182    (movl (@ x8632::misc-data-offset (% a) (% i)) (% val))
183    (movl (% val) (@ x8632::misc-data-offset (% b) (% j)))
184    (subl ($ '1) (@ (% esp)))
185    @back-test
186    (jne @back-loop)
187    @done
188    ;; dest already in arg_z
189    (addl ($ 4) (% esp))                ;pop loop counter
190    (single-value-return 5)))
191
192(defx8632lapfunction %heap-bytes-allocated ()
193  (movl (@ (% :rcontext) x8632::tcr.save-allocptr) (% temp1))
194  (movl (@ (% :rcontext) x8632::tcr.last-allocptr) (% temp0))
195  (cmpl ($ -8) (% temp1))               ;void_allocptr
196  (movq (@ (% :rcontext) x8632::tcr.total-bytes-allocated-low) (% mm0))
197  (jz @go)
198  (movl (% temp0) (% arg_y))
199  (subl (% temp1) (% temp0))
200  (testl (% arg_y) (% arg_y))
201  (jz @go)
202  (movd (% temp0) (% mm1))
203  (paddq (% mm1) (% mm0))
204  @go
205  (jmp-subprim .SPmakeu64))
206
207(defx8632lapfunction values ()
208  (:arglist (&rest values))
209  (save-frame-variable-arg-count)
210  (push-argregs)
211  (jmp-subprim .SPnvalret))
212
213(defx8632lapfunction rdtsc ()
214  (mark-as-imm temp1)                   ;aka edx
215  (:byte #x0f)                          ;two-byte rdtsc opcode
216  (:byte #x31)                          ;is #x0f #x31
217  (box-fixnum imm0 arg_z)
218  (mark-as-node temp1)
219  (single-value-return))
220
221;;; Return all 64 bits of the time-stamp counter as an unsigned integer.
222(defx8632lapfunction rdtsc64 ()
223  (mark-as-imm temp1)                   ;aka edx
224  (:byte #x0f)                          ;two-byte rdtsc opcode
225  (:byte #x31)                          ;is #x0f #x31
226  (movd (% eax) (% mm0))
227  (movd (% edx) (% mm1))
228  (psllq ($ 32) (% mm1))
229  (por (% mm1) (% mm0))
230  (mark-as-node temp1)
231  (jmp-subprim .SPmakeu64))
232
233;;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
234;;; ash::fixnumshift)) would do this inline.
235
236(defx8632lapfunction %setf-macptr-to-object ((macptr arg_y) (object arg_z))
237  (check-nargs 2)
238  (trap-unless-typecode= macptr x8632::subtag-macptr)
239  (movl (% object) (@ x8632::macptr.address (% macptr)))
240  (single-value-return))
241
242(defx8632lapfunction %fixnum-from-macptr ((macptr arg_z))
243  (check-nargs 1)
244  (trap-unless-typecode= arg_z x8632::subtag-macptr)
245  (movl (@ x8632::macptr.address (% arg_z)) (% imm0))
246  (mark-as-imm temp0)
247  (let ((imm1 temp0))
248    (trap-unless-lisptag= imm0 x8632::tag-fixnum imm1))
249  (mark-as-node temp0)
250  (movl (% imm0) (% arg_z))
251  (single-value-return))
252
253(defx8632lapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
254  (trap-unless-typecode= ptr x8632::subtag-macptr)
255  (mark-as-imm temp0)
256  (let ((imm1 temp0))
257    (macptr-ptr ptr imm1)
258    (unbox-fixnum offset imm0)
259    (movq (@ (% imm1) (% imm0)) (% mm0)))
260  (mark-as-node temp0)
261  (jmp-subprim .SPmakeu64))
262
263(defx8632lapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
264  (trap-unless-typecode= ptr x8632::subtag-macptr)
265  (mark-as-imm temp0)
266  (let ((imm1 temp0))
267    (macptr-ptr ptr imm1)
268    (unbox-fixnum offset imm0)
269    (movq (@ (% imm1) (% imm0)) (% mm0)))
270  (mark-as-node temp0)
271  (jmp-subprim .SPmakes64))
272
273(defx8632lapfunction %%set-unsigned-longlong ((ptr 4)
274                                              #|(ra 0)|#
275                                              (offset arg_y)
276                                              (val arg_z))
277  (mark-as-imm temp1)
278  (let ((rptr temp0)
279        (imm1 temp1))
280    (save-simple-frame)
281    (movl (@ ptr (% esp)) (% rptr))
282    (trap-unless-typecode= rptr x8632::subtag-macptr)
283    (call-subprim .SPgetu64)
284    (macptr-ptr rptr imm0)
285    (unbox-fixnum offset imm1)
286    (movq (% mm0) (@ (% imm0) (% imm1)))
287    (restore-simple-frame))
288  (mark-as-node temp1)
289  (single-value-return 3))
290
291(defx8632lapfunction %%set-signed-longlong ((ptr 4)
292                                            #|(ra 0)|#
293                                            (offset arg_y)
294                                            (val arg_z))
295  (mark-as-imm temp1)
296  (let ((rptr temp0)
297        (imm1 temp1))
298    (save-simple-frame)
299    (movl (@ ptr (% esp)) (% rptr))
300    (trap-unless-typecode= rptr x8632::subtag-macptr)
301    (call-subprim .SPgets64)
302    (macptr-ptr rptr imm0)
303    (unbox-fixnum offset imm1)
304    (movq (% mm0) (@ (% imm0) (% imm1)))
305    (restore-simple-frame))
306  (mark-as-node temp1)
307  (single-value-return 3))
308
309(defx8632lapfunction interrupt-level ()
310  (movl (@ (% :rcontext) x8632::tcr.tlb-pointer) (% imm0))
311  (movl (@ x8632::interrupt-level-binding-index (% imm0)) (% arg_z))
312  (single-value-return))
313
314(defx8632lapfunction set-interrupt-level ((new arg_z))
315  (movl (@ (% :rcontext) x8632::tcr.tlb-pointer) (% imm0))
316  (trap-unless-fixnum new)
317  (movl (% new) (@ x8632::interrupt-level-binding-index (% imm0)))
318  (single-value-return))
319
320(defx8632lapfunction %current-tcr ()
321  (movl (@ (% :rcontext) x8632::tcr.linear) (% arg_z))
322  (single-value-return))
323
324(defx8632lapfunction %tcr-toplevel-function ((tcr arg_z))
325  (check-nargs 1)
326  (movl (@ x8632::tcr.vs-area (% tcr)) (% temp0))
327  (movl (@ x8632::area.high (% temp0)) (% imm0)) ;bottom of vstack
328  (cmpl (% tcr) (@ (% :rcontext) x8632::tcr.linear))
329  (jz @myself)
330  (cmpl (% imm0) (@ x8632::area.active (% temp0)))
331  (jmp @finish)
332  @myself
333  (cmpl (% imm0) (% esp))
334  @finish
335  (movl ($ x8632::nil-value) (% arg_z))
336  (cmovnel (@ (- x8632::node-size) (% imm0)) (% arg_z))
337  (single-value-return))
338 
339(defx8632lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
340  (check-nargs 2)
341  (movl (@ x8632::tcr.vs-area (% tcr)) (% temp0))
342  (movl (@ x8632::area.high (% temp0)) (% imm0))
343  (cmpl (% tcr) (@ (% :rcontext) x8632::tcr.linear))
344  (jz @myself)
345  (cmpl (% imm0) (@ x8632::area.active (% temp0))) ;vstack empty?
346  (jmp @room)
347  @myself
348  (cmpl (% imm0) (% esp))
349  @room
350  (leal (@ (- x8632::node-size) (% imm0)) (% imm0))
351  (movl ($ 0) (@ (% imm0)))
352  (jne @have-room)
353  (movl (% imm0) (@ x8632::area.active (% temp0)))
354  (movl (% imm0) (@ x8632::tcr.save-vsp (% tcr)))
355  (jmp @have-room)
356  @have-room
357  (movl (% fun) (@ (% imm0)))
358  (single-value-return))
359
360;;; This needs to be done out-of-line, to handle EGC memoization.
361(defx8632lapfunction %store-node-conditional ((offset 8)
362                                              (object 4)
363                                              #|(ra 0)|#
364                                              (old arg_y)
365                                              (new arg_z))
366  (movl (@ offset (% esp)) (% temp0))
367  (movl (@ object (% esp)) (% temp1))
368  (save-simple-frame)
369  (call-subprim .SPstore-node-conditional)
370  (restore-simple-frame)
371  (single-value-return 4))
372
373(defx8632lapfunction %store-immediate-conditional ((offset 8)
374                                                   (object 4)
375                                                   #|(ra 0)|#
376                                                   (old arg_y)
377                                                   (new arg_z))
378  (mark-as-imm temp0)
379  (let ((imm1 temp0)
380        (robject temp1))
381    (movl (@ offset (% esp)) (% imm1))
382    (sarl ($ x8632::fixnumshift) (% imm1))
383    (movl (@ object (% esp)) (% robject))
384    @again
385    (movl (@ (% robject) (% imm1)) (% eax))
386    (cmpl (% eax) (% old))
387    (jne @lose)
388    (lock)
389    (cmpxchgl (% new) (@ (% robject) (% imm1)))
390    (jne @again)
391    (movl ($ x8632::t-value) (% arg_z))
392    (mark-as-node temp0)
393    (single-value-return 4)
394    @lose
395    (movl ($ x8632::nil-value) (% arg_z))
396    (mark-as-node temp0)
397    (single-value-return 4)))
398
399(defx8632lapfunction set-%gcable-macptrs% ((ptr arg_z))
400  @again
401  (movl (@ (+ x8632::nil-value (x8632::kernel-global gcable-pointers))) (% eax))
402  (movl (% eax) (@ x8632::xmacptr.link (% ptr)))
403  (lock)
404  (cmpxchgl (% ptr) (@ (+ x8632::nil-value (x8632::kernel-global gcable-pointers))))
405  (jne @again)
406  (single-value-return))
407
408;;; Atomically increment or decrement the gc-inhibit-count kernel-global
409;;; (It's decremented if it's currently negative, incremented otherwise.)
410(defx8632lapfunction %lock-gc-lock ()
411  @again
412  (movl (@ (+ x8632::nil-value (x8632::kernel-global gc-inhibit-count))) (% eax))
413  (lea (@ '-1 (% eax)) (% temp0))
414  (lea (@ '1 (% eax)) (% arg_z))
415  (test (% eax) (% eax))
416  (cmovsl (% temp0) (% arg_z))
417  (lock)
418  (cmpxchgl (% arg_z) (@ (+ x8632::nil-value (x8632::kernel-global gc-inhibit-count))))
419  (jnz @again)
420  (single-value-return))
421
422;;; Atomically decrement or increment the gc-inhibit-count kernel-global
423;;; (It's incremented if it's currently negative, incremented otherwise.)
424;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
425(defx8632lapfunction %unlock-gc-lock ()
426  @again
427  (movl (@ (+ x8632::nil-value (x8632::kernel-global gc-inhibit-count)))
428        (% eax))
429  (lea (@ '1 (% eax)) (% temp0))
430  (cmpl ($ -1) (% eax))
431  (lea (@ '-1 (% eax)) (% arg_z))
432  (cmovlel (% temp0) (% arg_z))
433  (lock)
434  (cmpxchgl (% arg_z) (@ (+ x8632::nil-value (x8632::kernel-global gc-inhibit-count))))
435  (jne @again)
436  (cmpl ($ '-1) (% eax))
437  (jne @done)
438  ;; The GC tried to run while it was inhibited.  Unless something else
439  ;; has just inhibited it, it should be possible to GC now.
440  (mov ($ arch::gc-trap-function-immediate-gc) (% imm0))
441  (uuo-gc-trap)
442  @done
443  (single-value-return))
444
445(defx8632lapfunction %atomic-incf-node ((by 4) #|(ra 0)|# (node arg_y) (disp arg_z))
446  (check-nargs 3)
447  (mark-as-imm temp0)
448  (let ((imm1 temp0)
449        (rby temp1))
450    (movl (@ by (% esp)) (% rby))
451    (unbox-fixnum disp imm1)
452    @again
453    (movl (@ (% node) (% imm1)) (% eax))
454    (lea (@ (% eax) (% rby)) (% arg_z))
455    (lock)
456    (cmpxchgl (% arg_z) (@ (% node) (% imm1)))
457    (jne @again))
458  (mark-as-node temp0)
459  (single-value-return 3))
460
461(defx8632lapfunction %atomic-incf-ptr ((ptr arg_z))
462  (mark-as-imm temp0)
463  (mark-as-imm temp1)
464  (let ((imm1 temp0)
465        (imm2 temp1))
466    (macptr-ptr ptr imm2)
467    @again
468    (movl (@ (% imm2)) (% eax))
469    (lea (@ 1 (% eax)) (% imm1))
470    (lock)
471    (cmpxchgl (% imm1) (@ (% imm2)))
472    (jne @again)
473    (box-fixnum imm1 arg_z))
474  (mark-as-node temp0)
475  (mark-as-node temp1)
476  (single-value-return))
477
478(defx8632lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
479  (mark-as-imm temp0)
480  (mark-as-imm temp1)
481  (let ((imm1 temp0)
482        (imm2 temp1))
483    (macptr-ptr ptr imm2)
484    @again
485    (movl (@ (% imm2)) (% eax))
486    (unbox-fixnum by imm1)
487    (add (% eax) (% imm1))
488    (lock)
489    (cmpxchgl (% imm1) (@ (% imm2)))
490    (jnz @again)
491    (box-fixnum imm1 arg_z))
492  (mark-as-node temp0)
493  (mark-as-node temp1)
494  (single-value-return))
495
496(defx8632lapfunction %atomic-decf-ptr ((ptr arg_z))
497  (mark-as-imm temp0)
498  (mark-as-imm temp1)
499  (let ((imm1 temp0)
500        (imm2 temp1))
501    (macptr-ptr ptr imm2)
502    @again
503    (movl (@ (% imm2)) (% eax))
504    (lea (@ -1 (% eax)) (% imm1))
505    (lock)
506    (cmpxchgl (% imm1) (@ (% imm2)))
507    (jne @again)
508    (box-fixnum imm1 arg_z))
509  (mark-as-node temp0)
510  (mark-as-node temp1)
511  (single-value-return))
512
513(defx8632lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
514  (mark-as-imm temp0)
515  (mark-as-imm temp1)
516  (let ((imm1 temp0)
517        (imm2 temp1))
518    (macptr-ptr ptr imm2)
519    @again
520    (movl (@ (% imm2)) (% eax))
521    (testl (% eax) (% eax))
522    (lea (@ -1 (% eax)) (% imm1))
523    (jz @done)
524    (lock)
525    (cmpxchgl (% imm1) (@ (% imm2)))
526    (jnz @again)
527    @done
528    (box-fixnum imm1 arg_z))
529  (mark-as-node temp0)
530  (mark-as-node temp1)
531  (single-value-return))
532
533(defx8632lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
534  (mark-as-imm temp0)
535  (let ((imm1 temp0))
536    (macptr-ptr arg_y imm1)
537    (unbox-fixnum newval imm0)
538    (lock)
539    (xchgl (% imm0) (@ (% imm1)))
540    (box-fixnum imm0 arg_z))
541  (mark-as-node temp0)
542  (single-value-return))
543
544;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
545;;; was equal to OLDVAL.  Return the old value
546(defx8632lapfunction %ptr-store-conditional ((ptr 4) #|(ra 0)|# (expected-oldval arg_y) (newval arg_z))
547  (mark-as-imm temp1)
548  (let ((imm2 temp1))
549    (movl (@ ptr (% esp)) (% temp0))
550    (macptr-ptr temp0 imm2)
551    (mark-as-imm temp0)
552    (let ((imm1 temp0))
553      @again
554      (movl (@ (% imm2)) (% imm0))
555      (box-fixnum imm0 imm0)
556      (cmpl (% imm0) (% expected-oldval))
557      (jne @done)
558      (unbox-fixnum newval imm1)
559      (lock)
560      (cmpxchgl (% imm1) (@ (% imm2)))
561      (jne @again)
562      @done
563      (movl (% imm0) (% arg_z)))
564    (mark-as-node temp0))
565  (mark-as-node temp1)
566  (single-value-return 3))
567
568(defx8632lapfunction %ptr-store-fixnum-conditional ((ptr 4) #|(ra 0)|# (expected-oldval arg_y) (newval arg_z))
569  (mark-as-imm temp0)
570  (let ((address temp0))
571    (movl (@ ptr (% esp)) (% temp1))
572    (macptr-ptr temp1 address)
573    @again
574    (movl (@ (% address)) (% imm0))
575    (cmpl (% imm0) (% expected-oldval))
576    (jne @done)
577    (lock)
578    (cmpxchgl (% newval) (@ (% address)))
579    (jne @again)
580    @done
581    (movl (% imm0) (% arg_z)))
582  (mark-as-node temp0)
583  (single-value-return 3))
584
585(defx8632lapfunction xchgl ((newval arg_y) (ptr arg_z))
586  (unbox-fixnum newval imm0)
587  (macptr-ptr ptr arg_y)                ;better be aligned
588  (xchgl (% imm0) (@ (% arg_y)))
589  (box-fixnum imm0 arg_z)
590  (single-value-return))
591
592(defx8632lapfunction %macptr->dead-macptr ((macptr arg_z))
593  (check-nargs 1)
594  (movb ($ x8632::subtag-dead-macptr) (@ x8632::misc-subtag-offset (% macptr)))
595  (single-value-return))
596
597;;; %%apply-in-frame
598
599(defx8632lapfunction %%save-application ((flags arg_y) (fd arg_z))
600  (unbox-fixnum fd imm0)
601  (movd (% imm0) (% mm0))
602  (unbox-fixnum flags imm0)
603  (orl ($ arch::gc-trap-function-save-application) (% imm0))
604  (uuo-gc-trap)
605  (single-value-return))
606
607(defx8632lapfunction %misc-address-fixnum ((misc-object arg_z))
608  (check-nargs 1)
609  (lea (@ x8632::misc-data-offset (% misc-object)) (% arg_z))
610  (single-value-return))
611
612(defx8632lapfunction fudge-heap-pointer ((ptr 4) #|(ra 0)|# (subtype arg_y) (len arg_z))
613  (check-nargs 3)
614  (mark-as-imm temp0)
615  (let ((imm1 temp0))
616    (movl (@ ptr (% esp)) (% temp1))
617    (macptr-ptr temp1 imm1)           ; address in macptr
618    (lea (@ 9 (% imm1)) (% imm0))     ; 2 for delta + 7 for alignment
619    (andb ($ -8) (%b  imm0))          ; Clear low three bits to align
620    (subl (% imm0) (% imm1))          ; imm1 = -delta
621    (negw (%w imm1))
622    (movw (%w imm1) (@  -2 (% imm0)))   ; save delta halfword
623    (unbox-fixnum subtype imm1)         ; subtype at low end of imm1
624    (shll ($ (- x8632::num-subtag-bits x8632::fixnum-shift)) (% len))
625    (orl (% len) (% imm1))
626    (movl (% imm1) (@ (% imm0)))        ; store subtype & length
627    (lea (@ x8632::fulltag-misc (% imm0)) (% arg_z))) ; tag it, return it
628  (mark-as-node temp0)
629  (single-value-return 3))
630
631(defx8632lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
632  (check-nargs 2)
633  (mark-as-imm temp0)
634  (let ((imm1 temp0))
635    (lea (@ (- x8632::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
636    (movzwl (@ -2 (% imm0)) (% imm1))     ; get delta
637    (subl (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
638    (movl (% imm0) (@ x8632::macptr.address (% ptr))))
639  (mark-as-node temp0)
640  (single-value-return))
641
642(defx8632lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
643  (lea (@ x8632::misc-data-offset (% vect)) (% imm0))
644  (movl (% imm0) (@ x8632::macptr.address (% ptr)))
645  (single-value-return))
646
647;;; Sadly, we have no NVRs on x8632.
648(defun get-saved-register-values ()
649  (values))
650
651(defx8632lapfunction %current-db-link ()
652  (movl (@ (% :rcontext) x8632::tcr.db-link) (% arg_z))
653  (single-value-return))
654
655(defx8632lapfunction %no-thread-local-binding-marker ()
656  (movl ($ x8632::subtag-no-thread-local-binding) (% arg_z))
657  (single-value-return))
658
659(defx8632lapfunction break-event-pending-p ()
660  (xorl (% temp0) (% temp0))
661  (ref-global x8632::intflag imm0)
662  (set-global temp0 x8632::intflag)
663  (testl (% imm0) (% imm0))
664  (setne (%b imm0))
665  (andl ($ x8632::t-offset) (%l imm0))
666  (lea (@ x8632::nil-value (% imm0)) (% arg_z))
667  (single-value-return))
668
669(defx8632lapfunction debug-trap-with-string ((arg arg_z))
670  (check-nargs 1)
671  (uuo-error-debug-trap-with-string)
672  (single-value-return))
673
674(defx8632lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
675  (check-nargs 2)
676  (save-simple-frame)
677  (macptr-ptr src imm0)
678  (leal (@ (:^ done) (% fn)) (% ra0))
679  (movl (% imm0) (@ (% :rcontext) x8632::tcr.safe-ref-address))
680  (movl (@ (% imm0)) (% imm0))
681  (jmp done)
682  (:tra done)
683  (recover-fn)
684  (movl ($ 0) (@ (% :rcontext) x8632::tcr.safe-ref-address))
685  (movl (% imm0) (@ x8632::macptr.address (% dest)))
686  (restore-simple-frame)
687  (single-value-return))
688
689(defx8632lapfunction %%tcr-interrupt ((target arg_z))
690  (check-nargs 1)
691  (ud2a)
692  (:byte 4)
693  (box-fixnum imm0 arg_z)
694  (single-value-return))
695
696(defx8632lapfunction %suspend-tcr ((target arg_z))
697  (check-nargs 1)
698  (ud2a)
699  (:byte 5)
700  (movzbl (%b imm0) (%l imm0))
701  (testl (%l imm0) (%l imm0))
702  (movl ($ target::nil-value) (%l arg_z))
703  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
704  (single-value-return))
705
706(defx8632lapfunction %suspend-other-threads ()
707  (check-nargs 0)
708  (ud2a)
709  (:byte 6)
710  (movl ($ target::nil-value) (%l arg_z))
711  (single-value-return))
712
713(defx8632lapfunction %resume-tcr ((target arg_z))
714  (check-nargs 1)
715  (ud2a)
716  (:byte 7)
717  (movzbl (%b imm0) (%l imm0))
718  (testl (%l imm0) (%l imm0))
719  (movl ($ target::nil-value) (%l arg_z))
720  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
721  (single-value-return))
722
723(defx8632lapfunction %resume-other-threads ()
724  (check-nargs 0)
725  (ud2a)
726  (:byte 8)
727  (movl ($ target::nil-value) (%l arg_z))
728  (single-value-return))
729
730(defx8632lapfunction %get-spin-lock ((p arg_z))
731  (check-nargs 1)
732  (save-simple-frame)
733  (push (% arg_z))
734  @again
735  (mark-as-imm temp1)
736  (movl (@ -4 (% ebp)) (% arg_z))
737  (macptr-ptr arg_z temp1)
738  (movl (@ '*spin-lock-tries* (% fn)) (% arg_y))
739  (movl (@ '*spin-lock-timeouts* (% fn)) (% arg_z))
740  (movl (@ target::symbol.vcell (% arg_y)) (% arg_y))
741  (movl (@ (% :rcontext) x8632::tcr.linear) (% temp0))
742  @try-swap
743  (xorl (% eax) (% eax))
744  (lock)
745  (cmpxchgl (% temp0) (@ (% temp1)))
746  (je @done)
747  @spin
748  (pause)
749  (cmpl ($ 0) (@ (% temp1)))
750  (je @try-swap)
751  (subl ($ '1) (% arg_y))
752  (jne @spin)
753  @wait
754  (addl ($ x8632::fixnumone) (@ x8632::symbol.vcell (% arg_z)))
755  (mark-as-node temp1)
756  (call-symbol yield 0)
757  (jmp @again)
758  @done
759  (mark-as-node temp1)
760  (movl (@ -4 (% ebp)) (% arg_z))
761  (restore-simple-frame)
762  (single-value-return))
763
764;;; future %%apply-in-frame-proto would go here
765
766(defx8632lapfunction %atomic-pop-static-cons ()
767  @again
768  (movl (@ (+ x8632::nil-value (x8632::kernel-global static-conses))) (% eax))
769  (testl ($ x8632::nil-value) (% eax))
770  (jz @lose)
771  (%cdr eax temp0)
772  (lock)
773  (cmpxchgl (% temp0) (@ (+ x8632::nil-value (x8632::kernel-global static-conses))))
774  (jnz @again)
775  @lose
776  (movl (% eax) (% arg_z))
777  (single-value-return))
778
779(defx8632lapfunction %staticp ((x arg_z))
780  (check-nargs 1)
781  (ref-global tenured-area temp0)
782  (movl (% x) (% imm0))
783  (subl (@ target::area.low (% temp0)) (% imm0))
784  (shrl ($ target::dnode-shift) (% imm0))
785  (cmpl (@ target::area.static-dnodes (% temp0)) (% imm0))
786  (leal (@ (% imm0) target::fixnumone) (% arg_z))
787  (movl ($ target::nil-value) (%l imm0))
788  (cmovael (% imm0) (% arg_z))
789  (single-value-return))
790
791(defx8632lapfunction %static-inverse-cons ((n arg_z))
792  (check-nargs 1)
793  (ref-global tenured-area temp0)
794  (movl (@ target::area.low (% temp0)) (% imm0))
795  (leal (@ target::fulltag-cons (% imm0) (% n) 2) (% arg_z))
796  (single-value-return))
797
798;;; Get the thread-specific value of %fs.
799(defx8632lapfunction %get-fs-register ()
800  (xorl (% imm0) (% imm0))
801  (:byte #x66)                          ;movw %fs,%ax
802  (:byte #x8c)
803  (:byte #xe0)
804  (box-fixnum imm0 arg_z)
805  (single-value-return))
806
807(defx8632lapfunction %get-gs-register ()
808  (xorl (% imm0) (% imm0))
809  (:byte #x66)                          ;movw %gs,%ax
810  (:byte #x8c)
811  (:byte #xe8)
812  (box-fixnum imm0 arg_z)
813  (single-value-return))
814 
Note: See TracBrowser for help on using the repository browser.