diff options
author | João Távora <joaotavora@gmail.com> | 2023-04-03 00:33:03 +0100 |
---|---|---|
committer | João Távora <joaotavora@gmail.com> | 2023-04-03 00:33:03 +0100 |
commit | c108132d3bb69d0cc8d2e0222a781dff9abca087 (patch) | |
tree | f2bd600bfcf0f9f06dd36b7f08bfcc605da352fe /lisp/emacs-lisp/comp.el | |
parent | f886ae5cf07bb40ad3fd0262942bdc74efca0277 (diff) | |
parent | 3bdbb66efb9895b8ed55270075fa7d8329f8d36b (diff) | |
download | emacs-c108132d3bb69d0cc8d2e0222a781dff9abca087.tar.gz |
Merge from origin/emacs-29
3bdbb66efb9 ; CONTRIBUTE: Minor stylistic changes.
d0eb12e8d3c Fix typo in section 14.1 of Emacs Manual
b2fbec37f39 ; * etc/EGLOT-NEWS: Clarify scope of topmost section
131ec049db0 Eglot: unbreak eglot-extend-to-xref on w32
0622e1f29f6 Eglot: ensure server shutdown turns off eglot-inlay-hints...
59f66ea3027 ; * lisp/emacs-lisp/package-vc.el: Remove completed item ...
d23dc3dd7e3 ; * lisp/emacs-lisp/package-vc.el (package-vc): Fix manua...
4508a024e81 ; Clarify documentation of 'cursor' text property
d2e82817a3f Add two typescript-ts-mode faces (bug#62429)
10918fc9d24 Fix scrolling window when point moves up
9b32bc134c4 Improve documentation of 'defcustom's :set keyword
ab4273056e0 Comp fix calls to redefined primtives with op-bytecode (b...
c98929c7e18 ; Fix last change
a14c3f62a67 ; Fix last change
09fece5722f Fix duplicate defcustom in eww.el
e45bd10a3d9 Fix indentation regression in 'C-h l'
46fd10a7600 * doc/misc/tramp.texi (Remote shell setup): Clarify use o...
Diffstat (limited to 'lisp/emacs-lisp/comp.el')
-rw-r--r-- | lisp/emacs-lisp/comp.el | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a5ed5df117d..841b0ebf29d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1764,27 +1764,32 @@ Return value is the fall-through block name." (_ (signal 'native-ice '("missing previous setimm while creating a switch"))))) +(defun comp--func-arity (subr-name) + "Like `func-arity' but invariant against primitive redefinitions. +SUBR-NAME is the name of function." + (or (gethash subr-name comp-subr-arities-h) + (func-arity subr-name))) + (defun comp-emit-set-call-subr (subr-name sp-delta) "Emit a call for SUBR-NAME. SP-DELTA is the stack adjustment." - (let ((subr (symbol-function subr-name)) - (nargs (1+ (- sp-delta)))) - (let* ((arity (func-arity subr)) - (minarg (car arity)) - (maxarg (cdr arity))) - (when (eq maxarg 'unevalled) - (signal 'native-ice (list "subr contains unevalled args" subr-name))) - (if (eq maxarg 'many) - ;; callref case. - (comp-emit-set-call (comp-callref subr-name nargs (comp-sp))) - ;; Normal call. - (unless (and (>= maxarg nargs) (<= minarg nargs)) - (signal 'native-ice - (list "incoherent stack adjustment" nargs maxarg minarg))) - (let* ((subr-name subr-name) - (slots (cl-loop for i from 0 below maxarg - collect (comp-slot-n (+ i (comp-sp)))))) - (comp-emit-set-call (apply #'comp-call (cons subr-name slots)))))))) + (let* ((nargs (1+ (- sp-delta))) + (arity (comp--func-arity subr-name)) + (minarg (car arity)) + (maxarg (cdr arity))) + (when (eq maxarg 'unevalled) + (signal 'native-ice (list "subr contains unevalled args" subr-name))) + (if (eq maxarg 'many) + ;; callref case. + (comp-emit-set-call (comp-callref subr-name nargs (comp-sp))) + ;; Normal call. + (unless (and (>= maxarg nargs) (<= minarg nargs)) + (signal 'native-ice + (list "incoherent stack adjustment" nargs maxarg minarg))) + (let* ((subr-name subr-name) + (slots (cl-loop for i from 0 below maxarg + collect (comp-slot-n (+ i (comp-sp)))))) + (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))) (eval-when-compile (defun comp-op-to-fun (x) |