add stack-overflow check in compiler's letrec-check pass

Closes PR 15247
This commit is contained in:
Matthew Flatt 2016-02-17 06:16:31 -07:00
parent 0c38da0ee2
commit db04b47cdb

View File

@ -20,6 +20,7 @@
*/
#include "schpriv.h"
#include "schmach.h"
/* PLAN:
*
@ -987,9 +988,37 @@ static Scheme_Object *letrec_check_module(Scheme_Object *o, Letrec_Check_Frame *
return o;
}
static Scheme_Object *letrec_check_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *expr = (Scheme_Object *)p->ku.k.p1;
Letrec_Check_Frame *frame = (Letrec_Check_Frame *)p->ku.k.p3;
Scheme_Object *pos = (Scheme_Object *)p->ku.k.p3;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
return letrec_check_expr(expr, frame, pos);
}
static Scheme_Object *letrec_check_expr(Scheme_Object *expr, Letrec_Check_Frame *frame, Scheme_Object *pos)
{
int type;
#ifdef DO_STACK_CHECK
# include "mzstkchk.h"
{
Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)expr;
p->ku.k.p2 = (void *)frame;
p->ku.k.p3 = (void *)pos;
return scheme_handle_stack_overflow(letrec_check_k);
}
#endif
type = SCHEME_TYPE(expr);
SCHEME_USE_FUEL(1);