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

Last change on this file since 8012 was 8012, checked in by gb, 13 years ago

%APPLY-IN-FRAME-PROTO.

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