2 |
|
|
3 |
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
4 |
;; Licensed to the Free Software Foundation. |
;; Licensed to the Free Software Foundation. |
5 |
|
;; Copyright (C) 2002 Free Software Foundation, Inc. |
6 |
|
|
7 |
;; Keywords: CCL, mule, multilingual, character set, coding-system |
;; Keywords: CCL, mule, multilingual, character set, coding-system |
8 |
|
|
26 |
;;; Commentary: |
;;; Commentary: |
27 |
|
|
28 |
;; CCL (Code Conversion Language) is a simple programming language to |
;; CCL (Code Conversion Language) is a simple programming language to |
29 |
;; be used for various kind of code conversion. CCL program is |
;; be used for various kind of code conversion. A CCL program is |
30 |
;; compiled to CCL code (vector of integers) and executed by CCL |
;; compiled to CCL code (vector of integers) and executed by the CCL |
31 |
;; interpreter of Emacs. |
;; interpreter in Emacs. |
32 |
;; |
;; |
33 |
;; CCL is used for code conversion at process I/O and file I/O for |
;; CCL is used for code conversion at process I/O and file I/O for |
34 |
;; non-standard coding-system. In addition, it is used for |
;; non-standard coding-systems. In addition, it is used for |
35 |
;; calculating a code point of X's font from a character code. |
;; calculating code points of X fonts from character codes. |
36 |
;; However, since CCL is designed as a powerful programming language, |
;; However, since CCL is designed as a powerful programming language, |
37 |
;; it can be used for more generic calculation. For instance, |
;; it can be used for more generic calculation. For instance, |
38 |
;; combination of three or more arithmetic operations can be |
;; combination of three or more arithmetic operations can be |
39 |
;; calculated faster than Emacs Lisp. |
;; calculated faster than in Emacs Lisp. |
40 |
;; |
;; |
41 |
;; Syntax and semantics of CCL program is described in the |
;; The syntax and semantics of CCL programs are described in the |
42 |
;; documentation of `define-ccl-program'. |
;; documentation of `define-ccl-program'. |
43 |
|
|
44 |
;;; Code: |
;;; Code: |
53 |
read read-if read-branch write call end |
read read-if read-branch write call end |
54 |
read-multibyte-character write-multibyte-character |
read-multibyte-character write-multibyte-character |
55 |
translate-character |
translate-character |
56 |
iterate-multiple-map map-multiple map-single] |
iterate-multiple-map map-multiple map-single lookup-integer |
57 |
|
lookup-character] |
58 |
"Vector of CCL commands (symbols).") |
"Vector of CCL commands (symbols).") |
59 |
|
|
60 |
;; Put a property to each symbol of CCL commands for the compiler. |
;; Put a property to each symbol of CCL commands for the compiler. |
109 |
iterate-multiple-map |
iterate-multiple-map |
110 |
map-multiple |
map-multiple |
111 |
map-single |
map-single |
112 |
|
lookup-int-const-tbl |
113 |
|
lookup-char-const-tbl |
114 |
] |
] |
115 |
"Vector of CCL extended compiled codes (symbols).") |
"Vector of CCL extended compiled codes (symbols).") |
116 |
|
|
200 |
|
|
201 |
;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give |
;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give |
202 |
;; proper index number for SYMBOL. PROP should be |
;; proper index number for SYMBOL. PROP should be |
203 |
;; `translation-table-id', `code-conversion-map-id', or |
;; `translation-table-id', `translation-hash-table-id' |
204 |
;; `ccl-program-idx'. |
;; `code-conversion-map-id', or `ccl-program-idx'. |
205 |
(defun ccl-embed-symbol (symbol prop) |
(defun ccl-embed-symbol (symbol prop) |
206 |
(ccl-embed-data (cons symbol prop))) |
(ccl-embed-data (cons symbol prop))) |
207 |
|
|
837 |
(ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) |
(ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) |
838 |
nil) |
nil) |
839 |
|
|
840 |
|
;; Compile lookup-integer |
841 |
|
(defun ccl-compile-lookup-integer (cmd) |
842 |
|
(if (/= (length cmd) 4) |
843 |
|
(error "CCL: Invalid number of arguments: %s" cmd)) |
844 |
|
(let ((Rrr (nth 1 cmd)) |
845 |
|
(RRR (nth 2 cmd)) |
846 |
|
(rrr (nth 3 cmd))) |
847 |
|
(ccl-check-register RRR cmd) |
848 |
|
(ccl-check-register rrr cmd) |
849 |
|
(cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number))) |
850 |
|
(ccl-embed-extended-command 'lookup-int-const-tbl |
851 |
|
rrr RRR 0) |
852 |
|
(ccl-embed-symbol Rrr 'translation-hash-table-id)) |
853 |
|
(t |
854 |
|
(error "CCL: non-constant table: %s" cmd) |
855 |
|
;; not implemented: |
856 |
|
(ccl-check-register Rrr cmd) |
857 |
|
(ccl-embed-extended-command 'lookup-int rrr RRR 0)))) |
858 |
|
nil) |
859 |
|
|
860 |
|
;; Compile lookup-character |
861 |
|
(defun ccl-compile-lookup-character (cmd) |
862 |
|
(if (/= (length cmd) 4) |
863 |
|
(error "CCL: Invalid number of arguments: %s" cmd)) |
864 |
|
(let ((Rrr (nth 1 cmd)) |
865 |
|
(RRR (nth 2 cmd)) |
866 |
|
(rrr (nth 3 cmd))) |
867 |
|
(ccl-check-register RRR cmd) |
868 |
|
(ccl-check-register rrr cmd) |
869 |
|
(cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number))) |
870 |
|
(ccl-embed-extended-command 'lookup-char-const-tbl |
871 |
|
rrr RRR 0) |
872 |
|
(ccl-embed-symbol Rrr 'translation-hash-table-id)) |
873 |
|
(t |
874 |
|
(error "CCL: non-constant table: %s" cmd) |
875 |
|
;; not implemented: |
876 |
|
(ccl-check-register Rrr cmd) |
877 |
|
(ccl-embed-extended-command 'lookup-char rrr RRR 0)))) |
878 |
|
nil) |
879 |
|
|
880 |
(defun ccl-compile-iterate-multiple-map (cmd) |
(defun ccl-compile-iterate-multiple-map (cmd) |
881 |
(ccl-compile-multiple-map-function 'iterate-multiple-map cmd) |
(ccl-compile-multiple-map-function 'iterate-multiple-map cmd) |
882 |
nil) |
nil) |
949 |
(setq args (cdr args))))) |
(setq args (cdr args))))) |
950 |
|
|
951 |
|
|
952 |
;;; CCL dump staffs |
;;; CCL dump stuff |
953 |
|
|
954 |
;; To avoid byte-compiler warning. |
;; To avoid byte-compiler warning. |
955 |
(defvar ccl-code) |
(defvar ccl-code) |
1236 |
(let ((tbl (ccl-get-next-code))) |
(let ((tbl (ccl-get-next-code))) |
1237 |
(insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr)))) |
(insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr)))) |
1238 |
|
|
1239 |
|
(defun ccl-dump-lookup-int-const-tbl (rrr RRR Rrr) |
1240 |
|
(let ((tbl (ccl-get-next-code))) |
1241 |
|
(insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr)))) |
1242 |
|
|
1243 |
|
(defun ccl-dump-lookup-char-const-tbl (rrr RRR Rrr) |
1244 |
|
(let ((tbl (ccl-get-next-code))) |
1245 |
|
(insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr)))) |
1246 |
|
|
1247 |
(defun ccl-dump-iterate-multiple-map (rrr RRR Rrr) |
(defun ccl-dump-iterate-multiple-map (rrr RRR Rrr) |
1248 |
(let ((notbl (ccl-get-next-code)) |
(let ((notbl (ccl-get-next-code)) |
1249 |
(i 0) id) |
(i 0) id) |
1323 |
|
|
1324 |
STATEMENT := |
STATEMENT := |
1325 |
SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL |
SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL |
1326 |
| TRANSLATE | END |
| TRANSLATE | MAP | LOOKUP | END |
1327 |
|
|
1328 |
SET := (REG = EXPRESSION) |
SET := (REG = EXPRESSION) |
1329 |
| (REG ASSIGNMENT_OPERATOR EXPRESSION) |
| (REG ASSIGNMENT_OPERATOR EXPRESSION) |
1490 |
(translate-character REG(table) REG(charset) REG(codepoint)) |
(translate-character REG(table) REG(charset) REG(codepoint)) |
1491 |
| (translate-character SYMBOL REG(charset) REG(codepoint)) |
| (translate-character SYMBOL REG(charset) REG(codepoint)) |
1492 |
;; SYMBOL must refer to a table defined by `define-translation-table'. |
;; SYMBOL must refer to a table defined by `define-translation-table'. |
1493 |
|
LOOKUP := |
1494 |
|
(lookup-character SYMBOL REG(charset) REG(codepoint)) |
1495 |
|
| (lookup-integer SYMBOL REG(integer)) |
1496 |
|
;; SYMBOL refers to a table defined by `define-hash-translation-table'. |
1497 |
MAP := |
MAP := |
1498 |
(iterate-multiple-map REG REG MAP-IDs) |
(iterate-multiple-map REG REG MAP-IDs) |
1499 |
| (map-multiple REG REG (MAP-SET)) |
| (map-multiple REG REG (MAP-SET)) |