fix problem with (continuation-marks <thread>)
A thread can be swapped out while it's in transition between a mandling of the mark-stack position and recovering from C-stack overflow. Fix up that case.
This commit is contained in:
parent
f3a8883331
commit
21f78ecd14
|
@ -66,6 +66,26 @@
|
||||||
(k inside))
|
(k inside))
|
||||||
0)))))
|
0)))))
|
||||||
|
|
||||||
|
(test 0 'deep-recursion-get-marks
|
||||||
|
(let ()
|
||||||
|
(define (nontail-mark-loop n)
|
||||||
|
(let loop ([n n])
|
||||||
|
(if (zero? n)
|
||||||
|
'(0)
|
||||||
|
(list (car (with-continuation-mark 'x n
|
||||||
|
(apply list (loop (sub1 n)))))))))
|
||||||
|
(define orig-t (current-thread))
|
||||||
|
(define t (thread
|
||||||
|
(lambda ()
|
||||||
|
(let loop ([v #f])
|
||||||
|
;; We hope to try to get marks at a place when
|
||||||
|
;; the main thread overflows the C stack while
|
||||||
|
;; trying to handle a tail call.
|
||||||
|
(loop (continuation-marks orig-t))))))
|
||||||
|
(nontail-mark-loop proc-depth)
|
||||||
|
(kill-thread t)
|
||||||
|
0))
|
||||||
|
|
||||||
(define (read-deep depth)
|
(define (read-deep depth)
|
||||||
(define paren-port
|
(define paren-port
|
||||||
(let* ([depth depth]
|
(let* ([depth depth]
|
||||||
|
|
|
@ -1367,6 +1367,12 @@ static Scheme_Object **evacuate_runstack(int num_rands, Scheme_Object **rands, S
|
||||||
return rands;
|
return rands;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Scheme_Object *do_eval_k_readjust_mark(void)
|
||||||
|
{
|
||||||
|
MZ_CONT_MARK_POS -= 2; /* undo increment in do_eval_stack_overflow() */
|
||||||
|
return do_eval_k();
|
||||||
|
}
|
||||||
|
|
||||||
static Scheme_Object *do_eval_stack_overflow(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
|
static Scheme_Object *do_eval_stack_overflow(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
|
||||||
int get_value)
|
int get_value)
|
||||||
{
|
{
|
||||||
|
@ -1390,7 +1396,14 @@ static Scheme_Object *do_eval_stack_overflow(Scheme_Object *obj, int num_rands,
|
||||||
} else
|
} else
|
||||||
p->ku.k.p2 = (void *)rands;
|
p->ku.k.p2 = (void *)rands;
|
||||||
p->ku.k.i2 = get_value;
|
p->ku.k.i2 = get_value;
|
||||||
return scheme_handle_stack_overflow(do_eval_k);
|
|
||||||
|
/* In case we got here via scheme_force_value_same_mark(), in case
|
||||||
|
overflow handling causes the thread to sleep, and in case another
|
||||||
|
thread tries to get this thread's continuation marks: ensure tha
|
||||||
|
the mark pos is not below any current mark. */
|
||||||
|
MZ_CONT_MARK_POS += 2;
|
||||||
|
|
||||||
|
return scheme_handle_stack_overflow(do_eval_k_readjust_mark);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Scheme_Dynamic_Wind *intersect_dw(Scheme_Dynamic_Wind *a, Scheme_Dynamic_Wind *b,
|
static Scheme_Dynamic_Wind *intersect_dw(Scheme_Dynamic_Wind *a, Scheme_Dynamic_Wind *b,
|
||||||
|
|
|
@ -1431,7 +1431,16 @@ scheme_force_value_same_mark(Scheme_Object *obj)
|
||||||
Scheme_Object *v;
|
Scheme_Object *v;
|
||||||
|
|
||||||
MZ_CONT_MARK_POS -= 2;
|
MZ_CONT_MARK_POS -= 2;
|
||||||
|
/* At this point, if the thread is swapped out and we attempt to get
|
||||||
|
the continuation marks of the thread, then MZ_CONT_MARK_POS may
|
||||||
|
be inconsistent with the first mark on the stack. We assume that
|
||||||
|
a thread swap will not happen until scheme_do_eval(), where
|
||||||
|
the first possibility for a swap is on stack overflow, and
|
||||||
|
in that case MZ_CONT_MARK_POS is adjusted back before overflow
|
||||||
|
handling (which can cause the thread to swap out). */
|
||||||
|
|
||||||
v = force_values(obj, 1);
|
v = force_values(obj, 1);
|
||||||
|
|
||||||
MZ_CONT_MARK_POS += 2;
|
MZ_CONT_MARK_POS += 2;
|
||||||
|
|
||||||
return v;
|
return v;
|
||||||
|
@ -1443,7 +1452,10 @@ scheme_force_one_value_same_mark(Scheme_Object *obj)
|
||||||
Scheme_Object *v;
|
Scheme_Object *v;
|
||||||
|
|
||||||
MZ_CONT_MARK_POS -= 2;
|
MZ_CONT_MARK_POS -= 2;
|
||||||
|
/* See above about thread swaps */
|
||||||
|
|
||||||
v = force_values(obj, 0);
|
v = force_values(obj, 0);
|
||||||
|
|
||||||
MZ_CONT_MARK_POS += 2;
|
MZ_CONT_MARK_POS += 2;
|
||||||
|
|
||||||
return v;
|
return v;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user