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

Last change on this file since 14710 was 14710, checked in by gb, 9 years ago

%IVECTOR-FROM-MACPTR for X86{32,64}

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