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))
|
||||
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 paren-port
|
||||
(let* ([depth depth]
|
||||
|
|
|
@ -1367,6 +1367,12 @@ static Scheme_Object **evacuate_runstack(int num_rands, Scheme_Object **rands, S
|
|||
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,
|
||||
int get_value)
|
||||
{
|
||||
|
@ -1390,7 +1396,14 @@ static Scheme_Object *do_eval_stack_overflow(Scheme_Object *obj, int num_rands,
|
|||
} else
|
||||
p->ku.k.p2 = (void *)rands;
|
||||
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,
|
||||
|
|
|
@ -1429,9 +1429,18 @@ Scheme_Object *
|
|||
scheme_force_value_same_mark(Scheme_Object *obj)
|
||||
{
|
||||
Scheme_Object *v;
|
||||
|
||||
|
||||
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);
|
||||
|
||||
MZ_CONT_MARK_POS += 2;
|
||||
|
||||
return v;
|
||||
|
@ -1443,7 +1452,10 @@ scheme_force_one_value_same_mark(Scheme_Object *obj)
|
|||
Scheme_Object *v;
|
||||
|
||||
MZ_CONT_MARK_POS -= 2;
|
||||
/* See above about thread swaps */
|
||||
|
||||
v = force_values(obj, 0);
|
||||
|
||||
MZ_CONT_MARK_POS += 2;
|
||||
|
||||
return v;
|
||||
|
|
Loading…
Reference in New Issue
Block a user