From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Mon, 8 Jul 2019 09:37:17 +0000 (+0200)
Subject: calling C
X-Git-Tag: emacs-28.0.90~2727^2~1384
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a09816558395ee289897561627ac44fdf1775a6b;p=emacs.git

calling C
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index fda4dc437b6..b6e3e010323 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -23,7 +23,9 @@
 ;;; Code:
 
 (require 'bytecomp)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(require 'cl-extra)
+(require 'subr-x)
 
 (defgroup comp nil
   "Emacs Lisp native compiler."
@@ -102,6 +104,11 @@
   (setf (comp-func-ir func) byte-compile-lap-output)
   func)
 
+(declare-function comp-init-ctxt "comp.c")
+(declare-function comp-release-ctxt "comp.c")
+(declare-function comp-add-func-to-ctxt "comp.c")
+(declare-function comp-compile-and-load-ctxt "comp.c")
+
 ;; (defun comp-opt-call (inst)
 ;;   "Optimize if possible a side-effect-free call in INST."
 ;;   (cl-destructuring-bind (_ f &rest args) inst
@@ -141,7 +148,7 @@
   (cl-incf (comp-sp))
   (setf (comp-slot)
         (make-comp-mvar :slot (comp-sp)
-                        :type (alist-get (second src-slot)
+                        :type (alist-get (cadr src-slot)
                                          comp-known-ret-types)))
   (push (list '=call (comp-slot) src-slot) comp-limple))
 
@@ -187,11 +194,11 @@ VAL is known at compile time."
       ('byte-dup
        (comp-push-slot-n (comp-sp)))
       ('byte-varref
-       (comp-push-call `(call Fsymbol_value ,(second inst))))
+       (comp-push-call `(call Fsymbol_value ,(cadr inst))))
       ;; ('byte-varset
-      ;;  (comp-push-call `(call Fsymbol_value ,(second inst))))
+      ;;  (comp-push-call `(call Fsymbol_value ,(cadr inst))))
       ('byte-constant
-       (comp-push-const (second inst)))
+       (comp-push-const (cadr inst)))
       ('byte-stack-ref
        (comp-push-slot-n (- (comp-sp) (cdr inst))))
       ('byte-plus
@@ -246,18 +253,24 @@ VAL is known at compile time."
     func))
 
 (defun native-compile (fun)
-  "FUN is the function definition to be compiled to native code."
+  "FUN is the function definition to be compiled into native code."
   (unless lexical-binding
     (error "Can't compile a non lexical binded function"))
   (if-let ((f (symbol-function fun)))
       (progn
         (when (byte-code-function-p f)
           (error "Can't native compile an already bytecompiled function"))
-        (cl-loop with func = (make-comp-func :symbol-name fun
-                                             :func f)
-                 for pass in comp-passes
-                 do (funcall pass func)
-                 finally return func))
+        (let ((func (make-comp-func :symbol-name fun
+                                    :func f)))
+          (mapc (lambda (pass)
+                  (funcall pass func))
+                comp-passes)
+          ;; Once we have the final LIMPLE we jump into C.
+          (when (boundp #'comp-init-ctxt)
+                (comp-init-ctxt)
+                (comp-add-func-to-ctxt func)
+                (comp-compile-and-load-ctxt)
+                (comp-release-ctxt))))
     (error "Trying to native compile not a function")))
 
 (provide 'comp)
diff --git a/src/comp.c b/src/comp.c
index fb1fa79d12d..89d057217dc 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -1835,9 +1835,11 @@ DEFUN ("comp-add-func-to-ctxt", Fcomp_add_func_to_ctxt, Scomp_add_func_to_ctxt,
   return Qt;
 }
 
-DEFUN ("comp-compile-ctxt", Fcomp_compile_ctxt, Scomp_compile_ctxt,
+DEFUN ("comp-compile-and-load-ctxt", Fcomp_compile_and_load_ctxt,
+       Scomp_compile_and_load_ctxt,
        0, 1, 0,
-       doc: /* Compile as native code the current context.  */)
+       doc: /* Compile as native code the current context and load its
+	       functions.  */)
      (Lisp_Object disassemble)
 {
   gcc_jit_context_set_int_option (comp.ctxt,
@@ -1852,7 +1854,7 @@ syms_of_comp (void)
   defsubr (&Scomp_init_ctxt);
   defsubr (&Scomp_release_ctxt);
   defsubr (&Scomp_add_func_to_ctxt);
-  defsubr (&Scomp_compile_ctxt);
+  defsubr (&Scomp_compile_and_load_ctxt);
   comp.func_hash = Qnil;
   staticpro (&comp.func_hash);