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

merge
author Ben Wing <ben@xemacs.org>
date Mon, 29 Mar 2010 21:28:13 -0500
parents 8b2f75cecb89 1fae11d56ad2
children 71ee43b8a74d
line wrap: on
line diff
--- a/src/mule-charset.c	Tue Feb 23 07:28:35 2010 -0600
+++ b/src/mule-charset.c	Mon Mar 29 21:28:13 2010 -0500
@@ -1,7 +1,7 @@
 /* Functions to handle multilingual characters.
    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
-   Copyright (C) 2001, 2002, 2004, 2005 Ben Wing.
+   Copyright (C) 2001, 2002, 2004, 2005, 2010 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -141,7 +141,7 @@
   Lisp_Charset *cs = XCHARSET (obj);
 
   if (print_readably)
-    printing_unreadable_lcrecord
+    printing_unreadable_lisp_object
       (obj, XSTRING_DATA (XSYMBOL (XCHARSET_NAME (obj))->name));
 
   write_fmt_string_lisp (printcharfun, "#<charset %s %S %S %S", 4,
@@ -158,7 +158,7 @@
 		    CHARSET_GRAPHIC (cs),
 		    CHARSET_FINAL (cs));
   print_internal (CHARSET_REGISTRIES (cs), printcharfun, 0);
-  write_fmt_string (printcharfun, " 0x%x>", cs->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
 }
 
 static const struct memory_description charset_description[] = {
@@ -178,10 +178,9 @@
   { XD_END }
 };
 
-DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
-			       1, /* dumpable flag */
-                               mark_charset, print_charset, 0,
-			       0, 0, charset_description, Lisp_Charset);
+DEFINE_DUMPABLE_LISP_OBJECT ("charset", charset,
+			     mark_charset, print_charset, 0,
+			     0, 0, charset_description, Lisp_Charset);
 /* Make a new charset. */
 /* #### SJT Should generic properties be allowed? */
 static Lisp_Object
@@ -196,8 +195,8 @@
 
   if (!overwrite)
     {
-      cs = ALLOC_LCRECORD_TYPE (Lisp_Charset, &lrecord_charset);
-      obj = wrap_charset (cs);
+      obj = ALLOC_NORMAL_LISP_OBJECT (charset);
+      cs = XCHARSET (obj);
 
       if (final)
 	{
@@ -991,58 +990,25 @@
 
 struct charset_stats
 {
-  int from_unicode;
-  int to_unicode;
-  int other;
+  struct usage_stats u;
+  Bytecount from_unicode;
+  Bytecount to_unicode;
 };
 
 static void
 compute_charset_usage (Lisp_Object charset, struct charset_stats *stats,
-		      struct overhead_stats *ovstats)
+		      struct usage_stats *ustats)
 {
-  struct Lisp_Charset *c = XCHARSET (charset);
-  xzero (*stats);
-  stats->other   += LISPOBJ_STORAGE_SIZE (c, sizeof (*c), ovstats);
-  stats->from_unicode += compute_from_unicode_table_size (charset, ovstats);
-  stats->to_unicode += compute_to_unicode_table_size (charset, ovstats);
+  stats->from_unicode += compute_from_unicode_table_size (charset, ustats);
+  stats->to_unicode += compute_to_unicode_table_size (charset, ustats);
 }
 
-DEFUN ("charset-memory-usage", Fcharset_memory_usage, 1, 1, 0, /*
-Return stats about the memory usage of charset CHARSET.
-The values returned are in the form of an alist of usage types and
-byte counts.  The byte counts attempt to encompass all the memory used
-by the charset (separate from the memory logically associated with a
-charset or frame), including internal structures and any malloc()
-overhead associated with them.  In practice, the byte counts are
-underestimated for various reasons, e.g. because certain memory usage
-is very hard to determine \(e.g. the amount of memory used inside the
-Xt library or inside the X server).
+static void
+charset_memory_usage (Lisp_Object charset, struct generic_usage_stats *gustats)
+{
+  struct charset_stats *stats = (struct charset_stats *) gustats;
 
-Multiple slices of the total memory usage may be returned, separated
-by a nil.  Each slice represents a particular view of the memory, a
-particular way of partitioning it into groups.  Within a slice, there
-is no overlap between the groups of memory, and each slice collectively
-represents all the memory concerned.
-*/
-       (charset))
-{
-  struct charset_stats stats;
-  struct overhead_stats ovstats;
-  Lisp_Object val = Qnil;
-
-  charset = Fget_charset (charset);
-  xzero (ovstats);
-  compute_charset_usage (charset, &stats, &ovstats);
-
-  val = acons (Qfrom_unicode,       make_int (stats.from_unicode),      val);
-  val = acons (Qto_unicode,         make_int (stats.to_unicode),        val);
-  val = Fcons (Qnil, val);
-  val = acons (Qactually_requested, make_int (ovstats.was_requested),   val);
-  val = acons (Qmalloc_overhead,    make_int (ovstats.malloc_overhead), val);
-  val = acons (Qgap_overhead,       make_int (ovstats.gap_overhead),    val);
-  val = acons (Qdynarr_overhead,    make_int (ovstats.dynarr_overhead), val);
-
-  return Fnreverse (val);
+  compute_charset_usage (charset, stats, &stats->u);
 }
 
 #endif /* MEMORY_USAGE_STATS */
@@ -1053,9 +1019,17 @@
 /************************************************************************/
 
 void
+mule_charset_objects_create (void)
+{
+#ifdef MEMORY_USAGE_STATS
+  OBJECT_HAS_METHOD (charset, memory_usage);
+#endif
+}
+
+void
 syms_of_mule_charset (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (charset);
+  INIT_LISP_OBJECT (charset);
 
   DEFSUBR (Fcharsetp);
   DEFSUBR (Ffind_charset);
@@ -1076,10 +1050,6 @@
   DEFSUBR (Fset_charset_registries);
   DEFSUBR (Fcharsets_in_region);
 
-#ifdef MEMORY_USAGE_STATS
-  DEFSUBR (Fcharset_memory_usage);
-#endif
-
   DEFSYMBOL (Qcharsetp);
   DEFSYMBOL (Qregistries);
   DEFSYMBOL (Qfinal);
@@ -1128,6 +1098,11 @@
 {
   int i, j, k;
 
+#ifdef MEMORY_USAGE_STATS
+  OBJECT_HAS_PROPERTY
+    (charset, memusage_stats_list, list2 (Qfrom_unicode, Qto_unicode));
+#endif /* MEMORY_USAGE_STATS */
+
   chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
   dump_add_root_block_ptr (&chlook, &charset_lookup_description);