Mercurial > emacs

comparison lisp/international/ccl.el @ 22127:dc00ef92855c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Change term translate-XXX-map to map-XXX throughout the file. Change terms unify/unification to translate/translation respectively throughtout the file.
author Kenichi Handa <handa@m17n.org>
date Mon, 18 May 1998 01:01:00 +0000
parents fe7ef7cd642a
children fc4aaf1b1772
comparison
equal deleted inserted replaced
22126:97cf1cae1971 22127:dc00ef92855c
77 ;; (write REG ...) 77 ;; (write REG ...)
78 ;; | (write EXPRESSION) 78 ;; | (write EXPRESSION)
79 ;; | (write integer) | (write string) | (write REG ARRAY) 79 ;; | (write integer) | (write string) | (write REG ARRAY)
80 ;; | string 80 ;; | string
81 ;; | (write-multibyte-character REG(charset) REG(codepoint)) 81 ;; | (write-multibyte-character REG(charset) REG(codepoint))
82 ;; UNIFY :=
83 ;; (unify-char REG(table) REG(charset) REG(codepoint))
84 ;; | (unify-char SYMBOL REG(charset) REG(codepoint))
85 ;; TRANSLATE := 82 ;; TRANSLATE :=
86 ;; (iterate-multiple-map REG REG TABLE-IDs) 83 ;; (translate-character REG(table) REG(charset) REG(codepoint))
87 ;; | (translate-multiple-map REG REG (TABLE-SET)) 84 ;; | (translate-character SYMBOL REG(charset) REG(codepoint))
88 ;; | (translate-single-map REG REG TABLE-ID) 85 ;; MAP :=
89 ;; TABLE-IDs := TABLE-ID ... 86 ;; (iterate-multiple-map REG REG MAP-IDs)
90 ;; TABLE-SET := TABLE-IDs | (TABLE-IDs) TABLE-SET 87 ;; | (map-multiple REG REG (MAP-SET))
91 ;; TABLE-ID := integer 88 ;; | (map-single REG REG MAP-ID)
89 ;; MAP-IDs := MAP-ID ...
90 ;; MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
91 ;; MAP-ID := integer
92 ;; 92 ;;
93 ;; CALL := (call ccl-program-name) 93 ;; CALL := (call ccl-program-name)
94 ;; END := (end) 94 ;; END := (end)
95 ;; 95 ;;
96 ;; REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 96 ;; REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7
111 111
112 (defconst ccl-command-table 112 (defconst ccl-command-table
113 [if branch loop break repeat write-repeat write-read-repeat 113 [if branch loop break repeat write-repeat write-read-repeat
114 read read-if read-branch write call end 114 read read-if read-branch write call end
115 read-multibyte-character write-multibyte-character 115 read-multibyte-character write-multibyte-character
116 unify-character 116 translate-character
117 iterate-multiple-map translate-multiple-map translate-single-map] 117 iterate-multiple-map map-multiple map-single]
118 "Vector of CCL commands (symbols).") 118 "Vector of CCL commands (symbols).")
119 119
120 ;; Put a property to each symbol of CCL commands for the compiler. 120 ;; Put a property to each symbol of CCL commands for the compiler.
121 (let (op (i 0) (len (length ccl-command-table))) 121 (let (op (i 0) (len (length ccl-command-table)))
122 (while (< i len) 122 (while (< i len)
161 "Vector of CCL compiled codes (symbols).") 161 "Vector of CCL compiled codes (symbols).")
162 162
163 (defconst ccl-extended-code-table 163 (defconst ccl-extended-code-table
164 [read-multibyte-character 164 [read-multibyte-character
165 write-multibyte-character 165 write-multibyte-character
166 unify-character 166 translate-character
167 unify-character-const-tbl 167 translate-character-const-tbl
168 nil nil nil nil nil nil nil nil nil nil nil nil ; 0x04-0x0f 168 nil nil nil nil nil nil nil nil nil nil nil nil ; 0x04-0x0f
169 iterate-multiple-map 169 iterate-multiple-map
170 translate-multiple-map 170 map-multiple
171 translate-single-map 171 map-single
172 ] 172 ]
173 "Vector of CCL extended compiled codes (symbols).") 173 "Vector of CCL extended compiled codes (symbols).")
174 174
175 ;; Put a property to each symbol of CCL codes for the disassembler. 175 ;; Put a property to each symbol of CCL codes for the disassembler.
176 (let (code (i 0) (len (length ccl-code-table))) 176 (let (code (i 0) (len (length ccl-code-table)))
870 (rrr (nth 2 cmd))) 870 (rrr (nth 2 cmd)))
871 (ccl-check-register rrr cmd) 871 (ccl-check-register rrr cmd)
872 (ccl-check-register RRR cmd) 872 (ccl-check-register RRR cmd)
873 (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0))) 873 (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0)))
874 874
875 ;; Compile unify-character 875 ;; Compile translate-character
876 (defun ccl-compile-unify-character (cmd) 876 (defun ccl-compile-translate-character (cmd)
877 (if (/= (length cmd) 4) 877 (if (/= (length cmd) 4)
878 (error "CCL: Invalid number of arguments: %s" cmd)) 878 (error "CCL: Invalid number of arguments: %s" cmd))
879 (let ((Rrr (nth 1 cmd)) 879 (let ((Rrr (nth 1 cmd))
880 (RRR (nth 2 cmd)) 880 (RRR (nth 2 cmd))
881 (rrr (nth 3 cmd))) 881 (rrr (nth 3 cmd)))
882 (ccl-check-register rrr cmd) 882 (ccl-check-register rrr cmd)
883 (ccl-check-register RRR cmd) 883 (ccl-check-register RRR cmd)
884 (cond ((symbolp Rrr) 884 (cond ((symbolp Rrr)
885 (if (not (get Rrr 'unification-table)) 885 (if (not (get Rrr 'character-translation-table))
886 (error "CCL: Invalid unification-table %s in %s" Rrr cmd)) 886 (error "CCL: Invalid character translation table %s in %s"
887 (ccl-embed-extended-command 'unify-character-const-tbl rrr RRR 0) 887 Rrr cmd))
888 (ccl-embed-extended-command 'translate-character-const-tbl
889 rrr RRR 0)
888 (ccl-embed-data Rrr)) 890 (ccl-embed-data Rrr))
889 (t 891 (t
890 (ccl-check-register Rrr cmd) 892 (ccl-check-register Rrr cmd)
891 (ccl-embed-extended-command 'unify-character rrr RRR Rrr))))) 893 (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))))
892 894
893 (defun ccl-compile-iterate-multiple-map (cmd) 895 (defun ccl-compile-iterate-multiple-map (cmd)
894 (ccl-compile-multiple-map-function 'iterate-multiple-map cmd)) 896 (ccl-compile-multiple-map-function 'iterate-multiple-map cmd))
895 897
896 (defun ccl-compile-translate-multiple-map (cmd) 898 (defun ccl-compile-map-multiple (cmd)
897 (if (/= (length cmd) 4) 899 (if (/= (length cmd) 4)
898 (error "CCL: Invalid number of arguments: %s" cmd)) 900 (error "CCL: Invalid number of arguments: %s" cmd))
899 (let ((func '(lambda (arg mp) 901 (let ((func '(lambda (arg mp)
900 (let ((len 0) result add) 902 (let ((len 0) result add)
901 (while arg 903 (while arg
913 (cons (- len) result) 915 (cons (- len) result)
914 result)))) 916 result))))
915 arg) 917 arg)
916 (setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd)) 918 (setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd))
917 (funcall func (nth 3 cmd) nil))) 919 (funcall func (nth 3 cmd) nil)))
918 (ccl-compile-multiple-map-function 'translate-multiple-map arg))) 920 (ccl-compile-multiple-map-function 'map-multiple arg)))
919 921
920 (defun ccl-compile-translate-single-map (cmd) 922 (defun ccl-compile-map-single (cmd)
921 (if (/= (length cmd) 4) 923 (if (/= (length cmd) 4)
922 (error "CCL: Invalid number of arguments: %s" cmd)) 924 (error "CCL: Invalid number of arguments: %s" cmd))
923 (let ((RRR (nth 1 cmd)) 925 (let ((RRR (nth 1 cmd))
924 (rrr (nth 2 cmd)) 926 (rrr (nth 2 cmd))
925 (table (nth 3 cmd)) 927 (map (nth 3 cmd))
926 id) 928 id)
927 (ccl-check-register rrr cmd) 929 (ccl-check-register rrr cmd)
928 (ccl-check-register RRR cmd) 930 (ccl-check-register RRR cmd)
929 (ccl-embed-extended-command 'translate-single-map rrr RRR 0) 931 (ccl-embed-extended-command 'map-single rrr RRR 0)
930 (cond ((symbolp table) 932 (cond ((symbolp map)
931 (if (get table 'ccl-translation-table) 933 (if (get map 'code-conversion-map)
932 (ccl-embed-data table) 934 (ccl-embed-data map)
933 (error "CCL: Invalid table: %s" table))) 935 (error "CCL: Invalid map: %s" map)))
934 (t 936 (t
935 (error "CCL: Invalid type of arguments: %s" cmd))))) 937 (error "CCL: Invalid type of arguments: %s" cmd)))))
936 938
937 (defun ccl-compile-multiple-map-function (command cmd) 939 (defun ccl-compile-multiple-map-function (command cmd)
938 (if (< (length cmd) 4) 940 (if (< (length cmd) 4)
939 (error "CCL: Invalid number of arguments: %s" cmd)) 941 (error "CCL: Invalid number of arguments: %s" cmd))
940 (let ((RRR (nth 1 cmd)) 942 (let ((RRR (nth 1 cmd))
941 (rrr (nth 2 cmd)) 943 (rrr (nth 2 cmd))
942 (args (nthcdr 3 cmd)) 944 (args (nthcdr 3 cmd))
943 table) 945 map)
944 (ccl-check-register rrr cmd) 946 (ccl-check-register rrr cmd)
945 (ccl-check-register RRR cmd) 947 (ccl-check-register RRR cmd)
946 (ccl-embed-extended-command command rrr RRR 0) 948 (ccl-embed-extended-command command rrr RRR 0)
947 (ccl-embed-data (length args)) 949 (ccl-embed-data (length args))
948 (while args 950 (while args
949 (setq table (car args)) 951 (setq map (car args))
950 (cond ((symbolp table) 952 (cond ((symbolp map)
951 (if (get table 'ccl-translation-table) 953 (if (get map 'code-conversion-map)
952 (ccl-embed-data table) 954 (ccl-embed-data map)
953 (error "CCL: Invalid table: %s" table))) 955 (error "CCL: Invalid map: %s" map)))
954 ((numberp table) 956 ((numberp map)
955 (ccl-embed-data table)) 957 (ccl-embed-data map))
956 (t 958 (t
957 (error "CCL: Invalid type of arguments: %s" cmd))) 959 (error "CCL: Invalid type of arguments: %s" cmd)))
958 (setq args (cdr args))))) 960 (setq args (cdr args)))))
959 961
960 962
1236 (insert (format "read-multibyte-character r%d r%d\n" RRR rrr))) 1238 (insert (format "read-multibyte-character r%d r%d\n" RRR rrr)))
1237 1239
1238 (defun ccl-dump-write-multibyte-character (rrr RRR Rrr) 1240 (defun ccl-dump-write-multibyte-character (rrr RRR Rrr)
1239 (insert (format "write-multibyte-character r%d r%d\n" RRR rrr))) 1241 (insert (format "write-multibyte-character r%d r%d\n" RRR rrr)))
1240 1242
1241 (defun ccl-dump-unify-character (rrr RRR Rrr) 1243 (defun ccl-dump-translate-character (rrr RRR Rrr)
1242 (insert (format "unify-character table(r%d) r%d r%d\n" Rrr RRR rrr))) 1244 (insert (format "character translation table(r%d) r%d r%d\n" Rrr RRR rrr)))
1243 1245
1244 (defun ccl-dump-unify-character-const-tbl (rrr RRR Rrr) 1246 (defun ccl-dump-translate-character-const-tbl (rrr RRR Rrr)
1245 (let ((tbl (ccl-get-next-code))) 1247 (let ((tbl (ccl-get-next-code)))
1246 (insert (format "unify-character table(%d) r%d r%d\n" tbl RRR rrr)))) 1248 (insert (format "character translation table(%d) r%d r%d\n" tbl RRR rrr))))
1247 1249
1248 (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr) 1250 (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr)
1249 (let ((notbl (ccl-get-next-code)) 1251 (let ((notbl (ccl-get-next-code))
1250 (i 0) id) 1252 (i 0) id)
1251 (insert (format "iterate-multiple-map r%d r%d\n" RRR rrr)) 1253 (insert (format "iterate-multiple-map r%d r%d\n" RRR rrr))
1252 (insert (format "\tnumber of tables is %d .\n\t [" notbl)) 1254 (insert (format "\tnumber of maps is %d .\n\t [" notbl))
1253 (while (< i notbl) 1255 (while (< i notbl)
1254 (setq id (ccl-get-next-code)) 1256 (setq id (ccl-get-next-code))
1255 (insert (format "%S" id)) 1257 (insert (format "%S" id))
1256 (setq i (1+ i))) 1258 (setq i (1+ i)))
1257 (insert "]\n"))) 1259 (insert "]\n")))
1258 1260
1259 (defun ccl-dump-translate-multiple-map (rrr RRR Rrr) 1261 (defun ccl-dump-map-multiple (rrr RRR Rrr)
1260 (let ((notbl (ccl-get-next-code)) 1262 (let ((notbl (ccl-get-next-code))
1261 (i 0) id) 1263 (i 0) id)
1262 (insert (format "translate-multiple-map r%d r%d\n" RRR rrr)) 1264 (insert (format "map-multiple r%d r%d\n" RRR rrr))
1263 (insert (format "\tnumber of tables and separators is %d\n\t [" notbl)) 1265 (insert (format "\tnumber of maps and separators is %d\n\t [" notbl))
1264 (while (< i notbl) 1266 (while (< i notbl)
1265 (setq id (ccl-get-next-code)) 1267 (setq id (ccl-get-next-code))
1266 (if (= id -1) 1268 (if (= id -1)
1267 (insert "]\n\t [") 1269 (insert "]\n\t [")
1268 (insert (format "%S " id))) 1270 (insert (format "%S " id)))
1269 (setq i (1+ i))) 1271 (setq i (1+ i)))
1270 (insert "]\n"))) 1272 (insert "]\n")))
1271 1273
1272 (defun ccl-dump-translate-single-map (rrr RRR Rrr) 1274 (defun ccl-dump-map-single (rrr RRR Rrr)
1273 (let ((id (ccl-get-next-code))) 1275 (let ((id (ccl-get-next-code)))
1274 (insert (format "translate-single-map r%d r%d table(%S)\n" RRR rrr id)))) 1276 (insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))
1275 1277
1276 1278
1277 ;; CCL emulation staffs 1279 ;; CCL emulation staffs
1278 1280
1279 ;; Not yet implemented. 1281 ;; Not yet implemented.