From f9f9c95ab578dee680093cf3f1e618c770fc22c3 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 19 Jul 2023 11:23:00 +0000 Subject: [PATCH] Fix native compilation in dynamically bound files. This fixes bug#64642. * lisp/emacs-lisp/comp.el (comp-spill-lap-function/symbol): Add code for dynamically bound functions. * test/src/comp-tests.el (comp-tests-result-lambda): New test. * test/src/comp-resources/comp-test-funcs-dyn2.el: New test file. # Please enter the commit message for your changes. Lines starting # with '#' will be ignored, and an empty message aborts the commit. # # On branch master # Your branch is up to date with 'origin/master'. # # Changes to be committed: # modified: lisp/emacs-lisp/comp.el # new file: test/src/comp-resources/comp-test-funcs-dyn2.el # modified: test/src/comp-tests.el # # Changes not staged for commit: # modified: .gitignore # # Untracked files: # .gitignore.acm # .gitignore.backup # .timestamps.txt # 2021-01-03.err # 2021-01-06.err # 2021-12-16.make # 2021-12-30.err # 2021-12-31.err # 2022-01-01.err # 2022-01-02.check.err # 2022-01-02.err # 2022-01-04.err # 2022-01-05.err # 2022-01-06.err # 2022-01-07.err # 2022-01-07.outerr # 2022-01-08.err # 2022-01-09.err # 2022-01-09b.err # 2022-01-10.err # 2022-01-11 # 2022-01-11.err # 2022-02-22.err # 2022-02-22.outerr # checkout.20220228.out # checkout.20220301.out # checkout.20220302.out # doc/lispref/syntax.20160318.techsi # doc/lispref/syntax.20160318b.techsi # lib/.deps/ # lisp/2022-01-09.err # lisp/emacs-lisp/comp.el.rej # src/2021-12-20.err # src/globals.20211124.aitch # src/lisp.20211127.aitch # test/lisp/calendar/icalendar-tests.elcr5m9Wq # --- lisp/emacs-lisp/comp.el | 48 ++++++++++++------- .../comp-resources/comp-test-funcs-dyn2.el | 31 ++++++++++++ test/src/comp-tests.el | 7 ++- 3 files changed, 67 insertions(+), 19 deletions(-) create mode 100644 test/src/comp-resources/comp-test-funcs-dyn2.el diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 4892733d456..b35e1b97e9d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1301,33 +1301,45 @@ clashes." (make-temp-file (comp-c-func-name function-name "freefn-") nil ".eln"))) (let* ((f (symbol-function function-name)) + (byte-code (byte-compile function-name)) (c-name (comp-c-func-name function-name "F")) - (func (make-comp-func-l :name function-name - :c-name c-name - :doc (documentation f t) - :int-spec (interactive-form f) - :command-modes (command-modes f) - :speed (comp-spill-speed function-name) - :pure (comp-spill-decl-spec function-name - 'pure)))) + (func + (if (comp-lex-byte-func-p byte-code) + (make-comp-func-l :name function-name + :c-name c-name + :doc (documentation f t) + :int-spec (interactive-form f) + :command-modes (command-modes f) + :speed (comp-spill-speed function-name) + :pure (comp-spill-decl-spec function-name + 'pure)) + (make-comp-func-d :name function-name + :c-name c-name + :doc (documentation f t) + :int-spec (interactive-form f) + :command-modes (command-modes f) + :speed (comp-spill-speed function-name) + :pure (comp-spill-decl-spec function-name + 'pure))))) (when (byte-code-function-p f) (signal 'native-compiler-error '("can't native compile an already byte-compiled function"))) - (setf (comp-func-byte-func func) - (byte-compile (comp-func-name func))) + (setf (comp-func-byte-func func) byte-code) (let ((lap (byte-to-native-lambda-lap (gethash (aref (comp-func-byte-func func) 1) byte-to-native-lambdas-h)))) (cl-assert lap) (comp-log lap 2 t) - (let ((arg-list (aref (comp-func-byte-func func) 0))) - (setf (comp-func-l-args func) - (comp-decrypt-arg-list arg-list function-name) - (comp-func-lap func) - lap - (comp-func-frame-size func) - (comp-byte-frame-size (comp-func-byte-func func)))) - (setf (comp-ctxt-top-level-forms comp-ctxt) + (if (comp-func-l-p func) + (let ((arg-list (aref (comp-func-byte-func func) 0))) + (setf (comp-func-l-args func) + (comp-decrypt-arg-list arg-list function-name))) + (setf (comp-func-d-lambda-list func) (cadr f))) + (setf (comp-func-lap func) + lap + (comp-func-frame-size func) + (comp-byte-frame-size (comp-func-byte-func func)) + (comp-ctxt-top-level-forms comp-ctxt) (list (make-byte-to-native-func-def :name function-name :c-name c-name))) (comp-add-func-to-ctxt func)))) diff --git a/test/src/comp-resources/comp-test-funcs-dyn2.el b/test/src/comp-resources/comp-test-funcs-dyn2.el new file mode 100644 index 00000000000..3d70489d1ca --- /dev/null +++ b/test/src/comp-resources/comp-test-funcs-dyn2.el @@ -0,0 +1,31 @@ +;;; comp-test-funcs-dyn2.el -*- lexical-binding: nil; no-byte-compile: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Alan Mackenzie + +;; 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 . + +;;; Commentary: +;; Test the compilation of a function under dynamic binding. + +;;; Code: + +(defun comp-tests-result-lambda () + (lambda (bar) (car bar))) + +(provide 'comp-test-funcs-dyn2) +;;; comp-test-funcs-dyn2.el ends here. diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index ce7899d9d4c..30dfd669ded 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -33,7 +33,8 @@ (eval-and-compile (defconst comp-test-src (ert-resource-file "comp-test-funcs.el")) - (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el"))) + (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el")) + (defconst comp-test-dyn-src2 (ert-resource-file "comp-test-funcs-dyn2.el"))) (when (native-comp-available-p) (message "Compiling tests...") @@ -44,6 +45,7 @@ ;; names used in this file. (require 'comp-test-funcs comp-test-src) (require 'comp-test-dyn-funcs comp-test-dyn-src) ;Non-standard feature name! +(require 'comp-test-funcs-dyn2 comp-test-dyn-src2) (defmacro comp-deftest (name args &rest docstring-and-body) "Define a test for the native compiler tagging it as :nativecomp." @@ -1528,4 +1530,7 @@ folded." (equal (comp-mvar-typeset mvar) comp-tests-cond-rw-expected-type)))))))) +(ert-deftest comp-tests-result-lambda () + (native-compile 'comp-tests-result-lambda) + (should (eq (funcall (comp-tests-result-lambda) '(a . b)) 'a))) ;;; comp-tests.el ends here -- 2.39.5