/* CCL (Code Conversion Language) interpreter.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008, 2009, 2010
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
+#include <setjmp.h>
#include "lisp.h"
#include "character.h"
break;
case CCL_STAT_QUIT:
- sprintf(msg, "\nCCL: Quited.");
+ if (! ccl->quit_silently)
+ sprintf(msg, "\nCCL: Quited.");
break;
default:
val = Fget (XCAR (contents), XCDR (contents));
if (NATNUMP (val))
- AREF (result, i) = val;
+ ASET (result, i, val);
else
unresolved = 1;
continue;
val = Fget (contents, Qtranslation_table_id);
if (NATNUMP (val))
- AREF (result, i) = val;
+ ASET (result, i, val);
else
{
val = Fget (contents, Qcode_conversion_map_id);
if (NATNUMP (val))
- AREF (result, i) = val;
+ ASET (result, i, val);
else
{
val = Fget (contents, Qccl_program_idx);
if (NATNUMP (val))
- AREF (result, i) = val;
+ ASET (result, i, val);
else
unresolved = 1;
}
val = resolve_symbol_ccl_program (AREF (slot, 1));
if (! VECTORP (val))
return Qnil;
- AREF (slot, 1) = val;
- AREF (slot, 2) = Qt;
+ ASET (slot, 1, val);
+ ASET (slot, 2, Qt);
}
return AREF (slot, 1);
}
ccl->stack_idx = 0;
ccl->suppress_error = 0;
ccl->eight_bit_control = 0;
+ ccl->quit_silently = 0;
return 0;
}
error ("Error in CCL program at %dth code", ccl.ic);
for (i = 0; i < 8; i++)
- XSETINT (AREF (reg, i), ccl.reg[i]);
+ ASET (reg, i, make_number (ccl.reg[i]));
return Qnil;
}
for (i = 0; i < 8; i++)
{
if (NILP (AREF (status, i)))
- XSETINT (AREF (status, i), 0);
+ ASET (status, i, make_number (0));
if (INTEGERP (AREF (status, i)))
ccl.reg[i] = XINT (AREF (status, i));
}
}
if (idx == len)
- {
- /* Extend the table. */
- Lisp_Object new_table;
- int j;
-
- new_table = Fmake_vector (make_number (len * 2), Qnil);
- for (j = 0; j < len; j++)
- ASET (new_table, j, AREF (Vccl_program_table, j));
- Vccl_program_table = new_table;
- }
+ /* Extend the table. */
+ Vccl_program_table = larger_vector (Vccl_program_table, len * 2, Qnil);
{
Lisp_Object elt;
}
if (i == len)
- {
- Lisp_Object new_vector = Fmake_vector (make_number (len * 2), Qnil);
- int j;
-
- for (j = 0; j < len; j++)
- AREF (new_vector, j)
- = AREF (Vcode_conversion_map_vector, j);
- Vcode_conversion_map_vector = new_vector;
- }
+ Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
+ len * 2, Qnil);
index = make_number (i);
Fput (symbol, Qcode_conversion_map, map);
Fput (symbol, Qcode_conversion_map_id, index);
- AREF (Vcode_conversion_map_vector, i) = Fcons (symbol, map);
+ ASET (Vcode_conversion_map_vector, i, Fcons (symbol, map));
return index;
}
staticpro (&Vccl_program_table);
Vccl_program_table = Fmake_vector (make_number (32), Qnil);
- Qccl = intern ("ccl");
+ Qccl = intern_c_string ("ccl");
staticpro (&Qccl);
- Qcclp = intern ("cclp");
+ Qcclp = intern_c_string ("cclp");
staticpro (&Qcclp);
- Qccl_program = intern ("ccl-program");
+ Qccl_program = intern_c_string ("ccl-program");
staticpro (&Qccl_program);
- Qccl_program_idx = intern ("ccl-program-idx");
+ Qccl_program_idx = intern_c_string ("ccl-program-idx");
staticpro (&Qccl_program_idx);
- Qcode_conversion_map = intern ("code-conversion-map");
+ Qcode_conversion_map = intern_c_string ("code-conversion-map");
staticpro (&Qcode_conversion_map);
- Qcode_conversion_map_id = intern ("code-conversion-map-id");
+ Qcode_conversion_map_id = intern_c_string ("code-conversion-map-id");
staticpro (&Qcode_conversion_map_id);
DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,