/* chartab.c -- char-table support
- Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <setjmp.h>
#include "lisp.h"
#include "character.h"
#include "charset.h"
/* Number of characters each element of Nth level char-table
covers. */
-const int chartab_chars[4] =
+static const int chartab_chars[4] =
{ (1 << (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
(1 << (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
(1 << CHARTAB_SIZE_BITS_3),
/* Number of characters (in bits) each element of Nth level char-table
covers. */
-const int chartab_bits[4] =
+static const int chartab_bits[4] =
{ (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
(CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
CHARTAB_SIZE_BITS_3,
(((c) - (min_char)) >> chartab_bits[(depth)])
-DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
+DEFUE ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
doc: /* Return a newly created char-table, with purpose PURPOSE.
Each element is initialized to INIT, which defaults to nil.
property, the property's value should be an integer between 0 and 10
that specifies how many extra slots the char-table has. Otherwise,
the char-table has no extra slot. */)
- (purpose, init)
- register Lisp_Object purpose, init;
+ (register Lisp_Object purpose, Lisp_Object init)
{
Lisp_Object vector;
Lisp_Object n;
}
static Lisp_Object
-make_sub_char_table (depth, min_char, defalt)
- int depth, min_char;
- Lisp_Object defalt;
+make_sub_char_table (int depth, int min_char, Lisp_Object defalt)
{
Lisp_Object table;
int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth];
}
static Lisp_Object
-char_table_ascii (table)
- Lisp_Object table;
+char_table_ascii (Lisp_Object table)
{
Lisp_Object sub;
return XSUB_CHAR_TABLE (sub)->contents[0];
}
-Lisp_Object
-copy_sub_char_table (table)
- Lisp_Object table;
+static Lisp_Object
+copy_sub_char_table (Lisp_Object table)
{
Lisp_Object copy;
int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
Lisp_Object
-copy_char_table (table)
- Lisp_Object table;
+copy_char_table (Lisp_Object table)
{
Lisp_Object copy;
int size = XCHAR_TABLE (table)->size & PSEUDOVECTOR_SIZE_MASK;
return copy;
}
-Lisp_Object
-sub_char_table_ref (table, c)
- Lisp_Object table;
- int c;
+static Lisp_Object
+sub_char_table_ref (Lisp_Object table, int c)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
}
Lisp_Object
-char_table_ref (table, c)
- Lisp_Object table;
- int c;
+char_table_ref (Lisp_Object table, int c)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
Lisp_Object val;
}
static Lisp_Object
-sub_char_table_ref_and_range (table, c, from, to, defalt)
- Lisp_Object table;
- int c;
- int *from, *to;
- Lisp_Object defalt;
+sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp_Object defalt)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
int min_char = XINT (tbl->min_char);
- int max_char = min_char + chartab_chars[depth - 1] - 1;
- int index = CHARTAB_IDX (c, depth, min_char), idx;
+ int chartab_idx = CHARTAB_IDX (c, depth, min_char), idx;
Lisp_Object val;
- val = tbl->contents[index];
+ val = tbl->contents[chartab_idx];
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, defalt);
else if (NILP (val))
val = defalt;
- idx = index;
+ idx = chartab_idx;
while (idx > 0 && *from < min_char + idx * chartab_chars[depth])
{
Lisp_Object this_val;
break;
}
}
- while ((c = min_char + (index + 1) * chartab_chars[depth]) < max_char
- && *to >= c)
+ while (((c = (chartab_idx + 1) * chartab_chars[depth])
+ < chartab_chars[depth - 1])
+ && (c += min_char) <= *to)
{
Lisp_Object this_val;
- index++;
- this_val = tbl->contents[index];
+ chartab_idx++;
+ this_val = tbl->contents[chartab_idx];
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
else if (NILP (this_val))
1) are different from that of C. */
Lisp_Object
-char_table_ref_and_range (table, c, from, to)
- Lisp_Object table;
- int c;
- int *from, *to;
+char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
- int index = CHARTAB_IDX (c, 0, 0), idx;
+ int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
Lisp_Object val;
- val = tbl->contents[index];
+ val = tbl->contents[chartab_idx];
if (*from < 0)
*from = 0;
if (*to < 0)
else if (NILP (val))
val = tbl->defalt;
- idx = index;
+ idx = chartab_idx;
while (*from < idx * chartab_chars[0])
{
Lisp_Object this_val;
break;
}
}
- while (*to >= (index + 1) * chartab_chars[0])
+ while (*to >= (chartab_idx + 1) * chartab_chars[0])
{
Lisp_Object this_val;
- index++;
- c = index * chartab_chars[0];
- this_val = tbl->contents[index];
+ chartab_idx++;
+ c = chartab_idx * chartab_chars[0];
+ this_val = tbl->contents[chartab_idx];
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt);
}
-#define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL) \
- do { \
- int limit = (TO) < (LIMIT) ? (TO) : (LIMIT); \
- for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \
- } while (0)
-
-#define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR) \
- do { \
- (SUBTABLE) = (TABLE)->contents[(IDX)]; \
- if (!SUB_CHAR_TABLE_P (SUBTABLE)) \
- (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
- } while (0)
-
-
static void
-sub_char_table_set (table, c, val)
- Lisp_Object table;
- int c;
- Lisp_Object val;
+sub_char_table_set (Lisp_Object table, int c, Lisp_Object val)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
}
Lisp_Object
-char_table_set (table, c, val)
- Lisp_Object table;
- int c;
- Lisp_Object val;
+char_table_set (Lisp_Object table, int c, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
}
static void
-sub_char_table_set_range (table, depth, min_char, from, to, val)
- Lisp_Object *table;
- int depth;
- int min_char;
- int from, to;
- Lisp_Object val;
+sub_char_table_set_range (Lisp_Object *table, int depth, int min_char, int from, int to, Lisp_Object val)
{
int max_char = min_char + chartab_chars[depth] - 1;
*table = val;
else
{
- int i, j;
+ int i;
+ unsigned j;
depth++;
if (! SUB_CHAR_TABLE_P (*table))
i = CHARTAB_IDX (from, depth, min_char);
j = CHARTAB_IDX (to, depth, min_char);
min_char += chartab_chars[depth] * i;
- for (; i <= j; i++, min_char += chartab_chars[depth])
+ for (j++; i < j; i++, min_char += chartab_chars[depth])
sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i,
depth, min_char, from, to, val);
}
Lisp_Object
-char_table_set_range (table, from, to, val)
- Lisp_Object table;
- int from, to;
- Lisp_Object val;
+char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
Lisp_Object *contents = tbl->contents;
- int i, min_char;
+ int i;
if (from == to)
char_table_set (table, from, val);
else
{
- for (i = CHARTAB_IDX (from, 0, 0), min_char = i * chartab_chars[0];
- min_char <= to;
- i++, min_char += chartab_chars[0])
- sub_char_table_set_range (contents + i, 0, min_char, from, to, val);
+ unsigned lim = to / chartab_chars[0] + 1;
+ for (i = CHARTAB_IDX (from, 0, 0); i < lim; i++)
+ sub_char_table_set_range (contents + i, 0, i * chartab_chars[0],
+ from, to, val);
if (ASCII_CHAR_P (from))
tbl->ascii = char_table_ascii (table);
}
1, 1, 0,
doc: /*
Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
- (char_table)
- Lisp_Object char_table;
+ (Lisp_Object char_table)
{
CHECK_CHAR_TABLE (char_table);
If CHAR-TABLE holds nil for a given character,
then the actual applicable value is inherited from the parent char-table
\(or from its parents, if necessary). */)
- (char_table)
- Lisp_Object char_table;
+ (Lisp_Object char_table)
{
CHECK_CHAR_TABLE (char_table);
return XCHAR_TABLE (char_table)->parent;
}
-DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
+DEFUE ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
2, 2, 0,
doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
Return PARENT. PARENT must be either nil or another char-table. */)
- (char_table, parent)
- Lisp_Object char_table, parent;
+ (Lisp_Object char_table, Lisp_Object parent)
{
Lisp_Object temp;
return parent;
}
-DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
+DEFUE ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
2, 2, 0,
doc: /* Return the value of CHAR-TABLE's extra-slot number N. */)
- (char_table, n)
- Lisp_Object char_table, n;
+ (Lisp_Object char_table, Lisp_Object n)
{
CHECK_CHAR_TABLE (char_table);
CHECK_NUMBER (n);
return XCHAR_TABLE (char_table)->extras[XINT (n)];
}
-DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
+DEFUE ("set-char-table-extra-slot", Fset_char_table_extra_slot,
Sset_char_table_extra_slot,
3, 3, 0,
doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
- (char_table, n, value)
- Lisp_Object char_table, n, value;
+ (Lisp_Object char_table, Lisp_Object n, Lisp_Object value)
{
CHECK_CHAR_TABLE (char_table);
CHECK_NUMBER (n);
doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
RANGE should be nil (for the default value),
a cons of character codes (for characters in the range), or a character code. */)
- (char_table, range)
- Lisp_Object char_table, range;
+ (Lisp_Object char_table, Lisp_Object range)
{
Lisp_Object val;
CHECK_CHAR_TABLE (char_table);
return val;
}
-DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
+DEFUE ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
3, 3, 0,
doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
RANGE should be t (for all characters), nil (for the default value),
a cons of character codes (for characters in the range),
or a character code. Return VALUE. */)
- (char_table, range, value)
- Lisp_Object char_table, range, value;
+ (Lisp_Object char_table, Lisp_Object range, Lisp_Object value)
{
CHECK_CHAR_TABLE (char_table);
if (EQ (range, Qt))
Sset_char_table_default, 3, 3, 0,
doc: /*
This function is obsolete and has no effect. */)
- (char_table, ch, value)
- Lisp_Object char_table, ch, value;
+ (Lisp_Object char_table, Lisp_Object ch, Lisp_Object value)
{
return Qnil;
}
integer. If the element is not a character, return CH itself. */
int
-char_table_translate (table, ch)
- Lisp_Object table;
- int ch;
+char_table_translate (Lisp_Object table, int ch)
{
Lisp_Object value;
value = Faref (table, make_number (ch));
}
static Lisp_Object
-optimize_sub_char_table (table, test)
- Lisp_Object table, test;
+optimize_sub_char_table (Lisp_Object table, Lisp_Object test)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
return (optimizable ? elt : table);
}
-DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
+DEFUE ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
1, 2, 0,
doc: /* Optimize CHAR-TABLE.
TEST is the comparison function used to decide whether two entries are
equivalent and can be merged. It defaults to `equal'. */)
- (char_table, test)
- Lisp_Object char_table, test;
+ (Lisp_Object char_table, Lisp_Object test)
{
Lisp_Object elt;
int i;
following characters in TABLE have the same value. */
static Lisp_Object
-map_sub_char_table (c_function, function, table, arg, val, range,
- default_val, parent)
- void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- Lisp_Object function, table, arg, val, range, default_val, parent;
+map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
+ Lisp_Object function, Lisp_Object table, Lisp_Object arg, Lisp_Object val,
+ Lisp_Object range, Lisp_Object default_val, Lisp_Object parent)
{
/* Pointer to the elements of TABLE. */
Lisp_Object *contents;
ARG is passed to C_FUNCTION when that is called. */
void
-map_char_table (c_function, function, table, arg)
- void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- Lisp_Object function, table, arg;
+map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object function, Lisp_Object table, Lisp_Object arg)
{
Lisp_Object range, val;
struct gcpro gcpro1, gcpro2, gcpro3;
FUNCTION is called with two arguments--a key and a value.
The key is a character code or a cons of character codes specifying a
range of characters that have the same value. */)
- (function, char_table)
- Lisp_Object function, char_table;
+ (Lisp_Object function, Lisp_Object char_table)
{
CHECK_CHAR_TABLE (char_table);
static void
-map_sub_char_table_for_charset (c_function, function, table, arg, range,
- charset, from, to)
- void (*c_function) P_ ((Lisp_Object, Lisp_Object));
- Lisp_Object function, table, arg, range;
- struct charset *charset;
- unsigned from, to;
+map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
+ Lisp_Object function, Lisp_Object table, Lisp_Object arg,
+ Lisp_Object range, struct charset *charset,
+ unsigned from, unsigned to)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
map_charset_chars. */
void
-map_char_table_for_charset (c_function, function, table, arg,
- charset, from, to)
- void (*c_function) P_ ((Lisp_Object, Lisp_Object));
- Lisp_Object function, table, arg;
- struct charset *charset;
- unsigned from, to;
+map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
+ Lisp_Object function, Lisp_Object table, Lisp_Object arg,
+ struct charset *charset,
+ unsigned from, unsigned to)
{
Lisp_Object range;
int c, i;
\f
void
-syms_of_chartab ()
+syms_of_chartab (void)
{
defsubr (&Smake_char_table);
defsubr (&Schar_table_parent);
defsubr (&Soptimize_char_table);
defsubr (&Smap_char_table);
}
-
-/* arch-tag: 18b5b560-7ab5-4108-b09e-d5dd65dc6fda
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff