source: branches/ia32/level-0/X86/X8632/x8632-misc.lisp @ 8690

Last change on this file since 8690 was 8690, checked in by rme, 12 years ago

Uh, remember to use (single-value-return n) in functions that take args
on the stack.

File size: 20.9 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 (@ 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 (@ src (% esp)) (% a))
154    (movl (@ src-element (% esp)) (% i))
155    (movl (@ 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;;; Return true iff we were able to increment a non-negative
446;;; lock._value
447(defx8632lapfunction %try-read-lock-rwlock ((lock arg_z))
448  (check-nargs 1)
449  (mark-as-imm temp0)
450  (let ((imm1 temp0))
451    @try
452    (movl (@ x8632::lock._value (% lock)) (% eax))
453    (movl (% eax) (% imm1))
454    (addl ($ '1) (% imm1))
455    (jle @fail)
456    (lock)
457    (cmpxchgl (% imm1) (@ x8632::lock._value (% lock)))
458    (jne @try)
459    (mark-as-node temp0)
460    (single-value-return)               ; return the lock
461    @fail
462    (mark-as-node temp0)
463    (movl ($ x8632::nil-value) (% arg_z))
464    (single-value-return)))
465
466(defx8632lapfunction unlock-rwlock ((lock arg_z))
467  (cmpl ($ 0) (@ x8632::lock._value (% lock)))
468  (jle @unlock-write)
469  @unlock-read
470  (mark-as-imm temp0)
471  (let ((imm1 temp0))
472    (movl (@ x8632::lock._value (% lock)) (% eax))
473    (lea (@ '-1 (% imm0)) (% imm1))
474    (lock)
475    (cmpxchgl (% imm1) (@ x8632::lock._value (% lock)))
476    (jne @unlock-read))
477  (mark-as-node temp0)
478  (single-value-return)
479  @unlock-write
480  ;;; If we aren't the writer, return NIL.
481  ;;; If we are and the value's about to go to 0, clear the writer field.
482  (movl (@ x8632::lock.writer (% lock)) (% imm0))
483  (cmpl (% imm0) (@ (% :rcontext) x8632::tcr.linear))
484  (jne @fail)
485  (cmpl ($ '-1) (@ x8632::lock._value (% lock)))
486  (jne @still-owner)
487  (movss (% fpzero) (@ x8632::lock.writer (% lock)))
488  @still-owner
489  (addl ($ '1) (@ x8632::lock._value (% lock)))
490  (single-value-return)
491  @fail
492  (movl ($ x8632::nil-value) (%l arg_z))
493  (single-value-return))
494
495(defx8632lapfunction %atomic-incf-node ((by 4) #|(ra 0)|# (node arg_y) (disp arg_z))
496  (check-nargs 3)
497  (mark-as-imm temp0)
498  (let ((imm1 temp0)
499        (rby temp1))
500    (movl (@ by (% esp)) (% rby))
501    (unbox-fixnum disp imm1)
502    @again
503    (movl (@ (% node) (% imm1)) (% eax))
504    (lea (@ (% eax) (% rby)) (% arg_z))
505    (lock)
506    (cmpxchgl (% arg_z) (@ (% node) (% imm1)))
507    (jne @again))
508  (mark-as-node temp0)
509  (single-value-return 3))
510
511(defx8632lapfunction %atomic-incf-ptr ((ptr arg_z))
512  (mark-as-imm temp0)
513  (mark-as-imm temp1)
514  (let ((imm1 temp0)
515        (imm2 temp1))
516    (macptr-ptr ptr imm2)
517    @again
518    (movl (@ (% imm2)) (% eax))
519    (lea (@ 1 (% eax)) (% imm1))
520    (lock)
521    (cmpxchgl (% imm1) (@ (% imm2)))
522    (jne @again)
523    (box-fixnum imm1 arg_z))
524  (mark-as-node temp0)
525  (mark-as-node temp1)
526  (single-value-return))
527
528(defx8632lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
529  (mark-as-imm temp0)
530  (mark-as-imm temp1)
531  (let ((imm1 temp0)
532        (imm2 temp1))
533    (macptr-ptr ptr imm2)
534    @again
535    (movl (@ (% imm2)) (% eax))
536    (unbox-fixnum by imm1)
537    (add (% eax) (% imm1))
538    (lock)
539    (cmpxchgl (% imm1) (@ (% imm2)))
540    (jnz @again)
541    (box-fixnum imm1 arg_z))
542  (mark-as-node temp0)
543  (mark-as-node temp1)
544  (single-value-return))
545
546(defx8632lapfunction %atomic-decf-ptr ((ptr arg_z))
547  (mark-as-imm temp0)
548  (mark-as-imm temp1)
549  (let ((imm1 temp0)
550        (imm2 temp1))
551    (macptr-ptr ptr imm2)
552    @again
553    (movl (@ (% imm2)) (% eax))
554    (lea (@ -1 (% eax)) (% imm1))
555    (lock)
556    (cmpxchgl (% imm1) (@ (% imm2)))
557    (jne @again)
558    (box-fixnum imm1 arg_z))
559  (mark-as-node temp0)
560  (mark-as-node temp1)
561  (single-value-return))
562
563(defx8632lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
564  (mark-as-imm temp0)
565  (mark-as-imm temp1)
566  (let ((imm1 temp0)
567        (imm2 temp1))
568    (macptr-ptr ptr imm2)
569    @again
570    (movl (@ (% imm2)) (% eax))
571    (testl (% eax) (% eax))
572    (lea (@ -1 (% eax)) (% imm1))
573    (jz @done)
574    (lock)
575    (cmpxchgl (% imm1) (@ (% imm2)))
576    (jnz @again)
577    @done
578    (box-fixnum imm1 arg_z))
579  (mark-as-node temp0)
580  (mark-as-node temp1)
581  (single-value-return))
582
583(defx8632lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
584  (mark-as-imm temp0)
585  (let ((imm1 temp0))
586    (macptr-ptr arg_y imm1)
587    (unbox-fixnum newval imm0)
588    (lock)
589    (xchgl (% imm0) (@ (% imm1)))
590    (box-fixnum imm0 arg_z))
591  (mark-as-node temp0)
592  (single-value-return))
593
594;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
595;;; was equal to OLDVAL.  Return the old value
596(defx8632lapfunction %ptr-store-conditional ((ptr 4) #|(ra 0)|# (expected-oldval arg_y) (newval arg_z))
597  (mark-as-imm temp1)
598  (let ((imm2 temp1))
599    (movl (@ ptr (% esp)) (% temp0))
600    (macptr-ptr temp0 imm2)
601    (mark-as-imm temp0)
602    (let ((imm1 temp0))
603      @again
604      (movl (@ (% imm2)) (% imm0))
605      (box-fixnum imm0 imm0)
606      (cmpl (% imm0) (% expected-oldval))
607      (jne @done)
608      (unbox-fixnum newval imm1)
609      (lock)
610      (cmpxchgl (% imm1) (@ (% imm2)))
611      (jne @again)
612      @done
613      (movl (% imm0) (% arg_z)))
614    (mark-as-node temp0))
615  (mark-as-node temp1)
616  (single-value-return 3))
617
618(defx86lapfunction %ptr-store-fixnum-conditional ((ptr 4) #|(ra 0)|# (expected-oldval arg_y) (newval arg_z))
619  (mark-as-imm temp0)
620  (let ((address temp0))
621    (movl (@ ptr (% esp)) (% temp1))
622    (macptr-ptr temp1 address)
623    @again
624    (movl (@ (% address)) (% imm0))
625    (cmpl (% imm0) (% expected-oldval))
626    (jne @done)
627    (lock)
628    (cmpxchgl (% newval) (@ (% address)))
629    (jne @again)
630    @done
631    (movl (% imm0) (% arg_z)))
632  (mark-as-node temp0)
633  (single-value-return 3))
634
635(defx8632lapfunction %macptr->dead-macptr ((macptr arg_z))
636  (check-nargs 1)
637  (movb ($ x8632::subtag-dead-macptr) (@ x8632::misc-subtag-offset (% macptr)))
638  (single-value-return))
639
640;;; %%apply-in-frame
641
642;; xxx
643(defx8632lapfunction %%save-application ((flags arg_y) (fd arg_z))
644  (unbox-fixnum flags imm0)
645  (orl ($ arch::gc-trap-function-save-application) (% imm0))
646  ;;(unbox-fixnum fd imm1)
647  (uuo-gc-trap)
648  (single-value-return))
649
650(defx8632lapfunction %misc-address-fixnum ((misc-object arg_z))
651  (check-nargs 1)
652  (lea (@ x8632::misc-data-offset (% misc-object)) (% arg_z))
653  (single-value-return))
654
655(defx8632lapfunction fudge-heap-pointer ((ptr 4) #|(ra 0)|# (subtype arg_y) (len arg_z))
656  (check-nargs 3)
657  (mark-as-imm temp0)
658  (let ((imm1 temp0))
659    (movl (@ ptr (% esp)) (% temp1))
660    (macptr-ptr temp1 imm1)           ; address in macptr
661    (lea (@ 9 (% imm1)) (% imm0))     ; 2 for delta + 7 for alignment
662    (andb ($ -8) (%b  imm0))          ; Clear low three bits to align
663    (subl (% imm0) (% imm1))          ; imm1 = -delta
664    (negw (%w imm1))
665    (movw (%w imm1) (@  -2 (% imm0)))   ; save delta halfword
666    (unbox-fixnum subtype imm1)         ; subtype at low end of imm1
667    (shll ($ (- x8632::num-subtag-bits x8632::fixnum-shift)) (% len))
668    (orl (% len) (% imm1))
669    (movl (% imm1) (@ (% imm0)))        ; store subtype & length
670    (lea (@ x8632::fulltag-misc (% imm0)) (% arg_z))) ; tag it, return it
671  (mark-as-node temp0)
672  (single-value-return 3))
673
674(defx8632lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
675  (check-nargs 2)
676  (mark-as-imm temp0)
677  (let ((imm1 temp0))
678    (lea (@ (- x8632::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
679    (movzwl (@ -2 (% imm0)) (% imm1))     ; get delta
680    (subl (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
681    (movl (% imm0) (@ x8632::macptr.address (% ptr))))
682  (mark-as-node temp0)
683  (single-value-return))
684
685(defx8632lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
686  (lea (@ x8632::misc-data-offset (% vect)) (% imm0))
687  (movl (% imm0) (@ x8632::macptr.address (% ptr)))
688  (single-value-return))
Note: See TracBrowser for help on using the repository browser.