;ELC ;;; Compiled by pot@pot.cnuce.cnr.it on Tue Mar 18 15:46:37 2003 ;;; from file /home/pot/gnu/emacs-pretest.new/lisp/international/ccl.el ;;; in Emacs version 21.3 ;;; with bytecomp version 2.85.4.1 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. (if (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`ccl.el' was compiled for Emacs 19.29 or later")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (custom-declare-group 'ccl nil "CCL (Code Conversion Language) compiler." :prefix "ccl-" :group 'i18n) #@35 Vector of CCL commands (symbols). (defconst ccl-command-table [if branch loop break repeat write-repeat write-read-repeat read read-if read-branch write call end read-multibyte-character write-multibyte-character translate-character iterate-multiple-map map-multiple map-single] (#$ . 725)) (byte-code "\304\305G\n W\203#\nH\306 \307\310\311\312 \"!#\210\nT\211\202+\304\207" [ccl-command-table len i op nil 0 put ccl-compile-function intern format "ccl-compile-%s"] 8) #@41 Vector of CCL compiled codes (symbols). (defconst ccl-code-table [set-register set-short-const set-const set-array jump jump-cond write-register-jump write-register-read-jump write-const-jump write-const-read-jump write-string-jump write-array-read-jump read-jump branch read-register write-expr-const read-branch write-register write-expr-register call write-const-string write-array end set-assign-expr-const set-assign-expr-register set-expr-const set-expr-register jump-cond-expr-const jump-cond-expr-register read-jump-cond-expr-const read-jump-cond-expr-register ex-cmd] (#$ . 1211)) #@50 Vector of CCL extended compiled codes (symbols). (defconst ccl-extended-code-table [read-multibyte-character write-multibyte-character translate-character translate-character-const-tbl nil nil nil nil nil nil nil nil nil nil nil nil iterate-multiple-map map-multiple map-single] (#$ . 1807)) (byte-code "\306\307G\n W\203)\nH\310 \311\n#\210\310 \312\313\314\315 \"!#\210\nT\211\202+\306\307\fG\n W\203W\f\nH\211\203P\310 \316\n#\210\310 \312\313\314\315 \"!#\210\nT\211\2022+\317 B\320\320\310@\321\322#\210A\211\204b)\306\207" [ccl-code-table len i code ccl-extended-code-table current-load-list nil 0 put ccl-code ccl-dump-function intern format "ccl-dump-%s" ccl-ex-code ccl-jump-code-list (jump jump-cond write-register-jump write-register-read-jump write-const-jump write-const-read-jump write-string-jump write-array-read-jump read-jump) jump-flag t l] 8) #@36 Vector of CCL registers (symbols). (defconst ccl-register-table [r0 r1 r2 r3 r4 r5 r6 r7] (#$ . 2706)) (byte-code "\304\305G\n W\203\nH\306 \307\n#\210\nT\211\202+\304\207" [ccl-register-table len i reg nil 0 put ccl-register-number] 5) #@55 Vector of CCL arithmetic/logical operators (symbols). (defconst ccl-arith-table [+ - * / % & | ^ << >> <8 >8 // nil nil nil < > == <= >= != de-sjis en-sjis] (#$ . 2960)) (byte-code "\304\305G\n W\203\"\nH\211\203\306 \307\n#\210\nT\211\202+\304\207" [ccl-arith-table len i arith nil 0 put ccl-arith-code] 5) #@47 Vector of CCL assignment operators (symbols). (defconst ccl-assign-arith-table [+= -= *= /= %= &= |= ^= <<= >>= <8= >8= //=] (#$ . 3286)) (byte-code "\304\305G\n W\203\nH\306 \307\n#\210\nT\211\202+\304\207" [ccl-assign-arith-table len i arith nil 0 put ccl-self-arith-code] 5) #@55 Working vector of CCL codes produced by CCL compiler. (defvar ccl-program-vector nil (#$ . 3581)) #@45 The current index for `ccl-program-vector'. (defvar ccl-current-ic 0 (#$ . 3685)) (defalias 'ccl-embed-data #[(data &optional ic) "\203 \nI\207 G\f Y\2031\306 \211\\\307\\\310\" \307V\203. S HI\210\202 )) \f\nI\210\fT\211\207" [ic ccl-program-vector data len ccl-current-ic new make-vector 0 nil] 4]) (defalias 'ccl-embed-symbol #[(symbol prop) "\302 B!\207" [symbol prop ccl-embed-data] 3]) (defalias 'ccl-embed-string #[(len str) "\303\303 W\205>\304\305\306\nH\307\"T W\203!\306\nTH\310\"\202\"\303\311\\ W\2032\n\311\\H\2023\303#!\210\312\\\211\202)\207" [i len str 0 ccl-embed-data logior ash 16 8 2 3] 8]) (defalias 'ccl-embed-current-address #[(ic) " TZ \304 H\305\n\306\"\"I)\207" [ccl-current-ic ic relative ccl-program-vector logior ash 8] 7]) (defalias 'ccl-embed-code #[(op reg data &optional reg2) "\306V\203 \307N\203\nTZ\310 \311N\312 9\203! \313N\202\" \314\"\f\2037\310\312\f\313N\315\"\312\316\"\"\202;\312\315\"#\317 !)\207" [data op ccl-current-ic reg reg2 code 0 jump-flag logior ccl-code ash ccl-register-number 5 8 11 ccl-embed-data] 8]) (defalias 'ccl-embed-extended-command #[(ex-op reg reg2 reg3) "\305\306\307N\310\" 9\203 \311N\202\312\"\313\314 \n\f$)\207" [ex-op reg3 data reg reg2 logior ash ccl-ex-code 3 ccl-register-number 0 ccl-embed-code ex-cmd] 5]) (defalias 'ccl-increment-ic #[(inc) " \\\211\207" [ccl-current-ic inc] 2]) (byte-code "\301B\303\301!\204\f\304\302B\303\302!\204\304\304\207" [current-load-list ccl-loop-head ccl-breaks boundp nil] 2) #@66 Return the compiled code of CCL-PROGRAM as a vector of integers. (defalias 'ccl-compile #[(ccl-program) ":\203@\250\203A@<\204\306\307\"\210\310 !\204\"\311\312\313\"\314\314\313\315@!\210\316\317!\210\320A@!\210\315\f\317\"\210\3218\203H\320\3218!\210\322\323\313\211#\210\311\f\313\"\313 \fW\203k HI\210 T\211\202W*\207" [ccl-program ccl-program-vector ccl-loop-head ccl-breaks ccl-current-ic i error "CCL: Invalid CCL program: %s" vectorp make-vector 8192 0 nil ccl-embed-data ccl-increment-ic 1 ccl-compile-1 2 ccl-embed-code end vec] 5 (#$ . 5246)]) (defalias 'ccl-syntax-error #[(cmd) "\301\302\"\207" [cmd error "CCL: Syntax error: %s"] 3]) (defalias 'ccl-check-register #[(arg cmd) "\302N\203\207\303\304 #\207" [arg cmd ccl-register-number error "CCL: Invalid register %s in %s"] 4]) (defalias 'ccl-check-compile-function #[(arg cmd) "\302N\206\n\303\304 \"\207" [arg cmd ccl-compile-function error "CCL: Invalid command: %s"] 3]) (defalias 'ccl-compile-1 #[(ccl-block) "\303\211\n\250\204\n;\204\n\203\n@9\203\nC\n\203x\n@\211\250\2030\304\305\306E!\202p;\203;\307!\202p<\203mA@\306=\203N\304!\202pA@9\203cA@\310N\203c\311!\202p\312@\"!\202p\313!\nA\211\204 *\207" [cmd unconditional-jump ccl-block nil ccl-compile-set r0 = ccl-compile-write-string ccl-self-arith-code ccl-compile-self-set ccl-check-compile-function ccl-syntax-error] 5]) (byte-code "\301B\303\304\305\"\302B\303\306\305\"\301\207" [current-load-list ccl-max-short-const ccl-min-short-const ash 1 19 -1] 3) (defalias 'ccl-compile-set #[(cmd) "\306@\"\3078 <\203\310\n \"\210\202\200 \250\203> X\2031 \fY\2031\311\312\n #\210\202\200\311\313\n\314#\210\315 !\210\202\200\306 \"\210\3168\317 !\203x\314 G\311\320\n $\210W\203t\315 H!\210T\211\202^*\202\311\321\n\314 $\210)*\322\207" [cmd right rrr ccl-max-short-const ccl-min-short-const ary ccl-check-register 2 ccl-compile-expression ccl-embed-code set-short-const set-const 0 ccl-embed-data 3 vectorp set-array set-register nil len i] 6]) (defalias 'ccl-compile-self-set #[(cmd) "\303@\"\3048 <\203\305\306 \"\210\306\305\n\211\307\310A@!\311\312O! E\"\210*\313\207" [cmd right rrr ccl-check-register 2 ccl-compile-expression r7 intern symbol-name 0 -1 nil] 7]) (defalias 'ccl-compile-expression #[(rrr expr) "@A@\306N\3078\211<\203\310\311 \"\210\311\f =\203L\n GW\203L \250\203;\312\313\f\314\n\315\"\316$\210\317 !\202t\320 \"\210\312\321\f\314\n\315\" $\202t \250\203a\312\322\f\314\n\315\" $\210\317 !\202t\320 \"\210\312\323\f\324\314\n\315\" \325N\" $+\207" [expr right op left rrr ccl-assign-arith-table ccl-arith-code 2 ccl-compile-expression r7 ccl-embed-code set-assign-expr-const ash 3 r0 ccl-embed-data ccl-check-register set-assign-expr-register set-expr-const set-expr-register logior ccl-register-number] 8]) (defalias 'ccl-compile-write-string #[(str) "\302!\211G\303\304\305 #\210\306 \"\210)\307\207" [str len string-as-unibyte ccl-embed-code write-const-string 1 ccl-embed-string nil] 5]) (defalias 'ccl-compile-if #[(cmd &optional read-flag) "G\306U\204G\307U\204\310\311\"\210A@\3128\3068\313\211\211<\203B @<\203B\314\315 @\"\210\315 AB@ AABB 9\203X\316 \"\210\317\320 \321#\210\202\264 @ A@\322N\312 8\316\"\210\250\203\221\317 \203~\323\202\324\321#\210\325!\210\325!\210\202\263\316\"\210\317 \203\241\326\202\242\327\321#\210\325!\210\325\330N!\210+\331\f!! \204\307\332\n!\210\313!\202\362\313\"!\204\331\"\317\333\321\211#\210\332\n!\210\331 !\205\345!!\"\203\361\332\"!\210)!.\207" [cmd false-ic jump-cond-address false-cmds true-cmds condition 3 4 error "CCL: Invalid number of arguments: %s" 2 nil ccl-compile-expression r7 ccl-check-register ccl-embed-code jump-cond 0 ccl-arith-code read-jump-cond-expr-const jump-cond-expr-const ccl-embed-data read-jump-cond-expr-register jump-cond-expr-register ccl-register-number ccl-compile-1 ccl-embed-current-address jump ccl-current-ic arg op rrr read-flag unconditional-jump end-true-part-address] 6]) (defalias 'ccl-compile-branch #[(cmd) "G\301W\203\f\302\303\"\210\304\305\306A@\"AA#\207" [cmd 3 error "CCL: Invalid number of arguments: %s" ccl-compile-branch-blocks branch ccl-compile-branch-expression] 5]) (defalias 'ccl-compile-read-branch #[(cmd) "G\301W\203\f\302\303\"\210\304\305\306A@\"AA#\207" [cmd 3 error "CCL: Invalid number of arguments: %s" ccl-compile-branch-blocks read-branch ccl-compile-branch-expression] 5]) (defalias 'ccl-compile-branch-expression #[(expr cmd) "<\203\f\302\303\"\210\303\207\304 \"\207" [expr cmd ccl-compile-expression r7 ccl-check-register] 3]) (defalias 'ccl-compile-branch-blocks #[(code rrr blocks) "G\306\211\211\211\211\307#\210\310T!\210C\311\203`@\2048 B\312\202V\313\fZ\f \\\"\210\314@!\211\204V\nB\307\315\311\211#\210 TA\211\204* \204l\nAS\n\203|\316\n@!\210\nA\211\204p \203\222\313\fZ\f @\\\"\210 A\211\204\200.\306\207" [blocks block-unconditional-jump block-tail-addresses empty-block-indexes jump-table-head-address branch-idx nil ccl-embed-code ccl-increment-ic 0 t ccl-embed-data ccl-compile-1 jump ccl-embed-current-address branches code rrr ccl-current-ic] 7]) (defalias 'ccl-compile-loop #[(cmd) "G\305W\203\f\306\307\"\210 \310\310A\211\205I\311\203/\312@!\205'\fA\211\204 \2048\f\210\202H \203H\313 @!\210 A\211\204<\310+\207" [cmd ccl-current-ic ccl-loop-head ccl-breaks unconditional-jump 2 error "CCL: Invalid number of arguments: %s" nil t ccl-compile-1 ccl-embed-current-address] 4]) (defalias 'ccl-compile-break #[(cmd) "G\304U\204\f\305\306\"\210 \204\305\307\"\210\n B\310\311\312\211#\210\313\207" [cmd ccl-loop-head ccl-current-ic ccl-breaks 1 error "CCL: Invalid number of arguments: %s" "CCL: No outer loop: %s" ccl-embed-code jump 0 t] 4]) (defalias 'ccl-compile-repeat #[(cmd) "G\302U\204\f\303\304\"\210 \204\303\305\"\210\306\307\310 #\210\311\207" [cmd ccl-loop-head 1 error "CCL: Invalid number of arguments: %s" "CCL: No outer loop: %s" ccl-embed-code jump 0 t] 4]) (defalias 'ccl-compile-write-repeat #[(cmd) "G\305U\204\f\306\307\"\210 \204\306\310\"\210A@\211\250\203+\311\312\313 #\210\314\n!\210\202W\n;\203L\315\n!\211G\313\311\316\313 #\210\314\f!\210\317\f\n\"\210*\202W\320\n\"\210\311\321\n #\210)\322\207" [cmd ccl-loop-head arg i len 2 error "CCL: Invalid number of arguments: %s" "CCL: No outer loop: %s" ccl-embed-code write-const-jump 0 ccl-embed-data string-as-unibyte write-string-jump ccl-embed-string ccl-check-register write-register-jump t] 5]) (defalias 'ccl-compile-write-read-repeat #[(cmd) "G\306W\204G\307V\203\310\311\"\210 \204\310\312\"\210\313A@\"\3068\n\2044\314\315 #\210\202u\n\250\203C\314\316 \n $\210\202u\317\n!\203o\nG\320\314\321 #\210\322 !\210\f W\203k\322\n\fH!\210\fT\211\202Y*\202u\310\323\n#\210\314\324 #\210*\325\207" [cmd ccl-loop-head arg rrr i len 2 3 error "CCL: Invalid number of arguments: %s" "CCL: No outer loop: %s" ccl-check-register ccl-embed-code write-register-read-jump write-const-read-jump vectorp 0 write-array-read-jump ccl-embed-data "CCL: Invalid argument %s: %s" read-jump t] 6]) (defalias 'ccl-compile-read #[(cmd) "G\304W\203\f\305\306\"\210A\211GS \203-\307 @\"\310\311 \n#\210 A\nS)\202*\312\207" [cmd args i rrr 2 error "CCL: Invalid number of arguments: %s" ccl-check-register ccl-embed-code read-register nil] 5]) (defalias 'ccl-compile-read-if #[(cmd) "\301\302\"\207" [cmd ccl-compile-if read] 3]) (defalias 'ccl-compile-write #[(cmd) "G\306W\203\f\307\310\"\210A@\211\250\203\311\312\313 #\210\202\364 ;\203*\314 !\210\202\364 9\203o\315\3068!\203o\316 \"\210\3068\211G\313\311\317 #\210\f W\203k\n\fH\250\204^\307\320\n#\210\321\n\fH!\210\fT\211\202L+\202\364 9\203\230A\211GS \203\224\316 @\"\311\322 \f#\210 A\fS\202{*\202\364 <\203\357 @ A@\323N\306 8\211 <\203\273\324\325 \"\210\325 \250\203\325\311\326\313\327\330\" $\210\321!\210\202\353\316 \"\210\311\331\313\332\327\330\"\333N\"#\210+\202\364\307\334\"\210)\335\207" [cmd rrr arg len i args 2 error "CCL: Invalid number of arguments: %s" ccl-embed-code write-const-string 0 ccl-compile-write-string vectorp ccl-check-register write-array "CCL: Invalid argument %s: %s" ccl-embed-data write-register ccl-arith-code ccl-compile-expression r7 write-expr-const ash 3 write-expr-register logior ccl-register-number "CCL: Invalid argument: %s" nil right op left] 8]) (defalias 'ccl-compile-call #[(cmd) "G\301U\204\f\302\303\"\210A@9\204\302\304\"\210\305\306\307\310#\210\311A@\312\"\210\313\207" [cmd 2 error "CCL: Invalid number of arguments: %s" "CCL: Subroutine should be a symbol: %s" ccl-embed-code call 1 0 ccl-embed-symbol ccl-program-idx nil] 4]) (defalias 'ccl-compile-end #[(cmd) "G\301U\204\f\302\303\"\210\304\305\306\211#\210\307\207" [cmd 1 error "CCL: Invalid number of arguments: %s" ccl-embed-code end 0 t] 4]) (defalias 'ccl-compile-read-multibyte-character #[(cmd) "G\303U\204\f\304\305\"\210A@\3068\307 \"\210\307\n\"\210\310\311 \n\312$\210*\313\207" [cmd rrr RRR 3 error "CCL: Invalid number of arguments: %s" 2 ccl-check-register ccl-embed-extended-command read-multibyte-character 0 nil] 5]) (defalias 'ccl-compile-write-multibyte-character #[(cmd) "G\303U\204\f\304\305\"\210A@\3068\307 \"\210\307\n\"\210\310\311 \n\312$\210*\313\207" [cmd rrr RRR 3 error "CCL: Invalid number of arguments: %s" 2 ccl-check-register ccl-embed-extended-command write-multibyte-character 0 nil] 5]) (defalias 'ccl-compile-translate-character #[(cmd) "G\304U\204\f\305\306\"\210A@\3078\3108\311 \"\210\311\n\"\210 9\203< \312N\204<\313\314 \n\315$\210\316 \317\"\210\202H\311 \"\210\313\320 \n $\210+\321\207" [cmd rrr RRR Rrr 4 error "CCL: Invalid number of arguments: %s" 2 3 ccl-check-register ccl-register-number ccl-embed-extended-command translate-character-const-tbl 0 ccl-embed-symbol translation-table-id translate-character nil] 5]) (defalias 'ccl-compile-iterate-multiple-map #[(cmd) "\301\302\"\210\303\207" [cmd ccl-compile-multiple-map-function iterate-multiple-map nil] 3]) (defalias 'ccl-compile-map-multiple #[(cmd) "G\303U\204\f\304\305\"\210\306\211\307\310@A@\3118E\n\3128\306\"\"\313\314 \"\210*\306\207" [cmd arg func 4 error "CCL: Invalid number of arguments: %s" nil #[(arg mp) "\306\307\211 \2036 @:\203#\f @\310\"\311 \"@[T\202,\311 @C\"\312 A\n\\\202 \203A\n[ B\202B +\207" [add result len arg func mp 0 nil t append 1] 3] append 2 3 ccl-compile-multiple-map-function map-multiple] 5]) (defalias 'ccl-compile-map-single #[(cmd) "G\305U\204\f\306\307\"\210A@\3108\3118\312\313 \"\210\313\f\"\210\314\315 \f\316$\210\n9\203F\n\317N\203>\320\n\321\"\210\202K\306\322\n\"\210\202K\306\323\"\210,\312\207" [cmd id map rrr RRR 4 error "CCL: Invalid number of arguments: %s" 2 3 nil ccl-check-register ccl-embed-extended-command map-single 0 code-conversion-map ccl-embed-symbol code-conversion-map-id "CCL: Invalid map: %s" "CCL: Invalid type of arguments: %s"] 5]) (defalias 'ccl-compile-multiple-map-function #[(command cmd) "G\306W\203\f\307\310\"\210A@\3118\312\233\313\314 \"\210\314\f\"\210\315 \f\316$\210\317\nG!\210\n\205k\n@\2119\203R \320N\203J\321 \322\"\210\202c\307\323 \"\210\202c \247\203^\317 !\210\202c\307\324\"\210\nA\211\2044\313,\207" [cmd map args rrr RRR command 4 error "CCL: Invalid number of arguments: %s" 2 3 nil ccl-check-register ccl-embed-extended-command 0 ccl-embed-data code-conversion-map ccl-embed-symbol code-conversion-map-id "CCL: Invalid map: %s" "CCL: Invalid type of arguments: %s"] 6]) (byte-code "\301B\301\207" [current-load-list ccl-code] 2) #@32 Disassemble compiled CCL-CODE. (defalias 'ccl-dump #[(ccl-code) "G\304H \304U\203\305c\210\202% \306U\203\307c\210\202%\310\311 \"c\210\312c\210\313\306H\304V\203C \306HW\203@\314 \210\2022\315c\210 \nW\205O\314 \210\202C*\207" [ccl-code buffer-mag len ccl-current-ic 0 "Don't output anything.\n" 1 "Out-buffer must be as large as in-buffer.\n" format "Out-buffer must be %d times bigger than in-buffer.\n" "Main-body:\n" 2 ccl-dump-1 "At EOF:\n"] 3 (#$ . 17184)]) (defalias 'ccl-get-next-code #[nil " H T\207" [ccl-code ccl-current-ic] 2]) (defalias 'ccl-dump-1 #[nil "\306  \307\310\"H\311\307\312\"\313\"\311\314\"\315\316 S\n#c\210\n\317N \f\",\207" [code ccl-code-table cmd rrr cc ccl-current-ic ccl-get-next-code logand 31 ash 255 -5 -8 format "%5d:[%s] " ccl-dump-function] 4]) (defalias 'ccl-dump-set-register #[(rrr cc) "\302\303 #c\207" [rrr cc format "r%d = r%d\n"] 4]) (defalias 'ccl-dump-set-short-const #[(rrr cc) "\302\303 #c\207" [rrr cc format "r%d = %d\n"] 4]) (defalias 'ccl-dump-set-const #[(rrr ignore) "\301\302\303 #c\207" [rrr format "r%d = %d\n" ccl-get-next-code] 4]) (defalias 'ccl-dump-set-array #[(rrr cc) "\305\306\"\307\310\"\311\312\313\f \n$c\210 \nW\203(\312\314\315 \"c\210 T\211\202\316c+\207" [cc i len rrr2 rrr logand 7 ash -3 0 format "r%d = array[r%d] of length %d\n " "%d " ccl-get-next-code "\n"] 6]) (defalias 'ccl-dump-jump #[(ignore cc &optional address) "\303\304\206 \n\\\"c\210\n\305Y\203\306c\210\303\307\nT\"c\207" [address ccl-current-ic cc format "jump to %d(" 0 "+" "%d)\n"] 4]) (defalias 'ccl-dump-jump-cond #[(rrr cc) "\302\303\"c\210\304\305 \"\207" [rrr cc format "if (r%d == 0), " ccl-dump-jump nil] 3]) (defalias 'ccl-dump-write-register-jump #[(rrr cc) "\302\303\"c\210\304\305 \"\207" [rrr cc format "write r%d, " ccl-dump-jump nil] 3]) (defalias 'ccl-dump-write-register-read-jump #[(rrr cc) "\302\303\211#c\210\304\305 \"\210\306 \207" [rrr cc format "write r%d, read r%d, " ccl-dump-jump nil ccl-get-next-code] 4]) (defalias 'ccl-extract-arith-op #[(cc) "\302 \303\"H\207" [ccl-arith-table cc ash -6] 4]) (defalias 'ccl-dump-write-expr-const #[(ignore cc) "\301\302\303\304\"\305!\306 $c\207" [cc format "write (r%d %s %d)\n" logand 7 ccl-extract-arith-op ccl-get-next-code] 5]) (defalias 'ccl-dump-write-expr-register #[(ignore cc) "\301\302\303\304\"\305!\303\306\307\"\304\"$c\207" [cc format "write (r%d %s r%d)\n" logand 7 ccl-extract-arith-op ash -3] 8]) (defalias 'ccl-dump-insert-char #[(cc) "\301U\203 \302c\207\303U\203\304c\207\305\306\"c\207" [cc 9 " \"^I\"" 10 " \"^J\"" format " \"%c\""] 3]) (defalias 'ccl-dump-write-const-jump #[(ignore cc) "\303c\210\304\305 !\210\306c\210\307\310\n #)\207" [ccl-current-ic address cc "write char" ccl-dump-insert-char ccl-get-next-code ", " ccl-dump-jump nil] 4]) (defalias 'ccl-dump-write-const-read-jump #[(rrr cc) "\304c\210\305\306 !\210\307\310\n\"c\210\311 \"\210\306 )\207" [ccl-current-ic address rrr cc "write char" ccl-dump-insert-char ccl-get-next-code format ", read r%d, " ccl-dump-jump] 3]) (defalias 'ccl-dump-write-string-jump #[(ignore cc) "\306 \307\310c\210 \nW\203@\306 \311\f\312\"c\210 T\nW\203)\313\311\f\314\"\315\"c\210 \316\\\nW\2037\313\f\315\"c\210) \317\\\211\202 \320c\210\321\322 #+\207" [ccl-current-ic i len address code cc ccl-get-next-code 0 "write \"" ash -16 logand -8 255 2 3 "\", " ccl-dump-jump nil] 5]) (defalias 'ccl-dump-write-array-read-jump #[(rrr cc) "\306 \307\310\311\f\n#c\210 \nW\203 \312\306 !\210 T\211\202\310\313\f\"c\210\314\315 #\210\306 +\207" [ccl-current-ic i len address rrr cc ccl-get-next-code 0 format "write array[r%d] of length %d,\n " ccl-dump-insert-char "\n then read r%d, " ccl-dump-jump nil] 5]) (defalias 'ccl-dump-read-jump #[(rrr cc) "\302\303\"c\210\304\305 \"\207" [rrr cc format "read r%d, " ccl-dump-jump nil] 3]) (defalias 'ccl-dump-branch #[(rrr len) "\305\306\307 \f#c\210 \fX\203!\306\310\n\311 \\\"c\210 T\211\202\f\312c*\207" [ccl-current-ic i jump-table-head rrr len 0 format "jump to array[r%d] of length %d\n " "%d " ccl-get-next-code "\n"] 5]) (defalias 'ccl-dump-read-register #[(rrr cc) "\302\303 #c\207" [rrr cc format "read r%d (%d remaining)\n"] 4]) (defalias 'ccl-dump-read-branch #[(rrr len) "\302\303\"c\210\304 \"\207" [rrr len format "read r%d, " ccl-dump-branch] 3]) (defalias 'ccl-dump-write-register #[(rrr cc) "\302\303 #c\207" [rrr cc format "write r%d (%d remaining)\n"] 4]) (defalias 'ccl-dump-call #[(ignore cc) "\301\302\"c\207" [cc format "call subroutine #%d\n"] 3]) (defalias 'ccl-dump-write-const-string #[(rrr cc) "\305U\203\306c\210\307 !\210\310 \207 \305\311c\210\n W\203U\312 \313\314\315\f\316\"\"c\210\nT W\203<\313\314\317\315\f\320\"\321\"\"c\210\n\322\\ W\203M\313\314\317\f\321\"\"c\210\n\323\\)\202\324c*\207" [rrr cc i len code 0 "write char" ccl-dump-insert-char newline "write \"" ccl-get-next-code format "%c" lsh -16 logand -8 255 2 3 "\"\n"] 6]) (defalias 'ccl-dump-write-array #[(rrr cc) "\303\304\305 \n#c\210\nW\203\306\307 !\210T\211\202\n\310c)\207" [i rrr cc 0 format "write array[r%d] of length %d\n " ccl-dump-insert-char ccl-get-next-code "\n"] 5]) (defalias 'ccl-dump-end #[(&rest ignore) "\300c\207" ["end\n"] 1]) (defalias 'ccl-dump-set-assign-expr-const #[(rrr cc) "\302\303\304 !\305 $c\207" [rrr cc format "r%d %s= %d\n" ccl-extract-arith-op ccl-get-next-code] 5]) (defalias 'ccl-dump-set-assign-expr-register #[(rrr cc) "\302\303\304 !\305 \306\"$c\207" [rrr cc format "r%d %s= r%d\n" ccl-extract-arith-op logand 7] 7]) (defalias 'ccl-dump-set-expr-const #[(rrr cc) "\302\303\304 \305\"\306 !\307 %c\207" [rrr cc format "r%d = r%d %s %d\n" logand 7 ccl-extract-arith-op ccl-get-next-code] 6]) (defalias 'ccl-dump-set-expr-register #[(rrr cc) "\302\303\304 \305\"\306 !\304\307 \310\"\305\"%c\207" [rrr cc format "r%d = r%d %s r%d\n" logand 7 ccl-extract-arith-op ash -3] 9]) (defalias 'ccl-dump-jump-cond-expr-const #[(rrr cc) "\305\306\n \307 H\307 $c\210\310\311\f #)\207" [ccl-current-ic address rrr ccl-arith-table cc format "if !(r%d %s %d), " ccl-get-next-code ccl-dump-jump nil] 5]) (defalias 'ccl-dump-jump-cond-expr-register #[(rrr cc) "\305\306\n \307 H\307 $c\210\310\311\f #)\207" [ccl-current-ic address rrr ccl-arith-table cc format "if !(r%d %s r%d), " ccl-get-next-code ccl-dump-jump nil] 5]) (defalias 'ccl-dump-read-jump-cond-expr-const #[(rrr cc) "\302\303\"c\210\304 \"\207" [rrr cc format "read r%d, " ccl-dump-jump-cond-expr-const] 3]) (defalias 'ccl-dump-read-jump-cond-expr-register #[(rrr cc) "\302\303\"c\210\304 \"\207" [rrr cc format "read r%d, " ccl-dump-jump-cond-expr-register] 3]) (defalias 'ccl-dump-binary #[(ccl-code) "G\306 \nW\205P H\307 \310Y\2031\311\f\312\313 \"\"\310U\203'\314\202(\315c\210 S\211\202\311\f\316\"\211 GW\203E\317\320 \fH\"c\210\321c\210* T\211\202*\207" [ccl-code i len j code ccl-code-table 2 27 0 logand ash 1 48 49 31 format ":%s" "\n"] 6]) (defalias 'ccl-dump-ex-cmd #[(rrr cc) "\306\307\"\306\310\311\"\307\" \306\310\312\"\313\"H\314\315\f\"c\210\f\316N \n#+\207" [cc RRR Rrr ccl-extended-code-table ex-op rrr logand 7 ash -3 -6 16383 format "<%s> " ccl-dump-function] 5]) (defalias 'ccl-dump-read-multibyte-character #[(rrr RRR Rrr) "\302\303 #c\207" [RRR rrr format "read-multibyte-character r%d r%d\n"] 4]) (defalias 'ccl-dump-write-multibyte-character #[(rrr RRR Rrr) "\302\303 #c\207" [RRR rrr format "write-multibyte-character r%d r%d\n"] 4]) (defalias 'ccl-dump-translate-character #[(rrr RRR Rrr) "\303\304 \n$c\207" [Rrr RRR rrr format "translation table(r%d) r%d r%d\n"] 5]) (defalias 'ccl-dump-translate-character-const-tbl #[(rrr RRR Rrr) "\303 \304\305 \n$c)\207" [tbl RRR rrr ccl-get-next-code format "translation table(%S) r%d r%d\n"] 5]) (defalias 'ccl-dump-iterate-multiple-map #[(rrr RRR Rrr) "\305 \306\307\310\311 \f#c\210\310\312\n\"c\210 \nW\203*\305 \310\313\"c\210 T\211\202\314c+\207" [id i notbl RRR rrr ccl-get-next-code 0 nil format "iterate-multiple-map r%d r%d\n" " number of maps is %d .\n [" "%S" "]\n"] 5]) (defalias 'ccl-dump-map-multiple #[(rrr RRR Rrr) "\305 \306\307\310\311 \f#c\210\310\312\n\"c\210 \nW\2036\305 \211\313U\203)\314c\210\202/\310\315\"c\210 T\211\202\316c+\207" [id i notbl RRR rrr ccl-get-next-code 0 nil format "map-multiple r%d r%d\n" " number of maps and separators is %d\n [" -1 "]\n [" "%S " "]\n"] 5]) (defalias 'ccl-dump-map-single #[(rrr RRR Rrr) "\303 \304\305 \n$c)\207" [id RRR rrr ccl-get-next-code format "map-single r%d r%d map(%S)\n"] 5]) #@387 Declare NAME as a name of CCL program. 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. (defalias 'declare-ccl-program '(macro . #[(name &optional vector) "\302\303D\304\305\303D EF\207" [name vector put quote 'ccl-program-idx register-ccl-program] 6 (#$ . 25806)])) #@6156 Set NAME the compiled code of CCL-PROGRAM. CCL-PROGRAM has this form: (BUFFER_MAGNIFICATION CCL_MAIN_CODE [ CCL_EOF_CODE ]) BUFFER_MAGNIFICATION is an integer value specifying the approximate output buffer magnification size compared with the bytes of input data text. If the value is zero, the CCL program can't execute `read' and `write' commands. CCL_MAIN_CODE and CCL_EOF_CODE are CCL program codes. CCL_MAIN_CODE executed at first. If there's no more input data when `read' command is executed in CCL_MAIN_CODE, CCL_EOF_CODE is executed. If CCL_MAIN_CODE is terminated, CCL_EOF_CODE is not executed. Here's the syntax of CCL program code in BNF notation. The lines starting by two semicolons (and optional leading spaces) describe the semantics. CCL_MAIN_CODE := CCL_BLOCK CCL_EOF_CODE := CCL_BLOCK CCL_BLOCK := STATEMENT | (STATEMENT [STATEMENT ...]) STATEMENT := SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL | TRANSLATE | END SET := (REG = EXPRESSION) | (REG ASSIGNMENT_OPERATOR EXPRESSION) ;; The following form is the same as (r0 = integer). | integer EXPRESSION := ARG | (EXPRESSION OPERATOR ARG) ;; Evaluate EXPRESSION. If the result is nonzero, execute ;; CCL_BLOCK_0. Otherwise, execute CCL_BLOCK_1. IF := (if EXPRESSION CCL_BLOCK_0 CCL_BLOCK_1) ;; Evaluate EXPRESSION. Provided that the result is N, execute ;; CCL_BLOCK_N. BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...]) ;; Execute STATEMENTs until (break) or (end) is executed. LOOP := (loop STATEMENT [STATEMENT ...]) ;; Terminate the most inner loop. BREAK := (break) REPEAT := ;; Jump to the head of the most inner loop. (repeat) ;; Same as: ((write [REG | integer | string]) ;; (repeat)) | (write-repeat [REG | integer | string]) ;; Same as: ((write REG [ARRAY]) ;; (read REG) ;; (repeat)) | (write-read-repeat REG [ARRAY]) ;; Same as: ((write integer) ;; (read REG) ;; (repeat)) | (write-read-repeat REG integer) READ := ;; Set REG_0 to a byte read from the input text, set REG_1 ;; to the next byte read, and so on. (read REG_0 [REG_1 ...]) ;; Same as: ((read REG) ;; (if (REG OPERATOR ARG) CCL_BLOCK_0 CCL_BLOCK_1)) | (read-if (REG OPERATOR ARG) CCL_BLOCK_0 CCL_BLOCK_1) ;; Same as: ((read REG) ;; (branch REG CCL_BLOCK_0 [CCL_BLOCK_1 ...])) | (read-branch REG CCL_BLOCK_0 [CCL_BLOCK_1 ...]) ;; Read a character from the input text while parsing ;; multibyte representation, set REG_0 to the charset ID of ;; the character, set REG_1 to the code point of the ;; character. If the dimension of charset is two, set REG_1 ;; to ((CODE0 << 7) | CODE1), where CODE0 is the first code ;; point and CODE1 is the second code point. | (read-multibyte-character REG_0 REG_1) WRITE := ;; Write REG_0, REG_1, ... to the output buffer. If REG_N is ;; a multibyte character, write the corresponding multibyte ;; representation. (write REG_0 [REG_1 ...]) ;; Same as: ((r7 = EXPRESSION) ;; (write r7)) | (write EXPRESSION) ;; Write the value of `integer' to the output buffer. If it ;; is a multibyte character, write the corresponding multibyte ;; representation. | (write integer) ;; Write the byte sequence of `string' as is to the output ;; buffer. | (write string) ;; Same as: (write string) | string ;; Provided that the value of REG is N, write Nth element of ;; ARRAY to the output buffer. If it is a multibyte ;; character, write the corresponding multibyte ;; representation. | (write REG ARRAY) ;; Write a multibyte representation of a character whose ;; charset ID is REG_0 and code point is REG_1. If the ;; dimension of the charset is two, REG_1 should be ((CODE0 << ;; 7) | CODE1), where CODE0 is the first code point and CODE1 ;; is the second code point of the character. | (write-multibyte-character REG_0 REG_1) ;; Call CCL program whose name is ccl-program-name. CALL := (call ccl-program-name) ;; Terminate the CCL program. END := (end) ;; CCL registers that can contain any integer value. As r7 is also ;; used by CCL interpreter, its value is changed unexpectedly. REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 ARG := REG | integer OPERATOR := ;; Normal arithmethic operators (same meaning as C code). + | - | * | / | % ;; Bitwize operators (same meaning as C code) | & | `|' | ^ ;; Shifting operators (same meaning as C code) | << | >> ;; (REG = ARG_0 <8 ARG_1) means: ;; (REG = ((ARG_0 << 8) | ARG_1)) | <8 ;; (REG = ARG_0 >8 ARG_1) means: ;; ((REG = (ARG_0 >> 8)) ;; (r7 = (ARG_0 & 255))) | >8 ;; (REG = ARG_0 // ARG_1) means: ;; ((REG = (ARG_0 / ARG_1)) ;; (r7 = (ARG_0 % ARG_1))) | // ;; Normal comparing operators (same meaning as C code) | < | > | == | <= | >= | != ;; If ARG_0 and ARG_1 are higher and lower byte of Shift-JIS ;; code, and CHAR is the corresponding JISX0208 character, ;; (REG = ARG_0 de-sjis ARG_1) means: ;; ((REG = CODE0) ;; (r7 = CODE1)) ;; where CODE0 is the first code point of CHAR, CODE1 is the ;; second code point of CHAR. | de-sjis ;; If ARG_0 and ARG_1 are the first and second code point of ;; JISX0208 character CHAR, and SJIS is the correponding ;; Shift-JIS code, ;; (REG = ARG_0 en-sjis ARG_1) means: ;; ((REG = HIGH) ;; (r7 = LOW)) ;; where HIGH is the higher byte of SJIS, LOW is the lower ;; byte of SJIS. | en-sjis ASSIGNMENT_OPERATOR := ;; Same meaning as C code += | -= | *= | /= | %= | &= | `|=' | ^= | <<= | >>= ;; (REG <8= ARG) is the same as: ;; ((REG <<= 8) ;; (REG |= ARG)) | <8= ;; (REG >8= ARG) is the same as: ;; ((r7 = (REG & 255)) ;; (REG >>= 8)) ;; (REG //= ARG) is the same as: ;; ((r7 = (REG % ARG)) ;; (REG /= ARG)) | //= ARRAY := `[' integer ... `]' TRANSLATE := (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'. MAP := (iterate-multiple-map REG REG MAP-IDs) | (map-multiple REG REG (MAP-SET)) | (map-single REG REG MAP-ID) MAP-IDs := MAP-ID ... MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET MAP-ID := integer  (defalias 'define-ccl-program '(macro . #[(name ccl-program &optional doc) "\303\304\305\306!!DC\307 \304\nF\310\311 D\312\313\311 D\314BBF\315BBBB\207" [ccl-program name doc let prog ccl-compile eval defconst put quote 'ccl-program-idx register-ccl-program (prog) (nil)] 9 (#$ . 26381)])) #@243 Check validity of CCL-PROGRAM. 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. (defalias 'check-ccl-program '(macro . #[(ccl-program &optional name) "\302\303D\302\304D\305\306 E EFE\207" [ccl-program name if ccl-program-p vectorp progn register-ccl-program] 8 (#$ . 32834)])) #@206 Execute CCL-PROGRAM with registers initialized by the remaining args. The return value is a vector of resulting CCL registers. See the documentation of `define-ccl-program' for the detail of CCL program. (defalias 'ccl-execute-with-args #[(ccl-prog &rest args) "\304\305\306\"\306\n\203*\305W\203*\n@\250\204\307\310!\210 \n@I\210\nAT\202\311 \"\210 *\207" [i reg args ccl-prog make-vector 8 0 error "Arguments should be integer" ccl-execute] 3 (#$ . 33285)]) (provide 'ccl)