Printing error messages when child threads terminate by default.

This commit is contained in:
Alex Shinn 2012-09-17 15:03:48 +09:00
parent 4a59cc5a68
commit d56d6fd8c6
2 changed files with 15 additions and 2 deletions

6
sexp.c
View file

@ -579,9 +579,10 @@ sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) {
} }
sexp sexp_print_exception_op (sexp ctx, sexp self, sexp_sint_t n, sexp exn, sexp out) { sexp sexp_print_exception_op (sexp ctx, sexp self, sexp_sint_t n, sexp exn, sexp out) {
sexp ls; sexp_gc_var2(ls, tmp);
sexp_gc_preserve2(ctx, ls, tmp);
if (! sexp_oportp(out)) if (! sexp_oportp(out))
out = sexp_make_output_port(ctx, stderr, SEXP_FALSE); out = tmp = sexp_make_output_port(ctx, stderr, SEXP_FALSE);
sexp_write_string(ctx, "ERROR", out); sexp_write_string(ctx, "ERROR", out);
if (sexp_exceptionp(exn)) { if (sexp_exceptionp(exn)) {
if (sexp_exception_procedure(exn)) { if (sexp_exception_procedure(exn)) {
@ -643,6 +644,7 @@ sexp sexp_print_exception_op (sexp ctx, sexp self, sexp_sint_t n, sexp exn, sexp
sexp_write(ctx, exn, out); sexp_write(ctx, exn, out);
sexp_write_char(ctx, '\n', out); sexp_write_char(ctx, '\n', out);
} }
sexp_gc_release2(ctx);
return SEXP_VOID; return SEXP_VOID;
} }

11
vm.c
View file

@ -2104,6 +2104,17 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
_ARG1 = SEXP_VOID; _ARG1 = SEXP_VOID;
} else { } else {
/* don't return from child threads */ /* don't return from child threads */
if (sexp_exceptionp(_ARG1)) {
tmp1 = sexp_current_error_port(ctx);
sexp_write_string(ctx, "ERROR in child thread: ", tmp1);
sexp_write(ctx, ctx, tmp1);
sexp_newline(ctx, tmp1);
sexp_print_exception(ctx, _ARG1, tmp1);
}
#if SEXP_USE_DEBUG_THREADS
fprintf(stderr, "****** schedule: terminating %p (%s)\n",
ctx, sexp_thread_debug_name(ctx));
#endif
sexp_context_refuel(ctx) = fuel = 0; sexp_context_refuel(ctx) = fuel = 0;
goto loop; goto loop;
} }