Comp fix calls to redefined primtives with op-bytecode (bug#61917)

* lisp/emacs-lisp/comp.el (comp-emit-set-call-subr): Fix compilation
of calls to redefined primtives with dedicated op-bytecode.
* test/src/comp-tests.el (61917-1): New test.

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 283c00103b550ea9e496ca5f192e0e5e282803de..febca8df19c5bfbab8c2c6731875ee2d8569bc97 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1773,17 +1773,25 @@ SP-DELTA is the stack adjustment."
              (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))))))))
+        (if (not (subrp subr-name))
+            ;; The primitive got redefined before the compiler is
+            ;; invoked! (bug#61917)
+            (comp-emit-set-call `(callref funcall
+                                          ,(make-comp-mvar :constant subr-name)
+                                          ,@(cl-loop repeat nargs
+                                                     for sp from (comp-sp)
+                                                     collect (comp-slot-n sp))))
+          (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)

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 926ba27e563b31fe489b230ce32d5cd4cc96a461..1615b2838fcce0a170c52b809bf85dcdecc1c8ee 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -532,6 +532,19 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
   (should (subr-native-elisp-p
            (symbol-function 'comp-test-48029-nonascii-žžž-f))))
 
+(comp-deftest 61917-1 ()
+  "Verify we can compile calls to redefined primitives with
+dedicated byte-op code."
+  (let ((f (lambda (fn &rest args)
+             (apply fn args))))
+    (advice-add #'delete-region :around f)
+    (unwind-protect
+        (should (subr-native-elisp-p
+                 (native-compile
+                  '(lambda ()
+                     (delete-region (point-min) (point-max))))))
+      (advice-remove #'delete-region f))))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;