mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-20 20:50:53 -08:00
Code Issues Projects Releases Wiki Activity

With `native-compile', compile lambdas in a defun or lambda too

Browse source 
This fixes bug#64646.  Also refactor two functions to reduce
code duplication.

* lisp/emacs-lisp/comp.el (comp-spill-lap-function/symbol)
(comp-spill-lap-function/list): Add all functions found by the
byte compiler (including lambdas) to the native compiler's
context, thus making them be native compiled.  Refactor to use
comp-intern-func-in-ctxt.  Make comp-spill-lap-function/list
also compile closures.

* test/src/comp-resources/comp-test-funcs.el
(comp-tests-lambda-return-f2): New function

* test/src/comp-tests.el (comp-test-lambda-return2)
(comp-tests-free-fun-f2): New functions to test that internal
lambdas get native compiled.
This commit is contained in:
Alan Mackenzie 2023-11-08 20:49:48 +00:00
parent bf9cbc2354
commit 06e4ebc81a
3 changed files with 45 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1316,86 +1316,31 @@ clashes."
nil ".eln")))
(let* ((f (symbol-function function-name))
(byte-code (byte-compile function-name))
(c-name (comp-c-func-name function-name "F"))
(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)))))
(c-name (comp-c-func-name function-name "F")))
(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-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)
(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)
(setf (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))))
:c-name c-name
:byte-func byte-code)))
(maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
(cl-defmethod comp-spill-lap-function ((form list))
"Byte-compile FORM, spilling data from the byte compiler."
(unless (eq (car-safe form) 'lambda)
(unless (memq (car-safe form) '(lambda closure))
(signal 'native-compiler-error
'("Cannot native-compile, form is not a lambda")))
'("Cannot native-compile, form is not a lambda or closure")))
(unless (comp-ctxt-output comp-ctxt)
(setf (comp-ctxt-output comp-ctxt)
(make-temp-file "comp-lambda-" nil ".eln")))
(let* ((byte-code (byte-compile form))
(c-name (comp-c-func-name "anonymous-lambda" "F"))
(func (if (comp-lex-byte-func-p byte-code)
(make-comp-func-l :c-name c-name
:doc (documentation form t)
:int-spec (interactive-form form)
:command-modes (command-modes form)
:speed (comp-ctxt-speed comp-ctxt))
(make-comp-func-d :c-name c-name
:doc (documentation form t)
:int-spec (interactive-form form)
:command-modes (command-modes form)
:speed (comp-ctxt-speed comp-ctxt)))))
(let ((lap (byte-to-native-lambda-lap
(gethash (aref byte-code 1)
byte-to-native-lambdas-h))))
(cl-assert lap)
(comp-log lap 2 t)
(if (comp-func-l-p func)
(setf (comp-func-l-args func)
(comp-decrypt-arg-list (aref byte-code 0) byte-code))
(setf (comp-func-d-lambda-list func) (cadr form)))
(setf (comp-func-lap func) lap
(comp-func-frame-size func) (comp-byte-frame-size
byte-code))
(setf (comp-func-byte-func func) byte-code
(comp-ctxt-top-level-forms comp-ctxt)
(c-name (comp-c-func-name "anonymous-lambda" "F")))
(setf (comp-ctxt-top-level-forms comp-ctxt)
(list (make-byte-to-native-func-def :name '--anonymous-lambda
:c-name c-name)))
(comp-add-func-to-ctxt func))))
:c-name c-name
:byte-func byte-code)))
(maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
(defun comp-intern-func-in-ctxt (_ obj)
"Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'."