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:
parent
acf101c636
commit
4a69e953f3
@ -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
|
||||
|
@ -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
|
||||
|
32
src/comp.c
32
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 =
|
||||
|
Loading…
Reference in New Issue
Block a user