diff options
| author | Andrea Corallo | 2019-07-09 22:28:29 +0200 |
|---|---|---|
| committer | Andrea Corallo | 2020-01-01 11:33:51 +0100 |
| commit | c1a738bd98f7eaaf4dcc87b0769dad2821178ab8 (patch) | |
| tree | d9f4c45b2d934a3018d932c663656de0a840d6bb | |
| parent | 0a227b6db46dcd5c4af0b6266d4f642b0c6157b5 (diff) | |
| download | emacs-c1a738bd98f7eaaf4dcc87b0769dad2821178ab8.tar.gz emacs-c1a738bd98f7eaaf4dcc87b0769dad2821178ab8.zip | |
update tests
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 20 | ||||
| -rw-r--r-- | test/src/comp-tests.el | 5 |
2 files changed, 11 insertions, 14 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 93e3bf17b35..e3cb8684386 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el | |||
| @@ -79,7 +79,7 @@ To be used when ncall-conv is nil.") | |||
| 79 | 79 | ||
| 80 | (cl-defstruct (comp-mvar (:copier nil) (:constructor make--comp-mvar)) | 80 | (cl-defstruct (comp-mvar (:copier nil) (:constructor make--comp-mvar)) |
| 81 | "A meta-variable being a slot in the meta-stack." | 81 | "A meta-variable being a slot in the meta-stack." |
| 82 | (n nil :type number | 82 | (id nil :type number |
| 83 | :documentation "SSA number") | 83 | :documentation "SSA number") |
| 84 | (slot nil :type fixnum | 84 | (slot nil :type fixnum |
| 85 | :documentation "Slot position") | 85 | :documentation "Slot position") |
| @@ -139,8 +139,11 @@ To be used when ncall-conv is nil.") | |||
| 139 | (byte-compile (comp-func-symbol-name func))) | 139 | (byte-compile (comp-func-symbol-name func))) |
| 140 | (when comp-debug | 140 | (when comp-debug |
| 141 | (cl-prettyprint byte-compile-lap-output)) | 141 | (cl-prettyprint byte-compile-lap-output)) |
| 142 | (setf (comp-func-args func) | 142 | (let ((lambda-list (aref (comp-func-byte-func func) 0))) |
| 143 | (comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0))) | 143 | (if (fixnump lambda-list) |
| 144 | (setf (comp-func-args func) | ||
| 145 | (comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0))) | ||
| 146 | (error "Can't native compile a non lexical scoped function"))) | ||
| 144 | (setf (comp-func-ir func) byte-compile-lap-output) | 147 | (setf (comp-func-ir func) byte-compile-lap-output) |
| 145 | (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3)) | 148 | (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3)) |
| 146 | func) | 149 | func) |
| @@ -163,7 +166,7 @@ To be used when ncall-conv is nil.") | |||
| 163 | (defvar comp-func) | 166 | (defvar comp-func) |
| 164 | 167 | ||
| 165 | (cl-defun make-comp-mvar (&key slot const-vld constant type) | 168 | (cl-defun make-comp-mvar (&key slot const-vld constant type) |
| 166 | (make--comp-mvar :n (cl-incf (comp-func-limple-cnt comp-func)) | 169 | (make--comp-mvar :id (cl-incf (comp-func-limple-cnt comp-func)) |
| 167 | :slot slot :const-vld const-vld :constant constant | 170 | :slot slot :const-vld const-vld :constant constant |
| 168 | :type type)) | 171 | :type type)) |
| 169 | 172 | ||
| @@ -207,11 +210,10 @@ To be used when ncall-conv is nil.") | |||
| 207 | "Push VAL into frame. | 210 | "Push VAL into frame. |
| 208 | VAL is known at compile time." | 211 | VAL is known at compile time." |
| 209 | (cl-incf (comp-sp)) | 212 | (cl-incf (comp-sp)) |
| 210 | (let ((const (make-comp-mvar :slot (comp-sp) | 213 | (setf (comp-slot) (make-comp-mvar :slot (comp-sp) |
| 211 | :const-vld t | 214 | :const-vld t |
| 212 | :constant val))) | 215 | :constant val)) |
| 213 | (setf (comp-slot) const) | 216 | (push (list '=const (comp-slot) val) comp-limple)) |
| 214 | (push (list '=const (comp-slot) const) comp-limple))) | ||
| 215 | 217 | ||
| 216 | (defun comp-push-block (bblock) | 218 | (defun comp-push-block (bblock) |
| 217 | "Push basic block BBLOCK." | 219 | "Push basic block BBLOCK." |
| @@ -307,8 +309,6 @@ VAL is known at compile time." | |||
| 307 | 309 | ||
| 308 | (defun native-compile (fun) | 310 | (defun native-compile (fun) |
| 309 | "FUN is the function definition to be compiled into native code." | 311 | "FUN is the function definition to be compiled into native code." |
| 310 | (unless lexical-binding | ||
| 311 | (error "Can't native compile a non lexical scoped function")) | ||
| 312 | (if-let ((f (symbol-function fun))) | 312 | (if-let ((f (symbol-function fun))) |
| 313 | (progn | 313 | (progn |
| 314 | (when (byte-code-function-p f) | 314 | (when (byte-code-function-p f) |
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index c6ee5b76855..8d3a0f507d3 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el | |||
| @@ -26,6 +26,7 @@ | |||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | (require 'ert) | 28 | (require 'ert) |
| 29 | (require 'comp) | ||
| 29 | 30 | ||
| 30 | (setq garbage-collection-messages t) | 31 | (setq garbage-collection-messages t) |
| 31 | 32 | ||
| @@ -103,10 +104,6 @@ | |||
| 103 | (defun comp-tests-varset-f () | 104 | (defun comp-tests-varset-f () |
| 104 | (setq comp-tests-var1 55)) | 105 | (setq comp-tests-var1 55)) |
| 105 | (comp-test-compile #'comp-tests-varset-f) | 106 | (comp-test-compile #'comp-tests-varset-f) |
| 106 | ((byte-constant 55 . 1) | ||
| 107 | (byte-dup . 0) | ||
| 108 | (byte-varset comp-tests-var1 . 0) | ||
| 109 | (byte-return . 0)) | ||
| 110 | 107 | ||
| 111 | (comp-tests-varset-f) | 108 | (comp-tests-varset-f) |
| 112 | 109 | ||