Function: ccl-compile-if

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

Signature

(ccl-compile-if CMD &optional READ-FLAG)

Documentation

Compile IF statement of the form (if CONDITION TRUE-PART FALSE-PART).

If READ-FLAG is non-nil, this statement has the form
(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART).

Source Code

;; Defined in /usr/src/emacs/lisp/international/ccl.el.gz
(defun ccl-compile-if (cmd &optional read-flag)
  "Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'.
If READ-FLAG is non-nil, this statement has the form
`(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'."
  (if (and (/= (length cmd) 3) (/= (length cmd) 4))
      (error "CCL: Invalid number of arguments: %s" cmd))
  (let ((condition (nth 1 cmd))
	(true-cmds (nth 2 cmd))
	(false-cmds (nth 3 cmd))
	jump-cond-address)
    (if (and (listp condition)
	     (listp (car condition)))
	;; If CONDITION is a nested expression, the inner expression
	;; should be compiled at first as SET statement, i.e.:
	;; `(if ((X OP2 Y) OP Z) ...)' is compiled into two statements:
	;; `(r7 = (X OP2 Y)) (if (r7 OP Z) ...)'.
	(progn
	  (ccl-compile-expression 'r7 (car condition))
	  (setq condition (cons 'r7 (cdr condition)))
	  (setq cmd (cons (car cmd)
			  (cons condition (cdr (cdr cmd)))))))

    (setq jump-cond-address ccl-current-ic)
    ;; Compile CONDITION.
    (if (symbolp condition)
	;; CONDITION is a register.
	(progn
	  (ccl-check-register condition cmd)
	  (ccl-embed-code 'jump-cond condition 0))
      ;; CONDITION is a simple expression of the form (RRR OP ARG).
      (let ((rrr (car condition))
	    (op (get (nth 1 condition) 'ccl-arith-code))
	    (arg (nth 2 condition)))
	(ccl-check-register rrr cmd)
	(or (integerp op)
            (error "CCL: Invalid operator: %s" (nth 1 condition)))
	(if (integerp arg)
	    (progn
	      (ccl-embed-code (if read-flag 'read-jump-cond-expr-const
				'jump-cond-expr-const)
			      rrr 0)
	      (ccl-embed-data op)
	      (ccl-embed-data arg))
	  (ccl-check-register arg cmd)
	  (ccl-embed-code (if read-flag 'read-jump-cond-expr-register
			    'jump-cond-expr-register)
			  rrr 0)
	  (ccl-embed-data op)
	  (ccl-embed-data (get arg 'ccl-register-number)))))

    ;; Compile TRUE-PART.
    (let ((unconditional-jump (ccl-compile-1 true-cmds)))
      (if (null false-cmds)
	  ;; This is the place to jump to if condition is false.
	  (progn
	    (ccl-embed-current-address jump-cond-address)
	    (setq unconditional-jump nil))
	(let (end-true-part-address)
	  (if (not unconditional-jump)
	      (progn
		;; If TRUE-PART does not end with unconditional jump, we
		;; have to jump to the end of FALSE-PART from here.
		(setq end-true-part-address ccl-current-ic)
		(ccl-embed-code 'jump 0 0)))
	  ;; This is the place to jump to if CONDITION is false.
	  (ccl-embed-current-address jump-cond-address)
	  ;; Compile FALSE-PART.
	  (setq unconditional-jump
		(and (ccl-compile-1 false-cmds) unconditional-jump))
	  (if end-true-part-address
	      ;; This is the place to jump to after the end of TRUE-PART.
	      (ccl-embed-current-address end-true-part-address))))
      unconditional-jump)))