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

avoid retaining unneeded runstacks in continuations

Browse Source 
While a continuation is set up to avoid retaining runstacks, partly by
storing a prompt ID instead of a prompt record, prompt records can
remain on the C stack and get captured anyway. Mitigate that problem
by making the runstack link weak in some prompt record.

Racket CS doesn't have this problem, of course.

Relevant to jeapostrophe/lux#10
This commit is contained in:
Matthew Flatt 2019-06-04 12:27:51 -06:00
parent 6eb2175f7a
commit 0ca19cfa08
6 changed files with 193 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
pkgs/racket-test/tests/racket/stress/prompt-mem-use.rkt Normal file
View File

@ -0,0 +1,75 @@
#lang racket/base
;; Version 1, using DOS
#;(require dos)
;; Version 2, going direct
(begin
(define 0x80 (make-continuation-prompt-tag 'dos))
(define (run-process-until-syscall p st)
(call-with-continuation-barrier
(λ ()
(call-with-continuation-prompt
(λ () (p st))
0x80
(λ (x) x)))))
(define (dos-syscall k->syscall)
;; First we capture our context back to the OS
(call-with-current-continuation
(λ (k)
;; Then we abort, give it to the OS, along with a syscall
;; specification
(abort-current-continuation 0x80 (k->syscall k)))
0x80))
(define USE-OBSCENE-MEMORY? #t)
(define (map-reduce f + a l)
(if USE-OBSCENE-MEMORY?
(cond
[(null? l) a]
[else
(+ (f (car l)) (map-reduce f + a (cdr l)))])
(cond
[(null? l)
a]
[(pair? l)
(+ (map-reduce f + a (car l))
(map-reduce f + a (cdr l)))]
[else
(f l)])))
(define USE-LOTS-OF-MEMORY? #t)
(define (dos-boot merge-effects last-state ps empty-effects)
(if USE-LOTS-OF-MEMORY?
(map-reduce (λ (p) (run-process-until-syscall p last-state))
merge-effects
empty-effects
ps)
(map (λ (p) (run-process-until-syscall p last-state)) ps))))
(define nothing-threads
(for/list ([i (in-range 1900)])
(λ (init-st)
(let lp ()
(dos-syscall (λ (k) k))
(lp)))))
;; prevent inlining
(set! dos-boot dos-boot)
(begin
(let lp ([ps nothing-threads] [max-use 0] [n 0] [grow-n 0])
(printf "~s ~s ~s\n" max-use n grow-n)
(unless (= n 200)
(when (= grow-n 25)
(error "memory use grew too many times"))
(collect-garbage)
(define use (current-memory-use))
(lp (dos-boot cons #f ps null)
(max use max-use)
(add1 n)
(if (use . > . max-use)
(add1 grow-n)
grow-n)))))

98
racket/src/racket/src/fun.c
View File

@ -996,16 +996,61 @@ int scheme_intern_prim_opt_flags(int flags)
/* prompt helpers */
/*========================================================================*/
static void initialize_prompt(Scheme_Thread *p, Scheme_Prompt *prompt, void *stack_boundary)
static void initialize_prompt(Scheme_Thread *p, Scheme_Prompt *prompt, void *stack_boundary, int is_barrier)
{
prompt->is_barrier = 0;
prompt->is_barrier = is_barrier;
prompt->stack_boundary = stack_boundary;
prompt->runstack_boundary_start = MZ_RUNSTACK_START;
if (is_barrier) {
/* Avoid leak in case barrier is retained longer than the rest of the stack */
Scheme_Object *ref;
ref = scheme_make_weak_box((Scheme_Object *)MZ_RUNSTACK_START);
prompt->u.runstack_boundary_start_ref = ref;
prompt->weak_boundary = 1;
} else
prompt->u.runstack_boundary_start = MZ_RUNSTACK_START;
prompt->runstack_boundary_offset = (MZ_RUNSTACK - MZ_RUNSTACK_START);
prompt->mark_boundary = MZ_CONT_MARK_STACK;
prompt->boundary_mark_pos = MZ_CONT_MARK_POS;
}
Scheme_Object **scheme_prompt_runstack_boundary_start(Scheme_Prompt *p)
{
if (p->weak_boundary)
return (Scheme_Object **)(SCHEME_BOX_VAL(p->u.runstack_boundary_start_ref));
else
return p->u.runstack_boundary_start;
}
static void init_prompt_id(Scheme_Prompt *prompt)
{
Scheme_Object *id;
if (!prompt->id) {
id = scheme_make_pair(scheme_false, scheme_false);
prompt->id = id;
}
}
Scheme_Prompt *make_weak_prompt(Scheme_Prompt *p)
{
Scheme_Prompt *p2;
Scheme_Object *ref;
if (p->weak_boundary)
return p;
init_prompt_id(p);
p2 = MALLOC_ONE_TAGGED(Scheme_Prompt);
memcpy(p2, p, sizeof(Scheme_Prompt));
ref = scheme_make_weak_box((Scheme_Object *)p2->u.runstack_boundary_start);
p2->u.runstack_boundary_start_ref = ref;
p2->weak_boundary = 1;
return p2;
}
/*========================================================================*/
/* stack-overflow wrapper */
/*========================================================================*/
@ -1193,11 +1238,7 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread)
if (eb) {
prompt = allocate_prompt(&available_prompt);
initialize_prompt(p, prompt, PROMPT_STACK(prompt));
if (!new_thread) {
prompt->is_barrier = 1;
}
initialize_prompt(p, prompt, PROMPT_STACK(prompt), !new_thread);
}
#ifdef MZ_PRECISE_GC
@ -4589,7 +4630,7 @@ static Scheme_Saved_Stack *copy_out_runstack(Scheme_Thread *p,
size += MAX_CALL_CC_ARG_COUNT;
else
size += shared_amt;
} else if (effective_prompt && (effective_prompt->runstack_boundary_start == runstack_start)) {
} else if (effective_prompt && (scheme_prompt_runstack_boundary_start(effective_prompt) == runstack_start)) {
/* Copy only up to the prompt */
size = effective_prompt->runstack_boundary_offset - (runstack XFORM_OK_MINUS runstack_start);
} else {
@ -4604,7 +4645,7 @@ static Scheme_Saved_Stack *copy_out_runstack(Scheme_Thread *p,
memcpy(saved->runstack_start, runstack, size * sizeof(Scheme_Object *));
saved->runstack_offset = (runstack XFORM_OK_MINUS runstack_start);
if (!effective_prompt || (effective_prompt->runstack_boundary_start != runstack_start)) {
if (!effective_prompt || (scheme_prompt_runstack_boundary_start(effective_prompt) != runstack_start)) {
/* Copy saved runstacks: */
if (share_from) {
@ -4630,7 +4671,7 @@ static Scheme_Saved_Stack *copy_out_runstack(Scheme_Thread *p,
isaved->prev = ss;
isaved = ss;
if (effective_prompt && (effective_prompt->runstack_boundary_start == csaved->runstack_start)) {
if (effective_prompt && (scheme_prompt_runstack_boundary_start(effective_prompt) == csaved->runstack_start)) {
size = effective_prompt->runstack_boundary_offset - csaved->runstack_offset;
done = 1;
} else {
@ -5071,16 +5112,16 @@ static Scheme_Meta_Continuation *clone_meta_cont(Scheme_Meta_Continuation *mc,
saved = clone_runstack_copied(cnaya->runstack_copied,
cnaya->runstack_start,
cnaya->runstack_saved,
prompt->runstack_boundary_start,
scheme_prompt_runstack_boundary_start(prompt),
prompt->runstack_boundary_offset);
cnaya->runstack_copied = saved;
/* Prune unneeded buffers */
if (prompt->runstack_boundary_start == cnaya->runstack_start)
if (scheme_prompt_runstack_boundary_start(prompt) == cnaya->runstack_start)
saved = NULL;
else
saved = clone_runstack_saved(cnaya->runstack_saved,
prompt->runstack_boundary_start,
scheme_prompt_runstack_boundary_start(prompt),
NULL);
cnaya->runstack_saved = saved;
@ -5383,16 +5424,12 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
cont->meta_continuation = NULL;
} else if (prompt) {
Scheme_Meta_Continuation *mc;
Scheme_Object *id;
mc = clone_meta_cont(p->meta_continuation, pt, -1, prompt_cont, prompt, NULL, composable);
cont->meta_continuation = mc;
if (!prompt_cont) {
/* Remember the prompt id, so we can maybe take a shortcut on
invocation. (The shortcut only works within a meta-continuation.) */
if (!prompt->id) {
id = scheme_make_pair(scheme_false, scheme_false);
prompt->id = id;
}
init_prompt_id(prompt);
cont->prompt_id = prompt->id;
}
cont->has_prompt_dw = 1;
@ -5475,11 +5512,11 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
(Note that this is different than runstack_copied;
runstack_saved keeps the shared runstack buffers,
not the content.) */
if (SAME_OBJ(prompt->runstack_boundary_start, MZ_RUNSTACK_START))
if (scheme_prompt_runstack_boundary_start(prompt) == MZ_RUNSTACK_START)
saved = NULL;
else
saved = clone_runstack_saved(cont->runstack_saved,
prompt->runstack_boundary_start,
scheme_prompt_runstack_boundary_start(prompt),
NULL);
cont->runstack_saved = saved;
}
@ -5629,11 +5666,11 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
/* In shortcut mode, we need to preserve saved runstacks
that were pruned when capturing the continuation. */
Scheme_Saved_Stack *rs;
if (shortcut_prompt->runstack_boundary_start == MZ_RUNSTACK_START)
if (scheme_prompt_runstack_boundary_start(shortcut_prompt) == MZ_RUNSTACK_START)
rs = p->runstack_saved;
else {
rs = p->runstack_saved;
while (rs && (rs->runstack_start != shortcut_prompt->runstack_boundary_start)) {
while (rs && (rs->runstack_start != scheme_prompt_runstack_boundary_start(shortcut_prompt))) {
rs = rs->prev;
}
if (rs)
@ -5762,10 +5799,10 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
actual = actual->prev;
}
if (actual) {
meta_prompt->runstack_boundary_start = actual->runstack_start;
meta_prompt->u.runstack_boundary_start = actual->runstack_start;
meta_prompt->runstack_boundary_offset = actual->runstack_offset + saved->runstack_size;
} else {
meta_prompt->runstack_boundary_start = MZ_RUNSTACK_START;
meta_prompt->u.runstack_boundary_start = MZ_RUNSTACK_START;
meta_prompt->runstack_boundary_offset = (MZ_RUNSTACK - MZ_RUNSTACK_START) + saved->runstack_size + delta;
MZ_ASSERT(meta_prompt->runstack_boundary_offset <= scheme_current_thread->runstack_size);
}
@ -5935,6 +5972,13 @@ internal_call_cc (int argc, Scheme_Object *argv[])
return NULL;
}
/* This prompt is likely to be on the C stack when we capture it for
the continuation, but we only want to retain the prompt's
runstack. Convert it to one that has the same ID but holds the
runstack weakly. */
if (prompt)
prompt = make_weak_prompt(prompt);
barrier_prompt = scheme_get_barrier_prompt(&barrier_cont, &barrier_pos);
if (composable && SCHEME_FALSEP(argv[2])) {
@ -6736,7 +6780,7 @@ static void restore_from_prompt(Scheme_Prompt *prompt)
{
Scheme_Thread *p = scheme_current_thread;
while (MZ_RUNSTACK_START != prompt->runstack_boundary_start) {
while (MZ_RUNSTACK_START != scheme_prompt_runstack_boundary_start(prompt)) {
MZ_RUNSTACK_START = p->runstack_saved->runstack_start;
p->runstack_saved = p->runstack_saved->prev;
}
@ -7029,7 +7073,7 @@ static Scheme_Object *call_with_prompt (int in_argc, Scheme_Object *in_argv[])
ASSERT_SUSPEND_BREAK_ZERO();
initialize_prompt(p, prompt, NULL);
initialize_prompt(p, prompt, NULL, 0);
if (p->overflow) {
ensure_overflow_id(p->overflow);

32
racket/src/racket/src/mzmark_type.inc
View File

@ -2857,8 +2857,8 @@ static int runstack_val_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
intptr_t *s = (intptr_t *)p;
void **a, **b;
a = (void **)s + 5 + s[2];
b = (void **)s + 5 + s[3];
a = (void **)s + RUNSTACK_HEADER_FIELDS + s[2];
b = (void **)s + RUNSTACK_HEADER_FIELDS + s[3];
while (a < b) {
gcMARK2(*a, gc);
a++;
@ -2866,14 +2866,14 @@ static int runstack_val_MARK(void *p, struct NewGC *gc) {
/* Zero out the part that we didn't mark, in case it becomes
live later. */
a = (void **)s + 5;
b = (void **)s + 5 + s[2];
a = (void **)s + RUNSTACK_HEADER_FIELDS;
b = (void **)s + RUNSTACK_HEADER_FIELDS + s[2];
while (a < b) {
*a = RUNSTACK_ZERO_VAL;
a++;
}
a = (void **)s + 5 + s[3];
b = (void **)s + 5 + (s[1] - 5);
a = (void **)s + RUNSTACK_HEADER_FIELDS + s[3];
b = (void **)s + RUNSTACK_HEADER_FIELDS + (s[1] - RUNSTACK_HEADER_FIELDS);
while (a < b) {
*a = RUNSTACK_ZERO_VAL;
a++;
@ -2892,8 +2892,8 @@ static int runstack_val_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
intptr_t *s = (intptr_t *)p;
void **a, **b;
a = (void **)s + 5 + s[2];
b = (void **)s + 5 + s[3];
a = (void **)s + RUNSTACK_HEADER_FIELDS + s[2];
b = (void **)s + RUNSTACK_HEADER_FIELDS + s[3];
while (a < b) {
gcFIXUP2(*a, gc);
a++;
@ -2925,8 +2925,12 @@ static int prompt_val_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Prompt *pr = (Scheme_Prompt *)p;
gcMARK2(pr->boundary_overflow_id, gc);
if (!GC_merely_accounting())
gcMARK2(pr->runstack_boundary_start, gc);
if (!GC_merely_accounting()) {
if (pr->is_barrier)
gcMARK2(pr->u.runstack_boundary_start_ref, gc);
else
gcMARK2(pr->u.runstack_boundary_start, gc);
}
gcMARK2(pr->tag, gc);
gcMARK2(pr->id, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
@ -2942,8 +2946,12 @@ static int prompt_val_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Prompt *pr = (Scheme_Prompt *)p;
gcFIXUP2(pr->boundary_overflow_id, gc);
if (!GC_merely_accounting())
gcFIXUP2(pr->runstack_boundary_start, gc);
if (!GC_merely_accounting()) {
if (pr->is_barrier)
gcFIXUP2(pr->u.runstack_boundary_start_ref, gc);
else
gcFIXUP2(pr->u.runstack_boundary_start, gc);
}
gcFIXUP2(pr->tag, gc);
gcFIXUP2(pr->id, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS

20
racket/src/racket/src/mzmarksrc.c
View File

@ -810,8 +810,8 @@ runstack_val {
intptr_t *s = (intptr_t *)p;
mark:
void **a, **b;
a = (void **)s + 5 + s[2];
b = (void **)s + 5 + s[3];
a = (void **)s + RUNSTACK_HEADER_FIELDS + s[2];
b = (void **)s + RUNSTACK_HEADER_FIELDS + s[3];
while (a < b) {
gcMARK2(*a, gc);
a++;
@ -820,14 +820,14 @@ runstack_val {
START_MARK_ONLY;
/* Zero out the part that we didn't mark, in case it becomes
live later. */
a = (void **)s + 5;
b = (void **)s + 5 + s[2];
a = (void **)s + RUNSTACK_HEADER_FIELDS;
b = (void **)s + RUNSTACK_HEADER_FIELDS + s[2];
while (a < b) {
*a = RUNSTACK_ZERO_VAL;
a++;
}
a = (void **)s + 5 + s[3];
b = (void **)s + 5 + (s[1] - 5);
a = (void **)s + RUNSTACK_HEADER_FIELDS + s[3];
b = (void **)s + RUNSTACK_HEADER_FIELDS + (s[1] - RUNSTACK_HEADER_FIELDS);
while (a < b) {
*a = RUNSTACK_ZERO_VAL;
a++;
@ -842,8 +842,12 @@ prompt_val {
mark:
Scheme_Prompt *pr = (Scheme_Prompt *)p;
gcMARK2(pr->boundary_overflow_id, gc);
if (!GC_merely_accounting())
gcMARK2(pr->runstack_boundary_start, gc);
if (!GC_merely_accounting()) {
if (pr->is_barrier)
gcMARK2(pr->u.runstack_boundary_start_ref, gc);
else
gcMARK2(pr->u.runstack_boundary_start, gc);
}
gcMARK2(pr->tag, gc);
gcMARK2(pr->id, gc);
size:

13
racket/src/racket/src/schpriv.h
View File

@ -736,6 +736,10 @@ THREAD_LOCAL_DECL(extern MZ_MARK_POS_TYPE scheme_current_cont_mark_pos);
# define MZ_CONT_MARK_POS (scheme_current_thread->cont_mark_pos)
#endif
#ifdef MZ_PRECISE_GC
# define RUNSTACK_HEADER_FIELDS 5
#endif
THREAD_LOCAL_DECL(extern volatile int scheme_fuel_counter);
THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_main_thread);
@ -1977,19 +1981,24 @@ typedef struct Scheme_Meta_Continuation {
typedef struct Scheme_Prompt {
Scheme_Object so;
char is_barrier, has_chaperone;
char is_barrier, has_chaperone, weak_boundary;
Scheme_Object *tag;
Scheme_Object *id; /* created as needed; allows direct-jump optimization for cont app */
void *stack_boundary; /* where to stop copying the C stack */
void *boundary_overflow_id; /* indicates the C stack segment */
MZ_MARK_STACK_TYPE mark_boundary; /* where to stop copying cont marks */
MZ_MARK_POS_TYPE boundary_mark_pos; /* mark position of prompt */
Scheme_Object **runstack_boundary_start; /* which stack has runstack_boundary */
union {
Scheme_Object **runstack_boundary_start; /* which stack has runstack_boundary */
Scheme_Object *runstack_boundary_start_ref; /* weak-ref variant, used when `weak_boundary` */
} u;
intptr_t runstack_boundary_offset; /* where to stop copying the Scheme stack */
mz_jmp_buf *prompt_buf; /* to jump directly to the prompt */
intptr_t runstack_size; /* needed for restore */
} Scheme_Prompt;
XFORM_NONGCING Scheme_Object **scheme_prompt_runstack_boundary_start(Scheme_Prompt *p);
/* Compiler helper: */
#define ESCAPED_BEFORE_HERE return NULL

8
racket/src/racket/src/thread.c
View File

@ -2740,7 +2740,7 @@ Scheme_Object **scheme_alloc_runstack(intptr_t len)
#ifdef MZ_PRECISE_GC
intptr_t sz;
void **p;
sz = sizeof(Scheme_Object*) * (len + 5);
sz = sizeof(Scheme_Object*) * (len + RUNSTACK_HEADER_FIELDS);
p = (void **)GC_malloc_tagged_allow_interior(sz);
*(Scheme_Type *)(void *)p = scheme_rt_runstack;
((intptr_t *)(void *)p)[1] = gcBYTES_TO_WORDS(sz);
@ -2748,7 +2748,7 @@ Scheme_Object **scheme_alloc_runstack(intptr_t len)
((intptr_t *)(void *)p)[3] = len;
# define MZ_RUNSTACK_OVERFLOW_CANARY 0xFF77FF77
((intptr_t *)(void *)p)[4] = MZ_RUNSTACK_OVERFLOW_CANARY;
return (Scheme_Object **)(p + 5);
return (Scheme_Object **)(p + RUNSTACK_HEADER_FIELDS);
#else
return (Scheme_Object **)scheme_malloc_allow_interior(sizeof(Scheme_Object*) * len);
#endif
@ -9093,7 +9093,7 @@ static void prepare_thread_for_GC(Scheme_Object *t)
Scheme_Object **rs_start;
/* If there's a meta-prompt, we can also zero out past the unused part */
if (p->meta_prompt && (p->meta_prompt->runstack_boundary_start == p->runstack_start)) {
if (p->meta_prompt && (scheme_prompt_runstack_boundary_start(p->meta_prompt) == p->runstack_start)) {
rs_end = p->meta_prompt->runstack_boundary_offset;
} else {
rs_end = p->runstack_size;
@ -9115,7 +9115,7 @@ static void prepare_thread_for_GC(Scheme_Object *t)
for (saved = p->runstack_saved; saved; saved = saved->prev) {
RUNSTACK_TUNE( size += saved->runstack_size; );
if (p->meta_prompt && (p->meta_prompt->runstack_boundary_start == saved->runstack_start)) {
if (p->meta_prompt && (scheme_prompt_runstack_boundary_start(p->meta_prompt) == saved->runstack_start)) {
rs_end = p->meta_prompt->runstack_boundary_offset;
} else {
rs_end = saved->runstack_size;