comparison 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
comparison
equal deleted inserted replaced
4744:17f7e9191c0b 4745:0c54de4c4b9d
3342 } 3342 }
3343 3343
3344 static int 3344 static int
3345 ccl_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value) 3345 ccl_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value)
3346 { 3346 {
3347 Lisp_Object sym;
3348 struct ccl_program test_ccl;
3349 const Ascbyte *suffix;
3350
3351 /* Check key first. */
3352 if (EQ (key, Qdecode)) 3347 if (EQ (key, Qdecode))
3353 suffix = "-ccl-decode"; 3348 XCODING_SYSTEM_CCL_DECODE (codesys) = get_ccl_program (value);
3354 else if (EQ (key, Qencode)) 3349 else if (EQ (key, Qencode))
3355 suffix = "-ccl-encode"; 3350 XCODING_SYSTEM_CCL_ENCODE (codesys) = get_ccl_program (value);
3356 else
3357 return 0;
3358
3359 /* If value is vector, register it as a ccl program
3360 associated with a newly created symbol for
3361 backward compatibility.
3362
3363 #### Bogosity alert! Do we really have to do this crap???? --ben */
3364 if (VECTORP (value))
3365 {
3366 sym = Fintern (concat2 (Fsymbol_name (XCODING_SYSTEM_NAME (codesys)),
3367 build_string (suffix)),
3368 Qnil);
3369 Fregister_ccl_program (sym, value);
3370 }
3371 else
3372 {
3373 CHECK_SYMBOL (value);
3374 sym = value;
3375 }
3376 /* check if the given ccl programs are valid. */
3377 if (setup_ccl_program (&test_ccl, sym) < 0)
3378 invalid_argument ("Invalid CCL program", value);
3379
3380 if (EQ (key, Qdecode))
3381 XCODING_SYSTEM_CCL_DECODE (codesys) = sym;
3382 else if (EQ (key, Qencode))
3383 XCODING_SYSTEM_CCL_ENCODE (codesys) = sym;
3384
3385 return 1; 3351 return 1;
3386 } 3352 }
3387 3353
3388 static Lisp_Object 3354 static Lisp_Object
3389 ccl_getprop (Lisp_Object coding_system, Lisp_Object prop) 3355 ccl_getprop (Lisp_Object coding_system, Lisp_Object prop)
3532 3498
3533 static int 3499 static int
3534 fixed_width_putprop (Lisp_Object codesys, Lisp_Object key, 3500 fixed_width_putprop (Lisp_Object codesys, Lisp_Object key,
3535 Lisp_Object value) 3501 Lisp_Object value)
3536 { 3502 {
3537 struct ccl_program test_ccl; 3503 if (EQ (key, Qdecode))
3538 3504 {
3539 if (EQ (key, Qdecode) || EQ (key, Qencode)) 3505 XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys) = get_ccl_program (value);
3540 { 3506 }
3541 Lisp_Object sym; 3507 else if (EQ (key, Qencode))
3542 3508 {
3543 CHECK_VECTOR (value); 3509 XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys) = get_ccl_program (value);
3544
3545 sym = Fintern (concat3 (XSYMBOL_NAME (XCODING_SYSTEM_NAME (codesys)),
3546 build_string ("-"),
3547 XSYMBOL_NAME (key)), Qnil);
3548
3549 Fregister_ccl_program (sym, value);
3550
3551
3552 /* Check if the CCL infrastructure thinks this is a sane CCL
3553 program: */
3554 if (setup_ccl_program (&test_ccl, value) < 0)
3555 {
3556 invalid_argument ("Invalid CCL program", value);
3557 }
3558
3559 if (EQ (key, Qdecode))
3560 {
3561 XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys) = sym;
3562 }
3563 else
3564 {
3565 XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys) = sym;
3566 }
3567 } 3510 }
3568 else if (EQ (key, Qfrom_unicode)) 3511 else if (EQ (key, Qfrom_unicode))
3569 { 3512 {
3570 CHECK_HASH_TABLE (value); 3513 CHECK_HASH_TABLE (value);
3571 XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys) = value; 3514 XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys) = value;