reliably preserve cp in thread context for S_call_help
Also, for completeness, correct the listing of callee-save registers in callable return for x86 & x86_64. original commit: 276f8da076a5692457226ea6ad74ba5f0e71cc06
This commit is contained in:
Matthew Flatt
parent
b7f90e2495
commit
31e65b1554
4
LOG
4
LOG
|
|
@ -1023,3 +1023,7 @@
|
|||
newhash.ss, primdata.ss,
|
||||
hash.ms, root-experr*,
|
||||
objects.stex, release_notes.stex
|
||||
- fix handling of calling code's address for locking around a callable,
|
||||
where the cp register copy in the thread context could be changed
|
||||
in the callable prep before S_call_help gets it
|
||||
cpnanopass.ss, x86_64.ss, x86.ss, foreign2.c, foreign.ms
|
||||
|
|
|
|||
|
|
@ -2516,6 +2516,29 @@
|
|||
(let ([v ($with-exit-proc (lambda (k) (Sinvoke2 Fcons k 5)))])
|
||||
(list v (locked-object? Fcons)))))
|
||||
'((#t #f) (#t #f)))
|
||||
|
||||
;; Make sure the code pointer for a call into a
|
||||
;; foreign procedure is correctly saved for locking
|
||||
;; when entering a callback as a callable:
|
||||
(equal?
|
||||
(let ()
|
||||
(define v 0)
|
||||
(define call_many_times (foreign-procedure "call_many_times" (void*) void))
|
||||
(define work
|
||||
(lambda (n)
|
||||
;; This loop needs to be non-allocating, but
|
||||
;; causes varying numbers of ticks
|
||||
;; to be used up.
|
||||
(let loop ([n (bitwise-and n #xFFFF)])
|
||||
(unless (zero? n)
|
||||
(set! v (add1 v))
|
||||
(loop (bitwise-arithmetic-shift-right n 1))))))
|
||||
(define handler (foreign-callable work (long) void))
|
||||
(lock-object handler)
|
||||
(call_many_times (foreign-callable-entry-point handler))
|
||||
v)
|
||||
14995143)
|
||||
|
||||
)
|
||||
|
||||
(machine-case
|
||||
|
|
@ -3021,10 +3044,6 @@
|
|||
(let ([m (make-mutex)]
|
||||
[done? #f]
|
||||
[ok? #t])
|
||||
(define object->addr
|
||||
(foreign-procedure "(cs)fxmul"
|
||||
(scheme-object uptr)
|
||||
uptr))
|
||||
(fork-thread (lambda ()
|
||||
(let loop ([i 10])
|
||||
(unless (zero? i)
|
||||
|
|
|
|||
|
|
@ -424,3 +424,22 @@ EXPORT i64 ifoo64a(i64 a, i64 b, i64 c, i64 d, i64 e, i64 f, i64 g) {
|
|||
EXPORT i64 ifoo64b(i32 x, i64 a, i64 b, i64 c, i64 d, i64 e, i64 f, i64 g) {
|
||||
return (i64)x + (a - b) + (c - d) + (e - f) + g;
|
||||
}
|
||||
|
||||
EXPORT void call_many_times(void (*f)(iptr))
|
||||
{
|
||||
int x;
|
||||
iptr a = 1, b = 3, c = 5, d = 7;
|
||||
iptr e = 1, g = 3, h = 5, i = 7;
|
||||
iptr j = 1, k = 3, l = 5, m = 7;
|
||||
iptr big = (((iptr)1) << ((8 * sizeof(iptr)) - 2));
|
||||
|
||||
/* The intent of the loop is to convince the C compiler to store
|
||||
something in the same register used for CP (so, compile with
|
||||
optimization). */
|
||||
for (x = 0; x < 1000000; x++) {
|
||||
f(big|(a+e+j));
|
||||
a = b; b = c; c = d; d = e;
|
||||
e = g; g = h; h = i; i = j;
|
||||
j = k+2; k = l+2; l = m+2; m = m+2;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10997,9 +10997,12 @@
|
|||
; c-return restores callee-save registers and returns to C
|
||||
(%seq
|
||||
,(c-init)
|
||||
; although we don't actually need %cp in a register, we need
|
||||
; to make sure that `(%tc-ref cp)` doesn't change before S_call_help
|
||||
; is called, and claiming that %cp is live is the easiest way
|
||||
,(restore-scheme-state
|
||||
(in) ; save just the required registers, e.g., %sfp
|
||||
(out %ac0 %ac1 %cp %xp %yp %ts %td scheme-args extra-regs))
|
||||
(in %cp)
|
||||
(out %ac0 %ac1 %xp %yp %ts %td scheme-args extra-regs))
|
||||
; need overflow check since we're effectively retroactively turning
|
||||
; what was a foreign call into a Scheme non-tail call
|
||||
(fcallable-overflow-check)
|
||||
|
|
@ -11015,8 +11018,8 @@
|
|||
(set! ,(ref-reg %ac1) (literal ,(make-info-literal #f 'object 0 0)))
|
||||
(set! ,(ref-reg %ts) (label-ref ,self-label 0)) ; for locking
|
||||
,(save-scheme-state
|
||||
(in %ac0 %ac1 %ts)
|
||||
(out %cp %xp %yp %td scheme-args extra-regs))
|
||||
(in %ac0 %ac1 %ts %cp)
|
||||
(out %xp %yp %td scheme-args extra-regs))
|
||||
; Scall-{any,one}-results calls the Scheme implementation of the
|
||||
; callable, locking this callable wrapper (as communicated in %ts)
|
||||
; until just before returning
|
||||
|
|
@ -11024,6 +11027,7 @@
|
|||
,(restore-scheme-state
|
||||
(in %ac0)
|
||||
(out %ac1 %cp %xp %yp %ts %td scheme-args extra-regs))
|
||||
; assuming no use of %cp from here on that could get saved into `(%tc-ref cp)`:
|
||||
,(Scheme->C-for-result result-type c-result %ac0)
|
||||
,(c-return)))))))))))
|
||||
(define handle-do-rest
|
||||
|
|
|
|||
2
s/x86.ss
2
s/x86.ss
|
|
@ -2882,6 +2882,7 @@
|
|||
locs))
|
||||
get-result
|
||||
(lambda ()
|
||||
(define callee-save-regs (list %ebx %edi %esi %ebp))
|
||||
(in-context Tail
|
||||
((lambda (e)
|
||||
(if adjust-active?
|
||||
|
|
@ -2913,5 +2914,6 @@
|
|||
;; after popping the return address
|
||||
(make-info-c-return 4)
|
||||
null-info)
|
||||
,callee-save-regs ...
|
||||
,result-regs ...)))))))))))))))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -3410,6 +3410,10 @@
|
|||
locs))
|
||||
get-result
|
||||
(lambda ()
|
||||
(define callee-save-regs
|
||||
(if-feature windows
|
||||
(list %rbx %rbp %rdi %rsi %r12 %r13 %r14 %r15)
|
||||
(list %rbx %rbp %r12 %r13 %r14 %r15)))
|
||||
(in-context Tail
|
||||
((lambda (e)
|
||||
(if adjust-active?
|
||||
|
|
@ -3441,5 +3445,5 @@
|
|||
(set! ,%rbp ,(%inline pop))
|
||||
(set! ,%rbx ,(%inline pop))
|
||||
(set! ,%sp ,(%inline + ,%sp (immediate 136)))))
|
||||
(asm-c-return ,null-info ,result-regs ...))))))))))))))
|
||||
(asm-c-return ,null-info ,callee-save-regs ... ,result-regs ...))))))))))))))
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user