exceptions: allow description field in catch frames.

* eval.c (op_catch): Extra argument in sys:catch syntax
specifies an expression that evaluates to a description
field.
(expand_catch): Expand the desc expression in sys:catch
syntax.

* parser.c (read_file_common): Increase acceptance of compiled
files from versions 1-4 to 1-5, since we are now marking
compiled files with version 5.0 rather than 4.0.

* share/txr/stdlib/asm.tl (op-catch catch): Support new
argument in the opcode syntax. Turns out we have a spare field
in the instruction format which was previously set to zero
We can use that for the description. Thus, the instruction
set and VM remain backward compatible: old code works.

* share/txr/stdlib/compiler.tl (compiler comp-catch): Handle
the desc argument introduced into the sys:catch form.
We must compile it as an expression, then inject the code into
the instruction template, and reference the output register of
that code block in the catch instruction.
(%tlo-ver%): Bump up the compiled file version to 5.0.

* share/txr/stdlib/except.tl (usr:catch, catch*): Add desc
argument to generated sys:catch form, specifying it as nil.

* unwind.c (desc_s): New symbol variable.
(uw_find_frames_impl): Set the desc member of the extracted
catch structure from the corresponding field in the catch
frame.
(uw_late_init): Initialize desc_s with interned symbol.
Add desc slot to catch-frame type.

* unwind.h (struct uw_catch): New member, desc.
(uw_catch_begin_w_desc): New macro.

* vm.c (vm_catch): Extract the desc field from the catch
instruction, and use uw_catch_begin_w_desc to propagate that
to the catch frame.

1 files changed, 12 insertions, 6 deletions

diff --git a/eval.c b/eval.c
index b9db0d8e..f57b084f 100644
--- a/eval.c
+++ b/eval.c
@@ -2595,17 +2595,19 @@ static val op_dwim(val form, val env)
 
 static val op_catch(val form, val env)
 {
-  val catch_syms = second(form);
-  val try_form = third(form);
+  val args = cdr(form);
+  val catch_syms = pop(&args);
+  val try_form = pop(&args);
+  val desc = pop(&args);
+  val catches = args;
   val result = nil;
 
-  uw_catch_begin (catch_syms, exsym, exvals);
+  uw_catch_begin_w_desc (catch_syms, exsym, exvals, desc);
 
   result = eval(try_form, env, try_form);
 
   uw_catch(exsym, exvals) {
     args_decl(args, ARGS_MIN);
-    val catches = rest(rest(rest(form)));
     val iter;
 
     args_add(args, exsym);
@@ -4437,19 +4439,23 @@ static val expand_catch(val form, val menv)
   val sym = pop(&args);
   val catch_syms = pop(&args);
   val try_form = pop(&args);
+  val desc = pop(&args);
   val catch_clauses = args;
   val try_form_ex = expand(try_form, menv);
+  val desc_ex = expand(desc, menv);
   val catch_clauses_ex = rlcp(mapcar(curry_12_1(func_n2(expand_catch_clause),
                                                 menv),
                                      catch_clauses),
                               catch_clauses);
 
-  if (try_form_ex == try_form && catch_clauses_ex == catch_clauses)
+  if (try_form_ex == try_form && desc_ex == desc &&
+      catch_clauses_ex == catch_clauses)
     return form;
 
   return rlcp(cons(sym,
                    cons(catch_syms,
-                        cons(try_form_ex, catch_clauses_ex))), form);
+                        cons(try_form_ex,
+                             cons(desc_ex, catch_clauses_ex)))), form);
 }
 
 static val expand_list_of_form_lists(val lofl, val menv, val ss_hash)