Mercurial > hg > xemacs-beta
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)) {