Function: ccl-compile-1

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

Signature

(ccl-compile-1 CCL-BLOCK)

Documentation

Compile CCL-BLOCK (see the syntax above).

Source Code

;; Defined in /usr/src/emacs/lisp/international/ccl.el.gz
;; In the following code, most ccl-compile-XXXX functions return t if
;; they end with unconditional jump, else return nil.

(defun ccl-compile-1 (ccl-block)
  "Compile CCL-BLOCK (see the syntax above)."
  (let (unconditional-jump
	cmd)
    (if (or (integerp ccl-block)
	    (stringp ccl-block)
	    (and ccl-block (symbolp (car ccl-block))))
	;; This block consists of single statement.
	(setq ccl-block (list ccl-block)))

    ;; Now CCL-BLOCK is a list of statements.  Compile them one by
    ;; one.
    (while ccl-block
      (setq cmd (car ccl-block))
      (setq unconditional-jump
	    (cond ((integerp cmd)
		   ;; SET statement for the register 0.
		   (ccl-compile-set (list 'r0 '= cmd)))

		  ((stringp cmd)
		   ;; WRITE statement of string argument.
		   (ccl-compile-write-string cmd))

		  ((listp cmd)
		   ;; The other statements.
		   (cond ((eq (nth 1 cmd) '=)
			  ;; SET statement of the form `(REG = EXPRESSION)'.
			  (ccl-compile-set cmd))

			 ((and (symbolp (nth 1 cmd))
			       (get (nth 1 cmd) 'ccl-self-arith-code))
			  ;; SET statement with an assignment operation.
			  (ccl-compile-self-set cmd))

			 (t
			  (funcall (ccl-check-compile-function (car cmd) cmd)
				   cmd))))

		  (t
		   (ccl-syntax-error cmd))))
      (setq ccl-block (cdr ccl-block)))
    unconditional-jump))