From 2acc46b55bdf518ece6301913ffa074f31563fa4 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 27 Feb 2021 21:26:41 +0100 Subject: [PATCH] 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 c294c53b6b0..89815f03b53 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 09ae3834922..e71d4abbd53 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 1a89e4e62a4..21d1c1a23cf 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 fa84ffbc0bf..402ba7cd8b8 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'.") -- 2.39.2