suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #365 from mflatt/retreg

Browse Source 
correct CP(TC) management for callable return
original commit: ff73b2bcdecbf8f5b9360a7f774dba70b664249b
This commit is contained in:
R. Kent Dybvig 2018-12-05 11:49:25 -08:00 committed by GitHub
commit 44f93b0ddb
6 changed files with 61 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
LOG
View File

@ -1021,3 +1021,7 @@
get-mode, and path-absolute more consistent with
https://docs.microsoft.com/en-us/windows/desktop/FileIO/naming-a-file
6.ss, 6.ms, io.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

27
mats/foreign.ms
View File

@ -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)

19
mats/foreign2.c
View File

@ -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;
}
}

12
s/cpnanopass.ss
View File

@ -10730,9 +10730,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)
@ -10748,8 +10751,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
@ -10757,6 +10760,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
View File

@ -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 ...)))))))))))))))
)

6
s/x86_64.ss
View File

@ -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 ...))))))))))))))
)