Function: ccl-compile-write

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

Signature

(ccl-compile-write CMD)

Documentation

Compile WRITE statement.

Source Code

;; Defined in /usr/src/emacs/lisp/international/ccl.el.gz
(defun ccl-compile-write (cmd)
  "Compile WRITE statement."
  (if (< (length cmd) 2)
      (error "CCL: Invalid number of arguments: %s" cmd))
  (let ((rrr (nth 1 cmd)))
    (cond ((integerp rrr)
	   (if (> rrr #xFFFFF)
	       (ccl-compile-write-string (string rrr))
	     (ccl-embed-code 'write-const-string 0 rrr)))
	  ((stringp rrr)
	   (ccl-compile-write-string rrr))
	  ((and (symbolp rrr) (vectorp (nth 2 cmd)))
	   (ccl-check-register rrr cmd)
	   ;; CMD has the form `(write REG ARRAY)'.
	   (let* ((arg (nth 2 cmd))
		  (len (length arg))
		  (i 0))
	     (ccl-embed-code 'write-array rrr len)
	     (while (< i len)
	       (if (not (integerp (aref arg i)))
		   (error "CCL: Invalid argument %s: %s" arg cmd))
	       (ccl-embed-data (aref arg i))
	       (setq i (1+ i)))))

	  ((symbolp rrr)
	   ;; CMD has the form `(write REG ...)'.
	   (let* ((args (cdr cmd))
		  (i (1- (length args))))
	     (while args
	       (setq rrr (ccl-check-register (car args) cmd))
	       (ccl-embed-code 'write-register rrr i)
	       (setq args (cdr args) i (1- i)))))

	  ((listp rrr)
	   ;; CMD has the form `(write (LEFT OP RIGHT))'.
	   (let ((left (car rrr))
		 (op (get (nth 1 rrr) 'ccl-arith-code))
		 (right (nth 2 rrr)))
	     (if (listp left)
		 (progn
		   ;; RRR has the form `((EXPR OP2 ARG) OP RIGHT)'.
		   ;; Compile the first term as `(r7 = (EXPR OP2 ARG))'.
		   (ccl-compile-expression 'r7 left)
		   (setq left 'r7)))
	     ;; Now RRR has the form `(ARG OP RIGHT)'.
	     (if (integerp right)
		 (progn
		   (ccl-embed-code 'write-expr-const 0 (ash op 3) left)
		   (ccl-embed-data right))
	       (ccl-check-register right rrr)
	       (ccl-embed-code 'write-expr-register 0
			       (logior (ash op 3)
				       (get right 'ccl-register-number))
			       left))))

	  (t
	   (error "CCL: Invalid argument: %s" cmd))))
  nil)