1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-13 09:32:47 +00:00

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.
This commit is contained in:
Andrea Corallo 2020-11-07 00:13:01 +01:00
parent acf101c636
commit 4a69e953f3
3 changed files with 39 additions and 25 deletions

View File

@ -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

View File

@ -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

View File

@ -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 =