/[emacs]/emacs/lisp/international/ccl.el
ViewVC logotype

Diff of /emacs/lisp/international/ccl.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.29 by pj, Sun Jul 15 19:53:53 2001 UTC revision 1.30 by fx, Wed Jul 17 10:32:38 2002 UTC
# Line 2  Line 2 
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    
# Line 25  Line 26 
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:
# Line 52  Line 53 
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.
# Line 107  Line 109 
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    
# Line 196  Line 200 
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    
# Line 833  Line 837 
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)
# Line 905  Line 949 
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)
# Line 1192  Line 1236 
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)
# Line 1271  CCL_BLOCK := STATEMENT | (STATEMENT [STA Line 1323  CCL_BLOCK := STATEMENT | (STATEMENT [STA
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)
# Line 1438  TRANSLATE := Line 1490  TRANSLATE :=
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))

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26