[Emacs-diffs] Changes to emacs/lisp/international/ccl.el

[Dave Love]

Index: emacs/lisp/international/ccl.el
diff -c emacs/lisp/international/ccl.el:1.29 
emacs/lisp/international/ccl.el:1.30
*** emacs/lisp/international/ccl.el:1.29        Sun Jul 15 15:53:53 2001
--- emacs/lisp/international/ccl.el     Wed Jul 17 06:32:38 2002
***************
*** 2,7 ****
--- 2,8 ----
  
  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
  ;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2002 Free Software Foundation, Inc.
  
  ;; Keywords: CCL, mule, multilingual, character set, coding-system
  
***************
*** 25,43 ****
  ;;; Commentary:
  
  ;; CCL (Code Conversion Language) is a simple programming language to
! ;; be used for various kind of code conversion.  CCL program is
! ;; compiled to CCL code (vector of integers) and executed by CCL
! ;; interpreter of Emacs.
  ;;
  ;; CCL is used for code conversion at process I/O and file I/O for
! ;; non-standard coding-system.  In addition, it is used for
! ;; calculating a code point of X's font from a character code.
  ;; However, since CCL is designed as a powerful programming language,
  ;; it can be used for more generic calculation.  For instance,
  ;; combination of three or more arithmetic operations can be
! ;; calculated faster than Emacs Lisp.
  ;;
! ;; Syntax and semantics of CCL program is described in the
  ;; documentation of `define-ccl-program'.
  
  ;;; Code:
--- 26,44 ----
  ;;; Commentary:
  
  ;; CCL (Code Conversion Language) is a simple programming language to
! ;; be used for various kind of code conversion.  A CCL program is
! ;; compiled to CCL code (vector of integers) and executed by the CCL
! ;; interpreter in Emacs.
  ;;
  ;; CCL is used for code conversion at process I/O and file I/O for
! ;; non-standard coding-systems.  In addition, it is used for
! ;; calculating code points of X fonts from character codes.
  ;; However, since CCL is designed as a powerful programming language,
  ;; it can be used for more generic calculation.  For instance,
  ;; combination of three or more arithmetic operations can be
! ;; calculated faster than in Emacs Lisp.
  ;;
! ;; The syntax and semantics of CCL programs are described in the
  ;; documentation of `define-ccl-program'.
  
  ;;; Code:
***************
*** 52,58 ****
        read read-if read-branch write call end
        read-multibyte-character write-multibyte-character
        translate-character
!       iterate-multiple-map map-multiple map-single]
    "Vector of CCL commands (symbols).")
  
  ;; Put a property to each symbol of CCL commands for the compiler.
--- 53,60 ----
        read read-if read-branch write call end
        read-multibyte-character write-multibyte-character
        translate-character
!       iterate-multiple-map map-multiple map-single lookup-integer
!       lookup-character]
    "Vector of CCL commands (symbols).")
  
  ;; Put a property to each symbol of CCL commands for the compiler.
***************
*** 107,112 ****
--- 109,116 ----
     iterate-multiple-map
     map-multiple
     map-single
+    lookup-int-const-tbl
+    lookup-char-const-tbl
     ]
    "Vector of CCL extended compiled codes (symbols).")
  
***************
*** 196,203 ****
  
  ;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give
  ;; proper index number for SYMBOL.  PROP should be
! ;; `translation-table-id', `code-conversion-map-id', or
! ;; `ccl-program-idx'.
  (defun ccl-embed-symbol (symbol prop)
    (ccl-embed-data (cons symbol prop)))
  
--- 200,207 ----
  
  ;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give
  ;; proper index number for SYMBOL.  PROP should be
! ;; `translation-table-id', `translation-hash-table-id'
! ;; `code-conversion-map-id', or `ccl-program-idx'.
  (defun ccl-embed-symbol (symbol prop)
    (ccl-embed-data (cons symbol prop)))
  
***************
*** 833,838 ****
--- 837,882 ----
           (ccl-embed-extended-command 'translate-character rrr RRR Rrr))))
    nil)
  
+ ;; Compile lookup-integer
+ (defun ccl-compile-lookup-integer (cmd)
+   (if (/= (length cmd) 4)
+       (error "CCL: Invalid number of arguments: %s" cmd))
+   (let ((Rrr (nth 1 cmd))
+       (RRR (nth 2 cmd))
+       (rrr (nth 3 cmd)))
+     (ccl-check-register RRR cmd)
+     (ccl-check-register rrr cmd)
+     (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number)))
+          (ccl-embed-extended-command 'lookup-int-const-tbl
+                                      rrr RRR 0)
+          (ccl-embed-symbol Rrr 'translation-hash-table-id))
+         (t
+          (error "CCL: non-constant table: %s" cmd)
+          ;; not implemented:
+          (ccl-check-register Rrr cmd)
+          (ccl-embed-extended-command 'lookup-int rrr RRR 0))))
+   nil)
+ 
+ ;; Compile lookup-character
+ (defun ccl-compile-lookup-character (cmd)
+   (if (/= (length cmd) 4)
+       (error "CCL: Invalid number of arguments: %s" cmd))
+   (let ((Rrr (nth 1 cmd))
+       (RRR (nth 2 cmd))
+       (rrr (nth 3 cmd)))
+     (ccl-check-register RRR cmd)
+     (ccl-check-register rrr cmd)
+     (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number)))
+          (ccl-embed-extended-command 'lookup-char-const-tbl
+                                      rrr RRR 0)
+          (ccl-embed-symbol Rrr 'translation-hash-table-id))
+         (t
+          (error "CCL: non-constant table: %s" cmd)
+          ;; not implemented:
+          (ccl-check-register Rrr cmd)
+          (ccl-embed-extended-command 'lookup-char rrr RRR 0))))
+   nil)
+ 
  (defun ccl-compile-iterate-multiple-map (cmd)
    (ccl-compile-multiple-map-function 'iterate-multiple-map cmd)
    nil)
***************
*** 905,911 ****
        (setq args (cdr args)))))
  
  
! ;;; CCL dump staffs
  
  ;; To avoid byte-compiler warning.
  (defvar ccl-code)
--- 949,955 ----
        (setq args (cdr args)))))
  
  
! ;;; CCL dump stuff
  
  ;; To avoid byte-compiler warning.
  (defvar ccl-code)
***************
*** 1192,1197 ****
--- 1236,1249 ----
    (let ((tbl (ccl-get-next-code)))
      (insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr))))
  
+ (defun ccl-dump-lookup-int-const-tbl (rrr RRR Rrr)
+   (let ((tbl (ccl-get-next-code)))
+     (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
+ 
+ (defun ccl-dump-lookup-char-const-tbl (rrr RRR Rrr)
+   (let ((tbl (ccl-get-next-code)))
+     (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
+ 
  (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr)
    (let ((notbl (ccl-get-next-code))
        (i 0) id)
***************
*** 1271,1277 ****
  
  STATEMENT :=
        SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL
!       | TRANSLATE | END
  
  SET :=        (REG = EXPRESSION)
        | (REG ASSIGNMENT_OPERATOR EXPRESSION)
--- 1323,1329 ----
  
  STATEMENT :=
        SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL
!       | TRANSLATE | MAP | LOOKUP | END
  
  SET :=        (REG = EXPRESSION)
        | (REG ASSIGNMENT_OPERATOR EXPRESSION)
***************
*** 1438,1443 ****
--- 1490,1499 ----
        (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'.
+ LOOKUP :=
+       (lookup-character SYMBOL REG(charset) REG(codepoint))
+       | (lookup-integer SYMBOL REG(integer))
+         ;; SYMBOL refers to a table defined by 
`define-hash-translation-table'.
  MAP :=
       (iterate-multiple-map REG REG MAP-IDs)
       | (map-multiple REG REG (MAP-SET))