xemacs-beta: src/mule-ccl.c comparison

comparison src/mule-ccl.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	d64f1060cd65
children	27b09b4219b1

comparison

equal deleted inserted replaced

-:17f7e9191c0b
+:0c54de4c4b9d
 } while (0)
 #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))	\
 {								\
 	if (stack_idx > 0)					\
 	  {							\
 setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
 {
 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]);
 ccl->buf_magnification = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_BUF_MAG]);
 }
 ccl->ic = CCL_HEADER_MAIN;
 ccl->eol_type = CCL_CODING_EOL_LF;
 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, /*
 Return t if OBJECT is a CCL program name or a compiled CCL program code.
 See the documentation of  `define-ccl-program' for the detail of CCL program.
 */
 (object))
 {
-Lisp_Object val;
+return NILP (find_ccl_program (object, NULL)) ? Qnil : Qt;
-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);
 }
 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
 Execute CCL-PROGRAM with registers initialized by REGISTERS.
 See the documentation of `define-ccl-program' for the detail of CCL program.
 */
 (ccl_prog, reg))
 {
 struct ccl_program ccl;
+struct gcpro gcpro1;
 int i;
-if (setup_ccl_program (&ccl, ccl_prog) < 0)
+ccl_prog = get_ccl_program (ccl_prog);
-syntax_error ("Invalid CCL program", Qunbound);
+/* 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)
 syntax_error ("Length of vector REGISTERS is not 8", Qunbound);
 if (ccl.status != CCL_STAT_SUCCESS)
 signal_error (Qccl_error, "Error in CCL program at code numbered ...", make_int (ccl.ic));
 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,
 3, 4, 0, /*
 Execute CCL-PROGRAM with initial STATUS on STRING.
 {
 Lisp_Object val;
 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)
+ccl_prog = get_ccl_program (ccl_prog);
-syntax_error ("Invalid CCL program", Qunbound);
+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++)
 {
 if (NILP (XVECTOR_DATA (status)[i]))
 	XVECTOR_DATA (status)[i] = make_int (0);

Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 4745:0c54de4c4b9d