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, 11 insertions, 0 deletions

diff --git a/unwind.h b/unwind.h
index 074b79fe..0dfeea17 100644
--- a/unwind.h
+++ b/unwind.h
@@ -61,6 +61,7 @@ struct uw_catch {
   int visible;
   val sym;
   val args;
+  val desc;
   uw_frame_t *cont;
   extended_jmp_buf jb;
 };
@@ -203,6 +204,16 @@ noreturn val type_mismatch(val, ...);
     switch (extended_setjmp(uw_catch.ca.jb)) {  \
     case 0:
 
+#define uw_catch_begin_w_desc(MATCHES, SYMVAR,  \
+                              EXCVAR, DESC)     \
+  do {                                          \
+    obj_t *SYMVAR = nil;                        \
+    obj_t *EXCVAR = nil;                        \
+    uw_frame_t uw_catch;                        \
+    uw_push_catch(&uw_catch, MATCHES);          \
+    uw_catch.ca.desc = (DESC);                  \
+    switch (extended_setjmp(uw_catch.ca.jb)) {  \
+    case 0:
 #define uw_catch(SYMVAR, EXCVAR)        \
     goto uw_unwind_label;               \
       break;                            \