;; 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)
+ name c-name data lap)
(cl-defstruct byte-to-native-top-level
"All other top level forms."
form)
;; 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 nil
- "A-list to accumulate LAP.
-Each pair is (NAME . LAP)")
+(defvar byte-to-native-lap-h nil
+ "Hash byte-code -> LAP.")
(defvar byte-to-native-top-level-forms nil
"List of top level forms.")
(defvar byte-to-native-output-file nil
;; it within 2 bytes in the byte string).
(puthash value pc hash-table))
hash-table))
- (apply 'unibyte-string (nreverse bytes))))
+ (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))
+ bytecode)))
\f
;;; compile-time evaluation
(defvar byte-compile-current-file nil)
(defvar byte-compile-current-group nil)
(defvar byte-compile-current-buffer nil)
-(defvar byte-compile-not-top-level nil ; We'll evolve this for naming lambdas
- "Non nil if compiling something that is not top-level.")
;; Log something that isn't a warning.
(defmacro byte-compile-log (format-string &rest args)
(defun byte-compile-flush-pending ()
(if byte-compile-output
- (let* ((byte-compile-current-form nil)
- (form (byte-compile-out-toplevel t 'file)))
+ (let ((form (byte-compile-out-toplevel t 'file)))
(cond ((eq (car-safe form) 'progn)
(mapc 'byte-compile-output-file-form (cdr form)))
(form
(push (if macro
(make-byte-to-native-top-level
:form `(defalias ',name '(macro . ,code) nil))
- (make-byte-to-native-function :name name :data code))
+ (make-byte-to-native-function :name name
+ :data code
+ :lap (gethash (aref code 1)
+ byte-to-native-lap-h)))
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.
;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
(let* ((form (nth 1 int))
- (byte-compile-not-top-level t)
(newform (byte-compile-top-level form)))
(while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form))
(not (delq nil (mapcar 'consp (cdr (car body))))))))
(setq rest (cdr rest)))
rest))
- (let* ((byte-compile-vector (byte-compile-constants-vector))
- (out (list 'byte-code (byte-compile-lapcode byte-compile-output)
- byte-compile-vector byte-compile-maxdepth)))
- (when (and byte-native-compiling
- (or (null byte-compile-not-top-level)
- (eq byte-native-compiling 'free-func)))
- ;; Spill LAP for the native compiler here
- (push (cons byte-compile-current-form byte-compile-output)
- byte-to-native-lap))
- out))
+ (let ((byte-compile-vector (byte-compile-constants-vector)))
+ (list 'byte-code (byte-compile-lapcode byte-compile-output)
+ byte-compile-vector byte-compile-maxdepth)))
;; it's a trivial function
((cdr body) (cons 'progn (nreverse body)))
((car body)))))
;; byte-compile--for-effect flag too.)
;;
(defun byte-compile-form (form &optional for-effect)
- (let ((byte-compile--for-effect for-effect)
- (byte-compile-not-top-level t))
+ (let ((byte-compile--for-effect for-effect))
(cond
((not (consp form))
(cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
;; and (funcall (function foo)) will lose with autoloads.
(defun byte-compile-function-form (form)
- (let ((f (nth 1 form))
- (byte-compile-not-top-level t))
+ (let ((f (nth 1 form)))
(when (and (symbolp f)
(byte-compile-warning-enabled-p 'callargs f))
(byte-compile-function-warn f t (byte-compile-fdefinition f nil)))
(cl-defgeneric comp-spill-lap-function ((function-name symbol))
"Byte compile FUNCTION-NAME spilling data from the byte compiler."
- (let* ((byte-native-compiling 'free-func)
- (f (symbol-function function-name))
+ (let* ((f (symbol-function function-name))
(c-name (comp-c-func-name function-name "F"))
(func (make-comp-func :name function-name
:c-name c-name
"can't native compile an already bytecompiled function"))
(setf (comp-func-byte-func func)
(byte-compile (comp-func-name func)))
- (let ((lap (alist-get nil byte-to-native-lap)))
+ (let ((lap (gethash (aref (comp-func-byte-func func) 1)
+ byte-to-native-lap-h)))
(cl-assert lap)
(comp-log lap 2)
(let ((arg-list (aref (comp-func-byte-func func) 0)))
(signal 'native-compiler-error-empty-byte filename))
(setf (comp-ctxt-top-level-forms comp-ctxt)
(reverse byte-to-native-top-level-forms))
- (comp-log byte-to-native-lap 3)
(cl-loop
- with lap-forms = (reverse byte-to-native-lap)
;; 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)
collect x)
for name = (byte-to-native-function-name f)
for c-name = (comp-c-func-name name "F")
- for lap-entry = (assoc name lap-forms)
- for lap = (cdr lap-entry)
for data = (byte-to-native-function-data f)
for func = (make-comp-func :name name
:byte-func data
:int-spec (interactive-form data)
:c-name c-name
:args (comp-decrypt-arg-list (aref data 0) name)
- :lap lap
+ :lap (byte-to-native-function-lap f)
:frame-size (comp-byte-frame-size data))
do
- ;; Remove it form the original lap list to avoid multiple function
- ;; definition with the same name shadowing each other.
- (setf lap-forms (delete lap-entry lap-forms))
;; Store the c-name to have it retrivable from
;; comp-ctxt-top-level-forms.
(setf (byte-to-native-function-c-name f) c-name)
(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 lap 1)))
+ (comp-log (byte-to-native-function-lap f) 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 ())
+ (byte-to-native-lap-h (make-hash-table :test #'eq))
(byte-to-native-top-level-forms ()))
(comp-spill-lap-function input)))
projects / emacs.git / commitdiff