emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/native-comp ab985f4: Add 'internal_condition_case_5' (bug#45303)


From: Andrea Corallo
Subject: feature/native-comp ab985f4: Add 'internal_condition_case_5' (bug#45303).
Date: Sat, 19 Dec 2020 15:36:14 -0500 (EST)

branch: feature/native-comp
commit ab985f41db5fdaeada513d28a065332fd8838cf4
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    Add 'internal_condition_case_5' (bug#45303).
    
        * src/lisp.h (internal_condition_case_4)
        (internal_condition_case_5): Declare.
        * src/eval.c (internal_condition_case_5): New function.
        * src/comp.c (eln_load_path_final_clean_up): Use
        'internal_condition_case_5'.
---
 src/comp.c |  4 ++--
 src/eval.c | 29 +++++++++++++++++++++++++++++
 src/lisp.h |  2 ++
 3 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index f77faaa..12c5f1c 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -4618,11 +4618,11 @@ eln_load_path_final_clean_up (void)
   FOR_EACH_TAIL (dir_tail)
     {
       Lisp_Object files_in_dir =
-       internal_condition_case_4 (Fdirectory_files,
+       internal_condition_case_5 (Fdirectory_files,
                                   concat2 (XCAR (dir_tail),
                                            Vcomp_native_version_dir),
                                   Qt, build_string ("\\.eln\\.old\\'"), Qnil,
-                                  Qt, return_nil);
+                                  Qt, return_nil, Qnil);
       FOR_EACH_TAIL (files_in_dir)
        Fdelete_file (XCAR (files_in_dir), Qnil);
     }
diff --git a/src/eval.c b/src/eval.c
index 2b31b91..368fa09 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1534,6 +1534,35 @@ internal_condition_case_4 (Lisp_Object (*bfun) 
(Lisp_Object, Lisp_Object,
     }
 }
 
+/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3,
+   ARG4, ARG5 as its arguments.  */
+
+Lisp_Object
+internal_condition_case_5 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object,
+                                                Lisp_Object, Lisp_Object,
+                                               Lisp_Object),
+                           Lisp_Object arg1, Lisp_Object arg2,
+                           Lisp_Object arg3, Lisp_Object arg4,
+                          Lisp_Object arg5, 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, arg3, arg4, arg5);
+      eassert (handlerlist == c);
+      handlerlist = c->next;
+      return val;
+    }
+}
+
 /* Like internal_condition_case but call BFUN with NARGS as first,
    and ARGS as second argument.  */
 
diff --git a/src/lisp.h b/src/lisp.h
index 588316e..923e742 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4157,6 +4157,8 @@ extern Lisp_Object internal_condition_case (Lisp_Object 
(*) (void), Lisp_Object,
 extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), 
Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
 extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, 
Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) 
(Lisp_Object));
 extern Lisp_Object internal_condition_case_3 (Lisp_Object (*) (Lisp_Object, 
Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, 
Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_4 (Lisp_Object (*) (Lisp_Object, 
Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, 
Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_5 (Lisp_Object (*) (Lisp_Object, 
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, 
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) 
(Lisp_Object));
 extern Lisp_Object internal_condition_case_n
     (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
      Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));



reply via email to

[Prev in Thread] Current Thread [Next in Thread]