[COMMIT] Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly
Aidan Kehoe
kehoea at parhasard.net
Sun Nov 15 12:03:06 EST 2009
This is the proper fix for the problem Robert Delius Royar was seeing when I
moved the query-coding-region implementation to C; the bug that I tickled
then was old, cf. the "Bogosity alert!" comment below from Ben.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea at parhasard.net>
# Date 1258303994 0
# Node ID 0c54de4c4b9dcd6659362d857f6dcf0efcdccb28
# Parent 17f7e9191c0b5ff234091cfcf43267a26583b2b9
Resolve the unregistered-CCL-programs-get-garbage-collected problem correctly
src/ChangeLog addition:
2009-11-15 Aidan Kehoe <kehoea at 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.
diff -r 17f7e9191c0b -r 0c54de4c4b9d src/ChangeLog
--- 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 at 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 at parhasard.net>
* eval.c (Fquote_maybe):
diff -r 17f7e9191c0b -r 0c54de4c4b9d src/mule-ccl.c
--- 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++)
{
diff -r 17f7e9191c0b -r 0c54de4c4b9d src/mule-ccl.h
--- 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);
diff -r 17f7e9191c0b -r 0c54de4c4b9d src/mule-charset.c
--- 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;
}
diff -r 17f7e9191c0b -r 0c54de4c4b9d src/mule-coding.c
--- 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))
{
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
More information about the XEmacs-Patches
mailing list