Display additional stack trace for r7rs#import error v2

src/error.c

@@ -1128,6 +1128,25 @@ void Scm_DumpStackTrace(ScmVM *vm, ScmPort *port)
     SCM_PUTZ("Stack Trace:\n", -1, port);
     SCM_PUTZ("_______________________________________\n", -1, port);
     Scm_ShowStackTrace(port, stack, 0, 0, 0, 0);
+
+    /* display additional stack trace */
+    if (vm->errorCont) {
+        ScmContFrame *vmcont = vm->cont;
+        ScmCompiledCode *vmbase = vm->base;
+        vm->cont = vm->errorCont;
+        vm->base = NULL;
+        ScmObj stack2 = Scm_VMGetStackLite(vm);
+        if (!Scm_EqualP(stack, stack2)) {
+            SCM_PUTZ("Stack Trace on Error:\n", -1, port);
+            SCM_PUTZ("_______________________________________\n", -1, port);
+            Scm_ShowStackTrace(port, stack2, 0, 0, 0, 0);
+        }
+        vm->cont = vmcont;
+        vm->base = vmbase;
+        /* reset information for additional stack trace */
+        vm->errorCont = NULL;
+    }
+
     if (SCM_PAIRP(calls)) {
         SCM_PUTZ("Call Trace:\n", -1, port);
         SCM_PUTZ("_______________________________________\n", -1, port);

src/gauche/vm.h

@@ -580,6 +580,10 @@ struct ScmVMRec {
                                    appears in 'reset' and the end marker of
                                    partial continuation is set. */
 
+    /* for additional stack trace */
+    ScmContFrame *errorCont;    /* continuation saved on error.
+                                   this is used to display stack trace
+                                   that is dropped during import. */
 };
 
 SCM_EXTERN ScmVM *Scm_NewVM(ScmVM *proto, ScmObj name);

src/vm.c

@@ -345,6 +345,8 @@ ScmVM *Scm_NewVM(ScmVM *proto, ScmObj name)
     v->currentPrompt = NULL;
     v->resetChain = SCM_NIL;
 
+    v->errorCont = NULL;
+
     Scm_RegisterFinalizer(SCM_OBJ(v), vm_finalize, NULL);
     return v;
 }
@@ -452,6 +454,9 @@ ScmVM *Scm_VMTakeSnapshot(ScmVM *master)
 
     v->currentPrompt = master->currentPrompt;
     v->resetChain = master->resetChain;
+
+    v->errorCont = master->errorCont;
+
     /* NB: We don't register the finalizer vm_finalize to the snapshot,
        for we do not want the associated system resources to be cleaned
        up when the snapshot is GCed. */
@@ -2288,8 +2293,17 @@ struct eval_packet_rec {
 static ScmObj safe_eval_handler(ScmObj *args,
                                 int nargs, void *data)
 {
+    ScmVM *vm = theVM;
+
     SCM_ASSERT(nargs == 1);
     ((struct eval_packet_rec *)data)->exception = args[0];
+
+    /* save information for additional stack trace */
+    if (vm->errorCont == NULL) {
+        save_cont(vm);
+        vm->errorCont = vm->cont;
+    }
+
     return SCM_UNDEFINED;
 }
 
@@ -2342,6 +2356,9 @@ static int safe_eval_wrap(int kind, ScmObj arg0, ScmObj args,
     epak.cstr = cstr;
     epak.exception = SCM_UNBOUND;
 
+    /* reset information for additional stack trace */
+    vm->errorCont = NULL;
+
     ScmObj proc = Scm_MakeSubr(safe_eval_int, &epak, 0, 0, SCM_FALSE);
     ScmObj r = Scm_ApplyRec(proc, SCM_NIL);