changeset 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 17f7e9191c0b
children ae862598ee56 27b09b4219b1
files src/ChangeLog src/mule-ccl.c src/mule-ccl.h src/mule-charset.c src/mule-coding.c
diffstat 5 files changed, 142 insertions(+), 100 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sun Nov 15 14:59:53 2009 +0000
+++ b/src/ChangeLog	Sun Nov 15 16:53:14 2009 +0000
@@ -1,3 +1,30 @@
+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.
+
 2009-11-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* eval.c (Fquote_maybe): 
--- a/src/mule-ccl.c	Sun Nov 15 14:59:53 2009 +0000
+++ b/src/mule-ccl.c	Sun Nov 15 16:53:14 2009 +0000
@@ -627,6 +627,9 @@
 #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic)		\
   do {								\
     struct ccl_program called_ccl;				\
+    /* We shouldn't ever call setup_ccl_program on a vector in  \
+       this context: */                                         \
+    text_checking_assert (SYMBOLP (symbol));                    \
     if (stack_idx >= 256					\
 	|| (setup_ccl_program (&called_ccl, (symbol)) != 0))	\
       {								\
@@ -2150,9 +2153,20 @@
   xzero (*ccl); /* XEmacs change */
   if (! NILP (ccl_prog))
     {
-      ccl_prog = ccl_get_compiled_code (ccl_prog);
+      Lisp_Object new_prog = ccl_get_compiled_code (ccl_prog);
+
+      if (VECTORP (ccl_prog))
+        {
+          /* Make sure we're not allocating unreachable memory in this
+             function: */
+          assert (ccl_prog == new_prog);
+        }
+
+      ccl_prog = new_prog;
+
       if (! VECTORP (ccl_prog))
 	return -1;
+
       ccl->size = XVECTOR_LENGTH (ccl_prog);
       ccl->prog = XVECTOR_DATA (ccl_prog);
       ccl->eof_ic = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_EOF]);
@@ -2163,6 +2177,59 @@
   return 0;
 }
 
+static Lisp_Object
+find_ccl_program (Lisp_Object object, int *unresolved_symbols)
+{
+  struct ccl_program test_ccl;
+
+  if (NULL != unresolved_symbols)
+    {
+      *unresolved_symbols = 0;
+    }
+
+  if (VECTORP (object))
+    {
+      object = resolve_symbol_ccl_program (object);
+      if (EQ (Qt, object))
+        {
+          if (NULL != unresolved_symbols)
+            {
+              *unresolved_symbols = 1;
+            }
+          return Qnil;
+        }
+    }
+  else if (!SYMBOLP (object))
+    {
+      return Qnil;
+    }
+
+  if (setup_ccl_program (&test_ccl, object) < 0)
+    {
+      return Qnil;
+    }
+
+  return object;
+}
+
+Lisp_Object
+get_ccl_program (Lisp_Object object)
+{
+  int unresolved_symbols = 0;
+  Lisp_Object val = find_ccl_program (object, &unresolved_symbols);
+
+  if (unresolved_symbols)
+    {
+      invalid_argument ("Unresolved symbol(s) in CCL program", object);
+    }
+  else if (NILP (val))
+    {
+      invalid_argument ("Invalid CCL program", object);
+    }
+
+  return val;
+}
+
 #ifdef emacs
 
 DEFUN ("ccl-program-p", Fccl_program_p, 1, 1, 0, /*
@@ -2171,20 +2238,7 @@
 */
        (object))
 {
-  Lisp_Object val;
-
-  if (VECTORP (object))
-    {
-      val = resolve_symbol_ccl_program (object);
-      return (VECTORP (val) ? Qt : Qnil);
-    }
-  if (!SYMBOLP (object))
-    return Qnil;
-
-  val = Fget (object, Qccl_program_idx, Qnil);
-  return ((! NATNUMP (val)
-	   || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
-	  ? Qnil : Qt);
+  return NILP (find_ccl_program (object, NULL)) ? Qnil : Qt;
 }
 
 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
@@ -2206,10 +2260,17 @@
        (ccl_prog, reg))
 {
   struct ccl_program ccl;
+  struct gcpro gcpro1;
   int i;
 
-  if (setup_ccl_program (&ccl, ccl_prog) < 0)
-    syntax_error ("Invalid CCL program", Qunbound);
+  ccl_prog = get_ccl_program (ccl_prog);
+  /* get_ccl_program may have consed. GCPROing shouldn't be necessary at the
+     moment, but maybe someday CCL will call Lisp:  */
+  GCPRO1 (ccl_prog);
+
+  i = setup_ccl_program (&ccl, ccl_prog);
+
+  text_checking_assert (i >= 0);
 
   CHECK_VECTOR (reg);
   if (XVECTOR_LENGTH (reg) != 8)
@@ -2229,7 +2290,8 @@
 
   for (i = 0; i < 8; i++)
     XVECTOR (reg)->contents[i] = make_int (ccl.reg[i]);
-  return Qnil;
+
+  RETURN_UNGCPRO (Qnil);
 }
 
 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string,
@@ -2263,17 +2325,19 @@
   struct ccl_program ccl;
   int i, produced;
   unsigned_char_dynarr *outbuf;
-  struct gcpro gcpro1, gcpro2;
+  struct gcpro gcpro1, gcpro2, gcpro3;
 
-  if (setup_ccl_program (&ccl, ccl_prog) < 0)
-    syntax_error ("Invalid CCL program", Qunbound);
+  ccl_prog = get_ccl_program (ccl_prog);
+  i = setup_ccl_program (&ccl, ccl_prog);
+
+  text_checking_assert (i >= 0);
 
   CHECK_VECTOR (status);
   if (XVECTOR (status)->size != 9)
     syntax_error ("Length of vector STATUS is not 9", Qunbound);
   CHECK_STRING (string);
 
-  GCPRO2 (status, string);
+  GCPRO3 (status, string, ccl_prog);
 
   for (i = 0; i < 8; i++)
     {
--- a/src/mule-ccl.h	Sun Nov 15 14:59:53 2009 +0000
+++ b/src/mule-ccl.h	Sun Nov 15 16:53:14 2009 +0000
@@ -69,12 +69,24 @@
 					   line-feed.  */
 #define CCL_CODING_EOL_CR	2	/* Carriage-return only.  */
 
-/* Alist of fontname patterns vs corresponding CCL program.  */
-extern Lisp_Object Vfont_ccl_encoder_alist;
+/* If OBJECT is symbol designating a registered CCL program, return it.
+   Else if OBJECT is a vector CCL program with no unresolved symbols, return
+   it.
+   Else, if OBJECT is a vector CCL program with unresolved symbols, return a
+   newly-created vector reflecting the CCL program with all symbols
+   resolved, if that is currently possible in this XEmacs.
 
-/* Setup fields of the structure pointed by CCL appropriately for the
-   execution of ccl program CCL_PROG (symbol or vector).  */
-extern int setup_ccl_program (struct ccl_program *, Lisp_Object);
+   Otherwise, signal `invalid-argument'. */
+extern Lisp_Object get_ccl_program (Lisp_Object object);
+
+/* Set up fields of the structure pointed by CCL appropriately for the
+   execution of ccl program CCL_PROG (a symbol or a vector).
+
+   If CCL_PROG is a vector and contains unresolved symbols, this function
+   will throw an assertion failure. To avoid this, call get_ccl_program at
+   the point that you receive the CCL program from Lisp, and use and store
+   its (resolved) result instead. */
+extern int setup_ccl_program (struct ccl_program *, Lisp_Object ccl_prog);
 
 extern int ccl_driver (struct ccl_program *, const unsigned char *,
 		       unsigned_char_dynarr *, int, int *, int);
--- a/src/mule-charset.c	Sun Nov 15 14:59:53 2009 +0000
+++ b/src/mule-charset.c	Sun Nov 15 16:53:14 2009 +0000
@@ -587,11 +587,8 @@
 	  }
 	else if (EQ (keyword, Qccl_program))
 	  {
-	    struct ccl_program test_ccl;
-
-	    if (setup_ccl_program (&test_ccl, value) < 0)
-	      invalid_argument ("Invalid value for `ccl-program'", value);
-	    ccl_program = value;
+            /* This errors if VALUE is not a valid CCL program. */
+	    ccl_program = get_ccl_program (value);
 	  }
 	else
 	  invalid_constant ("Unrecognized property", keyword);
@@ -874,9 +871,8 @@
   struct ccl_program test_ccl;
 
   charset = Fget_charset (charset);
-  if (setup_ccl_program (&test_ccl, ccl_program) < 0)
-    invalid_argument ("Invalid ccl-program", ccl_program);
-  XCHARSET_CCL_PROGRAM (charset) = ccl_program;
+  XCHARSET_CCL_PROGRAM (charset) = get_ccl_program (ccl_program);
+
   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
   return Qnil;
 }
--- 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))
     {