source: trunk/ccl/level-0/X86/x86-misc.lisp @ 7312

Last change on this file since 7312 was 7312, checked in by gb, 13 years ago

When unlocking a read-write lock on x86-64, clear the owner field before
incrementing the value field if the value field is currently -1. (The
PPC was already doing so; doing it in the order that x86-64 had been
doing it caused the lock to become free, and zeroing the owner after
the incf could cause the lock to be locked for writing with no owner
set ...

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.8 KB
Line 
1;;; -*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17;;; level-0;x86;x86-misc.lisp
18
19
20(in-package "CCL")
21
22;;; Copy N bytes from pointer src, starting at byte offset src-offset,
23;;; to ivector dest, starting at offset dest-offset.
24;;; It's fine to leave this in lap.
25;;; Depending on alignment, it might make sense to move more than
26;;; a byte at a time.
27;;; Does no arg checking of any kind.  Really.
28
29(defx86lapfunction %copy-ptr-to-ivector ((src (* 2 x8664::node-size) )
30                                         (src-byte-offset (* 1 x8664::node-size))
31                                         #|(ra 0)|#
32                                         (dest arg_x)
33                                         (dest-byte-offset arg_y)
34                                         (nbytes arg_z))
35  (let ((rsrc temp0)
36        (rsrc-byte-offset temp1))
37    (testq (% nbytes) (% nbytes))
38    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))         ; boxed src-byte-offset
39    (movq (@ src (% rsp)) (% rsrc))     ; src macptr
40    (jmp @test)
41    @loop
42    (unbox-fixnum rsrc-byte-offset imm0)
43    (addq ($ '1) (% rsrc-byte-offset))
44    (addq (@ x8664::macptr.address (% rsrc)) (% imm0))
45    (movb (@ (% imm0)) (%b imm0))
46    (unbox-fixnum dest-byte-offset imm1)
47    (addq ($ '1) (% dest-byte-offset))
48    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
49    (subq ($ '1) (% nbytes))
50    @test
51    (jne @loop)
52    (movq (% dest) (% arg_z))
53    (single-value-return 4)))
54
55(defx86lapfunction %copy-ivector-to-ptr ((src (* 2 x8664::node-size))
56                                         (src-byte-offset (* 1 x8664::node-size))
57                                         #|(ra 0)|#
58                                         (dest arg_x)
59                                         (dest-byte-offset arg_y)
60                                         (nbytes arg_z))
61  (let ((rsrc temp0)
62        (rsrc-byte-offset temp1))
63    (testq (% nbytes) (% nbytes))
64    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))
65    (movq (@ src (% rsp)) (% rsrc))
66    (jmp @test)
67    @loop
68    (unbox-fixnum rsrc-byte-offset imm0)
69    (addq ($ '1) (% rsrc-byte-offset))
70    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
71    (unbox-fixnum dest-byte-offset imm1)
72    (addq ($ '1) (% dest-byte-offset))
73    (addq (@ x8664::macptr.address (%q dest)) (% imm1))
74    (movb (%b imm0) (@ (% imm1)))
75    (subq ($ '1) (% nbytes))
76    @test
77    (jne @loop)
78    (movq (% dest) (% arg_z))
79    (single-value-return 4)))
80
81
82
83(defx86lapfunction %copy-ivector-to-ivector ((src-offset 16) 
84                                             (src-byte-offset 8)
85                                             #|(ra 0)|#
86                                             (dest arg_x)
87                                             (dest-byte-offset arg_y)
88                                             (nbytes arg_z))
89  (let ((rsrc temp0)
90        (rsrc-byte-offset temp1))
91    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))
92    (movq (@ src-offset (% rsp)) (% rsrc))
93    (cmpq (% dest) (% rsrc))
94    (jne @front)
95    (cmpq (% src-byte-offset) (% dest-byte-offset))
96    (jg @back)
97    @front
98    (testq (% nbytes) (% nbytes))
99    (jmp @front-test)
100    @front-loop
101    (unbox-fixnum rsrc-byte-offset imm0)
102    (addq ($ '1) (% rsrc-byte-offset))
103    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
104    (unbox-fixnum dest-byte-offset imm1)
105    (addq ($ '1) (% dest-byte-offset))
106    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
107    (subq ($ '1) (% nbytes))
108    @front-test
109    (jne @front-loop)
110    (movq (% dest) (% arg_z))
111    (single-value-return 4)
112    @back
113    (addq (% nbytes) (% rsrc-byte-offset))
114    (addq (% nbytes) (% dest-byte-offset))
115    (testq (% nbytes) (% nbytes))
116    (jmp @back-test)
117    @back-loop
118    (subq ($ '1) (% rsrc-byte-offset))
119    (unbox-fixnum rsrc-byte-offset imm0)
120    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
121    (subq ($ '1) (% dest-byte-offset))
122    (unbox-fixnum dest-byte-offset imm1)
123    (subq ($ '1) (% nbytes))
124    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
125    @back-test
126    (jne @back-loop)
127    (movq (% dest) (% arg_z))
128    (single-value-return 4)))
129 
130
131(defx86lapfunction %copy-gvector-to-gvector ((src (* 2 x8664::node-size))
132                                             (src-element (* 1 x8664::node-size))
133                                             #|(ra 0)|#
134                                             (dest arg_x)
135                                             (dest-element arg_y)
136                                             (nelements arg_z))
137  (let ((rsrc temp0)
138        (rsrc-element imm1)
139        (val temp1))
140    (movq (@ src-element (% rsp)) (% rsrc-element))
141    (movq (@ src (% rsp)) (% rsrc))
142    (cmpq (% rsrc) (% dest))
143    (jne @front)
144    (rcmp (% rsrc-element) (% dest-element))
145    (jl @back)
146    @front
147    (testq (% nelements) (% nelements))
148    (jmp @front-test)
149    @front-loop
150    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
151    (addq ($ '1) (% rsrc-element))
152    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
153    (addq ($ '1) (% dest-element))
154    (subq ($ '1) (% nelements))
155    @front-test
156    (jne @front-loop)
157    (movq (% dest) (% arg_z))
158    (single-value-return 4)
159    @back
160    (addq (% nelements) (% rsrc-element))
161    (addq (% nelements) (% dest-element))
162    (testq (% nelements) (% nelements))
163    (jmp @back-test)
164    @back-loop
165    (subq ($ '1) (% rsrc-element))
166    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
167    (subq ($ '1) (% dest-element))
168    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
169    (subq ($ '1) (% nelements))
170    @back-test
171    (jne @back-loop)
172    (movq (% dest) (% arg_z))
173    (single-value-return 4)))
174
175(defx86lapfunction %heap-bytes-allocated ()
176  (movq (@ (% :rcontext) x8664::tcr.save-allocptr) (% temp1))
177  (movq (@ (% :rcontext) x8664::tcr.last-allocptr) (% temp0))
178  (cmpq ($ -16) (% temp1))
179  (movq (@ (% :rcontext) x8664::tcr.total-bytes-allocated) (% imm0))
180  (jz @go)
181  (movq (% temp0) (% temp2))
182  (subq (% temp1) (% temp0))
183  (testq (% temp2) (% temp2))
184  (jz @go)
185  (add (% temp0) (% imm0))
186  @go
187  (jmp-subprim .SPmakeu64))
188
189
190(defx86lapfunction values ()
191  (:arglist (&rest values))
192  (save-frame-variable-arg-count)
193  (push-argregs)
194  (jmp-subprim .SPnvalret))
195
196(defx86lapfunction rdtsc ()
197  (:byte #x0f)                          ;two-byte rdtsc opcode
198  (:byte #x31)                          ;is #x0f #x31
199  (shlq ($ 32) (% rdx))
200  (orq (% rdx) (% rax))
201  (imul ($ (* 2 target::node-size)) (% rax) (% arg_z))
202  (shrq ($ 1) (% arg_z))
203  (single-value-return))
204
205;;; Return all 64 bits of the time-stamp counter as an unsigned integer.
206(defx86lapfunction rdtsc64 ()
207  (:byte #x0f)                          ;two-byte rdtsc opcode
208  (:byte #x31)                          ;is #x0f #x31
209  (shlq ($ 32) (% rdx))
210  (orq (% rdx) (% rax))
211  (jmp-subprim .SPmakeu64))
212
213;;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
214;;; ash::fixnumshift)) would do this inline.
215
216(defx86lapfunction %setf-macptr-to-object ((macptr arg_y) (object arg_z))
217  (check-nargs 2)
218  (trap-unless-typecode= macptr x8664::subtag-macptr)
219  (movq (% object) (@ x8664::macptr.address (% macptr)))
220  (single-value-return))
221
222(defx86lapfunction %fixnum-from-macptr ((macptr arg_z))
223  (check-nargs 1)
224  (trap-unless-typecode= arg_z x8664::subtag-macptr)
225  (movq (@ x8664::macptr.address (% arg_z)) (% imm0))
226  (trap-unless-lisptag= imm0 x8664::tag-fixnum imm1)
227  (movq (% imm0) (% arg_z))
228  (single-value-return))
229
230
231(defx86lapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
232  (trap-unless-typecode= ptr x8664::subtag-macptr)
233  (macptr-ptr ptr imm1)
234  (unbox-fixnum offset imm0)
235  (movq (@ (% imm1) (% imm0)) (% imm0))
236  (jmp-subprim .SPmakeu64))
237
238
239(defx86lapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
240  (trap-unless-typecode= ptr x8664::subtag-macptr)
241  (macptr-ptr ptr imm1)
242  (unbox-fixnum offset imm0)
243  (movq (@ (% imm1) (% imm0)) (% imm0))
244  (jmp-subprim .SPmakes64))
245
246
247
248
249(defx86lapfunction %%set-unsigned-longlong ((ptr arg_x)
250                                            (offset arg_y)
251                                            (val arg_z))
252  (save-simple-frame)
253  (trap-unless-typecode= ptr x8664::subtag-macptr)
254  (call-subprim .SPgetu64)
255  (macptr-ptr ptr ptr)
256  (unbox-fixnum offset imm1)
257  (movq (% imm0) (@ (% ptr) (% imm1)))
258  (restore-simple-frame)
259  (single-value-return))
260
261
262(defx86lapfunction %%set-signed-longlong ((ptr arg_x)
263                                          (offset arg_y)
264                                          (val arg_z))
265  (save-simple-frame)
266  (trap-unless-typecode= ptr x8664::subtag-macptr)
267  (call-subprim .SPgets64)
268  (macptr-ptr ptr ptr)
269  (unbox-fixnum offset imm1)
270  (movq (% imm0) (@ (% ptr) (% imm1)))
271  (restore-simple-frame)
272  (single-value-return))
273
274(defx86lapfunction interrupt-level ()
275  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% imm1))
276  (movq (@ x8664::interrupt-level-binding-index (% imm1)) (% arg_z))
277  (single-value-return))
278
279(defx86lapfunction set-interrupt-level ((new arg_z))
280  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% imm1))
281  (trap-unless-fixnum new)
282  (movq (% new) (@ x8664::interrupt-level-binding-index (% imm1)))
283  (single-value-return))
284
285(defx86lapfunction %current-tcr ()
286  (movq (@ (% :rcontext) x8664::tcr.linear) (% arg_z))
287  (single-value-return))
288
289(defx86lapfunction %tcr-toplevel-function ((tcr arg_z))
290  (check-nargs 1)
291  (cmpq (% tcr) (@ (% :rcontext) x8664::tcr.linear))
292  (movq (% rsp) (% imm0))
293  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
294  (movq (@ x8664::area.high (% temp0)) (% imm1))
295  (jz @room)
296  (movq (@ x8664::area.active (% temp0)) (% imm0))
297  @room
298  (cmpq (% imm1) (% imm0))
299  (movl ($ x8664::nil-value) (%l arg_z))
300  (cmovneq (@ (- x8664::node-size) (% imm1)) (% arg_z))
301  (single-value-return))
302
303(defx86lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
304  (check-nargs 2)
305  (cmpq (% tcr) (@ (% :rcontext) x8664::tcr.linear))
306  (movq (% rsp) (% imm0))
307  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
308  (movq (@ x8664::area.high (% temp0)) (% imm1))
309  (jz @room)
310  (movq (@ x8664::area.active (% temp0)) (% imm0))
311  @room
312  (cmpq (% imm1) (% imm0))
313  (leaq (@ (- x8664::node-size) (% imm1)) (% imm1))
314  (movq ($ 0) (@ (% imm1)))
315  (jne @have-room)
316  (movq (% imm1) (@ x8664::area.active (% temp0)))
317  (movq (% imm1) (@ x8664::tcr.save-vsp (% tcr)))
318  @have-room
319  (movq (% fun) (@ (% imm1)))
320  (single-value-return))
321
322;;; This needs to be done out-of-line, to handle EGC memoization.
323(defx86lapfunction %store-node-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
324  (movq (@ offset (% rsp)) (% temp0))
325  (save-simple-frame)
326  (call-subprim .SPstore-node-conditional)
327  (restore-simple-frame)
328  (single-value-return 3))
329
330(defx86lapfunction %store-immediate-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
331  (movq (@ offset (% rsp)) (% temp0))
332  (unbox-fixnum temp0 imm1)
333  @again
334  (movq (@ (% object) (% imm1)) (% rax))
335  (cmpq (% rax) (% old))
336  (jne @lose)
337  (lock)
338  (cmpxchgq (% new) (@ (% object) (% imm1)))
339  (jne @again)
340  (movl ($ x8664::t-value) (%l arg_z))
341  (single-value-return 3)
342  @lose
343  (movl ($ x8664::nil-value) (%l arg_z))
344  (single-value-return 3))
345
346(defx86lapfunction set-%gcable-macptrs% ((ptr x8664::arg_z))
347  @again
348  (movq (@ (+ x8664::nil-value (x8664::kernel-global gcable-pointers)))
349        (% rax))
350  (movq (% rax) (@ x8664::xmacptr.link (% ptr)))
351  (lock)
352  (cmpxchgq (% ptr) (@ (+ x8664::nil-value (x8664::kernel-global gcable-pointers))))
353  (jne @again)
354  (single-value-return))
355
356;;; Atomically increment or decrement the gc-inhibit-count kernel-global
357;;; (It's decremented if it's currently negative, incremented otherwise.)
358(defx86lapfunction %lock-gc-lock ()
359  @again
360  (movq (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))) (% rax))
361  (lea (@ '-1 (% rax)) (% temp0))
362  (lea (@ '1 (% rax)) (% arg_z))
363  (testq (% rax) (% rax))
364  (cmovsq (% temp0) (% arg_z))
365  (lock)
366  (cmpxchgq (% arg_z) (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))))
367  (jnz @again)
368  (single-value-return))
369
370;;; Atomically decrement or increment the gc-inhibit-count kernel-global
371;;; (It's incremented if it's currently negative, incremented otherwise.)
372;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
373(defx86lapfunction %unlock-gc-lock ()
374  @again
375  (movq (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count)))
376        (% rax))
377  (lea (@ '1 (% rax)) (% arg_x))
378  (cmpq ($ -1) (% rax))
379  (lea (@ '-1 (% rax)) (% arg_z))
380  (cmovleq (% arg_x) (% arg_z))
381  (lock)
382  (cmpxchgq (% arg_z) (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))))
383  (jne @again)
384  (cmpq ($ '-1) (% rax))
385  (jne @done)
386  ;; The GC tried to run while it was inhibited.  Unless something else
387  ;; has just inhibited it, it should be possible to GC now.
388  (mov ($ arch::gc-trap-function-immediate-gc) (% imm0))
389  (uuo-gc-trap)
390  @done
391  (single-value-return))
392
393;;; Return true iff we were able to increment a non-negative
394;;; lock._value
395(defx86lapfunction %try-read-lock-rwlock ((lock arg_z))
396  (check-nargs 1)
397  @try
398  (movq (@ x8664::lock._value (% lock)) (% rax))
399  (movq (% rax) (% imm1))
400  (addq ($ '1) (% imm1))
401  (jle @fail)
402  (lock)
403  (cmpxchgq (% imm1) (@ x8664::lock._value (% lock)))
404  (jne @try)
405  (single-value-return)                                 ; return the lock
406@fail
407  (movl ($ x8664::nil-value) (%l arg_z))
408  (single-value-return))
409
410
411
412(defx86lapfunction unlock-rwlock ((lock arg_z))
413  (cmpq ($ 0) (@ x8664::lock._value (% lock)))
414  (jle @unlock-write)
415  @unlock-read
416  (movq (@ x8664::lock._value (% lock)) (% rax))
417  (lea (@ '-1 (% imm0)) (% imm1))
418  (lock)
419  (cmpxchgq (% imm1) (@ x8664::lock._value (% lock)))
420  (jne @unlock-read)
421  (single-value-return)
422  @unlock-write
423  ;;; If we aren't the writer, return NIL.
424  ;;; If we are and the value's about to go to 0, clear the writer field.
425  (movq (@ x8664::lock.writer (% lock)) (% imm0))
426  (cmpq (% imm0) (@ (% :rcontext) x8664::tcr.linear))
427  (jne @fail)
428  (cmpq ($ '-1) (@ x8664::lock._value (% lock)))
429  (jne @still-owner)
430  (movsd (% fpzero) (@ x8664::lock.writer (% lock)))
431  @still-owner
432  (addq ($ '1) (@ x8664::lock._value (% lock)))
433  (single-value-return)
434  @fail
435  (movl ($ x8664::nil-value) (%l arg_z))
436  (single-value-return))
437
438(defx86lapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
439  (check-nargs 3)
440  (unbox-fixnum disp imm1)
441  @again
442  (movq (@ (% node) (% imm1)) (% rax))
443  (lea (@ (% rax) (% by)) (% arg_z))
444  (lock)
445  (cmpxchgq (% arg_z) (@ (% node) (% imm1)))
446  (jne @again)
447  (single-value-return))
448
449(defx86lapfunction %atomic-incf-ptr ((ptr arg_z))
450  (macptr-ptr ptr ptr)
451  @again
452  (movq (@ (% ptr)) (% rax))
453  (lea (@ 1 (% rax)) (% imm1))
454  (lock)
455  (cmpxchgq (% imm1) (@ (% ptr)))
456  (jne @again)
457  (box-fixnum imm1 arg_z)
458  (single-value-return))
459
460(defx86lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
461  (macptr-ptr ptr ptr)
462  @again
463  (movq (@ (% ptr)) (% rax))
464  (unbox-fixnum by imm1)
465  (add (% rax) (% imm1))
466  (lock)
467  (cmpxchgq (% imm1) (@ (% ptr)))
468  (jnz @again)
469  (box-fixnum imm1 arg_z)
470  (single-value-return))
471
472
473(defx86lapfunction %atomic-decf-ptr ((ptr arg_z))
474  (macptr-ptr ptr ptr)
475  @again
476  (movq (@ (% ptr)) (% rax))
477  (lea (@ -1 (% rax)) (% imm1))
478  (lock)
479  (cmpxchgq (% imm1) (@ (% ptr)))
480  (jnz @again)
481  (box-fixnum imm1 arg_z)
482  (single-value-return))
483
484(defx86lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
485  (macptr-ptr ptr ptr)                  ;must be fixnum-aligned
486  @again
487  (movq (@ (% ptr)) (% rax))
488  (testq (% rax) (% rax))
489  (lea (@ -1 (% rax)) (% imm1))
490  (jz @done)
491  (lock)
492  (cmpxchgq (% imm1) (@ (% ptr)))
493  (jnz @again)
494  @done
495  (box-fixnum imm1 arg_z)
496  (single-value-return))
497
498
499(defx86lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
500  (macptr-ptr arg_y imm1)
501  (unbox-fixnum newval imm0)
502  (lock)
503  (xchgq (% imm0) (@ (% imm1)))
504  (box-fixnum imm0 arg_z)
505  (single-value-return))
506
507;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
508;;; was equal to OLDVAL.  Return the old value
509(defx86lapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
510  (macptr-ptr ptr ptr)                  ;  must be fixnum-aligned
511  @again
512  (movq (@ (% ptr)) (% imm0))
513  (box-fixnum imm0 temp0)
514  (cmpq (% temp0) (% expected-oldval))
515  (jne @done)
516  (unbox-fixnum newval imm1)
517  (lock)
518  (cmpxchgq (% imm1) (@ (% ptr)))
519  (jne @again)
520  @done
521  (movq (% temp0) (% arg_z))
522  (single-value-return))
523
524(defx86lapfunction %ptr-store-fixnum-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
525  (let ((address imm1))
526    (macptr-ptr ptr address)
527    @again
528    (movq (@ (% address)) (% imm0))
529    (cmpq (% imm0) (% expected-oldval))
530    (jne @done)
531    (lock)
532    (cmpxchgq (% newval) (@ (% address)))
533    (jne @again)
534    @done
535    (movq (% imm0) (% arg_z))
536    (single-value-return)))
537
538
539(defx86lapfunction %macptr->dead-macptr ((macptr arg_z))
540  (check-nargs 1)
541  (movb ($ x8664::subtag-dead-macptr) (@ x8664::misc-subtag-offset (% macptr)))
542  (single-value-return))
543
544#+are-you-kidding
545(defx86lapfunction %%apply-in-frame ((catch-count imm0) (srv temp0) (tsp-count imm0) (db-link imm0)
546                                     (parent arg_x) (function arg_y) (arglist arg_z))
547  (check-nargs 7)
548
549  ; Throw through catch-count catch frames
550  (lwz imm0 12 vsp)                      ; catch-count
551  (vpush parent)
552  (vpush function)
553  (vpush arglist)
554  (bla .SPnthrowvalues)
555
556  ; Pop tsp-count TSP frames
557  (lwz tsp-count 16 vsp)
558  (cmpi cr0 tsp-count 0)
559  (b @test)
560@loop
561  (subi tsp-count tsp-count '1)
562  (cmpi cr0 tsp-count 0)
563  (lwz tsp 0 tsp)
564@test
565  (bne cr0 @loop)
566
567  ; Pop dynamic bindings until we get to db-link
568  (lwz imm0 12 vsp)                     ; db-link
569  (lwz imm1 x8664::tcr.db-link :rcontext)
570  (cmp cr0 imm0 imm1)
571  (beq cr0 @restore-regs)               ; .SPunbind-to expects there to be something to do
572  (bla .SPunbind-to)
573
574@restore-regs
575  ; restore the saved registers from srv
576  (lwz srv 20 vsp)
577@get0
578  (svref imm0 1 srv)
579  (cmpwi cr0 imm0 x8664::nil-value)
580  (beq @get1)
581  (lwz save0 0 imm0)
582@get1
583  (svref imm0 2 srv)
584  (cmpwi cr0 imm0 x8664::nil-value)
585  (beq @get2)
586  (lwz save1 0 imm0)
587@get2
588  (svref imm0 3 srv)
589  (cmpwi cr0 imm0 x8664::nil-value)
590  (beq @get3)
591  (lwz save2 0 imm0)
592@get3
593  (svref imm0 4 srv)
594  (cmpwi cr0 imm0 x8664::nil-value)
595  (beq @get4)
596  (lwz save3 0 imm0)
597@get4
598  (svref imm0 5 srv)
599  (cmpwi cr0 imm0 x8664::nil-value)
600  (beq @get5)
601  (lwz save4 0 imm0)
602@get5
603  (svref imm0 6 srv)
604  (cmpwi cr0 imm0 x8664::nil-value)
605  (beq @get6)
606  (lwz save5 0 imm0)
607@get6
608  (svref imm0 7 srv)
609  (cmpwi cr0 imm0 x8664::nil-value)
610  (beq @get7)
611  (lwz save6 0 imm0)
612@get7
613  (svref imm0 8 srv)
614  (cmpwi cr0 imm0 x8664::nil-value)
615  (beq @got)
616  (lwz save7 0 imm0)
617@got
618
619  (vpop arg_z)                          ; arglist
620  (vpop temp0)                          ; function
621  (vpop parent)                         ; parent
622  (extract-lisptag imm0 parent)
623  (cmpi cr0 imm0 x8664::tag-fixnum)
624  (if (:cr0 :ne)
625    ; Parent is a fake-stack-frame. Make it real
626    (progn
627      (svref sp %fake-stack-frame.sp parent)
628      (stwu sp (- x8664::lisp-frame.size) sp)
629      (svref fn %fake-stack-frame.fn parent)
630      (stw fn x8664::lisp-frame.savefn sp)
631      (svref temp1 %fake-stack-frame.vsp parent)
632      (stw temp1 x8664::lisp-frame.savevsp sp)
633      (svref temp1 %fake-stack-frame.lr parent)
634      (extract-lisptag imm0 temp1)
635      (cmpi cr0 imm0 x8664::tag-fixnum)
636      (if (:cr0 :ne)
637        ;; must be a macptr encoding the actual link register
638        (macptr-ptr loc-pc temp1)
639        ;; Fixnum is offset from start of function vector
640        (progn
641          (svref temp2 0 fn)        ; function vector
642          (unbox-fixnum temp1 temp1)
643          (add loc-pc temp2 temp1)))
644      (stw loc-pc x8664::lisp-frame.savelr sp))
645    ;; Parent is a real stack frame
646    (mr sp parent))
647  (set-nargs 0)
648  (bla .SPspreadargz)
649  (ba .SPtfuncallgen))
650
651
652
653 
654(defx86lapfunction %%save-application ((flags arg_y) (fd arg_z))
655  (unbox-fixnum flags imm0)
656  (orq ($ arch::gc-trap-function-save-application) (% imm0))
657  (unbox-fixnum fd imm1)
658  (uuo-gc-trap)
659  (single-value-return))
660
661
662
663(defx86lapfunction %misc-address-fixnum ((misc-object arg_z))
664  (check-nargs 1)
665  (lea (@ x8664::misc-data-offset (% misc-object)) (% arg_z))
666  (single-value-return))
667
668
669(defx86lapfunction fudge-heap-pointer ((ptr arg_x) (subtype arg_y) (len arg_z))
670  (check-nargs 3)
671  (macptr-ptr ptr imm1) ; address in macptr
672  (lea (@ 17 (% imm1)) (% imm0))     ; 2 for delta + 15 for alignment
673  (andb ($ -16) (%b  imm0))   ; Clear low four bits to align
674  (subq (% imm0) (% imm1))  ; imm1 = -delta
675  (negw (%w imm1))
676  (movw (%w imm1) (@  -2 (% imm0)))     ; save delta halfword
677  (unbox-fixnum subtype imm1)  ; subtype at low end of imm1
678  (shlq ($ (- x8664::num-subtag-bits x8664::fixnum-shift)) (% len ))
679  (orq (% len) (% imm1))
680  (movq (% imm1) (@ (% imm0)))       ; store subtype & length
681  (lea (@ x8664::fulltag-misc (% imm0)) (% arg_z)) ; tag it, return it
682  (single-value-return))
683
684(defx86lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
685  (check-nargs 2)
686  (lea (@ (- x8664::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
687  (movzwq (@ -2 (% imm0)) (% imm1))     ; get delta
688  (subq (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
689  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
690  (single-value-return))
691
692
693(defx86lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
694  (lea (@ x8664::misc-data-offset (% vect)) (% imm0))
695  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
696  (single-value-return))
697
698(defx86lapfunction get-saved-register-values ()
699  (movq (% rsp) (% temp0))
700  (push (% save0))
701  (push (% save1))
702  (push (% save2))
703  (push (% save3))
704  (set-nargs 4)
705  (jmp-subprim .SPvalues))
706
707
708(defx86lapfunction %current-db-link ()
709  (movq (@ (% :rcontext) x8664::tcr.db-link) (% arg_z))
710  (single-value-return))
711
712(defx86lapfunction %no-thread-local-binding-marker ()
713  (movq ($ x8664::subtag-no-thread-local-binding) (% arg_z))
714  (single-value-return))
715
716
717(defx86lapfunction break-event-pending-p ()
718  (xorq (% imm0) (% imm0))
719  (ref-global x8664::intflag imm1)
720  (set-global imm0 x8664::intflag)
721  (testq (% imm1) (% imm1))
722  (setne (%b imm0))
723  (andl ($ x8664::t-offset) (%l imm0))
724  (lea (@ x8664::nil-value (% imm0)) (% arg_z))
725  (single-value-return))
726
727
728(defx86lapfunction debug-trap-with-string ((arg arg_z))
729  (check-nargs 1)
730  (uuo-error-debug-trap-with-string)
731  (single-value-return))
732
733(defx86lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
734  (check-nargs 2)
735  (save-simple-frame)
736  (macptr-ptr src imm0)
737  (leaq (@ (:^ done) (% fn)) (% ra0))
738  (movq (% imm0) (@ (% :rcontext) x8664::tcr.safe-ref-address))
739  (movq (@ (% imm0)) (% imm0))
740  (jmp done)
741  (:tra done)
742  (recover-fn-from-rip)
743  (movq ($ 0) (@ (% :rcontext) x8664::tcr.safe-ref-address))
744  (movq (% imm0) (@ x8664::macptr.address (% dest)))
745  (restore-simple-frame)
746  (single-value-return))
747
748;;; This was intentded to work around a bug in #_nanosleep in early
749;;; Leopard test releases.  It's probably not necessary any more; is
750;;; it still called ?
751(defx86lapfunction %valid-remaining-timespec-time-p ((seconds arg_y) (ptr arg_z))
752  (macptr-ptr arg_z imm0)
753  (unbox-fixnum seconds imm1)
754  (movl ($ x8664::nil-value) (% arg_z.l))
755  (cmpq ($ 0) (@ (% imm0)))
756  (jl @done)
757  (cmpq (% imm1) (% imm0))
758  (ja @done)
759  (cmpq ($ 1000000000) (@ 8 (% imm0)))
760  (jae @done)
761  (movq (@ (% imm0)) (% imm1))
762  (orq (@ 8 (% imm0)) (% imm1))
763  (jz @done)
764  (movl ($ x8664::t-value) (% arg_z.l))
765  @done
766  (single-value-return))
767
768;;; end of x86-misc.lisp
Note: See TracBrowser for help on using the repository browser.