X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/56388398e7a1251497f002072c061002ec9d9e81..9f36b9fd38fb4bde2ac4664f05a65e2dd973add2:/src/ccl.c
diff --git a/src/ccl.c b/src/ccl.c
index 6fc6f29d42..411c041b22 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1,8 +1,7 @@
/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 2001-2011 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
@@ -11,10 +10,10 @@
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
@@ -22,13 +21,12 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
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 . */
#include
#include
+#include
#include "lisp.h"
#include "character.h"
@@ -38,13 +36,7 @@ Boston, MA 02110-1301, USA. */
Lisp_Object Qccl, Qcclp;
-/* This contains all code conversion map available to CCL. */
-Lisp_Object Vcode_conversion_map_vector;
-
-/* Alist of fontname patterns vs corresponding CCL program. */
-Lisp_Object Vfont_ccl_encoder_alist;
-
-/* This symbol is a property which assocates with ccl program vector.
+/* This symbol is a property which associates with ccl program vector.
Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
Lisp_Object Qccl_program;
@@ -66,15 +58,10 @@ Lisp_Object Qccl_program_idx;
was once used. */
Lisp_Object Vccl_program_table;
-/* Vector of registered hash tables for translation. */
-Lisp_Object Vtranslation_hash_table_vector;
-
/* Return a hash table of id number ID. */
#define GET_HASH_TABLE(id) \
(XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
-extern int charset_unicode;
-
/* CCL (Code Conversion Language) is a simple language which has
operations on one input buffer, one output buffer, and 7 registers.
The syntax of CCL is described in `ccl.el'. Emacs Lisp function
@@ -451,7 +438,7 @@ extern int charset_unicode;
Therefore, the instruction code range is 0..16384(0x3fff).
*/
-/* Read a multibyte characeter.
+/* Read a multibyte character.
A code point is stored into reg[rrr]. A charset ID is stored into
reg[RRR]. */
@@ -863,11 +850,7 @@ struct ccl_prog_stack
static struct ccl_prog_stack ccl_prog_stack_struct[256];
void
-ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
- struct ccl_program *ccl;
- int *source, *destination;
- int src_size, dst_size;
- Lisp_Object charset_list;
+ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size, int dst_size, Lisp_Object charset_list)
{
register int *reg = ccl->reg;
register int ic = ccl->ic;
@@ -884,9 +867,6 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
int eof_ic = ccl->eof_ic;
int eof_hit = 0;
- if (ic >= eof_ic)
- ic = CCL_HEADER_MAIN;
-
if (ccl->buf_magnification == 0) /* We can't read/produce any bytes. */
dst = NULL;
@@ -1366,7 +1346,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
if (point >= size) continue;
map = AREF (Vcode_conversion_map_vector, point);
- /* Check map varidity. */
+ /* Check map validity. */
if (!CONSP (map)) continue;
map = XCDR (map);
if (!VECTORP (map)) continue;
@@ -1377,7 +1357,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
- [t ELELMENT STARTPOINT ENDPOINT] */
+ [t ELEMENT STARTPOINT ENDPOINT] */
if (NUMBERP (content))
{
point = XUINT (content);
@@ -1539,7 +1519,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
if (point >= map_vector_size) continue;
map = AREF (Vcode_conversion_map_vector, point);
- /* Check map varidity. */
+ /* Check map validity. */
if (!CONSP (map)) continue;
map = XCDR (map);
if (!VECTORP (map)) continue;
@@ -1723,7 +1703,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
msglen = strlen (msg);
if (dst + msglen <= (dst_bytes ? dst_end : src))
{
- bcopy (msg, dst, msglen);
+ memcpy (dst, msg, msglen);
dst += msglen;
}
@@ -1736,7 +1716,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
msglen = strlen (msg);
if (dst + msglen > (dst_bytes ? dst_end : src))
break;
- bcopy (msg, dst, msglen);
+ memcpy (dst, msg, msglen);
dst += msglen;
}
goto ccl_finish;
@@ -1745,7 +1725,8 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
break;
case CCL_STAT_QUIT:
- sprintf(msg, "\nCCL: Quited.");
+ if (! ccl->quit_silently)
+ sprintf(msg, "\nCCL: Quited.");
break;
default:
@@ -1768,7 +1749,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
int i = src_end - src;
if (dst_bytes && (dst_end - dst) < i)
i = dst_end - dst;
- bcopy (src, dst, i);
+ memcpy (dst, src, i);
src += i;
dst += i;
#else
@@ -1798,8 +1779,7 @@ ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
or nil if CCL contains invalid data. */
static Lisp_Object
-resolve_symbol_ccl_program (ccl)
- Lisp_Object ccl;
+resolve_symbol_ccl_program (Lisp_Object ccl)
{
int i, veclen, unresolved = 0;
Lisp_Object result, contents, val;
@@ -1870,9 +1850,7 @@ resolve_symbol_ccl_program (ccl)
symbols, return Qnil. */
static Lisp_Object
-ccl_get_compiled_code (ccl_prog, idx)
- Lisp_Object ccl_prog;
- int *idx;
+ccl_get_compiled_code (Lisp_Object ccl_prog, int *idx)
{
Lisp_Object val, slot;
@@ -1913,9 +1891,7 @@ ccl_get_compiled_code (ccl_prog, idx)
If CCL_PROG is nil, we just reset the structure pointed by CCL. */
int
-setup_ccl_program (ccl, ccl_prog)
- struct ccl_program *ccl;
- Lisp_Object ccl_prog;
+setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
{
int i;
@@ -1948,6 +1924,7 @@ setup_ccl_program (ccl, ccl_prog)
ccl->stack_idx = 0;
ccl->suppress_error = 0;
ccl->eight_bit_control = 0;
+ ccl->quit_silently = 0;
return 0;
}
@@ -1955,8 +1932,7 @@ setup_ccl_program (ccl, ccl_prog)
/* Check if CCL is updated or not. If not, re-setup members of CCL. */
int
-check_ccl_update (ccl)
- struct ccl_program *ccl;
+check_ccl_update (struct ccl_program *ccl)
{
Lisp_Object slot, ccl_prog;
@@ -1979,9 +1955,8 @@ check_ccl_update (ccl)
DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
doc: /* 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 object;
+See the documentation of `define-ccl-program' for the detail of CCL program. */)
+ (Lisp_Object object)
{
Lisp_Object val;
@@ -2015,8 +1990,7 @@ the corresponding register after the execution.
See the documentation of `define-ccl-program' for a definition of CCL
programs. */)
- (ccl_prog, reg)
- Lisp_Object ccl_prog, reg;
+ (Lisp_Object ccl_prog, Lisp_Object reg)
{
struct ccl_program ccl;
int i;
@@ -2060,7 +2034,7 @@ If R0..R7 are nil, they are initialized to 0.
If IC is nil, it is initialized to head of the CCL program.
If optional 4th arg CONTINUE is non-nil, keep IC on read operation
-when read buffer is exausted, else, IC is always set to the end of
+when read buffer is exhausted, else, IC is always set to the end of
CCL-PROGRAM on exit.
It returns the contents of write buffer as a string,
@@ -2070,18 +2044,17 @@ is a unibyte string. By default it is a multibyte string.
See the documentation of `define-ccl-program' for the detail of CCL program.
usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBYTE-P) */)
- (ccl_prog, status, str, contin, unibyte_p)
- Lisp_Object ccl_prog, status, str, contin, unibyte_p;
+ (Lisp_Object ccl_prog, Lisp_Object status, Lisp_Object str, Lisp_Object contin, Lisp_Object unibyte_p)
{
Lisp_Object val;
struct ccl_program ccl;
int i;
int outbufsize;
unsigned char *outbuf, *outp;
- int str_chars, str_bytes;
+ EMACS_INT str_chars, str_bytes;
#define CCL_EXECUTE_BUF_SIZE 1024
int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE];
- int consumed_chars, consumed_bytes, produced_chars;
+ EMACS_INT consumed_chars, consumed_bytes, produced_chars;
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
@@ -2145,7 +2118,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced
> outbufsize)
{
- int offset = outp - outbuf;
+ EMACS_INT offset = outp - outbuf;
outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced;
outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
outp = outbuf + offset;
@@ -2157,7 +2130,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
{
if (outp - outbuf + ccl.produced > outbufsize)
{
- int offset = outp - outbuf;
+ EMACS_INT offset = outp - outbuf;
outbufsize += ccl.produced;
outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
outp = outbuf + offset;
@@ -2201,8 +2174,7 @@ DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
CCL-PROG should be a compiled CCL program (vector), or nil.
If it is nil, just reserve NAME as a CCL program name.
Return index number of the registered CCL program. */)
- (name, ccl_prog)
- Lisp_Object name, ccl_prog;
+ (Lisp_Object name, Lisp_Object ccl_prog)
{
int len = ASIZE (Vccl_program_table);
int idx;
@@ -2231,7 +2203,7 @@ Return index number of the registered CCL program. */)
slot = AREF (Vccl_program_table, idx);
if (!VECTORP (slot))
- /* This is the first unsed slot. Register NAME here. */
+ /* This is the first unused slot. Register NAME here. */
break;
if (EQ (name, AREF (slot, 0)))
@@ -2277,8 +2249,7 @@ DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
2, 2, 0,
doc: /* Register SYMBOL as code conversion map MAP.
Return index number of the registered map. */)
- (symbol, map)
- Lisp_Object symbol, map;
+ (Lisp_Object symbol, Lisp_Object map)
{
int len = ASIZE (Vcode_conversion_map_vector);
int i;
@@ -2317,34 +2288,34 @@ Return index number of the registered map. */)
void
-syms_of_ccl ()
+syms_of_ccl (void)
{
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,
+ DEFVAR_LISP ("code-conversion-map-vector", Vcode_conversion_map_vector,
doc: /* Vector of code conversion maps. */);
Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
- DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
+ DEFVAR_LISP ("font-ccl-encoder-alist", Vfont_ccl_encoder_alist,
doc: /* Alist of fontname patterns vs corresponding CCL program.
Each element looks like (REGEXP . CCL-CODE),
where CCL-CODE is a compiled CCL program.
@@ -2357,7 +2328,7 @@ The code point in the font is set in CCL registers R1 and R2
If the font is single-byte font, the register R2 is not used. */);
Vfont_ccl_encoder_alist = Qnil;
- DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector,
+ DEFVAR_LISP ("translation-hash-table-vector", Vtranslation_hash_table_vector,
doc: /* Vector containing all translation hash tables ever defined.
Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls
to `define-translation-hash-table'. The vector is indexed by the table id
@@ -2371,5 +2342,3 @@ used by CCL. */);
defsubr (&Sregister_code_conversion_map);
}
-/* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860
- (do not change this comment) */