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;
|
||||
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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user