# HG changeset patch # User Kenichi Handa # Date 932990064 0 # Node ID 206f04753cc11281833069901ca892788794ccd1 # Parent 7c69e1001e350ff23d35b49846c17ebe7fb8ab42 (ccl-embed-symbol): New function. (ccl-program-p): Deleted. Now it's implemented in C code. (ccl-compile-call): Use ccl-embed-symbol to embed a symbol. (ccl-compile-translate-character): Likewise. (ccl-compile-map-single): Likewise. (ccl-compile-multiple-map-function): Likewise. (declare-ccl-program): Doc-string modified. (check-ccl-program): Check compiled CCL code by ccl-program-p. diff -r 7c69e1001e35 -r 206f04753cc1 lisp/international/ccl.el --- a/lisp/international/ccl.el Mon Jul 26 11:50:17 1999 +0000 +++ b/lisp/international/ccl.el Mon Jul 26 11:54:24 1999 +0000 @@ -249,6 +249,13 @@ (aset ccl-program-vector ccl-current-ic data) (setq ccl-current-ic (1+ ccl-current-ic)))) +;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give +;; proper index number for SYMBOL. PROP should be +;; `translation-table-id', `code-conversion-map-id', or +;; `ccl-program-idx'. +(defun ccl-embed-symbol (symbol prop) + (ccl-embed-data (cons symbol prop))) + ;; Embed string STR of length LEN in `ccl-program-vector' at ;; `ccl-current-ic'. (defun ccl-embed-string (len str) @@ -312,18 +319,6 @@ (defun ccl-increment-ic (inc) (setq ccl-current-ic (+ ccl-current-ic inc))) -;;;###autoload -(defun ccl-program-p (obj) - "T if OBJECT is a valid CCL compiled code." - (and (vectorp obj) - (let ((i 0) (len (length obj)) (flag t)) - (if (> len 1) - (progn - (while (and flag (< i len)) - (setq flag (integerp (aref obj i))) - (setq i (1+ i))) - flag))))) - ;; If non-nil, index of the start of the current loop. (defvar ccl-loop-head nil) ;; If non-nil, list of absolute addresses of the breaking points of @@ -840,11 +835,8 @@ (error "CCL: Invalid number of arguments: %s" cmd)) (if (not (symbolp (nth 1 cmd))) (error "CCL: Subroutine should be a symbol: %s" cmd)) - (let* ((name (nth 1 cmd)) - (idx (get name 'ccl-program-idx))) - (if (not idx) - (error "CCL: Unknown subroutine name: %s" name)) - (ccl-embed-code 'call 0 idx)) + (ccl-embed-code 'call 1 0) + (ccl-embed-symbol (nth 1 cmd) 'ccl-program-idx) nil) ;; Compile END statement. @@ -890,7 +882,7 @@ (error "CCL: Invalid translation table %s in %s" Rrr cmd)) (ccl-embed-extended-command 'translate-character-const-tbl rrr RRR 0) - (ccl-embed-data Rrr)) + (ccl-embed-symbol Rrr 'translation-table-id)) (t (ccl-check-register Rrr cmd) (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) @@ -937,7 +929,7 @@ (ccl-embed-extended-command 'map-single rrr RRR 0) (cond ((symbolp map) (if (get map 'code-conversion-map) - (ccl-embed-data map) + (ccl-embed-symbol map 'code-conversion-map-id) (error "CCL: Invalid map: %s" map))) (t (error "CCL: Invalid type of arguments: %s" cmd)))) @@ -958,7 +950,7 @@ (setq map (car args)) (cond ((symbolp map) (if (get map 'code-conversion-map) - (ccl-embed-data map) + (ccl-embed-symbol map 'code-conversion-map-id) (error "CCL: Invalid map: %s" map))) ((numberp map) (ccl-embed-data map)) @@ -1293,8 +1285,12 @@ (defmacro declare-ccl-program (name &optional vector) "Declare NAME as a name of CCL program. -To compile a CCL program which calls another CCL program not yet -defined, it must be declared as a CCL program in advance. +This macro exists for backward compatibility. In the old version of +Emacs, to compile a CCL program which calls another CCL program not +yet defined, it must be declared as a CCL program in advance. But, +now CCL program names are resolved not at compile time but before +execution. + Optional arg VECTOR is a compiled CCL code of the CCL program." `(put ',name 'ccl-program-idx (register-ccl-program ',name ,vector))) @@ -1311,20 +1307,16 @@ ;;;###autoload (defmacro check-ccl-program (ccl-program &optional name) "Check validity of CCL-PROGRAM. -If CCL-PROGRAM is a symbol denoting a valid CCL program, return +If CCL-PROGRAM is a symbol denoting a CCL program, return CCL-PROGRAM, else return nil. If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied, register CCL-PROGRAM by name NAME, and return NAME." - `(let ((result ,ccl-program)) - (cond ((symbolp ,ccl-program) - (or (numberp (get ,ccl-program 'ccl-program-idx)) - (setq result nil))) - ((vectorp ,ccl-program) - (setq result ,name) - (register-ccl-program result ,ccl-program)) - (t - (setq result nil))) - result)) + `(if (ccl-program-p ,ccl-program) + (if (vectorp ,ccl-program) + (progn + (register-ccl-program ,name ,ccl-program) + ,name) + ,ccl-program))) ;;;###autoload (defun ccl-execute-with-args (ccl-prog &rest args)