Function: comp--emit-switch

comp--emit-switch is a byte-compiled function defined in comp.el.gz.

Signature

(comp--emit-switch VAR LAST-INSN)

Documentation

Emit a Limple for a lap jump table given VAR and LAST-INSN.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/comp.el.gz
(defun comp--emit-switch (var last-insn)
  "Emit a Limple for a lap jump table given VAR and LAST-INSN."
  ;; FIXME this not efficient for big jump tables. We should have a second
  ;; strategy for this case.
  (pcase last-insn
    (`(setimm ,_ ,jmp-table)
     (unless (comp--jump-table-optimizable jmp-table)
       (cl-loop
        for test being each hash-keys of jmp-table
        using (hash-value target-label)
        with len = (hash-table-count jmp-table)
        with test-func = (hash-table-test jmp-table)
        for n from 1
        for last = (= n len)
        for m-test = (make--comp-mvar :constant test)
        for target-name = (comp-block-name (comp--bb-maybe-add
                                            (comp--label-to-addr target-label)
                                            (comp--sp)))
        for ff-bb = (if last
                        (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass))
                                           (comp--sp))
                      (make--comp-block-lap nil
                                            (comp--sp)
                                            (comp--new-block-sym)))
        for ff-bb-name = (comp-block-name ff-bb)
        if (eq test-func 'eq)
          do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name))
        else
        ;; Store the result of the comparison into the scratch slot before
        ;; emitting the conditional jump.
          do (comp--emit (list 'set (make--comp-mvar :slot 'scratch)
                              (comp--call test-func var m-test)))
             (comp--emit (list 'cond-jump
                              (make--comp-mvar :slot 'scratch)
                              (make--comp-mvar :constant nil)
                              ff-bb-name target-name))
        unless last
        ;; All fall through are artificially created here except the last one.
          do (puthash ff-bb-name ff-bb (comp-func-blocks comp-func))
             (setf (comp-limplify-curr-block comp-pass) ff-bb))))
    (_ (signal 'native-ice
               '("missing previous setimm while creating a switch")))))