feature/native-comp 4a69e95 2/2: Allow for native compilation qualities to be specified per input file

[Andrea Corallo]

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

    Allow for native compilation qualities to be specified per input file
    
        * lisp/emacs-lisp/bytecomp.el (byte-native-qualities): Define
        variable.
        (byte-compile-from-buffer): Spill compilation qualities.
        * lisp/emacs-lisp/comp.el (comp-speed, comp-debug): Make
        them file local variables.
        (comp-ctxt): Add `speed' and `debug' slots.
        (comp-spill-speed, comp-spill-lap-function): Make use of these.
        (comp-spill-lap-function): Spill qualities from
        `byte-native-qualities'.
        (comp-limplify-top-level): Do not use `comp-speed' but ctxt value
        unstead.
        (comp-final): Do not propagate qualities as they are already
        in the `comp-ctxt'.
        (comp--native-compile): Close on `byte-native-qualities'.
        * src/comp.c (comp_t): Add 'speed' and 'debug' fields.
        (emit_comment, emit_mvar_rval, emit_static_object)
        (emit_ctxt_code, Fcomp__init_ctxt): Use these instead of the
        global variables.
        (Fcomp__compile_ctxt_to_file): Set comp.speed and comp.debug and
        use them.
---
 lisp/emacs-lisp/bytecomp.el |  7 +++++++
 lisp/emacs-lisp/comp.el     | 25 +++++++++++++++++--------
 src/comp.c                  | 32 +++++++++++++++-----------------
 3 files changed, 39 insertions(+), 25 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index a3c830e..5508a60 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -598,6 +598,8 @@ Each element is (INDEX . VALUE)")
 
 (defvar byte-native-compiling nil
   "Non nil while native compiling.")
+(defvar byte-native-qualities nil
+  "To spill default qualities from the compiled file.")
 (defvar byte-native-for-bootstrap nil
   "Non nil while compiling for bootstrap."
   ;; During boostrap we produce both the .eln and the .elc together.
@@ -2216,6 +2218,11 @@ With argument ARG, insert value in current buffer after 
the form."
        (setq byte-compile-unresolved-functions nil)
         (setq byte-compile-noruntime-functions nil)
         (setq byte-compile-new-defuns nil)
+        (when byte-native-compiling
+          (defvar comp-speed)
+          (push `(comp-speed . ,comp-speed) byte-native-qualities)
+          (defvar comp-debug)
+          (push `(comp-debug . ,comp-debug) byte-native-qualities))
 
        ;; Compile the forms from the input buffer.
        (while (progn
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index bb32aef..9fbf60c 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -51,6 +51,7 @@
 - 3 max optimization level, to be used only when necessary.
     Warning: the compiler is free to perform dangerous optimizations."
   :type 'number
+  :safe #'numberp
   :group 'comp)
 
 (defcustom comp-debug 0
@@ -62,6 +63,7 @@ This intended for debugging the compiler itself.
 - 2 dump gcc passes and libgccjit log file.
 - 3 dump libgccjit reproducers."
   :type 'number
+  :safe #'numberp
   :group 'comp)
 
 (defcustom comp-verbose 0
@@ -256,6 +258,10 @@ Useful to hook into pass checkers.")
   "Lisp side of the compiler context."
   (output nil :type string
           :documentation "Target output file-name for the compilation.")
+  (speed comp-speed :type number
+         :documentation "Default speed for this compilation unit.")
+  (debug comp-debug :type number
+         :documentation "Default debug level for this compilation unit.")
   (top-level-forms () :type list
                    :documentation "List of spilled top level forms.")
   (funcs-h (make-hash-table :test #'equal) :type hash-table
@@ -605,7 +611,7 @@ instruction."
 (defun comp-spill-speed (function-name)
   "Return the speed for FUNCTION-NAME."
   (or (comp-spill-decl-spec function-name 'speed)
-      comp-speed))
+      (comp-ctxt-speed comp-ctxt)))
 
 ;; Autoloaded as might be used by `disassemble-internal'.
 ;;;###autoload
@@ -723,11 +729,11 @@ clashes."
                    (make-comp-func-l :c-name c-name
                                      :doc (documentation form t)
                                      :int-spec (interactive-form form)
-                                     :speed comp-speed)
+                                     :speed (comp-ctxt-speed comp-ctxt))
                  (make-comp-func-d :c-name c-name
                                    :doc (documentation form t)
                                    :int-spec (interactive-form form)
-                                   :speed comp-speed))))
+                                   :speed (comp-ctxt-speed comp-ctxt)))))
     (let ((lap (byte-to-native-lambda-lap
                 (gethash (aref byte-code 1)
                          byte-to-native-lambdas-h))))
@@ -798,7 +804,11 @@ clashes."
                                         filename
                                         (when byte-native-for-bootstrap
                                           (car (last comp-eln-load-path))))))
-  (setf (comp-ctxt-top-level-forms comp-ctxt)
+  (setf (comp-ctxt-speed comp-ctxt) (alist-get 'comp-speed
+                                               byte-native-qualities)
+        (comp-ctxt-debug comp-ctxt) (alist-get 'comp-debug
+                                               byte-native-qualities)
+        (comp-ctxt-top-level-forms comp-ctxt)
         (cl-loop
          for form in (reverse byte-to-native-top-level-forms)
          collect
@@ -1575,7 +1585,7 @@ into the C code forwarding the compilation unit."
                                  ;; the last function being
                                  ;; registered.
                                  :frame-size 2
-                                 :speed comp-speed))
+                                 :speed (comp-ctxt-speed comp-ctxt)))
          (comp-func func)
          (comp-pass (make-comp-limplify
                      :curr-block (make--comp-block-lap -1 0 'top-level)
@@ -2670,9 +2680,7 @@ Prepare every function for final compilation and drive 
the C back-end."
              (print-circle t)
              (expr `(progn
                       (require 'comp)
-                      (setf comp-speed ,comp-speed
-                            comp-debug ,comp-debug
-                            comp-verbose ,comp-verbose
+                      (setf comp-verbose ,comp-verbose
                             comp-ctxt ,comp-ctxt
                             comp-eln-load-path ',comp-eln-load-path
                             comp-native-driver-options
@@ -2988,6 +2996,7 @@ load once finished compiling."
             (list "Not a function symbol or file" function-or-file)))
   (let* ((data function-or-file)
          (comp-native-compiling t)
+         (byte-native-qualities nil)
          ;; Have byte compiler signal an error when compilation fails.
          (byte-compile-debug t)
          (comp-ctxt (make-comp-ctxt :output output
diff --git a/src/comp.c b/src/comp.c
index 48e4f1c..05ec073 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -423,10 +423,6 @@ load_gccjit_if_necessary (bool mandatory)
 #define TEXT_OPTIM_QLY_SYM "text_optim_qly"
 #define TEXT_FDOC_SYM "text_data_fdoc"
 
-
-#define COMP_SPEED XFIXNUM (Fsymbol_value (Qcomp_speed))
-#define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug))
-
 #define STR_VALUE(s) #s
 #define STR(s) STR_VALUE (s)
 
@@ -485,6 +481,8 @@ enum cast_kind_of_type
 /* C side of the compiler context.  */
 
 typedef struct {
+  EMACS_INT speed;
+  EMACS_INT debug;
   gcc_jit_context *ctxt;
   gcc_jit_type *void_type;
   gcc_jit_type *bool_type;
@@ -916,7 +914,7 @@ obj_to_reloc (Lisp_Object obj)
 static void
 emit_comment (const char *str)
 {
-  if (COMP_DEBUG)
+  if (comp.debug)
     gcc_jit_block_add_comment (comp.block,
                               NULL,
                               str);
@@ -1847,7 +1845,7 @@ emit_mvar_rval (Lisp_Object mvar)
 
   if (!NILP (const_vld))
     {
-      if (COMP_DEBUG > 1)
+      if (comp.debug > 1)
        {
          Lisp_Object func =
            Fgethash (constant,
@@ -2566,7 +2564,7 @@ emit_static_object (const char *name, Lisp_Object obj)
                                  0, NULL, 0);
   DECL_BLOCK (block, f);
 
-  if (COMP_DEBUG > 1)
+  if (comp.debug > 1)
     {
       char *comment = memcpy (xmalloc (len), p, len);
       for (ptrdiff_t i = 0; i < len - 1; i++)
@@ -2789,10 +2787,8 @@ emit_ctxt_code (void)
 {
   /* Emit optimize qualities.  */
   Lisp_Object opt_qly[] =
-    { Fcons (Qcomp_speed,
-            Fsymbol_value (Qcomp_speed)),
-      Fcons (Qcomp_debug,
-            Fsymbol_value (Qcomp_debug)),
+    { Fcons (Qcomp_speed, make_fixnum (comp.speed)),
+      Fcons (Qcomp_debug, make_fixnum (comp.debug)),
       Fcons (Qgccjit,
             Fcomp_libgccjit_version ()) };
   emit_static_object (TEXT_OPTIM_QLY_SYM, Flist (ARRAYELTS (opt_qly), 
opt_qly));
@@ -4212,13 +4208,13 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, 
Scomp__init_ctxt,
 
   comp.ctxt = gcc_jit_context_acquire ();
 
-  if (COMP_DEBUG)
+  if (comp.debug)
     {
       gcc_jit_context_set_bool_option (comp.ctxt,
                                       GCC_JIT_BOOL_OPTION_DEBUGINFO,
                                       1);
     }
-  if (COMP_DEBUG > 2)
+  if (comp.debug > 2)
     {
       logfile = fopen ("libgccjit.log", "w");
       gcc_jit_context_set_logfile (comp.ctxt,
@@ -4403,10 +4399,12 @@ DEFUN ("comp--compile-ctxt-to-file", 
Fcomp__compile_ctxt_to_file,
   CHECK_STRING (filename);
   Lisp_Object base_name = Fsubstring (filename, Qnil, make_fixnum (-4));
 
+  comp.speed = XFIXNUM (CALL1I (comp-ctxt-speed, Vcomp_ctxt));
+  comp.debug = XFIXNUM (CALL1I (comp-ctxt-debug, Vcomp_ctxt));
   gcc_jit_context_set_int_option (comp.ctxt,
                                  GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL,
-                                 COMP_SPEED < 0 ? 0
-                                 : (COMP_SPEED > 3 ? 3 : COMP_SPEED));
+                                 comp.speed < 0 ? 0
+                                 : (comp.speed > 3 ? 3 : comp.speed));
   comp.d_default_idx =
     CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt));
   comp.d_impure_idx =
@@ -4456,11 +4454,11 @@ DEFUN ("comp--compile-ctxt-to-file", 
Fcomp__compile_ctxt_to_file,
 
   add_driver_options ();
 
-  if (COMP_DEBUG)
+  if (comp.debug)
       gcc_jit_context_dump_to_file (comp.ctxt,
                                    format_string ("%s.c", SSDATA (base_name)),
                                    1);
-  if (COMP_DEBUG > 2)
+  if (comp.debug > 2)
     gcc_jit_context_dump_reproducer_to_file (comp.ctxt, "comp_reproducer.c");
 
   Lisp_Object tmp_file =