--- a/src/alloc.c	Thu Nov 24 22:51:25 2005 +0000
+++ b/src/alloc.c	Fri Nov 25 01:42:08 2005 +0000
@@ -52,6 +52,7 @@
 #include "extents-impl.h"
 #include "file-coding.h"
 #include "frame-impl.h"
+#include "gc.h"
 #include "glyphs.h"
 #include "opaque.h"
 #include "lstream.h"
@@ -62,6 +63,9 @@
 #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
@@ -70,8 +74,6 @@
 
 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
@@ -91,13 +93,6 @@
 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;
@@ -149,6 +144,20 @@
   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);			\
@@ -158,51 +167,11 @@
     consing_since_gc = 0;			\
   recompute_need_to_garbage_collect ();		\
 } while (0)
-
-/* 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];
+#endif /*not NEW_GC */
 
 /* 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;
 
@@ -248,7 +217,7 @@
 
 
 #ifndef MC_ALLOC
-static void *breathing_space;
+void *breathing_space;
 
 void
 release_breathing_space (void)
@@ -282,6 +251,7 @@
 DOESNT_RETURN
 memory_full (void)
 {
+  fprintf (stderr, "##### M E M O R Y   F U L L #####\n");
   /* 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"
@@ -521,33 +491,10 @@
 } 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
@@ -581,6 +528,17 @@
 
   DECREMENT_CONS_COUNTER (size);
 }
+
+int
+lrecord_stats_heap_size (void)
+{
+  int i;
+  int size = 0;
+  for (i = 0; i < (countof (lrecord_implementations_table)
+		   + MODULE_DEFINABLE_TYPE_COUNT); i++)
+    size += lrecord_stats[i].bytes_in_use;
+  return size;
+}
 #endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */
 
 #ifndef MC_ALLOC
@@ -613,6 +571,7 @@
   return lheader;
 }
 
+
 void *
 noseeum_alloc_lrecord (Bytecount size,
 		       const struct lrecord_implementation *implementation)
@@ -634,15 +593,59 @@
   return lheader;
 }
 
+#ifdef NEW_GC
+void *
+alloc_lrecord_array (Bytecount size, int elemcount,
+		     const struct lrecord_implementation *implementation)
+{
+  struct lrecord_header *lheader;
+  Rawbyte *start, *stop;
+
+  type_checking_assert
+    ((implementation->static_size == 0 ?
+      implementation->size_in_bytes_method != NULL :
+      implementation->static_size == size));
+
+  lheader = (struct lrecord_header *) mc_alloc_array (size, elemcount);
+  gc_checking_assert (LRECORD_FREE_P (lheader));
+  
+  for (start = (Rawbyte *) lheader, 
+       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 */
+    }
+  INCREMENT_CONS_COUNTER (size * elemcount, implementation->name);
+  return lheader;
+}
+#endif /* NEW_GC */
+
 void
 free_lrecord (Lisp_Object lrecord)
 {
+#ifndef NEW_GC
   gc_checking_assert (!gc_in_progress);
+#endif /* not NEW_GC */
   gc_checking_assert (!LRECORD_FREE_P (XRECORD_LHEADER (lrecord)));
   gc_checking_assert (!XRECORD_LHEADER (lrecord)->free);
 
+#ifdef NEW_GC
+  GC_STAT_EXPLICITLY_TRIED_FREED;
+  /* Ignore requests to manual free objects while in garbage collection. */
+  if (write_barrier_enabled || gc_in_progress)
+    return;
+
+  GC_STAT_EXPLICITLY_FREED;
+#endif /* NEW_GC */
+
   MC_ALLOC_CALL_FINALIZER (XPNTR (lrecord));
   mc_free (XPNTR (lrecord));
+  recompute_need_to_garbage_collect ();
 }
 #else /* not MC_ALLOC */
 
@@ -955,16 +958,6 @@
    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,
@@ -1832,7 +1825,11 @@
   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
@@ -2238,8 +2235,12 @@
 }
 
 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 }
 };
@@ -2310,6 +2311,10 @@
 						Lisp_String);
 #endif /* not MC_ALLOC */
 
+#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 -			\
@@ -2341,8 +2346,10 @@
 
 #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
+#ifndef NEW_GC
 static void
 finalize_string (void *header, int for_disksave)
 {
@@ -2350,9 +2357,6 @@
     {
       Lisp_String *s = (Lisp_String *) header;
       Bytecount size = s->size_;
-#ifdef ALLOC_TYPE_STATS
-      dec_lrecord_string_data_stats (size);
-#endif /* ALLOC_TYPE_STATS */
       if (BIG_STRING_SIZE_P (size))
 	xfree (s->data_, Ibyte *);
     }
@@ -2369,9 +2373,58 @@
 					  string_remprop,
 					  string_plist,
 					  Lisp_String);
-
+#else /* NEW_GC */
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
+					  1, /*dumpable-flag*/
+					  mark_string, print_string,
+					  0,
+					  string_equal, 0,
+					  string_description,
+					  string_getprop,
+					  string_putprop,
+					  string_remprop,
+					  string_plist,
+					  Lisp_String);
+
+
+static const struct memory_description string_direct_data_description[] = {
+  { XD_BYTECOUNT,       offsetof (Lisp_String_Indirect_Data, size) },
+  { XD_END }
+};
+
+static Bytecount
+size_string_direct_data (const void *lheader)
+{
+  return STRING_FULLSIZE (((Lisp_String_Direct_Data *) lheader)->size);
+}
+
+
+DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("string-direct-data",
+					string_direct_data,
+					1, /*dumpable-flag*/
+					0, 0, 0, 0, 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_LRECORD_IMPLEMENTATION ("string-indirect-data", 
+			       string_indirect_data,
+			       1, /*dumpable-flag*/
+			       0, 0, 0, 0, 0,
+			       string_indirect_data_description,
+			       Lisp_String_Indirect_Data);
+#endif /* NEW_GC */
 #endif /* MC_ALLOC */
 
+#ifndef NEW_GC
 struct string_chars
 {
   Lisp_String *string;
@@ -2438,6 +2491,7 @@
 
   return s_chars;
 }
+#endif /* not NEW_GC */
 
 #ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN
 void
@@ -2472,9 +2526,6 @@
 
 #ifdef MC_ALLOC
   s = alloc_lrecord_type (Lisp_String, &lrecord_string);
-#ifdef ALLOC_TYPE_STATS
-  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);
@@ -2486,10 +2537,16 @@
      ascii-length field, to some non-zero value.  We need to zero it. */
   XSET_STRING_ASCII_BEGIN (wrap_string (s), 0);
 
+#ifdef NEW_GC
+  STRING_DATA_OBJECT (s) = 
+    wrap_string_direct_data (alloc_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;
@@ -2511,7 +2568,11 @@
 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
@@ -2539,6 +2600,23 @@
        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 /* NEW_GC */
   oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s));
   newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta);
 
@@ -2631,6 +2709,7 @@
 	  }
 	}
     }
+#endif /* not NEW_GC */
 
   XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta);
   /* If pos < 0, the string won't be zero-terminated.
@@ -2852,9 +2931,6 @@
 
 #ifdef MC_ALLOC
   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. */
@@ -2867,8 +2943,18 @@
   /* 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);
@@ -3337,787 +3423,6 @@
 #endif /* not DEBUG_XEMACS */
 #endif /* MC_ALLOC */
 
-#ifdef ERROR_CHECK_GC
-#ifdef 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);	\
-} 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;
@@ -4795,9 +4100,10 @@
 
 #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;
@@ -4893,6 +4199,7 @@
     current_string_chars_block->next = 0;
   }
 }
+#endif /* not NEW_GC */
 
 #ifndef MC_ALLOC
 #if 1 /* Hack to debug missing purecopy's */
@@ -4954,28 +4261,9 @@
 }
 #endif /* not MC_ALLOC */
 
-/* I hate duplicating all this crap! */
-int
-marked_p (Lisp_Object obj)
-{
-  /* 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)
+#ifndef NEW_GC
+void
+gc_sweep_1 (void)
 {
 #ifdef MC_ALLOC
   compact_string_chars ();
@@ -5064,6 +4352,7 @@
 #endif
 #endif /* not MC_ALLOC */
 }
+#endif /* not NEW_GC */
 
 /* Clearing for disksave. */
 
@@ -5101,11 +4390,16 @@
 #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. */
   {
@@ -5122,405 +4416,12 @@
 	  }
       }
   }
+#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
@@ -5573,13 +4474,6 @@
 	  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);
-  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 */
 
@@ -5720,7 +4614,11 @@
        ())
 {
   /* 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. */
@@ -5819,28 +4717,6 @@
     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)
@@ -6007,11 +4883,9 @@
   Qnull_pointer = wrap_pointer_1 (0);
 #endif
 
-  gc_generation_number[0] = 0;
 #ifndef MC_ALLOC
   breathing_space = 0;
 #endif /* not MC_ALLOC */
-  Vgc_message = Qzero;
 #ifndef MC_ALLOC
   all_lcrecords = 0;
 #endif /* not MC_ALLOC */
@@ -6023,7 +4897,9 @@
   mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
 #endif
 #endif
+#ifndef NEW_GC
   init_string_chars_alloc ();
+#endif /* not NEW_GC */
 #ifndef MC_ALLOC
   init_string_alloc ();
   init_string_chars_alloc ();
@@ -6081,26 +4957,15 @@
 #endif /* MC_ALLOC */
 
   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
   debug_string_purity = 0;
 #endif /* not MC_ALLOC */
 
-  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;
@@ -6167,6 +5032,10 @@
   INIT_LRECORD_IMPLEMENTATION (cons);
   INIT_LRECORD_IMPLEMENTATION (vector);
   INIT_LRECORD_IMPLEMENTATION (string);
+#ifdef NEW_GC
+  INIT_LRECORD_IMPLEMENTATION (string_indirect_data);
+  INIT_LRECORD_IMPLEMENTATION (string_direct_data);
+#endif /* NEW_GC */
 #ifndef MC_ALLOC
   INIT_LRECORD_IMPLEMENTATION (lcrecord_list);
   INIT_LRECORD_IMPLEMENTATION (free);
@@ -6200,8 +5069,6 @@
 void
 syms_of_alloc (void)
 {
-  DEFSYMBOL (Qpre_gc_hook);
-  DEFSYMBOL (Qpost_gc_hook);
   DEFSYMBOL (Qgarbage_collecting);
 
   DEFSUBR (Fcons);
@@ -6232,49 +5099,6 @@
 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.
@@ -6293,49 +5117,4 @@
 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);
-}