feature/soc-bytecode-in-traceback e5734be: Experiment giving bytecode in traceback...

[Rocky Bernstein]

branch: feature/soc-bytecode-in-traceback
commit e5734bef9074fa8b1c80c35aa9bf528e31d966a4
Author: rocky <address@hidden>
Commit: rocky <address@hidden>

    Experiment giving bytecode in traceback...
    
    This commit only changes the behavior when `(cdr)` when it is not
    given a `cons` node, in order to give some quick idea of how adding
    more traceback information might work.
    
    Here's how to see/use. Build this code.
    
    Byte-compile this buggy function in `/tmp/foo.el`
    with (byte-compile-file)
    ```lisp
    (defun foo()
      (setq x 5)
      (cdr 'b)
      )
    ```
    
    ```
    (load-file "/tmp/foo.elc")
    (foo)
    ```
    
    You should see:
    
    ```
    Debugger entered--Lisp error: (wrong-type-argument listp b 3)
                                            this is the offset ^
      foo()
      eval((foo) nil)
      elisp--eval-last-sexp(nil)
      eval-last-sexp(nil)
      funcall-interactively(eval-last-sexp nil)
      call-interactively(eval-last-sexp nil nil)
      command-execute(eval-last-sexp)
    ```
    
    Compare against disassembly:
    
    ```
    byte code for foo:
      args: nil
    0   constant  5
    1   varset    x
    2   constant  b
    3   cdr
    ^^^ offset from above
    4   return
    ```
    
    You can try with other offsets such as by removing the `(setq x 5)`
    and you'll see offset 1 instead.
    
    Right now, we just pass to `signal` bytecode offset. More elaborate would be
    to pass the code object and its offset. Even more elaborate schemes
    could be imagined.
---
 src/bytecode.c | 8 +++++---
 src/data.c     | 8 ++++++++
 src/eval.c     | 6 ++++++
 src/lisp.h     | 5 +++++
 4 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/src/bytecode.c b/src/bytecode.c
index 3c90544..8ef8468 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -286,12 +286,13 @@ enum byte_code_op
 
 /* Fetch the next byte from the bytecode stream.  */
 
-#define FETCH (*pc++)
+#define FETCH (last_pc = pc, *pc++)
+#define FETCH_NORECORD (*pc++)
 
 /* Fetch two bytes from the bytecode stream and make a 16-bit number
    out of them.  */
 
-#define FETCH2 (op = FETCH, op + (FETCH << 8))
+#define FETCH2 (op = FETCH, op + (FETCH_NORECORD << 8))
 
 /* Push X onto the execution stack.  The expression X should not
    contain TOP, to avoid competing side effects.  */
@@ -375,6 +376,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
   bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length);
   memcpy (bytestr_data, SDATA (bytestr), bytestr_length);
   unsigned char const *pc = bytestr_data;
+  unsigned char const *last_pc = pc;
   ptrdiff_t count = SPECPDL_INDEX ();
 
   if (!NILP (args_template))
@@ -535,7 +537,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
            if (CONSP (TOP))
              TOP = XCDR (TOP);
            else if (!NILP (TOP))
-             wrong_type_argument (Qlistp, TOP);
+             wrong_type_argument_new (Qlistp, TOP, last_pc - bytestr_data);
            NEXT;
          }
 
diff --git a/src/data.c b/src/data.c
index bce2e53..0ebdd67 100644
--- a/src/data.c
+++ b/src/data.c
@@ -149,6 +149,14 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object 
value)
   xsignal2 (Qwrong_type_argument, predicate, value);
 }
 
+AVOID
+wrong_type_argument_new (Lisp_Object predicate, Lisp_Object value,
+                        int bytecode_offset)
+{
+  eassert (!TAGGEDP (value, Lisp_Type_Unused0));
+  xsignal2_new (Qwrong_type_argument, predicate, value, bytecode_offset);
+}
+
 void
 pure_write_error (Lisp_Object obj)
 {
diff --git a/src/eval.c b/src/eval.c
index 014905c..4251c3e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1714,6 +1714,12 @@ xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, 
Lisp_Object arg2)
 }
 
 void
+xsignal2_new (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, 
int bytecode_offset)
+{
+  xsignal (error_symbol, list3 (arg1, arg2, make_fixnum(bytecode_offset)));
+}
+
+void
 xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, 
Lisp_Object arg3)
 {
   xsignal (error_symbol, list3 (arg1, arg2, arg3));
diff --git a/src/lisp.h b/src/lisp.h
index b4ac017..c9b069b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -603,6 +603,7 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object);
 /* Defined in data.c.  */
 extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
+extern AVOID wrong_type_argument_new (Lisp_Object, Lisp_Object, int 
bytecode_offset);
 extern Lisp_Object default_value (Lisp_Object symbol);
 
 
@@ -3284,6 +3285,9 @@ struct handler
   enum nonlocal_exit nonlocal_exit;
   Lisp_Object val;
 
+  /* The bytecode offset where the error occurred. */
+  int bytecode_offset;
+
   struct handler *next;
   struct handler *nextfree;
 
@@ -4107,6 +4111,7 @@ xsignal (Lisp_Object error_symbol, Lisp_Object data)
 extern AVOID xsignal0 (Lisp_Object);
 extern AVOID xsignal1 (Lisp_Object, Lisp_Object);
 extern AVOID xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
+extern AVOID xsignal2_new (Lisp_Object, Lisp_Object, Lisp_Object, int 
bytecode_offset);
 extern AVOID xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
 extern AVOID signal_error (const char *, Lisp_Object);
 extern AVOID overflow_error (void);