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

fix problem with prompts, call/cc, and tail-buffer allocation

Browse Source 
Merge to v5.3.1
This commit is contained in:
Matthew Flatt 2012-11-03 07:10:33 -06:00
parent 7a256fbb72
commit 8079ff6c4f
3 changed files with 36 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/racket/gc2/newgc.c
View File

@ -1282,6 +1282,21 @@ inline static uintptr_t allocate_slowpath(NewGC *gc, size_t allocate_size, uintp
return newptr;
}
static void check_allocation_time_invariants()
{
#if 0
Scheme_Thread *p = scheme_current_thread;
if (p) {
if (p->values_buffer) {
memset(p->values_buffer, 0, sizeof(Scheme_Object*) * p->values_buffer_size);
}
if (p->tail_buffer && (p->tail_buffer != p->runstack_tmp_keep)) {
memset(p->tail_buffer, 0, sizeof(Scheme_Object*) * p->tail_buffer_size);
}
}
#endif
}
inline static void *allocate(const size_t request_size, const int type)
{
size_t allocate_size;
@ -1289,6 +1304,8 @@ inline static void *allocate(const size_t request_size, const int type)
if(request_size == 0) return (void *) zero_sized;
check_allocation_time_invariants();
allocate_size = COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(request_size);
if(allocate_size > MAX_OBJECT_SIZE) return allocate_big(request_size, type);
@ -1340,6 +1357,8 @@ inline static void *fast_malloc_one_small_tagged(size_t request_size, int dirty)
uintptr_t newptr;
const size_t allocate_size = COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(request_size);
check_allocation_time_invariants();
newptr = GC_gen0_alloc_page_ptr + allocate_size;
if(OVERFLOWS_GEN0(newptr)) {
@ -1373,6 +1392,8 @@ void *GC_malloc_pair(void *car, void *cdr)
void *pair;
const size_t allocate_size = PAIR_SIZE_IN_BYTES;
check_allocation_time_invariants();
newptr = GC_gen0_alloc_page_ptr + allocate_size;
if(OVERFLOWS_GEN0(newptr)) {

2
src/racket/src/eval.c
View File

@ -1628,6 +1628,8 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc
else {
GC_CAN_IGNORE Scheme_Object *vals;
vals = scheme_values(num_rands, (Scheme_Object **)value);
if (SAME_OBJ(p->ku.multiple.array, p->values_buffer))
p->values_buffer = NULL;
c->value = vals;
}

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

@ -6615,6 +6615,11 @@ static Scheme_Object *call_with_prompt (int in_argc, Scheme_Object *in_argv[])
p = scheme_current_thread;
if (v == SCHEME_MULTIPLE_VALUES) {
if (SAME_OBJ(p->ku.multiple.array, p->values_buffer))
p->values_buffer = NULL;
}
restore_from_prompt(prompt);
p->suspend_break = 0;
@ -6639,6 +6644,10 @@ static Scheme_Object *call_with_prompt (int in_argc, Scheme_Object *in_argv[])
if (v) {
/* Got a result: */
if (v == SCHEME_MULTIPLE_VALUES) {
if (SAME_OBJ(p->ku.multiple.array, p->values_buffer))
p->values_buffer = NULL;
}
prompt_unwind_one_dw(prompt_tag);
handler = NULL;
} else {
@ -6706,6 +6715,10 @@ static Scheme_Object *call_with_prompt (int in_argc, Scheme_Object *in_argv[])
if (SAME_OBJ(handler, scheme_values_func)) {
v = scheme_values(argc, argv);
if (v == SCHEME_MULTIPLE_VALUES) {
if (SAME_OBJ(p->ku.multiple.array, p->values_buffer))
p->values_buffer = NULL;
}
handler = NULL;
} else if (SCHEME_FALSEP(handler)) {
if (argc == 1) {