]> git.eshelyaron.com Git - emacs.git/commitdiff
comp: Add comp-common.el
authorAndrea Corallo <acorallo@gnu.org>
Wed, 8 Nov 2023 15:19:18 +0000 (16:19 +0100)
committerAndrea Corallo <acorallo@gnu.org>
Thu, 9 Nov 2023 11:34:26 +0000 (12:34 +0100)
* 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.

admin/MAINTAINERS
lisp/Makefile.in
lisp/emacs-lisp/comp-common.el [new file with mode: 0644]
lisp/emacs-lisp/comp-run.el
lisp/emacs-lisp/comp.el
src/Makefile.in

index fbb89f66006efd253a56be019258779d76e9d51a..f59c684e81fc709b82a696630efb4854ec545a1c 100644 (file)
@@ -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
index 446af922d346bdaef6a29c397fb237b8b32ebc62..0059305cc80ec778da9a5b38911936de6a21a6b5 100644 (file)
@@ -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
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el
new file mode 100644 (file)
index 0000000..6da2a98
--- /dev/null
@@ -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
index 512cadf4cabccf1863b99fbb020b0fc9b91c0a22..87fb46d9aa91a728b7984c70b4b3f7d19ae0a350 100644 (file)
@@ -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."
index 457960b2198de954b703f2d945217df7e9b74964..017af49b658bd8a0dbb5155ff4f018ed57d512d6 100644 (file)
@@ -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."
 \f
 ;;; 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)
index 963a0a14f4fb8f02b1edc2bf18a8bae4cd15a9c1..d3d71e78abbe3df147282bcc76e5badffe32e8c4 100644 (file)
@@ -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)