diff options
| author | Andrea Corallo | 2019-09-07 11:17:02 +0200 |
|---|---|---|
| committer | Andrea Corallo | 2020-01-01 11:37:44 +0100 |
| commit | 29fcb6ca1280fc01c652dcecc331b20cd88a5729 (patch) | |
| tree | 75893e95fd11382547b01f4ecabcd2da9acead10 | |
| parent | 37a794ce21aa52180c3b5037c3825efee91ee7a0 (diff) | |
| download | emacs-29fcb6ca1280fc01c652dcecc331b20cd88a5729.tar.gz emacs-29fcb6ca1280fc01c652dcecc331b20cd88a5729.zip | |
basic file compilation working
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 44 | ||||
| -rw-r--r-- | src/comp.c | 6 |
3 files changed, 45 insertions, 17 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 736f4f62235..ec7b036a677 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -563,8 +563,9 @@ Each element is (INDEX . VALUE)") | |||
| 563 | (defvar byte-compile-depth 0 "Current depth of execution stack.") | 563 | (defvar byte-compile-depth 0 "Current depth of execution stack.") |
| 564 | (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.") | 564 | (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.") |
| 565 | 565 | ||
| 566 | ;; These are use by comp.el to spill | 566 | ;; These are use by comp.el to spill data out of here |
| 567 | (defvar byte-native-compiling nil) | 567 | (defvar byte-native-compiling nil) |
| 568 | (defvar byte-to-native-names nil) | ||
| 568 | (defvar byte-to-native-lap-output nil) | 569 | (defvar byte-to-native-lap-output nil) |
| 569 | (defvar byte-to-native-bytecode-output nil) | 570 | (defvar byte-to-native-bytecode-output nil) |
| 570 | 571 | ||
| @@ -2271,6 +2272,10 @@ we output that argument and the following argument | |||
| 2271 | QUOTED says that we have to put a quote before the | 2272 | QUOTED says that we have to put a quote before the |
| 2272 | list that represents a doc string reference. | 2273 | list that represents a doc string reference. |
| 2273 | `defvaralias', `autoload' and `custom-declare-variable' need that." | 2274 | `defvaralias', `autoload' and `custom-declare-variable' need that." |
| 2275 | (when byte-native-compiling | ||
| 2276 | ;; Spill output for the native compiler here | ||
| 2277 | (push name byte-to-native-names) | ||
| 2278 | (push (apply #'vector form) byte-to-native-bytecode-output)) | ||
| 2274 | ;; We need to examine byte-compile-dynamic-docstrings | 2279 | ;; We need to examine byte-compile-dynamic-docstrings |
| 2275 | ;; in the input buffer (now current), not in the output buffer. | 2280 | ;; in the input buffer (now current), not in the output buffer. |
| 2276 | (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) | 2281 | (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) |
| @@ -3121,9 +3126,8 @@ for symbols generated by the byte compiler itself." | |||
| 3121 | (out (list 'byte-code (byte-compile-lapcode byte-compile-output) | 3126 | (out (list 'byte-code (byte-compile-lapcode byte-compile-output) |
| 3122 | byte-compile-vector byte-compile-maxdepth))) | 3127 | byte-compile-vector byte-compile-maxdepth))) |
| 3123 | (when byte-native-compiling | 3128 | (when byte-native-compiling |
| 3124 | ;; Spill output for the native compiler here | 3129 | ;; Spill output for the native compiler here |
| 3125 | (push byte-compile-output byte-to-native-lap-output) | 3130 | (push byte-compile-output byte-to-native-lap-output)) |
| 3126 | (push out byte-to-native-bytecode-output)) | ||
| 3127 | out)) | 3131 | out)) |
| 3128 | ;; it's a trivial function | 3132 | ;; it's a trivial function |
| 3129 | ((cdr body) (cons 'progn (nreverse body))) | 3133 | ((cdr body) (cons 'progn (nreverse body))) |
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index cfaf453932d..1a426560ba5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el | |||
| @@ -243,6 +243,8 @@ Put PREFIX in front of it." | |||
| 243 | 243 | ||
| 244 | (defun comp-decrypt-lambda-list (x) | 244 | (defun comp-decrypt-lambda-list (x) |
| 245 | "Decript lambda list X." | 245 | "Decript lambda list X." |
| 246 | (unless (fixnump x) | ||
| 247 | (error "Can't native compile a non lexical scoped function")) | ||
| 246 | (let ((rest (not (= (logand x 128) 0))) | 248 | (let ((rest (not (= (logand x 128) 0))) |
| 247 | (mandatory (logand x 127)) | 249 | (mandatory (logand x 127)) |
| 248 | (nonrest (ash x -8))) | 250 | (nonrest (ash x -8))) |
| @@ -254,7 +256,7 @@ Put PREFIX in front of it." | |||
| 254 | :nonrest nonrest)))) | 256 | :nonrest nonrest)))) |
| 255 | 257 | ||
| 256 | (defun comp-spill-lap-function (function-name) | 258 | (defun comp-spill-lap-function (function-name) |
| 257 | "Spill LAP for FUNCTION-NAME." | 259 | "Byte compile FUNCTION-NAME spilling data from the byte compiler." |
| 258 | (let* ((f (symbol-function function-name)) | 260 | (let* ((f (symbol-function function-name)) |
| 259 | (func (make-comp-func :symbol-name function-name | 261 | (func (make-comp-func :symbol-name function-name |
| 260 | :func f | 262 | :func f |
| @@ -268,23 +270,45 @@ Put PREFIX in front of it." | |||
| 268 | (comp-within-log-buff | 270 | (comp-within-log-buff |
| 269 | (cl-prettyprint byte-to-native-lap-output)) | 271 | (cl-prettyprint byte-to-native-lap-output)) |
| 270 | (let ((lambda-list (aref (comp-func-byte-func func) 0))) | 272 | (let ((lambda-list (aref (comp-func-byte-func func) 0))) |
| 271 | (if (fixnump lambda-list) | 273 | (setf (comp-func-args func) |
| 272 | (setf (comp-func-args func) | 274 | (comp-decrypt-lambda-list lambda-list))) |
| 273 | (comp-decrypt-lambda-list lambda-list)) | ||
| 274 | (error "Can't native compile a non lexical scoped function"))) | ||
| 275 | (setf (comp-func-lap func) (car byte-to-native-lap-output)) | 275 | (setf (comp-func-lap func) (car byte-to-native-lap-output)) |
| 276 | (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3)) | 276 | (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3)) |
| 277 | func)) | 277 | func)) |
| 278 | 278 | ||
| 279 | (defun comp-spill-lap-functions-file (filename) | ||
| 280 | "Byte compile FILENAME spilling data from the byte compiler." | ||
| 281 | (byte-compile-file filename) | ||
| 282 | (cl-assert (= (length byte-to-native-names) | ||
| 283 | (length byte-to-native-lap-output) | ||
| 284 | (length byte-to-native-bytecode-output))) | ||
| 285 | (cl-loop for function-name in byte-to-native-names | ||
| 286 | for lap in byte-to-native-lap-output | ||
| 287 | for bytecode in byte-to-native-bytecode-output | ||
| 288 | for lambda-list = (aref bytecode 0) | ||
| 289 | for func = (make-comp-func :symbol-name function-name | ||
| 290 | :byte-func bytecode | ||
| 291 | :c-func-name (comp-c-func-name | ||
| 292 | function-name | ||
| 293 | "F") | ||
| 294 | :args (comp-decrypt-lambda-list lambda-list) | ||
| 295 | :lap lap | ||
| 296 | :frame-size (aref bytecode 3)) | ||
| 297 | do (comp-within-log-buff | ||
| 298 | (cl-prettyprint lap)) | ||
| 299 | collect func)) | ||
| 300 | |||
| 279 | (defun comp-spill-lap (input) | 301 | (defun comp-spill-lap (input) |
| 280 | "Byte compile and spill the LAP rapresentation for INPUT. | 302 | "Byte compile and spill the LAP rapresentation for INPUT. |
| 281 | If INPUT is a symbol this is the function-name to be compiled. | 303 | If INPUT is a symbol this is the function-name to be compiled. |
| 282 | If INPUT is a string this is the file path to be compiled." | 304 | If INPUT is a string this is the file path to be compiled." |
| 283 | (let ((byte-native-compiling t) | 305 | (let ((byte-native-compiling t) |
| 284 | (byte-to-native-lap-output ())) | 306 | (byte-to-native-names ()) |
| 307 | (byte-to-native-lap-output ()) | ||
| 308 | (byte-to-native-bytecode-output ())) | ||
| 285 | (cl-typecase input | 309 | (cl-typecase input |
| 286 | (symbol (list (comp-spill-lap-function input))) | 310 | (symbol (list (comp-spill-lap-function input))) |
| 287 | (string (error "To be implemented"))))) | 311 | (string (comp-spill-lap-functions-file input))))) |
| 288 | 312 | ||
| 289 | 313 | ||
| 290 | ;;; Limplification pass specific code. | 314 | ;;; Limplification pass specific code. |
| @@ -905,11 +929,11 @@ Prepare every functions for final compilation and drive the C side." | |||
| 905 | (defun native-compile (input) | 929 | (defun native-compile (input) |
| 906 | "Compile INPUT into native code. | 930 | "Compile INPUT into native code. |
| 907 | This is the entrypoint for the Emacs Lisp native compiler. | 931 | This is the entrypoint for the Emacs Lisp native compiler. |
| 908 | If INPUT is a symbol this is the function-name to be compiled. | 932 | If INPUT is a symbol, native-compile its function definition. |
| 909 | If INPUT is a string this is the file path to be compiled." | 933 | If INPUT is a string, use it as the file path to be native compiled." |
| 910 | (unless (or (symbolp input) | 934 | (unless (or (symbolp input) |
| 911 | (stringp input)) | 935 | (stringp input)) |
| 912 | (error "Trying to native compile something not a function or file")) | 936 | (error "Trying to native compile something not a symbol function or file")) |
| 913 | (let ((data input) | 937 | (let ((data input) |
| 914 | (comp-ctxt (make-comp-ctxt :output (if (symbolp input) | 938 | (comp-ctxt (make-comp-ctxt :output (if (symbolp input) |
| 915 | (symbol-name input) | 939 | (symbol-name input) |
diff --git a/src/comp.c b/src/comp.c index 905cc70b6b3..07c779369c8 100644 --- a/src/comp.c +++ b/src/comp.c | |||
| @@ -3057,9 +3057,9 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (const union vectorlike_header *a, | |||
| 3057 | } | 3057 | } |
| 3058 | 3058 | ||
| 3059 | 3059 | ||
| 3060 | /*********************************/ | 3060 | /**************************************/ |
| 3061 | /* Native elisp load functions. */ | 3061 | /* Functions used to load eln files. */ |
| 3062 | /*********************************/ | 3062 | /**************************************/ |
| 3063 | 3063 | ||
| 3064 | static Lisp_Object Vnative_elisp_refs_hash; | 3064 | static Lisp_Object Vnative_elisp_refs_hash; |
| 3065 | 3065 | ||