]> code.delx.au - gnu-emacs/blobdiff - src/ccl.c
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-86
[gnu-emacs] / src / ccl.c
index 71a08fdf7c7a512427e2e56c71e96d913280fc03..a785707295c6157e32c68753b2e5bf11bfb597cc 100644 (file)
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1,7 +1,7 @@
 /* CCL (Code Conversion Language) interpreter.
    Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
      Licensed to the Free Software Foundation.
 /* CCL (Code Conversion Language) interpreter.
    Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
      Licensed to the Free Software Foundation.
-   Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+   Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
    Copyright (C) 2003
      National Institute of Advanced Industrial Science and Technology (AIST)
      Registration Number H13PRO009
    Copyright (C) 2003
      National Institute of Advanced Industrial Science and Technology (AIST)
      Registration Number H13PRO009
@@ -20,8 +20,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 #include <config.h>
 
 
 #include <config.h>
 
@@ -55,10 +55,12 @@ Lisp_Object Qcode_conversion_map_id;
 Lisp_Object Qccl_program_idx;
 
 /* Table of registered CCL programs.  Each element is a vector of
 Lisp_Object Qccl_program_idx;
 
 /* Table of registered CCL programs.  Each element is a vector of
-   NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of
-   the program, CCL_PROG (vector) is the compiled code of the program,
-   RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is
-   already resolved to index numbers or not.  */
+   NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the
+   name of the program, CCL_PROG (vector) is the compiled code of the
+   program, RESOLVEDP (t or nil) is the flag to tell if symbols in
+   CCL_PROG is already resolved to index numbers or not, UPDATEDP (t
+   or nil) is the flat to tell if the CCL program is updated after it
+   was once used.  */
 Lisp_Object Vccl_program_table;
 
 /* Vector of registered hash tables for translation.  */
 Lisp_Object Vccl_program_table;
 
 /* Vector of registered hash tables for translation.  */
@@ -1850,14 +1852,16 @@ resolve_symbol_ccl_program (ccl)
    symbols, return Qnil.  */
 
 static Lisp_Object
    symbols, return Qnil.  */
 
 static Lisp_Object
-ccl_get_compiled_code (ccl_prog)
+ccl_get_compiled_code (ccl_prog, idx)
      Lisp_Object ccl_prog;
      Lisp_Object ccl_prog;
+     int *idx;
 {
   Lisp_Object val, slot;
 
   if (VECTORP (ccl_prog))
     {
       val = resolve_symbol_ccl_program (ccl_prog);
 {
   Lisp_Object val, slot;
 
   if (VECTORP (ccl_prog))
     {
       val = resolve_symbol_ccl_program (ccl_prog);
+      *idx = -1;
       return (VECTORP (val) ? val : Qnil);
     }
   if (!SYMBOLP (ccl_prog))
       return (VECTORP (val) ? val : Qnil);
     }
   if (!SYMBOLP (ccl_prog))
@@ -1869,9 +1873,10 @@ ccl_get_compiled_code (ccl_prog)
     return Qnil;
   slot = AREF (Vccl_program_table, XINT (val));
   if (! VECTORP (slot)
     return Qnil;
   slot = AREF (Vccl_program_table, XINT (val));
   if (! VECTORP (slot)
-      || ASIZE (slot) != 3
+      || ASIZE (slot) != 4
       || ! VECTORP (AREF (slot, 1)))
     return Qnil;
       || ! VECTORP (AREF (slot, 1)))
     return Qnil;
+  *idx = XINT (val);
   if (NILP (AREF (slot, 2)))
     {
       val = resolve_symbol_ccl_program (AREF (slot, 1));
   if (NILP (AREF (slot, 2)))
     {
       val = resolve_symbol_ccl_program (AREF (slot, 1));
@@ -1900,7 +1905,7 @@ setup_ccl_program (ccl, ccl_prog)
     {
       struct Lisp_Vector *vp;
 
     {
       struct Lisp_Vector *vp;
 
-      ccl_prog = ccl_get_compiled_code (ccl_prog);
+      ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx);
       if (! VECTORP (ccl_prog))
        return -1;
       vp = XVECTOR (ccl_prog);
       if (! VECTORP (ccl_prog))
        return -1;
       vp = XVECTOR (ccl_prog);
@@ -1908,6 +1913,13 @@ setup_ccl_program (ccl, ccl_prog)
       ccl->prog = vp->contents;
       ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
       ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
       ccl->prog = vp->contents;
       ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
       ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
+      if (ccl->idx >= 0)
+       {
+         Lisp_Object slot;
+
+         slot = AREF (Vccl_program_table, ccl->idx);
+         ASET (slot, 3, Qnil);
+       }
     }
   ccl->ic = CCL_HEADER_MAIN;
   for (i = 0; i < 8; i++)
     }
   ccl->ic = CCL_HEADER_MAIN;
   for (i = 0; i < 8; i++)
@@ -1921,6 +1933,33 @@ setup_ccl_program (ccl, ccl_prog)
   return 0;
 }
 
   return 0;
 }
 
+
+/* Check if CCL is updated or not.  If not, re-setup members of CCL.  */
+
+int
+check_ccl_update (ccl)
+     struct ccl_program *ccl;
+{
+  struct Lisp_Vector *vp;
+  Lisp_Object slot, ccl_prog;
+
+  if (ccl->idx < 0)
+    return 0;
+  slot = AREF (Vccl_program_table, ccl->idx);
+  if (NILP (AREF (slot, 3)))
+    return 0;
+  ccl_prog = ccl_get_compiled_code (AREF (slot, 0), &ccl->idx);
+  if (! VECTORP (ccl_prog))
+    return -1;
+  ccl->size = ASIZE (ccl_prog);
+  ccl->prog = XVECTOR (ccl_prog)->contents;
+  ccl->eof_ic = XINT (AREF (ccl_prog, CCL_HEADER_EOF));
+  ccl->buf_magnification = XINT (AREF (ccl_prog, CCL_HEADER_BUF_MAG));
+  ASET (slot, 3, Qnil);
+  return 0;
+}
+
+
 DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
        doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code.
 See the documentation of  `define-ccl-program' for the detail of CCL program.  */)
 DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
        doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code.
 See the documentation of  `define-ccl-program' for the detail of CCL program.  */)
@@ -1991,7 +2030,7 @@ DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
        3, 5, 0,
        doc: /* Execute CCL-PROGRAM with initial STATUS on STRING.
 
        3, 5, 0,
        doc: /* Execute CCL-PROGRAM with initial STATUS on STRING.
 
-CCL-PROGRAM is a symbol registered by register-ccl-program,
+CCL-PROGRAM is a symbol registered by `register-ccl-program',
 or a compiled code generated by `ccl-compile' (for backward compatibility,
 in this case, the execution is slower).
 
 or a compiled code generated by `ccl-compile' (for backward compatibility,
 in this case, the execution is slower).
 
@@ -2012,7 +2051,8 @@ It returns the contents of write buffer as a string,
 If the optional 5th arg UNIBYTE-P is non-nil, the returned string
 is a unibyte string.  By default it is a multibyte string.
 
 If the optional 5th arg UNIBYTE-P is non-nil, the returned string
 is a unibyte string.  By default it is a multibyte string.
 
-See the documentation of `define-ccl-program' for the detail of CCL program.  */)
+See the documentation of `define-ccl-program' for the detail of CCL program.
+usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBYTE-P)  */)
      (ccl_prog, status, str, contin, unibyte_p)
      Lisp_Object ccl_prog, status, str, contin, unibyte_p;
 {
      (ccl_prog, status, str, contin, unibyte_p)
      Lisp_Object ccl_prog, status, str, contin, unibyte_p;
 {
@@ -2138,8 +2178,8 @@ See the documentation of `define-ccl-program' for the detail of CCL program.  */
 
 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
        2, 2, 0,
 
 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
        2, 2, 0,
-       doc: /* Register CCL program CCL_PROG as NAME in `ccl-program-table'.
-CCL_PROG should be a compiled CCL program (vector), or nil.
+       doc: /* Register CCL program CCL-PROG as NAME in `ccl-program-table'.
+CCL-PROG should be a compiled CCL program (vector), or nil.
 If it is nil, just reserve NAME as a CCL program name.
 Return index number of the registered CCL program.  */)
      (name, ccl_prog)
 If it is nil, just reserve NAME as a CCL program name.
 Return index number of the registered CCL program.  */)
      (name, ccl_prog)
@@ -2178,8 +2218,9 @@ Return index number of the registered CCL program.  */)
       if (EQ (name, AREF (slot, 0)))
        {
          /* Update this slot.  */
       if (EQ (name, AREF (slot, 0)))
        {
          /* Update this slot.  */
-         AREF (slot, 1) = ccl_prog;
-         AREF (slot, 2) = resolved;
+         ASET (slot, 1, ccl_prog);
+         ASET (slot, 2, resolved);
+         ASET (slot, 3, Qt);
          return make_number (idx);
        }
     }
          return make_number (idx);
        }
     }
@@ -2192,19 +2233,19 @@ Return index number of the registered CCL program.  */)
 
       new_table = Fmake_vector (make_number (len * 2), Qnil);
       for (j = 0; j < len; j++)
 
       new_table = Fmake_vector (make_number (len * 2), Qnil);
       for (j = 0; j < len; j++)
-       AREF (new_table, j)
-         = AREF (Vccl_program_table, j);
+       ASET (new_table, j, AREF (Vccl_program_table, j));
       Vccl_program_table = new_table;
     }
 
   {
     Lisp_Object elt;
 
       Vccl_program_table = new_table;
     }
 
   {
     Lisp_Object elt;
 
-    elt = Fmake_vector (make_number (3), Qnil);
-    AREF (elt, 0) = name;
-    AREF (elt, 1) = ccl_prog;
-    AREF (elt, 2) = resolved;
-    AREF (Vccl_program_table, idx) = elt;
+    elt = Fmake_vector (make_number (4), Qnil);
+    ASET (elt, 0, name);
+    ASET (elt, 1, ccl_prog);
+    ASET (elt, 2, resolved);
+    ASET (elt, 3, Qt);
+    ASET (Vccl_program_table, idx, elt);
   }
 
   Fput (name, Qccl_program_idx, make_number (idx));
   }
 
   Fput (name, Qccl_program_idx, make_number (idx));