/[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.29.8.1 by miles, Fri Apr 4 06:20:21 2003 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 233  Line 237 
237    
238  ;; If REG is a CCL register symbol (e.g. r0, r1...), the register  ;; If REG is a CCL register symbol (e.g. r0, r1...), the register
239  ;; number is embedded.  If OP is one of unconditional jumps, DATA is  ;; number is embedded.  If OP is one of unconditional jumps, DATA is
240  ;; changed to an relative jump address.  ;; changed to a relative jump address.
241    
242  (defun ccl-embed-code (op reg data &optional reg2)  (defun ccl-embed-code (op reg data &optional reg2)
243    (if (and (> data 0) (get op 'jump-flag))    (if (and (> data 0) (get op 'jump-flag))
# Line 505  Line 509 
509                (ccl-embed-data op)                (ccl-embed-data op)
510                (ccl-embed-data arg))                (ccl-embed-data arg))
511            (ccl-check-register arg cmd)            (ccl-check-register arg cmd)
512            (ccl-embed-code (if read-flag 'read-jump-cond-expr-register            (ccl-embed-code (if read-flag 'read-jump-cond-expr-register
513                              'jump-cond-expr-register)                              'jump-cond-expr-register)
514                            rrr 0)                            rrr 0)
515            (ccl-embed-data op)            (ccl-embed-data op)
# Line 703  Line 707 
707             (error "CCL: Invalid argument %s: %s" arg cmd)))             (error "CCL: Invalid argument %s: %s" arg cmd)))
708      (ccl-embed-code 'read-jump rrr ccl-loop-head))      (ccl-embed-code 'read-jump rrr ccl-loop-head))
709    t)    t)
710                                
711  ;; Compile READ statement.  ;; Compile READ statement.
712  (defun ccl-compile-read (cmd)  (defun ccl-compile-read (cmd)
713    (if (< (length cmd) 2)    (if (< (length cmd) 2)
# 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 855  Line 899 
899                          add 1))                          add 1))
900                  (setq arg (cdr arg)                  (setq arg (cdr arg)
901                        len (+ len add)))                        len (+ len add)))
902                (if mp                (if mp
903                    (cons (- len) result)                    (cons (- len) result)
904                  result))))                  result))))
905      (setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd))      (setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd))
# 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 946  Line 990 
990           (rrr (ash (logand code 255) -5))           (rrr (ash (logand code 255) -5))
991           (cc (ash code -8)))           (cc (ash code -8)))
992      (insert (format "%5d:[%s] " (1- ccl-current-ic) cmd))      (insert (format "%5d:[%s] " (1- ccl-current-ic) cmd))
993      (funcall (get cmd 'ccl-dump-function) rrr cc)))      (funcall (get cmd 'ccl-dump-function) rrr cc)))
994    
995  (defun ccl-dump-set-register (rrr cc)  (defun ccl-dump-set-register (rrr cc)
996    (insert (format "r%d = r%d\n" rrr cc)))    (insert (format "r%d = r%d\n" rrr cc)))
# 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 1221  Line 1273 
1273      (insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))      (insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))
1274    
1275    
1276  ;; CCL emulation staffs  ;; CCL emulation staffs
1277    
1278  ;; Not yet implemented.  ;; Not yet implemented.
1279    
# 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 1420  ASSIGNMENT_OPERATOR := Line 1472  ASSIGNMENT_OPERATOR :=
1472          ;; (REG <8= ARG) is the same as:          ;; (REG <8= ARG) is the same as:
1473          ;;      ((REG <<= 8)          ;;      ((REG <<= 8)
1474          ;;       (REG |= ARG))          ;;       (REG |= ARG))
1475          | <8=          | <8=
1476    
1477          ;; (REG >8= ARG) is the same as:          ;; (REG >8= ARG) is the same as:
1478          ;;      ((r7 = (REG & 255))          ;;      ((r7 = (REG & 255))
# 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.29.8.1

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