Function: ccl-compile-branch-blocks

ccl-compile-branch-blocks is a byte-compiled function defined in ccl.el.gz.

Signature

(ccl-compile-branch-blocks CODE RRR BLOCKS)

Documentation

Compile BLOCKs of BRANCH statement. CODE is branch or read-branch.

REG is a register which holds a value of EXPRESSION part. BLOCKs is a list of CCL-BLOCKs.

Source Code

;; Defined in /usr/src/emacs/lisp/international/ccl.el.gz
(defun ccl-compile-branch-blocks (code rrr blocks)
  "Compile BLOCKs of BRANCH statement.  CODE is `branch' or `read-branch'.
REG is a register which holds a value of EXPRESSION part.  BLOCKs
is a list of CCL-BLOCKs."
  (let ((branches (length blocks))
	branch-idx
	jump-table-head-address
	empty-block-indexes
	block-tail-addresses
	block-unconditional-jump)
    (ccl-embed-code code rrr branches)
    (setq jump-table-head-address ccl-current-ic)
    ;; The size of jump table is the number of blocks plus 1 (for the
    ;; case RRR is out of range).
    (ccl-increment-ic (1+ branches))
    (setq empty-block-indexes (list branches))
    ;; Compile each block.
    (setq branch-idx 0)
    (while blocks
      (if (null (car blocks))
	  ;; This block is empty.
	  (setq empty-block-indexes (cons branch-idx empty-block-indexes)
		block-unconditional-jump t)
	;; This block is not empty.
	(ccl-embed-data (- ccl-current-ic jump-table-head-address)
			(+ jump-table-head-address branch-idx))
	(setq block-unconditional-jump (ccl-compile-1 (car blocks)))
	(if (not block-unconditional-jump)
	    (progn
	      ;; Jump address of the end of branches are embedded later.
	      ;; For the moment, just remember where to embed them.
	      (setq block-tail-addresses
		    (cons ccl-current-ic block-tail-addresses))
	      (ccl-embed-code 'jump 0 0))))
      (setq branch-idx (1+ branch-idx))
      (setq blocks (cdr blocks)))
    (if (not block-unconditional-jump)
	;; We don't need jump code at the end of the last block.
	(setq block-tail-addresses (cdr block-tail-addresses)
	      ccl-current-ic (1- ccl-current-ic)))
    ;; Embed jump address at the tailing jump commands of blocks.
    (while block-tail-addresses
      (ccl-embed-current-address (car block-tail-addresses))
      (setq block-tail-addresses (cdr block-tail-addresses)))
    ;; For empty blocks, make entries in the jump table point directly here.
    (while empty-block-indexes
      (ccl-embed-data (- ccl-current-ic jump-table-head-address)
		      (+ jump-table-head-address (car empty-block-indexes)))
      (setq empty-block-indexes (cdr empty-block-indexes))))
  ;; Branch command ends by unconditional jump if RRR is out of range.
  nil)