From 263d6c38539691c954f4c3057cbe8d5468499b91 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Mon, 20 Mar 2023 17:24:48 +0100
Subject: [PATCH] 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.
---
 lisp/emacs-lisp/comp.el | 30 +++++++++++++++++++-----------
 test/src/comp-tests.el  | 13 +++++++++++++
 2 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 283c00103b5..febca8df19c 100644
--- 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 926ba27e563..1615b2838fc 100644
--- 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))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;
-- 
2.39.5