suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

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

cherry picked from cisco/ChezScheme#d8c2704031

original commit: f03e2535577df3e3b5d8ad7349c46d4c2e89b507
This commit is contained in:
dyb 2018-07-02 07:43:02 -06:00 committed by Matthew Flatt
parent 349f36e2a0
commit 9e7900e2f9
4 changed files with 27 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
LOG
View File

@ -763,6 +763,9 @@
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
- added box-cas! and vector-cas!
prims.ss, cpnanopass.ss, np-languages.ss,
cmacros.ss, library.ss, primdata.ss

2
c/externs.h
View File

@ -343,7 +343,7 @@ extern void S_machine_init PROTO((void));
extern void S_initframe PROTO((ptr tc, iptr n));
extern void S_put_arg PROTO((ptr tc, iptr i, ptr x));
extern void S_return PROTO((void));
extern void S_call_help PROTO((ptr tc, IBOOL singlep));
extern void S_call_help PROTO((ptr tc, IBOOL singlep, IBOOL lock_ts));
extern void S_call_one_result PROTO((void));
extern void S_call_any_results PROTO((void));

2
c/scheme.c
View File

@ -320,7 +320,7 @@ static ptr boot_call(tc, p, n) ptr tc; ptr p; INT n; {
CP(tc) = Svoid; /* don't have calling code object */
AC0(tc) = (ptr)(uptr)n;
S_call_help(tc, 0);
S_call_help(tc, 0, 0);
check_ap(tc);
CP(tc) = Svoid; /* leave clean so direct Scall won't choke */

31
c/schlib.c
View File

@ -199,14 +199,16 @@ ptr Scall(cp, argcnt) ptr cp; iptr argcnt; {
static ptr S_call(tc, cp, argcnt) ptr tc; ptr cp; iptr argcnt; {
AC0(tc) = (ptr)argcnt;
AC1(tc) = cp;
S_call_help(tc, 1);
S_call_help(tc, 1, 0);
return AC0(tc);
}
/* args are set up, argcnt in ac0, closure in ac1 */
void S_call_help(tc, singlep) ptr tc; IBOOL singlep; {
/* declaring code volatile should be unnecessary, but it quiets gcc */
void *jb; volatile ptr code;
void S_call_help(tc_in, singlep, lock_ts) ptr tc_in; IBOOL singlep; IBOOL lock_ts; {
/* declaring code and tc volatile should be unnecessary, but it quiets gcc
and avoids occasional invalid memory violations on Windows */
void *jb; volatile ptr code;
volatile ptr tc = tc_in;
/* lock caller's code object, since his return address is sitting in
the C stack and we may end up in a garbage collection */
@ -219,7 +221,16 @@ void S_call_help(tc, singlep) ptr tc; IBOOL singlep; {
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(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 */
@ -254,15 +265,15 @@ void S_call_help(tc, singlep) ptr tc; IBOOL singlep; {
void S_call_one_result() {
ptr tc = get_thread_context();
S_call_help(tc, 1);
S_call_help(tc, 1, 1);
}
void S_call_any_results() {
ptr tc = get_thread_context();
S_call_help(tc, 0);
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;
@ -279,7 +290,9 @@ 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;
FREEJMPBUF(CAAR(xp));
}