=== modified file 'configure.ac'
--- configure.ac	2012-08-01 07:20:52 +0000
+++ configure.ac	2012-08-01 10:03:56 +0000
@@ -607,6 +607,15 @@
    fi
 fi)
 
+AC_ARG_ENABLE(experimental-gc,
+[AS_HELP_STRING([--enable-experimental-gc],
+                [build emacs with experimental garbage collector.
+                 This is not really implemented yet.
+                 Expect bootstrap failures, slowdown and crashes.])],
+if test "${enableval}" = "yes"; then
+  AC_DEFINE(EXPERIMENTAL_GC, 1, [Define to try experimental GC.])
+fi)
+
 # gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found])
 # ------------------------------------------------
 # If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND.

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-08-01 08:49:28 +0000
+++ src/alloc.c	2012-08-01 16:41:39 +0000
@@ -1443,8 +1443,18 @@
 #endif /* not SYNC_INPUT */
 #endif /* not SYSTEM_MALLOC */
 
-
-
+#ifdef EXPERIMENTAL_GC
+
+#define GC_EXTRA sizeof (struct blockdata)
+
+static void set_sweep (Lisp_Object);
+
+#else /* not EXPERIMENTAL_GC */
+
+#define GC_EXTRA (0)
+
+#endif /* EXPERIMENTAL_GC */
+
 /***********************************************************************
 			 Interval Allocation
  ***********************************************************************/
@@ -2639,7 +2649,7 @@
    any new cons cells from the latest cons_block.  */
 
 #define CONS_BLOCK_SIZE						\
-  (((BLOCK_BYTES - sizeof (struct cons_block *)			\
+  (((BLOCK_BYTES - GC_EXTRA - sizeof (struct cons_block *)	\
      /* The compiler might add padding at the end.  */		\
      - (sizeof (struct Lisp_Cons) - sizeof (int))) * CHAR_BIT)	\
    / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
@@ -2655,6 +2665,9 @@
   /* Place `conses' at the beginning, to ease up CONS_INDEX's job.  */
   struct Lisp_Cons conses[CONS_BLOCK_SIZE];
   int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof (int) * CHAR_BIT)];
+#ifdef EXPERIMENTAL_GC
+  struct blockdata bd;
+#endif
   struct cons_block *next;
 };
 
@@ -2693,6 +2706,34 @@
   total_free_conses++;
 }
 
+#ifdef EXPERIMENTAL_GC
+
+void
+xsetcar (Lisp_Object cell, Lisp_Object car)
+{
+  struct Lisp_Cons *c = XCONS (cell);
+  
+  if (!PURE_POINTER_P (c))
+    CONS_BLOCK (c)->bd.mark = 1;
+
+  set_sweep (CVAR (c, car));
+  CVAR (c, car) = car;
+}
+
+void
+xsetcdr (Lisp_Object cell, Lisp_Object cdr)
+{
+  struct Lisp_Cons *c = XCONS (cell);
+
+  if (!PURE_POINTER_P (c))
+    CONS_BLOCK (c)->bd.mark = 1;
+
+  set_sweep (CVAR (c, u.cdr));
+  CVAR (c, u.cdr) = cdr;
+}
+
+#endif /* EXPERIMENTAL_GC */
+
 DEFUN ("cons", Fcons, Scons, 2, 2, 0,
        doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)
   (Lisp_Object car, Lisp_Object cdr)
@@ -2718,6 +2759,10 @@
 	    = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
 	  memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
 	  new->next = cons_block;
+#ifdef EXPERIMENTAL_GC
+	  new->bd.mark = 1;
+	  new->bd.sweep = 0;
+#endif
 	  cons_block = new;
 	  cons_block_index = 0;
 	  total_free_conses += CONS_BLOCK_SIZE;
@@ -2728,8 +2773,10 @@
 
   MALLOC_UNBLOCK_INPUT;
 
-  XSETCAR (val, car);
-  XSETCDR (val, cdr);
+  /* Do not use XSETxxx here.  */
+  CVAR (XCONS (val), car) = car;
+  CVAR (XCONS (val), u.cdr) = cdr;
+
   eassert (!CONS_MARKED_P (XCONS (val)));
   consing_since_gc += sizeof (struct Lisp_Cons);
   total_free_conses--;
@@ -2914,7 +2961,8 @@
 
 /* Rounding helps to maintain alignment constraints if USE_LSB_TAG.  */
 
-#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
+#define VECTOR_BLOCK_BYTES \
+  (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *) + GC_EXTRA))
 
 /* Size of the minimal vector allocated from block.  */
 
@@ -2952,9 +3000,19 @@
     total_free_vector_slots += (nbytes) / word_size;		\
   } while (0)
 
+#ifdef EXPERIMENTAL_GC
+
+#define VECTOR_BLOCK(vptr) \
+  ((struct vector_block *) ((uintptr_t) (vptr) & ~(VECTOR_BLOCK_SIZE - 1)))
+
+#endif /* EXPERIMENTAL_GC */
+
 struct vector_block
 {
   char data[VECTOR_BLOCK_BYTES];
+#ifdef EXPERIMENTAL_GC
+  struct blockdata bd;
+#endif
   struct vector_block *next;
 };
 
@@ -2988,7 +3046,17 @@
 static struct vector_block *
 allocate_vector_block (void)
 {
-  struct vector_block *block = xmalloc (sizeof *block);
+  struct vector_block *block;
+
+#ifdef EXPERIMENTAL_GC
+  if (posix_memalign
+      ((void **) &block, VECTOR_BLOCK_SIZE, VECTOR_BLOCK_SIZE))
+    abort ();
+  block->bd.mark = 1;
+  block->bd.sweep = 0;
+#else
+  block = xmalloc (sizeof *block);
+#endif
 
 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
   mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
@@ -3096,6 +3164,9 @@
 {
   struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
   struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
+#ifdef EXPERIMENTAL_GC
+    int num_blocks = 0, num_unchanged_blocks = 0;
+#endif
 
   total_vectors = total_vector_slots = total_free_vector_slots = 0;
   memset (vector_free_lists, 0, sizeof (vector_free_lists));
@@ -3159,9 +3230,21 @@
 	  xfree (block);
 	}
       else
-	bprev = &block->next;
+	{
+	  bprev = &block->next;
+#ifdef EXPERIMENTAL_GC
+	  num_blocks++;
+	  num_unchanged_blocks += !block->bd.mark;
+	  block->bd.mark = 0;
+#endif
+	}
     }
 
+#ifdef EXPERIMENTAL_GC
+  fprintf (stderr, "GC%ld: %d of %d vector blocks are unchanged\n",
+	   gcs_done, num_unchanged_blocks, num_blocks);
+#endif
+
   /* Sweep large vectors.  */
 
   for (vector = large_vectors; vector; vector = *vprev)
@@ -3197,6 +3280,53 @@
     }
 }
 
+#ifdef EXPERIMENTAL_GC
+
+/* Return non-zero if V is allocated from block.  */
+
+static inline int
+block_vector (struct Lisp_Vector *v)
+{
+  ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+
+  if (size & PSEUDOVECTOR_FLAG)
+    {
+      ptrdiff_t pvectype = ((v->header.size & PVEC_TYPE_MASK)
+			    >> PSEUDOVECTOR_SIZE_BITS);
+
+      if (pvectype == PVEC_BUFFER || pvectype == PVEC_SUBR)
+	return 0;
+      else if (pvectype == PVEC_BOOL_VECTOR)
+	{
+	  struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) v;
+
+	  return (((b->size + CHAR_BIT - 1) / CHAR_BIT)
+		  + bool_header_size) <= VBLOCK_BYTES_MAX;
+	}
+      else
+	return 1;
+    }
+  return header_size + size * word_size <= VBLOCK_BYTES_MAX;
+}
+
+struct Lisp_Vector *
+vector_write_barrier (struct Lisp_Vector *v)
+{
+  if (!PURE_POINTER_P (v) && block_vector (v))
+    {
+      ptrdiff_t i, size = v->header.size & ~ARRAY_MARK_FLAG;
+
+      if (size & PSEUDOVECTOR_FLAG)
+	size &= PSEUDOVECTOR_SIZE_MASK;
+      VECTOR_BLOCK (v)->bd.mark = 1;
+      for (i = 0; i < size; i++)
+	set_sweep (v->contents[i]);
+    }
+  return v;
+}
+
+#endif /* EXPERIMENTAL_GC */
+
 /* Value is a pointer to a newly allocated Lisp_Vector structure
    with room for LEN Lisp_Objects.  */
 
@@ -3279,6 +3409,35 @@
   return v;
 }
 
+#ifdef EXPERIMENTAL_GC
+
+static void
+setup_buffer (struct buffer *b)
+{
+  ptrdiff_t i, size 
+    = (b->header.size & ~ARRAY_MARK_FLAG) & PSEUDOVECTOR_SIZE_MASK;
+  struct Lisp_Vector *v = (struct Lisp_Vector *) b;
+
+  for (i = 0; i < size; i++)
+    v->contents[i] = Qnil;
+}
+
+struct buffer *
+buffer_write_barrier (struct buffer *b)
+{
+  ptrdiff_t i, size 
+    = (b->header.size & ~ARRAY_MARK_FLAG) & PSEUDOVECTOR_SIZE_MASK;
+  struct Lisp_Vector *v = (struct Lisp_Vector *) b;
+
+  b->bd.mark = 1;
+  for (i = 0; i < size; i++)
+    set_sweep (v->contents[i]);
+
+  return b;
+}
+
+#endif /* EXPERIMENTAL_GC */
+
 struct buffer *
 allocate_buffer (void)
 {
@@ -3286,7 +3445,13 @@
 
   XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
 				     - header_size) / word_size);
+#ifdef EXPERIMENTAL_GC
+  b->bd.mark = 1;
+  b->bd.sweep = 0;
+  setup_buffer (b);
+#else
   /* Note that the fields of B are not initialized.  */
+#endif
   return b;
 }
 
@@ -3461,16 +3626,27 @@
    really allocates in units of powers of two and uses 4 bytes for its
    own overhead.  */
 
-#define SYMBOL_BLOCK_SIZE \
-  ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))
+#define SYMBOL_BLOCK_SIZE				\
+  ((1020 - GC_EXTRA - sizeof (struct symbol_block *))	\
+   / sizeof (union aligned_Lisp_Symbol))
 
 struct symbol_block
 {
   /* Place `symbols' first, to preserve alignment.  */
   union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
+#ifdef EXPERIMENTAL_GC
+  struct blockdata bd;
+#endif
   struct symbol_block *next;
 };
 
+#ifdef EXPERIMENTAL_GC
+
+#define SYMBOL_BLOCK(sptr) \
+  ((struct symbol_block *) ((uintptr_t) (sptr) & ~(BLOCK_ALIGN - 1)))
+
+#endif
+
 /* Current symbol block and index of first unused Lisp_Symbol
    structure in it.  */
 
@@ -3481,6 +3657,27 @@
 
 static struct Lisp_Symbol *symbol_free_list;
 
+#ifdef EXPERIMENTAL_GC
+
+struct Lisp_Symbol *
+symbol_write_barrier (struct Lisp_Symbol *sym) 
+{
+  if (!PURE_POINTER_P (sym))
+    SYMBOL_BLOCK (sym)->bd.mark = 1;
+
+  /* Do not use SVAR, you don't want to go
+     through the barrier recursively.  */
+  set_sweep (sym->INTERNAL_FIELD (xname));
+  if (sym->redirect == 0)
+    set_sweep (sym->INTERNAL_FIELD (val.value));
+  set_sweep (sym->INTERNAL_FIELD (function));
+  set_sweep (sym->INTERNAL_FIELD (plist));
+
+  return sym;
+}
+
+#endif /* EXPERIMENTAL_GC */
+
 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
        doc: /* Return a newly allocated uninterned symbol whose name is NAME.
 Its value and function definition are void, and its property list is nil.  */)
@@ -3504,8 +3701,18 @@
     {
       if (symbol_block_index == SYMBOL_BLOCK_SIZE)
 	{
-	  struct symbol_block *new
-	    = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
+	  struct symbol_block *new;
+#ifdef EXPERIMENTAL_GC
+	  if (posix_memalign ((void **) &new, BLOCK_ALIGN, sizeof *new))
+	    abort ();
+	  mem_insert ((char *) new->symbols,
+		      (char *) new->symbols + sizeof (new->symbols),
+		      MEM_TYPE_SYMBOL);
+          new->bd.mark = 1;
+	  new->bd.sweep = 0;
+#else
+	  new = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
+#endif
 	  new->next = symbol_block;
 	  symbol_block = new;
 	  symbol_block_index = 0;
@@ -3518,11 +3725,11 @@
   MALLOC_UNBLOCK_INPUT;
 
   p = XSYMBOL (val);
-  SVAR (p, xname) = name;
-  SVAR (p, plist) = Qnil;
+  p->INTERNAL_FIELD (xname) = name;
+  p->INTERNAL_FIELD (plist) = Qnil;
   p->redirect = SYMBOL_PLAINVAL;
-  SET_SYMBOL_VAL (p, Qunbound);
-  SVAR (p, function) = Qunbound;
+  p->INTERNAL_FIELD (val.value) = Qunbound;
+  p->INTERNAL_FIELD (function) = Qunbound;
   p->next = NULL;
   p->gcmarkbit = 0;
   p->interned = SYMBOL_UNINTERNED;
@@ -5867,6 +6074,36 @@
     mark_buffer (buffer->base_buffer);
 }
 
+#ifdef EXPERIMENTAL_GC
+
+/* Mark OBJ's block as candidate to sweep.  */
+
+static void
+set_sweep (Lisp_Object obj)
+{
+  if (!INTEGERP (obj) && !PURE_POINTER_P (XPNTR (obj)))
+    switch (XTYPE (obj))
+      {
+        case Lisp_Cons:
+	  CONS_BLOCK (XCONS (obj))->bd.sweep = 1;
+	  break;
+
+        case Lisp_Symbol:
+	  SYMBOL_BLOCK (XSYMBOL (obj))->bd.sweep = 1;
+	  break;
+
+        case Lisp_Vectorlike:
+	  if (block_vector (XVECTOR (obj)))
+	    VECTOR_BLOCK (XVECTOR (obj))->bd.sweep = 1;
+	  break;
+
+        default:
+	  break;
+      }
+}
+
+#endif /* EXPERIMENTAL_GC */
+
 /* Determine type of generic Lisp_Object and mark it accordingly.  */
 
 void
@@ -6287,7 +6524,9 @@
     struct cons_block **cprev = &cons_block;
     register int lim = cons_block_index;
     EMACS_INT num_free = 0, num_used = 0;
-
+#ifdef EXPERIMENTAL_GC
+    int num_blocks = 0, num_unchanged_blocks = 0;
+#endif
     cons_free_list = 0;
 
     for (cblk = cons_block; cblk; cblk = *cprev)
@@ -6352,10 +6591,19 @@
 	  {
 	    num_free += this_free;
 	    cprev = &cblk->next;
+#ifdef EXPERIMENTAL_GC
+	    num_blocks++;
+	    num_unchanged_blocks += !cblk->bd.mark;
+	    cblk->bd.mark = 0;
+#endif
 	  }
       }
     total_conses = num_used;
     total_free_conses = num_free;
+#ifdef EXPERIMENTAL_GC
+    fprintf (stderr, "GC%ld: %d of %d cons blocks are unchanged\n",
+             gcs_done, num_unchanged_blocks, num_blocks);
+#endif
   }
 
   /* Put all unmarked floats on free list */
@@ -6459,6 +6707,9 @@
     struct symbol_block **sprev = &symbol_block;
     register int lim = symbol_block_index;
     EMACS_INT num_free = 0, num_used = 0;
+#ifdef EXPERIMENTAL_GC
+    int num_blocks = 0, num_unchanged_blocks = 0;
+#endif
 
     symbol_free_list = NULL;
 
@@ -6510,10 +6761,19 @@
 	  {
 	    num_free += this_free;
 	    sprev = &sblk->next;
+#ifdef EXPERIMENTAL_GC
+	    num_blocks++;
+	    num_unchanged_blocks += !sblk->bd.mark;
+	    sblk->bd.mark = 0;
+#endif
 	  }
       }
     total_symbols = num_used;
     total_free_symbols = num_free;
+#ifdef EXPERIMENTAL_GC
+    fprintf (stderr, "GC%ld: %d of %d symbol blocks are unchanged\n",
+             gcs_done, num_unchanged_blocks, num_blocks);
+#endif
   }
 
   /* Put all unmarked misc's on free list.
@@ -6576,7 +6836,9 @@
   /* Free all unmarked buffers */
   {
     register struct buffer *buffer = all_buffers, *prev = 0, *next;
-
+#ifdef EXPERIMENTAL_GC
+    int unchanged_buffers = 0;
+#endif
     total_buffers = 0;
     while (buffer)
       if (!VECTOR_MARKED_P (buffer))
@@ -6594,8 +6856,16 @@
 	  VECTOR_UNMARK (buffer);
 	  UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
 	  total_buffers++;
+#ifdef EXPERIMENTAL_GC
+	  unchanged_buffers += !buffer->bd.mark;
+	  buffer->bd.mark = 0;
+#endif
 	  prev = buffer, buffer = buffer->header.next.buffer;
 	}
+#ifdef EXPERIMENTAL_GC
+    fprintf (stderr, "GC%ld: %d of %ld buffers are unchanged\n",
+	     gcs_done, unchanged_buffers, total_buffers);
+#endif    
   }
 
   sweep_vectors ();

=== modified file 'src/buffer.h'
--- src/buffer.h	2012-08-01 08:49:28 +0000
+++ src/buffer.h	2012-08-01 14:52:03 +0000
@@ -474,8 +474,18 @@
 
 /* Most code should use this macro to access Lisp fields in struct buffer.  */
 
+#ifdef EXPERIMENTAL_GC
+
+extern struct buffer * buffer_write_barrier (struct buffer *);
+
+#define BVAR(buf, field) (buffer_write_barrier (buf)->INTERNAL_FIELD (field))
+
+#else
+
 #define BVAR(buf, field) ((buf)->INTERNAL_FIELD (field))
 
+#endif /* EXPERIMENTAL_GC */
+
 /* This is the structure that the buffer Lisp object points to.  */
 
 struct buffer
@@ -851,6 +861,10 @@
   /* Position where the overlay lists are centered.  */
   ptrdiff_t overlay_center;
 
+#ifdef EXPERIMENTAL_GC
+  struct blockdata bd;
+#endif
+
   /* Changes in the buffer are recorded here for undo, and t means
      don't record anything.  This information belongs to the base
      buffer of an indirect buffer.  But we can't store it in the

=== modified file 'src/lisp.h'
--- src/lisp.h	2012-08-01 08:49:28 +0000
+++ src/lisp.h	2012-08-01 14:49:35 +0000
@@ -592,7 +592,28 @@
 
 /* Convenience macros for dealing with Lisp arrays.  */
 
+#ifdef EXPERIMENTAL_GC
+
+struct blockdata
+{
+  /* Non-zero if objects in this block are subject to mark.  */
+  unsigned mark : 1;
+
+  /* Non-zero if objects in this block are subject to sweep.  */
+  unsigned sweep : 1;
+};
+
+struct Lisp_Vector;
+extern struct Lisp_Vector * vector_write_barrier (struct Lisp_Vector *);
+
+#define AREF(ARRAY, IDX) vector_write_barrier (XVECTOR (ARRAY))->contents[IDX]
+
+#else
+
 #define AREF(ARRAY, IDX)	XVECTOR ((ARRAY))->contents[IDX]
+
+#endif /* EXPERIMENTAL_GC */
+
 #define ASIZE(ARRAY)		XVECTOR ((ARRAY))->header.size
 /* The IDX==IDX tries to detect when the macro argument is side-effecting.  */
 #define ASET(ARRAY, IDX, VAL)	\
@@ -671,6 +692,16 @@
 #define XCAR(c)	LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c))
 #define XCDR(c) LISP_MAKE_RVALUE (XCDR_AS_LVALUE (c))
 
+#ifdef EXPERIMENTAL_GC
+
+extern void xsetcar (Lisp_Object, Lisp_Object);
+extern void xsetcdr (Lisp_Object, Lisp_Object);
+
+#define XSETCAR(c,n) xsetcar ((c), (n))
+#define XSETCDR(c,n) xsetcdr ((c), (n))
+
+#else /* not EXPERIMENTAL_GC */
+
 /* Use these to set the fields of a cons cell.
 
    Note that both arguments may refer to the same object, so 'n'
@@ -680,6 +711,8 @@
 #define XSETCAR(c,n) (XCAR_AS_LVALUE (c) = (n))
 #define XSETCDR(c,n) (XCDR_AS_LVALUE (c) = (n))
 
+#endif /* EXPERIMENTAL_GC */
+
 /* Take the car or cdr of something whose type is not known.  */
 #define CAR(c)					\
  (CONSP ((c)) ? XCAR ((c))			\
@@ -1047,8 +1080,18 @@
 /* Most code should use this macro to access
    Lisp fields in struct Lisp_Symbol.  */
 
+#ifdef EXPERIMENTAL_GC
+
+extern struct Lisp_Symbol * symbol_write_barrier (struct Lisp_Symbol *);
+
+#define SVAR(sym, field) (symbol_write_barrier (sym)->INTERNAL_FIELD (field))
+
+#else
+
 #define SVAR(sym, field) ((sym)->INTERNAL_FIELD (field))
 
+#endif /* not EXPERIMENTAL_GC */
+
 struct Lisp_Symbol
 {
   unsigned gcmarkbit : 1;