# HG changeset patch # User Dave Love # Date 1026901958 0 # Node ID 109eee3b7af4bba20258e30fa42ec6b26733e053 # Parent 4bc90b6a952fa31c92b42c06d65d16b22e19c0eb (ccl-command-table): Add lookup-integer, lookup-character. (ccl-extended-code-table): Add lookup-int-const-tbl, lookup-char-const-tbl. (ccl-compile-lookup-integer, ccl-compile-lookup-character) (ccl-dump-lookup-int-const-tbl, ccl-dump-lookup-char-const-tbl): New functions. (define-ccl-program): Doc update. diff -r 4bc90b6a952f -r 109eee3b7af4 lisp/international/ccl.el --- a/lisp/international/ccl.el Wed Jul 17 08:46:12 2002 +0000 +++ b/lisp/international/ccl.el Wed Jul 17 10:32:38 2002 +0000 @@ -2,6 +2,7 @@ ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. +;; Copyright (C) 2002 Free Software Foundation, Inc. ;; Keywords: CCL, mule, multilingual, character set, coding-system @@ -25,19 +26,19 @@ ;;; Commentary: ;; CCL (Code Conversion Language) is a simple programming language to -;; be used for various kind of code conversion. CCL program is -;; compiled to CCL code (vector of integers) and executed by CCL -;; interpreter of Emacs. +;; be used for various kind of code conversion. A CCL program is +;; compiled to CCL code (vector of integers) and executed by the CCL +;; interpreter in Emacs. ;; ;; CCL is used for code conversion at process I/O and file I/O for -;; non-standard coding-system. In addition, it is used for -;; calculating a code point of X's font from a character code. +;; non-standard coding-systems. In addition, it is used for +;; calculating code points of X fonts from character codes. ;; However, since CCL is designed as a powerful programming language, ;; it can be used for more generic calculation. For instance, ;; combination of three or more arithmetic operations can be -;; calculated faster than Emacs Lisp. +;; calculated faster than in Emacs Lisp. ;; -;; Syntax and semantics of CCL program is described in the +;; The syntax and semantics of CCL programs are described in the ;; documentation of `define-ccl-program'. ;;; Code: @@ -52,7 +53,8 @@ read read-if read-branch write call end read-multibyte-character write-multibyte-character translate-character - iterate-multiple-map map-multiple map-single] + iterate-multiple-map map-multiple map-single lookup-integer + lookup-character] "Vector of CCL commands (symbols).") ;; Put a property to each symbol of CCL commands for the compiler. @@ -107,6 +109,8 @@ iterate-multiple-map map-multiple map-single + lookup-int-const-tbl + lookup-char-const-tbl ] "Vector of CCL extended compiled codes (symbols).") @@ -196,8 +200,8 @@ ;; 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'. +;; `translation-table-id', `translation-hash-table-id' +;; `code-conversion-map-id', or `ccl-program-idx'. (defun ccl-embed-symbol (symbol prop) (ccl-embed-data (cons symbol prop))) @@ -833,6 +837,46 @@ (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) nil) +;; Compile lookup-integer +(defun ccl-compile-lookup-integer (cmd) + (if (/= (length cmd) 4) + (error "CCL: Invalid number of arguments: %s" cmd)) + (let ((Rrr (nth 1 cmd)) + (RRR (nth 2 cmd)) + (rrr (nth 3 cmd))) + (ccl-check-register RRR cmd) + (ccl-check-register rrr cmd) + (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number))) + (ccl-embed-extended-command 'lookup-int-const-tbl + rrr RRR 0) + (ccl-embed-symbol Rrr 'translation-hash-table-id)) + (t + (error "CCL: non-constant table: %s" cmd) + ;; not implemented: + (ccl-check-register Rrr cmd) + (ccl-embed-extended-command 'lookup-int rrr RRR 0)))) + nil) + +;; Compile lookup-character +(defun ccl-compile-lookup-character (cmd) + (if (/= (length cmd) 4) + (error "CCL: Invalid number of arguments: %s" cmd)) + (let ((Rrr (nth 1 cmd)) + (RRR (nth 2 cmd)) + (rrr (nth 3 cmd))) + (ccl-check-register RRR cmd) + (ccl-check-register rrr cmd) + (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number))) + (ccl-embed-extended-command 'lookup-char-const-tbl + rrr RRR 0) + (ccl-embed-symbol Rrr 'translation-hash-table-id)) + (t + (error "CCL: non-constant table: %s" cmd) + ;; not implemented: + (ccl-check-register Rrr cmd) + (ccl-embed-extended-command 'lookup-char rrr RRR 0)))) + nil) + (defun ccl-compile-iterate-multiple-map (cmd) (ccl-compile-multiple-map-function 'iterate-multiple-map cmd) nil) @@ -905,7 +949,7 @@ (setq args (cdr args))))) -;;; CCL dump staffs +;;; CCL dump stuff ;; To avoid byte-compiler warning. (defvar ccl-code) @@ -1192,6 +1236,14 @@ (let ((tbl (ccl-get-next-code))) (insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr)))) +(defun ccl-dump-lookup-int-const-tbl (rrr RRR Rrr) + (let ((tbl (ccl-get-next-code))) + (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr)))) + +(defun ccl-dump-lookup-char-const-tbl (rrr RRR Rrr) + (let ((tbl (ccl-get-next-code))) + (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr)))) + (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr) (let ((notbl (ccl-get-next-code)) (i 0) id) @@ -1271,7 +1323,7 @@ STATEMENT := SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL - | TRANSLATE | END + | TRANSLATE | MAP | LOOKUP | END SET := (REG = EXPRESSION) | (REG ASSIGNMENT_OPERATOR EXPRESSION) @@ -1438,6 +1490,10 @@ (translate-character REG(table) REG(charset) REG(codepoint)) | (translate-character SYMBOL REG(charset) REG(codepoint)) ;; SYMBOL must refer to a table defined by `define-translation-table'. +LOOKUP := + (lookup-character SYMBOL REG(charset) REG(codepoint)) + | (lookup-integer SYMBOL REG(integer)) + ;; SYMBOL refers to a table defined by `define-hash-translation-table'. MAP := (iterate-multiple-map REG REG MAP-IDs) | (map-multiple REG REG (MAP-SET))