diff options
| author | Alan Mackenzie | 2022-10-29 13:21:39 +0000 |
|---|---|---|
| committer | Alan Mackenzie | 2022-10-29 13:21:39 +0000 |
| commit | 31e7b9c073bd0dddedb90a1ff882dc78ff33315c (patch) | |
| tree | 5a635ab618cd95588d43624e53112fe54202950c | |
| parent | 174dd064643e9487c0fa1460727d0935a60b3646 (diff) | |
| download | emacs-31e7b9c073bd0dddedb90a1ff882dc78ff33315c.tar.gz emacs-31e7b9c073bd0dddedb90a1ff882dc78ff33315c.zip | |
Fix the subr-arity returned by native compiled functions with lots of args
This fixes bug #58739. Make subr-arity return, e.g., (12 . 12) rather than
(12 . many) for a function with a fixed number of arguments more than 8.
* lisp/emacs-lisp/comp.el (comp-prepare-args-for-top-level): Only return a cdr
of 'many when there are &rest arguments.
* src/eval.c (eval_sub): Also check for a fixed number of args over 8 when
using the nargs + *args calling convention.
(funcall_subr): Also check numargs <= 8 before using the fixed args calling
convention. Include the case numargs > 8 in the aMany calling convention.
* src/lisp.h (DEFUN): Amend the comment about MANY.
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 7 | ||||
| -rw-r--r-- | src/eval.c | 15 | ||||
| -rw-r--r-- | src/lisp.h | 9 |
3 files changed, 17 insertions, 14 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 3987692f6f9..21395c23d9a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el | |||
| @@ -2057,9 +2057,10 @@ and the annotation emission." | |||
| 2057 | "Lexically-scoped FUNCTION." | 2057 | "Lexically-scoped FUNCTION." |
| 2058 | (let ((args (comp-func-l-args function))) | 2058 | (let ((args (comp-func-l-args function))) |
| 2059 | (cons (make-comp-mvar :constant (comp-args-base-min args)) | 2059 | (cons (make-comp-mvar :constant (comp-args-base-min args)) |
| 2060 | (make-comp-mvar :constant (if (comp-args-p args) | 2060 | (make-comp-mvar :constant (cond |
| 2061 | (comp-args-max args) | 2061 | ((comp-args-p args) (comp-args-max args)) |
| 2062 | 'many))))) | 2062 | ((comp-nargs-rest args) 'many) |
| 2063 | (t (comp-nargs-nonrest args))))))) | ||
| 2063 | 2064 | ||
| 2064 | (cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) | 2065 | (cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) |
| 2065 | "Dynamically scoped FUNCTION." | 2066 | "Dynamically scoped FUNCTION." |
diff --git a/src/eval.c b/src/eval.c index e1399d6a05c..ea238299488 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -2435,7 +2435,9 @@ eval_sub (Lisp_Object form) | |||
| 2435 | 2435 | ||
| 2436 | else if (XSUBR (fun)->max_args == UNEVALLED) | 2436 | else if (XSUBR (fun)->max_args == UNEVALLED) |
| 2437 | val = (XSUBR (fun)->function.aUNEVALLED) (args_left); | 2437 | val = (XSUBR (fun)->function.aUNEVALLED) (args_left); |
| 2438 | else if (XSUBR (fun)->max_args == MANY) | 2438 | else if (XSUBR (fun)->max_args == MANY |
| 2439 | || XSUBR (fun)->max_args > 8) | ||
| 2440 | |||
| 2439 | { | 2441 | { |
| 2440 | /* Pass a vector of evaluated arguments. */ | 2442 | /* Pass a vector of evaluated arguments. */ |
| 2441 | Lisp_Object *vals; | 2443 | Lisp_Object *vals; |
| @@ -2998,7 +3000,8 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) | |||
| 2998 | if (numargs >= subr->min_args) | 3000 | if (numargs >= subr->min_args) |
| 2999 | { | 3001 | { |
| 3000 | /* Conforming call to finite-arity subr. */ | 3002 | /* Conforming call to finite-arity subr. */ |
| 3001 | if (numargs <= subr->max_args) | 3003 | if (numargs <= subr->max_args |
| 3004 | && subr->max_args <= 8) | ||
| 3002 | { | 3005 | { |
| 3003 | Lisp_Object argbuf[8]; | 3006 | Lisp_Object argbuf[8]; |
| 3004 | Lisp_Object *a; | 3007 | Lisp_Object *a; |
| @@ -3034,15 +3037,13 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) | |||
| 3034 | return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5], | 3037 | return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5], |
| 3035 | a[6], a[7]); | 3038 | a[6], a[7]); |
| 3036 | default: | 3039 | default: |
| 3037 | /* If a subr takes more than 8 arguments without using MANY | 3040 | emacs_abort (); /* Can't happen. */ |
| 3038 | or UNEVALLED, we need to extend this function to support it. | ||
| 3039 | Until this is done, there is no way to call the function. */ | ||
| 3040 | emacs_abort (); | ||
| 3041 | } | 3041 | } |
| 3042 | } | 3042 | } |
| 3043 | 3043 | ||
| 3044 | /* Call to n-adic subr. */ | 3044 | /* Call to n-adic subr. */ |
| 3045 | if (subr->max_args == MANY) | 3045 | if (subr->max_args == MANY |
| 3046 | || subr->max_args > 8) | ||
| 3046 | return subr->function.aMANY (numargs, args); | 3047 | return subr->function.aMANY (numargs, args); |
| 3047 | } | 3048 | } |
| 3048 | 3049 | ||
diff --git a/src/lisp.h b/src/lisp.h index 4701dfa868d..d87f9549382 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -3183,10 +3183,11 @@ CHECK_SUBR (Lisp_Object x) | |||
| 3183 | `minargs' should be a number, the minimum number of arguments allowed. | 3183 | `minargs' should be a number, the minimum number of arguments allowed. |
| 3184 | `maxargs' should be a number, the maximum number of arguments allowed, | 3184 | `maxargs' should be a number, the maximum number of arguments allowed, |
| 3185 | or else MANY or UNEVALLED. | 3185 | or else MANY or UNEVALLED. |
| 3186 | MANY means pass a vector of evaluated arguments, | 3186 | MANY means there are &rest arguments. Here we pass a vector |
| 3187 | in the form of an integer number-of-arguments | 3187 | of evaluated arguments in the form of an integer |
| 3188 | followed by the address of a vector of Lisp_Objects | 3188 | number-of-arguments followed by the address of a vector of |
| 3189 | which contains the argument values. | 3189 | Lisp_Objects which contains the argument values. (We also use |
| 3190 | this convention when calling a subr with more than 8 parameters.) | ||
| 3190 | UNEVALLED means pass the list of unevaluated arguments | 3191 | UNEVALLED means pass the list of unevaluated arguments |
| 3191 | `intspec' says how interactive arguments are to be fetched. | 3192 | `intspec' says how interactive arguments are to be fetched. |
| 3192 | If the string starts with a `(', `intspec' is evaluated and the resulting | 3193 | If the string starts with a `(', `intspec' is evaluated and the resulting |