source: branches/working-0711/ccl/level-0/X86/x86-misc.lisp @ 10005

Last change on this file since 10005 was 10005, checked in by gz, 12 years ago

Merge r8134, r8137 just to minimize diffs

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 29.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(defun %copy-ivector-to-ivector (src src-byte-offset dest dest-byte-offset nbytes)
83  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
84  (if (or (eq src dest)
85          (not (eql 0 src-byte-offset))
86          (not (eql 0 dest-byte-offset))
87          (< nbytes 8))
88    (%copy-ivector-to-ivector-bytes src src-byte-offset dest dest-byte-offset nbytes)
89    (%copy-ivector-to-ivector-words src dest (ash nbytes -3) (logand nbytes 7))))
90
91(defx86lapfunction %copy-ivector-to-ivector-words ((src 8)
92                                                   #|(ra 0)|#
93                                                   (dest arg_x)
94                                                   (nwords arg_y)
95                                                   (nbytes arg_z))
96  (let ((rsrc temp0)
97         (ridx imm1)
98         (rval imm0))
99    (xorl (%l ridx) (%l ridx))
100    (movq (@ src (% rsp)) (% rsrc))
101    (jmp @word-test)
102    @word-loop
103    (movq (@ x8664::misc-data-offset (% rsrc) (% ridx)) (% rval))
104    (movq (% rval) (@ x8664::misc-data-offset (% dest) (% ridx)))
105    (addq ($ 8) (% ridx))
106    @word-test
107    (cmpq (% ridx) (% nwords))
108    (jne @word-loop)
109    (jmp @byte-test)
110    @byte-loop
111    (movb (@ x8664::misc-data-offset (% rsrc) (% ridx)) (%b rval))
112    (movb (%b rval) (@ x8664::misc-data-offset (% dest) (% ridx)))
113    (addq ($ 1) (% ridx))
114    @byte-test
115    (subq ($ '1) (% nbytes))
116    (jns @byte-loop)
117    (movq (% dest) (% arg_z))
118    (single-value-return 3)))
119         
120   
121   
122
123(defx86lapfunction %copy-ivector-to-ivector-bytes ((src-offset 16) 
124                                                   (src-byte-offset 8)
125                                                   #|(ra 0)|#
126                                                   (dest arg_x)
127                                                   (dest-byte-offset arg_y)
128                                                   (nbytes arg_z))
129  (let ((rsrc temp0)
130        (rsrc-byte-offset temp1))
131    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))
132    (movq (@ src-offset (% rsp)) (% rsrc))
133    (cmpq (% dest) (% rsrc))
134    (jne @front)
135    (cmpq (% src-byte-offset) (% dest-byte-offset))
136    (jg @back)
137    @front
138    (testq (% nbytes) (% nbytes))
139    (jmp @front-test)
140    @front-loop
141    (unbox-fixnum rsrc-byte-offset imm0)
142    (addq ($ '1) (% rsrc-byte-offset))
143    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
144    (unbox-fixnum dest-byte-offset imm1)
145    (addq ($ '1) (% dest-byte-offset))
146    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
147    (subq ($ '1) (% nbytes))
148    @front-test
149    (jne @front-loop)
150    (movq (% dest) (% arg_z))
151    (single-value-return 4)
152    @back
153    (addq (% nbytes) (% rsrc-byte-offset))
154    (addq (% nbytes) (% dest-byte-offset))
155    (testq (% nbytes) (% nbytes))
156    (jmp @back-test)
157    @back-loop
158    (subq ($ '1) (% rsrc-byte-offset))
159    (unbox-fixnum rsrc-byte-offset imm0)
160    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
161    (subq ($ '1) (% dest-byte-offset))
162    (unbox-fixnum dest-byte-offset imm1)
163    (subq ($ '1) (% nbytes))
164    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
165    @back-test
166    (jne @back-loop)
167    (movq (% dest) (% arg_z))
168    (single-value-return 4)))
169 
170
171(defx86lapfunction %copy-gvector-to-gvector ((src (* 2 x8664::node-size))
172                                             (src-element (* 1 x8664::node-size))
173                                             #|(ra 0)|#
174                                             (dest arg_x)
175                                             (dest-element arg_y)
176                                             (nelements arg_z))
177  (let ((rsrc temp0)
178        (rsrc-element imm1)
179        (val temp1))
180    (movq (@ src-element (% rsp)) (% rsrc-element))
181    (movq (@ src (% rsp)) (% rsrc))
182    (cmpq (% rsrc) (% dest))
183    (jne @front)
184    (rcmp (% rsrc-element) (% dest-element))
185    (jl @back)
186    @front
187    (testq (% nelements) (% nelements))
188    (jmp @front-test)
189    @front-loop
190    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
191    (addq ($ '1) (% rsrc-element))
192    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
193    (addq ($ '1) (% dest-element))
194    (subq ($ '1) (% nelements))
195    @front-test
196    (jne @front-loop)
197    (movq (% dest) (% arg_z))
198    (single-value-return 4)
199    @back
200    (addq (% nelements) (% rsrc-element))
201    (addq (% nelements) (% dest-element))
202    (testq (% nelements) (% nelements))
203    (jmp @back-test)
204    @back-loop
205    (subq ($ '1) (% rsrc-element))
206    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
207    (subq ($ '1) (% dest-element))
208    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
209    (subq ($ '1) (% nelements))
210    @back-test
211    (jne @back-loop)
212    (movq (% dest) (% arg_z))
213    (single-value-return 4)))
214
215(defx86lapfunction %heap-bytes-allocated ()
216  (movq (@ (% :rcontext) x8664::tcr.save-allocptr) (% temp1))
217  (movq (@ (% :rcontext) x8664::tcr.last-allocptr) (% temp0))
218  (cmpq ($ -16) (% temp1))
219  (movq (@ (% :rcontext) x8664::tcr.total-bytes-allocated) (% imm0))
220  (jz @go)
221  (movq (% temp0) (% temp2))
222  (subq (% temp1) (% temp0))
223  (testq (% temp2) (% temp2))
224  (jz @go)
225  (add (% temp0) (% imm0))
226  @go
227  (jmp-subprim .SPmakeu64))
228
229
230(defx86lapfunction values ()
231  (:arglist (&rest values))
232  (save-frame-variable-arg-count)
233  (push-argregs)
234  (jmp-subprim .SPnvalret))
235
236(defx86lapfunction rdtsc ()
237  (:byte #x0f)                          ;two-byte rdtsc opcode
238  (:byte #x31)                          ;is #x0f #x31
239  (shlq ($ 32) (% rdx))
240  (orq (% rdx) (% rax))
241  (imul ($ (* 2 target::node-size)) (% rax) (% arg_z))
242  (shrq ($ 1) (% arg_z))
243  (single-value-return))
244
245;;; Return all 64 bits of the time-stamp counter as an unsigned integer.
246(defx86lapfunction rdtsc64 ()
247  (:byte #x0f)                          ;two-byte rdtsc opcode
248  (:byte #x31)                          ;is #x0f #x31
249  (shlq ($ 32) (% rdx))
250  (orq (% rdx) (% rax))
251  (jmp-subprim .SPmakeu64))
252
253;;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
254;;; ash::fixnumshift)) would do this inline.
255
256(defx86lapfunction %setf-macptr-to-object ((macptr arg_y) (object arg_z))
257  (check-nargs 2)
258  (trap-unless-typecode= macptr x8664::subtag-macptr)
259  (movq (% object) (@ x8664::macptr.address (% macptr)))
260  (single-value-return))
261
262(defx86lapfunction %fixnum-from-macptr ((macptr arg_z))
263  (check-nargs 1)
264  (trap-unless-typecode= arg_z x8664::subtag-macptr)
265  (movq (@ x8664::macptr.address (% arg_z)) (% imm0))
266  (trap-unless-lisptag= imm0 x8664::tag-fixnum imm1)
267  (movq (% imm0) (% arg_z))
268  (single-value-return))
269
270
271(defx86lapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
272  (trap-unless-typecode= ptr x8664::subtag-macptr)
273  (macptr-ptr ptr imm1)
274  (unbox-fixnum offset imm0)
275  (movq (@ (% imm1) (% imm0)) (% imm0))
276  (jmp-subprim .SPmakeu64))
277
278
279(defx86lapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
280  (trap-unless-typecode= ptr x8664::subtag-macptr)
281  (macptr-ptr ptr imm1)
282  (unbox-fixnum offset imm0)
283  (movq (@ (% imm1) (% imm0)) (% imm0))
284  (jmp-subprim .SPmakes64))
285
286
287
288
289(defx86lapfunction %%set-unsigned-longlong ((ptr arg_x)
290                                            (offset arg_y)
291                                            (val arg_z))
292  (save-simple-frame)
293  (trap-unless-typecode= ptr x8664::subtag-macptr)
294  (call-subprim .SPgetu64)
295  (macptr-ptr ptr imm2)
296  (unbox-fixnum offset imm1)
297  (movq (% imm0) (@ (% imm2) (% imm1)))
298  (restore-simple-frame)
299  (single-value-return))
300
301
302(defx86lapfunction %%set-signed-longlong ((ptr arg_x)
303                                          (offset arg_y)
304                                          (val arg_z))
305  (save-simple-frame)
306  (trap-unless-typecode= ptr x8664::subtag-macptr)
307  (call-subprim .SPgets64)
308  (macptr-ptr ptr imm2)
309  (unbox-fixnum offset imm1)
310  (movq (% imm0) (@ (% imm2) (% imm1)))
311  (restore-simple-frame)
312  (single-value-return))
313
314(defx86lapfunction interrupt-level ()
315  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% imm1))
316  (movq (@ x8664::interrupt-level-binding-index (% imm1)) (% arg_z))
317  (single-value-return))
318
319(defx86lapfunction set-interrupt-level ((new arg_z))
320  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% imm1))
321  (trap-unless-fixnum new)
322  (movq (% new) (@ x8664::interrupt-level-binding-index (% imm1)))
323  (single-value-return))
324
325(defx86lapfunction %current-tcr ()
326  (movq (@ (% :rcontext) x8664::tcr.linear) (% arg_z))
327  (single-value-return))
328
329(defx86lapfunction %tcr-toplevel-function ((tcr arg_z))
330  (check-nargs 1)
331  (cmpq (% tcr) (@ (% :rcontext) x8664::tcr.linear))
332  (movq (% rsp) (% imm0))
333  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
334  (movq (@ x8664::area.high (% temp0)) (% imm1))
335  (jz @room)
336  (movq (@ x8664::area.active (% temp0)) (% imm0))
337  @room
338  (cmpq (% imm1) (% imm0))
339  (movl ($ x8664::nil-value) (%l arg_z))
340  (cmovneq (@ (- x8664::node-size) (% imm1)) (% arg_z))
341  (single-value-return))
342
343(defx86lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
344  (check-nargs 2)
345  (cmpq (% tcr) (@ (% :rcontext) x8664::tcr.linear))
346  (movq (% rsp) (% imm0))
347  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
348  (movq (@ x8664::area.high (% temp0)) (% imm1))
349  (jz @room)
350  (movq (@ x8664::area.active (% temp0)) (% imm0))
351  @room
352  (cmpq (% imm1) (% imm0))
353  (leaq (@ (- x8664::node-size) (% imm1)) (% imm1))
354  (movq ($ 0) (@ (% imm1)))
355  (jne @have-room)
356  (movq (% imm1) (@ x8664::area.active (% temp0)))
357  (movq (% imm1) (@ x8664::tcr.save-vsp (% tcr)))
358  @have-room
359  (movq (% fun) (@ (% imm1)))
360  (single-value-return))
361
362;;; This needs to be done out-of-line, to handle EGC memoization.
363(defx86lapfunction %store-node-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
364  (movq (@ offset (% rsp)) (% temp0))
365  (save-simple-frame)
366  (call-subprim .SPstore-node-conditional)
367  (restore-simple-frame)
368  (single-value-return 3))
369
370(defx86lapfunction %store-immediate-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
371  (movq (@ offset (% rsp)) (% temp0))
372  (unbox-fixnum temp0 imm1)
373  @again
374  (movq (@ (% object) (% imm1)) (% rax))
375  (cmpq (% rax) (% old))
376  (jne @lose)
377  (lock)
378  (cmpxchgq (% new) (@ (% object) (% imm1)))
379  (jne @again)
380  (movl ($ x8664::t-value) (%l arg_z))
381  (single-value-return 3)
382  @lose
383  (movl ($ x8664::nil-value) (%l arg_z))
384  (single-value-return 3))
385
386(defx86lapfunction set-%gcable-macptrs% ((ptr x8664::arg_z))
387  @again
388  (movq (@ (+ x8664::nil-value (x8664::kernel-global gcable-pointers)))
389        (% rax))
390  (movq (% rax) (@ x8664::xmacptr.link (% ptr)))
391  (lock)
392  (cmpxchgq (% ptr) (@ (+ x8664::nil-value (x8664::kernel-global gcable-pointers))))
393  (jne @again)
394  (single-value-return))
395
396;;; Atomically increment or decrement the gc-inhibit-count kernel-global
397;;; (It's decremented if it's currently negative, incremented otherwise.)
398(defx86lapfunction %lock-gc-lock ()
399  @again
400  (movq (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))) (% rax))
401  (lea (@ '-1 (% rax)) (% temp0))
402  (lea (@ '1 (% rax)) (% arg_z))
403  (testq (% rax) (% rax))
404  (cmovsq (% temp0) (% arg_z))
405  (lock)
406  (cmpxchgq (% arg_z) (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))))
407  (jnz @again)
408  (single-value-return))
409
410;;; Atomically decrement or increment the gc-inhibit-count kernel-global
411;;; (It's incremented if it's currently negative, incremented otherwise.)
412;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
413(defx86lapfunction %unlock-gc-lock ()
414  @again
415  (movq (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count)))
416        (% rax))
417  (lea (@ '1 (% rax)) (% arg_x))
418  (cmpq ($ -1) (% rax))
419  (lea (@ '-1 (% rax)) (% arg_z))
420  (cmovleq (% arg_x) (% arg_z))
421  (lock)
422  (cmpxchgq (% arg_z) (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))))
423  (jne @again)
424  (cmpq ($ '-1) (% rax))
425  (jne @done)
426  ;; The GC tried to run while it was inhibited.  Unless something else
427  ;; has just inhibited it, it should be possible to GC now.
428  (mov ($ arch::gc-trap-function-immediate-gc) (% imm0))
429  (uuo-gc-trap)
430  @done
431  (single-value-return))
432
433;;; Return true iff we were able to increment a non-negative
434;;; lock._value
435
436
437
438
439(defx86lapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
440  (check-nargs 3)
441  (unbox-fixnum disp imm1)
442  @again
443  (movq (@ (% node) (% imm1)) (% rax))
444  (lea (@ (% rax) (% by)) (% arg_z))
445  (lock)
446  (cmpxchgq (% arg_z) (@ (% node) (% imm1)))
447  (jne @again)
448  (single-value-return))
449
450(defx86lapfunction %atomic-incf-ptr ((ptr arg_z))
451  (macptr-ptr ptr imm2)
452  @again
453  (movq (@ (% imm2)) (% rax))
454  (lea (@ 1 (% rax)) (% imm1))
455  (lock)
456  (cmpxchgq (% imm1) (@ (% imm2)))
457  (jne @again)
458  (box-fixnum imm1 arg_z)
459  (single-value-return))
460
461(defx86lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
462  (macptr-ptr ptr imm2)
463  @again
464  (movq (@ (% imm2)) (% rax))
465  (unbox-fixnum by imm1)
466  (add (% rax) (% imm1))
467  (lock)
468  (cmpxchgq (% imm1) (@ (% imm2)))
469  (jnz @again)
470  (box-fixnum imm1 arg_z)
471  (single-value-return))
472
473
474(defx86lapfunction %atomic-decf-ptr ((ptr arg_z))
475  (macptr-ptr ptr imm2)
476  @again
477  (movq (@ (% imm2)) (% rax))
478  (lea (@ -1 (% rax)) (% imm1))
479  (lock)
480  (cmpxchgq (% imm1) (@ (% imm2)))
481  (jnz @again)
482  (box-fixnum imm1 arg_z)
483  (single-value-return))
484
485(defx86lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
486  (macptr-ptr ptr imm2)
487  @again
488  (movq (@ (% imm2)) (% rax))
489  (testq (% rax) (% rax))
490  (lea (@ -1 (% rax)) (% imm1))
491  (jz @done)
492  (lock)
493  (cmpxchgq (% imm1) (@ (% imm2)))
494  (jnz @again)
495  @done
496  (box-fixnum imm1 arg_z)
497  (single-value-return))
498
499
500(defx86lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
501  (macptr-ptr arg_y imm1)
502  (unbox-fixnum newval imm0)
503  (lock)
504  (xchgq (% imm0) (@ (% imm1)))
505  (box-fixnum imm0 arg_z)
506  (single-value-return))
507
508;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
509;;; was equal to OLDVAL.  Return the old value
510(defx86lapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
511  (macptr-ptr ptr imm2)
512  @again
513  (movq (@ (% imm2)) (% imm0))
514  (box-fixnum imm0 temp0)
515  (cmpq (% temp0) (% expected-oldval))
516  (jne @done)
517  (unbox-fixnum newval imm1)
518  (lock)
519  (cmpxchgq (% imm1) (@ (% imm2)))
520  (jne @again)
521  @done
522  (movq (% temp0) (% arg_z))
523  (single-value-return))
524
525(defx86lapfunction %ptr-store-fixnum-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
526  (let ((address imm1))
527    (macptr-ptr ptr address)
528    @again
529    (movq (@ (% address)) (% imm0))
530    (cmpq (% imm0) (% expected-oldval))
531    (jne @done)
532    (lock)
533    (cmpxchgq (% newval) (@ (% address)))
534    (jne @again)
535    @done
536    (movq (% imm0) (% arg_z))
537    (single-value-return)))
538
539(defx86lapfunction xchgl ((newval arg_y) (ptr arg_z))
540  (unbox-fixnum newval imm0)
541  (macptr-ptr ptr imm1)
542  (lock)                                ; implicit ?
543  (xchgl (% imm0.l) (@ (% imm1)))
544  (box-fixnum imm0 arg_z)
545  (single-value-return))
546 
547                         
548
549
550(defx86lapfunction %macptr->dead-macptr ((macptr arg_z))
551  (check-nargs 1)
552  (movb ($ x8664::subtag-dead-macptr) (@ x8664::misc-subtag-offset (% macptr)))
553  (single-value-return))
554
555
556
557
558 
559(defx86lapfunction %%save-application ((flags arg_y) (fd arg_z))
560  (unbox-fixnum flags imm0)
561  (orq ($ arch::gc-trap-function-save-application) (% imm0))
562  (unbox-fixnum fd imm1)
563  (uuo-gc-trap)
564  (single-value-return))
565
566
567
568(defx86lapfunction %misc-address-fixnum ((misc-object arg_z))
569  (check-nargs 1)
570  (lea (@ x8664::misc-data-offset (% misc-object)) (% arg_z))
571  (single-value-return))
572
573
574(defx86lapfunction fudge-heap-pointer ((ptr arg_x) (subtype arg_y) (len arg_z))
575  (check-nargs 3)
576  (macptr-ptr ptr imm1) ; address in macptr
577  (lea (@ 17 (% imm1)) (% imm0))     ; 2 for delta + 15 for alignment
578  (andb ($ -16) (%b  imm0))   ; Clear low four bits to align
579  (subq (% imm0) (% imm1))  ; imm1 = -delta
580  (negw (%w imm1))
581  (movw (%w imm1) (@  -2 (% imm0)))     ; save delta halfword
582  (unbox-fixnum subtype imm1)  ; subtype at low end of imm1
583  (shlq ($ (- x8664::num-subtag-bits x8664::fixnum-shift)) (% len ))
584  (orq (% len) (% imm1))
585  (movq (% imm1) (@ (% imm0)))       ; store subtype & length
586  (lea (@ x8664::fulltag-misc (% imm0)) (% arg_z)) ; tag it, return it
587  (single-value-return))
588
589(defx86lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
590  (check-nargs 2)
591  (lea (@ (- x8664::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
592  (movzwq (@ -2 (% imm0)) (% imm1))     ; get delta
593  (subq (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
594  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
595  (single-value-return))
596
597
598(defx86lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
599  (lea (@ x8664::misc-data-offset (% vect)) (% imm0))
600  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
601  (single-value-return))
602
603(defx86lapfunction get-saved-register-values ()
604  (movq (% rsp) (% temp0))
605  (push (% save0))
606  (push (% save1))
607  (push (% save2))
608  (push (% save3))
609  (set-nargs 4)
610  (jmp-subprim .SPvalues))
611
612
613(defx86lapfunction %current-db-link ()
614  (movq (@ (% :rcontext) x8664::tcr.db-link) (% arg_z))
615  (single-value-return))
616
617(defx86lapfunction %no-thread-local-binding-marker ()
618  (movq ($ x8664::subtag-no-thread-local-binding) (% arg_z))
619  (single-value-return))
620
621
622(defx86lapfunction break-event-pending-p ()
623  (xorq (% imm0) (% imm0))
624  (ref-global x8664::intflag imm1)
625  (set-global imm0 x8664::intflag)
626  (testq (% imm1) (% imm1))
627  (setne (%b imm0))
628  (andl ($ x8664::t-offset) (%l imm0))
629  (lea (@ x8664::nil-value (% imm0)) (% arg_z))
630  (single-value-return))
631
632
633(defx86lapfunction debug-trap-with-string ((arg arg_z))
634  (check-nargs 1)
635  (uuo-error-debug-trap-with-string)
636  (single-value-return))
637
638(defx86lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
639  (check-nargs 2)
640  (save-simple-frame)
641  (macptr-ptr src imm0)
642  (leaq (@ (:^ done) (% fn)) (% ra0))
643  (movq (% imm0) (@ (% :rcontext) x8664::tcr.safe-ref-address))
644  (movq (@ (% imm0)) (% imm0))
645  (jmp done)
646  (:tra done)
647  (recover-fn-from-rip)
648  (movq ($ 0) (@ (% :rcontext) x8664::tcr.safe-ref-address))
649  (movq (% imm0) (@ x8664::macptr.address (% dest)))
650  (restore-simple-frame)
651  (single-value-return))
652
653;;; This was intentded to work around a bug in #_nanosleep in early
654;;; Leopard test releases.  It's probably not necessary any more; is
655;;; it still called ?
656
657(defx86lapfunction %check-deferred-gc ()
658  (btq ($ (+ arch::tcr-flag-bit-pending-suspend target::fixnumshift)) (@ (% :rcontext) x8664::tcr.flags))
659  (movl ($ x8664::nil-value) (% arg_z.l))
660  (jae @done)
661  (ud2a)
662  (:byte 3)
663  (movl ($ x8664::t-value) (% arg_z.l))
664  @done
665  (single-value-return))
666(defx86lapfunction %%tcr-interrupt ((target arg_z))
667  (check-nargs 1)
668  (ud2a)
669  (:byte 4)
670  (box-fixnum imm0 arg_z)
671  (single-value-return))
672
673(defx86lapfunction %suspend-tcr ((target arg_z))
674  (check-nargs 1)
675  (ud2a)
676  (:byte 5)
677  (testl (%l imm0) (%l imm0))
678  (movl ($ target::nil-value) (%l arg_z))
679  (cmovel (@ target::t-offset (% arg_z)) (%l arg_z))
680  (single-value-return))
681
682(defx86lapfunction %suspend-other-threads ()
683  (check-nargs 0)
684  (ud2a)
685  (:byte 6)
686  (movl ($ target::nil-value) (%l arg_z))
687  (single-value-return))
688
689(defx86lapfunction %resume-tcr ((target arg_z))
690  (check-nargs 1)
691  (ud2a)
692  (:byte 7)
693  (testl (%l imm0) (%l imm0))
694  (movl ($ target::nil-value) (%l arg_z))
695  (cmovel (@ target::t-offset (% arg_z)) (%l arg_z))
696  (single-value-return))
697
698(defx86lapfunction %resume-other-threads ()
699  (check-nargs 0)
700  (ud2a)
701  (:byte 8)
702  (movl ($ target::nil-value) (%l arg_z))
703  (single-value-return))
704
705
706(defx86lapfunction %get-spin-lock ((p arg_z))
707  (check-nargs 1)
708  (save-simple-frame)
709  @again
710  (macptr-ptr arg_z imm1)
711  (movq (@ '*spin-lock-tries* (% fn)) (% temp0))
712  (movq (@ '*spin-lock-timeouts* (% fn)) (% temp1))
713  (movq (@ target::symbol.vcell (% temp0)) (% temp0))
714  (movq (@ (% :rcontext) x8664::tcr.linear) (% arg_y))
715  @try-swap
716  (xorq (% rax) (% rax))
717  (lock)
718  (cmpxchgq (% arg_y) (@ (% imm1)))
719  (je @done)
720  @spin
721  (pause)
722  (cmpq ($ 0) (@ (% imm1)))
723  (je @try-swap)
724  (subq ($ '1) (% temp0))
725  (jne @spin)
726  @wait
727  (addq ($ x8664::fixnumone) (@ x8664::symbol.vcell (% temp1)))
728  (pushq (% arg_z))
729  (call-symbol yield 0)
730  (popq (% arg_z))
731  (jmp @again)
732  @done
733  (restore-simple-frame)
734  (single-value-return))
735
736;;; This is a prototype; it can't easily keep its arguments on the stack,
737;;; or in registers, because its job involves unwinding the stack and
738;;; restoring registers.  Its parameters are thus kept in constants,
739;;; and this protoype is cloned (with the right parameters).
740
741(defx86lapfunction %%apply-in-frame-proto ()
742  (:fixed-constants (target-frame target-catch target-db-link target-xcf target-tsp target-foreign-sp save0-offset save1-offset save2-offset save3-offset function args))
743  (check-nargs 0)
744  ;;(uuo-error-debug-trap)
745  (movq (@ 'target-catch (% fn)) (% temp0))
746  (xorl (%l imm0) (%l imm0))
747  (cmpb ($ x8664::fulltag-nil) (%b temp0))
748  (movq (@ (% :rcontext) target::tcr.catch-top) (% arg_z))
749  (jz @did-catch)
750  @find-catch
751  (testq (% arg_z) (% arg_z))
752  (jz @did-catch)                       ; never found target catch
753  (addq ($ '1)  (% imm0))
754  (cmpq (% temp0) (% arg_z))
755  (je @found-catch)
756  (movq (@ target::catch-frame.link (% arg_z)) (% arg_z))
757  (jmp @find-catch)
758  @found-catch
759  (set-nargs 0)                         ; redundant, but ...
760  (lea (@ (:^ @back-from-nthrow) (% fn)) (% ra0))
761  (:talign 4)
762  (jmp-subprim .SPnthrowvalues)
763  @back-from-nthrow
764  (recover-fn-from-rip)
765  @did-catch
766  ;; Restore special bindings
767  (movq (@ 'target-db-link (% fn)) (% imm0))
768  (cmpb ($ x8664::fulltag-nil) (%b imm0))
769  (jz @no-unbind)
770  (call-subprim .SPunbind-to)
771  @no-unbind
772  ;; If there's at least one exception frame between the target
773  ;; frame and the last catch (or the point of departure), restore
774  ;; the NVRs and foreign sp from the oldest such frame
775  (movq (@ 'target-xcf (% fn)) (% arg_z))
776  (cmpb ($ x8664::fulltag-nil) (%b arg_z))
777  (jz @no-xcf)
778  (movq (@ target::xcf.xp (% arg_z)) (% arg_y))
779  ;; arg_y points to a "portable" ucontext.  Find the platform-specifc
780  ;; "gpr vector" in the uc_mcontext, load the NVRs and stack/frame
781  ;; pointer from there.
782  #+linuxx8664-target
783  (progn
784    (addq ($ gp-regs-offset) (% arg_y))
785    (movq (@ (* #$REG_R15 8) (% arg_y)) (% r15))
786    (movq (@ (* #$REG_R14 8) (% arg_y)) (% r14))
787    (movq (@ (* #$REG_R12 8) (% arg_y)) (% r12))
788    (movq (@ (* #$REG_R11 8) (% arg_y)) (% r11))
789    (movq (@ (* #$REG_RBP 8) (% arg_y)) (% rbp))
790    (movq (@ (* #$REG_RSP 8) (% arg_y)) (% rsp)))
791  #+freebsdx8664-target
792  (progn
793    ;; If you think that this is ugly, just wait until you see the Darwin
794    ;; version.
795    (addq ($ gp-regs-offset) (% arg_y))
796    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r15)) -3) (% arg_y)) (% r15))
797    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r14)) -3) (% arg_y)) (% r14))
798    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r12)) -3) (% arg_y)) (% r12))
799    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r11)) -3) (% arg_y)) (% r11))
800    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_rbp)) -3) (% arg_y)) (% rbp))
801    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_rsp)) -3) (% arg_y)) (% rsp)))
802  #+darwinx8664-target
803  (progn
804    ;; Yes, this is ugly.
805    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_ucontext)) :uc_mcontext)) -3) (% arg_y)) (% arg_y))
806    (addq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_mcontext64)) :__ss)) -3)) (% arg_y))
807    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r15)) -3) (% arg_y)) (% r15))
808    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r14)) -3) (% arg_y)) (% r14))
809    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r12)) -3) (% arg_y)) (% r12))
810    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r11)) -3) (% arg_y)) (% r11))
811    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__rbp)) -3) (% arg_y)) (% rbp))
812    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__rsp)) -3) (% arg_y)) (% rsp)))
813  ;; This is our best (possibly only) chance to get
814  ;; the foreign sp right.
815  (movq (@ target::xcf.prev-xframe (% arg_z)) (% temp0))
816  (movq (@ target::xcf.foreign-sp (% arg_z)) (% imm0))
817  (movq (% temp0) (@ (% :rcontext) target::tcr.xframe))
818  (movq (% imm0) (@ (% :rcontext) target::tcr.foreign-sp))
819  ;; All done processing the xcf.  NVRs may have been
820  ;; saved between the last catch/last xcf and the
821  ;; target frame.  The save-n-offset parameter/constants
822  ;; are either 0 or negative offsets from the target frame
823  ;; of the stack location where the corresponding GPR
824  ;; was saved.
825  @no-xcf
826  (movq (@ 'target-tsp (% fn)) (% imm0))
827  (cmpb ($ x8664::fulltag-nil) (%b imm0))
828  (movq (@ 'target-foreign-sp (% fn)) (% temp0))
829  (je @no-tsp)
830  (movq (% imm0) (@ (% :rcontext) target::tcr.save-tsp))
831  (movq (% imm0) (@ (% :rcontext) target::tcr.next-tsp))
832  @no-tsp
833  (cmpb ($ x8664::fulltag-nil) (%b temp0))
834  (je @no-sp)
835  (movq (% temp0) (@ (% :rcontext) target::tcr.foreign-sp))
836  @no-sp
837  (movq (@ 'target-frame (% fn)) (% rbp))
838  (movq (@ 'save0-offset (% fn)) (% arg_x))
839  (movq (@ 'save1-offset (% fn)) (% arg_y))
840  (movq (@ 'save2-offset (% fn)) (% arg_z))
841  (movq (@ 'save3-offset (% fn)) (% temp0))
842  (testq (% arg_x) (% arg_x))
843  (cmovneq (@ (% rbp) (% arg_x)) (% save0))
844  (testq (% arg_y) (% arg_y))
845  (cmovneq (@ (% rbp) (% arg_x)) (% save1))
846  (testq (% arg_z) (% arg_z))
847  (cmovneq (@ (% rbp) (% arg_x)) (% save2))
848  (testq (% temp0) (% temp0))
849  (cmovneq (@ (% rbp) (% arg_x)) (% save3))
850  (leave)
851  (pop (% temp0))                       ; return address, not used by subprim
852  (set-nargs 0)
853  (movq (@ 'args (% fn)) (% arg_z))
854  (lea (@ (:^ @back-from-spread) (% fn)) (% ra0))
855  (:talign 4)
856  (jmp-subprim .SPspreadargz)
857  @back-from-spread
858  (recover-fn-from-rip)                 ; .SPspreadargz preserves %fn, but ...
859  (push (% temp0))                      ; return address
860  (jmp (@ 'function (% fn))))
861 
862
863(defx86lapfunction %atomic-pop-static-cons ()
864  @again
865  (movq (@ (+ x8664::nil-value (x8664::kernel-global static-conses))) (% rax))
866  (testq ($ x8664::nil-value) (% rax))
867  (jz @lose)
868  (%cdr rax temp0)
869  (lock)
870  (cmpxchgq (% temp0) (@ (+ x8664::nil-value (x8664::kernel-global static-conses))))
871  (jnz @again)
872  @lose
873  (movq (% rax) (% arg_z))
874  (single-value-return))
875 
876
877
878 
879
880;;; end of x86-misc.lisp
Note: See TracBrowser for help on using the repository browser.