better scratch slot support

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 7c4cfc95bffe2fb4df8a5b8ecc89ec706f074d4e..60eb9420662c1c6f6f10b6c9b985f55227a72f3b 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -257,9 +257,8 @@ structure.")
 
 (cl-defstruct (comp-mvar (:constructor make--comp-mvar))
   "A meta-variable being a slot in the meta-stack."
-  (slot nil :type fixnum
-        :documentation "Slot number.
--1 is a special value and indicates the scratch slot.")
+  (slot nil :type (or fixnum symbol)
+        :documentation "Slot number if a number or 'scratch' for scratch slot.")
   (id nil :type (or null number)
      :documentation "SSA number when in SSA form.")
   (const-vld nil :type boolean
@@ -732,10 +731,10 @@ Return value is the fall through block name."
       else
         ;; Store the result of the comparison into the scratch slot before
         ;; emitting the conditional jump.
-        do (comp-emit (list 'set (make-comp-mvar :slot -1)
+        do (comp-emit (list 'set (make-comp-mvar :slot 'scratch)
                             (comp-call test-func var m-test)))
            (comp-emit (list 'cond-jump
-                            (make-comp-mvar :slot -1)
+                            (make-comp-mvar :slot 'scratch)
                             (make-comp-mvar :constant nil)
                             target-name ff-bb-name))
       do (unless last
@@ -1180,7 +1179,7 @@ This will be called at load-time."
 
 (defun comp-limplify (lap-funcs)
   "Compute the LIMPLE ir for LAP-FUNCS.
-Top level forms for the current context are rendered too."
+Top-level forms for the current context are rendered too."
   (mapc #'comp-add-func-to-ctxt (mapcar #'comp-limplify-function lap-funcs))
   (comp-add-func-to-ctxt (comp-limplify-top-level)))
 
@@ -1342,7 +1341,7 @@ Top level forms for the current context are rendered too."
              ;; Return t if a SLOT-N was assigned within BB.
              (cl-loop for insn in (comp-block-insns bb)
                       when (and (comp-assign-op-p (car insn))
-                                (= slot-n (comp-mvar-slot (cadr insn))))
+                                (eql slot-n (comp-mvar-slot (cadr insn))))
                         return t)))
 
     (cl-loop for i from 0 below (comp-func-frame-size comp-func)

diff --git a/src/comp.c b/src/comp.c
index 63c99b98334aba6d5fb420bd56dedb3e5a4bc9f6..ce2a542e7cfa1200543d60061ca31fe1a40c8ca9 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -297,8 +297,9 @@ declare_block (Lisp_Object block_name)
 static gcc_jit_lvalue *
 get_slot (Lisp_Object mvar)
 {
-  EMACS_INT slot_n = XFIXNUM (CALL1I (comp-mvar-slot, mvar));
-  if (slot_n == -1)
+  Lisp_Object mvar_slot = CALL1I (comp-mvar-slot, mvar);
+
+  if (EQ (mvar_slot, Qscratch))
     {
       if (!comp.scratch)
        comp.scratch = gcc_jit_function_new_local (comp.func,
@@ -307,6 +308,7 @@ get_slot (Lisp_Object mvar)
                                                   "scratch");
       return comp.scratch;
     }
+  EMACS_INT slot_n = XFIXNUM (mvar_slot);
   gcc_jit_lvalue **frame =
     (CALL1I (comp-mvar-ref, mvar) || SPEED < 2)
     ? comp.frame : comp.f_frame;
@@ -3366,6 +3368,7 @@ syms_of_comp (void)
 
   /* Others.  */
   DEFSYM (Qfixnum, "fixnum");
+  DEFSYM (Qscratch, "scratch");
 
   /* To be signaled by the compiler.  */
   DEFSYM (Qnative_compiler_error, "native-compiler-error");