Function: byte-compile-cond-jump-table

byte-compile-cond-jump-table is a byte-compiled function defined in bytecomp.el.gz.

Signature

(byte-compile-cond-jump-table SWITCH DONETAG)

Documentation

Generate code for SWITCH, ending at DONETAG.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
(defun byte-compile-cond-jump-table (switch donetag)
  "Generate code for SWITCH, ending at DONETAG."
  (let* ((var (car switch))
         (test (nth 1 switch))
         (cases (nth 2 switch))
         jump-table test-objects body tag default-tag)
    ;; TODO: Once :linear-search is implemented for `make-hash-table'
    ;; set it to t for cond forms with a small number of cases.
    (let ((nvalues (apply #'+ (mapcar (lambda (case) (length (car case)))
                                      cases))))
      (setq jump-table (make-hash-table
			:test test
			:size nvalues)))
    (setq default-tag (byte-compile-make-tag))
    ;; The structure of byte-switch code:
    ;;
    ;; varref var
    ;; constant #s(hash-table data (val1 (TAG1) val2 (TAG2)))
    ;; switch
    ;; goto DEFAULT-TAG
    ;; TAG1
    ;; <clause body>
    ;; goto DONETAG
    ;; TAG2
    ;; <clause body>
    ;; goto DONETAG
    ;; DEFAULT-TAG
    ;; <body for remaining (non-switch) clauses>
    ;; DONETAG

    (byte-compile-variable-ref var)
    (byte-compile-push-constant jump-table)
    (byte-compile-out 'byte-switch)

    ;; When the opcode argument is `byte-goto', `byte-compile-goto' sets
    ;; `byte-compile-depth' to nil. However, we need `byte-compile-depth'
    ;; to be non-nil for generating tags for all cases. Since
    ;; `byte-compile-depth' will increase by at most 1 after compiling
    ;; all of the clause (which is further enforced by cl-assert below)
    ;; it should be safe to preserve its value.
    (let ((byte-compile-depth byte-compile-depth))
      (byte-compile-goto 'byte-goto default-tag))

    (dolist (case cases)
      (setq tag (byte-compile-make-tag)
            test-objects (car case)
            body (cdr case))
      (byte-compile-out-tag tag)
      (dolist (value test-objects)
        (puthash value tag jump-table))

      (let ((byte-compile-depth byte-compile-depth)
            (init-depth byte-compile-depth))
        ;; Since `byte-compile-body' might increase `byte-compile-depth'
        ;; by 1, not preserving its value will cause it to potentially
        ;; increase by one for every clause body compiled, causing
        ;; depth/tag conflicts or violating asserts down the road.
        ;; To make sure `byte-compile-body' itself doesn't violate this,
        ;; we use `cl-assert'.
        (byte-compile-body body byte-compile--for-effect)
        (cl-assert (or (= byte-compile-depth init-depth)
                       (= byte-compile-depth (1+ init-depth))))
        (byte-compile-goto 'byte-goto donetag)
        (setcdr (cdr donetag) nil)))

    (byte-compile-out-tag default-tag)
    (push jump-table byte-compile-jump-tables)))