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)))