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

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

Another batch of changes from the trunk, some bug fixes, optimizations, as well as formatting unification

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 31.0 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 break-event-pending-p ()
625  (xorq (% imm0) (% imm0))
626  (ref-global x8664::intflag imm1)
627  (set-global imm0 x8664::intflag)
628  (testq (% imm1) (% imm1))
629  (setne (%b imm0))
630  (andl ($ x8664::t-offset) (%l imm0))
631  (lea (@ (target-nil-value) (% imm0)) (% arg_z))
632  (single-value-return))
633
634
635(defx86lapfunction debug-trap-with-string ((arg arg_z))
636  (check-nargs 1)
637  (uuo-error-debug-trap-with-string)
638  (single-value-return))
639
640(defx86lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
641  (check-nargs 2)
642  (save-simple-frame)
643  (macptr-ptr src imm0)
644  (leaq (@ (:^ done) (% fn)) (% ra0))
645  (movq (% imm0) (:rcontext x8664::tcr.safe-ref-address))
646  (movq (@ (% imm0)) (% imm0))
647  (jmp done)
648  (:tra done)
649  (recover-fn-from-rip)
650  (movq ($ 0) (:rcontext x8664::tcr.safe-ref-address))
651  (movq (% imm0) (@ x8664::macptr.address (% dest)))
652  (restore-simple-frame)
653  (single-value-return))
654
655;;; This was intentded to work around a bug in #_nanosleep in early
656;;; Leopard test releases.  It's probably not necessary any more; is
657;;; it still called ?
658
659(defx86lapfunction %check-deferred-gc ()
660  (btq ($ (+ arch::tcr-flag-bit-pending-suspend target::fixnumshift)) (:rcontext x8664::tcr.flags))
661  (movl ($ (target-nil-value)) (% arg_z.l))
662  (jae @done)
663  (ud2a)
664  (:byte 3)
665  (movl ($ (target-t-value)) (% arg_z.l))
666  @done
667  (single-value-return))
668
669(defx86lapfunction %%tcr-interrupt ((target arg_z))
670  (check-nargs 1)
671  (ud2a)
672  (:byte 4)
673  (box-fixnum imm0 arg_z)
674  (single-value-return))
675
676(defx86lapfunction %suspend-tcr ((target arg_z))
677  (check-nargs 1)
678  (ud2a)
679  (:byte 5)
680  (movzbl (%b imm0) (%l imm0))
681  (testl (%l imm0) (%l imm0))
682  (movl ($ (target-nil-value)) (%l arg_z))
683  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
684  (single-value-return))
685
686(defx86lapfunction %suspend-other-threads ()
687  (check-nargs 0)
688  (ud2a)
689  (:byte 6)
690  (movl ($ (target-nil-value)) (%l arg_z))
691  (single-value-return))
692
693(defx86lapfunction %resume-tcr ((target arg_z))
694  (check-nargs 1)
695  (ud2a)
696  (:byte 7)
697  (movzbl (%b imm0) (%l imm0))
698  (testl (%l imm0) (%l imm0))
699  (movl ($ (target-nil-value)) (%l arg_z))
700  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
701  (single-value-return))
702
703(defx86lapfunction %resume-other-threads ()
704  (check-nargs 0)
705  (ud2a)
706  (:byte 8)
707  (movl ($ (target-nil-value)) (%l arg_z))
708  (single-value-return))
709
710(defx86lapfunction %kill-tcr ((target arg_z))
711  (check-nargs 1)
712  (ud2a)
713  (:byte 9)
714  (testb (%b imm0) (%b imm0))
715  (movl ($ (target-nil-value)) (%l arg_z))
716  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
717  (single-value-return))
718 
719
720(defx86lapfunction %get-spin-lock ((p arg_z))
721  (check-nargs 1)
722  (save-simple-frame)
723  @again
724  (macptr-ptr arg_z imm1)
725  (movq (@ '*spin-lock-tries* (% fn)) (% temp0))
726  (movq (@ '*spin-lock-timeouts* (% fn)) (% temp1))
727  (movq (@ target::symbol.vcell (% temp0)) (% temp0))
728  (movq (:rcontext x8664::tcr.linear) (% arg_y))
729  @try-swap
730  (xorq (% rax) (% rax))
731  (lock)
732  (cmpxchgq (% arg_y) (@ (% imm1)))
733  (je @done)
734  @spin
735  (pause)
736  (cmpq ($ 0) (@ (% imm1)))
737  (je @try-swap)
738  (subq ($ '1) (% temp0))
739  (jne @spin)
740  @wait
741  (addq ($ x8664::fixnumone) (@ x8664::symbol.vcell (% temp1)))
742  (pushq (% arg_z))
743  (call-symbol yield 0)
744  (popq (% arg_z))
745  (jmp @again)
746  @done
747  (restore-simple-frame)
748  (single-value-return))
749
750;;; This is a prototype; it can't easily keep its arguments on the stack,
751;;; or in registers, because its job involves unwinding the stack and
752;;; restoring registers.  Its parameters are thus kept in constants,
753;;; and this protoype is cloned (with the right parameters).
754
755;;; For win64 (which doesn't really have a "save3" register), the code
756;;; which instantiates this should always set save3-offset to 0.
757(defx86lapfunction %%apply-in-frame-proto ()
758  (: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))
759  (check-nargs 0)
760  ;;(uuo-error-debug-trap)
761  (movq (@ 'target-catch (% fn)) (% temp0))
762  (xorl (%l imm0) (%l imm0))
763  (cmpb ($ x8664::fulltag-nil) (%b temp0))
764  (movq (:rcontext target::tcr.catch-top) (% arg_z))
765  (jz @did-catch)
766  @find-catch
767  (testq (% arg_z) (% arg_z))
768  (jz @did-catch)                       ; never found target catch
769  (addq ($ '1)  (% imm0))
770  (cmpq (% temp0) (% arg_z))
771  (je @found-catch)
772  (movq (@ target::catch-frame.link (% arg_z)) (% arg_z))
773  (jmp @find-catch)
774  @found-catch
775  (set-nargs 0)                         ; redundant, but ...
776  (lea (@ (:^ @back-from-nthrow) (% fn)) (% ra0))
777  (:talign 4)
778  (jmp-subprim .SPnthrowvalues)
779  @back-from-nthrow
780  (recover-fn-from-rip)
781  @did-catch
782  ;; Restore special bindings
783  (movq (@ 'target-db-link (% fn)) (% imm0))
784  (cmpb ($ x8664::fulltag-nil) (%b imm0))
785  (jz @no-unbind)
786  (call-subprim .SPunbind-to)
787  @no-unbind
788  ;; If there's at least one exception frame between the target
789  ;; frame and the last catch (or the point of departure), restore
790  ;; the NVRs and foreign sp from the oldest such frame
791  (movq (@ 'target-xcf (% fn)) (% arg_z))
792  (cmpb ($ x8664::fulltag-nil) (%b arg_z))
793  (jz @no-xcf)
794  (movq (@ target::xcf.xp (% arg_z)) (% arg_y))
795  ;; arg_y points to a "portable" ucontext.  Find the platform-specifc
796  ;; "gpr vector" in the uc_mcontext, load the NVRs and stack/frame
797  ;; pointer from there.
798  #+linuxx8664-target
799  (progn
800    (addq ($ gp-regs-offset) (% arg_y))
801    (movq (@ (* #$REG_R15 8) (% arg_y)) (% r15))
802    (movq (@ (* #$REG_R14 8) (% arg_y)) (% r14))
803    (movq (@ (* #$REG_R12 8) (% arg_y)) (% r12))
804    (movq (@ (* #$REG_R11 8) (% arg_y)) (% r11))
805    (movq (@ (* #$REG_RBP 8) (% arg_y)) (% rbp))
806    (movq (@ (* #$REG_RSP 8) (% arg_y)) (% rsp)))
807  #+freebsdx8664-target
808  (progn
809    ;; If you think that this is ugly, just wait until you see the Darwin
810    ;; version.
811    (addq ($ gp-regs-offset) (% arg_y))
812    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r15)) -3) (% arg_y)) (% r15))
813    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r14)) -3) (% arg_y)) (% r14))
814    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r12)) -3) (% arg_y)) (% r12))
815    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r11)) -3) (% arg_y)) (% r11))
816    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_rbp)) -3) (% arg_y)) (% rbp))
817    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_rsp)) -3) (% arg_y)) (% rsp)))
818  #+darwinx8664-target
819  (progn
820    ;; Yes, this is ugly.
821    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_ucontext)) :uc_mcontext)) -3) (% arg_y)) (% arg_y))
822    (addq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_mcontext64)) :__ss)) -3)) (% arg_y))
823    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r15)) -3) (% arg_y)) (% r15))
824    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r14)) -3) (% arg_y)) (% r14))
825    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r12)) -3) (% arg_y)) (% r12))
826    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r11)) -3) (% arg_y)) (% r11))
827    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__rbp)) -3) (% arg_y)) (% rbp))
828    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__rsp)) -3) (% arg_y)) (% rsp)))
829  ;; This is our best (possibly only) chance to get
830  ;; the foreign sp right.
831  (movq (@ target::xcf.prev-xframe (% arg_z)) (% temp0))
832  (movq (@ target::xcf.foreign-sp (% arg_z)) (% imm0))
833  (movq (% temp0) (:rcontext target::tcr.xframe))
834  (movq (% imm0) (:rcontext target::tcr.foreign-sp))
835  ;; All done processing the xcf.  NVRs may have been
836  ;; saved between the last catch/last xcf and the
837  ;; target frame.  The save-n-offset parameter/constants
838  ;; are either 0 or negative offsets from the target frame
839  ;; of the stack location where the corresponding GPR
840  ;; was saved.
841  @no-xcf
842  (movq (@ 'target-tsp (% fn)) (% imm0))
843  (cmpb ($ x8664::fulltag-nil) (%b imm0))
844  (movq (@ 'target-foreign-sp (% fn)) (% temp0))
845  (je @no-tsp)
846  (movq (% imm0) (:rcontext target::tcr.save-tsp))
847  (movq (% imm0) (:rcontext target::tcr.next-tsp))
848  @no-tsp
849  (cmpb ($ x8664::fulltag-nil) (%b temp0))
850  (je @no-sp)
851  (movq (% temp0) (:rcontext target::tcr.foreign-sp))
852  @no-sp
853  (movq (@ 'target-frame (% fn)) (% rbp))
854  (movq (@ 'save0-offset (% fn)) (% arg_x))
855  (movq (@ 'save1-offset (% fn)) (% arg_y))
856  (movq (@ 'save2-offset (% fn)) (% arg_z))
857  (movq (@ 'save3-offset (% fn)) (% temp0))
858  (testq (% arg_x) (% arg_x))
859  (cmovneq (@ (% rbp) (% arg_x)) (% save0))
860  (testq (% arg_y) (% arg_y))
861  (cmovneq (@ (% rbp) (% arg_x)) (% save1))
862  (testq (% arg_z) (% arg_z))
863  (cmovneq (@ (% rbp) (% arg_x)) (% save2))
864  (testq (% temp0) (% temp0))
865  (cmovneq (@ (% rbp) (% arg_x)) (% save3))
866  (leave)
867  (pop (% temp0))                       ; return address, not used by subprim
868  (set-nargs 0)
869  (movq (@ 'args (% fn)) (% arg_z))
870  (lea (@ (:^ @back-from-spread) (% fn)) (% ra0))
871  (:talign 4)
872  (jmp-subprim .SPspreadargz)
873  @back-from-spread
874  (recover-fn-from-rip)                 ; .SPspreadargz preserves %fn, but ...
875  (push (% temp0))                      ; return address
876  (jmp (@ 'function (% fn))))
877 
878
879(defx86lapfunction %atomic-pop-static-cons ()
880  @again
881  (movq (@ (+ (target-nil-value) (x8664::kernel-global static-conses))) (% rax))
882  (testq ($ (target-nil-value)) (% rax))
883  (jz @lose)
884  (%cdr rax temp0)
885  (lock)
886  (cmpxchgq (% temp0) (@ (+ (target-nil-value) (x8664::kernel-global static-conses))))
887  (jnz @again)
888  @lose
889  (movq (% rax) (% arg_z))
890  (single-value-return))
891 
892(defx86lapfunction %staticp ((x arg_z))
893  (check-nargs 1)
894  (ref-global tenured-area temp0)
895  (movq (% x) (% imm0))
896  (subq (@ target::area.low (% temp0)) (% imm0))
897  (shrq ($ target::dnode-shift) (% imm0))
898  (cmpq (@ target::area.static-dnodes (% temp0)) (% imm0))
899  (leaq (@ (% imm0) target::fixnumone) (% arg_z))
900  (movl ($ (target-nil-value)) (%l imm0))
901  (cmovaeq (% imm0) (% arg_z))
902  (single-value-return))
903
904(defx86lapfunction %static-inverse-cons ((n arg_z))
905  (check-nargs 1)
906  (ref-global tenured-area temp0)
907  (movq (@ target::area.low (% temp0)) (% imm0))
908  (leaq (@ target::fulltag-cons (% imm0) (% n) 2) (% arg_z))
909  (single-value-return))
910
911
912 
913
914;;; end of x86-misc.lisp
915) ; #+x8664-target
Note: See TracBrowser for help on using the repository browser.