feature/native-comp e8ab017 3/6: Change 'direct-call' 'direct-callref' LIMPLE ops sematinc

[Andrea Corallo]

branch: feature/native-comp
commit e8ab017b6d45aea2514a49f974e649ad1f7297ad
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    Change 'direct-call' 'direct-callref' LIMPLE ops sematinc
    
    Is cleaner to have the function c-name as first argument of
    'direct-call' 'direct-callref'.  This is preparatory to anonymous
    lambdas optimization.
    
        * lisp/emacs-lisp/comp.el (comp-propagate-insn): Use c-name when
        gathering the comp-func definition for direct calls.
        (comp-call-optim-form-call): Add put c-name as first argument of
        direct-call direct-callref when optimizing.
    
        * src/comp.c (emit_call): Update logic for having c-name as
        first arg of direct calls.
        (emit_call_ref): Rename 'subr_sym' into 'func'.
---
 lisp/emacs-lisp/comp.el | 25 +++++++++++++------------
 src/comp.c              | 38 ++++++++++++++++----------------------
 2 files changed, 29 insertions(+), 34 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 5116f88..e776b66 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1888,14 +1888,15 @@ Here goes everything that can be done not iteratively 
(read once).
   (pcase insn
     (`(set ,lval ,rval)
      (pcase rval
-       (`(,(or 'call 'direct-call) ,f . ,args)
-        (setf (comp-mvar-type lval)
-              (alist-get f comp-known-ret-types))
-        (comp-function-call-maybe-remove insn f args))
-       (`(,(or 'callref 'direct-callref) ,f . ,args)
+       (`(,(or 'call 'callref) ,f . ,args)
         (setf (comp-mvar-type lval)
               (alist-get f comp-known-ret-types))
         (comp-function-call-maybe-remove insn f args))
+       (`(,(or 'direct-call 'direct-callref) ,f . ,args)
+        (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt)))))
+          (setf (comp-mvar-type lval)
+                (alist-get f comp-known-ret-types))
+          (comp-function-call-maybe-remove insn f args)))
        (_
         (comp-mvar-propagate lval rval))))
     (`(phi ,lval . ,rest)
@@ -1985,9 +1986,9 @@ Backward propagate array placement properties."
                (not (memq callee comp-never-optimize-functions)))
       (let* ((f (symbol-function callee))
              (subrp (subrp f))
-             (callee-in-unit (gethash (gethash callee
-                                               (comp-ctxt-sym-to-c-name-h 
comp-ctxt))
-                                      (comp-ctxt-funcs-h comp-ctxt))))
+             (comp-func-callee (gethash (gethash callee
+                                                 (comp-ctxt-sym-to-c-name-h 
comp-ctxt))
+                                        (comp-ctxt-funcs-h comp-ctxt))))
         (cond
          ((and subrp (not (subr-native-elisp-p f)))
           ;; Trampoline removal.
@@ -1995,7 +1996,7 @@ Backward propagate array placement properties."
                  (maxarg (cdr (subr-arity f)))
                  (call-type (if (if subrp
                                     (not (numberp maxarg))
-                                  (comp-nargs-p callee-in-unit))
+                                  (comp-nargs-p comp-func-callee))
                                 'callref
                               'call))
                  (args (if (eq call-type 'callref)
@@ -2005,14 +2006,14 @@ Backward propagate array placement properties."
          ;; Intra compilation unit procedure call optimization.
          ;; Attention speed 3 triggers this for non self calls too!!
          ((and (>= comp-speed 3)
-               callee-in-unit)
-          (let* ((func-args (comp-func-args callee-in-unit))
+               comp-func-callee)
+          (let* ((func-args (comp-func-args comp-func-callee))
                  (nargs (comp-nargs-p func-args))
                  (call-type (if nargs 'direct-callref 'direct-call))
                  (args (if (eq call-type 'direct-callref)
                            args
                          (fill-args args (comp-args-max func-args)))))
-            `(,call-type ,callee ,@args)))
+            `(,call-type ,(comp-func-c-name comp-func-callee) ,@args)))
          ((comp-type-hint-p callee)
           `(call ,callee ,@args)))))))
 
diff --git a/src/comp.c b/src/comp.c
index 45904a3..9171a6a 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -860,34 +860,28 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type 
*ret_type,
 }
 
 /* Emit calls fetching from existing declarations.  */
+
 static gcc_jit_rvalue *
-emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, ptrdiff_t nargs,
+emit_call (Lisp_Object func, gcc_jit_type *ret_type, ptrdiff_t nargs,
           gcc_jit_rvalue **args, bool direct)
 {
-  Lisp_Object func;
-  if (direct)
-    {
-      Lisp_Object c_name =
-       Fgethash (subr_sym,
-                 CALL1I (comp-ctxt-sym-to-c-name-h, Vcomp_ctxt),
-                 Qnil);
-      func = Fgethash (c_name, comp.exported_funcs_h, Qnil);
-    }
-  else
-    func = Fgethash (subr_sym, comp.imported_funcs_h, Qnil);
+  Lisp_Object gcc_func =
+    Fgethash (func,
+             direct ? comp.exported_funcs_h : comp.imported_funcs_h,
+             Qnil);
 
-  if (NILP (func))
+  if (NILP (gcc_func))
       xsignal2 (Qnative_ice,
                build_string ("missing function declaration"),
-               subr_sym);
+               func);
 
   if (direct)
     {
-      emit_comment (format_string ("direct call to subr: %s",
-                                  SSDATA (SYMBOL_NAME (subr_sym))));
+      emit_comment (format_string ("direct call to: %s",
+                                  SSDATA (func)));
       return gcc_jit_context_new_call (comp.ctxt,
                                       NULL,
-                                      xmint_pointer (func),
+                                      xmint_pointer (gcc_func),
                                       nargs,
                                       args);
     }
@@ -897,14 +891,14 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, 
ptrdiff_t nargs,
        gcc_jit_rvalue_dereference_field (
          gcc_jit_lvalue_as_rvalue (comp.func_relocs),
          NULL,
-         (gcc_jit_field *) xmint_pointer (func));
+         (gcc_jit_field *) xmint_pointer (gcc_func));
 
       if (!f_ptr)
        xsignal2 (Qnative_ice,
                  build_string ("missing function relocation"),
-                 subr_sym);
+                 func);
       emit_comment (format_string ("calling subr: %s",
-                                  SSDATA (SYMBOL_NAME (subr_sym))));
+                                  SSDATA (SYMBOL_NAME (func))));
       return gcc_jit_context_new_call_through_ptr (comp.ctxt,
                                                   NULL,
                                                   gcc_jit_lvalue_as_rvalue 
(f_ptr),
@@ -914,7 +908,7 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, 
ptrdiff_t nargs,
 }
 
 static gcc_jit_rvalue *
-emit_call_ref (Lisp_Object subr_sym, ptrdiff_t nargs,
+emit_call_ref (Lisp_Object func, ptrdiff_t nargs,
               gcc_jit_lvalue *base_arg, bool direct)
 {
   gcc_jit_rvalue *args[] =
@@ -922,7 +916,7 @@ emit_call_ref (Lisp_Object subr_sym, ptrdiff_t nargs,
                                           comp.ptrdiff_type,
                                           nargs),
       gcc_jit_lvalue_get_address (base_arg, NULL) };
-  return emit_call (subr_sym, comp.lisp_obj_type, 2, args, direct);
+  return emit_call (func, comp.lisp_obj_type, 2, args, direct);
 }
 
 /* Close current basic block emitting a conditional.  */