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.

admin/MAINTAINERS

@@ -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

lisp/Makefile.in

@@ -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

lisp/emacs-lisp/comp-common.el

@@ -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

lisp/emacs-lisp/comp-run.el

@@ -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."

lisp/emacs-lisp/comp.el

@@ -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)

src/Makefile.in

@@ -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)