let limple support calls with no assignment

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 05f17e43d64cb890eb16b3abc9fe596519217f56..1094acf1ea32caf8cd4dbe5831f74f4ff8e7502d 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -193,19 +193,23 @@ To be used when ncall-conv is nil.")
   "Slot into the meta-stack pointed by sp + 1."
   '(comp-slot-n (1+ (comp-sp))))
 
-(defun comp-emit-call (call)
-  "Emit CALL."
+(defun comp-emit (x)
+  "Emit X into current LIMPLE ir.."
+  (push x comp-limple))
+
+(defun comp-emit-set-call (call)
+  "Emit CALL assigning the result the the current slot frame.."
   (cl-assert call)
   (setf (comp-slot)
         (make-comp-mvar :slot (comp-sp)
                         :type (alist-get (cadr call)
                                          comp-known-ret-types)))
-  (push (list 'set (comp-slot) call) comp-limple))
+  (comp-emit (list 'set (comp-slot) call)))
 
 (defun comp-push-call (call)
-  "Push call CALL into frame."
+  "Increase sp and call `comp-emit-set-call' to emit CALL."
   (cl-incf (comp-sp))
-  (comp-emit-call call))
+  (comp-emit-set-call call))
 
 (defun comp-push-slot-n (n)
   "Push slot number N into frame."
@@ -215,11 +219,11 @@ To be used when ncall-conv is nil.")
     (setf (comp-slot)
           (copy-sequence src-slot))
     (setf (comp-mvar-slot (comp-slot)) (comp-sp))
-    (push (list 'set (comp-slot) src-slot) comp-limple)))
+    (comp-emit (list 'set (comp-slot) src-slot))))
 
 (defun comp-emit-annotation (str)
   "Emit annotation STR."
-  (push `(comment ,str) comp-limple))
+  (comp-emit `(comment ,str)))
 
 (defun comp-push-const (val)
   "Push VAL into frame.
@@ -228,7 +232,7 @@ VAL is known at compile time."
   (setf (comp-slot) (make-comp-mvar :slot (comp-sp)
                                     :const-vld t
                                     :constant val))
-  (push (list 'setimm (comp-slot) val) comp-limple))
+  (comp-emit (list 'setimm (comp-slot) val)))
 
 (defun comp-emit-block (bblock)
   "Push basic block BBLOCK."
@@ -237,7 +241,7 @@ VAL is known at compile time."
   ;; This will be superseded by proper flow analysis.
   (setf (comp-limple-frame-frame comp-frame)
         (comp-limple-frame-new-frame (comp-func-frame-size comp-func)))
-  (push `(block ,bblock) comp-limple))
+  (comp-emit `(block ,bblock)))
 
 (defun comp-pop (n)
   "Pop N elements from the meta-stack."
@@ -245,12 +249,12 @@ VAL is known at compile time."
 
 (defun comp-limplify-listn (n)
   "Limplify list N."
-  (comp-emit-call `(call Fcons ,(comp-slot)
+  (comp-emit-set-call `(call Fcons ,(comp-slot)
                          ,(make-comp-mvar :const-vld t
                                           :constant nil)))
   (dotimes (_ (1- n))
     (comp-pop 1)
-    (comp-emit-call `(call Fcons
+    (comp-emit-set-call `(call Fcons
                            ,(comp-slot)
                            ,(comp-slot-n (1+ (comp-sp)))))))
 
@@ -265,31 +269,31 @@ VAL is known at compile time."
                                               :const-vld t
                                               :constant (cadr inst)))))
       ('byte-varset
-       (comp-emit-call `(call set_internal
-                              ,(make-comp-mvar
-                                :const-vld t
-                                :constant (cadr inst))
-                              ,(comp-slot))))
+       (comp-emit `(call set_internal
+                         ,(make-comp-mvar
+                           :const-vld t
+                           :constant (cadr inst))
+                         ,(comp-slot))))
       ('byte-constant
        (comp-push-const (cadr inst)))
       ('byte-stack-ref
        (comp-push-slot-n (- (comp-sp) (cdr inst))))
       ('byte-plus
        (comp-pop 1)
-       (comp-emit-call `(callref Fplus 2 ,(comp-sp))))
+       (comp-emit-set-call `(callref Fplus 2 ,(comp-sp))))
       ('byte-cons
        (comp-pop 1)
-       (comp-emit-call `(call Fcons ,(comp-slot) ,(comp-slot-next))))
+       (comp-emit-set-call `(call Fcons ,(comp-slot) ,(comp-slot-next))))
       ('byte-car
-       (comp-emit-call `(call Fcar ,(comp-slot))))
+       (comp-emit-set-call `(call Fcar ,(comp-slot))))
       ('byte-cdr
-       (comp-emit-call `(call Fcdr ,(comp-slot))))
+       (comp-emit-set-call `(call Fcdr ,(comp-slot))))
       ('byte-car-safe
-       (comp-emit-call `(call Fcar_safe ,(comp-slot))))
+       (comp-emit-set-call `(call Fcar_safe ,(comp-slot))))
       ('byte-cdr-safe
-       (comp-emit-call `(call Fcdr_safe ,(comp-slot))))
+       (comp-emit-set-call `(call Fcdr_safe ,(comp-slot))))
       ('byte-length
-       (comp-emit-call `(call Flength ,(comp-slot))))
+       (comp-emit-set-call `(call Flength ,(comp-slot))))
       ('byte-list1
        (comp-limplify-listn 1))
       ('byte-list2
@@ -299,7 +303,7 @@ VAL is known at compile time."
       ('byte-list4
        (comp-limplify-listn 4))
       ('byte-return
-       (push (list 'return (comp-slot)) comp-limple)
+       (comp-emit (list 'return (comp-slot)))
        `(return ,(comp-slot)))
       (_ (error "Unexpected LAP op %s" (symbol-name op))))))
 

diff --git a/src/comp.c b/src/comp.c
index 25598aa20c1f1ed11c10b1f81138eaa0f3ae80ef..f164bf892a5ab293302528274d548675214ae468 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -976,12 +976,10 @@ emit_limple_call (Lisp_Object arg1)
   if (calle[0] == 'F')
     {
       /*
-       Ex: (= #s(comp-mvar 6 1 nil nil nil)
-              (call Fcar #s(comp-mvar 4 0 nil nil nil)))
+       Ex: (call Fcar #s(comp-mvar 4 0 nil nil nil))
 
-        Ex: (= #s(comp-mvar 5 0 nil nil cons)
-              (call Fcons #s(comp-mvar 3 0 t 1 nil)
-                          #s(comp-mvar 4 nil t nil nil)))
+       Ex: (call Fcons #s(comp-mvar 3 0 t 1 nil)
+                       #s(comp-mvar 4 nil t nil nil))
       */
 
       ptrdiff_t nargs = list_length (call_args);
@@ -994,10 +992,9 @@ emit_limple_call (Lisp_Object arg1)
   else if (!strcmp (calle, "set_internal"))
     {
       /*
-       Ex: (set #s(comp-mvar 8 1 nil nil nil)
-                 (call set_internal
-                       #s(comp-mvar 7 nil t xxx nil)
-                       #s(comp-mvar 6 1 t 3 nil)))
+       Ex: (call set_internal
+                 #s(comp-mvar 7 nil t xxx nil)
+                 #s(comp-mvar 6 1 t 3 nil))
       */
       /* TODO: Inline the most common case.  */
       eassert (list_length (call_args) == 2);
@@ -1008,14 +1005,26 @@ emit_limple_call (Lisp_Object arg1)
       gcc_args[3] = gcc_jit_context_new_rvalue_from_int (comp.ctxt,
                                                         comp.int_type,
                                                         SET_INTERNAL_SET);
-      gcc_jit_block_add_eval (
-       comp.block,
-       NULL,
-       emit_call ("set_internal", comp.void_type , 4, gcc_args));
-
-      return NULL;
+      return emit_call ("set_internal", comp.void_type , 4, gcc_args);
     }
-  error ("LIMPLE inconsiste call");
+  error ("LIMPLE call is inconsistet");
+}
+
+static gcc_jit_rvalue *
+emit_limple_call_ref (Lisp_Object arg1)
+{
+  /* Ex: (callref Fplus 2 0).  */
+
+  char *calle = (char *) SDATA (SYMBOL_NAME (SECOND (arg1)));
+  EMACS_UINT nargs = XFIXNUM (THIRD (arg1));
+  EMACS_UINT base_ptr = XFIXNUM (FORTH (arg1));
+  gcc_jit_rvalue *gcc_args[2] =
+    { gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+                                          comp.ptrdiff_type,
+                                          nargs),
+      gcc_jit_lvalue_get_address (comp.frame[base_ptr], NULL) };
+
+  return emit_call (calle, comp.lisp_obj_type, 2, gcc_args);
 }
 
 static void
@@ -1032,53 +1041,35 @@ emit_limple_inst (Lisp_Object inst)
     }
   else if (EQ (op, Qjump))
     {
-      /* Unconditional branch.  */
+      /* Unconditional branch. */
       gcc_jit_block *target = retrive_block (arg0);
       gcc_jit_block_end_with_jump (comp.block, NULL, target);
       comp.block = target;
     }
+  else if (EQ (op, Qcall))
+    {
+      gcc_jit_block_add_eval (comp.block,
+                             NULL,
+                             emit_limple_call (inst));
+    }
   else if (EQ (op, Qset))
     {
       EMACS_UINT slot_n = XFIXNUM (FUNCALL1 (comp-mvar-slot, arg0));
       Lisp_Object arg1 = THIRD (inst);
 
       if (EQ (Ftype_of (arg1), Qcomp_mvar))
-       {
-       /*
-          Ex: (= #s(comp-mvar 6 2 nil nil nil)
-                  #s(comp-mvar 6 0 nil nil nil)).
-       */
-         res = emit_mvar_val (arg1);
-       }
+       res = emit_mvar_val (arg1);
       else if (EQ (FIRST (arg1), Qcall))
-       {
-         res = emit_limple_call (arg1);
-       }
+       res = emit_limple_call (arg1);
       else if (EQ (FIRST (arg1), Qcallref))
-       {
-         /* Ex: (= #s(comp-mvar 10 1 nil nil nil) (callref Fplus 2 0)).  */
-
-         char *calle = (char *) SDATA (SYMBOL_NAME (SECOND (arg1)));
-         EMACS_UINT nargs = XFIXNUM (THIRD (arg1));
-         EMACS_UINT base_ptr = XFIXNUM (FORTH (arg1));
-         gcc_jit_rvalue *gcc_args[2] =
-           { gcc_jit_context_new_rvalue_from_int (comp.ctxt,
-                                                  comp.ptrdiff_type,
-                                                  nargs),
-             gcc_jit_lvalue_get_address (
-               comp.frame[base_ptr],
-               NULL) };
-         res = emit_call (calle, comp.lisp_obj_type, 2, gcc_args);
-       }
+       res = emit_limple_call_ref (arg1);
       else
-       {
-         error ("LIMPLE inconsistent arg1 for op =");
-       }
-      if (res)
-       gcc_jit_block_add_assignment (comp.block,
-                                     NULL,
-                                     comp.frame[slot_n],
-                                     res);
+       error ("LIMPLE inconsistent arg1 for op =");
+      eassert (res);
+      gcc_jit_block_add_assignment (comp.block,
+                                   NULL,
+                                   comp.frame[slot_n],
+                                   res);
     }
   else if (EQ (op, Qsetpar))
     {
@@ -1105,7 +1096,7 @@ emit_limple_inst (Lisp_Object inst)
     }
   else if (EQ (op, Qcomment))
     {
-      /* Ex: (comment "Function: foo").  */
+      /* Ex: (comment "Function: foo").         */
       emit_comment((char *) SDATA (arg0));
     }
   else if (EQ (op, Qreturn))