bug#66912: With `require', the byte compiler reports the wrong file for errors.

[Alan Mackenzie]

Hello again, Stefan.

[ I've just got your latest post, answering my last one.  Thanks!  But
I'm sending you this post anyway, which I'd almost finished. ]

Progress!

On Mon, Nov 04, 2024 at 12:52:10 +0000, Alan Mackenzie wrote:
> On Sun, Nov 03, 2024 at 21:46:42 -0500, Stefan Monnier wrote:
> > Hi Alan,

[ .... ]

> > I don't understand the above code: `handler-bind` is not supposed to
> > call setjmp/longjmp: when the handler of a `handler-bind` gets
> > called, the stack is not unwound.

[ .... ]

> Given HANDLER_BIND doesn't need the setjmp/longjmp mechanism, it would
> seem there's no sense in combining the HANDLER_BIND and CONDITION_CASE
> cases in internal_cc_hb and friends.  I should just restore the
> condition-case functions to what they were, and add separate new ones
> for handler-bind.

I've now done this.  Possibly the new function
internal_condition_case_1_voidstar is superfluous and should be deleted.
Also, not all of the internal_handler_bind* functions are currently
used.

[ .... ]

> > > +         else
> > > +           call1 (h->val, error);
> > > +         unbind_to (count, Qnil); /* Removes SKIP_CONDITIONS handler.  */
> > > +         pop_handler ();          /* Discards HANDLER_BIND handler.  */

> > These comments don't match my understanding of the code: IIRC the
> > `pop_handler` pops the `SKIP_CONDITIONS` handler.

> I think I see now you're right.  push_handler doesn't push an entry onto
> the binding stack.  I'll amend these comments as soon as I understand
> the code.  I think these lines definitely need comments.

> > Also there's no reason to presume the HANDLER_BIND handler is at the
> > top, so if we wanted to remove it, we'd have to work harder.

> This code is difficult to understand.  What is the purpose of the
> binding block around the call of the handler function?  I think a
> comment here would help.

I've worked this out.  The binding block is to restore the size of the
stack via the unwind_protect set up in the call to max_ensure_room.
I've added a comment to say that.

[ .... ]

I've also amended the doc string of Fhandler_bind_1, saying that the
return value from a handler gets ignored, and clarifying that a normal
return from a handler means the error hasn't been handled.  If you agree
with this, I will make a corresponding amendment to the macro
handler-bind.

Here is the revised part of the patch, just for eval.c:



diff --git a/src/eval.c b/src/eval.c
index d0a2abf0089..79cf9115379 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -256,7 +256,7 @@ restore_stack_limits (Lisp_Object data)
   max_lisp_eval_depth = old_depth;
 }
 
-/* Try and ensure that we have at least B dpeth available.  */
+/* Try and ensure that we have at least B depth available.  */
 
 static void
 max_ensure_room (intmax_t b)
@@ -1450,9 +1450,9 @@ DEFUN ("handler-bind-1", Fhandler_bind_1, 
Shandler_bind_1, 1, MANY, 0,
 error matches one of CONDITIONS, then the associated HANDLER is
 called with the error as argument.
 HANDLER should either transfer the control via a non-local exit,
-or return normally.
-If it returns normally, the search for an error handler continues
-from where it left off.
+or return normally, should it fail to handle the error.
+If it returns normally, the returned value is ignored, and the
+search for an error handler continues from where it left off.
 
 usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
@@ -1583,7 +1583,7 @@ internal_lisp_condition_case (Lisp_Object var, 
Lisp_Object bodyform,
 /* Call the function BFUN with no arguments, catching errors within it
    according to HANDLERS.  If there is an error, call HFUN with
    one argument which is the data that describes the error:
-   (SIGNALNAME . DATA)
+   (SIGNALNAME . DATA).
 
    HANDLERS can be a list of conditions to catch.
    If HANDLERS is Qt, catch all errors.
@@ -1662,6 +1662,33 @@ internal_condition_case_2 (Lisp_Object (*bfun) 
(Lisp_Object, Lisp_Object),
     }
 }
 
+/* Like internal_condition_case_2 but the second argument is an arbitrary
+   pointer.  */
+
+Lisp_Object
+internal_condition_case_1_voidstar (Lisp_Object (*bfun) (Lisp_Object, void *),
+                                   Lisp_Object arg1,
+                                   void *arg2,
+                                   Lisp_Object handlers,
+                                   Lisp_Object (*hfun) (Lisp_Object))
+{
+  struct handler *c = push_handler (handlers, CONDITION_CASE);
+  if (sys_setjmp (c->jmp))
+    {
+      Lisp_Object val = handlerlist->val;
+      clobbered_eassert (handlerlist == c);
+      handlerlist = handlerlist->next;
+      return hfun (val);
+    }
+  else
+    {
+      Lisp_Object val = bfun (arg1, arg2);
+      eassert (handlerlist == c);
+      handlerlist = c->next;
+      return val;
+    }
+}
+
 /* Like internal_condition_case but call BFUN with NARGS as first,
    and ARGS as second argument.  */
 
@@ -1691,6 +1718,137 @@ internal_condition_case_n (Lisp_Object (*bfun) 
(ptrdiff_t, Lisp_Object *),
     }
 }
 
+/* Call the function BFUN with no arguments, catching errors within it
+   in a `handler-bind' construct according to HANDLERS.  If there is an
+   error, call HFUN with one argument which is the data that describes
+   the error: (SIGNALNAME . DATA).
+
+   HANDLERS is either a list of conditions to catch, or one of these
+   symbols:
+   If HANDLERS is Qt, catch all errors.
+   If HANDLERS is Qerror, catch all errors, but allow the debugger to
+   run if that is enabled.  */
+
+Lisp_Object
+internal_handler_bind (Lisp_Object (*bfun) (void), Lisp_Object handlers,
+                      Lisp_Object (*hfun) (Lisp_Object))
+{
+  struct handler *c = push_handler (handlers, HANDLER_BIND);
+  /* if (NILP (Flistp (handlers))) */
+  /*   handlers = Fcons (handlers, Qnil); */
+  c->val = Qnil;
+  c->bin_handler = hfun;
+  c->bytecode_dest = 0;
+
+  {
+    Lisp_Object val = bfun ();
+    eassert (handlerlist == c);
+    handlerlist = c->next;
+    return val;
+  }
+}
+
+/* Like internal_handler_bind, but call BFUN with ARG as its argument.  */
+
+Lisp_Object
+internal_handler_bind_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
+                        Lisp_Object handlers,
+                        Lisp_Object (*hfun) (Lisp_Object))
+{
+  struct handler *c = push_handler (handlers, HANDLER_BIND);
+  /* if (NILP (Flistp (handlers))) */
+  /*   handlers = Fcons (handlers, Qnil); */
+  c->val = Qnil;
+  c->bin_handler = hfun;
+  c->bytecode_dest = 0;
+  {
+    Lisp_Object val = bfun (arg);
+    eassert (handlerlist == c);
+    handlerlist = c->next;
+    return val;
+  }
+}
+
+/* Like internal_handler_bind_1, but call BFUN with ARG1 and ARG2 as
+   its arguments.  */
+
+Lisp_Object
+internal_handler_bind_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
+                        Lisp_Object arg1,
+                        Lisp_Object arg2,
+                        Lisp_Object handlers,
+                        Lisp_Object (*hfun) (Lisp_Object))
+{
+  struct handler *c = push_handler (handlers, HANDLER_BIND);
+  /* if (NILP (Flistp (handlers))) */
+  /*   handlers = Fcons (handlers, Qnil); */
+  c->val = Qnil;
+  c->bin_handler = hfun;
+  c->bytecode_dest = 0;
+  {
+    Lisp_Object val = bfun (arg1, arg2);
+    eassert (handlerlist == c);
+    handlerlist = c->next;
+    return val;
+  }
+}
+
+/* Like internal_handler_bind_2, but the second argument is an arbitrary
+   pointer.  */
+
+Lisp_Object
+internal_handler_bind_1_voidstar (Lisp_Object (*bfun) (Lisp_Object, void *),
+                        Lisp_Object arg1,
+                        void *arg2,
+                        Lisp_Object handlers,
+                        Lisp_Object (*hfun) (Lisp_Object))
+{
+  struct handler *c = push_handler (handlers, HANDLER_BIND);
+  /* if (NILP (Flistp (handlers))) */
+  /*   handlers = Fcons (handlers, Qnil); */
+  c->val = Qnil;
+  c->bin_handler = hfun;
+  c->bytecode_dest = 0;
+  {
+    Lisp_Object val = bfun (arg1, arg2);
+    eassert (handlerlist == c);
+    handlerlist = c->next;
+    return val;
+  }
+}
+
+/* Like internal_handler_bind, but call BFUN with NARGS as first,
+   and ARGS as second argument.  */
+
+Lisp_Object
+internal_handler_bind_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
+                        ptrdiff_t nargs,
+                        Lisp_Object *args,
+                        Lisp_Object handlers,
+                        Lisp_Object (*hfun) (Lisp_Object err))
+{
+  struct handler *c = push_handler (handlers, HANDLER_BIND);
+    {
+      c->val = Qnil;
+      c->bin_handler = hfun;
+      c->bytecode_dest = 0;
+    }
+  if (sys_setjmp (c->jmp))
+    {
+      Lisp_Object val = handlerlist->val;
+      clobbered_eassert (handlerlist == c);
+      handlerlist = handlerlist->next;
+      return hfun (val);
+    }
+  else
+    {
+      Lisp_Object val = bfun (nargs, args);
+      eassert (handlerlist == c);
+      handlerlist = c->next;
+      return val;
+    }
+}
+
 static Lisp_Object Qcatch_all_memory_full;
 
 /* Like a combination of internal_condition_case_1 and internal_catch.
@@ -1900,9 +2058,12 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool continuable)
                max_ensure_room (20);
                push_handler (make_fixnum (skip + h->bytecode_dest),
                              SKIP_CONDITIONS);
-               call1 (h->val, error);
-               unbind_to (count, Qnil);
-               pop_handler ();
+               if (NILP (h->val))
+                 h->bin_handler (error);
+               else
+                 call1 (h->val, error);
+               unbind_to (count, Qnil); /* Restore after `max_ensure_room'.  */
+               pop_handler ();          /* Remove SKIP_CONDITIONS handler.  */
              }
            continue;
          }


> >         Stefan

> -- 
> Alan Mackenzie (Nuremberg, Germany).