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:
Matthew Flatt 2014-07-30 07:17:08 +01:00
parent f3a8883331
commit 21f78ecd14
3 changed files with 47 additions and 2 deletions

View File

@ -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]

View File

@ -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,

View File

@ -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;