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:
parent
dafb6d722e
commit
3e5c889b7d
|
@ -3746,21 +3746,6 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
|
||||||
int need_pop_mark;
|
int need_pop_mark;
|
||||||
Scheme_Cont_Frame_Data cframe;
|
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)) {
|
if (SCHEME_RPAIRP(o)) {
|
||||||
/* An applicable struct, where a layer of struct chaperones
|
/* An applicable struct, where a layer of struct chaperones
|
||||||
has been removed from the object to apply, but we will
|
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);
|
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: */
|
/* Ensure that the original procedure accepts `argc' arguments: */
|
||||||
if (argc != SCHEME_INT_VAL(SCHEME_VEC_ELS(px->redirects)[1])) {
|
if (argc != SCHEME_INT_VAL(SCHEME_VEC_ELS(px->redirects)[1])) {
|
||||||
a[0] = px->prev;
|
a[0] = px->prev;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user