comp: Add comp-common.el
* lisp/emacs-lisp/comp-common.el: New file. (comp-common): New group. (native-comp-verbose, native-comp-never-optimize-functions) (native-comp-async-env-modifier-form, comp-limple-calls) (comp-limple-sets, comp-limple-assignments) (comp-limple-branches, comp-limple-ops) (comp-limple-lock-keywords, comp-log-buffer-name, comp-log) (native-comp-limple-mode, comp-log-to-buffer) (comp-ensure-native-compiler, comp-trampoline-filename) (comp-eln-load-path-eff): Move here * lisp/emacs-lisp/comp-run.el (comp-common): Require. * lisp/emacs-lisp/comp.el (comp-common): Require. * admin/MAINTAINERS: Add comp-common.el * lisp/Makefile.in (COMPILE_FIRST): Likewise. * src/Makefile.in (elnlisp): Likewise.
This commit is contained in:
Andrea Corallo
parent
b2416d2c02
commit
c559f4e368
6 changed files with 192 additions and 150 deletions
|
|
@ -133,6 +133,7 @@ Andrea Corallo
|
|||
Lisp native compiler
|
||||
src/comp.c
|
||||
lisp/emacs-lisp/comp.el
|
||||
lisp/emacs-lisp/comp-common.el
|
||||
lisp/emacs-lisp/comp-run.el
|
||||
lisp/emacs-lisp/comp-cstr.el
|
||||
test/src/comp-*.el
|
||||
|
|
|
|||
|
|
@ -95,6 +95,7 @@ COMPILE_FIRST = \
|
|||
ifeq ($(HAVE_NATIVE_COMP),yes)
|
||||
COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc
|
||||
COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc
|
||||
COMPILE_FIRST += $(lisp)/emacs-lisp/comp-common.elc
|
||||
COMPILE_FIRST += $(lisp)/emacs-lisp/comp-run.elc
|
||||
endif
|
||||
COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc
|
||||
|
|
|
|||
187
lisp/emacs-lisp/comp-common.el
Normal file
187
lisp/emacs-lisp/comp-common.el
Normal file
|
|
@ -0,0 +1,187 @@
|
|||
;;; comp-common.el --- common code -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2023 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andrea Corallo <acorallo@gnu.org>
|
||||
;; Keywords: lisp
|
||||
;; Package: emacs
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file holds common code required by comp.el and comp-run.el.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(defgroup comp-common nil
|
||||
"Emacs Lisp native compiler common code."
|
||||
:group 'lisp)
|
||||
|
||||
(defcustom native-comp-verbose 0
|
||||
"Compiler verbosity for native compilation, a number between 0 and 3.
|
||||
This is intended for debugging the compiler itself.
|
||||
0 no logging.
|
||||
1 final LIMPLE is logged.
|
||||
2 LAP, final LIMPLE, and some pass info are logged.
|
||||
3 max verbosity."
|
||||
:type 'natnum
|
||||
:risky t
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-never-optimize-functions
|
||||
'(;; The following two are mandatory for Emacs to be working
|
||||
;; correctly (see comment in `advice--add-function'). DO NOT
|
||||
;; REMOVE.
|
||||
macroexpand rename-buffer)
|
||||
"Primitive functions to exclude from trampoline optimization.
|
||||
|
||||
Primitive functions included in this list will not be called
|
||||
directly by the natively-compiled code, which makes trampolines for
|
||||
those primitives unnecessary in case of function redefinition/advice."
|
||||
:type '(repeat symbol)
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-async-env-modifier-form nil
|
||||
"Form evaluated before compilation by each asynchronous compilation subprocess.
|
||||
Used to modify the compiler environment."
|
||||
:type 'sexp
|
||||
:risky t
|
||||
:version "28.1")
|
||||
|
||||
(defconst comp-limple-calls '(call
|
||||
callref
|
||||
direct-call
|
||||
direct-callref)
|
||||
"Limple operators used to call subrs.")
|
||||
|
||||
(defconst comp-limple-sets '(set
|
||||
setimm
|
||||
set-par-to-local
|
||||
set-args-to-local
|
||||
set-rest-args-to-local)
|
||||
"Limple set operators.")
|
||||
|
||||
(defconst comp-limple-assignments `(assume
|
||||
fetch-handler
|
||||
,@comp-limple-sets)
|
||||
"Limple operators that clobber the first m-var argument.")
|
||||
|
||||
(defconst comp-limple-branches '(jump cond-jump)
|
||||
"Limple operators used for conditional and unconditional branches.")
|
||||
|
||||
(defconst comp-limple-ops `(,@comp-limple-calls
|
||||
,@comp-limple-assignments
|
||||
,@comp-limple-branches
|
||||
return)
|
||||
"All Limple operators.")
|
||||
|
||||
(defconst comp-limple-lock-keywords
|
||||
`((,(rx bol "(comment" (1+ not-newline)) . font-lock-comment-face)
|
||||
(,(rx "#(" (group-n 1 "mvar"))
|
||||
(1 font-lock-function-name-face))
|
||||
(,(rx bol "(" (group-n 1 "phi"))
|
||||
(1 font-lock-variable-name-face))
|
||||
(,(rx bol "(" (group-n 1 (or "return" "unreachable")))
|
||||
(1 font-lock-warning-face))
|
||||
(,(rx (group-n 1 (or "entry"
|
||||
(seq (or "entry_" "entry_fallback_" "bb_")
|
||||
(1+ num) (? (or "_latch"
|
||||
(seq "_cstrs_" (1+ num))))))))
|
||||
(1 font-lock-constant-face))
|
||||
(,(rx-to-string
|
||||
`(seq "(" (group-n 1 (or ,@(mapcar #'symbol-name comp-limple-ops)))))
|
||||
(1 font-lock-keyword-face)))
|
||||
"Highlights used by `native-comp-limple-mode'.")
|
||||
|
||||
(defconst comp-log-buffer-name "*Native-compile-Log*"
|
||||
"Name of the native-compiler log buffer.")
|
||||
|
||||
(cl-defun comp-log (data &optional (level 1) quoted)
|
||||
"Log DATA at LEVEL.
|
||||
LEVEL is a number from 1-3, and defaults to 1; if it is less
|
||||
than `native-comp-verbose', do nothing. If `noninteractive', log
|
||||
with `message'. Otherwise, log with `comp-log-to-buffer'."
|
||||
(when (>= native-comp-verbose level)
|
||||
(if noninteractive
|
||||
(cl-typecase data
|
||||
(atom (message "%s" data))
|
||||
(t (dolist (elem data)
|
||||
(message "%s" elem))))
|
||||
(comp-log-to-buffer data quoted))))
|
||||
|
||||
(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE"
|
||||
"Syntax-highlight LIMPLE IR."
|
||||
(setf font-lock-defaults '(comp-limple-lock-keywords)))
|
||||
|
||||
(cl-defun comp-log-to-buffer (data &optional quoted)
|
||||
"Log DATA to `comp-log-buffer-name'."
|
||||
(let* ((print-f (if quoted #'prin1 #'princ))
|
||||
(log-buffer
|
||||
(or (get-buffer comp-log-buffer-name)
|
||||
(with-current-buffer (get-buffer-create comp-log-buffer-name)
|
||||
(unless (derived-mode-p 'compilation-mode)
|
||||
(emacs-lisp-compilation-mode))
|
||||
(current-buffer))))
|
||||
(log-window (get-buffer-window log-buffer))
|
||||
(inhibit-read-only t)
|
||||
at-end-p)
|
||||
(with-current-buffer log-buffer
|
||||
(unless (eq major-mode 'native-comp-limple-mode)
|
||||
(native-comp-limple-mode))
|
||||
(when (= (point) (point-max))
|
||||
(setf at-end-p t))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(cl-typecase data
|
||||
(atom (funcall print-f data log-buffer))
|
||||
(t (dolist (elem data)
|
||||
(funcall print-f elem log-buffer)
|
||||
(insert "\n"))))
|
||||
(insert "\n"))
|
||||
(when (and at-end-p log-window)
|
||||
;; When log window's point is at the end, follow the tail.
|
||||
(with-selected-window log-window
|
||||
(goto-char (point-max)))))))
|
||||
|
||||
(defun comp-ensure-native-compiler ()
|
||||
"Make sure Emacs has native compiler support and libgccjit can be loaded.
|
||||
Signal an error otherwise.
|
||||
To be used by all entry points."
|
||||
(cond
|
||||
((null (featurep 'native-compile))
|
||||
(error "Emacs was not compiled with native compiler support (--with-native-compilation)"))
|
||||
((null (native-comp-available-p))
|
||||
(error "Cannot find libgccjit library"))))
|
||||
|
||||
(defun comp-trampoline-filename (subr-name)
|
||||
"Given SUBR-NAME return the filename containing the trampoline."
|
||||
(concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln"))
|
||||
|
||||
(defun comp-eln-load-path-eff ()
|
||||
"Return a list of effective eln load directories.
|
||||
Account for `native-comp-eln-load-path' and `comp-native-version-dir'."
|
||||
(mapcar (lambda (dir)
|
||||
(expand-file-name comp-native-version-dir
|
||||
(file-name-as-directory
|
||||
(expand-file-name dir invocation-directory))))
|
||||
native-comp-eln-load-path))
|
||||
|
||||
(provide 'comp-common)
|
||||
|
||||
;;; comp-common.el ends here
|
||||
|
|
@ -32,6 +32,7 @@
|
|||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(require 'comp-common)
|
||||
|
||||
(defgroup comp-run nil
|
||||
"Emacs Lisp native compiler runtime."
|
||||
|
|
@ -96,13 +97,6 @@ compilation has completed."
|
|||
:type 'hook
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-async-env-modifier-form nil
|
||||
"Form evaluated before compilation by each asynchronous compilation subprocess.
|
||||
Used to modify the compiler environment."
|
||||
:type 'sexp
|
||||
:risky t
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-async-query-on-exit nil
|
||||
"Whether to query the user about killing async compilations when exiting.
|
||||
If this is non-nil, Emacs will ask for confirmation to exit and kill the
|
||||
|
|
@ -112,33 +106,6 @@ if `confirm-kill-processes' is non-nil."
|
|||
:type 'boolean
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-verbose 0
|
||||
"Compiler verbosity for native compilation, a number between 0 and 3.
|
||||
This is intended for debugging the compiler itself.
|
||||
0 no logging.
|
||||
1 final LIMPLE is logged.
|
||||
2 LAP, final LIMPLE, and some pass info are logged.
|
||||
3 max verbosity."
|
||||
:type 'natnum
|
||||
:risky t
|
||||
:version "28.1")
|
||||
|
||||
(defcustom native-comp-never-optimize-functions
|
||||
'(;; The following two are mandatory for Emacs to be working
|
||||
;; correctly (see comment in `advice--add-function'). DO NOT
|
||||
;; REMOVE.
|
||||
macroexpand rename-buffer)
|
||||
"Primitive functions to exclude from trampoline optimization.
|
||||
|
||||
Primitive functions included in this list will not be called
|
||||
directly by the natively-compiled code, which makes trampolines for
|
||||
those primitives unnecessary in case of function redefinition/advice."
|
||||
:type '(repeat symbol)
|
||||
:version "28.1")
|
||||
|
||||
(defconst comp-log-buffer-name "*Native-compile-Log*"
|
||||
"Name of the native-compiler log buffer.")
|
||||
|
||||
(defconst comp-async-buffer-name "*Async-native-compile-log*"
|
||||
"Name of the async compilation buffer log.")
|
||||
|
||||
|
|
@ -148,63 +115,6 @@ those primitives unnecessary in case of function redefinition/advice."
|
|||
(defvar comp-async-compilations (make-hash-table :test #'equal)
|
||||
"Hash table file-name -> async compilation process.")
|
||||
|
||||
(cl-defun comp-log (data &optional (level 1) quoted)
|
||||
"Log DATA at LEVEL.
|
||||
LEVEL is a number from 1-3, and defaults to 1; if it is less
|
||||
than `native-comp-verbose', do nothing. If `noninteractive', log
|
||||
with `message'. Otherwise, log with `comp-log-to-buffer'."
|
||||
(when (>= native-comp-verbose level)
|
||||
(if noninteractive
|
||||
(cl-typecase data
|
||||
(atom (message "%s" data))
|
||||
(t (dolist (elem data)
|
||||
(message "%s" elem))))
|
||||
(comp-log-to-buffer data quoted))))
|
||||
|
||||
(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE"
|
||||
"Syntax-highlight LIMPLE IR."
|
||||
(setf font-lock-defaults '(comp-limple-lock-keywords)))
|
||||
|
||||
(cl-defun comp-log-to-buffer (data &optional quoted)
|
||||
"Log DATA to `comp-log-buffer-name'."
|
||||
(let* ((print-f (if quoted #'prin1 #'princ))
|
||||
(log-buffer
|
||||
(or (get-buffer comp-log-buffer-name)
|
||||
(with-current-buffer (get-buffer-create comp-log-buffer-name)
|
||||
(unless (derived-mode-p 'compilation-mode)
|
||||
(emacs-lisp-compilation-mode))
|
||||
(current-buffer))))
|
||||
(log-window (get-buffer-window log-buffer))
|
||||
(inhibit-read-only t)
|
||||
at-end-p)
|
||||
(with-current-buffer log-buffer
|
||||
(unless (eq major-mode 'native-comp-limple-mode)
|
||||
(native-comp-limple-mode))
|
||||
(when (= (point) (point-max))
|
||||
(setf at-end-p t))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(cl-typecase data
|
||||
(atom (funcall print-f data log-buffer))
|
||||
(t (dolist (elem data)
|
||||
(funcall print-f elem log-buffer)
|
||||
(insert "\n"))))
|
||||
(insert "\n"))
|
||||
(when (and at-end-p log-window)
|
||||
;; When log window's point is at the end, follow the tail.
|
||||
(with-selected-window log-window
|
||||
(goto-char (point-max)))))))
|
||||
|
||||
(defun comp-ensure-native-compiler ()
|
||||
"Make sure Emacs has native compiler support and libgccjit can be loaded.
|
||||
Signal an error otherwise.
|
||||
To be used by all entry points."
|
||||
(cond
|
||||
((null (featurep 'native-compile))
|
||||
(error "Emacs was not compiled with native compiler support (--with-native-compilation)"))
|
||||
((null (native-comp-available-p))
|
||||
(error "Cannot find libgccjit library"))))
|
||||
|
||||
(defun native-compile-async-skip-p (file load selector)
|
||||
"Return non-nil if FILE's compilation should be skipped.
|
||||
|
||||
|
|
@ -406,19 +316,6 @@ display a message."
|
|||
"List of primitives we want to warn about in case of redefinition.
|
||||
This are essential for the trampoline machinery to work properly.")
|
||||
|
||||
(defun comp-trampoline-filename (subr-name)
|
||||
"Given SUBR-NAME return the filename containing the trampoline."
|
||||
(concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln"))
|
||||
|
||||
(defun comp-eln-load-path-eff ()
|
||||
"Return a list of effective eln load directories.
|
||||
Account for `native-comp-eln-load-path' and `comp-native-version-dir'."
|
||||
(mapcar (lambda (dir)
|
||||
(expand-file-name comp-native-version-dir
|
||||
(file-name-as-directory
|
||||
(expand-file-name dir invocation-directory))))
|
||||
native-comp-eln-load-path))
|
||||
|
||||
(defun comp-trampoline-search (subr-name)
|
||||
"Search a trampoline file for SUBR-NAME.
|
||||
Return the trampoline if found or nil otherwise."
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@
|
|||
(require 'rx)
|
||||
(require 'subr-x)
|
||||
(require 'warnings)
|
||||
(require 'comp-run)
|
||||
(require 'comp-common)
|
||||
(require 'comp-cstr)
|
||||
|
||||
;; These variables and functions are defined in comp.c
|
||||
|
|
@ -587,33 +587,6 @@ Useful to hook into pass checkers.")
|
|||
comp-hint-cons)
|
||||
"List of fake functions used to give compiler hints.")
|
||||
|
||||
(defconst comp-limple-sets '(set
|
||||
setimm
|
||||
set-par-to-local
|
||||
set-args-to-local
|
||||
set-rest-args-to-local)
|
||||
"Limple set operators.")
|
||||
|
||||
(defconst comp-limple-assignments `(assume
|
||||
fetch-handler
|
||||
,@comp-limple-sets)
|
||||
"Limple operators that clobber the first m-var argument.")
|
||||
|
||||
(defconst comp-limple-calls '(call
|
||||
callref
|
||||
direct-call
|
||||
direct-callref)
|
||||
"Limple operators used to call subrs.")
|
||||
|
||||
(defconst comp-limple-branches '(jump cond-jump)
|
||||
"Limple operators used for conditional and unconditional branches.")
|
||||
|
||||
(defconst comp-limple-ops `(,@comp-limple-calls
|
||||
,@comp-limple-assignments
|
||||
,@comp-limple-branches
|
||||
return)
|
||||
"All Limple operators.")
|
||||
|
||||
(defvar comp-func nil
|
||||
"Bound to the current function by most passes.")
|
||||
|
||||
|
|
@ -965,24 +938,6 @@ Assume allocation class `d-default' as default."
|
|||
|
||||
;;; Log routines.
|
||||
|
||||
(defconst comp-limple-lock-keywords
|
||||
`((,(rx bol "(comment" (1+ not-newline)) . font-lock-comment-face)
|
||||
(,(rx "#(" (group-n 1 "mvar"))
|
||||
(1 font-lock-function-name-face))
|
||||
(,(rx bol "(" (group-n 1 "phi"))
|
||||
(1 font-lock-variable-name-face))
|
||||
(,(rx bol "(" (group-n 1 (or "return" "unreachable")))
|
||||
(1 font-lock-warning-face))
|
||||
(,(rx (group-n 1 (or "entry"
|
||||
(seq (or "entry_" "entry_fallback_" "bb_")
|
||||
(1+ num) (? (or "_latch"
|
||||
(seq "_cstrs_" (1+ num))))))))
|
||||
(1 font-lock-constant-face))
|
||||
(,(rx-to-string
|
||||
`(seq "(" (group-n 1 (or ,@(mapcar #'symbol-name comp-limple-ops)))))
|
||||
(1 font-lock-keyword-face)))
|
||||
"Highlights used by `native-comp-limple-mode'.")
|
||||
|
||||
(defun comp-prettyformat-mvar (mvar)
|
||||
(format "#(mvar %s %s %S)"
|
||||
(comp-mvar-id mvar)
|
||||
|
|
|
|||
|
|
@ -943,6 +943,7 @@ elnlisp := \
|
|||
international/charscript.eln \
|
||||
emacs-lisp/comp.eln \
|
||||
emacs-lisp/comp-cstr.eln \
|
||||
emacs-lisp/comp-common.eln \
|
||||
emacs-lisp/comp-run.eln \
|
||||
international/emoji-zwj.eln
|
||||
elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue