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

Last change on this file since 6180 was 6180, checked in by gb, 15 years ago

%PTR-STORE-FIXNUM-CONDITIONAL.

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