Wrap each compiled code evaluation in a catchframe for safe resumable…

… error handling
Affonso-Gui · Oct 31, 2022 · b896e81 · b896e81
1 parent 1a3d141
commit b896e81
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 4 deletions.
diff --git a/lisp/c/eus.c b/lisp/c/eus.c
@@ -329,6 +329,7 @@ va_dcl
   register struct callframe *vf;
   pointer msg,form,callstack;
   pointer errobj;
+  pointer result;
 
 #ifdef USE_STDARG
   va_start(args,ec);
@@ -435,7 +436,13 @@ va_dcl
   Spevalof(QEVALHOOK)=NIL;	/* reset eval hook */
   if (errhandler!=NIL) {
     vpush(errobj);
-    ufuncall(ctx,errhandler,errhandler,(pointer)(ctx->vsp-1),ctx->bindfp,1);}
+    result=ufuncall(ctx,errhandler,errhandler,(pointer)(ctx->vsp-1),ctx->bindfp,1);}
+  else {
+    result=NIL;
+  }
+  // the NULL catcher is introduced by catchfuncode, in order to ensure
+  // that errors follow the termination semantics in the C lang level
+  throw(ctx,NULL,result);
 }
 
 #ifdef USE_STDARG

diff --git a/lisp/c/eval.c b/lisp/c/eval.c
@@ -1450,6 +1450,28 @@ pointer args[];
 #endif /* IRIX */
 #endif /* IRIX6 */
 
+pointer catchfuncode(ctx,func,args,noarg)
+register context *ctx;
+register pointer func,args;
+register int noarg;
+{
+    // create a NULL catcher around each evaluation of compiled code
+    // this ensures that no continuations are allowed in the C lang level,
+    // even if the user locally overwrites the error handler
+    pointer tag,val;
+    jmp_buf catchbuf;
+    mkcatchframe(ctx,NULL,&catchbuf);
+    if ((val=(pointer)eussetjmp(catchbuf))==0) {
+        val=funcode(ctx,func,args,noarg);}
+    else if ((eusinteger_t)val==1) {
+        val=NIL;
+    }
+
+    ctx->vsp=(pointer *)ctx->catchfp;
+    ctx->catchfp=(struct catchframe *)*ctx->vsp;
+    return(val);
+}
+
 pointer funcode(ctx,func,args,noarg)
 register context *ctx;
 register pointer func,args;
@@ -1610,7 +1632,7 @@ int noarg;
 
   else if (piscode(func)) {	/*call subr*/
     GC_POINT;
-    result=funcode(ctx,func,args,noarg);
+    result=catchfuncode(ctx,func,args,noarg);
     ctx->vsp=(pointer *)vf;
     ctx->callfp= vf->vlink;
     ctx->fletfp=oldfletfp;

diff --git a/lisp/c/sysfunc.c b/lisp/c/sysfunc.c
@@ -752,8 +752,9 @@ pointer *argv;
   struct catchframe *cfp=ctx->catchfp;
   int i=0;
   while (cfp) {
-    vpush(cfp->label);
-    i++;
+    if (cfp->label) {
+      vpush(cfp->label);
+      i++;}
     cfp=cfp->nextcatch;}
   return(stacknlist(ctx,i));}