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

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

View File

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

View File

@ -1149,13 +1149,15 @@ typedef struct Scheme_Cont_Mark {
} Scheme_Cont_Mark;
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 *val;
MZ_MARK_POS_TYPE pos;
struct Scheme_Cont_Mark_Chain *next;
} Scheme_Cont_Mark_Chain;
#define SCHEME_MARK_CHAIN_FLAG(c) MZ_OPT_HASH_KEY(&(c)->iso)
typedef struct Scheme_Cont_Mark_Set {
Scheme_Object so;
struct Scheme_Cont_Mark_Chain *chain;