+Lisp_Object Vall_syntax_tables;
+
+#ifdef MULE
+Lisp_Object Qcategory_table_p;
+Lisp_Object Qcategory_designator_p;
+Lisp_Object Qcategory_table_value_p;
+
+Lisp_Object Vstandard_category_table;
+
+/* Variables to determine word boundary. */
+Lisp_Object Vword_combining_categories, Vword_separating_categories;
+#endif /* MULE */
+
+\f
+#ifdef UTF2000
+
+#define BT_UINT8_MIN 0
+#define BT_UINT8_MAX (UCHAR_MAX - 3)
+#define BT_UINT8_t (UCHAR_MAX - 2)
+#define BT_UINT8_nil (UCHAR_MAX - 1)
+#define BT_UINT8_unbound UCHAR_MAX
+
+INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
+INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
+INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
+INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
+INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
+
+INLINE_HEADER int
+INT_UINT8_P (Lisp_Object obj)
+{
+ if (INTP (obj))
+ {
+ int num = XINT (obj);
+
+ return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER int
+UINT8_VALUE_P (Lisp_Object obj)
+{
+ return EQ (obj, Qunbound)
+ || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
+}
+
+INLINE_HEADER unsigned char
+UINT8_ENCODE (Lisp_Object obj)
+{
+ if (EQ (obj, Qunbound))
+ return BT_UINT8_unbound;
+ else if (EQ (obj, Qnil))
+ return BT_UINT8_nil;
+ else if (EQ (obj, Qt))
+ return BT_UINT8_t;
+ else
+ return XINT (obj);
+}
+
+INLINE_HEADER Lisp_Object
+UINT8_DECODE (unsigned char n)
+{
+ if (n == BT_UINT8_unbound)
+ return Qunbound;
+ else if (n == BT_UINT8_nil)
+ return Qnil;
+ else if (n == BT_UINT8_t)
+ return Qt;
+ else
+ return make_int (n);
+}
+
+static Lisp_Object
+mark_uint8_byte_table (Lisp_Object obj)
+{
+ return Qnil;
+}
+
+static void
+print_uint8_byte_table (Lisp_Object obj,
+ Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("\n#<uint8-byte-table", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ unsigned char n = bte->property[i];
+ if ( (i & 15) == 0 )
+ write_c_string ("\n ", printcharfun);
+ write_c_string (" ", printcharfun);
+ if (n == BT_UINT8_unbound)
+ write_c_string ("void", printcharfun);
+ else if (n == BT_UINT8_nil)
+ write_c_string ("nil", printcharfun);
+ else if (n == BT_UINT8_t)
+ write_c_string ("t", printcharfun);
+ else
+ {
+ char buf[4];
+
+ sprintf (buf, "%hd", n);
+ write_c_string (buf, printcharfun);
+ }
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
+ Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ if (te1->property[i] != te2->property[i])
+ return 0;
+ return 1;
+}
+
+static unsigned long
+uint8_byte_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
+ int i;
+ hashcode_t hash = 0;
+
+ for (i = 0; i < 256; i++)
+ hash = HASH2 (hash, te->property[i]);
+ return hash;
+}
+
+static const struct lrecord_description uint8_byte_table_description[] = {
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
+ mark_uint8_byte_table,
+ print_uint8_byte_table,
+ 0, uint8_byte_table_equal,
+ uint8_byte_table_hash,
+ uint8_byte_table_description,
+ Lisp_Uint8_Byte_Table);
+
+static Lisp_Object
+make_uint8_byte_table (unsigned char initval)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint8_Byte_Table *cte;
+
+ cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
+ &lrecord_uint8_byte_table);
+
+ for (i = 0; i < 256; i++)
+ cte->property[i] = initval;
+
+ XSETUINT8_BYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static Lisp_Object
+copy_uint8_byte_table (Lisp_Object entry)
+{
+ Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint8_Byte_Table *ctenew
+ = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
+ &lrecord_uint8_byte_table);
+
+ for (i = 0; i < 256; i++)
+ {
+ ctenew->property[i] = cte->property[i];
+ }
+
+ XSETUINT8_BYTE_TABLE (obj, ctenew);
+ return obj;
+}
+
+static int
+uint8_byte_table_same_value_p (Lisp_Object obj)
+{
+ Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
+ unsigned char v0 = bte->property[0];
+ int i;
+
+ for (i = 1; i < 256; i++)
+ {
+ if (bte->property[i] != v0)
+ return 0;
+ }
+ return -1;
+}
+
+static int
+map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ struct chartab_range rainj;
+ int i, retval;
+ int unit = 1 << (8 * place);
+ Emchar c = ofs;
+ Emchar c1;
+
+ rainj.type = CHARTAB_RANGE_CHAR;
+
+ for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+ {
+ if (ct->property[i] != BT_UINT8_unbound)
+ {
+ c1 = c + unit;
+ for (; c < c1 && retval == 0; c++)
+ {
+ rainj.ch = c;
+ retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
+ }
+ }
+ else
+ c += unit;
+ }
+ return retval;
+}
+
+#define BT_UINT16_MIN 0
+#define BT_UINT16_MAX (USHRT_MAX - 3)
+#define BT_UINT16_t (USHRT_MAX - 2)
+#define BT_UINT16_nil (USHRT_MAX - 1)
+#define BT_UINT16_unbound USHRT_MAX
+
+INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
+INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
+INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
+INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
+
+INLINE_HEADER int
+INT_UINT16_P (Lisp_Object obj)
+{
+ if (INTP (obj))
+ {
+ int num = XINT (obj);
+
+ return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER int
+UINT16_VALUE_P (Lisp_Object obj)
+{
+ return EQ (obj, Qunbound)
+ || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
+}
+
+INLINE_HEADER unsigned short
+UINT16_ENCODE (Lisp_Object obj)
+{
+ if (EQ (obj, Qunbound))
+ return BT_UINT16_unbound;
+ else if (EQ (obj, Qnil))
+ return BT_UINT16_nil;
+ else if (EQ (obj, Qt))
+ return BT_UINT16_t;
+ else
+ return XINT (obj);
+}
+
+INLINE_HEADER Lisp_Object
+UINT16_DECODE (unsigned short n)
+{
+ if (n == BT_UINT16_unbound)
+ return Qunbound;
+ else if (n == BT_UINT16_nil)
+ return Qnil;
+ else if (n == BT_UINT16_t)
+ return Qt;
+ else
+ return make_int (n);
+}
+
+INLINE_HEADER unsigned short
+UINT8_TO_UINT16 (unsigned char n)
+{
+ if (n == BT_UINT8_unbound)
+ return BT_UINT16_unbound;
+ else if (n == BT_UINT8_nil)
+ return BT_UINT16_nil;
+ else if (n == BT_UINT8_t)
+ return BT_UINT16_t;
+ else
+ return n;
+}
+
+static Lisp_Object
+mark_uint16_byte_table (Lisp_Object obj)
+{
+ return Qnil;
+}
+
+static void
+print_uint16_byte_table (Lisp_Object obj,
+ Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("\n#<uint16-byte-table", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ unsigned short n = bte->property[i];
+ if ( (i & 15) == 0 )
+ write_c_string ("\n ", printcharfun);
+ write_c_string (" ", printcharfun);
+ if (n == BT_UINT16_unbound)
+ write_c_string ("void", printcharfun);
+ else if (n == BT_UINT16_nil)
+ write_c_string ("nil", printcharfun);
+ else if (n == BT_UINT16_t)
+ write_c_string ("t", printcharfun);
+ else
+ {
+ char buf[7];
+
+ sprintf (buf, "%hd", n);
+ write_c_string (buf, printcharfun);
+ }
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
+ Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ if (te1->property[i] != te2->property[i])
+ return 0;
+ return 1;
+}
+
+static unsigned long
+uint16_byte_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
+ int i;
+ hashcode_t hash = 0;
+
+ for (i = 0; i < 256; i++)
+ hash = HASH2 (hash, te->property[i]);
+ return hash;
+}
+
+static const struct lrecord_description uint16_byte_table_description[] = {
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
+ mark_uint16_byte_table,
+ print_uint16_byte_table,
+ 0, uint16_byte_table_equal,
+ uint16_byte_table_hash,
+ uint16_byte_table_description,
+ Lisp_Uint16_Byte_Table);
+
+static Lisp_Object
+make_uint16_byte_table (unsigned short initval)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint16_Byte_Table *cte;
+
+ cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
+ &lrecord_uint16_byte_table);
+
+ for (i = 0; i < 256; i++)
+ cte->property[i] = initval;
+
+ XSETUINT16_BYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static Lisp_Object
+copy_uint16_byte_table (Lisp_Object entry)
+{
+ Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint16_Byte_Table *ctenew
+ = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
+ &lrecord_uint16_byte_table);
+
+ for (i = 0; i < 256; i++)
+ {
+ ctenew->property[i] = cte->property[i];
+ }
+
+ XSETUINT16_BYTE_TABLE (obj, ctenew);
+ return obj;
+}
+
+static Lisp_Object
+expand_uint8_byte_table_to_uint16 (Lisp_Object table)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
+ Lisp_Uint16_Byte_Table* cte;
+
+ cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
+ &lrecord_uint16_byte_table);
+ for (i = 0; i < 256; i++)
+ {
+ cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
+ }
+ XSETUINT16_BYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static int
+uint16_byte_table_same_value_p (Lisp_Object obj)
+{
+ Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
+ unsigned short v0 = bte->property[0];
+ int i;
+
+ for (i = 1; i < 256; i++)
+ {
+ if (bte->property[i] != v0)
+ return 0;
+ }
+ return -1;
+}
+
+static int
+map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ struct chartab_range rainj;
+ int i, retval;
+ int unit = 1 << (8 * place);
+ Emchar c = ofs;
+ Emchar c1;
+
+ rainj.type = CHARTAB_RANGE_CHAR;
+
+ for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+ {
+ if (ct->property[i] != BT_UINT16_unbound)
+ {
+ c1 = c + unit;
+ for (; c < c1 && retval == 0; c++)
+ {
+ rainj.ch = c;
+ retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
+ }
+ }
+ else
+ c += unit;
+ }
+ return retval;
+}
+
+
+static Lisp_Object
+mark_byte_table (Lisp_Object obj)
+{
+ Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ mark_object (cte->property[i]);
+ }
+ return Qnil;
+}
+
+static void
+print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("\n#<byte-table", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ Lisp_Object elt = bte->property[i];
+ if ( (i & 15) == 0 )
+ write_c_string ("\n ", printcharfun);
+ write_c_string (" ", printcharfun);
+ if (EQ (elt, Qunbound))
+ write_c_string ("void", printcharfun);
+ else
+ print_internal (elt, printcharfun, escapeflag);
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
+ Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ if (BYTE_TABLE_P (cte1->property[i]))
+ {
+ if (BYTE_TABLE_P (cte2->property[i]))
+ {
+ if (!byte_table_equal (cte1->property[i],
+ cte2->property[i], depth + 1))
+ return 0;
+ }
+ else
+ return 0;
+ }
+ else
+ if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
+ return 0;
+ return 1;
+}
+
+static unsigned long
+byte_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
+
+ return internal_array_hash (cte->property, 256, depth);
+}
+
+static const struct lrecord_description byte_table_description[] = {
+ { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
+ mark_byte_table,
+ print_byte_table,
+ 0, byte_table_equal,
+ byte_table_hash,
+ byte_table_description,
+ Lisp_Byte_Table);
+
+static Lisp_Object
+make_byte_table (Lisp_Object initval)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Byte_Table *cte;
+
+ cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
+
+ for (i = 0; i < 256; i++)
+ cte->property[i] = initval;
+
+ XSETBYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static Lisp_Object
+copy_byte_table (Lisp_Object entry)
+{
+ Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
+ Lisp_Object obj;
+ int i;
+ Lisp_Byte_Table *ctnew
+ = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
+
+ for (i = 0; i < 256; i++)
+ {
+ if (UINT8_BYTE_TABLE_P (cte->property[i]))
+ {
+ ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
+ }
+ else if (UINT16_BYTE_TABLE_P (cte->property[i]))
+ {
+ ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
+ }
+ else if (BYTE_TABLE_P (cte->property[i]))
+ {
+ ctnew->property[i] = copy_byte_table (cte->property[i]);
+ }
+ else
+ ctnew->property[i] = cte->property[i];
+ }
+
+ XSETBYTE_TABLE (obj, ctnew);
+ return obj;
+}
+
+static int
+byte_table_same_value_p (Lisp_Object obj)
+{
+ Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
+ Lisp_Object v0 = bte->property[0];
+ int i;
projects / chise / xemacs-chise.git- / blobdiff