mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-06 11:50:51 -08:00
Code Issues Projects Releases Wiki Activity

* comp.el: Extend `native-compile-async' for load and late-load

Browse source
This commit is contained in:
Andrea Corallo 2020-03-18 19:52:36 +00:00
parent b53fc68535
commit c3e640bfa6
1 changed files with 34 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

50
lisp/emacs-lisp/comp.el
View file

@ -433,6 +433,21 @@ VERBOSITY is a number between 0 and 3."
2)) 2))
edges))) edges)))
(defun comp-output-base-filename (src)
"Output filename sans extention for SRC file being native compiled."
(let* ((expanded-filename (expand-file-name src))
(output-dir (file-name-as-directory
(concat (file-name-directory expanded-filename)
comp-native-path-postfix)))
(output-filename
(file-name-sans-extension
(file-name-nondirectory expanded-filename))))
(expand-file-name output-filename output-dir)))
(defun comp-output-filename (src)
"Output filename for SRC file being native compiled."
(concat (comp-output-base-filename src) ".eln"))
;;; spill-lap pass specific code. ;;; spill-lap pass specific code.
@ -2122,7 +2137,7 @@ display a message."
(> (comp-async-runnings) 0)) (> (comp-async-runnings) 0))
(unless (>= (comp-async-runnings) (comp-effective-async-max-jobs)) (unless (>= (comp-async-runnings) (comp-effective-async-max-jobs))
(cl-loop (cl-loop
for source-file = (pop comp-files-queue) for (source-file . load) = (pop comp-files-queue)
while source-file while source-file
do (cl-assert (string-match-p (rx ".el" eos) source-file) nil do (cl-assert (string-match-p (rx ".el" eos) source-file) nil
"`comp-files-queue' should be \".el\" files: %s" "`comp-files-queue' should be \".el\" files: %s"
@ -2136,7 +2151,9 @@ display a message."
comp-verbose ,comp-verbose comp-verbose ,comp-verbose
load-path ',load-path) load-path ',load-path)
(message "Compiling %s..." ,source-file) (message "Compiling %s..." ,source-file)
(native-compile ,source-file))) (native-compile ,source-file ,(and load t))))
(source-file1 source-file) ;; Make the closure works :/
(load1 load)
(process (make-process (process (make-process
:name (concat "Compiling: " source-file) :name (concat "Compiling: " source-file)
:buffer (get-buffer-create comp-async-buffer-name) :buffer (get-buffer-create comp-async-buffer-name)
@ -2149,6 +2166,10 @@ display a message."
'comp-async-cu-done-hook 'comp-async-cu-done-hook
source-file) source-file)
(accept-process-output process) (accept-process-output process)
(when load1
(native-elisp-load
(comp-output-filename source-file1)
load1))
(comp-run-async-workers))))) (comp-run-async-workers)))))
(push process comp-async-processes)) (push process comp-async-processes))
when (>= (comp-async-runnings) (comp-effective-async-max-jobs)) when (>= (comp-async-runnings) (comp-effective-async-max-jobs))
@ -2181,17 +2202,7 @@ Return the compilation unit file name."
(byte-compile-debug t) (byte-compile-debug t)
(comp-ctxt (comp-ctxt
(make-comp-ctxt (make-comp-ctxt
:output :output (comp-output-base-filename function-or-file)
(if (symbolp function-or-file)
(make-temp-file (concat (symbol-name function-or-file) "-"))
(let* ((expanded-filename (expand-file-name function-or-file))
(output-dir (file-name-as-directory
(concat (file-name-directory expanded-filename)
comp-native-path-postfix)))
(output-filename
(file-name-sans-extension
(file-name-nondirectory expanded-filename))))
(expand-file-name output-filename output-dir)))
:with-late-load with-late-load))) :with-late-load with-late-load)))
(comp-log "\n \n" 1) (comp-log "\n \n" 1)
(condition-case err (condition-case err
@ -2231,12 +2242,15 @@ Always generate elc files too and handle native compiler expected errors."
(rename-file tempfile target-file t)))))) (rename-file tempfile target-file t))))))
;;;###autoload ;;;###autoload
(defun native-compile-async (paths recursively) (defun native-compile-async (paths &optional recursively load)
"Compile PATHS asynchronously. "Compile PATHS asynchronously.
PATHS is one path or a list of paths to files or directories. PATHS is one path or a list of paths to files or directories.
`comp-async-jobs-number' specifies the number of (commands) to `comp-async-jobs-number' specifies the number of (commands) to
run simultaneously. If RECURSIVELY, recurse into subdirectories run simultaneously. If RECURSIVELY, recurse into subdirectories
of given directories." of given directories.
LOAD can be nil t or 'late."
(unless (member load '(nil t late))
(error "LOAD must be nil t or 'late"))
(unless (listp paths) (unless (listp paths)
(setf paths (list paths))) (setf paths (list paths)))
(let (files) (let (files)
@ -2250,7 +2264,11 @@ of given directories."
(t (signal 'native-compiler-error (t (signal 'native-compiler-error
(list "Path not a file nor directory" path))))) (list "Path not a file nor directory" path)))))
(dolist (file files) (dolist (file files)
(add-to-list 'comp-files-queue file t)) (if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=)))
(cl-assert (eq load (cdr entry))
nil "Incoherent load kind in compilation queue for %s"
file)
(setf comp-files-queue (append comp-files-queue `((,file . ,load))))))
(when (zerop (comp-async-runnings)) (when (zerop (comp-async-runnings))
(comp-run-async-workers)) (comp-run-async-workers))
(message "Compilation started."))) (message "Compilation started.")))