reworked the S_call_help/S_return CCHAIN handling to fix a bug in which

the signal handler could trip over the NULL jumpbuf in a CCHAIN record.
  schlib.c
remade boot files

original commit: d8c270403121547101cb523cc1f80a569dbb0378
This commit is contained in:
dybvig 2018-03-13 12:28:20 -04:00
parent 062e6a6e4e
commit aa8bea9648
2 changed files with 13 additions and 8 deletions

3
LOG
View File

@ -892,3 +892,6 @@
schlib.c, prim.c, externs.h
mats/foreign4.c, mats/foreign.ms mats/Mf-*
foreign.stex, release_notes.stex
- reworked the S_call_help/S_return CCHAIN handling to fix a bug in which
the signal handler could trip over the NULL jumpbuf in a CCHAIN record.
schlib.c

View File

@ -219,14 +219,17 @@ void S_call_help(tc, singlep, lock_ts) ptr tc; IBOOL singlep; IBOOL lock_ts; {
jb = CREATEJMPBUF();
if (jb == NULL)
S_error_abort("unable to allocate memory for jump buffer");
FRAME(tc, -1) = CCHAIN(tc) = Scons(Scons(jb, code), CCHAIN(tc));
if (lock_ts) {
/* Lock a code object passed in TS, which is a more immediate
caller whose return address is on the C stack */
Slock_object(TS(tc));
CCHAIN(tc) = Scons(Scons(NULL, TS(tc)), CCHAIN(tc));
CCHAIN(tc) = Scons(Scons(jb, Scons(code,TS(tc))), CCHAIN(tc));
} else {
CCHAIN(tc) = Scons(Scons(jb, Scons(code,Sfalse)), CCHAIN(tc));
}
FRAME(tc, -1) = CCHAIN(tc);
switch (SETJMP(jb)) {
case 0: /* first time */
S_generic_invoke(tc, S_G.invoke_code_object);
@ -268,11 +271,10 @@ void S_call_any_results() {
S_call_help(tc, 0, 1);
}
/* cchain = ((jb . co) ...) */
/* cchain = ((jb . (co . maybe-co)) ...) */
void S_return() {
ptr tc = get_thread_context();
ptr xp, yp;
void *jb;
SFP(tc) = (ptr)((ptr *)SFP(tc) - 2);
@ -286,11 +288,11 @@ void S_return() {
/* error checks are done; now unlock affected code objects */
for (xp = CCHAIN(tc); ; xp = Scdr(xp)) {
Sunlock_object(CDAR(xp));
ptr p = CDAR(xp);
Sunlock_object(Scar(p));
if (Scdr(p) != Sfalse) Sunlock_object(Scdr(p));
if (xp == yp) break;
jb = CAAR(xp);
if (jb != NULL)
FREEJMPBUF(jb);
FREEJMPBUF(CAAR(xp));
}
/* reset cchain and return via longjmp */