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

more memory-accounting repairs, so that sandbox tests now pass

Browse Source 
svn: r12861
This commit is contained in:
Matthew Flatt 2008-12-15 21:15:24 +00:00
parent 0786da10cb
commit 25b27a8b08
5 changed files with 60 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/mzscheme/sandbox.ss
View File

@ -152,7 +152,7 @@
(make-evaluator 'scheme/base
'(define a (for/list ([i (in-range 10)])
(collect-garbage)
(make-string 1000))))))
(make-string 500000))))))
=err> "out of memory"))
;; i/o
@ -488,9 +488,13 @@
--eval--
(define a '())
(define b 1)
(for ([i (in-range 20)])
(set! a (cons (make-bytes 500000) a))
(collect-garbage))
(length
(for/fold ([v null]) ([i (in-range 20)])
;; Increases size of sandbox:
(set! a (cons (make-bytes 500000) a))
(collect-garbage)
;; Increases size of evaluation:
(cons (make-bytes 500000) v)))
=err> "out of memory"
b => 1))

7
src/mzscheme/gc2/gc2.h
View File

@ -371,6 +371,13 @@ GC2_EXTERN void GC_fixup_variable_stack(void **var_stack,
The `stack_mem' argument indicates the start of the allocated memory
that contains `var_stack'. It is used for backtraces. */
GC2_EXTERN int GC_merely_accounting();
/*
Can be called by a mark or fixup traversal proc to determine whether
the traversal is merely for accounting, in which case some marking
can be skipped if the corresponding data should be charged to a
different object. */
GC2_EXTERN void GC_write_barrier(void *p);
/*
Explicit write barrier to ensure that a write-barrier signal is not

6
src/mzscheme/gc2/newgc.c
View File

@ -1404,6 +1404,12 @@ void GC_register_new_thread(void *t, void *c)
#endif
}
int GC_merely_accounting()
{
NewGC *gc = GC_get_GC();
return gc->doing_memory_accounting;
}
/*****************************************************************************/
/* administration / initialization */
/*****************************************************************************/

38
src/mzscheme/src/mzmark.c
View File

@ -923,8 +923,10 @@ static int cont_proc_MARK(void *p) {
MARK_cjs(&c->cjs);
MARK_stack_state(&c->ss);
gcMARK(c->barrier_prompt);
gcMARK(c->runstack_start);
gcMARK(c->runstack_saved);
if (!GC_merely_accounting()) {
gcMARK(c->runstack_start);
gcMARK(c->runstack_saved);
}
gcMARK(c->prompt_id);
gcMARK(c->prompt_buf);
@ -961,8 +963,10 @@ static int cont_proc_FIXUP(void *p) {
FIXUP_cjs(&c->cjs);
FIXUP_stack_state(&c->ss);
gcFIXUP(c->barrier_prompt);
gcFIXUP(c->runstack_start);
gcFIXUP(c->runstack_saved);
if (!GC_merely_accounting()) {
gcFIXUP(c->runstack_start);
gcFIXUP(c->runstack_saved);
}
gcFIXUP(c->prompt_id);
gcFIXUP(c->prompt_buf);
@ -1600,12 +1604,16 @@ static int thread_val_MARK(void *p) {
gcMARK(pr->init_config);
gcMARK(pr->init_break_cell);
{
if (!pr->runstack_owner
|| !GC_merely_accounting()
|| (*pr->runstack_owner == pr)) {
Scheme_Object **rs = pr->runstack_start;
gcMARK( pr->runstack_start);
pr->runstack = pr->runstack_start + (pr->runstack - rs);
if (pr->runstack != pr->runstack_start + (pr->runstack - rs))
pr->runstack = pr->runstack_start + (pr->runstack - rs);
gcMARK(pr->runstack_saved);
}
gcMARK(pr->runstack_saved);
gcMARK(pr->runstack_owner);
gcMARK(pr->runstack_swapped);
pr->spare_runstack = NULL; /* just in case */
@ -1706,12 +1714,16 @@ static int thread_val_FIXUP(void *p) {
gcFIXUP(pr->init_config);
gcFIXUP(pr->init_break_cell);
{
if (!pr->runstack_owner
|| !GC_merely_accounting()
|| (*pr->runstack_owner == pr)) {
Scheme_Object **rs = pr->runstack_start;
gcFIXUP_TYPED_NOW(Scheme_Object **, pr->runstack_start);
pr->runstack = pr->runstack_start + (pr->runstack - rs);
if (pr->runstack != pr->runstack_start + (pr->runstack - rs))
pr->runstack = pr->runstack_start + (pr->runstack - rs);
gcFIXUP(pr->runstack_saved);
}
gcFIXUP(pr->runstack_saved);
gcFIXUP(pr->runstack_owner);
gcFIXUP(pr->runstack_swapped);
pr->spare_runstack = NULL; /* just in case */
@ -1858,7 +1870,8 @@ static int prompt_val_SIZE(void *p) {
static int prompt_val_MARK(void *p) {
Scheme_Prompt *pr = (Scheme_Prompt *)p;
gcMARK(pr->boundary_overflow_id);
gcMARK(pr->runstack_boundary_start);
if (!GC_merely_accounting())
gcMARK(pr->runstack_boundary_start);
gcMARK(pr->tag);
gcMARK(pr->id);
return
@ -1868,7 +1881,8 @@ static int prompt_val_MARK(void *p) {
static int prompt_val_FIXUP(void *p) {
Scheme_Prompt *pr = (Scheme_Prompt *)p;
gcFIXUP(pr->boundary_overflow_id);
gcFIXUP(pr->runstack_boundary_start);
if (!GC_merely_accounting())
gcFIXUP(pr->runstack_boundary_start);
gcFIXUP(pr->tag);
gcFIXUP(pr->id);
return

19
src/mzscheme/src/mzmarksrc.c
View File

@ -355,8 +355,10 @@ cont_proc {
MARK_cjs(&c->cjs);
MARK_stack_state(&c->ss);
gcMARK(c->barrier_prompt);
gcMARK(c->runstack_start);
gcMARK(c->runstack_saved);
if (!GC_merely_accounting()) {
gcMARK(c->runstack_start);
gcMARK(c->runstack_saved);
}
gcMARK(c->prompt_id);
gcMARK(c->prompt_buf);
@ -615,12 +617,16 @@ thread_val {
gcMARK(pr->init_config);
gcMARK(pr->init_break_cell);
{
if (!pr->runstack_owner
|| !GC_merely_accounting()
|| (*pr->runstack_owner == pr)) {
Scheme_Object **rs = pr->runstack_start;
gcFIXUP_TYPED_NOW(Scheme_Object **, pr->runstack_start);
pr->runstack = pr->runstack_start + (pr->runstack - rs);
if (pr->runstack != pr->runstack_start + (pr->runstack - rs))
pr->runstack = pr->runstack_start + (pr->runstack - rs);
gcMARK(pr->runstack_saved);
}
gcMARK(pr->runstack_saved);
gcMARK(pr->runstack_owner);
gcMARK(pr->runstack_swapped);
pr->spare_runstack = NULL; /* just in case */
@ -738,7 +744,8 @@ prompt_val {
mark:
Scheme_Prompt *pr = (Scheme_Prompt *)p;
gcMARK(pr->boundary_overflow_id);
gcMARK(pr->runstack_boundary_start);
if (!GC_merely_accounting())
gcMARK(pr->runstack_boundary_start);
gcMARK(pr->tag);
gcMARK(pr->id);
size: