[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 2acc46b 1/2: Migrate and rename a bunch of functions
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 2acc46b 1/2: Migrate and rename a bunch of functions from comp.el to comp-cstr.el |
|
Date: |
Sun, 28 Feb 2021 18:02:16 -0500 (EST) |
branch: feature/native-comp
commit 2acc46b55bdf518ece6301913ffa074f31563fa4
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Migrate and rename a bunch of functions from comp.el to comp-cstr.el
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-imm-vld-p)
(comp-cstr-imm, comp-cstr-fixnum-p, comp-cstr-symbol-p)
(comp-cstr-cons-p): Move and rename from 'comp.el'.
* lisp/emacs-lisp/comp.el (comp-mvar-type-hint-match-p)
(make-comp-mvar, comp-emit-assume, comp-fwprop-prologue)
(comp-function-foldable-p, comp-function-call-maybe-fold)
(comp-fwprop-call, comp-fwprop-insn, comp-call-optim-func)
(comp-compute-function-type): Update for renamed functions.
* src/comp.c (emit_mvar_rval): Likewise.
* test/src/comp-tests.el (comp-tests-mentioned-p-1)
(comp-tests-cond-rw-checker-val): Likewise.
---
lisp/emacs-lisp/comp-cstr.el | 70 ++++++++++++++++++++++++++++++
lisp/emacs-lisp/comp.el | 100 ++++++++-----------------------------------
src/comp.c | 4 +-
test/src/comp-tests.el | 8 ++--
4 files changed, 93 insertions(+), 89 deletions(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index c294c53..89815f0 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -789,6 +789,76 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
;;; Entry points.
+(defun comp-cstr-imm-vld-p (cstr)
+ "Return t if one and only one immediate value can be extracted from CSTR."
+ (with-comp-cstr-accessors
+ (when (and (null (typeset cstr))
+ (null (neg cstr)))
+ (let* ((v (valset cstr))
+ (r (range cstr))
+ (valset-len (length v))
+ (range-len (length r)))
+ (if (and (= valset-len 1)
+ (= range-len 0))
+ t
+ (when (and (= valset-len 0)
+ (= range-len 1))
+ (let* ((low (caar r))
+ (high (cdar r)))
+ (and (integerp low)
+ (integerp high)
+ (= low high)))))))))
+
+(defun comp-cstr-imm (cstr)
+ "Return the immediate value of CSTR.
+`comp-cstr-imm-vld-p' *must* be satisfied before calling
+`comp-cstr-imm'."
+ (declare (gv-setter
+ (lambda (val)
+ `(with-comp-cstr-accessors
+ (if (integerp ,val)
+ (setf (typeset ,cstr) nil
+ (range ,cstr) (list (cons ,val ,val)))
+ (setf (typeset ,cstr) nil
+ (valset ,cstr) (list ,val)))))))
+ (with-comp-cstr-accessors
+ (let ((v (valset cstr)))
+ (if (= (length v) 1)
+ (car v)
+ (caar (range cstr))))))
+
+(defun comp-cstr-fixnum-p (cstr)
+ "Return t if CSTR is certainly a fixnum."
+ (with-comp-cstr-accessors
+ (when (null (neg cstr))
+ (when-let (range (range cstr))
+ (let* ((low (caar range))
+ (high (cdar (last range))))
+ (unless (or (eq low '-)
+ (< low most-negative-fixnum)
+ (eq high '+)
+ (> high most-positive-fixnum))
+ t))))))
+
+(defun comp-cstr-symbol-p (cstr)
+ "Return t if CSTR is certainly a symbol."
+ (with-comp-cstr-accessors
+ (and (null (range cstr))
+ (null (neg cstr))
+ (or (and (null (valset cstr))
+ (equal (typeset cstr) '(symbol)))
+ (and (or (null (typeset cstr))
+ (equal (typeset cstr) '(symbol)))
+ (cl-every #'symbolp (valset cstr)))))))
+
+(defsubst comp-cstr-cons-p (cstr)
+ "Return t if CSTR is certainly a cons."
+ (with-comp-cstr-accessors
+ (and (null (valset cstr))
+ (null (range cstr))
+ (null (neg cstr))
+ (equal (typeset cstr) '(cons)))))
+
(defun comp-cstr-> (dst old-dst src)
"Constraint DST being > than SRC.
SRC can be either a comp-cstr or an integer."
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 09ae383..e71d4ab 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -885,78 +885,12 @@ CFG is mutated by a pass.")
:documentation "Slot number in the array if a number or
'scratch' for scratch slot."))
-(defun comp-mvar-value-vld-p (mvar)
- "Return t if one single value can be extracted by the MVAR constrains."
- (when (and (null (comp-mvar-typeset mvar))
- (null (comp-mvar-neg mvar)))
- (let* ((v (comp-mvar-valset mvar))
- (r (comp-mvar-range mvar))
- (valset-len (length v))
- (range-len (length r)))
- (if (and (= valset-len 1)
- (= range-len 0))
- t
- (when (and (= valset-len 0)
- (= range-len 1))
- (let* ((low (caar r))
- (high (cdar r)))
- (and (integerp low)
- (integerp high)
- (= low high))))))))
-
-;; FIXME move these into cstr?
-
-(defun comp-mvar-value (mvar)
- "Return the constant value of MVAR.
-`comp-mvar-value-vld-p' *must* be satisfied before calling
-`comp-mvar-const'."
- (declare (gv-setter
- (lambda (val)
- `(if (integerp ,val)
- (setf (comp-mvar-typeset ,mvar) nil
- (comp-mvar-range ,mvar) (list (cons ,val ,val)))
- (setf (comp-mvar-typeset ,mvar) nil
- (comp-mvar-valset ,mvar) (list ,val))))))
- (let ((v (comp-mvar-valset mvar)))
- (if (= (length v) 1)
- (car v)
- (caar (comp-mvar-range mvar)))))
-
-(defun comp-mvar-fixnum-p (mvar)
- "Return t if MVAR is certainly a fixnum."
- (when (null (comp-mvar-neg mvar))
- (when-let (range (comp-mvar-range mvar))
- (let* ((low (caar range))
- (high (cdar (last range))))
- (unless (or (eq low '-)
- (< low most-negative-fixnum)
- (eq high '+)
- (> high most-positive-fixnum))
- t)))))
-
-(defun comp-mvar-symbol-p (mvar)
- "Return t if MVAR is certainly a symbol."
- (and (null (comp-mvar-range mvar))
- (null (comp-mvar-neg mvar))
- (or (and (null (comp-mvar-valset mvar))
- (equal (comp-mvar-typeset mvar) '(symbol)))
- (and (or (null (comp-mvar-typeset mvar))
- (equal (comp-mvar-typeset mvar) '(symbol)))
- (cl-every #'symbolp (comp-mvar-valset mvar))))))
-
-(defsubst comp-mvar-cons-p (mvar)
- "Return t if MVAR is certainly a cons."
- (and (null (comp-mvar-valset mvar))
- (null (comp-mvar-range mvar))
- (null (comp-mvar-neg mvar))
- (equal (comp-mvar-typeset mvar) '(cons))))
-
(defun comp-mvar-type-hint-match-p (mvar type-hint)
"Match MVAR against TYPE-HINT.
In use by the backend."
(cl-ecase type-hint
- (cons (comp-mvar-cons-p mvar))
- (fixnum (comp-mvar-fixnum-p mvar))))
+ (cons (comp-cstr-cons-p mvar))
+ (fixnum (comp-cstr-fixnum-p mvar))))
@@ -1501,7 +1435,7 @@ STACK-OFF is the index of the first slot frame involved."
(let ((mvar (make--comp-mvar :slot slot)))
(when const-vld
(comp-add-const-to-relocs constant)
- (setf (comp-mvar-value mvar) constant))
+ (setf (comp-cstr-imm mvar) constant))
(when type
(setf (comp-mvar-typeset mvar) (list type)))
mvar))
@@ -2351,8 +2285,8 @@ The assume is emitted at the beginning of the block BB."
kind)))
(push `(assume ,(make-comp-mvar :slot lhs-slot)
(,kind ,lhs
- ,(if-let* ((vld (comp-mvar-value-vld-p rhs))
- (val (comp-mvar-value rhs))
+ ,(if-let* ((vld (comp-cstr-imm-vld-p rhs))
+ (val (comp-cstr-imm rhs))
(ok (integerp val)))
val
(make-comp-mvar :slot (comp-mvar-slot
rhs)))))
@@ -3077,7 +3011,7 @@ Forward propagate immediate involed in assignments."
for insn in (comp-block-insns b)
do (pcase insn
(`(setimm ,lval ,v)
- (setf (comp-mvar-value lval) v))))))
+ (setf (comp-cstr-imm lval) v))))))
(defun comp-mvar-propagate (lval rval)
"Propagate into LVAL properties of RVAL."
@@ -3089,7 +3023,7 @@ Forward propagate immediate involed in assignments."
(defun comp-function-foldable-p (f args)
"Given function F called with ARGS return non-nil when optimizable."
(and (comp-function-pure-p f)
- (cl-every #'comp-mvar-value-vld-p args)))
+ (cl-every #'comp-cstr-imm-vld-p args)))
(defun comp-function-call-maybe-fold (insn f args)
"Given INSN when F is pure if all ARGS are known remove the function call.
@@ -3102,10 +3036,10 @@ Return non-nil if the function is folded successfully."
(cond
((eq f 'symbol-value)
(when-let* ((arg0 (car args))
- (const (comp-mvar-value-vld-p arg0))
- (ok-to-optim (member (comp-mvar-value arg0)
+ (const (comp-cstr-imm-vld-p arg0))
+ (ok-to-optim (member (comp-cstr-imm arg0)
comp-symbol-values-optimizable)))
- (rewrite-insn-as-setimm insn (symbol-value (comp-mvar-value
+ (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm
(car args))))))
((comp-function-foldable-p f args)
(ignore-errors
@@ -3118,7 +3052,7 @@ Return non-nil if the function is folded successfully."
;; and know to be pure.
(comp-func-byte-func f-in-ctxt)
f))
- (value (comp-apply-in-env f (mapcar #'comp-mvar-value args))))
+ (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args))))
(rewrite-insn-as-setimm insn value)))))))
(defun comp-fwprop-call (insn lval f args)
@@ -3127,8 +3061,8 @@ F is the function being called with arguments ARGS.
Fold the call in case."
(unless (comp-function-call-maybe-fold insn f args)
(when (and (eq 'funcall f)
- (comp-mvar-value-vld-p (car args)))
- (setf f (comp-mvar-value (car args))
+ (comp-cstr-imm-vld-p (car args)))
+ (setf f (comp-cstr-imm (car args))
args (cdr args)))
(when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
(let ((cstr (comp-cstr-f-ret cstr-f)))
@@ -3176,7 +3110,7 @@ Fold the call in case."
(<=
(comp-cstr-<= lval (car operands) (cadr operands)))))
(`(setimm ,lval ,v)
- (setf (comp-mvar-value lval) v))
+ (setf (comp-cstr-imm lval) v))
(`(phi ,lval . ,rest)
(let* ((from-latch (cl-some
(lambda (x)
@@ -3337,11 +3271,11 @@ FUNCTION can be a function-name or byte compiled
function."
(pcase insn
(`(set ,lval (callref funcall ,f . ,rest))
(when-let ((new-form (comp-call-optim-form-call
- (comp-mvar-value f) rest)))
+ (comp-cstr-imm f) rest)))
(setf insn `(set ,lval ,new-form))))
(`(callref funcall ,f . ,rest)
(when-let ((new-form (comp-call-optim-form-call
- (comp-mvar-value f) rest)))
+ (comp-cstr-imm f) rest)))
(setf insn new-form)))))))
(defun comp-call-optim (_)
@@ -3539,7 +3473,7 @@ Set it into the `type' slot."
,(comp-cstr-to-type-spec res-mvar))))
(comp-add-const-to-relocs type)
;; Fix it up.
- (setf (comp-mvar-value (comp-func-type func)) type))))
+ (setf (comp-cstr-imm (comp-func-type func)) type))))
(defun comp-finalize-container (cont)
"Finalize data container CONT."
diff --git a/src/comp.c b/src/comp.c
index 1a89e4e..21d1c1a 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -1747,11 +1747,11 @@ emit_PURE_P (gcc_jit_rvalue *ptr)
static gcc_jit_rvalue *
emit_mvar_rval (Lisp_Object mvar)
{
- Lisp_Object const_vld = CALL1I (comp-mvar-value-vld-p, mvar);
+ Lisp_Object const_vld = CALL1I (comp-cstr-imm-vld-p, mvar);
if (!NILP (const_vld))
{
- Lisp_Object value = CALL1I (comp-mvar-value, mvar);
+ Lisp_Object value = CALL1I (comp-cstr-imm, mvar);
if (comp.debug > 1)
{
Lisp_Object func =
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index fa84ffb..402ba7c 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -739,8 +739,8 @@
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html.";
(cl-loop for y in insn
when (cond
((consp y) (comp-tests-mentioned-p x y))
- ((and (comp-mvar-p y) (comp-mvar-value-vld-p y))
- (equal (comp-mvar-value y) x))
+ ((and (comp-mvar-p y) (comp-cstr-imm-vld-p y))
+ (equal (comp-cstr-imm y) x))
(t (equal x y)))
return t))
@@ -1313,8 +1313,8 @@ Return a list of results."
(lambda (insn)
(pcase insn
(`(return ,mvar)
- (and (comp-mvar-value-vld-p mvar)
- (eql (comp-mvar-value mvar) 123)))))))))
+ (and (comp-cstr-imm-vld-p mvar)
+ (eql (comp-cstr-imm mvar) 123)))))))))
(defvar comp-tests-cond-rw-expected-type nil
"Type to expect in `comp-tests-cond-rw-checker-type'.")