Nativecomp don't materialize non-materializable objects (bug#78606)

The native compiler should not try to generate in rendered code
immediate floats produced by the constrain on the '=' operator.

* test/src/comp-tests.el (comp-test-78606-1): Add test.
* test/src/comp-resources/comp-test-funcs.el (comp-test-78606-1-f): New
function.
* src/comp.c (emit_mvar_rval): Check if an immediate is materializable.
* lisp/emacs-lisp/comp.el (comp-ctxt): Add 'non-materializable-objs-h'
slot.
(comp--fwprop-insn): Update call.
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-=): Add parameter.

(cherry picked from commit 48a5917681dd53b8b75764f4e1455a6c24f95498)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index fad54d4cd465ab8b82685bc2d1ad7c014b315838..ac9e8eb2aceec95ca034bb517e124e9b15abc441 100644 (file)
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -985,8 +985,10 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
     (and (comp-cstr-cl-tag-p cstr)
          (intern (match-string 1 (symbol-name (car (valset cstr))))))))
 
-(defun comp-cstr-= (dst op1 op2)
-  "Constraint OP1 being = OP2 setting the result into DST."
+(defun comp-cstr-= (dst op1 op2 nm-objs-h)
+  "Constraint OP1 being = OP2 setting the result into DST.
+NM-OBJS-H is an hash with all the immediates generated at compile time
+which should not be rendered into compiled code."
   (with-comp-cstr-accessors
     (cl-flet ((relax-cstr (cstr)
                 (setf cstr (copy-sequence cstr))
@@ -1014,8 +1016,11 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
                  else
                    do (cl-pushnew 'float (typeset cstr))
                       (cl-return cstr)
-                 finally (setf (valset cstr)
-                               (append vals-to-add (valset cstr))))
+                 finally
+                   (mapc (lambda (x) (puthash x t nm-objs-h))
+                         vals-to-add)
+                   (setf (valset cstr)
+                         (append vals-to-add (valset cstr))))
                 (when (memql 0.0 (valset cstr))
                   (cl-pushnew -0.0 (valset cstr)))
                 (when (memql -0.0 (valset cstr))

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 9e3962ecd9d34c130143ba2bdf91242fe27c478e..aa6bfbf0e6aa9155c0f4705f3d752d99cb0ffe46 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -398,6 +398,9 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.")
              :documentation "Standard data relocated in use by functions.")
   (d-ephemeral (make-comp-data-container) :type comp-data-container
                :documentation "Relocated data not necessary after load.")
+  (non-materializable-objs-h (make-hash-table :test #'equal) :type hash-table
+               :documentation "Objects produced by the propagation engine which can't be materialized.
+Typically floating points (which are not cons-hashed).")
   (with-late-load nil :type boolean
                   :documentation "When non-nil support late load."))
 
@@ -2730,7 +2733,8 @@ Fold the call in case."
        (<=
         (comp-cstr-<= lval (car operands) (cadr operands)))
        (=
-        (comp-cstr-= lval (car operands) (cadr operands)))))
+        (comp-cstr-= lval (car operands) (cadr operands)
+                     (comp-ctxt-non-materializable-objs-h comp-ctxt)))))
     (`(setimm ,lval ,v)
      (setf (comp-cstr-imm lval) v))
     (`(phi ,lval . ,rest)

diff --git a/src/comp.c b/src/comp.c
index a2b6a959c2ac9b84f6abdbd98f03ef9fa6e94fff..bd5e637afe399ad72d60b23e1aabc6b9f87917e6 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -1972,27 +1972,32 @@ emit_mvar_rval (Lisp_Object mvar)
   if (!NILP (const_vld))
     {
       Lisp_Object value = CALLNI (comp-cstr-imm, mvar);
-      if (comp.debug > 1)
+      if (NILP (Fgethash (value,
+                         CALLNI (comp-ctxt-non-materializable-objs-h, Vcomp_ctxt),
+                         Qnil)))
        {
-         Lisp_Object func =
-           Fgethash (value,
-                     CALLNI (comp-ctxt-byte-func-to-func-h, Vcomp_ctxt),
-                     Qnil);
-
-         emit_comment (
-           SSDATA (
-             Fprin1_to_string (
-               NILP (func) ? value : CALLNI (comp-func-c-name, func),
-               Qnil, Qnil)));
-       }
-      if (FIXNUMP (value))
-       {
-         /* We can still emit directly objects that are self-contained in a
-            word (read fixnums).  */
-          return emit_rvalue_from_lisp_obj (value);
+         if (comp.debug > 1)
+           {
+             Lisp_Object func =
+               Fgethash (value,
+                         CALLNI (comp-ctxt-byte-func-to-func-h, Vcomp_ctxt),
+                         Qnil);
+
+             emit_comment (
+               SSDATA (
+                 Fprin1_to_string (
+                   NILP (func) ? value : CALLNI (comp-func-c-name, func),
+                   Qnil, Qnil)));
+           }
+         if (FIXNUMP (value))
+           {
+             /* We can still emit directly objects that are self-contained in a
+                word (read fixnums).  */
+             return emit_rvalue_from_lisp_obj (value);
+           }
+         /* Other const objects are fetched from the reloc array.  */
+         return emit_lisp_obj_rval (value);
        }
-      /* Other const objects are fetched from the reloc array.  */
-      return emit_lisp_obj_rval (value);
     }
 
   return gcc_jit_lvalue_as_rvalue (emit_mvar_lval (mvar));

diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
index 837ef018efb9377004a32d4512e03d681ae5518c..5154b875499e9a3b0bb54cbe1568d51a32c4644f 100644 (file)
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -582,6 +582,12 @@
 (defun comp-test-76573-1-f ()
   (record 'undeclared-type))
 
+(defun comp-test-78606-1-f (x)
+  (and (= x 1)
+       (if (eql x 1)
+           1
+         x)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 6b608d735402f880c3784c05dc01028270e9305d..879fda6f9c1ceec37a1500cf4b3edea5dcb697de 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -596,6 +596,11 @@ dedicated byte-op code."
   "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2024-09/msg00794.html>"
   (should (eq (comp-test-73270-1-f (make-comp-test-73270-child4)) 'child4)))
 
+(comp-deftest comp-test-78606-1 ()
+  "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2025-05/msg01270.html>"
+  (should (let ((x 1.0))
+            (eq (comp-test-78606-1-f x) x))))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;