Mercurial > hg > xemacs-beta

comparison src/mule-charset.c @ 5178:97eb4942aec8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Mon, 29 Mar 2010 21:28:13 -0500
parents 8b2f75cecb89 1fae11d56ad2
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5177:b785049378e3 5178:97eb4942aec8
1 /* Functions to handle multilingual characters. 1 /* Functions to handle multilingual characters.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. 2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc. 3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 2001, 2002, 2004, 2005 Ben Wing. 4 Copyright (C) 2001, 2002, 2004, 2005, 2010 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
139 int UNUSED (escapeflag)) 139 int UNUSED (escapeflag))
140 { 140 {
141 Lisp_Charset *cs = XCHARSET (obj); 141 Lisp_Charset *cs = XCHARSET (obj);
142 142
143 if (print_readably) 143 if (print_readably)
144 printing_unreadable_lcrecord 144 printing_unreadable_lisp_object
145 (obj, XSTRING_DATA (XSYMBOL (XCHARSET_NAME (obj))->name)); 145 (obj, XSTRING_DATA (XSYMBOL (XCHARSET_NAME (obj))->name));
146 146
147 write_fmt_string_lisp (printcharfun, "#<charset %s %S %S %S", 4, 147 write_fmt_string_lisp (printcharfun, "#<charset %s %S %S %S", 4,
148 CHARSET_NAME (cs), CHARSET_SHORT_NAME (cs), 148 CHARSET_NAME (cs), CHARSET_SHORT_NAME (cs),
149 CHARSET_LONG_NAME (cs), CHARSET_DOC_STRING (cs)); 149 CHARSET_LONG_NAME (cs), CHARSET_DOC_STRING (cs));
156 "r2l", 156 "r2l",
157 CHARSET_COLUMNS (cs), 157 CHARSET_COLUMNS (cs),
158 CHARSET_GRAPHIC (cs), 158 CHARSET_GRAPHIC (cs),
159 CHARSET_FINAL (cs)); 159 CHARSET_FINAL (cs));
160 print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0); 160 print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0);
161 write_fmt_string (printcharfun, " 0x%x>", cs->header.uid); 161 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
162 } 162 }
163 163
164 static const struct memory_description charset_description[] = { 164 static const struct memory_description charset_description[] = {
165 { XD_INT, offsetof (Lisp_Charset, dimension) }, 165 { XD_INT, offsetof (Lisp_Charset, dimension) },
166 { XD_INT, offsetof (Lisp_Charset, from_unicode_levels) }, 166 { XD_INT, offsetof (Lisp_Charset, from_unicode_levels) },
176 { XD_UNION, offsetof (Lisp_Charset, from_unicode_table), 176 { XD_UNION, offsetof (Lisp_Charset, from_unicode_table),
177 XD_INDIRECT (1, 0), { &from_unicode_description }, XD_FLAG_NO_KKCC }, 177 XD_INDIRECT (1, 0), { &from_unicode_description }, XD_FLAG_NO_KKCC },
178 { XD_END } 178 { XD_END }
179 }; 179 };
180 180
181 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, 181 DEFINE_DUMPABLE_LISP_OBJECT ("charset", charset,
182 1, /* dumpable flag */ 182 mark_charset, print_charset, 0,
183 mark_charset, print_charset, 0, 183 0, 0, charset_description, Lisp_Charset);
184 0, 0, charset_description, Lisp_Charset);
185 /* Make a new charset. */ 184 /* Make a new charset. */
186 /* #### SJT Should generic properties be allowed? */ 185 /* #### SJT Should generic properties be allowed? */
187 static Lisp_Object 186 static Lisp_Object
188 make_charset (int id, Lisp_Object name, int rep_bytes, 187 make_charset (int id, Lisp_Object name, int rep_bytes,
189 int type, int columns, int graphic, 188 int type, int columns, int graphic,
194 Lisp_Object obj; 193 Lisp_Object obj;
195 Lisp_Charset *cs; 194 Lisp_Charset *cs;
196 195
197 if (!overwrite) 196 if (!overwrite)
198 { 197 {
199 cs = ALLOC_LCRECORD_TYPE (Lisp_Charset, &lrecord_charset); 198 obj = ALLOC_NORMAL_LISP_OBJECT (charset);
200 obj = wrap_charset (cs); 199 cs = XCHARSET (obj);
201 200
202 if (final) 201 if (final)
203 { 202 {
204 /* some charsets do not have final characters. This includes 203 /* some charsets do not have final characters. This includes
205 ASCII, Control-1, Composite, and the two faux private 204 ASCII, Control-1, Composite, and the two faux private
989 988
990 #ifdef MEMORY_USAGE_STATS 989 #ifdef MEMORY_USAGE_STATS
991 990
992 struct charset_stats 991 struct charset_stats
993 { 992 {
994 int from_unicode; 993 struct usage_stats u;
995 int to_unicode; 994 Bytecount from_unicode;
996 int other; 995 Bytecount to_unicode;
997 }; 996 };
998 997
999 static void 998 static void
1000 compute_charset_usage (Lisp_Object charset, struct charset_stats *stats, 999 compute_charset_usage (Lisp_Object charset, struct charset_stats *stats,
1001 struct overhead_stats *ovstats) 1000 struct usage_stats *ustats)
1002 { 1001 {
1003 struct Lisp_Charset *c = XCHARSET (charset); 1002 stats->from_unicode += compute_from_unicode_table_size (charset, ustats);
1004 xzero (*stats); 1003 stats->to_unicode += compute_to_unicode_table_size (charset, ustats);
1005 stats->other += LISPOBJ_STORAGE_SIZE (c, sizeof (*c), ovstats); 1004 }
1006 stats->from_unicode += compute_from_unicode_table_size (charset, ovstats); 1005
1007 stats->to_unicode += compute_to_unicode_table_size (charset, ovstats); 1006 static void
1008 } 1007 charset_memory_usage (Lisp_Object charset, struct generic_usage_stats *gustats)
1009 1008 {
1010 DEFUN ("charset-memory-usage", Fcharset_memory_usage, 1, 1, 0, /* 1009 struct charset_stats *stats = (struct charset_stats *) gustats;
1011 Return stats about the memory usage of charset CHARSET. 1010
1012 The values returned are in the form of an alist of usage types and 1011 compute_charset_usage (charset, stats, &stats->u);
1013 byte counts. The byte counts attempt to encompass all the memory used
1014 by the charset (separate from the memory logically associated with a
1015 charset or frame), including internal structures and any malloc()
1016 overhead associated with them. In practice, the byte counts are
1017 underestimated for various reasons, e.g. because certain memory usage
1018 is very hard to determine \(e.g. the amount of memory used inside the
1019 Xt library or inside the X server).
1020
1021 Multiple slices of the total memory usage may be returned, separated
1022 by a nil. Each slice represents a particular view of the memory, a
1023 particular way of partitioning it into groups. Within a slice, there
1024 is no overlap between the groups of memory, and each slice collectively
1025 represents all the memory concerned.
1026 */
1027 (charset))
1028 {
1029 struct charset_stats stats;
1030 struct overhead_stats ovstats;
1031 Lisp_Object val = Qnil;
1032
1033 charset = Fget_charset (charset);
1034 xzero (ovstats);
1035 compute_charset_usage (charset, &stats, &ovstats);
1036
1037 val = acons (Qfrom_unicode, make_int (stats.from_unicode), val);
1038 val = acons (Qto_unicode, make_int (stats.to_unicode), val);
1039 val = Fcons (Qnil, val);
1040 val = acons (Qactually_requested, make_int (ovstats.was_requested), val);
1041 val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val);
1042 val = acons (Qgap_overhead, make_int (ovstats.gap_overhead), val);
1043 val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val);
1044
1045 return Fnreverse (val);
1046 } 1012 }
1047 1013
1048 #endif /* MEMORY_USAGE_STATS */ 1014 #endif /* MEMORY_USAGE_STATS */
1049 1015
1050 1016
1051 /************************************************************************/ 1017 /************************************************************************/
1052 /* initialization */ 1018 /* initialization */
1053 /************************************************************************/ 1019 /************************************************************************/
1054 1020
1055 void 1021 void
1022 mule_charset_objects_create (void)
1023 {
1024 #ifdef MEMORY_USAGE_STATS
1025 OBJECT_HAS_METHOD (charset, memory_usage);
1026 #endif
1027 }
1028
1029 void
1056 syms_of_mule_charset (void) 1030 syms_of_mule_charset (void)
1057 { 1031 {
1058 INIT_LRECORD_IMPLEMENTATION (charset); 1032 INIT_LISP_OBJECT (charset);
1059 1033
1060 DEFSUBR (Fcharsetp); 1034 DEFSUBR (Fcharsetp);
1061 DEFSUBR (Ffind_charset); 1035 DEFSUBR (Ffind_charset);
1062 DEFSUBR (Fget_charset); 1036 DEFSUBR (Fget_charset);
1063 DEFSUBR (Fcharset_list); 1037 DEFSUBR (Fcharset_list);
1073 DEFSUBR (Fcharset_property); 1047 DEFSUBR (Fcharset_property);
1074 DEFSUBR (Fcharset_id); 1048 DEFSUBR (Fcharset_id);
1075 DEFSUBR (Fset_charset_ccl_program); 1049 DEFSUBR (Fset_charset_ccl_program);
1076 DEFSUBR (Fset_charset_registries); 1050 DEFSUBR (Fset_charset_registries);
1077 DEFSUBR (Fcharsets_in_region); 1051 DEFSUBR (Fcharsets_in_region);
1078
1079 #ifdef MEMORY_USAGE_STATS
1080 DEFSUBR (Fcharset_memory_usage);
1081 #endif
1082 1052
1083 DEFSYMBOL (Qcharsetp); 1053 DEFSYMBOL (Qcharsetp);
1084 DEFSYMBOL (Qregistries); 1054 DEFSYMBOL (Qregistries);
1085 DEFSYMBOL (Qfinal); 1055 DEFSYMBOL (Qfinal);
1086 DEFSYMBOL (Qgraphic); 1056 DEFSYMBOL (Qgraphic);
1125 1095
1126 void 1096 void
1127 vars_of_mule_charset (void) 1097 vars_of_mule_charset (void)
1128 { 1098 {
1129 int i, j, k; 1099 int i, j, k;
1100
1101 #ifdef MEMORY_USAGE_STATS
1102 OBJECT_HAS_PROPERTY
1103 (charset, memusage_stats_list, list2 (Qfrom_unicode, Qto_unicode));
1104 #endif /* MEMORY_USAGE_STATS */
1130 1105
1131 chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */ 1106 chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
1132 dump_add_root_block_ptr (&chlook, &charset_lookup_description); 1107 dump_add_root_block_ptr (&chlook, &charset_lookup_description);
1133 1108
1134 /* Table of charsets indexed by leading byte. */ 1109 /* Table of charsets indexed by leading byte. */