Improvements to catch, return, signal, try

Improve the ability to rethrow errors
* Allow return to rethrow an error by accepting '-errorinfo stacktrace'
* Also, 'catch ... opts' now also stores opts(-errorinfo) on error
* Use these to provide better stack traces from 'case' and 'try'
* Implement 'return -level'
Make try/on/finally more Tcl 8.6 compatible
* With support for 'on' handlers and docs
Add support for catch options to try
* Otherwise it's hard to use try to catch signals
Improvements to signal handling
* catch -signal now sets a list of the handled signals as the result
* catch -signal won't execute the body at all if a handled signal is pending
* up to 64 (jim_wide) signals can now be handled
* if catch -signal is nested, the innermost catch will catch the error
* new 'signal catch' allows ignored/blocked signals to be examined and cleared.
* update docs on signal handling
exec should indicate which signal killed the child

Signed-off-by: Steve Bennett <steveb@workware.net.au>

12 files changed, 601 insertions, 200 deletions

diff --git a/doc/jim_tcl.txt b/doc/jim_tcl.txt
index 0508380..aef6083 100644
--- a/doc/jim_tcl.txt
+++ b/doc/jim_tcl.txt
@@ -985,7 +985,7 @@ argument specifiers:
 +*args*+::
     Variable Argument - The special name 'args', which is
     assigned all remaining arguments (including none). The
-	variable argument may only be specified once.
+    variable argument may only be specified once.
 
 Arguments must be provided in the following order, any of which
 may be omitted:
@@ -1483,25 +1483,35 @@ catch
 +*catch* '?-?no?code ...?' *?--?* 'command ?resultVarName? ?optionsVarName?'+
 
 The 'catch' command may be used to prevent errors from aborting
-command interpretation.  'Catch' evalues *command*, and
-returns a +JIM_OK+ code, regardless of any errors that might occur
-while executing *command* (with the possible exception of +JIM_SIGNAL+
-- see below).
-
-The return value from 'catch' is a decimal string giving the code returned
-by the Tcl interpreter after executing *command*.  This will be '0'
-(+JIM_OK+) if there were no errors in *command*; otherwise it will have
-a non-zero value corresponding to one of the exceptional return codes
-(see jim.h for the definitions of code values, or the 'info returncodes' command).
-
-If the *resultVarName* argument is given, then it gives the name of a variable;
-'catch' will set the value of the variable to the string returned from
-*command* (either a result or an error message).
-
-If the *optionsVarName* argument is given, then it gives the name of a variable;
-'catch' will set the value of the variable to a dictionary. For any return code other
-than +JIM_RETURN+, the value for the key +-code+ will be set to the return code. For +JIM_RETURN+
-it will be set to the code given in 'return -code'.
+command interpretation.  'Catch' evalues *command*, and returns a
++JIM_OK+ code, regardless of any errors that might occur while
+executing *command* (with the possible exception of +JIM_SIGNAL+ -
+see below).
+
+The return value from 'catch' is a decimal string giving the code
+returned by the Tcl interpreter after executing *command*.  This
+will be '0' (+JIM_OK+) if there were no errors in *command*; otherwise
+it will have a non-zero value corresponding to one of the exceptional
+return codes (see jim.h for the definitions of code values, or the
+'info returncodes' command).
+
+If the *resultVarName* argument is given, then it gives the name
+of a variable; 'catch' will set the value of the variable to the
+string returned from *command* (either a result or an error message).
+
+If the *optionsVarName* argument is given, then it gives the name
+of a variable; 'catch' will set the value of the variable to a
+dictionary. For any return code other than +JIM_RETURN+, the value
+for the key +-code+ will be set to the return code. For +JIM_RETURN+
+it will be set to the code given in 'return -code'. Additionally,
+for the return code +JIM_ERR+, the value of the key +-errorinfo+
+will contain the current stack trace (the same result as 'info
+stacktrace').  This can be useful to rethrow an error:
+
+    if {[catch {...} msg opts]} {
+        ...maybe do something with the error...
+        return {*}$opts $msg
+    }
 
 Normally 'catch' will *not* catch any of the codes +JIM_EXIT+, +JIM_EVAL+ or +JIM_SIGNAL+.
 The set of codes which will be caught may be modified by specifying the one more codes before
@@ -1683,7 +1693,7 @@ of the error:
     ...
     error $errMsg [info stacktrace]
 
-See also 'errorInfo' and 'info stacktrace'
+See also 'errorInfo', 'info stacktrace', 'catch' and 'return'
 
 errorInfo
 ~~~~~~~~~
@@ -1853,8 +1863,8 @@ abbreviation for *option* is acceptable.  The valid options are:
     error is generated.
 
 +*file copy ?-force?* 'source target'+::
-	Copies file *source* to file *target*. The source file must exist.
-	The target file must not exist, unless *-force* is specified.
+    Copies file *source* to file *target*. The source file must exist.
+    The target file must not exist, unless *-force* is specified.
 
 +*file delete* 'name'+::
     Deletes file *name*. If the file doesn't exist, nothing happens.
@@ -2285,8 +2295,8 @@ The legal *option*'s (which may be abbreviated) are:
 
 +*info returncodes* ?'code'?+::
     Returns a list representing the mapping of standard return codes
-	to names. e.g. +{0 ok 1 error 2 return ...}+. If a code is given,
-	instead returns the name for the given code.
+    to names. e.g. +{0 ok 1 error 2 return ...}+. If a code is given,
+    instead returns the name for the given code.
 
 +*info script*+::
     If a Tcl script file is currently being evaluated (i.e. there is a
@@ -2945,17 +2955,20 @@ returns an empty string as result.
 
 return
 ~~~~~~
-+*return* ?*-code* 'code'? ?'value'?+
++*return* ?*-code* 'code'? ?*-errorinfo* 'stacktrace'? ?'value'?+
 
 Return immediately from the current procedure (or top-level command
 or 'source' command), with *value* as the return value.  If *value*
 is not specified, an empty string will be returned as result.
 
-If *code* is specified (as either a number or ok, error, break,
+If *-code* is specified (as either a number or ok, error, break,
 continue, signal, return or exit), this code will be used instead
 of +JIM_OK+. This is generally useful when implementing flow of control
 commands.
 
+If *-errorinfo* is specified (as returned from 'info stacktrace')
+it is used to initialize the stacktrace.
+
 scan
 ~~~~
 +*scan* 'string format varName1 ?varName2 ...?'+
@@ -3045,7 +3058,6 @@ See GARBAGE COLLECTION, REFERENCES, LAMBDA for more detail.
 
 signal
 ~~~~~~
-
 Command for signal handling.
 
 See 'kill' for the different forms which may be used to specify signals.
@@ -3063,7 +3075,9 @@ Commands which return a list of signal names do so using the canonical form:
     If no signals are given, returns a lists all signals which are currently being
     ignored.
     If signals are specified, these are added to the list of signals currently
-    being ignored.
+    being ignored. These signals are still delivered, but are not considered by
+	'catch -signal' or 'try -signal'. Use 'signal check' to signals which have
+	occurred but been ignored.
 
 +*signal default* ?'signals ...'?+::
     If no signals are given, returns a lists all signals which are currently have
@@ -3071,12 +3085,47 @@ Commands which return a list of signal names do so using the canonical form:
     If signals are specified, these are added to the list of signals which have
     the default behaviour.
 
++*signal check ?-clear?* ?'signals ...'?+::
+    Returns a list of signals which have been delivered to the process
+	but are 'ignored'. If signals are specified, only that set of signals will
+	be checked, otherwise all signals will be checked.
+	If '-clear' is specified, any signals returned are removed and will not be
+	returned by subsequent calls to 'signal check' unless delivered again.
+
 +*signal throw* ?'signal'?+::
     Raises the given signal, which defaults to +SIGINT+ if not specified.
     The behaviour is identical to:
 
         kill signal [pid]
 
+Note that 'signal handle' and 'signal ignore' represent two forms of signal
+handling. 'signal handle' is used in conjunction with 'catch -signal' or 'try -signal'
+to immediately abort execution when the signal is delivered. Alternatively, 'signal ignore'
+is used in conjunction with 'signal check' to handle signal synchronously. Consider the
+two examples below.
+
+Prevent a processing from taking too long
+
+    signal handle SIGALRM
+	alarm 20
+	try -signal {
+		.. possibly long running process ..
+		alarm 0
+	} on signal {sig} {
+		puts stderr "Process took too long"
+	}
+
+Handle SIGHUP to reconfigure:
+
+	signal ignore SIGHUP
+    while {1} {
+		... handle configuration/reconfiguration ...
+		while {[signal check -clear SIGHUP] eq ""} {
+			... do processing ..
+		}
+		# Received SIGHUP, so reconfigure
+	}
+
 sleep
 ~~~~~
 +*sleep* 'seconds'+
@@ -3376,6 +3425,16 @@ Returns a decimal string giving the current access position in
 'open', or it may be 'stdin', 'stdout', or 'stderr' to refer to one
 of the standard I/O channels.
 
+throw
+~~~~~
++*throw* 'code ?msg?'+
+
+This command throws an exception (return) code along with an optional message.
+This command is mostly for convenient usage with 'try'.
+
+The command +throw break+ is equivalent to +break+.
+The command +throw 20 message+ can be caught with an +on 20 ...+ clause to 'try'.
+
 time
 ~~~~
 +*time* 'command ?count?'+
@@ -3393,27 +3452,52 @@ Time is measured in elapsed time, not CPU time.
 
 try
 ~~~
-+*try* 'script' *finally* 'finalscript'+
++*try* '?catchopts? tryscript' ?*on* 'returncodes {?resultvar? ?optsvar?} handlerscript ...'? ?*finally* 'finalscript'?+
 
 The 'try' command is provided as a convenience for exception handling.
-This interpeter evaluates *script* and then, regardless of any error
-generated, evaluates *finalscript*.
 
-The result of this command is the result of *script*, except in the
-case where *script* did not generate an error and *finalscript*
-did. In this case, the result is the result of *finalscript*.
+This interpeter first evaluates *tryscript* under the effect of the catch
+options *catchopts* (e.g. +-signal -noexit --+, see 'catch').
+
+It then evaluates the script for the first matching 'on' handler
+(there many be zero or more) based on the return code from the 'try'
+section. For example a normal +JIM_ERR+ error will be matched by
+an 'on error' handler.
+
+Finally, any *finalscript* is evaluated.
+
+The result of this command is the result of *tryscript*, except in the
+case where an exception occurs in a matching 'on' handler script or the 'finally' script,
+in which case the result is this new exception.
+
+The specified *returncodes* is a list of return codes either as names ('ok', 'error', 'break', etc.)
+or as integers.
+
+If *resultvar* and *optsvar* are specified, they are set as for 'catch' before evaluating
+the matching handler.
 
 For example:
 
-	set f [open input]
-    try {
-		process $f
-	} finally {
-		$f close
-	}
+    set f [open input]
+    try -signal {
+        process $f
+    } on {continue break} {} {
+        error "Unexpected break/continue"
+    } on error {msg opts} {
+        puts "Dealing with error"
+        return {*}$opts $msg
+    } on signal sig {
+        puts "Got signal: $sig"
+    } finally {
+        $f close
+    }
+
+If break, continue or error are raised, they are dealt with by the matching
+handler.
+
+In any case, the file will be closed via the 'finally' clause.
 
-Will close the file even if an error occurs during 'process'. The result will
-be the result of 'process'
+See also 'throw', 'catch', 'return', 'error'.
 
 unknown
 ~~~~~~~
diff --git a/jim-exec.c b/jim-exec.c
index c195286..f9d19a5 100644
--- a/jim-exec.c
+++ b/jim-exec.c
@@ -24,6 +24,7 @@
 
 #include "jim.h"
 #include "jim-subcmd.h"
+#include "jim-signal.h"
 
 /* These two could be moved into the Tcl core */
 static void Jim_SetResultErrno(Jim_Interp *interp, const char *msg)
@@ -947,7 +948,11 @@ Jim_CleanupChildren(Jim_Interp *interp, int numPids, int *pidPtr, int errorId)
                 /* Nothing */
             } else if (WIFSIGNALED(waitStatus)) {
                 /* REVISIT: Name the signal */
-                Jim_SetResultString(interp, "child killed by signal", -1);
+#ifdef jim_ext_signal
+                Jim_SetResultFormatted(interp, "child killed by signal %s", Jim_SignalId(WTERMSIG(waitStatus)));
+#else
+                Jim_SetResultFormatted(interp, "child killed by signal %d", WTERMSIG(waitStatus));
+#endif
             } else if (WIFSTOPPED(waitStatus)) {
                 Jim_SetResultString(interp, "child suspended", -1);
             }
diff --git a/jim-signal.c b/jim-signal.c
index e55134c..0760026 100644
--- a/jim-signal.c
+++ b/jim-signal.c
@@ -10,26 +10,30 @@
 
 #include "jim.h"
 #include "jim-subcmd.h"
+#include "jim-signal.h"
 
-#define MAX_SIGNALS 32
+#define MAX_SIGNALS (sizeof(jim_wide) * 8)
 
-static int *sigloc;
-static unsigned long sigsblocked; 
+static jim_wide *sigloc;
+static jim_wide sigsblocked; 
 static struct sigaction *sa_old;
 static int signal_handling[MAX_SIGNALS];
 
+/* Make sure to do this as a wide, not int */
+#define sig_to_bit(SIG) ((jim_wide)1 << (SIG))
+
 static void signal_handler(int sig)
 {
-    /* We just remember which signal occurred. Jim_Eval() will
+    /* We just remember which signals occurred. Jim_Eval() will
      * notice this as soon as it can and throw an error
      */
-    *sigloc = sig;
+    *sigloc |= sig_to_bit(sig);
 }
 
 static void signal_ignorer(int sig)
 {
     /* We just remember which signals occurred */
-    sigsblocked |= (1 << sig);
+    sigsblocked |= sig_to_bit(sig);
 }
 
 /*
@@ -227,11 +231,6 @@ static int do_signal_cmd(Jim_Interp *interp, int action, int argc, Jim_Obj *cons
         return JIM_OK;
     }
 
-    /* Make sure we know where to store the signals which occur */
-    if (!sigloc) {
-        sigloc = &interp->signal;
-    }
-
     /* Catch all the signals we care about */
     if (action != SIGNAL_ACTION_DEFAULT) {
         sa.sa_flags = 0;
@@ -295,6 +294,59 @@ static int signal_cmd_default(Jim_Interp *interp, int argc, Jim_Obj *const *argv
     return do_signal_cmd(interp, SIGNAL_ACTION_DEFAULT, argc, argv);
 }
 
+static int signal_set_sigmask_result(Jim_Interp *interp, jim_wide sigmask)
+{
+    int i;
+    Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
+    for (i = 0; i < MAX_SIGNALS; i++) {
+        if (sigmask & sig_to_bit(i)) {
+            Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, Jim_SignalId(i), -1));
+        }
+    }
+    Jim_SetResult(interp, listObj);
+    return JIM_OK;
+}
+
+static int signal_cmd_check(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+    int clear = 0;
+    jim_wide mask = 0;
+    jim_wide blocked; 
+    
+    if (argc > 0 && Jim_CompareStringImmediate(interp, argv[0], "-clear")) {
+        clear++;
+    }
+    if (argc > clear) {
+        int i;
+
+        /* Signals specified */
+        for (i = clear; i < argc; i++) {
+            int sig = find_signal_by_name(interp, Jim_GetString(argv[i], NULL));
+            if (sig < 0 || sig >= MAX_SIGNALS) {
+                return -1;
+            }
+            mask |= sig_to_bit(sig);
+        }
+    }
+    else {
+        /* No signals specified, so check/clear all */
+        mask = ~mask;
+    }
+
+    if ((sigsblocked & mask) == 0) {
+        /* No matching signals, so empty result and nothing to do */
+        return JIM_OK;
+    }
+    /* Be careful we don't have a race condition where signals are cleared but not returned */
+    blocked = sigsblocked & mask;
+    if (clear) {
+        sigsblocked &= ~blocked;
+    }
+    /* Set the result */
+    signal_set_sigmask_result(interp, blocked);
+    return JIM_OK;
+}
+
 static int signal_cmd_throw(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
     int sig = SIGINT;
@@ -304,13 +356,17 @@ static int signal_cmd_throw(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
         }
     }
 
+    /* If the signal is ignored (blocked) ... */
+    if (signal_handling[sig] == SIGNAL_ACTION_IGNORE) {
+        sigsblocked |= sig_to_bit(sig);
+        return JIM_OK;
+    }
+
     /* Just set the signal */
-    interp->signal = sig;
+    interp->sigmask |= sig_to_bit(sig);
 
-#if 1
     /* Set the canonical name of the signal as the result */
     Jim_SetResultString(interp, Jim_SignalId(sig), -1);
-#endif
 
     /* And simply say we caught the signal */
     return JIM_SIGNAL;
@@ -361,6 +417,13 @@ static const jim_subcmd_type signal_command_table[] = {
         .maxargs = -1,
         .description = "Lists defaulted signals, or adds to defaulted signals"
     },
+    {   .cmd = "check",
+        .args = "?-clear? ?signals ...?",
+        .function = signal_cmd_check,
+        .minargs = 0,
+        .maxargs = -1,
+        .description = "Returns ignored signals which have occurred, and optionally clearing them"
+    },
     {   .cmd = "throw",
         .args = "?signal?",
         .function = signal_cmd_throw,
@@ -479,8 +542,11 @@ int Jim_signalInit(Jim_Interp *interp)
     if (Jim_PackageProvide(interp, "signal", "1.0", JIM_ERRMSG) != JIM_OK) {
         return JIM_ERR;
     }
-    /* Teach the jim core how to convert signal values to names */
-    interp->signal_to_name = Jim_SignalId;
+    /* Teach the jim core how to set a result from a sigmask */
+    interp->signal_set_result = signal_set_sigmask_result;
+
+    /* Make sure we know where to store the signals which occur */
+    sigloc = &interp->sigmask;
 
     Jim_CreateCommand(interp, "signal", Jim_SubCmdProc, (void *)signal_command_table, NULL);
     Jim_CreateCommand(interp, "alarm", Jim_AlarmCmd, 0, 0);
diff --git a/jim-signal.h b/jim-signal.h
new file mode 100644
index 0000000..c5cdf9f
--- /dev/null
+++ b/jim-signal.h
@@ -0,0 +1,23 @@
+#ifndef JIM_SIGNAL_H
+#define JIM_SIGNAL_H
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SignalId --
+ *
+ *      Return a textual identifier for a signal number.
+ *
+ * Results:
+ *      This procedure returns a machine-readable textual identifier
+ *      that corresponds to sig.  The identifier is the same as the
+ *      #define name in signal.h.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+const char *Jim_SignalId(int sig);
+
+#endif
diff --git a/jim.c b/jim.c
index 6fb67e2..b4e4e5d 100644
--- a/jim.c
+++ b/jim.c
@@ -4387,6 +4387,7 @@ Jim_Interp *Jim_CreateInterp(void)
     i->numLevels = 0;
     i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
     i->returnCode = JIM_OK;
+    i->returnLevel = 0;
     i->exitCode = 0;
     i->procEpoch = 0;
     i->callFrameEpoch = 0;
@@ -4398,9 +4399,9 @@ Jim_Interp *Jim_CreateInterp(void)
     i->prngState = NULL;
     i->evalRetcodeLevel = -1;
     i->id = 0;
-    i->signal = 0;
+    i->sigmask = 0;
     i->signal_level = 0;
-    i->signal_to_name = NULL;
+    i->signal_set_result = NULL;
 
     /* Note that we can create objects only after the
      * interpreter liveList and freeList pointers are
@@ -4624,10 +4625,40 @@ static void JimResetStackTrace(Jim_Interp *interp)
     Jim_IncrRefCount(interp->stackTrace);
 }
 
+static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
+{
+    int len;
+
+    /* Increment reference first in case these are the same object */
+    Jim_IncrRefCount(stackTraceObj);
+    Jim_DecrRefCount(interp, interp->stackTrace);
+    interp->stackTrace = stackTraceObj;
+    interp->errorFlag = 1;
+
+    /* This is a bit ugly.
+     * If the filename of the last entry of the stack trace is empty,
+     * the next stack level should be added.
+     */
+    len = Jim_ListLength(interp, interp->stackTrace);
+    if (len >= 3) {
+        Jim_Obj *filenameObj;
+        Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj, JIM_NONE);
+
+        Jim_GetString(filenameObj, &len);
+
+        if (len == 0) {
+            interp->addStackTrace = 1;
+        }
+    }
+}
+
+/* Returns 1 if the stack trace information was used or 0 if not */
 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
         const char *filename, int linenr)
 {
-    /*printf("AppendStackTrace: %s:%d (%s)\n", filename, linenr, procname);*/
+#if 0
+    printf("JimAppendStackTrace: %s:%d (%s)\n", filename, linenr, procname);
+#endif
 
     /* XXX Omit "unknown" for now since it can be confusing (but it may help too!) */
     if (strcmp(procname, "unknown") == 0) {
@@ -8806,7 +8837,7 @@ void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
     }
 }
 
-static int JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filename, int line)
+static void JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filename, int line)
 {
     int rc = retcode;
 
@@ -8817,7 +8848,8 @@ static int JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filen
     if (retcode == JIM_RETURN) {
         rc = interp->returnCode;
     }
-
+#endif
+#if 0
     printf("JimAddErrorToStack: retcode=%s, %s:%d, ast=%d, errorFlag=%d\n",
         Jim_ReturnCode(retcode), filename, line, interp->addStackTrace, interp->errorFlag);
 #endif
@@ -8836,16 +8868,27 @@ static int JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filen
     /* Now if this is an "interesting" level, add it to the stack trace */
     if (rc == JIM_ERR && interp->addStackTrace > 0) {
         /* Add the stack info for the current level */
+
         JimAppendStackTrace(interp, Jim_GetString(interp->errorProc, NULL), filename, line);
 
+        /* Note: if we didn't have a filename for this level,
+         * don't clear the addStackTrace flag
+         * so we can pick it up at the next level
+         */
+        if (*filename) {
+            interp->addStackTrace = 0;
+        }
+
         Jim_DecrRefCount(interp, interp->errorProc);
         interp->errorProc = interp->emptyObj;
         Jim_IncrRefCount(interp->errorProc);
     }
-
-    interp->addStackTrace = 0;
-
-    return JIM_OK;
+    else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
+        /* Propagate the addStackTrace value through 'return -code error' */
+    }
+    else {
+        interp->addStackTrace = 0;
+    }
 }
 
 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
@@ -9041,7 +9084,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
             /* Call [unknown] */
             retcode = JimUnknown(interp, argc, argv);
         }
-        if (interp->signal_level && interp->signal) {
+        if (interp->signal_level && interp->sigmask) {
             /* Check for a signal after each command */
             retcode = JIM_SIGNAL;
         }
@@ -9232,8 +9275,11 @@ int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
     }
     /* Handle the JIM_RETURN return code */
     if (retcode == JIM_RETURN) {
-        retcode = interp->returnCode;
-        interp->returnCode = JIM_OK;
+        if (--interp->returnLevel <= 0) {
+            retcode = interp->returnCode;
+            interp->returnCode = JIM_OK;
+            interp->returnLevel = 0;
+        }
     }
     else if (retcode == JIM_ERR) {
         interp->addStackTrace++;
@@ -9359,8 +9405,11 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename)
 
     /* Handle the JIM_RETURN return code */
     if (retcode == JIM_RETURN) {
-        retcode = interp->returnCode;
-        interp->returnCode = JIM_OK;
+        if (--interp->returnLevel <= 0) {
+            retcode = interp->returnCode;
+            interp->returnCode = JIM_OK;
+            interp->returnLevel = 0;
+        }
     }
     if (retcode == JIM_ERR) {
         /* EvalFile changes context, so add a stack frame here */
@@ -11234,25 +11283,46 @@ static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, 
         Jim_Obj *const *argv)
 {
-    if (argc == 1) {
-        return JIM_RETURN;
-    } else if (argc == 2) {
-        Jim_SetResult(interp, argv[1]);
-        interp->returnCode = JIM_OK;
-        return JIM_RETURN;
-    } else if ((argc == 3 || argc == 4) && Jim_CompareStringImmediate(interp, argv[1], "-code")) {
-        int returnCode;
-        if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
-            return JIM_ERR;
-        interp->returnCode = returnCode;
-        if (argc == 4)
-            Jim_SetResult(interp, argv[3]);
-        return JIM_RETURN;
-    } else {
-        Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
-        return JIM_ERR;
+    int i;
+    Jim_Obj *stackTraceObj = NULL;
+    int returnCode = JIM_OK;
+    long level = 1;
+
+    for (i = 1; i < argc - 1; i += 2) {
+        if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
+            if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
+                return JIM_ERR;
+            }
+        }
+        else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
+            stackTraceObj = argv[i + 1];
+        }
+        else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
+            if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
+                Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
+                return JIM_ERR;
+            }
+        }
+        else {
+            break;
+        }
+    }
+
+    if (i != argc - 1 && i != argc) {
+        Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
+    }
+
+    /* If a stack trace is supplied and code is error, set the stack trace */
+    if (stackTraceObj && returnCode == JIM_ERR) {
+        JimSetStackTrace(interp, stackTraceObj);
     }
-    return JIM_RETURN; /* unreached */
+    interp->returnCode = returnCode;
+    interp->returnLevel = level;
+
+    if (i == argc - 1) {
+        Jim_SetResult(interp, argv[i]);
+    }
+    return JIM_RETURN;
 }
 
 /* [tailcall] */
@@ -11813,7 +11883,6 @@ static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
 
     argc -= i;
     if (argc < 1 || argc > 3) {
-        printf("argc=%d\n", argc);
 wrongargs:
         Jim_WrongNumArgs(interp, 1, argv, "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
         return JIM_ERR;
@@ -11825,7 +11894,13 @@ wrongargs:
     }
 
     interp->signal_level += sig;
-    exitCode = Jim_EvalObj(interp, argv[0]);
+    if (interp->signal_level && interp->sigmask) {
+        /* If a signal is set, don't even try to execute the body */
+        exitCode = JIM_SIGNAL;
+    }
+    else {
+        exitCode = Jim_EvalObj(interp, argv[0]);
+    }
     interp->signal_level -= sig;
 
     /* Catch or pass through? Only the first 64 codes can be passed through */
@@ -11834,15 +11909,15 @@ wrongargs:
         return exitCode;
     }
 
-    if (sig && exitCode == JIM_SIGNAL && interp->signal_level == 0) {
-        /* Yes, catch the signal at this level */
-        if (interp->signal_to_name) {
-            Jim_SetResultString(interp, interp->signal_to_name(interp->signal), -1);
+    if (sig && exitCode == JIM_SIGNAL) {
+        /* Catch the signal at this level */
+        if (interp->signal_set_result) {
+            interp->signal_set_result(interp, interp->sigmask);
         }
         else {
-            Jim_SetResultInt(interp, interp->signal);
+            Jim_SetResultInt(interp, interp->sigmask);
         }
-        interp->signal = 0;
+        interp->sigmask = 0;
     }
 
     if (argc >= 2) {
@@ -11854,7 +11929,12 @@ wrongargs:
             Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
             Jim_ListAppendElement(interp, optListObj,
                 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
-
+            Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
+            Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
+            if (exitCode == JIM_ERR) {
+                Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo", -1));
+                Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
+            }
             if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
                 return JIM_ERR;
             }
@@ -12469,11 +12549,7 @@ static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
     }
     Jim_SetResult(interp, argv[1]);
     if (argc == 3) {
-        /* Increment reference first in case these are the same object */
-        Jim_IncrRefCount(argv[2]);
-        Jim_DecrRefCount(interp, interp->stackTrace);
-        interp->stackTrace = argv[2];
-        interp->errorFlag = 1;
+        JimSetStackTrace(interp, argv[2]);
         return JIM_ERR;
     }
     interp->addStackTrace++;
diff --git a/jim.h.in b/jim.h.in
index 81c9f70..e578c07 100644
--- a/jim.h.in
+++ b/jim.h.in
@@ -494,11 +494,12 @@ typedef struct Jim_Interp {
     int numLevels; /* Number of current nested calls. */
     int maxNestingDepth; /* Used for infinite loop detection. */
     int returnCode; /* Completion code to return on JIM_RETURN. */
+    int returnLevel; /* Current level of 'return -level' */
     int exitCode; /* Code to return to the OS on JIM_EXIT. */
-    int signal; /* A caught signal, or 0 if none */
-    int signal_level; /* A nesting level of catch -signal */
     long id; /* Hold unique id for various purposes */
-    const char *(*signal_to_name)(int sig); /* Returns a name for the signal number */
+    int signal_level; /* A nesting level of catch -signal */
+    jim_wide sigmask;  /* Bit mask of caught signals, or 0 if none */
+    int (*signal_set_result)(struct Jim_Interp *interp, jim_wide sigmask); /* Set a result for the sigmask */
     Jim_CallFrame *framePtr; /* Pointer to the current call frame */
     Jim_CallFrame *topFramePtr; /* toplevel/global frame pointer. */
     struct Jim_HashTable commands; /* Commands hash table */
diff --git a/tclcompat.tcl b/tclcompat.tcl
index a1bc043..b631ae0 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -50,14 +50,10 @@ proc case {var args} {
 
 	if {[info exists do_action]} {
 		set rc [catch [list uplevel 1 $do_action] result opts]
-		set rcname [info returncode $rc]
-		if {$rcname in {break continue}} {
-			return -code error "invoked \"$rcname\" outside of a loop"
-		} elseif {$rcname eq "return" && $opts(-code)} {
-			# 'return -code' in the action
-			set rc $opts(-code)
+		if {$rc} {
+			incr opts(-level)
 		}
-		return -code $rc $result
+		return {*}$opts $result
 	}
 }
 
@@ -120,40 +116,102 @@ proc {info nameofexecutable} {} {
 
 # Implements 'file copy' - single file mode only
 proc {file copy} {{force {}} source target} {
-	set rc [catch {
+	try {
 		if {$force ni {{} -force}} {
 			error "bad option \"$force\": should be -force"
 		}
+
 		set in [open $source]
 
-		try {
-			if {$force eq "" && [file exists $target]} {
-				$in close
-				error "error copying \"$source\" to \"$target\": file already exists"
-			}
-			set out [open $target w]
-			bio copy $in $out
-			$out close
-		} finally {
-			catch {$in close}
+		if {$force eq "" && [file exists $target]} {
+			$in close
+			error "error copying \"$source\" to \"$target\": file already exists"
 		}
-	} result]
-
-	return -code $rc $result
+		set out [open $target w]
+		bio copy $in $out
+		$out close
+	} on error {msg opts} {
+		incr opts(-level)
+		return {*}$opts $msg
+	} finally {
+		catch {$in close}
+	}
 }
 
-# Poor mans try/catch/finally
-# Note that in this version 'finally' is required
-proc try {script finally finalscript} {
-	if {$finally ne "finally"} {
-		return -code error {mis-spelt "finally" keyword}
+# try/on/finally conceptually similar to Tcl 8.6
+#
+# Usage: try ?catchopts? script ?onclause ...? ?finallyclause?
+#
+# Where:
+#   onclause is:       on codes {?resultvar? ?optsvar?} script
+#
+#   codes is: a list of return codes (ok, error, etc. or integers), or * for any
+#
+#   finallyclause is:  finally script
+#
+#
+# Where onclause is: on codes {?resultvar? ?optsvar?}
+proc try {args} {
+	set catchopts {}
+	while {[string match -* [lindex $args 0]]} {
+		set args [lassign $args opt]
+		if {$opt eq "--"} {
+			break
+		}
+		lappend catchopts $opt
 	}
-	set bodycode [catch [list uplevel 1 $script] bodymsg]
-	set finalcode [catch [list uplevel 1 $finalscript] finalmsg]
-	if {$bodycode || !$finalcode} {
-		return -code $bodycode $bodymsg
+	if {[llength $args] == 0} {
+		return -code error {wrong # args: should be "try ?options? script ?argument ...?"}
+	}
+	set args [lassign $args script]
+	set code [catch {*}$catchopts [list uplevel 1 $script] msg opts]
+
+	set handled 0
+
+	foreach {on codes vars script} $args {
+		switch -- $on \
+			on {
+				if {!$handled && ($codes eq "*" || [info returncode $code] in $codes)} {
+					lassign $vars msgvar optsvar
+					if {$msgvar ne ""} {
+						upvar $msgvar hmsg
+						set hmsg $msg
+					}
+					if {$optsvar ne ""} {
+						upvar $optsvar hopts
+						set hopts $opts
+					}
+					# Override any body result
+					set code [catch [list uplevel 1 $script] msg opts]
+					incr handled
+				}
+			} \
+			finally {
+				set finalcode [catch [list uplevel 1 $codes] finalmsg finalopts]
+				if {$finalcode} {
+					# Override any body or handler result
+					set code $finalcode
+					set msg $finalmsg
+					set opts $finalopts
+				}
+				break
+			} \
+			default {
+				return -code error "try: expected 'on' or 'finally', got '$on'"
+			}
 	}
-	return -code $finalcode $finalmsg
+
+	if {$code} {
+		incr opts(-level)
+		return {*}$opts $msg
+	}
+	return $msg
+}
+
+# Generates an exception with the given code (ok, error, etc. or an integer)
+# and the given message
+proc throw {code {msg ""}} {
+	return -code $code $msg
 }
 
 
diff --git a/tests/case.test b/tests/case.test
index a74f265..4a594ad 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -1,56 +1,12 @@
 source testing.tcl
 
-# Test that control structures can be implemented in a proc
-
-proc control {cond code} {
-	set iscond [uplevel 1 expr $cond]
-	#puts "$cond -> $iscond"
-	if {$iscond} {
-		set rc [catch [list uplevel 1 $code] error opts]
-		#puts "$code -> rc=$rc, error=$error, opts=$opts"
-		if {$rc == 2 && $opts(-code) != 0} {
-			set rc $opts(-code)
-		}
-		return -code $rc $error
-	}
-}
-
-test control-1.1 "False case" {
-	control 0 bogus
-} {}
-
-test control-1.2 "Simple case" {
-	control 1 {return result}
-} {result}
-
-test control-1.3 "Break from proc" {
-	set result {}
-	foreach i {1 2 3 4 5} {
-		control {$i == 4} {break}
-		lappend result $i
-	}
-	set result
-} {1 2 3}
-
-test control-1.4 "Return from proc" {
-	foreach i {1 2 3 4 5} {
-		control {$i == 3} {return $i}
-	}
-} {3}
-
-test control-1.5 "Continue from proc" {
-	set result {}
-	foreach i {1 2 3 4 5} {
-		control {$i == 2} {continue}
-		lappend result $i
-	}
-	set result
-} {1 3 4 5}
-
 # case is a proc, but it should be able
 # to cause a return in do_case
 proc do_case {var} {
 	case $var in {
+		0 {
+			return
+		}
 		1 {
 			return one
 		}
@@ -61,23 +17,45 @@ proc do_case {var} {
 			return -code continue three
 		}
 		4 {
-			return 44
+			return -code break four
 		}
 		5 {
-			return -code break five
+			continue
 		}
 		6 {
-			return eight
+			break
 		}
 	}
 	return zero
 }
 
-test control-2.1 "Return from case" {
-	set result {}
-	foreach i {0 1 2 3 4 5 6} {
-		lappend result [do_case $i]
-	}
-	set result
-} {zero one two 44}
+test case-2.0 "Plain from case" {
+	do_case 0
+} {}
+
+test case-2.1 "Return from case with value" {
+	do_case 1
+} {one}
 
+test case-2.2 "Return -code ok from case" {
+	do_case 2
+	list [catch {do_case 2} msg] $msg
+} {0 two}
+
+test case-2.3 "Return -code continue from case" {
+	list [catch {do_case 3} msg] $msg
+} {4 three}
+
+test case-2.4 "Return -code break from case" {
+	list [catch {do_case 4} msg] $msg
+} {3 four}
+
+if {0} {
+test case-2.5 "continue from case" {
+	list [catch {do_case 5} msg] $msg
+} {1 {invoked "continue" outside of a loop}}
+
+test case-2.6 "break from case" {
+	list [catch {do_case 6} msg] $msg
+} {1 {invoked "break" outside of a loop}}
+}
diff --git a/tests/misc.test b/tests/misc.test
index 6bd9477..cbaaa5a 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -296,4 +296,37 @@ test catch-1.7 "catch exit" {
 	dict get [info returncodes] [catch -exit {exit 5} result]
 } {exit}
 
+test catch-1.8 "catch error has -errorinfo" {
+	set rc [catch {set undefined} msg opts]
+	list $rc [info exists opts(-errorinfo)]
+} {1 1}
+
+test catch-1.9 "catch no error has no -errorinfo" {
+	set rc [catch {set x 1} msg opts]
+	list $rc [info exists opts(-errorinfo)]
+} {0 0}
+
+test return-1.1 "return can rethrow an error" {
+	proc a {} { error "from a" }
+	proc b {} { catch {a} msg opts; return {*}$opts $msg }
+	set rc [catch {b} msg opts]
+	list $rc $msg [llength $opts(-errorinfo)]
+} {1 {from a} 6}
+
+test return-1.2 "error can rethrow an error" {
+	proc a {} { error "from a" }
+	proc b {} { catch {a} msg; error $msg [info stacktrace] }
+	set rc [catch {b} msg opts]
+	list $rc $msg [llength $opts(-errorinfo)]
+} {1 {from a} 9}
+
+test return-1.3 "return can rethrow no error" {
+	proc a {} { return "from a" }
+	proc b {} { catch {a} msg opts; return {*}$opts $msg }
+	set rc [catch {b} msg opts]
+	#list $rc $msg [llength $opts(-errorinfo)]
+	list $rc $msg [info exists opts(-errorinfo)]
+} {0 {from a} 0}
+
+
 testreport
diff --git a/tests/return.test b/tests/return.test
index 3ed659a..6fcef8c 100644
--- a/tests/return.test
+++ b/tests/return.test
@@ -11,6 +11,38 @@ test return-1.2 {source file with break} {
 	list [catch {source break.tcl} msg] $msg
 } {3 {}}
 
-test return-1.2 {source file with break} {
+test return-1.3 {source file with break} {
 	list [catch {source return-break.tcl} msg] $msg
 } {3 result}
+
+proc a {level code msg} {
+	return -level $level -code $code $msg
+}
+
+proc b {level code msg} {
+	a $level $code $msg
+}
+
+test return-2.1 {return -level 0} {
+	list [catch {a 0 20 text} msg] $msg
+} {20 text}
+
+test return-2.2 {return -level 1} {
+	list [catch {a 1 20 text} msg] $msg
+} {20 text}
+
+test return-2.3 {return -level 2} {
+	list [catch {a 2 20 text} msg] $msg
+} {2 text}
+
+test return-2.4 {return -level 0} {
+	list [catch {b 0 20 text} msg] $msg
+} {20 text}
+
+test return-2.5 {return -level 1} {
+	list [catch {b 1 20 text} msg] $msg
+} {20 text}
+
+test return-2.6 {return -level 2} {
+	list [catch {b 2 20 text} msg] $msg
+} {20 text}
diff --git a/tests/stacktrace.test b/tests/stacktrace.test
index 5a1ce0a..91dccbe 100644
--- a/tests/stacktrace.test
+++ b/tests/stacktrace.test
@@ -15,7 +15,7 @@ proc main {} {
 			}
 			test err-$id1.$id2 "Stacktrace on error type $type, method $method" {
 				set rc [catch {error_caller $type $method} msg]
-				#puts stderr "err-$id1.$id2 $type, $method\n[errorInfo $msg]\n"
+				#puts "\n-----------------\n$type, $method\n[errorInfo $msg]\n\n"
 				if {$::SHOW_EXPECTED} { puts stderr "\terr-$id1.$id2 {[list $rc $msg [info stacktrace]]}" }
 
 				list $rc $msg [info stacktrace]
diff --git a/tests/try.test b/tests/try.test
index 3cc86fb..7435763 100644
--- a/tests/try.test
+++ b/tests/try.test
@@ -40,7 +40,7 @@ test try-1.4 "Error in both" {
 			error finally
 		}
 	} msg] $msg $x
-} {1 message 1}
+} {1 finally 1}
 
 test try-1.5 "break in body" {
 	list [catch {
@@ -63,3 +63,48 @@ test try-1.6 "break in finally" {
 		}
 	} msg] $msg $x
 } {3 {} 1}
+
+test try-1.7 "return value from try, not finally" {
+	list [catch {
+		try {
+			set x 0
+		} finally {
+			incr x
+		}
+	} msg] $msg $x
+} {0 0 1}
+
+test try-1.8 "return from within try" {
+	proc a {} {
+		try {
+			return 1
+		}
+		# notreached
+		return 2
+	}
+	a
+} {1}
+
+test try-1.9 "return -code from within try" {
+	proc a {} {
+		try {
+			return -code break text
+		}
+		# notreached
+		return 2
+	}
+	list [catch a msg] $msg
+} {3 text}
+
+proc c {} {
+	try {
+		error here
+	} on error {msg opts} {
+		incr opts(-level)
+		return {*}$opts $msg
+	}
+}
+
+test try-3.1 "rethrow error in try/on handler" {
+	list [catch c msg] $msg
+} {1 here}