(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
;; 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
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)))
\f
(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.
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)
(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
(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
"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)))
(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))
(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)))
(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))
"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)))
"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.
projects / emacs.git / commitdiff