From: Andrea Corallo Date: Fri, 1 May 2020 16:32:39 +0000 (+0100) Subject: Update spill LAP machinery and compile anonymous lambdas X-Git-Tag: emacs-28.0.90~2727^2~652 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a335f7eeacd5381af1d8ef38a4c2b8e832ca96fa;p=emacs.git Update spill LAP machinery and compile anonymous lambdas * lisp/emacs-lisp/comp.el (comp-spill-lap-function): Make use of byte-to-native-lambdas-h and update for 'byte-to-native-func-def'. (comp-spill-lap-function): Rework logic to retrive LAP using 'byte-to-native-lambdas-h'. (comp-emit-for-top-level): Update for 'byte-to-native-function'. * lisp/emacs-lisp/bytecomp.el: Add commentary on new spill LAP mechanism. (byte-to-native-lambda, byte-to-native-func-def): New structures. (byte-to-native-top-level): Indent. (byte-to-native-lambdas-h): Update doc. (byte-compile-lapcode): Add a 'byte-to-native-lambda' instance into byte-to-native-lambdas-h instead of just LAP. (byte-compile-file-form-defmumble): Store into 'byte-to-native-func-def' only the byte compiled function, the LAP will be retrived through 'byte-to-native-lambdas-h'. (byte-compile-lambda): Return the byte compiled function. --- diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c0662a6d280..f33c30e5742 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -562,13 +562,31 @@ Each element is (INDEX . VALUE)") (defvar byte-compile-depth 0 "Current depth of execution stack.") (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.") -;; These are use by comp.el to spill data out of here -(cl-defstruct byte-to-native-function - "Named or anonymous function defined a top level." - name c-name data lap) +;; The following is used by comp.el to spill data out of here. +;; +;; Spilling is done in 3 places: +;; +;; - `byte-compile-lapcode' to obtain the map bytecode -> LAP for any +;; code assembled. +;; +;; - `byte-compile-lambda' to obtain arglist doc and interactive spec +;; af any lambda compiled (including anonymous). +;; +;; - `byte-compile-file-form-defmumble' to obtain the list of +;; top-level forms as they would be outputted in the .elc file. +;; + +(cl-defstruct byte-to-native-lambda + byte-func lap) + +;; Top level forms: +(cl-defstruct byte-to-native-func-def + "Named function defined at top-level." + name c-name byte-func) (cl-defstruct byte-to-native-top-level - "All other top level forms." - form) + "All other top-level forms." + form) + (defvar byte-native-compiling nil "Non nil while native compiling.") (defvar byte-native-for-bootstrap nil @@ -577,8 +595,8 @@ Each element is (INDEX . VALUE)") ;; Because the make target is the later this has to be produced as ;; last to be resilient against build interruptions. ) -(defvar byte-to-native-lap-h nil - "Hash byte-code -> LAP.") +(defvar byte-to-native-lambdas-h nil + "Hash byte-code -> byte-to-native-lambda.") (defvar byte-to-native-top-level-forms nil "List of top level forms.") (defvar byte-to-native-output-file nil @@ -978,8 +996,9 @@ CONST2 may be evaluated multiple times." hash-table)) (let ((bytecode (apply 'unibyte-string (nreverse bytes)))) (when byte-native-compiling - ;; Spill LAP for the native compiler here - (puthash bytecode lap byte-to-native-lap-h)) + ;; Spill LAP for the native compiler here. + (puthash bytecode (make-byte-to-native-lambda :lap lap) + byte-to-native-lambdas-h)) bytecode))) @@ -2689,10 +2708,8 @@ not to take responsibility for the actual compilation of the code." (push (if macro (make-byte-to-native-top-level :form `(defalias ',name '(macro . ,code) nil)) - (make-byte-to-native-function :name name - :data code - :lap (gethash (aref code 1) - byte-to-native-lap-h))) + (make-byte-to-native-func-def :name name + :byte-func code)) byte-to-native-top-level-forms)) ;; Output the form by hand, that's much simpler than having ;; b-c-output-file-form analyze the defalias. @@ -2950,23 +2967,30 @@ for symbols generated by the byte compiler itself." reserved-csts))) ;; Build the actual byte-coded function. (cl-assert (eq 'byte-code (car-safe compiled))) - (apply #'make-byte-code - (if lexical-binding - (byte-compile-make-args-desc arglist) - arglist) - (append - ;; byte-string, constants-vector, stack depth - (cdr compiled) - ;; optionally, the doc string. - (cond ((and lexical-binding arglist) - ;; byte-compile-make-args-desc lost the args's names, - ;; so preserve them in the docstring. - (list (help-add-fundoc-usage doc arglist))) - ((or doc int) - (list doc))) - ;; optionally, the interactive spec. - (if int - (list (nth 1 int)))))))) + (let ((out + (apply #'make-byte-code + (if lexical-binding + (byte-compile-make-args-desc arglist) + arglist) + (append + ;; byte-string, constants-vector, stack depth + (cdr compiled) + ;; optionally, the doc string. + (cond ((and lexical-binding arglist) + ;; byte-compile-make-args-desc lost the args's names, + ;; so preserve them in the docstring. + (list (help-add-fundoc-usage doc arglist))) + ((or doc int) + (list doc))) + ;; optionally, the interactive spec. + (if int + (list (nth 1 int))))))) + (when byte-native-compiling + (setf (byte-to-native-lambda-byte-func + (gethash (cadr compiled) + byte-to-native-lambdas-h)) + out)) + out)))) (defvar byte-compile-reserved-constants 0) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index c2a95feec10..3977580fc8e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -230,6 +230,9 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table :documentation "symbol-function -> c-name. This is only for optimizing intra CU calls at speed 3.") + (byte-func-to-func-h (make-hash-table :test #'eq) :type hash-table + :documentation "byte-function -> comp-func. +Needed to replace immediate byte-compiled lambdas with the compiled reference.") (function-docs (make-hash-table :test #'eql) :type (or hash-table vector) :documentation "Documentation index -> documentation") (d-default (make-comp-data-container) :type comp-data-container @@ -311,7 +314,7 @@ Is in use to help the SSA rename pass.")) (cl-defstruct (comp-func (:copier nil)) "LIMPLE representation of a function." (name nil :type symbol - :documentation "Function symbol name.") + :documentation "Function symbol name. Nil indicates anonymous.") (c-name nil :type string :documentation "The function name in the native world.") (byte-func nil @@ -554,8 +557,9 @@ Put PREFIX in front of it." "can't native compile an already bytecompiled function")) (setf (comp-func-byte-func func) (byte-compile (comp-func-name func))) - (let ((lap (gethash (aref (comp-func-byte-func func) 1) - byte-to-native-lap-h))) + (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) (let ((arg-list (aref (comp-func-byte-func func) 0))) @@ -566,7 +570,7 @@ Put PREFIX in front of it." (comp-func-frame-size func) (comp-byte-frame-size (comp-func-byte-func func)))) (setf (comp-ctxt-top-level-forms comp-ctxt) - (list (make-byte-to-native-function :name function-name + (list (make-byte-to-native-func-def :name function-name :c-name c-name))) ;; Create the default array. (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) @@ -580,38 +584,47 @@ Put PREFIX in front of it." (setf (comp-ctxt-top-level-forms comp-ctxt) (reverse byte-to-native-top-level-forms)) (cl-loop - ;; All non anonymous functions. - for f in (cl-loop for x in (comp-ctxt-top-level-forms comp-ctxt) - when (and (byte-to-native-function-p x) - (byte-to-native-function-name x)) - collect x) - for name = (byte-to-native-function-name f) - for c-name = (comp-c-func-name name "F") - for data = (byte-to-native-function-data f) + for x being each hash-value of byte-to-native-lambdas-h + for byte-func = (byte-to-native-lambda-byte-func x) + for lap = (byte-to-native-lambda-lap x) + for top-l-form = (cl-loop + for form in (comp-ctxt-top-level-forms comp-ctxt) + when (and (byte-to-native-func-def-p form) + (eq (byte-to-native-func-def-byte-func form) + byte-func)) + return form) + for name = (when top-l-form + (byte-to-native-func-def-name top-l-form)) + for c-name = (comp-c-func-name (or name "anonymous-lambda") + "F") for func = (make-comp-func :name name - :byte-func data - :doc (documentation data) - :int-spec (interactive-form data) + :byte-func byte-func + :doc (documentation byte-func) + :int-spec (interactive-form byte-func) :c-name c-name - :args (comp-decrypt-arg-list (aref data 0) name) - :lap (byte-to-native-function-lap f) - :frame-size (comp-byte-frame-size data)) - do + :args (comp-decrypt-arg-list (aref byte-func 0) + name) + :lap lap + :frame-size (comp-byte-frame-size byte-func)) ;; Store the c-name to have it retrivable from ;; comp-ctxt-top-level-forms. - (setf (byte-to-native-function-c-name f) c-name) + when top-l-form + do (setf (byte-to-native-func-def-c-name top-l-form) c-name) + unless name + do (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt)) + do ;; Create the default array. (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) (comp-add-func-to-ctxt func) (comp-log (format "Function %s:\n" name) 1) - (comp-log (byte-to-native-function-lap f) 1))) + (comp-log lap 1))) (defun comp-spill-lap (input) "Byte compile and spill the LAP representation for INPUT. If INPUT is a symbol this is the function-name to be compiled. If INPUT is a string this is the file path to be compiled." (let ((byte-native-compiling t) - (byte-to-native-lap-h (make-hash-table :test #'eq)) + (byte-to-native-lambdas-h (make-hash-table :test #'eq)) (byte-to-native-top-level-forms ())) (comp-spill-lap-function input))) @@ -1225,10 +1238,10 @@ the annotation emission." (cl-defgeneric comp-emit-for-top-level (form for-late-load) "Emit the limple code for top level FORM.") -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function) +(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def) for-late-load) - (let* ((name (byte-to-native-function-name form)) - (c-name (byte-to-native-function-c-name form)) + (let* ((name (byte-to-native-func-def-name form)) + (c-name (byte-to-native-func-def-c-name form)) (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) (args (comp-func-args f))) (cl-assert (and name f)) @@ -1293,6 +1306,9 @@ into the C code forwarding the compilation unit." "Top level")) ;; Assign the compilation unit incoming as parameter to the slot frame 0. (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0)) + (maphash (lambda (_ func) + (comp-emit-lambda-for-top-level func)) + (comp-ctxt-byte-func-to-func-h comp-ctxt)) (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) (comp-ctxt-top-level-forms comp-ctxt)) (comp-emit `(return ,(make-comp-mvar :constant t))) @@ -2142,6 +2158,7 @@ Update all insn accordingly." "Compile as native code the current context naming it NAME. Prepare every function for final compilation and drive the C back-end." (let ((dir (file-name-directory name))) + ;; FIXME: Strip bytecompiled functions here. (comp-finalize-relocs) (unless (file-exists-p dir) ;; In case it's created in the meanwhile.