aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2023-11-27 15:39:24 +0100
committerAndrea Corallo2023-12-04 20:11:24 +0100
commitc8636b46356f1bfecee89f09e255e3cb93baaed4 (patch)
treef423391eecd9848dfc4e1198a6829096592b3a87
parent7a7d41e07c4627c5de08a66368309b478c88edfc (diff)
downloademacs-c8636b46356f1bfecee89f09e255e3cb93baaed4.tar.gz
emacs-c8636b46356f1bfecee89f09e255e3cb93baaed4.zip
comp: Rename some functions
* lisp/emacs-lisp/comp.el (comp--known-predicate-p) (comp--pred-to-cstr, comp-edge, comp--edge-make) (comp--block-preds, comp--gen-counter, comp-func) (comp--equality-fun-p, comp--arithm-cmp-fun-p, comp--set-op-p) (comp--assign-op-p, comp--call-op-p, comp--branch-op-p) (comp--limple-insn-call-p, comp--type-hint-p) (comp--func-unique-in-cu-p, comp--symbol-func-to-fun) (comp--function-pure-p, comp--alloc-class-to-container) (comp--add-const-to-relocs, comp--prettyformat-insn) (comp--log-func, comp--log-edges, comp-emit-setimm) (comp-emit-lambda-for-top-level, comp-add-cond-cstrs) (comp-collect-calls, comp-compute-dominator-tree) (comp-function-foldable-p, comp-function-call-maybe-fold) (comp-func-in-unit, comp-call-optim-form-call) (comp-dead-assignments-func, comp-tco) (comp-remove-type-hints-func, comp-remove-type-hints) (comp-compute-function-type, comp-finalize-relocs) (comp-compile-ctxt-to-file): Rename and update.
-rw-r--r--lisp/emacs-lisp/comp.el172
1 files changed, 86 insertions, 86 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 73764eb1d79..dd08bc93ae4 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -224,13 +224,13 @@ Useful to hook into pass checkers.")
224 finally return h) 224 finally return h)
225 "Hash table function -> `comp-constraint'.") 225 "Hash table function -> `comp-constraint'.")
226 226
227(defun comp-known-predicate-p (predicate) 227(defun comp--known-predicate-p (predicate)
228 "Return t if PREDICATE is known." 228 "Return t if PREDICATE is known."
229 (when (or (gethash predicate comp-known-predicates-h) 229 (when (or (gethash predicate comp-known-predicates-h)
230 (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))) 230 (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))
231 t)) 231 t))
232 232
233(defun comp-pred-to-cstr (predicate) 233(defun comp--pred-to-cstr (predicate)
234 "Given PREDICATE, return the corresponding constraint." 234 "Given PREDICATE, return the corresponding constraint."
235 (or (gethash predicate comp-known-predicates-h) 235 (or (gethash predicate comp-known-predicates-h)
236 (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) 236 (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))))
@@ -430,7 +430,7 @@ non local exit (ends with an `unreachable' insn)."))
430 (:include comp-block)) 430 (:include comp-block))
431 "A basic block holding only constraints.") 431 "A basic block holding only constraints.")
432 432
433(cl-defstruct (comp-edge (:copier nil) (:constructor make--comp-edge)) 433(cl-defstruct (comp-edge (:copier nil) (:constructor comp--edge-make0))
434 "An edge connecting two basic blocks." 434 "An edge connecting two basic blocks."
435 (src nil :type (or null comp-block)) 435 (src nil :type (or null comp-block))
436 (dst nil :type (or null comp-block)) 436 (dst nil :type (or null comp-block))
@@ -438,19 +438,19 @@ non local exit (ends with an `unreachable' insn)."))
438 :documentation "The index number corresponding to this edge in the 438 :documentation "The index number corresponding to this edge in the
439 edge hash.")) 439 edge hash."))
440 440
441(defun make-comp-edge (&rest args) 441(defun comp--edge-make (&rest args)
442 "Create a `comp-edge' with basic blocks SRC and DST." 442 "Create a `comp-edge' with basic blocks SRC and DST."
443 (let ((n (funcall (comp-func-edge-cnt-gen comp-func)))) 443 (let ((n (funcall (comp-func-edge-cnt-gen comp-func))))
444 (puthash 444 (puthash
445 n 445 n
446 (apply #'make--comp-edge :number n args) 446 (apply #'comp--edge-make0 :number n args)
447 (comp-func-edges-h comp-func)))) 447 (comp-func-edges-h comp-func))))
448 448
449(defun comp-block-preds (basic-block) 449(defun comp--block-preds (basic-block)
450 "Return the list of predecessors of BASIC-BLOCK." 450 "Return the list of predecessors of BASIC-BLOCK."
451 (mapcar #'comp-edge-src (comp-block-in-edges basic-block))) 451 (mapcar #'comp-edge-src (comp-block-in-edges basic-block)))
452 452
453(defun comp-gen-counter () 453(defun comp--gen-counter ()
454 "Return a sequential number generator." 454 "Return a sequential number generator."
455 (let ((n -1)) 455 (let ((n -1))
456 (lambda () 456 (lambda ()
@@ -484,9 +484,9 @@ CFG is mutated by a pass.")
484 :documentation "LAP label -> LIMPLE basic block name.") 484 :documentation "LAP label -> LIMPLE basic block name.")
485 (edges-h (make-hash-table) :type hash-table 485 (edges-h (make-hash-table) :type hash-table
486 :documentation "Hash edge-num -> edge connecting basic two blocks.") 486 :documentation "Hash edge-num -> edge connecting basic two blocks.")
487 (block-cnt-gen (funcall #'comp-gen-counter) :type function 487 (block-cnt-gen (funcall #'comp--gen-counter) :type function
488 :documentation "Generates block numbers.") 488 :documentation "Generates block numbers.")
489 (edge-cnt-gen (funcall #'comp-gen-counter) :type function 489 (edge-cnt-gen (funcall #'comp--gen-counter) :type function
490 :documentation "Generates edges numbers.") 490 :documentation "Generates edges numbers.")
491 (has-non-local nil :type boolean 491 (has-non-local nil :type boolean
492 :documentation "t if non local jumps are present.") 492 :documentation "t if non local jumps are present.")
@@ -525,39 +525,39 @@ In use by the back-end."
525 525
526 526
527 527
528(defun comp-equality-fun-p (function) 528(defun comp--equality-fun-p (function)
529 "Equality functions predicate for FUNCTION." 529 "Equality functions predicate for FUNCTION."
530 (when (memq function '(eq eql equal)) t)) 530 (when (memq function '(eq eql equal)) t))
531 531
532(defun comp-arithm-cmp-fun-p (function) 532(defun comp--arithm-cmp-fun-p (function)
533 "Predicate for arithmetic comparison functions." 533 "Predicate for arithmetic comparison functions."
534 (when (memq function '(= > < >= <=)) t)) 534 (when (memq function '(= > < >= <=)) t))
535 535
536(defun comp-set-op-p (op) 536(defun comp--set-op-p (op)
537 "Assignment predicate for OP." 537 "Assignment predicate for OP."
538 (when (memq op comp-limple-sets) t)) 538 (when (memq op comp-limple-sets) t))
539 539
540(defun comp-assign-op-p (op) 540(defun comp--assign-op-p (op)
541 "Assignment predicate for OP." 541 "Assignment predicate for OP."
542 (when (memq op comp-limple-assignments) t)) 542 (when (memq op comp-limple-assignments) t))
543 543
544(defun comp-call-op-p (op) 544(defun comp--call-op-p (op)
545 "Call predicate for OP." 545 "Call predicate for OP."
546 (when (memq op comp-limple-calls) t)) 546 (when (memq op comp-limple-calls) t))
547 547
548(defun comp-branch-op-p (op) 548(defun comp--branch-op-p (op)
549 "Branch predicate for OP." 549 "Branch predicate for OP."
550 (when (memq op comp-limple-branches) t)) 550 (when (memq op comp-limple-branches) t))
551 551
552(defsubst comp-limple-insn-call-p (insn) 552(defsubst comp--limple-insn-call-p (insn)
553 "Limple INSN call predicate." 553 "Limple INSN call predicate."
554 (comp-call-op-p (car-safe insn))) 554 (comp--call-op-p (car-safe insn)))
555 555
556(defun comp-type-hint-p (func) 556(defun comp--type-hint-p (func)
557 "Type-hint predicate for function name FUNC." 557 "Type-hint predicate for function name FUNC."
558 (when (memq func comp-type-hints) t)) 558 (when (memq func comp-type-hints) t))
559 559
560(defun comp-func-unique-in-cu-p (func) 560(defun comp--func-unique-in-cu-p (func)
561 "Return t if FUNC is known to be unique in the current compilation unit." 561 "Return t if FUNC is known to be unique in the current compilation unit."
562 (if (symbolp func) 562 (if (symbolp func)
563 (cl-loop with h = (make-hash-table :test #'eq) 563 (cl-loop with h = (make-hash-table :test #'eq)
@@ -569,46 +569,46 @@ In use by the back-end."
569 finally return t) 569 finally return t)
570 t)) 570 t))
571 571
572(defsubst comp-symbol-func-to-fun (symbol-funcion) 572(defsubst comp--symbol-func-to-fun (symbol-funcion)
573 "Given a function called SYMBOL-FUNCION return its `comp-func'." 573 "Given a function called SYMBOL-FUNCION return its `comp-func'."
574 (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h 574 (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h
575 comp-ctxt)) 575 comp-ctxt))
576 (comp-ctxt-funcs-h comp-ctxt))) 576 (comp-ctxt-funcs-h comp-ctxt)))
577 577
578(defun comp-function-pure-p (f) 578(defun comp--function-pure-p (f)
579 "Return t if F is pure." 579 "Return t if F is pure."
580 (or (get f 'pure) 580 (or (get f 'pure)
581 (when-let ((func (comp-symbol-func-to-fun f))) 581 (when-let ((func (comp--symbol-func-to-fun f)))
582 (comp-func-pure func)))) 582 (comp-func-pure func))))
583 583
584(defun comp-alloc-class-to-container (alloc-class) 584(defun comp--alloc-class-to-container (alloc-class)
585 "Given ALLOC-CLASS, return the data container for the current context. 585 "Given ALLOC-CLASS, return the data container for the current context.
586Assume allocation class `d-default' as default." 586Assume allocation class `d-default' as default."
587 (cl-struct-slot-value 'comp-ctxt (or alloc-class 'd-default) comp-ctxt)) 587 (cl-struct-slot-value 'comp-ctxt (or alloc-class 'd-default) comp-ctxt))
588 588
589(defsubst comp-add-const-to-relocs (obj) 589(defsubst comp--add-const-to-relocs (obj)
590 "Keep track of OBJ into the ctxt relocations." 590 "Keep track of OBJ into the ctxt relocations."
591 (puthash obj t (comp-data-container-idx (comp-alloc-class-to-container 591 (puthash obj t (comp-data-container-idx (comp--alloc-class-to-container
592 comp-curr-allocation-class)))) 592 comp-curr-allocation-class))))
593 593
594 594
595;;; Log routines. 595;;; Log routines.
596 596
597(defun comp-prettyformat-mvar (mvar) 597(defun comp--prettyformat-mvar (mvar)
598 (format "#(mvar %s %s %S)" 598 (format "#(mvar %s %s %S)"
599 (comp-mvar-id mvar) 599 (comp-mvar-id mvar)
600 (comp-mvar-slot mvar) 600 (comp-mvar-slot mvar)
601 (comp-cstr-to-type-spec mvar))) 601 (comp-cstr-to-type-spec mvar)))
602 602
603(defun comp-prettyformat-insn (insn) 603(defun comp--prettyformat-insn (insn)
604 (cond 604 (cond
605 ((comp-mvar-p insn) 605 ((comp-mvar-p insn)
606 (comp-prettyformat-mvar insn)) 606 (comp--prettyformat-mvar insn))
607 ((proper-list-p insn) 607 ((proper-list-p insn)
608 (concat "(" (mapconcat #'comp-prettyformat-insn insn " ") ")")) 608 (concat "(" (mapconcat #'comp--prettyformat-insn insn " ") ")"))
609 (t (prin1-to-string insn)))) 609 (t (prin1-to-string insn))))
610 610
611(defun comp-log-func (func verbosity) 611(defun comp--log-func (func verbosity)
612 "Log function FUNC at VERBOSITY. 612 "Log function FUNC at VERBOSITY.
613VERBOSITY is a number between 0 and 3." 613VERBOSITY is a number between 0 and 3."
614 (when (>= native-comp-verbose verbosity) 614 (when (>= native-comp-verbose verbosity)
@@ -619,9 +619,9 @@ VERBOSITY is a number between 0 and 3."
619 do (comp-log (concat "<" (symbol-name block-name) ">") verbosity) 619 do (comp-log (concat "<" (symbol-name block-name) ">") verbosity)
620 (cl-loop 620 (cl-loop
621 for insn in (comp-block-insns bb) 621 for insn in (comp-block-insns bb)
622 do (comp-log (comp-prettyformat-insn insn) verbosity))))) 622 do (comp-log (comp--prettyformat-insn insn) verbosity)))))
623 623
624(defun comp-log-edges (func) 624(defun comp--log-edges (func)
625 "Log edges in FUNC." 625 "Log edges in FUNC."
626 (let ((edges (comp-func-edges-h func))) 626 (let ((edges (comp-func-edges-h func)))
627 (comp-log (format "\nEdges in function: %s\n" 627 (comp-log (format "\nEdges in function: %s\n"
@@ -963,7 +963,7 @@ STACK-OFF is the index of the first slot frame involved."
963 "`comp-mvar' initializer." 963 "`comp-mvar' initializer."
964 (let ((mvar (make--comp-mvar :slot slot))) 964 (let ((mvar (make--comp-mvar :slot slot)))
965 (when const-vld 965 (when const-vld
966 (comp-add-const-to-relocs constant) 966 (comp--add-const-to-relocs constant)
967 (setf (comp-cstr-imm mvar) constant)) 967 (setf (comp-cstr-imm mvar) constant))
968 (when type 968 (when type
969 (setf (comp-mvar-typeset mvar) (list type))) 969 (setf (comp-mvar-typeset mvar) (list type)))
@@ -1008,7 +1008,7 @@ If DST-N is specified, use it; otherwise assume it to be the current slot."
1008 1008
1009(defsubst comp-emit-setimm (val) 1009(defsubst comp-emit-setimm (val)
1010 "Set constant VAL to current slot." 1010 "Set constant VAL to current slot."
1011 (comp-add-const-to-relocs val) 1011 (comp--add-const-to-relocs val)
1012 ;; Leave relocation index nil on purpose, will be fixed-up in final 1012 ;; Leave relocation index nil on purpose, will be fixed-up in final
1013 ;; by `comp-finalize-relocs'. 1013 ;; by `comp-finalize-relocs'.
1014 (comp-emit `(setimm ,(comp-slot) ,val))) 1014 (comp-emit `(setimm ,(comp-slot) ,val)))
@@ -1496,7 +1496,7 @@ and the annotation emission."
1496 (cl-loop for bb being the hash-value in (comp-func-blocks func) 1496 (cl-loop for bb being the hash-value in (comp-func-blocks func)
1497 do (setf (comp-block-insns bb) 1497 do (setf (comp-block-insns bb)
1498 (nreverse (comp-block-insns bb)))) 1498 (nreverse (comp-block-insns bb))))
1499 (comp-log-func func 2) 1499 (comp--log-func func 2)
1500 func) 1500 func)
1501 1501
1502(cl-defgeneric comp-prepare-args-for-top-level (function) 1502(cl-defgeneric comp-prepare-args-for-top-level (function)
@@ -1570,7 +1570,7 @@ and the annotation emission."
1570These are stored in the reloc data array." 1570These are stored in the reloc data array."
1571 (let ((args (comp-prepare-args-for-top-level func))) 1571 (let ((args (comp-prepare-args-for-top-level func)))
1572 (let ((comp-curr-allocation-class 'd-impure)) 1572 (let ((comp-curr-allocation-class 'd-impure))
1573 (comp-add-const-to-relocs (comp-func-byte-func func))) 1573 (comp--add-const-to-relocs (comp-func-byte-func func)))
1574 (comp-emit 1574 (comp-emit
1575 (comp-call 'comp--register-lambda 1575 (comp-call 'comp--register-lambda
1576 ;; mvar to be fixed-up when containers are 1576 ;; mvar to be fixed-up when containers are
@@ -1773,7 +1773,7 @@ into the C code forwarding the compilation unit."
1773 do (cl-loop 1773 do (cl-loop
1774 for insn in (comp-block-insns b) 1774 for insn in (comp-block-insns b)
1775 for (op . args) = insn 1775 for (op . args) = insn
1776 if (comp-assign-op-p op) 1776 if (comp--assign-op-p op)
1777 do (comp-collect-mvars (cdr args)) 1777 do (comp-collect-mvars (cdr args))
1778 else 1778 else
1779 do (comp-collect-mvars args)))) 1779 do (comp-collect-mvars args))))
@@ -1822,7 +1822,7 @@ The assume is emitted at the beginning of the block BB."
1822 (comp-cstr-negation-make rhs) 1822 (comp-cstr-negation-make rhs)
1823 rhs))) 1823 rhs)))
1824 (comp-block-insns bb)))) 1824 (comp-block-insns bb))))
1825 ((pred comp-arithm-cmp-fun-p) 1825 ((pred comp--arithm-cmp-fun-p)
1826 (when-let ((kind (if negated 1826 (when-let ((kind (if negated
1827 (comp-negate-arithm-cmp-fun kind) 1827 (comp-negate-arithm-cmp-fun kind)
1828 kind))) 1828 kind)))
@@ -1855,7 +1855,7 @@ Return OP otherwise."
1855 (cl-loop 1855 (cl-loop
1856 with new-bb = (make-comp-block-cstr :name bb-symbol 1856 with new-bb = (make-comp-block-cstr :name bb-symbol
1857 :insns `((jump ,(comp-block-name bb-b)))) 1857 :insns `((jump ,(comp-block-name bb-b))))
1858 with new-edge = (make-comp-edge :src bb-a :dst new-bb) 1858 with new-edge = (comp--edge-make :src bb-a :dst new-bb)
1859 for ed in (comp-block-in-edges bb-b) 1859 for ed in (comp-block-in-edges bb-b)
1860 when (eq (comp-edge-src ed) bb-a) 1860 when (eq (comp-edge-src ed) bb-a)
1861 do 1861 do
@@ -1886,7 +1886,7 @@ Keep on searching till EXIT-INSN is encountered."
1886 when (eq insn exit-insn) 1886 when (eq insn exit-insn)
1887 do (cl-return (and (comp-mvar-p res) res)) 1887 do (cl-return (and (comp-mvar-p res) res))
1888 do (pcase insn 1888 do (pcase insn
1889 (`(,(pred comp-assign-op-p) ,(pred targetp) ,rhs) 1889 (`(,(pred comp--assign-op-p) ,(pred targetp) ,rhs)
1890 (setf res rhs))) 1890 (setf res rhs)))
1891 finally (cl-assert nil)))) 1891 finally (cl-assert nil))))
1892 1892
@@ -1972,9 +1972,9 @@ TARGET-BB-SYM is the symbol name of the target block."
1972 (push `(assume ,mvar-tested ,(make-comp-mvar :type (comp-cstr-cl-tag mvar-tag) :neg t)) 1972 (push `(assume ,mvar-tested ,(make-comp-mvar :type (comp-cstr-cl-tag mvar-tag) :neg t))
1973 (comp-block-insns (comp-add-cond-cstrs-target-block b bb1)))) 1973 (comp-block-insns (comp-add-cond-cstrs-target-block b bb1))))
1974 (`((set ,(and (pred comp-mvar-p) cmp-res) 1974 (`((set ,(and (pred comp-mvar-p) cmp-res)
1975 (,(pred comp-call-op-p) 1975 (,(pred comp--call-op-p)
1976 ,(and (or (pred comp-equality-fun-p) 1976 ,(and (or (pred comp--equality-fun-p)
1977 (pred comp-arithm-cmp-fun-p)) 1977 (pred comp--arithm-cmp-fun-p))
1978 fun) 1978 fun)
1979 ,op1 ,op2)) 1979 ,op1 ,op2))
1980 ;; (comment ,_comment-str) 1980 ;; (comment ,_comment-str)
@@ -2006,14 +2006,14 @@ TARGET-BB-SYM is the symbol name of the target block."
2006 block-target negated))) 2006 block-target negated)))
2007 finally (cl-return-from in-the-basic-block))) 2007 finally (cl-return-from in-the-basic-block)))
2008 (`((set ,(and (pred comp-mvar-p) cmp-res) 2008 (`((set ,(and (pred comp-mvar-p) cmp-res)
2009 (,(pred comp-call-op-p) 2009 (,(pred comp--call-op-p)
2010 ,(and (pred comp-known-predicate-p) fun) 2010 ,(and (pred comp--known-predicate-p) fun)
2011 ,op)) 2011 ,op))
2012 ;; (comment ,_comment-str) 2012 ;; (comment ,_comment-str)
2013 (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) 2013 (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
2014 (cl-loop 2014 (cl-loop
2015 with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) 2015 with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
2016 with cstr = (comp-pred-to-cstr fun) 2016 with cstr = (comp--pred-to-cstr fun)
2017 for branch-target-cell on blocks 2017 for branch-target-cell on blocks
2018 for branch-target = (car branch-target-cell) 2018 for branch-target = (car branch-target-cell)
2019 for negated in '(t nil) 2019 for negated in '(t nil)
@@ -2025,14 +2025,14 @@ TARGET-BB-SYM is the symbol name of the target block."
2025 finally (cl-return-from in-the-basic-block))) 2025 finally (cl-return-from in-the-basic-block)))
2026 ;; Match predicate on the negated branch (unless). 2026 ;; Match predicate on the negated branch (unless).
2027 (`((set ,(and (pred comp-mvar-p) cmp-res) 2027 (`((set ,(and (pred comp-mvar-p) cmp-res)
2028 (,(pred comp-call-op-p) 2028 (,(pred comp--call-op-p)
2029 ,(and (pred comp-known-predicate-p) fun) 2029 ,(and (pred comp--known-predicate-p) fun)
2030 ,op)) 2030 ,op))
2031 (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) 2031 (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p)))
2032 (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) 2032 (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks))
2033 (cl-loop 2033 (cl-loop
2034 with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) 2034 with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
2035 with cstr = (comp-pred-to-cstr fun) 2035 with cstr = (comp--pred-to-cstr fun)
2036 for branch-target-cell on blocks 2036 for branch-target-cell on blocks
2037 for branch-target = (car branch-target-cell) 2037 for branch-target = (car branch-target-cell)
2038 for negated in '(nil t) 2038 for negated in '(nil t)
@@ -2084,10 +2084,10 @@ TARGET-BB-SYM is the symbol name of the target block."
2084 (comp-loop-insn-in-block bb 2084 (comp-loop-insn-in-block bb
2085 (when-let ((match 2085 (when-let ((match
2086 (pcase insn 2086 (pcase insn
2087 (`(set ,lhs (,(pred comp-call-op-p) ,f . ,args)) 2087 (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args))
2088 (when-let ((cstr-f (gethash f comp-known-func-cstr-h))) 2088 (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
2089 (cl-values f cstr-f lhs args))) 2089 (cl-values f cstr-f lhs args)))
2090 (`(,(pred comp-call-op-p) ,f . ,args) 2090 (`(,(pred comp--call-op-p) ,f . ,args)
2091 (when-let ((cstr-f (gethash f comp-known-func-cstr-h))) 2091 (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
2092 (cl-values f cstr-f nil args)))))) 2092 (cl-values f cstr-f nil args))))))
2093 (cl-multiple-value-bind (f cstr-f lhs args) match 2093 (cl-multiple-value-bind (f cstr-f lhs args) match
@@ -2126,7 +2126,7 @@ blocks."
2126 (comp-add-cond-cstrs-simple) 2126 (comp-add-cond-cstrs-simple)
2127 (comp-add-cond-cstrs) 2127 (comp-add-cond-cstrs)
2128 (comp-add-call-cstr) 2128 (comp-add-call-cstr)
2129 (comp-log-func comp-func 3)))) 2129 (comp--log-func comp-func 3))))
2130 (comp-ctxt-funcs-h comp-ctxt))) 2130 (comp-ctxt-funcs-h comp-ctxt)))
2131 2131
2132 2132
@@ -2145,9 +2145,9 @@ blocks."
2145 do (cl-loop 2145 do (cl-loop
2146 for insn in (comp-block-insns b) 2146 for insn in (comp-block-insns b)
2147 do (pcase insn 2147 do (pcase insn
2148 (`(set ,_lval (,(pred comp-call-op-p) ,f . ,_rest)) 2148 (`(set ,_lval (,(pred comp--call-op-p) ,f . ,_rest))
2149 (puthash f t h)) 2149 (puthash f t h))
2150 (`(,(pred comp-call-op-p) ,f . ,_rest) 2150 (`(,(pred comp--call-op-p) ,f . ,_rest)
2151 (puthash f t h)))) 2151 (puthash f t h))))
2152 finally return (cl-loop 2152 finally return (cl-loop
2153 for f being each hash-key of h 2153 for f being each hash-key of h
@@ -2160,7 +2160,7 @@ blocks."
2160(defun comp-pure-infer-func (f) 2160(defun comp-pure-infer-func (f)
2161 "If all functions called by F are pure then F is pure too." 2161 "If all functions called by F are pure then F is pure too."
2162 (when (and (cl-every (lambda (x) 2162 (when (and (cl-every (lambda (x)
2163 (or (comp-function-pure-p x) 2163 (or (comp--function-pure-p x)
2164 (eq x (comp-func-name f)))) 2164 (eq x (comp-func-name f))))
2165 (comp-collect-calls f)) 2165 (comp-collect-calls f))
2166 (not (eq (comp-func-pure f) t))) 2166 (not (eq (comp-func-pure f) t)))
@@ -2224,16 +2224,16 @@ blocks."
2224 for (op first second third forth) = last-insn 2224 for (op first second third forth) = last-insn
2225 do (cl-case op 2225 do (cl-case op
2226 (jump 2226 (jump
2227 (make-comp-edge :src bb :dst (gethash first blocks))) 2227 (comp--edge-make :src bb :dst (gethash first blocks)))
2228 (cond-jump 2228 (cond-jump
2229 (make-comp-edge :src bb :dst (gethash third blocks)) 2229 (comp--edge-make :src bb :dst (gethash third blocks))
2230 (make-comp-edge :src bb :dst (gethash forth blocks))) 2230 (comp--edge-make :src bb :dst (gethash forth blocks)))
2231 (cond-jump-narg-leq 2231 (cond-jump-narg-leq
2232 (make-comp-edge :src bb :dst (gethash second blocks)) 2232 (comp--edge-make :src bb :dst (gethash second blocks))
2233 (make-comp-edge :src bb :dst (gethash third blocks))) 2233 (comp--edge-make :src bb :dst (gethash third blocks)))
2234 (push-handler 2234 (push-handler
2235 (make-comp-edge :src bb :dst (gethash third blocks)) 2235 (comp--edge-make :src bb :dst (gethash third blocks))
2236 (make-comp-edge :src bb :dst (gethash forth blocks))) 2236 (comp--edge-make :src bb :dst (gethash forth blocks)))
2237 (return) 2237 (return)
2238 (unreachable) 2238 (unreachable)
2239 (otherwise 2239 (otherwise
@@ -2250,7 +2250,7 @@ blocks."
2250 (comp-block-out-edges (comp-edge-src edge))) 2250 (comp-block-out-edges (comp-edge-src edge)))
2251 (push edge 2251 (push edge
2252 (comp-block-in-edges (comp-edge-dst edge)))) 2252 (comp-block-in-edges (comp-edge-dst edge))))
2253 (comp-log-edges comp-func))) 2253 (comp--log-edges comp-func)))
2254 2254
2255(defun comp-collect-rev-post-order (basic-block) 2255(defun comp-collect-rev-post-order (basic-block)
2256 "Walk BASIC-BLOCK children and return their name in reversed post-order." 2256 "Walk BASIC-BLOCK children and return their name in reversed post-order."
@@ -2306,7 +2306,7 @@ blocks."
2306 do (cl-loop 2306 do (cl-loop
2307 for name in (cdr rev-bb-list) 2307 for name in (cdr rev-bb-list)
2308 for b = (gethash name blocks) 2308 for b = (gethash name blocks)
2309 for preds = (comp-block-preds b) 2309 for preds = (comp--block-preds b)
2310 for new-idom = (first-processed preds) 2310 for new-idom = (first-processed preds)
2311 initially (setf changed nil) 2311 initially (setf changed nil)
2312 do (cl-loop for p in (delq new-idom preds) 2312 do (cl-loop for p in (delq new-idom preds)
@@ -2326,7 +2326,7 @@ blocks."
2326 (cl-loop with blocks = (comp-func-blocks comp-func) 2326 (cl-loop with blocks = (comp-func-blocks comp-func)
2327 for b-name being each hash-keys of blocks 2327 for b-name being each hash-keys of blocks
2328 using (hash-value b) 2328 using (hash-value b)
2329 for preds = (comp-block-preds b) 2329 for preds = (comp--block-preds b)
2330 when (length> preds 1) ; All joins 2330 when (length> preds 1) ; All joins
2331 do (cl-loop for p in preds 2331 do (cl-loop for p in preds
2332 for runner = p 2332 for runner = p
@@ -2358,7 +2358,7 @@ blocks."
2358 ;; Return t if a SLOT-N was assigned within BB. 2358 ;; Return t if a SLOT-N was assigned within BB.
2359 (cl-loop for insn in (comp-block-insns bb) 2359 (cl-loop for insn in (comp-block-insns bb)
2360 for op = (car insn) 2360 for op = (car insn)
2361 when (or (and (comp-assign-op-p op) 2361 when (or (and (comp--assign-op-p op)
2362 (eql slot-n (comp-mvar-slot (cadr insn)))) 2362 (eql slot-n (comp-mvar-slot (cadr insn))))
2363 ;; fetch-handler is after a non local 2363 ;; fetch-handler is after a non local
2364 ;; therefore clobbers all frame!!! 2364 ;; therefore clobbers all frame!!!
@@ -2424,7 +2424,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
2424 (setf (comp-vec-aref frame slot-n) mvar 2424 (setf (comp-vec-aref frame slot-n) mvar
2425 (cadr insn) mvar)))) 2425 (cadr insn) mvar))))
2426 (pcase insn 2426 (pcase insn
2427 (`(,(pred comp-assign-op-p) ,(pred targetp) . ,_) 2427 (`(,(pred comp--assign-op-p) ,(pred targetp) . ,_)
2428 (let ((mvar (comp-vec-aref frame slot-n))) 2428 (let ((mvar (comp-vec-aref frame slot-n)))
2429 (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn)))) 2429 (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
2430 (new-lvalue)) 2430 (new-lvalue))
@@ -2511,7 +2511,7 @@ Return t when one or more block was removed, nil otherwise."
2511 (comp-place-phis) 2511 (comp-place-phis)
2512 (comp-ssa-rename) 2512 (comp-ssa-rename)
2513 (comp-finalize-phis) 2513 (comp-finalize-phis)
2514 (comp-log-func comp-func 3) 2514 (comp--log-func comp-func 3)
2515 (setf (comp-func-ssa-status f) t)))) 2515 (setf (comp-func-ssa-status f) t))))
2516 (comp-ctxt-funcs-h comp-ctxt))) 2516 (comp-ctxt-funcs-h comp-ctxt)))
2517 2517
@@ -2574,7 +2574,7 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or
2574 2574
2575(defun comp-function-foldable-p (f args) 2575(defun comp-function-foldable-p (f args)
2576 "Given function F called with ARGS, return non-nil when optimizable." 2576 "Given function F called with ARGS, return non-nil when optimizable."
2577 (and (comp-function-pure-p f) 2577 (and (comp--function-pure-p f)
2578 (cl-every #'comp-cstr-imm-vld-p args))) 2578 (cl-every #'comp-cstr-imm-vld-p args)))
2579 2579
2580(defun comp-function-call-maybe-fold (insn f args) 2580(defun comp-function-call-maybe-fold (insn f args)
@@ -2582,7 +2582,7 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or
2582Return non-nil if the function is folded successfully." 2582Return non-nil if the function is folded successfully."
2583 (cl-flet ((rewrite-insn-as-setimm (insn value) 2583 (cl-flet ((rewrite-insn-as-setimm (insn value)
2584 ;; See `comp-emit-setimm'. 2584 ;; See `comp-emit-setimm'.
2585 (comp-add-const-to-relocs value) 2585 (comp--add-const-to-relocs value)
2586 (setf (car insn) 'setimm 2586 (setf (car insn) 'setimm
2587 (cddr insn) `(,value)))) 2587 (cddr insn) `(,value))))
2588 (cond 2588 (cond
@@ -2599,7 +2599,7 @@ Return non-nil if the function is folded successfully."
2599 ;; should do basic block pruning in order to be sure that this 2599 ;; should do basic block pruning in order to be sure that this
2600 ;; is not dead-code. This is now left to gcc, to be 2600 ;; is not dead-code. This is now left to gcc, to be
2601 ;; implemented only if we want a reliable diagnostic here. 2601 ;; implemented only if we want a reliable diagnostic here.
2602 (let* ((f (if-let (f-in-ctxt (comp-symbol-func-to-fun f)) 2602 (let* ((f (if-let (f-in-ctxt (comp--symbol-func-to-fun f))
2603 ;; If the function is IN the compilation ctxt 2603 ;; If the function is IN the compilation ctxt
2604 ;; and know to be pure. 2604 ;; and know to be pure.
2605 (comp-func-byte-func f-in-ctxt) 2605 (comp-func-byte-func f-in-ctxt)
@@ -2676,7 +2676,7 @@ Fold the call in case."
2676 (comp-func-blocks comp-func)))) 2676 (comp-func-blocks comp-func))))
2677 (or (comp-latch-p bb) 2677 (or (comp-latch-p bb)
2678 (when (comp-block-cstr-p bb) 2678 (when (comp-block-cstr-p bb)
2679 (comp-latch-p (car (comp-block-preds bb))))))) 2679 (comp-latch-p (car (comp--block-preds bb)))))))
2680 rest)) 2680 rest))
2681 (prop-fn (if from-latch 2681 (prop-fn (if from-latch
2682 #'comp-cstr-union-no-range 2682 #'comp-cstr-union-no-range
@@ -2743,7 +2743,7 @@ Return t if something was changed."
2743 (format "fwprop pass jammed into %s?" (comp-func-name f)))) 2743 (format "fwprop pass jammed into %s?" (comp-func-name f))))
2744 (comp-log (format "Propagation run %d times\n" i) 2)) 2744 (comp-log (format "Propagation run %d times\n" i) 2))
2745 (comp-rewrite-non-locals) 2745 (comp-rewrite-non-locals)
2746 (comp-log-func comp-func 3)))) 2746 (comp--log-func comp-func 3))))
2747 (comp-ctxt-funcs-h comp-ctxt))) 2747 (comp-ctxt-funcs-h comp-ctxt)))
2748 2748
2749 2749
@@ -2766,7 +2766,7 @@ Return t if something was changed."
2766 "Given FUNC return the `comp-fun' definition in the current context. 2766 "Given FUNC return the `comp-fun' definition in the current context.
2767FUNCTION can be a function-name or byte compiled function." 2767FUNCTION can be a function-name or byte compiled function."
2768 (if (symbolp func) 2768 (if (symbolp func)
2769 (comp-symbol-func-to-fun func) 2769 (comp--symbol-func-to-fun func)
2770 (cl-assert (byte-code-function-p func)) 2770 (cl-assert (byte-code-function-p func))
2771 (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt)))) 2771 (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt))))
2772 2772
@@ -2804,7 +2804,7 @@ FUNCTION can be a function-name or byte compiled function."
2804 ((and comp-func-callee 2804 ((and comp-func-callee
2805 (comp-func-c-name comp-func-callee) 2805 (comp-func-c-name comp-func-callee)
2806 (or (and (>= (comp-func-speed comp-func) 3) 2806 (or (and (>= (comp-func-speed comp-func) 3)
2807 (comp-func-unique-in-cu-p callee)) 2807 (comp--func-unique-in-cu-p callee))
2808 (and (>= (comp-func-speed comp-func) 2) 2808 (and (>= (comp-func-speed comp-func) 2)
2809 ;; Anonymous lambdas can't be redefined so are 2809 ;; Anonymous lambdas can't be redefined so are
2810 ;; always safe to optimize. 2810 ;; always safe to optimize.
@@ -2816,7 +2816,7 @@ FUNCTION can be a function-name or byte compiled function."
2816 args 2816 args
2817 (fill-args args (comp-args-max func-args))))) 2817 (fill-args args (comp-args-max func-args)))))
2818 `(,call-type ,(comp-func-c-name comp-func-callee) ,@args))) 2818 `(,call-type ,(comp-func-c-name comp-func-callee) ,@args)))
2819 ((comp-type-hint-p callee) 2819 ((comp--type-hint-p callee)
2820 `(call ,callee ,@args))))))) 2820 `(call ,callee ,@args)))))))
2821 2821
2822(defun comp-call-optim-func () 2822(defun comp-call-optim-func ()
@@ -2873,7 +2873,7 @@ Return the list of m-var ids nuked."
2873 do (cl-loop 2873 do (cl-loop
2874 for insn in (comp-block-insns b) 2874 for insn in (comp-block-insns b)
2875 for (op arg0 . rest) = insn 2875 for (op arg0 . rest) = insn
2876 if (comp-assign-op-p op) 2876 if (comp--assign-op-p op)
2877 do (push (comp-mvar-id arg0) l-vals) 2877 do (push (comp-mvar-id arg0) l-vals)
2878 (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals)) 2878 (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals))
2879 else 2879 else
@@ -2891,10 +2891,10 @@ Return the list of m-var ids nuked."
2891 for b being each hash-value of (comp-func-blocks comp-func) 2891 for b being each hash-value of (comp-func-blocks comp-func)
2892 do (comp-loop-insn-in-block b 2892 do (comp-loop-insn-in-block b
2893 (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn 2893 (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn
2894 (when (and (comp-assign-op-p op) 2894 (when (and (comp--assign-op-p op)
2895 (memq (comp-mvar-id arg0) nuke-list)) 2895 (memq (comp-mvar-id arg0) nuke-list))
2896 (setf insn 2896 (setf insn
2897 (if (comp-limple-insn-call-p arg1) 2897 (if (comp--limple-insn-call-p arg1)
2898 arg1 2898 arg1
2899 `(comment ,(format "optimized out: %s" 2899 `(comment ,(format "optimized out: %s"
2900 insn)))))))) 2900 insn))))))))
@@ -2911,7 +2911,7 @@ Return the list of m-var ids nuked."
2911 for i from 1 2911 for i from 1
2912 while (comp-dead-assignments-func) 2912 while (comp-dead-assignments-func)
2913 finally (comp-log (format "dead code rm run %d times\n" i) 2) 2913 finally (comp-log (format "dead code rm run %d times\n" i) 2)
2914 (comp-log-func comp-func 3)))) 2914 (comp--log-func comp-func 3))))
2915 (comp-ctxt-funcs-h comp-ctxt))) 2915 (comp-ctxt-funcs-h comp-ctxt)))
2916 2916
2917 2917
@@ -2951,7 +2951,7 @@ Return the list of m-var ids nuked."
2951 (not (comp-func-has-non-local f))) 2951 (not (comp-func-has-non-local f)))
2952 (let ((comp-func f)) 2952 (let ((comp-func f))
2953 (comp-tco-func) 2953 (comp-tco-func)
2954 (comp-log-func comp-func 3)))) 2954 (comp--log-func comp-func 3))))
2955 (comp-ctxt-funcs-h comp-ctxt))) 2955 (comp-ctxt-funcs-h comp-ctxt)))
2956 2956
2957 2957
@@ -2967,7 +2967,7 @@ These are substituted with a normal `set' op."
2967 for b being each hash-value of (comp-func-blocks comp-func) 2967 for b being each hash-value of (comp-func-blocks comp-func)
2968 do (comp-loop-insn-in-block b 2968 do (comp-loop-insn-in-block b
2969 (pcase insn 2969 (pcase insn
2970 (`(set ,l-val (call ,(pred comp-type-hint-p) ,r-val)) 2970 (`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val))
2971 (setf insn `(set ,l-val ,r-val))))))) 2971 (setf insn `(set ,l-val ,r-val)))))))
2972 2972
2973(defun comp-remove-type-hints (_) 2973(defun comp-remove-type-hints (_)
@@ -2976,7 +2976,7 @@ These are substituted with a normal `set' op."
2976 (when (>= (comp-func-speed f) 2) 2976 (when (>= (comp-func-speed f) 2)
2977 (let ((comp-func f)) 2977 (let ((comp-func f))
2978 (comp-remove-type-hints-func) 2978 (comp-remove-type-hints-func)
2979 (comp-log-func comp-func 3)))) 2979 (comp--log-func comp-func 3))))
2980 (comp-ctxt-funcs-h comp-ctxt))) 2980 (comp-ctxt-funcs-h comp-ctxt)))
2981 2981
2982 2982
@@ -3029,7 +3029,7 @@ Set it into the `type' slot."
3029 finally return res))) 3029 finally return res)))
3030 (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func)) 3030 (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func))
3031 ,(comp-cstr-to-type-spec res-mvar)))) 3031 ,(comp-cstr-to-type-spec res-mvar))))
3032 (comp-add-const-to-relocs type) 3032 (comp--add-const-to-relocs type)
3033 ;; Fix it up. 3033 ;; Fix it up.
3034 (setf (comp-cstr-imm (comp-func-type func)) type)))) 3034 (setf (comp-cstr-imm (comp-func-type func)) type))))
3035 3035
@@ -3058,7 +3058,7 @@ Update all insn accordingly."
3058 ;; Symbols imported by C inlined functions. We do this here because 3058 ;; Symbols imported by C inlined functions. We do this here because
3059 ;; is better to add all objs to the relocation containers before we 3059 ;; is better to add all objs to the relocation containers before we
3060 ;; compacting them. 3060 ;; compacting them.
3061 (mapc #'comp-add-const-to-relocs '(nil t consp listp symbol-with-pos-p)) 3061 (mapc #'comp--add-const-to-relocs '(nil t consp listp symbol-with-pos-p))
3062 3062
3063 (let* ((d-default (comp-ctxt-d-default comp-ctxt)) 3063 (let* ((d-default (comp-ctxt-d-default comp-ctxt))
3064 (d-default-idx (comp-data-container-idx d-default)) 3064 (d-default-idx (comp-data-container-idx d-default))
@@ -3113,7 +3113,7 @@ Prepare every function for final compilation and drive the C back-end."
3113 (let ((dir (file-name-directory name))) 3113 (let ((dir (file-name-directory name)))
3114 (comp-finalize-relocs) 3114 (comp-finalize-relocs)
3115 (maphash (lambda (_ f) 3115 (maphash (lambda (_ f)
3116 (comp-log-func f 1)) 3116 (comp--log-func f 1))
3117 (comp-ctxt-funcs-h comp-ctxt)) 3117 (comp-ctxt-funcs-h comp-ctxt))
3118 (unless (file-exists-p dir) 3118 (unless (file-exists-p dir)
3119 ;; In case it's created in the meanwhile. 3119 ;; In case it's created in the meanwhile.