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

Last change on this file since 11482 was 11482, checked in by gz, 13 years ago

r11450 from trunk: *quit-interrupt-hook*

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