Function: byte-compile-inline-lapcode

byte-compile-inline-lapcode is a byte-compiled function defined in bytecomp.el.gz.

Signature

(byte-compile-inline-lapcode LAP END-DEPTH)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
;; Splice the given lap code into the current instruction stream.
;; If it has any labels in it, you're responsible for making sure there
;; are no collisions, and that byte-compile-tag-number is reasonable
;; after this is spliced in.  The provided list is destroyed.
(defun byte-compile-inline-lapcode (lap end-depth)
  ;; "Replay" the operations: we used to just do
  ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))
  ;; but that fails to update byte-compile-depth, so we had to assume
  ;; that `lap' ends up adding exactly 1 element to the stack.  This
  ;; happens to be true for byte-code generated by bytecomp.el without
  ;; lexical-binding, but it's not true in general, and it's not true for
  ;; code output by bytecomp.el with lexical-binding.
  ;; We also restore the value of `byte-compile-depth' and remove TAG depths
  ;; accordingly when inlining lapcode containing lap-code, exactly as
  ;; documented in `byte-compile-cond-jump-table'.
  (let ((endtag (byte-compile-make-tag))
        last-jump-tag ;; last TAG we have jumped to
        last-depth ;; last value of `byte-compile-depth'
        last-constant ;; value of the last constant encountered
        last-switch ;; whether the last op encountered was byte-switch
        switch-tags ;; a list of tags that byte-switch could jump to
        ;; a list of tags byte-switch will jump to, if the value doesn't
        ;; match any entry in the hash table
        switch-default-tags)
    (dolist (op lap)
      (cond
       ((eq (car op) 'TAG)
        (when (or (member op switch-tags) (member op switch-default-tags))
          ;; This TAG is used in a jump table, this means the last goto
          ;; was to a done/default TAG, and thus it's cddr should be set to nil.
          (when last-jump-tag
            (setcdr (cdr last-jump-tag) nil))
          ;; Also, restore the value of `byte-compile-depth' to what it was
          ;; before the last goto.
          (setq byte-compile-depth last-depth
                last-jump-tag nil))
        (byte-compile-out-tag op))
       ((memq (car op) byte-goto-ops)
        (setq last-depth byte-compile-depth
              last-jump-tag (cdr op))
        (byte-compile-goto (car op) (cdr op))
        (when last-switch
          ;; The last op was byte-switch, this goto jumps to a "default" TAG
          ;; (when no value in the jump table is satisfied).
          (push (cdr op) switch-default-tags)
          (setcdr (cdr (cdr op)) nil)
          (setq byte-compile-depth last-depth
                last-switch nil)))
       ((eq (car op) 'byte-return)
        (byte-compile-discard (- byte-compile-depth end-depth) t)
        (byte-compile-goto 'byte-goto endtag))
       (t
        (when (eq (car op) 'byte-switch)
          ;; The last constant is a jump table.
          (push last-constant byte-compile-jump-tables)
          (setq last-switch t)
          ;; Push all TAGs in the jump to switch-tags.
          (maphash #'(lambda (_k tag)
                       (push tag switch-tags))
                   last-constant))
        (setq last-constant (and (eq (car op) 'byte-constant) (cadr op)))
        (setq last-depth byte-compile-depth)
        (byte-compile-out (car op) (cdr op)))))
    (byte-compile-out-tag endtag)))