diff options
| author | Andrea Corallo | 2023-11-27 15:39:24 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2023-12-04 20:11:24 +0100 |
| commit | c8636b46356f1bfecee89f09e255e3cb93baaed4 (patch) | |
| tree | f423391eecd9848dfc4e1198a6829096592b3a87 | |
| parent | 7a7d41e07c4627c5de08a66368309b478c88edfc (diff) | |
| download | emacs-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.el | 172 |
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. |
| 586 | Assume allocation class `d-default' as default." | 586 | Assume 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. |
| 613 | VERBOSITY is a number between 0 and 3." | 613 | VERBOSITY 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." | |||
| 1570 | These are stored in the reloc data array." | 1570 | These 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 | |||
| 2582 | Return non-nil if the function is folded successfully." | 2582 | Return 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. |
| 2767 | FUNCTION can be a function-name or byte compiled function." | 2767 | FUNCTION 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. |