xemacs-beta: src/alloc.c comparison

comparison src/alloc.c @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet

author	Ben Wing <ben@xemacs.org>
date	Sat, 26 Dec 2009 21:18:49 -0600
parents	3742ea8250b5 73e8632018ad
children	d1247f3cc363

comparison

equal deleted inserted replaced

-:3742ea8250b5
+:e0db3c197671
 #include "elhash.h"
 #include "events.h"
 #include "extents-impl.h"
 #include "file-coding.h"
 #include "frame-impl.h"
+#include "gc.h"
 #include "glyphs.h"
 #include "opaque.h"
 #include "lstream.h"
 #include "process.h"
 #include "profile.h"
 #include "redisplay.h"
 #include "specifier.h"
 #include "sysfile.h"
 #include "sysdep.h"
 #include "window.h"
+#ifdef NEW_GC
+#include "vdb.h"
+#endif /* NEW_GC */
 #include "console-stream.h"
 #ifdef DOUG_LEA_MALLOC
 #include <malloc.h>
 #endif
 EXFUN (Fgarbage_collect, 0);
-static void recompute_need_to_garbage_collect (void);
 #if 0 /* this is _way_ too slow to be part of the standard debug options */
 #if defined(DEBUG_XEMACS) && defined(MULE)
 #define VERIFY_STRING_CHARS_INTEGRITY
 #endif
 #ifdef DEBUG_XEMACS
 static Fixnum debug_allocation;
 static Fixnum debug_allocation_backtrace_length;
 #endif
-/* Number of bytes of consing done since the last gc */
-static EMACS_INT consing_since_gc;
-EMACS_UINT total_consing;
-EMACS_INT total_gc_usage;
-int total_gc_usage_set;
-int need_to_garbage_collect;
 int need_to_check_c_alloca;
 int need_to_signal_post_gc;
 int funcall_allocation_flag;
 Bytecount __temp_alloca_size__;
 Bytecount funcall_alloca_count;
 #define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
 #define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
 INCREMENT_CONS_COUNTER_1 (size)
 #endif
+#ifdef NEW_GC
+/* The call to recompute_need_to_garbage_collect is moved to
+free_lrecord, since DECREMENT_CONS_COUNTER is extensively called
+during sweep and recomputing need_to_garbage_collect all the time
+is not needed. */
+#define DECREMENT_CONS_COUNTER(size) do {	\
+consing_since_gc -= (size);			\
+total_consing -= (size);			\
+if (profiling_active)				\
+profile_record_unconsing (size);		\
+if (consing_since_gc < 0)			\
+consing_since_gc = 0;			\
+} while (0)
+#else /* not NEW_GC */
 #define DECREMENT_CONS_COUNTER(size) do {	\
 consing_since_gc -= (size);			\
 total_consing -= (size);			\
 if (profiling_active)				\
 profile_record_unconsing (size);		\
 if (consing_since_gc < 0)			\
 consing_since_gc = 0;			\
 recompute_need_to_garbage_collect ();		\
 } while (0)
+#endif /*not NEW_GC */
-/* Number of bytes of consing since gc before another gc should be done. */
-static EMACS_INT gc_cons_threshold;
-/* Percentage of consing of total data size before another GC. */
-static EMACS_INT gc_cons_percentage;
-#ifdef ERROR_CHECK_GC
-int always_gc;			/* Debugging hack; equivalent to
-				   (setq gc-cons-thresold -1) */
-#else
-#define always_gc 0
-#endif
-/* Nonzero during gc */
-int gc_in_progress;
-/* Nonzero means display messages at beginning and end of GC.  */
-int garbage_collection_messages;
-/* Number of times GC has happened at this level or below.
-* Level 0 is most volatile, contrary to usual convention.
-*  (Of course, there's only one level at present) */
-EMACS_INT gc_generation_number[1];
 /* This is just for use by the printer, to allow things to print uniquely */
 int lrecord_uid_counter;
-/* Nonzero when calling certain hooks or doing other things where
-a GC would be bad */
-int gc_currently_forbidden;
-/* Hooks. */
-Lisp_Object Vpre_gc_hook, Qpre_gc_hook;
-Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
-/* "Garbage collecting" */
-Lisp_Object Vgc_message;
-Lisp_Object Vgc_pointer_glyph;
-static const Ascbyte gc_default_message[] = "Garbage collecting";
-Lisp_Object Qgarbage_collecting;
-static Lisp_Object QSin_garbage_collection;
 /* Non-zero means we're in the process of doing the dump */
 int purify_flag;
 /* Non-zero means we're pdumping out or in */
 /* Very cheesy ways of figuring out how much memory is being used for
 data. #### Need better (system-dependent) ways. */
 void *minimum_address_seen;
 void *maximum_address_seen;
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 int
 c_readonly (Lisp_Object obj)
 {
 return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
 }
-#endif /* MC_ALLOC */
+#endif /* not NEW_GC */
 int
 lisp_readonly (Lisp_Object obj)
 {
 return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
 /* Non-zero means ignore malloc warnings.  Set during initialization.  */
 int ignore_malloc_warnings;
-#ifndef MC_ALLOC
+#ifndef NEW_GC
-static void *breathing_space;
+void *breathing_space;
 void
 release_breathing_space (void)
 {
 if (breathing_space)
 void *tmp = breathing_space;
 breathing_space = 0;
 xfree (tmp, void *);
 }
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-/* malloc calls this if it finds we are near exhausting storage */
-void
-malloc_warning (const char *str)
-{
-if (ignore_malloc_warnings)
-return;
-warn_when_safe
-(Qmemory, Qemergency,
-"%s\n"
-"Killing some buffers may delay running out of memory.\n"
-"However, certainly by the time you receive the 95%% warning,\n"
-"you should clean up, kill this Emacs, and start a new one.",
-str);
-}
-/* Called if malloc returns zero */
-DOESNT_RETURN
-memory_full (void)
-{
-/* Force a GC next time eval is called.
-It's better to loop garbage-collecting (we might reclaim enough
-to win) than to loop beeping and barfing "Memory exhausted"
-*/
-consing_since_gc = gc_cons_threshold + 1;
-recompute_need_to_garbage_collect ();
-#ifndef MC_ALLOC
-release_breathing_space ();
-#endif /* not MC_ALLOC */
-/* Flush some histories which might conceivably contain garbalogical
-inhibitors.  */
-if (!NILP (Fboundp (Qvalues)))
-Fset (Qvalues, Qnil);
-Vcommand_history = Qnil;
-out_of_memory ("Memory exhausted", Qunbound);
-}
 static void
 set_alloc_mins_and_maxes (void *val, Bytecount size)
 {
 if (!val)
 assert (!regex_malloc_disallowed);		\
 in_malloc = 1;				\
 }						\
 while (0)
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 #define FREE_OR_REALLOC_BEGIN(block)					\
 do									\
 {									\
 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an	\
 error until much later on for many system mallocs, such as		\
 the one that comes with Solaris 2.3.  FMH!! */			\
 assert (block != (void *) 0xDEADBEEF);				\
 MALLOC_BEGIN ();							\
 }									\
 while (0)
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 #define FREE_OR_REALLOC_BEGIN(block)					\
 do									\
 {									\
 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an	\
 error until much later on for many system mallocs, such as		\
 DUMPEDP. */							\
 assert (!DUMPEDP (block));						\
 MALLOC_BEGIN ();							\
 }									\
 while (0)
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 #define MALLOC_END()				\
 do						\
 {						\
 in_malloc = 0;				\
 if (!val && size != 0)
 memory_full ();
 set_alloc_mins_and_maxes (val, size);
 }
+/* malloc calls this if it finds we are near exhausting storage */
+void
+malloc_warning (const char *str)
+{
+if (ignore_malloc_warnings)
+return;
+/* Remove the malloc lock here, because warn_when_safe may allocate
+again.  It is safe to remove the malloc lock here, because malloc
+is already finished (malloc_warning is called via
+after_morecore_hook -> check_memory_limits -> save_warn_fun ->
+malloc_warning). */
+MALLOC_END ();
+warn_when_safe
+(Qmemory, Qemergency,
+"%s\n"
+"Killing some buffers may delay running out of memory.\n"
+"However, certainly by the time you receive the 95%% warning,\n"
+"you should clean up, kill this Emacs, and start a new one.",
+str);
+}
+/* Called if malloc returns zero */
+DOESNT_RETURN
+memory_full (void)
+{
+/* Force a GC next time eval is called.
+It's better to loop garbage-collecting (we might reclaim enough
+to win) than to loop beeping and barfing "Memory exhausted"
+*/
+consing_since_gc = gc_cons_threshold + 1;
+recompute_need_to_garbage_collect ();
+#ifdef NEW_GC
+/* Put mc-alloc into memory shortage mode.  This may keep XEmacs
+alive until the garbage collector can free enough memory to get
+us out of the memory exhaustion.  If already in memory shortage
+mode, we are in a loop and hopelessly lost. */
+if (memory_shortage)
+{
+fprintf (stderr, "Memory full, cannot recover.\n");
+ABORT ();
+}
+fprintf (stderr,
+	   "Memory full, try to recover.\n"
+	   "You should clean up, kill this Emacs, and start a new one.\n");
+memory_shortage++;
+#else /* not NEW_GC */
+release_breathing_space ();
+#endif /* not NEW_GC */
+/* Flush some histories which might conceivably contain garbalogical
+inhibitors.  */
+if (!NILP (Fboundp (Qvalues)))
+Fset (Qvalues, Qnil);
+Vcommand_history = Qnil;
+out_of_memory ("Memory exhausted", Qunbound);
+}
 /* like malloc, calloc, realloc, free but:
 -- check for no memory left
 -- set internal mins and maxes
 -- with error-checking on, check for reentrancy, invalid freeing, etc.
 MALLOC_END ();
 }
 #ifdef ERROR_CHECK_GC
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 deadbeef_memory (void *ptr, Bytecount size)
 {
 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr;
 Bytecount beefs = size >> 2;
 /* In practice, size will always be a multiple of four.  */
 while (beefs--)
 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 #else /* !ERROR_CHECK_GC */
 #define deadbeef_memory(ptr, size)
 return xstrdup (s);
 }
 #endif /* NEED_STRDUP */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void *
 allocate_lisp_storage (Bytecount size)
 {
 void *val = xmalloc (size);
 /* We don't increment the cons counter anymore.  Calling functions do
 if (need_to_check_c_alloca)
 xemacs_c_alloca (0);
 return val;
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-#if defined (MC_ALLOC) && defined (ALLOC_TYPE_STATS)
+#if defined (NEW_GC) && defined (ALLOC_TYPE_STATS)
 static struct
 {
 int instances_in_use;
 int bytes_in_use;
 int bytes_in_use_including_overhead;
-} lrecord_stats [countof (lrecord_implementations_table)
+} lrecord_stats [countof (lrecord_implementations_table)];
-		 + MODULE_DEFINABLE_TYPE_COUNT];
-int lrecord_string_data_instances_in_use;
-int lrecord_string_data_bytes_in_use;
-int lrecord_string_data_bytes_in_use_including_overhead;
 void
 init_lrecord_stats ()
 {
 xzero (lrecord_stats);
-lrecord_string_data_instances_in_use = 0;
-lrecord_string_data_bytes_in_use = 0;
-lrecord_string_data_bytes_in_use_including_overhead = 0;
-}
-void
-inc_lrecord_string_data_stats (Bytecount size)
-{
-lrecord_string_data_instances_in_use++;
-lrecord_string_data_bytes_in_use += size;
-lrecord_string_data_bytes_in_use_including_overhead += size;
-}
-void
-dec_lrecord_string_data_stats (Bytecount size)
-{
-lrecord_string_data_instances_in_use--;
-lrecord_string_data_bytes_in_use -= size;
-lrecord_string_data_bytes_in_use_including_overhead -= size;
 }
 void
 inc_lrecord_stats (Bytecount size, const struct lrecord_header *h)
 {
 lrecord_stats[type_index].bytes_in_use_including_overhead
 -= size_including_overhead;
 DECREMENT_CONS_COUNTER (size);
 }
-#endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */
+int
+lrecord_stats_heap_size (void)
+{
+int i;
+int size = 0;
+for (i = 0; i < countof (lrecord_implementations_table); i++)
+size += lrecord_stats[i].bytes_in_use;
+return size;
+}
+#endif /* NEW_GC && ALLOC_TYPE_STATS */
 #define assert_proper_sizing(size)			\
 type_checking_assert					\
 (implementation->static_size == 0 ?			\
 implementation->size_in_bytes_method != NULL :	\
 implementation->size_in_bytes_method == NULL &&	\
 implementation->static_size == size)
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 /* lcrecords are chained together through their "next" field.
 After doing the mark phase, GC will walk this linked list
 and free any lcrecord which hasn't been marked. */
 static struct old_lcrecord_header *all_lcrecords;
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 /* The basic lrecord allocation functions. See lrecord.h for details. */
 static Lisp_Object
 alloc_sized_lrecord_1 (Bytecount size,
 		       const struct lrecord_implementation *implementation,
 		       int noseeum)
 assert_proper_sizing (size);
 lheader = (struct lrecord_header *) mc_alloc (size);
 gc_checking_assert (LRECORD_FREE_P (lheader));
 set_lheader_implementation (lheader, implementation);
+lheader->uid = lrecord_uid_counter++;
 #ifdef ALLOC_TYPE_STATS
 inc_lrecord_stats (size, lheader);
 #endif /* ALLOC_TYPE_STATS */
+if (implementation->finalizer)
+add_finalizable_obj (wrap_pointer_1 (lheader));
 if (noseeum)
 NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
 else
 INCREMENT_CONS_COUNTER (size, implementation->name);
 return wrap_pointer_1 (lheader);
 {
 type_checking_assert (implementation->static_size > 0);
 return alloc_sized_lrecord (implementation->static_size, implementation);
 }
+Lisp_Object
+noseeum_alloc_lrecord (const struct lrecord_implementation *implementation)
+{
+type_checking_assert (implementation->static_size > 0);
+return noseeum_alloc_sized_lrecord (implementation->static_size, implementation);
+}
+Lisp_Object
+alloc_sized_lrecord_array (Bytecount size, int elemcount,
+			   const struct lrecord_implementation *implementation)
+{
+struct lrecord_header *lheader;
+Rawbyte *start, *stop;
+assert_proper_sizing (size);
+lheader = (struct lrecord_header *) mc_alloc_array (size, elemcount);
+gc_checking_assert (LRECORD_FREE_P (lheader));
+for (start = (Rawbyte *) lheader,
+	 /* #### FIXME: why is this -1 present? */
+	 stop = ((Rawbyte *) lheader) + (size * elemcount -1);
+start < stop; start += size)
+{
+struct lrecord_header *lh = (struct lrecord_header *) start;
+set_lheader_implementation (lh, implementation);
+lh->uid = lrecord_uid_counter++;
+#ifdef ALLOC_TYPE_STATS
+inc_lrecord_stats (size, lh);
+#endif /* not ALLOC_TYPE_STATS */
+if (implementation->finalizer)
+	add_finalizable_obj (wrap_pointer_1 (lh));
+}
+INCREMENT_CONS_COUNTER (size * elemcount, implementation->name);
+return wrap_pointer_1 (lheader);
+}
+Lisp_Object
+alloc_lrecord_array (int elemcount,
+		     const struct lrecord_implementation *implementation)
+{
+type_checking_assert (implementation->static_size > 0);
+return alloc_sized_lrecord_array (implementation->static_size, elemcount,
+				    implementation);
+}
 void
-free_lrecord (Lisp_Object lrecord)
+free_lrecord (Lisp_Object UNUSED (lrecord))
 {
-gc_checking_assert (!gc_in_progress);
+/* Manual frees are not allowed with asynchronous finalization */
-gc_checking_assert (!LRECORD_FREE_P (XRECORD_LHEADER (lrecord)));
+return;
-gc_checking_assert (!XRECORD_LHEADER (lrecord)->free);
+}
+#else /* not NEW_GC */
-MC_ALLOC_CALL_FINALIZER (XPNTR (lrecord));
-mc_free (XPNTR (lrecord));
-}
-#else /* not MC_ALLOC */
 /* The most basic of the lcrecord allocation functions.  Not usually called
 directly.  Allocates an lrecord not managed by any lcrecord-list, of a
 specified size.  See lrecord.h. */
 lrecord->implementation->finalizer (lrecord, 0);
 xfree (lrecord);
 return;
 }
 #endif /* Unused */
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 static void
 disksave_object_finalization_1 (void)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 mc_finalize_for_disksave ();
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 struct old_lcrecord_header *header;
 for (header = all_lcrecords; header; header = header->next)
 {
 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer &&
 	  !header->free)
 	LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 /* Bitwise copy all parts of a Lisp object other than the header */
 void
 Bytecount size = lisp_object_size (src);
 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst));
 assert (size == lisp_object_size (dst));
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
 	  (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
 	  size - sizeof (struct lrecord_header));
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 if (imp->basic_p)
 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
 	    (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
 	    size - sizeof (struct lrecord_header));
 else
 memcpy ((char *) XRECORD_LHEADER (dst) +
 	    sizeof (struct old_lcrecord_header),
 	    (char *) XRECORD_LHEADER (src) +
 	    sizeof (struct old_lcrecord_header),
 	    size - sizeof (struct old_lcrecord_header));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 /************************************************************************/
 /*			  Debugger support				*/
 {
 return EQ (obj1, obj2);
 }
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 #define DECLARE_FIXED_TYPE_ALLOC(type, structture) struct __foo__
 #else
 /************************************************************************/
 /*			  Fixed-size type macros			*/
 /************************************************************************/
 unless there's a large number (usually 1000, but
 varies depending on type) of them already on the list.
 This way, we ensure that an object that gets freed will
 remain free for the next 1000 (or whatever) times that
 an object of that type is allocated.  */
-#ifndef MALLOC_OVERHEAD
-#ifdef GNU_MALLOC
-#define MALLOC_OVERHEAD 0
-#elif defined (rcheck)
-#define MALLOC_OVERHEAD 20
-#else
-#define MALLOC_OVERHEAD 8
-#endif
-#endif /* MALLOC_OVERHEAD */
 #if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
 /* If we released our reserve (due to running out of memory),
 and we have a fair amount free once again,
 try to set aside another reserve in case we run out once more.
 gc_count_num_##type##_freelist++;				\
 } while (0)
 #else
 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr)
 #endif
-#endif /* not MC_ALLOC */
+#endif /* NEW_GC */
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \
 do {									\
 (var) = alloc_lrecord_type (lisp_type, lrec_ptr);			\
 } while (0)
 #define NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var,	\
 lrec_ptr)		\
 do {									\
 (var) = noseeum_alloc_lrecord_type (lisp_type, lrec_ptr);		\
 } while (0)
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \
 do									\
 {									\
 ALLOCATE_FIXED_TYPE (type, lisp_type, var);				\
 set_lheader_implementation (&(var)->lheader, lrec_ptr);		\
 do									\
 {									\
 NOSEEUM_ALLOCATE_FIXED_TYPE (type, lisp_type, var);			\
 set_lheader_implementation (&(var)->lheader, lrec_ptr);		\
 } while (0)
-#endif /* MC_ALLOC */
+#endif /* not NEW_GC */
 /************************************************************************/
 /*			   Cons allocation				*/
 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) },
 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) },
 { XD_END }
 };
-DEFINE_FROB_BLOCK_LISP_OBJECT ("cons", cons, Lisp_Cons, cons_description,
+DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("cons", cons,
-			       1, /*dumpable-flag*/
+					mark_cons, print_cons, 0, cons_equal,
-			       mark_cons, print_cons, cons_equal,
+					/*
-			       /*
+					 * No `hash' method needed.
-				* No `hash' method needed.
+					 * internal_hash knows how to
-				* internal_hash knows how to
+					 * handle conses.
-				* handle conses.
+					 */
-				*/
+					0, cons_description, Lisp_Cons);
-			       0, 0);
 DEFUN ("cons", Fcons, 2, 2, 0, /*
-Create a new cons, give it CAR and CDR as components, and return it.
+Create a new cons cell, give it CAR and CDR as components, and return it.
+A cons cell is a Lisp object (an area in memory) made up of two pointers
+called the CAR and the CDR.  Each of these pointers can point to any other
+Lisp object.  The common Lisp data type, the list, is a specially-structured
+series of cons cells.
+The pointers are accessed from Lisp with `car' and `cdr', and mutated with
+`setcar' and `setcdr' respectively.  For historical reasons, the aliases
+`rplaca' and `rplacd' (for `setcar' and `setcdr') are supported.
 */
 (car, cdr))
 {
 /* This cannot GC. */
 Lisp_Object val;
 XCDR (val) = cdr;
 return val;
 }
 DEFUN ("list", Flist, 0, MANY, 0, /*
-Return a newly created list with specified arguments as elements.
+Return a newly created list with specified ARGS as elements.
 Any number of arguments, even zero arguments, are allowed.
+arguments: (&rest ARGS)
 */
 (int nargs, Lisp_Object *args))
 {
 Lisp_Object val = Qnil;
 Lisp_Object *argp = args + nargs;
 { XD_LONG,              offsetof (Lisp_Vector, size) },
 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) },
 { XD_END }
 };
-DEFINE_SIZABLE_LISP_OBJECT ("vector", vector,
+DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("vector", vector,
-					1, /*dumpable-flag*/
+				     mark_vector, print_vector, 0,
-					mark_vector, print_vector, 0,
+				     vector_equal,
-					vector_equal,
+				     vector_hash,
-					vector_hash,
+				     vector_description,
-					vector_description,
+				     size_vector, Lisp_Vector);
-					size_vector, Lisp_Vector);
 /* #### should allocate `small' vectors from a frob-block */
 static Lisp_Vector *
 make_vector_internal (Elemcount sizei)
 {
 /* no `next' field; we use lcrecords */
 CONCHECK_NATNUM (length);
 return make_vector (XINT (length), object);
 }
 DEFUN ("vector", Fvector, 0, MANY, 0, /*
-Return a newly created vector with specified arguments as elements.
+Return a newly created vector with specified ARGS as elements.
 Any number of arguments, even zero arguments, are allowed.
+arguments: (&rest ARGS)
 */
 (int nargs, Lisp_Object *args))
 {
 Lisp_Vector *vecp = make_vector_internal (nargs);
 Lisp_Object *p = vector_data (vecp);
 return make_bit_vector (XINT (length), bit);
 }
 DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /*
-Return a newly created bit vector with specified arguments as elements.
+Return a newly created bit vector with specified ARGS as elements.
 Any number of arguments, even zero arguments, are allowed.
 Each argument must be one of the integers 0 or 1.
+arguments: (&rest ARGS)
 */
 (int nargs, Lisp_Object *args))
 {
 int i;
 Lisp_Bit_Vector *p = make_bit_vector_internal (nargs);
 f->flags.interactivep = 0;
 f->flags.domainp = 0; /* I18N3 */
 f->instructions = Qzero;
 f->constants = Qzero;
 f->arglist = Qnil;
+#ifdef NEW_GC
+f->arguments = Qnil;
+#else /* not NEW_GC */
 f->args = NULL;
+#endif /* not NEW_GC */
 f->max_args = f->min_args = f->args_in_array = 0;
 f->doc_and_interactive = Qnil;
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
 f->annotated = Qnil;
 #endif
 return wrap_compiled_function (f);
 }
 DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /*
 Return a new compiled-function object.
-Usage: (arglist instructions constants stack-depth
-	&optional doc-string interactive)
 Note that, unlike all other emacs-lisp functions, calling this with five
 arguments is NOT the same as calling it with six arguments, the last of
 which is nil.  If the INTERACTIVE arg is specified as nil, then that means
 that this function was defined with `(interactive)'.  If the arg is not
 specified, then that means the function is not interactive.
 This is terrible behavior which is retained for compatibility with old
 `.elc' files which expect these semantics.
+arguments: (ARGLIST INSTRUCTIONS CONSTANTS STACK-DEPTH &optional DOC-STRING INTERACTIVE)
 */
 (int nargs, Lisp_Object *args))
 {
 /* In a non-insane world this function would have this arglist...
 (arglist instructions constants stack_depth &optional doc_string interactive)
 return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) &&
 	  !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len));
 }
 static const struct memory_description string_description[] = {
+#ifdef NEW_GC
+{ XD_LISP_OBJECT,     offsetof (Lisp_String, data_object) },
+#else /* not NEW_GC */
 { XD_BYTECOUNT,       offsetof (Lisp_String, size_) },
 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) },
+#endif /* not NEW_GC */
 { XD_LISP_OBJECT,     offsetof (Lisp_String, plist) },
 { XD_END }
 };
 /* We store the string's extent info as the first element of the string's
 string_plist (Lisp_Object string)
 {
 return *string_plist_ptr (string);
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 /* No `finalize', or `hash' methods.
 internal_hash() already knows how to hash strings and finalization
 is done with the ADDITIONAL_FREE_string macro, which is the
 standard way to do finalization when using
 SWEEP_FIXED_TYPE_BLOCK(). */
-DEFINE_BASIC_LISP_OBJECT_WITH_PROPS ("string", string,
+DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS ("string", string,
-						mark_string, print_string,
+						   mark_string, print_string,
-						0, string_equal, 0,
+						   0, string_equal, 0,
-						string_description,
+						   string_description,
-						string_getprop,
+						   string_getprop,
-						string_putprop,
+						   string_putprop,
-						string_remprop,
+						   string_remprop,
-						string_plist,
+						   string_plist,
-						Lisp_String);
+						   Lisp_String);
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
+#ifdef NEW_GC
+#define STRING_FULLSIZE(size) \
+ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *));
+#else /* not NEW_GC */
 /* String blocks contain this many useful bytes. */
 #define STRING_CHARS_BLOCK_SIZE					\
 ((Bytecount) (8192 - MALLOC_OVERHEAD -			\
 	        ((2 * sizeof (struct string_chars_block *))	\
 	         + sizeof (EMACS_INT))))
 #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE)
 #define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size)))
 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL))
+#endif /* not NEW_GC */
-#ifdef MC_ALLOC
-static void
+#ifdef NEW_GC
-finalize_string (void *header, int for_disksave)
+DEFINE_DUMPABLE_LISP_OBJECT_WITH_PROPS ("string", string,
-{
+					mark_string, print_string,
-if (!for_disksave)
+					0,
-{
+					string_equal, 0,
-Lisp_String *s = (Lisp_String *) header;
+					string_description,
-Bytecount size = s->size_;
+					string_getprop,
-#ifdef ALLOC_TYPE_STATS
+					string_putprop,
-dec_lrecord_string_data_stats (size);
+					string_remprop,
-#endif /* ALLOC_TYPE_STATS */
+					string_plist,
-if (BIG_STRING_SIZE_P (size))
+					Lisp_String);
-	xfree (s->data_, Ibyte *);
-}
-}
+static const struct memory_description string_direct_data_description[] = {
+{ XD_BYTECOUNT,       offsetof (Lisp_String_Direct_Data, size) },
-DEFINE_LISP_OBJECT_WITH_PROPS ("string", string,
+{ XD_END }
-					  mark_string, print_string,
+};
-					  finalize_string,
-					  string_equal, 0,
+static Bytecount
-					  string_description,
+size_string_direct_data (const void *lheader)
-					  string_getprop,
+{
-					  string_putprop,
+return STRING_FULLSIZE (((Lisp_String_Direct_Data *) lheader)->size);
-					  string_remprop,
+}
-					  string_plist,
-					  Lisp_String);
+DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("string-direct-data",
-#endif /* MC_ALLOC */
+					      string_direct_data,
+					      0,
+					      string_direct_data_description,
+					      size_string_direct_data,
+					      Lisp_String_Direct_Data);
+static const struct memory_description string_indirect_data_description[] = {
+{ XD_BYTECOUNT,       offsetof (Lisp_String_Indirect_Data, size) },
+{ XD_OPAQUE_DATA_PTR, offsetof (Lisp_String_Indirect_Data, data),
+XD_INDIRECT(0, 1) },
+{ XD_END }
+};
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("string-indirect-data",
+				      string_indirect_data,
+				      0,
+				      string_indirect_data_description,
+				      Lisp_String_Indirect_Data);
+#endif /* NEW_GC */
+#ifndef NEW_GC
 struct string_chars
 {
 Lisp_String *string;
 unsigned char chars[1];
 };
 INCREMENT_CONS_COUNTER (fullsize, "string chars");
 return s_chars;
 }
+#endif /* not NEW_GC */
 #ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN
 void
 sledgehammer_check_ascii_begin (Lisp_Object str)
 {
 Lisp_String *s;
 Bytecount fullsize = STRING_FULLSIZE (length);
 assert (length >= 0 && fullsize > 0);
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 s = alloc_lrecord_type (Lisp_String, &lrecord_string);
-#ifdef ALLOC_TYPE_STATS
+#else /* not NEW_GC */
-inc_lrecord_string_data_stats (length);
-#endif /* ALLOC_TYPE_STATS */
-#else /* not MC_ALLOC */
 /* Allocate the string header */
 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
 xzero (*s);
 set_lheader_implementation (&s->u.lheader, &lrecord_string);
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 /* The above allocations set the UID field, which overlaps with the
 ascii-length field, to some non-zero value.  We need to zero it. */
 XSET_STRING_ASCII_BEGIN (wrap_string (s), 0);
+#ifdef NEW_GC
+set_lispstringp_direct (s);
+STRING_DATA_OBJECT (s) =
+alloc_sized_lrecord (fullsize, &lrecord_string_direct_data);
+#else /* not NEW_GC */
 set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize)
 			? allocate_big_string_chars (length + 1)
 			: allocate_string_chars_struct (wrap_string (s),
 							fullsize)->chars);
+#endif /* not NEW_GC */
 set_lispstringp_length (s, length);
 s->plist = Qnil;
 set_string_byte (wrap_string (s), length, 0);
 */
 void
 resize_string (Lisp_Object s, Bytecount pos, Bytecount delta)
 {
+#ifdef NEW_GC
+Bytecount newfullsize, len;
+#else /* not NEW_GC */
 Bytecount oldfullsize, newfullsize;
+#endif /* not NEW_GC */
 #ifdef VERIFY_STRING_CHARS_INTEGRITY
 verify_string_chars_integrity ();
 #endif
 #ifdef ERROR_CHECK_TEXT
 if (pos >= 0)
 /* If DELTA < 0, the functions below will delete the characters
 before POS.  We want to delete characters *after* POS, however,
 so convert this to the appropriate form. */
 pos += -delta;
+#ifdef NEW_GC
+newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
+len = XSTRING_LENGTH (s) + 1 - pos;
+if (delta < 0 && pos >= 0)
+memmove (XSTRING_DATA (s) + pos + delta,
+	     XSTRING_DATA (s) + pos, len);
+XSTRING_DATA_OBJECT (s) =
+wrap_string_direct_data (mc_realloc (XPNTR (XSTRING_DATA_OBJECT (s)),
+					 newfullsize));
+if (delta > 0 && pos >= 0)
+memmove (XSTRING_DATA (s) + pos + delta, XSTRING_DATA (s) + pos,
+	     len);
+#else /* not NEW_GC */
 oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
 newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
 if (BIG_STRING_FULLSIZE_P (oldfullsize))
 {
 	      memcpy (new_data + pos + delta, old_data + pos,
 		      XSTRING_LENGTH (s) + 1 - pos);
 	    }
 	  XSET_STRING_DATA (s, new_data);
-	  {
+	  if (!DUMPEDP (old_data)) /* Can't free dumped data. */
-	    /* We need to mark this chunk of the string_chars_block
+	    {
-	       as unused so that compact_string_chars() doesn't
+	      /* We need to mark this chunk of the string_chars_block
-	       freak. */
+		 as unused so that compact_string_chars() doesn't
-	    struct string_chars *old_s_chars = (struct string_chars *)
+		 freak. */
-	      ((char *) old_data - offsetof (struct string_chars, chars));
+	      struct string_chars *old_s_chars = (struct string_chars *)
-	    /* Sanity check to make sure we aren't hosed by strange
+		((char *) old_data - offsetof (struct string_chars, chars));
-	       alignment/padding. */
+	      /* Sanity check to make sure we aren't hosed by strange
-	    assert (old_s_chars->string == XSTRING (s));
+		 alignment/padding. */
-	    MARK_STRING_CHARS_AS_FREE (old_s_chars);
+	      assert (old_s_chars->string == XSTRING (s));
-	    ((struct unused_string_chars *) old_s_chars)->fullsize =
+	      MARK_STRING_CHARS_AS_FREE (old_s_chars);
-	      oldfullsize;
+	      ((struct unused_string_chars *) old_s_chars)->fullsize =
-	  }
+oldfullsize;
+	    }
 	}
 }
+#endif /* not NEW_GC */
 XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta);
 /* If pos < 0, the string won't be zero-terminated.
 Terminate now just to make sure. */
 XSTRING_DATA (s)[XSTRING_LENGTH (s)] = '\0';
 }
 }
 DEFUN ("string", Fstring, 0, MANY, 0, /*
 Concatenate all the argument characters and make the result a string.
+arguments: (&rest ARGS)
 */
 (int nargs, Lisp_Object *args))
 {
 Ibyte *storage = alloca_ibytes (nargs * MAX_ICHAR_LEN);
 Ibyte *p = storage;
 /* Make sure we find out about bad make_string_nocopy's when they happen */
 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
 bytecount_to_charcount (contents, length); /* Just for the assertions */
 #endif
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 s = alloc_lrecord_type (Lisp_String, &lrecord_string);
-#ifdef ALLOC_TYPE_STATS
-inc_lrecord_string_data_stats (length);
-#endif /* ALLOC_TYPE_STATS */
 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get
 				 collected and static data is tried to
 				 be freed. */
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 /* Allocate the string header */
 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
 set_lheader_implementation (&s->u.lheader, &lrecord_string);
 SET_C_READONLY_RECORD_HEADER (&s->u.lheader);
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 /* Don't need to XSET_STRING_ASCII_BEGIN() here because it happens in
 init_string_ascii_begin(). */
 s->plist = Qnil;
+#ifdef NEW_GC
+set_lispstringp_indirect (s);
+STRING_DATA_OBJECT (s) =
+wrap_string_indirect_data
+(alloc_lrecord_type (Lisp_String_Indirect_Data,
+			 &lrecord_string_indirect_data));
+XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents;
+XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length;
+#else /* not NEW_GC */
 set_lispstringp_data (s, (Ibyte *) contents);
 set_lispstringp_length (s, length);
+#endif /* not NEW_GC */
 val = wrap_string (s);
 init_string_ascii_begin (val);
 sledgehammer_check_ascii_begin (val);
 return val;
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 /************************************************************************/
 /*                           lcrecord lists                             */
 /************************************************************************/
 /* Lcrecord lists are used to manage the allocation of particular
 { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, { 0 },
 XD_FLAG_FREE_LISP_OBJECT },
 { XD_END }
 };
-DEFINE_NONDUMPABLE_LISP_OBJECT ("free", free, 0, 0,
+DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("free", free, 0, free_description,
-					   0, 0, 0, free_description,
+				    struct free_lcrecord_header);
-					   struct free_lcrecord_header);
 const struct memory_description lcrecord_list_description[] = {
 { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 },
 XD_FLAG_FREE_LISP_OBJECT },
 { XD_END }
 }
 return Qnil;
 }
-DEFINE_NONDUMPABLE_LISP_OBJECT ("lcrecord-list", lcrecord_list,
+DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("lcrecord-list", lcrecord_list,
-					   mark_lcrecord_list,
+				    mark_lcrecord_list,
-					   0,
+				    lcrecord_list_description,
-					   0, 0, 0, lcrecord_list_description,
+				    struct lcrecord_list);
-					   struct lcrecord_list);
 Lisp_Object
 make_lcrecord_list (Elemcount size,
 		    const struct lrecord_implementation *implementation)
 {
 assert (!EQ (all_lcrecord_lists[type], Qzero));
 free_managed_lcrecord (all_lcrecord_lists[type], rec);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /*
 Kept for compatibility, returns its argument.
 Old:
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 static const struct memory_description mcpro_description_1[] = {
 { XD_END }
 };
 static const struct sized_memory_description mcpro_description = {
 {
 Dynarr_add (mcpros, varaddress);
 }
 #endif /* not DEBUG_XEMACS */
-#endif /* MC_ALLOC */
+#endif /* NEW_GC */
-#ifdef ERROR_CHECK_GC
-#ifdef MC_ALLOC
+#ifndef NEW_GC
-#define GC_CHECK_LHEADER_INVARIANTS(lheader) do {		\
-struct lrecord_header * GCLI_lh = (lheader);			\
-assert (GCLI_lh != 0);					\
-assert (GCLI_lh->type < (unsigned int) lrecord_type_count);	\
-} while (0)
-#else /* not MC_ALLOC */
-#define GC_CHECK_LHEADER_INVARIANTS(lheader) do {		\
-struct lrecord_header * GCLI_lh = (lheader);			\
-assert (GCLI_lh != 0);					\
-assert (GCLI_lh->type < (unsigned int) lrecord_type_count);	\
-assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) ||		\
-	  (MARKED_RECORD_HEADER_P (GCLI_lh) &&			\
-	   LISP_READONLY_RECORD_HEADER_P (GCLI_lh)));		\
-} while (0)
-#endif /* not MC_ALLOC */
-#else
-#define GC_CHECK_LHEADER_INVARIANTS(lheader)
-#endif
-static const struct memory_description lisp_object_description_1[] = {
-{ XD_LISP_OBJECT, 0 },
-{ XD_END }
-};
-const struct sized_memory_description lisp_object_description = {
-sizeof (Lisp_Object),
-lisp_object_description_1
-};
-#if defined (USE_KKCC) || defined (PDUMP)
-/* This function extracts the value of a count variable described somewhere
-else in the description. It is converted corresponding to the type */
-EMACS_INT
-lispdesc_indirect_count_1 (EMACS_INT code,
-			   const struct memory_description *idesc,
-			   const void *idata)
-{
-EMACS_INT count;
-const void *irdata;
-int line = XD_INDIRECT_VAL (code);
-int delta = XD_INDIRECT_DELTA (code);
-irdata = ((char *) idata) +
-lispdesc_indirect_count (idesc[line].offset, idesc, idata);
-switch (idesc[line].type)
-{
-case XD_BYTECOUNT:
-count = * (Bytecount *) irdata;
-break;
-case XD_ELEMCOUNT:
-count = * (Elemcount *) irdata;
-break;
-case XD_HASHCODE:
-count = * (Hashcode *) irdata;
-break;
-case XD_INT:
-count = * (int *) irdata;
-break;
-case XD_LONG:
-count = * (long *) irdata;
-break;
-default:
-stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n",
-		  idesc[line].type, line, (long) code);
-#if defined(USE_KKCC) && defined(DEBUG_XEMACS)
-if (gc_in_progress)
-	kkcc_backtrace ();
-#endif
-#ifdef PDUMP
-if (in_pdump)
-	pdump_backtrace ();
-#endif
-count = 0; /* warning suppression */
-ABORT ();
-}
-count += delta;
-return count;
-}
-/* SDESC is a "description map" (basically, a list of offsets used for
-successive indirections) and OBJ is the first object to indirect off of.
-Return the description ultimately found. */
-const struct sized_memory_description *
-lispdesc_indirect_description_1 (const void *obj,
-				 const struct sized_memory_description *sdesc)
-{
-int pos;
-for (pos = 0; sdesc[pos].size >= 0; pos++)
-obj = * (const void **) ((const char *) obj + sdesc[pos].size);
-return (const struct sized_memory_description *) obj;
-}
-/* Compute the size of the data at RDATA, described by a single entry
-DESC1 in a description array.  OBJ and DESC are used for
-XD_INDIRECT references. */
-static Bytecount
-lispdesc_one_description_line_size (void *rdata,
-				    const struct memory_description *desc1,
-				    const void *obj,
-				    const struct memory_description *desc)
-{
-union_switcheroo:
-switch (desc1->type)
-{
-case XD_LISP_OBJECT_ARRAY:
-{
-	EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
-	return (val * sizeof (Lisp_Object));
-}
-case XD_LISP_OBJECT:
-case XD_LO_LINK:
-return sizeof (Lisp_Object);
-case XD_OPAQUE_PTR:
-return sizeof (void *);
-case XD_BLOCK_PTR:
-{
-	EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
-	return val * sizeof (void *);
-}
-case XD_BLOCK_ARRAY:
-{
-	EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj);
-	return (val *
-		lispdesc_block_size
-		(rdata,
-		 lispdesc_indirect_description (obj, desc1->data2.descr)));
-}
-case XD_OPAQUE_DATA_PTR:
-return sizeof (void *);
-case XD_UNION_DYNAMIC_SIZE:
-{
-	/* If an explicit size was given in the first-level structure
-	   description, use it; else compute size based on current union
-	   constant. */
-	const struct sized_memory_description *sdesc =
-	  lispdesc_indirect_description (obj, desc1->data2.descr);
-	if (sdesc->size)
-	  return sdesc->size;
-	else
-	  {
-	    desc1 = lispdesc_process_xd_union (desc1, desc, obj);
-	    if (desc1)
-	      goto union_switcheroo;
-	    break;
-	  }
-}
-case XD_UNION:
-{
-	/* If an explicit size was given in the first-level structure
-	   description, use it; else compute size based on maximum of all
-	   possible structures. */
-	const struct sized_memory_description *sdesc =
-	  lispdesc_indirect_description (obj, desc1->data2.descr);
-	if (sdesc->size)
-	  return sdesc->size;
-	else
-	  {
-	    int count;
-	    Bytecount max_size = -1, size;
-	    desc1 = sdesc->description;
-	    for (count = 0; desc1[count].type != XD_END; count++)
-	      {
-		size = lispdesc_one_description_line_size (rdata,
-							   &desc1[count],
-							   obj, desc);
-		if (size > max_size)
-		  max_size = size;
-	      }
-	    return max_size;
-	  }
-}
-case XD_ASCII_STRING:
-return sizeof (void *);
-case XD_DOC_STRING:
-return sizeof (void *);
-case XD_INT_RESET:
-return sizeof (int);
-case XD_BYTECOUNT:
-return sizeof (Bytecount);
-case XD_ELEMCOUNT:
-return sizeof (Elemcount);
-case XD_HASHCODE:
-return sizeof (Hashcode);
-case XD_INT:
-return sizeof (int);
-case XD_LONG:
-return sizeof (long);
-default:
-stderr_out ("Unsupported dump type : %d\n", desc1->type);
-ABORT ();
-}
-return 0;
-}
-/* Return the size of the memory block (NOT necessarily a structure!)
-described by SDESC and pointed to by OBJ.  If SDESC records an
-explicit size (i.e. non-zero), it is simply returned; otherwise,
-the size is calculated by the maximum offset and the size of the
-object at that offset, rounded up to the maximum alignment.  In
-this case, we may need the object, for example when retrieving an
-"indirect count" of an inlined array (the count is not constant,
-but is specified by one of the elements of the memory block). (It
-is generally not a problem if we return an overly large size -- we
-will simply end up reserving more space than necessary; but if the
-size is too small we could be in serious trouble, in particular
-with nested inlined structures, where there may be alignment
-padding in the middle of a block. #### In fact there is an (at
-least theoretical) problem with an overly large size -- we may
-trigger a protection fault when reading from invalid memory.  We
-need to handle this -- perhaps in a stupid but dependable way,
-i.e. by trapping SIGSEGV and SIGBUS.) */
-Bytecount
-lispdesc_block_size_1 (const void *obj, Bytecount size,
-		       const struct memory_description *desc)
-{
-EMACS_INT max_offset = -1;
-int max_offset_pos = -1;
-int pos;
-if (size)
-return size;
-for (pos = 0; desc[pos].type != XD_END; pos++)
-{
-EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj);
-if (offset == max_offset)
-	{
-	  stderr_out ("Two relocatable elements at same offset?\n");
-	  ABORT ();
-	}
-else if (offset > max_offset)
-	{
-	  max_offset = offset;
-	  max_offset_pos = pos;
-	}
-}
-if (max_offset_pos < 0)
-return 0;
-{
-Bytecount size_at_max;
-size_at_max =
-lispdesc_one_description_line_size ((char *) obj + max_offset,
-					  &desc[max_offset_pos], obj, desc);
-/* We have no way of knowing the required alignment for this structure,
-so just make it maximally aligned. */
-return MAX_ALIGN_SIZE (max_offset + size_at_max);
-}
-}
-#endif /* defined (USE_KKCC) || defined (PDUMP) */
-#ifdef MC_ALLOC
-#define GC_CHECK_NOT_FREE(lheader)			\
-gc_checking_assert (! LRECORD_FREE_P (lheader));
-#else /* MC_ALLOC */
-#define GC_CHECK_NOT_FREE(lheader)					\
-gc_checking_assert (! LRECORD_FREE_P (lheader));			\
-gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p ||	\
-			  ! ((struct old_lcrecord_header *) lheader)->free)
-#endif /* MC_ALLOC */
-#ifdef USE_KKCC
-/* The following functions implement the new mark algorithm.
-They mark objects according to their descriptions.  They
-are modeled on the corresponding pdumper procedures. */
-#ifdef DEBUG_XEMACS
-/* The backtrace for the KKCC mark functions. */
-#define KKCC_INIT_BT_STACK_SIZE 4096
-typedef struct
-{
-void *obj;
-const struct memory_description *desc;
-int pos;
-} kkcc_bt_stack_entry;
-static kkcc_bt_stack_entry *kkcc_bt;
-static int kkcc_bt_stack_size;
-static int kkcc_bt_depth = 0;
-static void
-kkcc_bt_init (void)
-{
-kkcc_bt_depth = 0;
-kkcc_bt_stack_size = KKCC_INIT_BT_STACK_SIZE;
-kkcc_bt = (kkcc_bt_stack_entry *)
-malloc (kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry));
-if (!kkcc_bt)
-{
-stderr_out ("KKCC backtrace stack init failed for size %d\n",
-		  kkcc_bt_stack_size);
-ABORT ();
-}
-}
-void
-kkcc_backtrace (void)
-{
-int i;
-stderr_out ("KKCC mark stack backtrace :\n");
-for (i = kkcc_bt_depth - 1; i >= 0; i--)
-{
-Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj);
-stderr_out (" [%d]", i);
-#ifdef MC_ALLOC
-if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type)
-#else /* not MC_ALLOC */
-if ((XRECORD_LHEADER (obj)->type >= lrecord_type_free)
-#endif /* not MC_ALLOC */
-	  || (!LRECORDP (obj))
-	  || (!XRECORD_LHEADER_IMPLEMENTATION (obj)))
-	{
-	  stderr_out (" non Lisp Object");
-	}
-else
-	{
-	  stderr_out (" %s",
-		      XRECORD_LHEADER_IMPLEMENTATION (obj)->name);
-	}
-stderr_out (" (addr: 0x%x, desc: 0x%x, ",
-		  (int) kkcc_bt[i].obj,
-		  (int) kkcc_bt[i].desc);
-if (kkcc_bt[i].pos >= 0)
-	stderr_out ("pos: %d)\n", kkcc_bt[i].pos);
-else
-	stderr_out ("root set)\n");
-}
-}
-static void
-kkcc_bt_stack_realloc (void)
-{
-kkcc_bt_stack_size *= 2;
-kkcc_bt = (kkcc_bt_stack_entry *)
-realloc (kkcc_bt, kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry));
-if (!kkcc_bt)
-{
-stderr_out ("KKCC backtrace stack realloc failed for size %d\n",
-		  kkcc_bt_stack_size);
-ABORT ();
-}
-}
-static void
-kkcc_bt_free (void)
-{
-free (kkcc_bt);
-kkcc_bt = 0;
-kkcc_bt_stack_size = 0;
-}
-static void
-kkcc_bt_push (void *obj, const struct memory_description *desc,
-	      int level, int pos)
-{
-kkcc_bt_depth = level;
-kkcc_bt[kkcc_bt_depth].obj = obj;
-kkcc_bt[kkcc_bt_depth].desc = desc;
-kkcc_bt[kkcc_bt_depth].pos = pos;
-kkcc_bt_depth++;
-if (kkcc_bt_depth >= kkcc_bt_stack_size)
-kkcc_bt_stack_realloc ();
-}
-#else /* not DEBUG_XEMACS */
-#define kkcc_bt_init()
-#define kkcc_bt_push(obj, desc, level, pos)
-#endif /* not DEBUG_XEMACS */
-/* Object memory descriptions are in the lrecord_implementation structure.
-But copying them to a parallel array is much more cache-friendly. */
-const struct memory_description *lrecord_memory_descriptions[countof (lrecord_implementations_table)];
-/* the initial stack size in kkcc_gc_stack_entries */
-#define KKCC_INIT_GC_STACK_SIZE 16384
-typedef struct
-{
-void *data;
-const struct memory_description *desc;
-#ifdef DEBUG_XEMACS
-int level;
-int pos;
-#endif
-} kkcc_gc_stack_entry;
-static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
-static kkcc_gc_stack_entry *kkcc_gc_stack_top;
-static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry;
-static int kkcc_gc_stack_size;
-static void
-kkcc_gc_stack_init (void)
-{
-kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE;
-kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *)
-malloc (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
-if (!kkcc_gc_stack_ptr)
-{
-stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size);
-ABORT ();
-}
-kkcc_gc_stack_top = kkcc_gc_stack_ptr - 1;
-kkcc_gc_stack_last_entry = kkcc_gc_stack_ptr + kkcc_gc_stack_size - 1;
-}
-static void
-kkcc_gc_stack_free (void)
-{
-free (kkcc_gc_stack_ptr);
-kkcc_gc_stack_ptr = 0;
-kkcc_gc_stack_top = 0;
-kkcc_gc_stack_size = 0;
-}
-static void
-kkcc_gc_stack_realloc (void)
-{
-int current_offset = (int)(kkcc_gc_stack_top - kkcc_gc_stack_ptr);
-kkcc_gc_stack_size *= 2;
-kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *)
-realloc (kkcc_gc_stack_ptr,
-	     kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
-if (!kkcc_gc_stack_ptr)
-{
-stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size);
-ABORT ();
-}
-kkcc_gc_stack_top = kkcc_gc_stack_ptr + current_offset;
-kkcc_gc_stack_last_entry = kkcc_gc_stack_ptr + kkcc_gc_stack_size - 1;
-}
-#define KKCC_GC_STACK_FULL (kkcc_gc_stack_top >= kkcc_gc_stack_last_entry)
-#define KKCC_GC_STACK_EMPTY (kkcc_gc_stack_top < kkcc_gc_stack_ptr)
-static void
-#ifdef DEBUG_XEMACS
-kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc,
-		    int level, int pos)
-#else
-kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc)
-#endif
-{
-if (KKCC_GC_STACK_FULL)
-kkcc_gc_stack_realloc();
-kkcc_gc_stack_top++;
-kkcc_gc_stack_top->data = data;
-kkcc_gc_stack_top->desc = desc;
-#ifdef DEBUG_XEMACS
-kkcc_gc_stack_top->level = level;
-kkcc_gc_stack_top->pos = pos;
-#endif
-}
-#ifdef DEBUG_XEMACS
-#define kkcc_gc_stack_push(data, desc, level, pos)	\
-kkcc_gc_stack_push_1 (data, desc, level, pos)
-#else
-#define kkcc_gc_stack_push(data, desc, level, pos)	\
-kkcc_gc_stack_push_1 (data, desc)
-#endif
-static kkcc_gc_stack_entry *
-kkcc_gc_stack_pop (void)
-{
-if (KKCC_GC_STACK_EMPTY)
-return 0;
-kkcc_gc_stack_top--;
-return kkcc_gc_stack_top + 1;
-}
-void
-#ifdef DEBUG_XEMACS
-kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos)
-#else
-kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj)
-#endif
-{
-if (XTYPE (obj) == Lisp_Type_Record)
-{
-struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-const struct memory_description *desc;
-GC_CHECK_LHEADER_INVARIANTS (lheader);
-desc = RECORD_DESCRIPTION (lheader);
-if (! MARKED_RECORD_HEADER_P (lheader))
-	{
-	  MARK_RECORD_HEADER (lheader);
-	  kkcc_gc_stack_push ((void*) lheader, desc, level, pos);
-	}
-}
-}
-#ifdef DEBUG_XEMACS
-#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
-kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
-#else
-#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
-kkcc_gc_stack_push_lisp_object_1 (obj)
-#endif
-#ifdef ERROR_CHECK_GC
-#define KKCC_DO_CHECK_FREE(obj, allow_free)			\
-do								\
-{								\
-if (!allow_free && XTYPE (obj) == Lisp_Type_Record)		\
-{								\
-struct lrecord_header *lheader = XRECORD_LHEADER (obj);	\
-GC_CHECK_NOT_FREE (lheader);				\
-}								\
-} while (0)
-#else
-#define KKCC_DO_CHECK_FREE(obj, allow_free)
-#endif
-#ifdef ERROR_CHECK_GC
-#ifdef DEBUG_XEMACS
-static void
-mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free,
-				 int level, int pos)
-#else
-static void
-mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free)
-#endif
-{
-KKCC_DO_CHECK_FREE (obj, allow_free);
-kkcc_gc_stack_push_lisp_object (obj, level, pos);
-}
-#ifdef DEBUG_XEMACS
-#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
-mark_object_maybe_checking_free_1 (obj, allow_free, level, pos)
-#else
-#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
-mark_object_maybe_checking_free_1 (obj, allow_free)
-#endif
-#else /* not ERROR_CHECK_GC */
-#define mark_object_maybe_checking_free(obj, allow_free, level, pos) 	\
-kkcc_gc_stack_push_lisp_object (obj, level, pos)
-#endif /* not ERROR_CHECK_GC */
-/* This function loops all elements of a struct pointer and calls
-mark_with_description with each element. */
-static void
-#ifdef DEBUG_XEMACS
-mark_struct_contents_1 (const void *data,
-		      const struct sized_memory_description *sdesc,
-		      int count, int level, int pos)
-#else
-mark_struct_contents_1 (const void *data,
-		      const struct sized_memory_description *sdesc,
-		      int count)
-#endif
-{
-int i;
-Bytecount elsize;
-elsize = lispdesc_block_size (data, sdesc);
-for (i = 0; i < count; i++)
-{
-kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description,
-			  level, pos);
-}
-}
-#ifdef DEBUG_XEMACS
-#define mark_struct_contents(data, sdesc, count, level, pos) \
-mark_struct_contents_1 (data, sdesc, count, level, pos)
-#else
-#define mark_struct_contents(data, sdesc, count, level, pos) \
-mark_struct_contents_1 (data, sdesc, count)
-#endif
-/* This function implements the KKCC mark algorithm.
-Instead of calling mark_object, all the alive Lisp_Objects are pushed
-on the kkcc_gc_stack. This function processes all elements on the stack
-according to their descriptions. */
-static void
-kkcc_marking (void)
-{
-kkcc_gc_stack_entry *stack_entry = 0;
-void *data = 0;
-const struct memory_description *desc = 0;
-int pos;
-#ifdef DEBUG_XEMACS
-int level = 0;
-kkcc_bt_init ();
-#endif
-while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
-{
-data = stack_entry->data;
-desc = stack_entry->desc;
-#ifdef DEBUG_XEMACS
-level = stack_entry->level + 1;
-#endif
-kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos);
-gc_checking_assert (data);
-gc_checking_assert (desc);
-for (pos = 0; desc[pos].type != XD_END; pos++)
-	{
-	  const struct memory_description *desc1 = &desc[pos];
-	  const void *rdata =
-	    (const char *) data + lispdesc_indirect_count (desc1->offset,
-							   desc, data);
-	union_switcheroo:
-	  /* If the flag says don't mark, then don't mark. */
-	  if ((desc1->flags) & XD_FLAG_NO_KKCC)
-	    continue;
-	  switch (desc1->type)
-	    {
-	    case XD_BYTECOUNT:
-	    case XD_ELEMCOUNT:
-	    case XD_HASHCODE:
-	    case XD_INT:
-	    case XD_LONG:
-	    case XD_INT_RESET:
-	    case XD_LO_LINK:
-	    case XD_OPAQUE_PTR:
-	    case XD_OPAQUE_DATA_PTR:
-	    case XD_ASCII_STRING:
-	    case XD_DOC_STRING:
-	      break;
-	    case XD_LISP_OBJECT:
-	      {
-		const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
-		/* Because of the way that tagged objects work (pointers and
-		   Lisp_Objects have the same representation), XD_LISP_OBJECT
-		   can be used for untagged pointers.  They might be NULL,
-		   though. */
-		if (EQ (*stored_obj, Qnull_pointer))
-		  break;
-#ifdef MC_ALLOC
-		mark_object_maybe_checking_free (*stored_obj, 0, level, pos);
-#else /* not MC_ALLOC */
-		mark_object_maybe_checking_free
-		  (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
-		   level, pos);
-#endif /* not MC_ALLOC */
-		break;
-	      }
-	    case XD_LISP_OBJECT_ARRAY:
-	      {
-		int i;
-		EMACS_INT count =
-		  lispdesc_indirect_count (desc1->data1, desc, data);
-		for (i = 0; i < count; i++)
-		  {
-		    const Lisp_Object *stored_obj =
-		      (const Lisp_Object *) rdata + i;
-		    if (EQ (*stored_obj, Qnull_pointer))
-		      break;
-#ifdef MC_ALLOC
-		    mark_object_maybe_checking_free (*stored_obj, 0, level, pos);
-#else /* not MC_ALLOC */
-		    mark_object_maybe_checking_free
-		      (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
-		       level, pos);
-#endif /* not MC_ALLOC */
-		  }
-		break;
-	      }
-	    case XD_BLOCK_PTR:
-	      {
-		EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
-							   data);
-		const struct sized_memory_description *sdesc =
-		  lispdesc_indirect_description (data, desc1->data2.descr);
-		const char *dobj = * (const char **) rdata;
-		if (dobj)
-		  mark_struct_contents (dobj, sdesc, count, level, pos);
-		break;
-	      }
-	    case XD_BLOCK_ARRAY:
-	      {
-		EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
-							   data);
-		const struct sized_memory_description *sdesc =
-		  lispdesc_indirect_description (data, desc1->data2.descr);
-		mark_struct_contents (rdata, sdesc, count, level, pos);
-		break;
-	      }
-	    case XD_UNION:
-	    case XD_UNION_DYNAMIC_SIZE:
-	      desc1 = lispdesc_process_xd_union (desc1, desc, data);
-	      if (desc1)
-		goto union_switcheroo;
-	      break;
-	    default:
-	      stderr_out ("Unsupported description type : %d\n", desc1->type);
-	      kkcc_backtrace ();
-	      ABORT ();
-	    }
-	}
-}
-#ifdef DEBUG_XEMACS
-kkcc_bt_free ();
-#endif
-}
-#endif /* USE_KKCC */
-/* Mark reference to a Lisp_Object.  If the object referred to has not been
-seen yet, recursively mark all the references contained in it. */
-void
-mark_object (
-#ifdef USE_KKCC
-	     Lisp_Object UNUSED (obj)
-#else
-	     Lisp_Object obj
-#endif
-	     )
-{
-#ifdef USE_KKCC
-/* this code should never be reached when configured for KKCC */
-stderr_out ("KKCC: Invalid mark_object call.\n");
-stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n");
-ABORT ();
-#else /* not USE_KKCC */
-tail_recurse:
-/* Checks we used to perform */
-/* if (EQ (obj, Qnull_pointer)) return; */
-/* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */
-/* if (PURIFIED (XPNTR (obj))) return; */
-if (XTYPE (obj) == Lisp_Type_Record)
-{
-struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-GC_CHECK_LHEADER_INVARIANTS (lheader);
-/* We handle this separately, above, so we can mark free objects */
-GC_CHECK_NOT_FREE (lheader);
-/* All c_readonly objects have their mark bit set,
-	 so that we only need to check the mark bit here. */
-if (! MARKED_RECORD_HEADER_P (lheader))
-	{
-	  MARK_RECORD_HEADER (lheader);
-	  if (RECORD_MARKER (lheader))
-	    {
-	      obj = RECORD_MARKER (lheader) (obj);
-	      if (!NILP (obj)) goto tail_recurse;
-	    }
-	}
-}
-#endif /* not KKCC */
-}
-#ifndef MC_ALLOC
 static int gc_count_num_short_string_in_use;
 static Bytecount gc_count_string_total_size;
 static Bytecount gc_count_short_string_total_size;
 /* static int gc_count_total_records_used, gc_count_records_total_size; */
 int instances_in_use;
 int bytes_in_use;
 int instances_freed;
 int bytes_freed;
 int instances_on_free_list;
-} lcrecord_stats [countof (lrecord_implementations_table)
+} lcrecord_stats [countof (lrecord_implementations_table)];
-		  + MODULE_DEFINABLE_TYPE_COUNT];
 static void
 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
 {
 int type_index = h->type;
 	  lcrecord_stats[type_index].instances_in_use++;
 	  lcrecord_stats[type_index].bytes_in_use += sz;
 	}
 }
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 /* Free all unmarked records */
 static void
 sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used)
 {
 struct old_lcrecord_header *header;
 #endif /* !ERROR_CHECK_GC */
 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
 SWEEP_FIXED_TYPE_BLOCK_1 (typename, obj_type, lheader)
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_conses (void)
 {
 #define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_cons(ptr)
 SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 /* Explicitly free a cons cell.  */
 void
 free_cons (Lisp_Object cons)
 {
-#ifndef MC_ALLOC /* to avoid compiler warning */
+#ifndef NEW_GC /* to avoid compiler warning */
 Lisp_Cons *ptr = XCONS (cons);
-#endif /* MC_ALLOC */
+#endif /* not NEW_GC */
 #ifdef ERROR_CHECK_GC
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 Lisp_Cons *ptr = XCONS (cons);
-#endif /* MC_ALLOC */
+#endif /* NEW_GC */
 /* If the CAR is not an int, then it will be a pointer, which will
 always be four-byte aligned.  If this cons cell has already been
 placed on the free list, however, its car will probably contain
 a chain pointer to the next cons on the list, which has cleverly
 had all its 0's and 1's inverted.  This allows for a quick
 well as a check in FREE_FIXED_TYPE(). */
 if (POINTER_TYPE_P (XTYPE (cons_car (ptr))))
 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
 #endif /* ERROR_CHECK_GC */
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (cons);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr);
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 /* explicitly free a list.  You **must make sure** that you have
 created all the cons cells that make up this list and that there
 are no pointers to any of these cons cells anywhere else.  If there
 free_cons (XCAR (rest));
 free_cons (rest);
 }
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_compiled_functions (void)
 {
 #define UNMARK_compiled_function(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_compiled_function(ptr) \
 #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_event(ptr)
 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 #ifdef EVENT_DATA_AS_OBJECTS
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_key_data (void)
 {
 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_key_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_key_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_button_data (void)
 {
 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_button_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_button_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_motion_data (void)
 {
 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_motion_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_motion_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_process_data (void)
 {
 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_process_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_process_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_timeout_data (void)
 {
 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_timeout_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_timeout_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_magic_data (void)
 {
 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_magic_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_magic_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_magic_eval_data (void)
 {
 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_magic_eval_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_magic_eval_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_eval_data (void)
 {
 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_eval_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_eval_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_misc_user_data (void)
 {
 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_misc_user_data(ptr)
 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 free_misc_user_data (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 #endif /* EVENT_DATA_AS_OBJECTS */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_markers (void)
 {
 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
 #define ADDITIONAL_FREE_marker(ptr)					\
 unchain_marker (tem);						\
 } while (0)
 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker);
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 /* Explicitly free a marker.  */
 void
 free_marker (Lisp_Object ptr)
 {
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 free_lrecord (ptr);
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
 }
 }
 #endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */
+#ifndef NEW_GC
 /* Compactify string chars, relocating the reference to each --
 free any empty string_chars_block we see. */
-static void
+void
 compact_string_chars (void)
 {
 struct string_chars_block *to_sb = first_string_chars_block;
 int to_pos = 0;
 struct string_chars_block *from_sb;
 current_string_chars_block = to_sb;
 current_string_chars_block->pos = to_pos;
 current_string_chars_block->next = 0;
 }
 }
+#endif /* not NEW_GC */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 #if 1 /* Hack to debug missing purecopy's */
 static int debug_string_purity;
 static void
 debug_string_purity_print (Lisp_Object p)
 stderr_out ("%c", ch);
 }
 stderr_out ("\"\n");
 }
 #endif /* 1 */
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 sweep_strings (void)
 {
 int num_small_used = 0;
 Bytecount num_small_bytes = 0, num_bytes = 0;
 gc_count_num_short_string_in_use = num_small_used;
 gc_count_string_total_size = num_bytes;
 gc_count_short_string_total_size = num_small_bytes;
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-/* I hate duplicating all this crap! */
+#ifndef NEW_GC
-int
+void
-marked_p (Lisp_Object obj)
+gc_sweep_1 (void)
 {
-/* Checks we used to perform. */
-/* if (EQ (obj, Qnull_pointer)) return 1; */
-/* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */
-/* if (PURIFIED (XPNTR (obj))) return 1; */
-if (XTYPE (obj) == Lisp_Type_Record)
-{
-struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-GC_CHECK_LHEADER_INVARIANTS (lheader);
-return MARKED_RECORD_HEADER_P (lheader);
-}
-return 1;
-}
-static void
-gc_sweep (void)
-{
-#ifdef MC_ALLOC
-compact_string_chars ();
-mc_finalize ();
-mc_sweep ();
-#else /* not MC_ALLOC */
 /* Free all unmarked records.  Do this at the very beginning,
 before anything else, so that the finalize methods can safely
 examine items in the objects.  sweep_lcrecords_1() makes
 sure to call all the finalize methods *before* freeing anything,
 to complete the safety. */
 sweep_magic_data ();
 sweep_magic_eval_data ();
 sweep_eval_data ();
 sweep_misc_user_data ();
 #endif /* EVENT_DATA_AS_OBJECTS */
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 #ifdef PDUMP
 pdump_objects_unmark ();
 #endif
-#endif /* not MC_ALLOC */
+}
-}
+#endif /* not NEW_GC */
 /* Clearing for disksave. */
 void
 disksave_object_finalization (void)
 			   defined(LOADHIST_BUILTIN))
 Vload_history = Qnil;
 #endif
 Vshell_file_name = Qnil;
+#ifdef NEW_GC
+gc_full ();
+#else /* not NEW_GC */
 garbage_collect_1 ();
+#endif /* not NEW_GC */
 /* Run the disksave finalization methods of all live objects. */
 disksave_object_finalization_1 ();
+#ifndef NEW_GC
 /* Zero out the uninitialized (really, unused) part of the containers
 for the live strings. */
 {
 struct string_chars_block *scb;
 for (scb = first_string_chars_block; scb; scb = scb->next)
 	    /* from the block's fill ptr to the end */
 	    memset ((scb->string_chars + scb->pos), 0, count);
 	  }
 }
 }
+#endif /* not NEW_GC */
 /* There, that ought to be enough... */
-}
-int
-begin_gc_forbidden (void)
-{
-return internal_bind_int (&gc_currently_forbidden, 1);
-}
-void
-end_gc_forbidden (int count)
-{
-unbind_to (count);
-}
-/* Maybe we want to use this when doing a "panic" gc after memory_full()? */
-static int gc_hooks_inhibited;
-struct post_gc_action
-{
-void (*fun) (void *);
-void *arg;
-};
-typedef struct post_gc_action post_gc_action;
-typedef struct
-{
-Dynarr_declare (post_gc_action);
-} post_gc_action_dynarr;
-static post_gc_action_dynarr *post_gc_actions;
-/* Register an action to be called at the end of GC.
-gc_in_progress is 0 when this is called.
-This is used when it is discovered that an action needs to be taken,
-but it's during GC, so it's not safe. (e.g. in a finalize method.)
-As a general rule, do not use Lisp objects here.
-And NEVER signal an error.
-*/
-void
-register_post_gc_action (void (*fun) (void *), void *arg)
-{
-post_gc_action action;
-if (!post_gc_actions)
-post_gc_actions = Dynarr_new (post_gc_action);
-action.fun = fun;
-action.arg = arg;
-Dynarr_add (post_gc_actions, action);
-}
-static void
-run_post_gc_actions (void)
-{
-int i;
-if (post_gc_actions)
-{
-for (i = 0; i < Dynarr_length (post_gc_actions); i++)
-	{
-	  post_gc_action action = Dynarr_at (post_gc_actions, i);
-	  (action.fun) (action.arg);
-	}
-Dynarr_reset (post_gc_actions);
-}
-}
-void
-garbage_collect_1 (void)
-{
-#if MAX_SAVE_STACK > 0
-char stack_top_variable;
-extern char *stack_bottom;
-#endif
-struct frame *f;
-int speccount;
-int cursor_changed;
-Lisp_Object pre_gc_cursor;
-struct gcpro gcpro1;
-PROFILE_DECLARE ();
-assert (!in_display || gc_currently_forbidden);
-if (gc_in_progress
-|| gc_currently_forbidden
-|| in_display
-|| preparing_for_armageddon)
-return;
-PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
-/* We used to call selected_frame() here.
-The following functions cannot be called inside GC
-so we move to after the above tests. */
-{
-Lisp_Object frame;
-Lisp_Object device = Fselected_device (Qnil);
-if (NILP (device)) /* Could happen during startup, eg. if always_gc */
-return;
-frame = Fselected_frame (device);
-if (NILP (frame))
-invalid_state ("No frames exist on device", device);
-f = XFRAME (frame);
-}
-pre_gc_cursor = Qnil;
-cursor_changed = 0;
-GCPRO1 (pre_gc_cursor);
-/* Very important to prevent GC during any of the following
-stuff that might run Lisp code; otherwise, we'll likely
-have infinite GC recursion. */
-speccount = begin_gc_forbidden ();
-need_to_signal_post_gc = 0;
-recompute_funcall_allocation_flag ();
-if (!gc_hooks_inhibited)
-run_hook_trapping_problems
-(Qgarbage_collecting, Qpre_gc_hook,
-INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
-/* Now show the GC cursor/message. */
-if (!noninteractive)
-{
-if (FRAME_WIN_P (f))
-	{
-	  Lisp_Object frame = wrap_frame (f);
-	  Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph,
-						     FRAME_SELECTED_WINDOW (f),
-						     ERROR_ME_NOT, 1);
-	  pre_gc_cursor = f->pointer;
-	  if (POINTER_IMAGE_INSTANCEP (cursor)
-	      /* don't change if we don't know how to change back. */
-	      && POINTER_IMAGE_INSTANCEP (pre_gc_cursor))
-	    {
-	      cursor_changed = 1;
-	      Fset_frame_pointer (frame, cursor);
-	    }
-	}
-/* Don't print messages to the stream device. */
-if (!cursor_changed && !FRAME_STREAM_P (f))
-	{
-	  if (garbage_collection_messages)
-	    {
-	      Lisp_Object args[2], whole_msg;
-	      args[0] = (STRINGP (Vgc_message) ? Vgc_message :
-			 build_msg_string (gc_default_message));
-	      args[1] = build_string ("...");
-	      whole_msg = Fconcat (2, args);
-	      echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1,
-				 Qgarbage_collecting);
-	    }
-	}
-}
-/***** Now we actually start the garbage collection. */
-gc_in_progress = 1;
-inhibit_non_essential_conversion_operations = 1;
-gc_generation_number[0]++;
-#if MAX_SAVE_STACK > 0
-/* Save a copy of the contents of the stack, for debugging.  */
-if (!purify_flag)
-{
-/* Static buffer in which we save a copy of the C stack at each GC.  */
-static char *stack_copy;
-static Bytecount stack_copy_size;
-ptrdiff_t stack_diff = &stack_top_variable - stack_bottom;
-Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff);
-if (stack_size < MAX_SAVE_STACK)
-	{
-	  if (stack_copy_size < stack_size)
-	    {
-	      stack_copy = (char *) xrealloc (stack_copy, stack_size);
-	      stack_copy_size = stack_size;
-	    }
-	  memcpy (stack_copy,
-		  stack_diff > 0 ? stack_bottom : &stack_top_variable,
-		  stack_size);
-	}
-}
-#endif /* MAX_SAVE_STACK > 0 */
-/* Do some totally ad-hoc resource clearing. */
-/* #### generalize this? */
-clear_event_resource ();
-cleanup_specifiers ();
-cleanup_buffer_undo_lists ();
-/* Mark all the special slots that serve as the roots of accessibility. */
-#ifdef USE_KKCC
-/* initialize kkcc stack */
-kkcc_gc_stack_init();
-#define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
-#endif /* USE_KKCC */
-{ /* staticpro() */
-Lisp_Object **p = Dynarr_begin (staticpros);
-Elemcount count;
-for (count = Dynarr_length (staticpros); count; count--)
-mark_object (**p++);
-}
-{ /* staticpro_nodump() */
-Lisp_Object **p = Dynarr_begin (staticpros_nodump);
-Elemcount count;
-for (count = Dynarr_length (staticpros_nodump); count; count--)
-mark_object (**p++);
-}
-#ifdef MC_ALLOC
-{ /* mcpro () */
-Lisp_Object *p = Dynarr_begin (mcpros);
-Elemcount count;
-for (count = Dynarr_length (mcpros); count; count--)
-mark_object (*p++);
-}
-#endif /* MC_ALLOC */
-{ /* GCPRO() */
-struct gcpro *tail;
-int i;
-for (tail = gcprolist; tail; tail = tail->next)
-for (i = 0; i < tail->nvars; i++)
-	mark_object (tail->var[i]);
-}
-{ /* specbind() */
-struct specbinding *bind;
-for (bind = specpdl; bind != specpdl_ptr; bind++)
-{
-	mark_object (bind->symbol);
-	mark_object (bind->old_value);
-}
-}
-{
-struct catchtag *c;
-for (c = catchlist; c; c = c->next)
-{
-	mark_object (c->tag);
-	mark_object (c->val);
-	mark_object (c->actual_tag);
-	mark_object (c->backtrace);
-}
-}
-{
-struct backtrace *backlist;
-for (backlist = backtrace_list; backlist; backlist = backlist->next)
-{
-	int nargs = backlist->nargs;
-	int i;
-	mark_object (*backlist->function);
-	if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
-	    /* might be fake (internal profiling entry) */
-	    && backlist->args)
-	  mark_object (backlist->args[0]);
-	else
-	  for (i = 0; i < nargs; i++)
-	    mark_object (backlist->args[i]);
-}
-}
-mark_profiling_info ();
-/* OK, now do the after-mark stuff.  This is for things that
-are only marked when something else is marked (e.g. weak hash tables).
-There may be complex dependencies between such objects -- e.g.
-a weak hash table might be unmarked, but after processing a later
-weak hash table, the former one might get marked.  So we have to
-iterate until nothing more gets marked. */
-#ifdef USE_KKCC
-kkcc_marking ();
-#endif /* USE_KKCC */
-init_marking_ephemerons ();
-while (finish_marking_weak_hash_tables () > 0 ||
-	 finish_marking_weak_lists       () > 0 ||
-	 continue_marking_ephemerons     () > 0)
-#ifdef USE_KKCC
-{
-kkcc_marking ();
-}
-#else /* NOT USE_KKCC */
-;
-#endif /* USE_KKCC */
-/* At this point, we know which objects need to be finalized: we
-still need to resurrect them */
-while (finish_marking_ephemerons       () > 0 ||
-	 finish_marking_weak_lists       () > 0 ||
-	 finish_marking_weak_hash_tables () > 0)
-#ifdef USE_KKCC
-{
-kkcc_marking ();
-}
-kkcc_gc_stack_free ();
-#undef mark_object
-#else /* NOT USE_KKCC */
-;
-#endif /* USE_KKCC */
-/* And prune (this needs to be called after everything else has been
-marked and before we do any sweeping). */
-/* #### this is somewhat ad-hoc and should probably be an object
-method */
-prune_weak_hash_tables ();
-prune_weak_lists ();
-prune_specifiers ();
-prune_syntax_tables ();
-prune_ephemerons ();
-prune_weak_boxes ();
-gc_sweep ();
-consing_since_gc = 0;
-#ifndef DEBUG_XEMACS
-/* Allow you to set it really fucking low if you really want ... */
-if (gc_cons_threshold < 10000)
-gc_cons_threshold = 10000;
-#endif
-recompute_need_to_garbage_collect ();
-inhibit_non_essential_conversion_operations = 0;
-gc_in_progress = 0;
-run_post_gc_actions ();
-/******* End of garbage collection ********/
-/* Now remove the GC cursor/message */
-if (!noninteractive)
-{
-if (cursor_changed)
-	Fset_frame_pointer (wrap_frame (f), pre_gc_cursor);
-else if (!FRAME_STREAM_P (f))
-	{
-	  /* Show "...done" only if the echo area would otherwise be empty. */
-	  if (NILP (clear_echo_area (selected_frame (),
-				     Qgarbage_collecting, 0)))
-	    {
-	      if (garbage_collection_messages)
-		{
-		  Lisp_Object args[2], whole_msg;
-		  args[0] = (STRINGP (Vgc_message) ? Vgc_message :
-			     build_msg_string (gc_default_message));
-		  args[1] = build_msg_string ("... done");
-		  whole_msg = Fconcat (2, args);
-		  echo_area_message (selected_frame (), (Ibyte *) 0,
-				     whole_msg, 0, -1,
-				     Qgarbage_collecting);
-		}
-	    }
-	}
-}
-/* now stop inhibiting GC */
-unbind_to (speccount);
-#ifndef MC_ALLOC
-if (!breathing_space)
-{
-breathing_space = malloc (4096 - MALLOC_OVERHEAD);
-}
-#endif /* not MC_ALLOC */
-UNGCPRO;
-need_to_signal_post_gc = 1;
-funcall_allocation_flag = 1;
-PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection);
-return;
 }
 #ifdef ALLOC_TYPE_STATS
 static Lisp_Object
 {
 Lisp_Object pl = Qnil;
 int i;
 EMACS_INT tgu_val = 0;
-#ifdef MC_ALLOC
+#ifdef NEW_GC
-for (i = 0; i < (countof (lrecord_implementations_table)
+for (i = 0; i < countof (lrecord_implementations_table); i++)
-		   + MODULE_DEFINABLE_TYPE_COUNT); i++)
 {
 if (lrecord_stats[i].instances_in_use != 0)
 {
 char buf [255];
 const char *name = lrecord_implementations_table[i]->name;
 	  else
 	    sprintf (buf, "%ss-used", name);
 	  pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
 }
 }
-pl = gc_plist_hack ("string-data-storage-including-overhead",
-		      lrecord_string_data_bytes_in_use_including_overhead, pl);
+#else /* not NEW_GC */
-pl = gc_plist_hack ("string-data-storage-additional",
-		      lrecord_string_data_bytes_in_use, pl);
-pl = gc_plist_hack ("string-data-used",
-		      lrecord_string_data_instances_in_use, pl);
-tgu_val += lrecord_string_data_bytes_in_use_including_overhead;
-#else /* not MC_ALLOC */
 #define HACK_O_MATIC(type, name, pl) do {				\
 EMACS_INT s = 0;							\
 struct type##_block *x = current_##type##_block;			\
 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; }	\
 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl);
 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl);
 #undef HACK_O_MATIC
-#endif /* MC_ALLOC */
+#endif /* NEW_GC */
 if (set_total_gc_usage)
 {
 total_gc_usage = tgu_val;
 total_gc_usage_set = 1;
 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
 */
 ())
 {
 /* Record total usage for purposes of determining next GC */
+#ifdef NEW_GC
+gc_full ();
+#else /* not NEW_GC */
 garbage_collect_1 ();
+#endif /* not NEW_GC */
 /* This will get set to 1, and total_gc_usage computed, as part of the
 call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */
 total_gc_usage_set = 0;
 #ifdef ALLOC_TYPE_STATS
 /* The things we do for backwards-compatibility */
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 return
 list6
 (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
 	    make_int (lrecord_stats[lrecord_type_cons]
 		      .bytes_in_use_including_overhead)),
 make_int (lrecord_stats[lrecord_type_string]
 	       .bytes_in_use_including_overhead),
 make_int (lrecord_stats[lrecord_type_vector]
 	       .bytes_in_use_including_overhead),
 object_memory_usage_stats (1));
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
 return
 list6 (Fcons (make_int (gc_count_num_cons_in_use),
 		  make_int (gc_count_num_cons_freelist)),
 	   Fcons (make_int (gc_count_num_symbol_in_use),
 		  make_int (gc_count_num_symbol_freelist)),
 		  make_int (gc_count_num_marker_freelist)),
 	   make_int (gc_count_string_total_size),
 	   make_int (lcrecord_stats[lrecord_type_vector].bytes_in_use +
 		     lcrecord_stats[lrecord_type_vector].bytes_freed),
 	   object_memory_usage_stats (1));
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 #else /* not ALLOC_TYPE_STATS */
 return Qnil;
 #endif /* ALLOC_TYPE_STATS */
 }
 need_to_garbage_collect ||
 need_to_check_c_alloca ||
 need_to_signal_post_gc;
 }
-/* True if it's time to garbage collect now. */
-static void
-recompute_need_to_garbage_collect (void)
-{
-if (always_gc)
-need_to_garbage_collect = 1;
-else
-need_to_garbage_collect =
-(consing_since_gc > gc_cons_threshold
-&&
-#if 0 /* #### implement this better */
-(100 * consing_since_gc) / total_data_usage () >=
-gc_cons_percentage
-#else
-(!total_gc_usage_set ||
-	(100 * consing_since_gc) / total_gc_usage >=
-	gc_cons_percentage)
-#endif
-);
-recompute_funcall_allocation_flag ();
-}
 int
 object_dead_p (Lisp_Object obj)
 {
 return ((BUFFERP  (obj) && !BUFFER_LIVE_P  (XBUFFER  (obj))) ||
 malloced_storage_size (void *UNUSED (ptr), Bytecount claimed_size,
 		       struct overhead_stats *stats)
 {
 Bytecount orig_claimed_size = claimed_size;
-#ifdef GNU_MALLOC
+#ifndef SYSTEM_MALLOC
 if (claimed_size < (Bytecount) (2 * sizeof (void *)))
 claimed_size = 2 * sizeof (void *);
 # ifdef SUNOS_LOCALTIME_BUG
 if (claimed_size < 16)
 claimed_size = 16;
 claimed_size += 4095;
 claimed_size &= ~4095;
 claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
 }
-#elif defined (SYSTEM_MALLOC)
+#else
 if (claimed_size < 16)
 claimed_size = 16;
 claimed_size += 2 * sizeof (void *);
-#else /* old GNU allocator */
+#endif /* system allocator */
-# ifdef rcheck /* #### may not be defined here */
-claimed_size += 20;
-# else
-claimed_size += 8;
-# endif
-{
-/* fxg: rename log->log2 to supress gcc3 shadow warning */
-int log2 = 1;
-/* compute the log base two, more or less, then use it to compute
-the block size needed. */
-claimed_size--;
-/* It's big, it's heavy, it's wood! */
-while ((claimed_size /= 2) != 0)
-++log2;
-claimed_size = 1;
-/* It's better than bad, it's good! */
-while (log2 > 0)
-{
-	claimed_size *= 2;
-log2--;
-}
-}
-#endif /* old GNU allocator */
 if (stats)
 {
 stats->was_requested += orig_claimed_size;
 stats->malloc_overhead += claimed_size - orig_claimed_size;
 }
 return claimed_size;
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 Bytecount
 fixed_type_block_overhead (Bytecount size)
 {
 Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char);
 Bytecount overhead = 0;
 }
 if (rand () % per_block < size)
 overhead += sizeof (void *) + per_block - storage_size;
 return overhead;
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 #endif /* MEMORY_USAGE_STATS */
 /* Initialization */
 static void
 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
 so the following is actually a no-op.  */
 Qnull_pointer = wrap_pointer_1 (0);
 #endif
-gc_generation_number[0] = 0;
+#ifndef NEW_GC
-#ifndef MC_ALLOC
 breathing_space = 0;
-#endif /* not MC_ALLOC */
-Vgc_message = Qzero;
-#ifndef MC_ALLOC
 all_lcrecords = 0;
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 ignore_malloc_warnings = 1;
 #ifdef DOUG_LEA_MALLOC
 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
 #if 0 /* Moved to emacs.c */
 mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
 #endif
 #endif
+#ifndef NEW_GC
 init_string_chars_alloc ();
-#ifndef MC_ALLOC
 init_string_alloc ();
 init_string_chars_alloc ();
 init_cons_alloc ();
 init_symbol_alloc ();
 init_compiled_function_alloc ();
 init_magic_data_alloc ();
 init_magic_eval_data_alloc ();
 init_eval_data_alloc ();
 init_misc_user_data_alloc ();
 #endif /* EVENT_DATA_AS_OBJECTS */
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 ignore_malloc_warnings = 0;
 if (staticpros_nodump)
 Dynarr_free (staticpros_nodump);
 Dynarr_free (staticpro_nodump_names);
 staticpro_nodump_names = Dynarr_new2 (char_ptr_dynarr, char *);
 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */
 #endif
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&mcpros, &mcpros_description);
 #ifdef DEBUG_XEMACS
 mcpro_names = Dynarr_new2 (char_ptr_dynarr, char *);
 Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&mcpro_names, &mcpro_names_description);
 #endif
-#endif /* MC_ALLOC */
+#endif /* NEW_GC */
 consing_since_gc = 0;
-need_to_garbage_collect = always_gc;
 need_to_check_c_alloca = 0;
 funcall_allocation_flag = 0;
 funcall_alloca_count = 0;
-#if 1
-gc_cons_threshold = 2000000; /* XEmacs change */
-#else
-gc_cons_threshold = 15000; /* debugging */
-#endif
-gc_cons_percentage = 40; /* #### what is optimal? */
-total_gc_usage_set = 0;
 lrecord_uid_counter = 259;
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 debug_string_purity = 0;
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
-gc_currently_forbidden = 0;
-gc_hooks_inhibited = 0;
 #ifdef ERROR_CHECK_TYPES
 ERROR_ME.really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
 666;
 ERROR_ME_NOT.
 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
 8675309;
 #endif /* ERROR_CHECK_TYPES */
 }
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 static void
 init_lcrecord_lists (void)
 {
 int i;
 {
 all_lcrecord_lists[i] = Qzero; /* Qnil not yet set */
 staticpro_nodump (&all_lcrecord_lists[i]);
 }
 }
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 void
 init_alloc_early (void)
 {
 #if defined (__cplusplus) && defined (ERROR_CHECK_GC)
 void
 reinit_alloc_early (void)
 {
 common_init_alloc_early ();
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 init_lcrecord_lists ();
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 void
 init_alloc_once_early (void)
 {
 }
 INIT_LISP_OBJECT (cons);
 INIT_LISP_OBJECT (vector);
 INIT_LISP_OBJECT (string);
-#ifndef MC_ALLOC
+#ifdef NEW_GC
+INIT_LISP_OBJECT (string_indirect_data);
+INIT_LISP_OBJECT (string_direct_data);
+#endif /* NEW_GC */
+#ifndef NEW_GC
 INIT_LISP_OBJECT (lcrecord_list);
 INIT_LISP_OBJECT (free);
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
 Dynarr_resize (staticpros, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&staticpros, &staticpros_description);
 #ifdef DEBUG_XEMACS
 staticpro_names = Dynarr_new2 (char_ptr_dynarr, char *);
 Dynarr_resize (staticpro_names, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&staticpro_names, &staticpro_names_description);
 #endif
-#ifdef MC_ALLOC
+#ifdef NEW_GC
 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&mcpros, &mcpros_description);
 #ifdef DEBUG_XEMACS
 mcpro_names = Dynarr_new2 (char_ptr_dynarr, char *);
 Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&mcpro_names, &mcpro_names_description);
 #endif
-#endif /* MC_ALLOC */
+#else /* not NEW_GC */
-#ifndef MC_ALLOC
 init_lcrecord_lists ();
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 }
 void
 syms_of_alloc (void)
 {
-DEFSYMBOL (Qpre_gc_hook);
-DEFSYMBOL (Qpost_gc_hook);
 DEFSYMBOL (Qgarbage_collecting);
 DEFSUBR (Fcons);
 DEFSUBR (Flist);
 DEFSUBR (Fvector);
 }
 void
 vars_of_alloc (void)
 {
-QSin_garbage_collection = build_msg_string ("(in garbage collection)");
-staticpro (&QSin_garbage_collection);
-DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /*
-*Number of bytes of consing between garbage collections.
-\"Consing\" is a misnomer in that this actually counts allocation
-of all different kinds of objects, not just conses.
-Garbage collection can happen automatically once this many bytes have been
-allocated since the last garbage collection.  All data types count.
-Garbage collection happens automatically when `eval' or `funcall' are
-called.  (Note that `funcall' is called implicitly as part of evaluation.)
-By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program.
-Normally, you cannot set this value less than 10,000 (if you do, it is
-automatically reset during the next garbage collection).  However, if
-XEmacs was compiled with DEBUG_XEMACS, this does not happen, allowing
-you to set this value very low to track down problems with insufficient
-GCPRO'ing.  If you set this to a negative number, garbage collection will
-happen at *EVERY* call to `eval' or `funcall'.  This is an extremely
-effective way to check GCPRO problems, but be warned that your XEmacs
-will be unusable!  You almost certainly won't have the patience to wait
-long enough to be able to set it back.
-See also `consing-since-gc' and `gc-cons-percentage'.
-*/ );
-DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /*
-*Percentage of memory allocated between garbage collections.
-Garbage collection will happen if this percentage of the total amount of
-memory used for data (see `lisp-object-memory-usage') has been allocated
-since the last garbage collection.  However, it will not happen if less
-than `gc-cons-threshold' bytes have been allocated -- this sets an absolute
-minimum in case very little data has been allocated or the percentage is
-set very low.  Set this to 0 to have garbage collection always happen after
-`gc-cons-threshold' bytes have been allocated, regardless of current memory
-usage.
-See also `consing-since-gc' and `gc-cons-threshold'.
-*/ );
 #ifdef DEBUG_XEMACS
 DEFVAR_INT ("debug-allocation", &debug_allocation /*
 If non-zero, print out information to stderr about all objects allocated.
 See also `debug-allocation-backtrace-length'.
 */ );
 DEFVAR_BOOL ("purify-flag", &purify_flag /*
 Non-nil means loading Lisp code in order to dump an executable.
 This means that certain objects should be allocated in readonly space.
 */ );
+}
-DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /*
-Non-nil means display messages at start and end of garbage collection.
-*/ );
-garbage_collection_messages = 0;
-DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /*
-Function or functions to be run just before each garbage collection.
-Interrupts, garbage collection, and errors are inhibited while this hook
-runs, so be extremely careful in what you add here.  In particular, avoid
-consing, and do not interact with the user.
-*/ );
-Vpre_gc_hook = Qnil;
-DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /*
-Function or functions to be run just after each garbage collection.
-Interrupts, garbage collection, and errors are inhibited while this hook
-runs.  Each hook is called with one argument which is an alist with
-finalization data.
-*/ );
-Vpost_gc_hook = Qnil;
-DEFVAR_LISP ("gc-message", &Vgc_message /*
-String to print to indicate that a garbage collection is in progress.
-This is printed in the echo area.  If the selected frame is on a
-window system and `gc-pointer-glyph' specifies a value (i.e. a pointer
-image instance) in the domain of the selected frame, the mouse pointer
-will change instead of this message being printed.
-*/ );
-Vgc_message = build_string (gc_default_message);
-DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /*
-Pointer glyph used to indicate that a garbage collection is in progress.
-If the selected window is on a window system and this glyph specifies a
-value (i.e. a pointer image instance) in the domain of the selected
-window, the pointer will be changed as specified during garbage collection.
-Otherwise, a message will be printed in the echo area, as controlled
-by `gc-message'.
-*/ );
-}
-void
-complex_vars_of_alloc (void)
-{
-Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer);
-}

Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5118:e0db3c197671 ben-lisp-object