Merge remote-tracking branch 'origin/master' into feature/package+vc
This commit is contained in:
Philip Kaludercic
commit
65fa87329c
61 changed files with 2138 additions and 724 deletions
|
|
@ -481,6 +481,11 @@ convention was modified."
|
|||
(puthash (indirect-function function) signature
|
||||
advertised-signature-table))
|
||||
|
||||
(defun get-advertised-calling-convention (function)
|
||||
"Get the advertised SIGNATURE of FUNCTION.
|
||||
Return t if there isn't any."
|
||||
(gethash function advertised-signature-table t))
|
||||
|
||||
(defun make-obsolete (obsolete-name current-name when)
|
||||
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
|
||||
OBSOLETE-NAME should be a function name or macro name (a symbol).
|
||||
|
|
|
|||
|
|
@ -129,6 +129,7 @@
|
|||
;; us from emitting warnings when compiling files which use cl-lib without
|
||||
;; requiring it! (bug#30635)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(eval-when-compile (require 'subr-x))
|
||||
|
||||
;; The feature of compiling in a specific target Emacs version
|
||||
;; has been turned off because compile time options are a bad idea.
|
||||
|
|
@ -1185,27 +1186,22 @@ message buffer `default-directory'."
|
|||
(defun byte-compile--first-symbol-with-pos (form)
|
||||
"Return the first symbol with position in form, or nil if none.
|
||||
Order is by depth-first search."
|
||||
(cond
|
||||
((symbol-with-pos-p form) form)
|
||||
((consp form)
|
||||
(or (byte-compile--first-symbol-with-pos (car form))
|
||||
(let ((sym nil))
|
||||
(setq form (cdr form))
|
||||
(while (and (consp form)
|
||||
(not (setq sym (byte-compile--first-symbol-with-pos
|
||||
(car form)))))
|
||||
(setq form (cdr form)))
|
||||
(or sym
|
||||
(and form (byte-compile--first-symbol-with-pos form))))))
|
||||
((or (vectorp form) (recordp form))
|
||||
(let ((len (length form))
|
||||
(i 0)
|
||||
(sym nil))
|
||||
(while (and (< i len)
|
||||
(not (setq sym (byte-compile--first-symbol-with-pos
|
||||
(aref form i)))))
|
||||
(setq i (1+ i)))
|
||||
sym))))
|
||||
(named-let loop ((form form)
|
||||
(depth 10)) ;Arbitrary limit.
|
||||
(cond
|
||||
((<= depth 0) nil) ;Avoid cycles (bug#58601).
|
||||
((symbol-with-pos-p form) form)
|
||||
((consp form)
|
||||
(or (loop (car form) (1- depth))
|
||||
(loop (cdr form) (1- depth))))
|
||||
((or (vectorp form) (recordp form))
|
||||
(let ((len (length form))
|
||||
(i 0)
|
||||
(sym nil))
|
||||
(while (and (< i len)
|
||||
(not (setq sym (loop (aref form i) (1- depth)))))
|
||||
(setq i (1+ i)))
|
||||
sym)))))
|
||||
|
||||
(defun byte-compile--warning-source-offset ()
|
||||
"Return a source offset from `byte-compile-form-stack' or nil if none."
|
||||
|
|
@ -1405,11 +1401,11 @@ when printing the error message."
|
|||
(and (not macro-p)
|
||||
(compiled-function-p (symbol-function fn)))))
|
||||
(setq fn (symbol-function fn)))
|
||||
(let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
|
||||
;; Could be a subr.
|
||||
(symbol-function fn)
|
||||
fn)
|
||||
advertised-signature-table t)))
|
||||
(let ((advertised (get-advertised-calling-convention
|
||||
(if (and (symbolp fn) (fboundp fn))
|
||||
;; Could be a subr.
|
||||
(symbol-function fn)
|
||||
fn))))
|
||||
(cond
|
||||
((listp advertised)
|
||||
(if macro-p
|
||||
|
|
@ -2335,9 +2331,15 @@ With argument ARG, insert value in current buffer after the form."
|
|||
(setq case-fold-search nil))
|
||||
(displaying-byte-compile-warnings
|
||||
(with-current-buffer inbuffer
|
||||
(and byte-compile-current-file
|
||||
(byte-compile-insert-header byte-compile-current-file
|
||||
byte-compile--outbuffer))
|
||||
(when byte-compile-current-file
|
||||
(byte-compile-insert-header byte-compile-current-file
|
||||
byte-compile--outbuffer)
|
||||
;; Instruct native-comp to ignore this file.
|
||||
(when (bound-and-true-p no-native-compile)
|
||||
(with-current-buffer byte-compile--outbuffer
|
||||
(insert
|
||||
"(when (boundp 'comp--no-native-compile)
|
||||
(puthash load-file-name t comp--no-native-compile))\n\n"))))
|
||||
(goto-char (point-min))
|
||||
;; Should we always do this? When calling multiple files, it
|
||||
;; would be useful to delay this warning until all have been
|
||||
|
|
|
|||
|
|
@ -650,13 +650,17 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
|
|||
(cl--generic-name generic)
|
||||
qualifiers specializers))
|
||||
current-load-list :test #'equal)
|
||||
(let (;; Prevent `defalias' from recording this as the definition site of
|
||||
(let ((old-adv-cc (get-advertised-calling-convention
|
||||
(symbol-function sym)))
|
||||
;; Prevent `defalias' from recording this as the definition site of
|
||||
;; the generic function.
|
||||
current-load-list
|
||||
;; BEWARE! Don't purify this function definition, since that leads
|
||||
;; to memory corruption if the hash-tables it holds are modified
|
||||
;; (the GC doesn't trace those pointers).
|
||||
(purify-flag nil))
|
||||
(when (listp old-adv-cc)
|
||||
(set-advertised-calling-convention gfun old-adv-cc nil))
|
||||
;; But do use `defalias', so that it interacts properly with nadvice,
|
||||
;; e.g. for tracing/debug-on-entry.
|
||||
(defalias sym gfun)))))
|
||||
|
|
|
|||
|
|
@ -687,6 +687,9 @@ Useful to hook into pass checkers.")
|
|||
'native-compiler-error)
|
||||
|
||||
|
||||
(defvar comp-no-spawn nil
|
||||
"Non-nil don't spawn native compilation processes.")
|
||||
|
||||
;; Moved early to avoid circularity when comp.el is loaded and
|
||||
;; `macroexpand' needs to be advised (bug#47049).
|
||||
;;;###autoload
|
||||
|
|
@ -696,12 +699,9 @@ Useful to hook into pass checkers.")
|
|||
(memq subr-name native-comp-never-optimize-functions)
|
||||
(gethash subr-name comp-installed-trampolines-h))
|
||||
(cl-assert (subr-primitive-p (symbol-function subr-name)))
|
||||
(comp--install-trampoline
|
||||
subr-name
|
||||
(or (comp-trampoline-search subr-name)
|
||||
(comp-trampoline-compile subr-name)
|
||||
;; Should never happen.
|
||||
(cl-assert nil)))))
|
||||
(when-let ((trampoline (or (comp-trampoline-search subr-name)
|
||||
(comp-trampoline-compile subr-name))))
|
||||
(comp--install-trampoline subr-name trampoline))))
|
||||
|
||||
|
||||
(cl-defstruct (comp-vec (:copier nil))
|
||||
|
|
@ -3689,7 +3689,8 @@ Prepare every function for final compilation and drive the C back-end."
|
|||
(print-circle t)
|
||||
(print-escape-multibyte t)
|
||||
(expr `((require 'comp)
|
||||
(setf native-comp-verbose ,native-comp-verbose
|
||||
(setf comp-no-spawn t
|
||||
native-comp-verbose ,native-comp-verbose
|
||||
comp-libgccjit-reproducer ,comp-libgccjit-reproducer
|
||||
comp-ctxt ,comp-ctxt
|
||||
native-comp-eln-load-path ',native-comp-eln-load-path
|
||||
|
|
@ -3945,8 +3946,9 @@ display a message."
|
|||
(file-newer-than-file-p
|
||||
source-file (comp-el-to-eln-filename source-file))))
|
||||
do (let* ((expr `((require 'comp)
|
||||
(setq comp-async-compilation t)
|
||||
(setq warning-fill-column most-positive-fixnum)
|
||||
(setq comp-async-compilation t
|
||||
comp-no-spawn t
|
||||
warning-fill-column most-positive-fixnum)
|
||||
,(let ((set (list 'setq)))
|
||||
(dolist (var '(comp-file-preloaded-p
|
||||
native-compile-target-directory
|
||||
|
|
@ -4046,72 +4048,73 @@ the deferred compilation mechanism."
|
|||
(stringp function-or-file))
|
||||
(signal 'native-compiler-error
|
||||
(list "Not a function symbol or file" function-or-file)))
|
||||
(catch 'no-native-compile
|
||||
(let* ((print-symbols-bare t)
|
||||
(data function-or-file)
|
||||
(comp-native-compiling t)
|
||||
(byte-native-qualities nil)
|
||||
(symbols-with-pos-enabled t)
|
||||
;; Have byte compiler signal an error when compilation fails.
|
||||
(byte-compile-debug t)
|
||||
(comp-ctxt (make-comp-ctxt :output output
|
||||
:with-late-load with-late-load)))
|
||||
(comp-log "\n \n" 1)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(condition-case err
|
||||
(cl-loop
|
||||
with report = nil
|
||||
for t0 = (current-time)
|
||||
for pass in comp-passes
|
||||
unless (memq pass comp-disabled-passes)
|
||||
do
|
||||
(comp-log (format "(%s) Running pass %s:\n"
|
||||
function-or-file pass)
|
||||
2)
|
||||
(setf data (funcall pass data))
|
||||
(push (cons pass (float-time (time-since t0))) report)
|
||||
(cl-loop for f in (alist-get pass comp-post-pass-hooks)
|
||||
do (funcall f data))
|
||||
finally
|
||||
(when comp-log-time-report
|
||||
(comp-log (format "Done compiling %s" data) 0)
|
||||
(cl-loop for (pass . time) in (reverse report)
|
||||
do (comp-log (format "Pass %s took: %fs."
|
||||
pass time) 0))))
|
||||
(native-compiler-skip)
|
||||
(t
|
||||
(let ((err-val (cdr err)))
|
||||
;; If we are doing an async native compilation print the
|
||||
;; error in the correct format so is parsable and abort.
|
||||
(if (and comp-async-compilation
|
||||
(not (eq (car err) 'native-compiler-error)))
|
||||
(progn
|
||||
(message (if err-val
|
||||
"%s: Error: %s %s"
|
||||
"%s: Error %s")
|
||||
function-or-file
|
||||
(get (car err) 'error-message)
|
||||
(car-safe err-val))
|
||||
(kill-emacs -1))
|
||||
;; Otherwise re-signal it adding the compilation input.
|
||||
(signal (car err) (if (consp err-val)
|
||||
(cons function-or-file err-val)
|
||||
(list function-or-file err-val)))))))
|
||||
(if (stringp function-or-file)
|
||||
data
|
||||
;; So we return the compiled function.
|
||||
(native-elisp-load data)))
|
||||
;; We may have created a temporary file when we're being
|
||||
;; called with something other than a file as the argument.
|
||||
;; Delete it.
|
||||
(when (and (not (stringp function-or-file))
|
||||
(not output)
|
||||
comp-ctxt
|
||||
(comp-ctxt-output comp-ctxt)
|
||||
(file-exists-p (comp-ctxt-output comp-ctxt)))
|
||||
(message "Deleting %s" (comp-ctxt-output comp-ctxt))
|
||||
(delete-file (comp-ctxt-output comp-ctxt)))))))
|
||||
(unless comp-no-spawn
|
||||
(catch 'no-native-compile
|
||||
(let* ((print-symbols-bare t)
|
||||
(data function-or-file)
|
||||
(comp-native-compiling t)
|
||||
(byte-native-qualities nil)
|
||||
(symbols-with-pos-enabled t)
|
||||
;; Have byte compiler signal an error when compilation fails.
|
||||
(byte-compile-debug t)
|
||||
(comp-ctxt (make-comp-ctxt :output output
|
||||
:with-late-load with-late-load)))
|
||||
(comp-log "\n \n" 1)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(condition-case err
|
||||
(cl-loop
|
||||
with report = nil
|
||||
for t0 = (current-time)
|
||||
for pass in comp-passes
|
||||
unless (memq pass comp-disabled-passes)
|
||||
do
|
||||
(comp-log (format "(%s) Running pass %s:\n"
|
||||
function-or-file pass)
|
||||
2)
|
||||
(setf data (funcall pass data))
|
||||
(push (cons pass (float-time (time-since t0))) report)
|
||||
(cl-loop for f in (alist-get pass comp-post-pass-hooks)
|
||||
do (funcall f data))
|
||||
finally
|
||||
(when comp-log-time-report
|
||||
(comp-log (format "Done compiling %s" data) 0)
|
||||
(cl-loop for (pass . time) in (reverse report)
|
||||
do (comp-log (format "Pass %s took: %fs."
|
||||
pass time) 0))))
|
||||
(native-compiler-skip)
|
||||
(t
|
||||
(let ((err-val (cdr err)))
|
||||
;; If we are doing an async native compilation print the
|
||||
;; error in the correct format so is parsable and abort.
|
||||
(if (and comp-async-compilation
|
||||
(not (eq (car err) 'native-compiler-error)))
|
||||
(progn
|
||||
(message (if err-val
|
||||
"%s: Error: %s %s"
|
||||
"%s: Error %s")
|
||||
function-or-file
|
||||
(get (car err) 'error-message)
|
||||
(car-safe err-val))
|
||||
(kill-emacs -1))
|
||||
;; Otherwise re-signal it adding the compilation input.
|
||||
(signal (car err) (if (consp err-val)
|
||||
(cons function-or-file err-val)
|
||||
(list function-or-file err-val)))))))
|
||||
(if (stringp function-or-file)
|
||||
data
|
||||
;; So we return the compiled function.
|
||||
(native-elisp-load data)))
|
||||
;; We may have created a temporary file when we're being
|
||||
;; called with something other than a file as the argument.
|
||||
;; Delete it.
|
||||
(when (and (not (stringp function-or-file))
|
||||
(not output)
|
||||
comp-ctxt
|
||||
(comp-ctxt-output comp-ctxt)
|
||||
(file-exists-p (comp-ctxt-output comp-ctxt)))
|
||||
(message "Deleting %s" (comp-ctxt-output comp-ctxt))
|
||||
(delete-file (comp-ctxt-output comp-ctxt))))))))
|
||||
|
||||
(defun native-compile-async-skip-p (file load selector)
|
||||
"Return non-nil if FILE's compilation should be skipped.
|
||||
|
|
@ -4119,6 +4122,7 @@ the deferred compilation mechanism."
|
|||
LOAD and SELECTOR work as described in `native--compile-async'."
|
||||
;; Make sure we are not already compiling `file' (bug#40838).
|
||||
(or (gethash file comp-async-compilations)
|
||||
(gethash (file-name-with-extension file "elc") comp--no-native-compile)
|
||||
(cond
|
||||
((null selector) nil)
|
||||
((functionp selector) (not (funcall selector file)))
|
||||
|
|
@ -4166,7 +4170,8 @@ bytecode definition was not changed in the meantime)."
|
|||
(error "LOAD must be nil, t or 'late"))
|
||||
(unless (listp files)
|
||||
(setf files (list files)))
|
||||
(let (file-list)
|
||||
(let ((added-something nil)
|
||||
file-list)
|
||||
(dolist (file-or-dir files)
|
||||
(cond ((file-directory-p file-or-dir)
|
||||
(dolist (file (if recursively
|
||||
|
|
@ -4194,11 +4199,15 @@ bytecode definition was not changed in the meantime)."
|
|||
(make-directory out-dir t))
|
||||
(if (file-writable-p out-filename)
|
||||
(setf comp-files-queue
|
||||
(append comp-files-queue `((,file . ,load))))
|
||||
(append comp-files-queue `((,file . ,load)))
|
||||
added-something t)
|
||||
(display-warning 'comp
|
||||
(format "No write access for %s skipping."
|
||||
out-filename)))))))
|
||||
(when (zerop (comp-async-runnings))
|
||||
;; Perhaps nothing passed `native-compile-async-skip-p'?
|
||||
(when (and added-something
|
||||
;; Don't start if there's one already running.
|
||||
(zerop (comp-async-runnings)))
|
||||
(comp-run-async-workers))))
|
||||
|
||||
|
||||
|
|
@ -4234,14 +4243,13 @@ Search happens in `native-comp-eln-load-path'."
|
|||
(defun native-compile (function-or-file &optional output)
|
||||
"Compile FUNCTION-OR-FILE into native code.
|
||||
This is the synchronous entry-point for the Emacs Lisp native
|
||||
compiler.
|
||||
FUNCTION-OR-FILE is a function symbol, a form, or the filename of
|
||||
an Emacs Lisp source file.
|
||||
If OUTPUT is non-nil, use it as the filename for the compiled
|
||||
object.
|
||||
If FUNCTION-OR-FILE is a filename, return the filename of the
|
||||
compiled object. If FUNCTION-OR-FILE is a function symbol or a
|
||||
form, return the compiled function."
|
||||
compiler. FUNCTION-OR-FILE is a function symbol, a form, or the
|
||||
filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
|
||||
it as the filename for the compiled object. If FUNCTION-OR-FILE
|
||||
is a filename, if the compilation was successful return the
|
||||
filename of the compiled object. If FUNCTION-OR-FILE is a
|
||||
function symbol or a form, if the compilation was successful
|
||||
return the compiled function."
|
||||
(comp--native-compile function-or-file nil output))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -4328,13 +4336,15 @@ of (commands) to run simultaneously."
|
|||
;; `invocation-directory'.
|
||||
(setq dir (expand-file-name dir invocation-directory))
|
||||
(when (file-exists-p dir)
|
||||
(dolist (subdir (directory-files dir t))
|
||||
(dolist (subdir (seq-filter
|
||||
(lambda (f) (not (string-match (rx "/." (? ".") eos) f)))
|
||||
(directory-files dir t)))
|
||||
(when (and (file-directory-p subdir)
|
||||
(file-writable-p subdir)
|
||||
(not (equal (file-name-nondirectory
|
||||
(directory-file-name subdir))
|
||||
comp-native-version-dir)))
|
||||
(message "Deleting %s..." subdir)
|
||||
(message "Deleting `%s'..." subdir)
|
||||
;; We're being overly cautious here -- there shouldn't be
|
||||
;; anything but .eln files in these directories.
|
||||
(dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'"))
|
||||
|
|
|
|||
|
|
@ -738,12 +738,12 @@ rules for built-in packages and excluded files."
|
|||
(expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory)
|
||||
output-file)))
|
||||
(let ((lisp-mode-autoload-regexp
|
||||
"^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)"))
|
||||
"^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)"))
|
||||
(loaddefs-generate
|
||||
(expand-file-name "../etc/themes/" lisp-directory)
|
||||
(expand-file-name "theme-loaddefs.el" lisp-directory))))
|
||||
|
||||
;;;###autoload (load "theme-loaddefs.el")
|
||||
;;;###autoload (load "theme-loaddefs.el" t)
|
||||
|
||||
(provide 'loaddefs-gen)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue