adjust non-JIT application of chaperone with only properties

Don't push elements to the runstack that aren't popped back off. I
can't construct an example that demonstrates a problem, but fix it
just in case.
This commit is contained in:
Matthew Flatt 2016-01-09 06:09:36 -07:00
parent dafb6d722e
commit 3e5c889b7d

View File

@ -3746,21 +3746,6 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
int need_pop_mark;
Scheme_Cont_Frame_Data cframe;
if (argv == MZ_RUNSTACK) {
/* Pushing onto the runstack ensures that `(vector-ref px->redirects 0)' won't
modify argv. */
if (MZ_RUNSTACK > MZ_RUNSTACK_START) {
--MZ_RUNSTACK;
*MZ_RUNSTACK = NULL;
need_restore = 1;
} else {
/* Can't push! Just allocate a copy. */
argv2 = MALLOC_N(Scheme_Object *, argc);
memcpy(argv2, argv, sizeof(Scheme_Object*) * argc);
argv = argv2;
}
}
if (SCHEME_RPAIRP(o)) {
/* An applicable struct, where a layer of struct chaperones
has been removed from the object to apply, but we will
@ -3804,6 +3789,21 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
return _scheme_tail_apply(px->prev, argc, argv);
}
if (argv == MZ_RUNSTACK) {
/* Pushing onto the runstack ensures that `(vector-ref px->redirects 0)' won't
modify argv. */
if (MZ_RUNSTACK > MZ_RUNSTACK_START) {
--MZ_RUNSTACK;
*MZ_RUNSTACK = NULL;
need_restore = 1;
} else {
/* Can't push! Just allocate a copy. */
argv2 = MALLOC_N(Scheme_Object *, argc);
memcpy(argv2, argv, sizeof(Scheme_Object*) * argc);
argv = argv2;
}
}
/* Ensure that the original procedure accepts `argc' arguments: */
if (argc != SCHEME_INT_VAL(SCHEME_VEC_ELS(px->redirects)[1])) {
a[0] = px->prev;