diff src/mule-coding.c @ 4745:0c54de4c4b9d

Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly src/ChangeLog addition: 2009-11-15 Aidan Kehoe <kehoea@parhasard.net> * mule-ccl.c (CCL_CALL_FOR_MAP_INSTRUCTION): Assert that we always have a symbol in this macro. (setup_ccl_program): Ensure we're not allocating unreachable memory in this function; all symbols must have been resolved in a given CCL program before this function is called. (find_ccl_program): New function, return a CCL program with all its symbols resolved if it is valid (possibly allocating memory), Qnil otherwise. (get_ccl_program): New function, exported to other files; call find_ccl_program, and error if it gives nil. (Fccl_program_p): Call find_ccl_program from this function instead of implementing the bulk of it here. (Fccl_execute): Call get_ccl_program instead of implementing the bulk of it here. (Fccl_execute_on_string): Ditto. * mule-ccl.h (Vfont_ccl_encoder_alist): Remove this declaration, it hasn't been used in years. (get_ccl_program): Declare this function. * mule-coding.c (ccl_putprop): Use get_ccl_program on any specified encode or decode CCL program property. (fixed_width_putprop): Ditto. * mule-charset.c (Fmake_charset): Use get_ccl_program on any specified ccl-program. (Fset_charset_ccl_program): Ditto.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 15 Nov 2009 16:53:14 +0000
parents 6dfca4f26f53
children 19a72041c5ed
line wrap: on
line diff
--- a/src/mule-coding.c	Sun Nov 15 14:59:53 2009 +0000
+++ b/src/mule-coding.c	Sun Nov 15 16:53:14 2009 +0000
@@ -3344,44 +3344,10 @@
 static int
 ccl_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value)
 {
-  Lisp_Object sym;
-  struct ccl_program test_ccl;
-  const Ascbyte *suffix;
-
-  /* Check key first.  */
   if (EQ (key, Qdecode))
-    suffix = "-ccl-decode";
+    XCODING_SYSTEM_CCL_DECODE (codesys) = get_ccl_program (value);
   else if (EQ (key, Qencode))
-    suffix = "-ccl-encode";
-  else
-    return 0;
-
-  /* If value is vector, register it as a ccl program
-     associated with a newly created symbol for
-     backward compatibility.
-
-     #### Bogosity alert!  Do we really have to do this crap???? --ben */
-  if (VECTORP (value))
-    {
-      sym = Fintern (concat2 (Fsymbol_name (XCODING_SYSTEM_NAME (codesys)),
-			      build_string (suffix)),
-		     Qnil);
-      Fregister_ccl_program (sym, value);
-    }
-  else
-    {
-      CHECK_SYMBOL (value);
-      sym = value;
-    }
-  /* check if the given ccl programs are valid.  */
-  if (setup_ccl_program (&test_ccl, sym) < 0)
-    invalid_argument ("Invalid CCL program", value);
-
-  if (EQ (key, Qdecode))
-    XCODING_SYSTEM_CCL_DECODE (codesys) = sym;
-  else if (EQ (key, Qencode))
-    XCODING_SYSTEM_CCL_ENCODE (codesys) = sym;
-
+    XCODING_SYSTEM_CCL_ENCODE (codesys) = get_ccl_program (value);
   return 1;
 }
 
@@ -3534,36 +3500,13 @@
 fixed_width_putprop (Lisp_Object codesys, Lisp_Object key,
                      Lisp_Object value)
 {
-  struct ccl_program test_ccl;
-
-  if (EQ (key, Qdecode) || EQ (key, Qencode))
+  if (EQ (key, Qdecode))
     {
-      Lisp_Object sym;
-
-      CHECK_VECTOR (value);
-
-      sym = Fintern (concat3 (XSYMBOL_NAME (XCODING_SYSTEM_NAME (codesys)),
-                              build_string ("-"),
-                              XSYMBOL_NAME (key)), Qnil);
-
-      Fregister_ccl_program (sym, value);
-
-      
-      /* Check if the CCL infrastructure thinks this is a sane CCL
-         program: */
-      if (setup_ccl_program (&test_ccl, value) < 0)
-        {
-          invalid_argument ("Invalid CCL program", value);
-        }
-
-      if (EQ (key, Qdecode))
-        {
-          XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys) = sym;
-        }
-      else 
-        {
-          XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys) = sym;
-        }
+      XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys) = get_ccl_program (value);
+    }
+  else if (EQ (key, Qencode))
+    {
+      XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys) = get_ccl_program (value);
     }
   else if (EQ (key, Qfrom_unicode))
     {