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

fix bug related to continuation-mark-set->list*

Browse Source 
svn: r16678
This commit is contained in:
Matthew Flatt 2009-11-11 00:01:01 +00:00
parent a566cd488a
commit f2d14f7af0
2 changed files with 30 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/mzscheme/src/fun.c
View File

@ -6624,8 +6624,8 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
Scheme_Cont_Mark_Set *set; Scheme_Cont_Mark_Set *set;
Scheme_Object *cache, *nt; Scheme_Object *cache, *nt;
long findpos, bottom; long findpos, bottom;
long cmpos, cdelta = 0; long cmpos, first_cmpos = 0, cdelta = 0;
int found_tag = 0; int found_tag = 0, at_mc_boundary = 0;
if (cont && SAME_OBJ(cont->prompt_tag, prompt_tag)) if (cont && SAME_OBJ(cont->prompt_tag, prompt_tag))
found_tag = 1; found_tag = 1;
@ -6651,6 +6651,7 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
cmpos = (long)mc->cont_mark_pos; cmpos = (long)mc->cont_mark_pos;
cdelta = mc->cont_mark_offset; cdelta = mc->cont_mark_offset;
bottom = 0; bottom = 0;
at_mc_boundary = 1;
} else { } else {
findpos = (long)MZ_CONT_MARK_STACK; findpos = (long)MZ_CONT_MARK_STACK;
cmpos = (long)MZ_CONT_MARK_POS; cmpos = (long)MZ_CONT_MARK_POS;
@ -6736,10 +6737,16 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
if (cache) { if (cache) {
if (((Scheme_Cont_Mark_Chain *)cache)->key) { if (((Scheme_Cont_Mark_Chain *)cache)->key) {
if (last) if (last) {
last->next = (Scheme_Cont_Mark_Chain *)cache; last->next = (Scheme_Cont_Mark_Chain *)cache;
else if (at_mc_boundary) {
SCHEME_MARK_CHAIN_FLAG(last) |= 0x1;
at_mc_boundary = 0;
}
} else {
first = (Scheme_Cont_Mark_Chain *)cache; first = (Scheme_Cont_Mark_Chain *)cache;
first_cmpos = cmpos;
}
found_tag = 1; /* cached => tag is there */ found_tag = 1; /* cached => tag is there */
} else { } else {
@ -6756,7 +6763,7 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
} else { } else {
Scheme_Cont_Mark_Chain *pr; Scheme_Cont_Mark_Chain *pr;
pr = MALLOC_ONE_RT(Scheme_Cont_Mark_Chain); pr = MALLOC_ONE_RT(Scheme_Cont_Mark_Chain);
pr->so.type = scheme_cont_mark_chain_type; pr->iso.so.type = scheme_cont_mark_chain_type;
pr->key = find[pos].key; pr->key = find[pos].key;
pr->val = find[pos].val; pr->val = find[pos].val;
pr->pos = find[pos].pos; pr->pos = find[pos].pos;
@ -6822,10 +6829,16 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
(Scheme_Object *)pr); (Scheme_Object *)pr);
find[pos].cache = cache; find[pos].cache = cache;
} }
if (last) if (last) {
last->next = pr; last->next = pr;
else if (at_mc_boundary) {
SCHEME_MARK_CHAIN_FLAG(last) |= 1;
at_mc_boundary = 0;
}
} else {
first = pr; first = pr;
first_cmpos = cmpos;
}
last = pr; last = pr;
} }
@ -6876,10 +6889,13 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
nt = NULL; nt = NULL;
#endif #endif
if (first && (first_cmpos < first->pos))
scheme_signal_error("internal error: bad mark-stack position");
set = MALLOC_ONE_TAGGED(Scheme_Cont_Mark_Set); set = MALLOC_ONE_TAGGED(Scheme_Cont_Mark_Set);
set->so.type = scheme_cont_mark_set_type; set->so.type = scheme_cont_mark_set_type;
set->chain = first; set->chain = first;
set->cmpos = cmpos; set->cmpos = first_cmpos;
set->native_stack_trace = nt; set->native_stack_trace = nt;
return (Scheme_Object *)set; return (Scheme_Object *)set;
@ -7099,10 +7115,12 @@ extract_cc_markses(int argc, Scheme_Object *argv[])
prompt_tag = SCHEME_PTR_VAL(prompt_tag); prompt_tag = SCHEME_PTR_VAL(prompt_tag);
chain = ((Scheme_Cont_Mark_Set *)argv[0])->chain; chain = ((Scheme_Cont_Mark_Set *)argv[0])->chain;
last_pos = ((Scheme_Cont_Mark_Set *)argv[0])->cmpos + 2; last_pos = -1;
while (chain) { while (chain) {
for (i = 0; i < len; i++) { for (i = 0; i < len; i++) {
if (SCHEME_MARK_CHAIN_FLAG(chain) & 0x1)
last_pos = -1;
if (SAME_OBJ(chain->key, keys[i])) { if (SAME_OBJ(chain->key, keys[i])) {
long pos; long pos;
pos = (long)chain->pos; pos = (long)chain->pos;

4
src/mzscheme/src/schpriv.h
View File

@ -1149,13 +1149,15 @@ typedef struct Scheme_Cont_Mark {
} Scheme_Cont_Mark; } Scheme_Cont_Mark;
typedef struct Scheme_Cont_Mark_Chain { typedef struct Scheme_Cont_Mark_Chain {
Scheme_Object so; Scheme_Inclhash_Object iso; /* 0x1 => next is from different meta-continuation */
Scheme_Object *key; Scheme_Object *key;
Scheme_Object *val; Scheme_Object *val;
MZ_MARK_POS_TYPE pos; MZ_MARK_POS_TYPE pos;
struct Scheme_Cont_Mark_Chain *next; struct Scheme_Cont_Mark_Chain *next;
} Scheme_Cont_Mark_Chain; } Scheme_Cont_Mark_Chain;
#define SCHEME_MARK_CHAIN_FLAG(c) MZ_OPT_HASH_KEY(&(c)->iso)
typedef struct Scheme_Cont_Mark_Set { typedef struct Scheme_Cont_Mark_Set {
Scheme_Object so; Scheme_Object so;
struct Scheme_Cont_Mark_Chain *chain; struct Scheme_Cont_Mark_Chain *chain;