comparison src/alloc.c @ 91041:bdb3fe0ba9fa

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 866-879) - Merge multi-tty branch - Update from CVS - Merge from emacs--rel--22 Revision: [e-mail]/emacs--unicode--0--patch-257

91040:14c4a6aac623

#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
#include "character.h"
#include "syssignal.h"
#include <setjmp.h>

/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
   memory.  Can do this only if using gmalloc.c.  */

Lisp_Object Vgc_elapsed;	/* accumulated elapsed time in GC  */
EMACS_INT gcs_done;		/* accumulated GCs  */

static void mark_buffer P_ ((Lisp_Object));
extern void mark_kboards P_ ((void));
extern void mark_backtrace P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
static void mark_face_cache P_ ((struct face_cache *));

  MEM_TYPE_CONS,
  MEM_TYPE_STRING,
  MEM_TYPE_MISC,
  MEM_TYPE_SYMBOL,
  MEM_TYPE_FLOAT,
  /* Keep the following vector-like types together, with
     MEM_TYPE_WINDOW being the last, and MEM_TYPE_VECTOR the
     first.  Or change the code of live_vector_p, for instance.  */
  MEM_TYPE_VECTOR,
  MEM_TYPE_PROCESS,
  MEM_TYPE_HASH_TABLE,
  MEM_TYPE_FRAME,
  MEM_TYPE_WINDOW
};

static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
void refill_memory_reserve ();

static struct mem_node mem_z;
#define MEM_NIL &mem_z

static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT, enum mem_type));
static void lisp_free P_ ((POINTER_TYPE *));
static void mark_stack P_ ((void));
static int live_vector_p P_ ((struct mem_node *, void *));
static int live_buffer_p P_ ((struct mem_node *, void *));
static int live_string_p P_ ((struct mem_node *, void *));

#define malloc overrun_check_malloc
#define realloc overrun_check_realloc
#define free overrun_check_free
#endif


/* Like malloc but check for no memory and block interrupt input..  */

POINTER_TYPE *
xmalloc (size)
     size_t size;
{
  register POINTER_TYPE *val;

  BLOCK_INPUT;
  val = (POINTER_TYPE *) malloc (size);
  UNBLOCK_INPUT;

  if (!val && size)
    memory_full ();
  return val;
}

     POINTER_TYPE *block;
     size_t size;
{
  register POINTER_TYPE *val;

  BLOCK_INPUT;
  /* We must call malloc explicitly when BLOCK is 0, since some
     reallocs don't do this.  */
  if (! block)
    val = (POINTER_TYPE *) malloc (size);
  else
    val = (POINTER_TYPE *) realloc (block, size);
  UNBLOCK_INPUT;

  if (!val && size) memory_full ();
  return val;
}

void
xfree (block)
     POINTER_TYPE *block;
{
  BLOCK_INPUT;
  free (block);
  UNBLOCK_INPUT;
  /* We don't call refill_memory_reserve here
     because that duplicates doing so in emacs_blocked_free
     and the criterion should go there.  */
}

     size_t nbytes;
     enum mem_type type;
{
  register void *val;

  BLOCK_INPUT;

#ifdef GC_MALLOC_CHECK
  allocated_mem_type = type;
#endif

#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  if (val && type != MEM_TYPE_NON_LISP)
    mem_insert (val, (char *) val + nbytes, type);
#endif

  UNBLOCK_INPUT;
  if (!val && nbytes)
    memory_full ();
  return val;
}

static void
lisp_free (block)
     POINTER_TYPE *block;
{
  BLOCK_INPUT;
  free (block);
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  mem_delete (mem_find (block));
#endif
  UNBLOCK_INPUT;
}

/* Allocation of aligned blocks of memory to store Lisp data.              */
/* The entry point is lisp_align_malloc which returns blocks of at most    */
/* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary.  */

  void *base, *val;
  struct ablocks *abase;

  eassert (nbytes <= BLOCK_BYTES);

  BLOCK_INPUT;

#ifdef GC_MALLOC_CHECK
  allocated_mem_type = type;
#endif

      abase = ALIGN (base, BLOCK_ALIGN);
#endif

      if (base == 0)
	{
	  UNBLOCK_INPUT;
	  memory_full ();
	}

      aligned = (base == abase);
      if (!aligned)

	  XSETCONS (tem, end);
	  if ((char *) XCONS (tem) != end)
	    {
	      lisp_malloc_loser = base;
	      free (base);
	      UNBLOCK_INPUT;
	      memory_full ();
	    }
	}
#endif

#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  if (val && type != MEM_TYPE_NON_LISP)
    mem_insert (val, (char *) val + nbytes, type);
#endif

  UNBLOCK_INPUT;
  if (!val && nbytes)
    memory_full ();

  eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN);
  return val;

     POINTER_TYPE *block;
{
  struct ablock *ablock = block;
  struct ablocks *abase = ABLOCK_ABASE (ablock);

  BLOCK_INPUT;
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  mem_delete (mem_find (block));
#endif
  /* Put on free list.  */
  ablock->x.next_free = free_ablock;

#ifdef USE_POSIX_MEMALIGN
      eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
#endif
      free (ABLOCKS_BASE (abase));
    }
  UNBLOCK_INPUT;
}

/* Return a new buffer structure allocated from the heap with
   a call to lisp_malloc.  */

   might call malloc, so we can't really protect them unless you're
   using GNU malloc.  Fortunately, most of the major operating systems
   can use GNU malloc.  */

#ifndef SYNC_INPUT

#ifndef DOUG_LEA_MALLOC
extern void * (*__malloc_hook) P_ ((size_t, const void *));
extern void * (*__realloc_hook) P_ ((void *, size_t, const void *));
extern void (*__free_hook) P_ ((void *, const void *));

  void *value;

  BLOCK_INPUT_ALLOC;
  __malloc_hook = old_malloc_hook;
#ifdef DOUG_LEA_MALLOC
    mallopt (M_TOP_PAD, malloc_hysteresis * 4096);
#else
    __malloc_extra_blocks = malloc_hysteresis;
#endif

  value = (void *) malloc (size);

   calls malloc because it is the first call, and we have an endless loop.  */

void
reset_malloc_hooks ()
{
  __free_hook = 0;
  __malloc_hook = 0;
  __realloc_hook = 0;
}
#endif /* HAVE_GTK_AND_PTHREAD */


/* Called from main to set up malloc to use our hooks.  */

{
  INTERVAL val;

  /* eassert (!handling_signal); */

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  if (interval_free_list)
    {
      val = interval_free_list;
      interval_free_list = INTERVAL_PARENT (interval_free_list);

	  n_interval_blocks++;
	}
      val = &interval_block->intervals[interval_block_index++];
    }

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  consing_since_gc += sizeof (struct interval);
  intervals_consed++;
  RESET_INTERVAL (val);
  val->gcmarkbit = 0;

{
  struct Lisp_String *s;

  /* eassert (!handling_signal); */

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  /* If the free-list is empty, allocate a new string_block, and
     add all the Lisp_Strings in it to the free-list.  */
  if (string_free_list == NULL)
    {

  /* Pop a Lisp_String off the free-list.  */
  s = string_free_list;
  string_free_list = NEXT_FREE_LISP_STRING (s);

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  /* Probably not strictly necessary, but play it safe.  */
  bzero (s, sizeof *s);

  --total_free_strings;

     of string data.  */
  needed = SDATA_SIZE (nbytes);
  old_data = s->data ? SDATA_OF_STRING (s) : NULL;
  old_nbytes = GC_STRING_BYTES (s);

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  if (nbytes > LARGE_STRING_BYTES)
    {
      size_t size = sizeof *b - sizeof (struct sdata) + needed;

         In case you think of allowing it in a dumped Emacs at the
         cost of not being able to re-dump, there's another reason:
         mmap'ed data typically have an address towards the top of the
         address space, which won't fit into an EMACS_INT (at least on
         32-bit systems with the current tagging scheme).  --fx  */
      BLOCK_INPUT;
      mallopt (M_MMAP_MAX, 0);
      UNBLOCK_INPUT;
#endif

      b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);

#ifdef DOUG_LEA_MALLOC
      /* Back to a reasonable maximum of mmap'ed areas. */
      BLOCK_INPUT;
      mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
      UNBLOCK_INPUT;
#endif

      b->next_free = &b->first_data;
      b->first_data.string = NULL;
      b->next = large_sblocks;

    b = current_sblock;

  data = b->next_free;
  b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  data->string = s;
  s->data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
  SDATA_NBYTES (data) = nbytes;

		     / BOOL_VECTOR_BITS_PER_CHAR);

  /* We must allocate one more elements than LENGTH_IN_ELTS for the
     slot `size' of the struct Lisp_Bool_Vector.  */
  val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
  p = XBOOL_VECTOR (val);

  /* Get rid of any bits that would cause confusion.  */
  p->vector_size = 0;
  XSETBOOL_VECTOR (val, p);
  p->size = XFASTINT (length);

  real_init = (NILP (init) ? 0 : -1);
  for (i = 0; i < length_in_chars ; i++)
    p->data[i] = real_init;

  /* Clear the extraneous bits in the last byte.  */
  if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
    XBOOL_VECTOR (val)->data[length_in_chars - 1]
      &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;

  return val;
}

{
  register Lisp_Object val;

  /* eassert (!handling_signal); */

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  if (float_free_list)
    {
      /* We use the data field for chaining the free list
	 so that we won't use the same field that has the mark bit.  */

	}
      XSETFLOAT (val, &float_block->floats[float_block_index]);
      float_block_index++;
    }

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  XFLOAT_DATA (val) = float_value;
  eassert (!FLOAT_MARKED_P (XFLOAT (val)));
  consing_since_gc += sizeof (struct Lisp_Float);
  floats_consed++;

{
  register Lisp_Object val;

  /* eassert (!handling_signal); */

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  if (cons_free_list)
    {
      /* We use the cdr for chaining the free list
	 so that we won't use the same field that has the mark bit.  */

	}
      XSETCONS (val, &cons_block->conses[cons_block_index]);
      cons_block_index++;
    }

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  XSETCAR (val, car);
  XSETCDR (val, cdr);
  eassert (!CONS_MARKED_P (XCONS (val)));
  consing_since_gc += sizeof (struct Lisp_Cons);

/* Value is a pointer to a newly allocated Lisp_Vector structure
   with room for LEN Lisp_Objects.  */

static struct Lisp_Vector *
allocate_vectorlike (len, type)
     EMACS_INT len;
     enum mem_type type;
{
  struct Lisp_Vector *p;
  size_t nbytes;

#ifdef DOUG_LEA_MALLOC
  /* Prevent mmap'ing the chunk.  Lisp data may not be mmap'ed
     because mapped region contents are not preserved in
     a dumped Emacs.  */
  BLOCK_INPUT;
  mallopt (M_MMAP_MAX, 0);
  UNBLOCK_INPUT;
#endif

  /* This gets triggered by code which I haven't bothered to fix.  --Stef  */
  /* eassert (!handling_signal); */

  nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
  p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);

#ifdef DOUG_LEA_MALLOC
  /* Back to a reasonable maximum of mmap'ed areas.  */
  BLOCK_INPUT;
  mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
  UNBLOCK_INPUT;
#endif

  consing_since_gc += nbytes;
  vector_cells_consed += len;

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  p->next = all_vectors;
  all_vectors = p;

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  ++n_vectors;
  return p;
}

struct Lisp_Vector *
allocate_vector (nslots)
     EMACS_INT nslots;
{
  struct Lisp_Vector *v = allocate_vectorlike (nslots, MEM_TYPE_VECTOR);
  v->size = nslots;
  return v;
}


/* Allocate other vector-like structures.  */

struct Lisp_Hash_Table *
allocate_hash_table ()
{
  EMACS_INT len = VECSIZE (struct Lisp_Hash_Table);
  struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE);
  EMACS_INT i;

  v->size = len;
  for (i = 0; i < len; ++i)
    v->contents[i] = Qnil;

  return (struct Lisp_Hash_Table *) v;
}


struct window *
allocate_window ()
{
  EMACS_INT len = VECSIZE (struct window);
  struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW);
  EMACS_INT i;

  for (i = 0; i < len; ++i)
    v->contents[i] = Qnil;
  v->size = len;

  return (struct window *) v;
}


struct frame *
allocate_frame ()
{
  EMACS_INT len = VECSIZE (struct frame);
  struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME);
  EMACS_INT i;

  for (i = 0; i < len; ++i)
    v->contents[i] = make_number (0);
  v->size = len;
  return (struct frame *) v;
}


struct Lisp_Process *
allocate_process ()
{
  /* Memory-footprint of the object in nb of Lisp_Object fields.  */
  EMACS_INT memlen = VECSIZE (struct Lisp_Process);
  /* Size if we only count the actual Lisp_Object fields (which need to be
     traced by the GC).  */
  EMACS_INT lisplen = PSEUDOVECSIZE (struct Lisp_Process, pid);
  struct Lisp_Vector *v = allocate_vectorlike (memlen, MEM_TYPE_PROCESS);
  EMACS_INT i;

  for (i = 0; i < lisplen; ++i)
    v->contents[i] = Qnil;
  v->size = lisplen;

  return (struct Lisp_Process *) v;
}


struct Lisp_Vector *
allocate_other_vector (len)
     EMACS_INT len;
{
  struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR);
  EMACS_INT i;

  for (i = 0; i < len; ++i)
    v->contents[i] = Qnil;
  v->size = len;

  p = allocate_vector (sizei);
  for (index = 0; index < sizei; index++)
    p->contents[index] = init;

  XSETVECTOR (vector, p);
  return vector;
}


DEFUN ("vector", Fvector, Svector, 0, MANY, 0,

    {
      if (!NILP (Vpurify_flag))
	args[index] = Fpurecopy (args[index]);
      p->contents[index] = args[index];
    }
  XSETCOMPILED (val, p);
  return val;
}

  CHECK_STRING (name);

  /* eassert (!handling_signal); */

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  if (symbol_free_list)
    {
      XSETSYMBOL (val, symbol_free_list);
      symbol_free_list = symbol_free_list->next;

	}
      XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
      symbol_block_index++;
    }

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  p = XSYMBOL (val);
  p->xname = name;
  p->plist = Qnil;
  p->value = Qunbound;

{
  Lisp_Object val;

  /* eassert (!handling_signal); */

#ifndef SYNC_INPUT
  BLOCK_INPUT;
#endif

  if (marker_free_list)
    {
      XSETMISC (val, marker_free_list);
      marker_free_list = marker_free_list->u_free.chain;

	}
      XSETMISC (val, &marker_block->markers[marker_block_index]);
      marker_block_index++;
    }

#ifndef SYNC_INPUT
  UNBLOCK_INPUT;
#endif

  --total_free_markers;
  consing_since_gc += sizeof (union Lisp_Misc);
  misc_objects_consed++;
  XMARKER (val)->gcmarkbit = 0;

static INLINE int
live_vector_p (m, p)
     struct mem_node *m;
     void *p;
{
  return (p == m->start
	  && m->type >= MEM_TYPE_VECTOR
	  && m->type <= MEM_TYPE_WINDOW);
}


/* Value is non-zero if P is a pointer to a live buffer.  M is a
   pointer to the mem_block for P.  */

	case MEM_TYPE_FLOAT:
	  if (live_float_p (m, p) && !FLOAT_MARKED_P (p))
	    XSETFLOAT (obj, p);
	  break;

	case MEM_TYPE_VECTOR:
	case MEM_TYPE_PROCESS:
	case MEM_TYPE_HASH_TABLE:
	case MEM_TYPE_FRAME:
	case MEM_TYPE_WINDOW:
	  if (live_vector_p (m, p))
	    {
	      Lisp_Object tem;
	      XSETVECTOR (tem, p);
	      if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))

      return live_symbol_p (m, p);

    case MEM_TYPE_FLOAT:
      return live_float_p (m, p);

    case MEM_TYPE_VECTOR:
    case MEM_TYPE_PROCESS:
    case MEM_TYPE_HASH_TABLE:
    case MEM_TYPE_FRAME:
    case MEM_TYPE_WINDOW:
      return live_vector_p (m, p);

    default:
      break;
    }

  for (bind = specpdl; bind != specpdl_ptr; bind++)
    {
      mark_object (bind->symbol);
      mark_object (bind->old_value);
    }
  mark_kboards ();

#ifdef USE_GTK
  {
    extern void xg_mark_data ();
    xg_mark_data ();

   links of a list, in mark_object.  In debugging,
   the call to abort will hit a breakpoint.
   Normally this is zero and the check never goes off.  */
int mark_object_loop_halt;

void
mark_object (arg)
     Lisp_Object arg;
{
  register Lisp_Object obj = arg;

	  goto loop;
	}
      else if (FRAMEP (obj))
	{
	  register struct frame *ptr = XFRAME (obj);

	  if (VECTOR_MARKED_P (ptr)) break;   /* Already marked */
	  VECTOR_MARK (ptr);		      /* Else mark it */

	  CHECK_LIVE (live_vector_p);
	  mark_object (ptr->name);
	  mark_object (ptr->icon_name);
	  mark_object (ptr->title);
	  mark_object (ptr->focus_frame);
	  mark_object (ptr->selected_window);
	  mark_object (ptr->minibuffer_window);
	  mark_object (ptr->param_alist);
	  mark_object (ptr->scroll_bars);
	  mark_object (ptr->condemned_scroll_bars);
	  mark_object (ptr->menu_bar_items);
	  mark_object (ptr->face_alist);
	  mark_object (ptr->menu_bar_vector);
	  mark_object (ptr->buffer_predicate);
	  mark_object (ptr->buffer_list);
	  mark_object (ptr->menu_bar_window);
	  mark_object (ptr->tool_bar_window);
	  mark_face_cache (ptr->face_cache);
#ifdef HAVE_WINDOW_SYSTEM
	  mark_image_cache (ptr);
	  mark_object (ptr->tool_bar_items);
	  mark_object (ptr->desired_tool_bar_string);
	  mark_object (ptr->current_tool_bar_string);
#endif /* HAVE_WINDOW_SYSTEM */
	}
      else if (BOOL_VECTOR_P (obj))
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);

	  if (VECTOR_MARKED_P (ptr))
	    break;   /* Already marked */
	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);	/* Else mark it */
	}
      else if (WINDOWP (obj))
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  struct window *w = XWINDOW (obj);
	  register int i;

	  /* Stop if already marked.  */
	  if (VECTOR_MARKED_P (ptr))
	    break;

	  /* Mark it.  */
	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);

	  /* There is no Lisp data above The member CURRENT_MATRIX in
	     struct WINDOW.  Stop marking when that slot is reached.  */
	  for (i = 0;
	       (char *) &ptr->contents[i] < (char *) &w->current_matrix;
	       i++)
	    mark_object (ptr->contents[i]);

	  /* Mark glyphs for leaf windows.  Marking window matrices is
	     sufficient because frame matrices use the same glyph
	     memory.  */
	  if (NILP (w->hchild)
	      && NILP (w->vchild)
	      && w->current_matrix)
	    {
	      mark_glyph_matrix (w->current_matrix);
	      mark_glyph_matrix (w->desired_matrix);
	    }
	}
      else if (HASH_TABLE_P (obj))
	{
	  struct Lisp_Hash_Table *h = XHASH_TABLE (obj);

	  /* Stop if already marked.  */
	  if (VECTOR_MARKED_P (h))
	    break;

	  /* Mark it.  */
	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (h);

	  /* Mark contents.  */
	  /* Do not mark next_free or next_weak.
	     Being in the next_weak chain
	     should not keep the hash table alive.
	     No need to mark `count' since it is an integer.  */
	  mark_object (h->test);
	  mark_object (h->weak);
	  mark_object (h->rehash_size);
	  mark_object (h->rehash_threshold);
	  mark_object (h->hash);
	  mark_object (h->next);
	  mark_object (h->index);
	  mark_object (h->user_hash_function);
	  mark_object (h->user_cmp_function);

	  /* If hash table is not weak, mark all keys and values.
	     For weak tables, mark only the vector.  */
	  if (NILP (h->weak))
	    mark_object (h->key_and_value);
	  else
	    VECTOR_MARK (XVECTOR (h->key_and_value));
	}
      else
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  register EMACS_INT size = ptr->size;
	  register int i;

	  if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);	/* Else mark it */
	  if (size & PSEUDOVECTOR_FLAG)
	    size &= PSEUDOVECTOR_SIZE_MASK;

	  /* Note that this size is not the memory-footprint size, but only
	     the number of Lisp_Object fields that we should trace.
	     The distinction is used e.g. by Lisp_Process which places extra
	     non-Lisp_Object fields at the end of the structure.  */
	  for (i = 0; i < size; i++) /* and then mark its elements */
	    mark_object (ptr->contents[i]);
	}
      break;

    case Lisp_Symbol:
      {
	register struct Lisp_Symbol *ptr = XSYMBOL (obj);

      XSETBUFFER (base_buffer, buffer->base_buffer);
      mark_buffer (base_buffer);
    }
}


/* Value is non-zero if OBJ will survive the current GC because it's
   either marked or does not need to be marked to survive.  */

int

    cons_free_list = 0;

    for (cblk = cons_block; cblk; cblk = *cprev)
      {
	register int i;
	int this_free = 0;
	for (i = 0; i < lim; i++)
	  if (!CONS_MARKED_P (&cblk->conses[i]))
	    {
	      this_free++;
	      cblk->conses[i].u.chain = cons_free_list;
	      cons_free_list = &cblk->conses[i];
#if GC_MARK_STACK
	      cons_free_list->car = Vdead;
#endif
	    }
	  else
	    {
	      num_used++;
	      CONS_UNMARK (&cblk->conses[i]);
	    }
	lim = CONS_BLOCK_SIZE;
	/* If this block contains only free conses and we have already
	   seen more than two blocks worth of free conses then deallocate
	   this block.  */
	if (this_free == CONS_BLOCK_SIZE && num_free > CONS_BLOCK_SIZE)

91041:bdb3fe0ba9fa

#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
#include "character.h"
#include "syssignal.h"
#include "termhooks.h"		/* For struct terminal.  */
#include <setjmp.h>

/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
   memory.  Can do this only if using gmalloc.c.  */

Lisp_Object Vgc_elapsed;	/* accumulated elapsed time in GC  */
EMACS_INT gcs_done;		/* accumulated GCs  */

static void mark_buffer P_ ((Lisp_Object));
static void mark_terminals P_ ((void));
extern void mark_kboards P_ ((void));
extern void mark_ttys P_ ((void));
extern void mark_backtrace P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
static void mark_face_cache P_ ((struct face_cache *));

  MEM_TYPE_CONS,
  MEM_TYPE_STRING,
  MEM_TYPE_MISC,
  MEM_TYPE_SYMBOL,
  MEM_TYPE_FLOAT,
  /* We used to keep separate mem_types for subtypes of vectors such as
     process, hash_table, frame, terminal, and window, but we never made
     use of the distinction, so it only caused source-code complexity
     and runtime slowdown.  Minor but pointless.  */
  MEM_TYPE_VECTORLIKE
};

static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
void refill_memory_reserve ();

static struct mem_node mem_z;
#define MEM_NIL &mem_z

static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT));
static void lisp_free P_ ((POINTER_TYPE *));
static void mark_stack P_ ((void));
static int live_vector_p P_ ((struct mem_node *, void *));
static int live_buffer_p P_ ((struct mem_node *, void *));
static int live_string_p P_ ((struct mem_node *, void *));

#define malloc overrun_check_malloc
#define realloc overrun_check_realloc
#define free overrun_check_free
#endif

#ifdef SYNC_INPUT
/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
   there's no need to block input around malloc.  */
#define MALLOC_BLOCK_INPUT   ((void)0)
#define MALLOC_UNBLOCK_INPUT ((void)0)
#else
#define MALLOC_BLOCK_INPUT   BLOCK_INPUT
#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
#endif

/* Like malloc but check for no memory and block interrupt input..  */

POINTER_TYPE *
xmalloc (size)
     size_t size;
{
  register POINTER_TYPE *val;

  MALLOC_BLOCK_INPUT;
  val = (POINTER_TYPE *) malloc (size);
  MALLOC_UNBLOCK_INPUT;

  if (!val && size)
    memory_full ();
  return val;
}

     POINTER_TYPE *block;
     size_t size;
{
  register POINTER_TYPE *val;

  MALLOC_BLOCK_INPUT;
  /* We must call malloc explicitly when BLOCK is 0, since some
     reallocs don't do this.  */
  if (! block)
    val = (POINTER_TYPE *) malloc (size);
  else
    val = (POINTER_TYPE *) realloc (block, size);
  MALLOC_UNBLOCK_INPUT;

  if (!val && size) memory_full ();
  return val;
}

void
xfree (block)
     POINTER_TYPE *block;
{
  MALLOC_BLOCK_INPUT;
  free (block);
  MALLOC_UNBLOCK_INPUT;
  /* We don't call refill_memory_reserve here
     because that duplicates doing so in emacs_blocked_free
     and the criterion should go there.  */
}

     size_t nbytes;
     enum mem_type type;
{
  register void *val;

  MALLOC_BLOCK_INPUT;

#ifdef GC_MALLOC_CHECK
  allocated_mem_type = type;
#endif

#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  if (val && type != MEM_TYPE_NON_LISP)
    mem_insert (val, (char *) val + nbytes, type);
#endif

  MALLOC_UNBLOCK_INPUT;
  if (!val && nbytes)
    memory_full ();
  return val;
}

static void
lisp_free (block)
     POINTER_TYPE *block;
{
  MALLOC_BLOCK_INPUT;
  free (block);
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  mem_delete (mem_find (block));
#endif
  MALLOC_UNBLOCK_INPUT;
}

/* Allocation of aligned blocks of memory to store Lisp data.              */
/* The entry point is lisp_align_malloc which returns blocks of at most    */
/* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary.  */

  void *base, *val;
  struct ablocks *abase;

  eassert (nbytes <= BLOCK_BYTES);

  MALLOC_BLOCK_INPUT;

#ifdef GC_MALLOC_CHECK
  allocated_mem_type = type;
#endif

      abase = ALIGN (base, BLOCK_ALIGN);
#endif

      if (base == 0)
	{
	  MALLOC_UNBLOCK_INPUT;
	  memory_full ();
	}

      aligned = (base == abase);
      if (!aligned)

	  XSETCONS (tem, end);
	  if ((char *) XCONS (tem) != end)
	    {
	      lisp_malloc_loser = base;
	      free (base);
	      MALLOC_UNBLOCK_INPUT;
	      memory_full ();
	    }
	}
#endif

#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  if (val && type != MEM_TYPE_NON_LISP)
    mem_insert (val, (char *) val + nbytes, type);
#endif

  MALLOC_UNBLOCK_INPUT;
  if (!val && nbytes)
    memory_full ();

  eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN);
  return val;

     POINTER_TYPE *block;
{
  struct ablock *ablock = block;
  struct ablocks *abase = ABLOCK_ABASE (ablock);

  MALLOC_BLOCK_INPUT;
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  mem_delete (mem_find (block));
#endif
  /* Put on free list.  */
  ablock->x.next_free = free_ablock;

#ifdef USE_POSIX_MEMALIGN
      eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
#endif
      free (ABLOCKS_BASE (abase));
    }
  MALLOC_UNBLOCK_INPUT;
}

/* Return a new buffer structure allocated from the heap with
   a call to lisp_malloc.  */

   might call malloc, so we can't really protect them unless you're
   using GNU malloc.  Fortunately, most of the major operating systems
   can use GNU malloc.  */

#ifndef SYNC_INPUT
/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
   there's no need to block input around malloc.  */

#ifndef DOUG_LEA_MALLOC
extern void * (*__malloc_hook) P_ ((size_t, const void *));
extern void * (*__realloc_hook) P_ ((void *, size_t, const void *));
extern void (*__free_hook) P_ ((void *, const void *));

  void *value;

  BLOCK_INPUT_ALLOC;
  __malloc_hook = old_malloc_hook;
#ifdef DOUG_LEA_MALLOC
  /* Segfaults on my system.  --lorentey */
  /* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */
#else
    __malloc_extra_blocks = malloc_hysteresis;
#endif

  value = (void *) malloc (size);

   calls malloc because it is the first call, and we have an endless loop.  */

void
reset_malloc_hooks ()
{
  __free_hook = old_free_hook;
  __malloc_hook = old_malloc_hook;
  __realloc_hook = old_realloc_hook;
}
#endif /* HAVE_GTK_AND_PTHREAD */


/* Called from main to set up malloc to use our hooks.  */

{
  INTERVAL val;

  /* eassert (!handling_signal); */

  MALLOC_BLOCK_INPUT;

  if (interval_free_list)
    {
      val = interval_free_list;
      interval_free_list = INTERVAL_PARENT (interval_free_list);

	  n_interval_blocks++;
	}
      val = &interval_block->intervals[interval_block_index++];
    }

  MALLOC_UNBLOCK_INPUT;

  consing_since_gc += sizeof (struct interval);
  intervals_consed++;
  RESET_INTERVAL (val);
  val->gcmarkbit = 0;

{
  struct Lisp_String *s;

  /* eassert (!handling_signal); */

  MALLOC_BLOCK_INPUT;

  /* If the free-list is empty, allocate a new string_block, and
     add all the Lisp_Strings in it to the free-list.  */
  if (string_free_list == NULL)
    {

  /* Pop a Lisp_String off the free-list.  */
  s = string_free_list;
  string_free_list = NEXT_FREE_LISP_STRING (s);

  MALLOC_UNBLOCK_INPUT;

  /* Probably not strictly necessary, but play it safe.  */
  bzero (s, sizeof *s);

  --total_free_strings;

     of string data.  */
  needed = SDATA_SIZE (nbytes);
  old_data = s->data ? SDATA_OF_STRING (s) : NULL;
  old_nbytes = GC_STRING_BYTES (s);

  MALLOC_BLOCK_INPUT;

  if (nbytes > LARGE_STRING_BYTES)
    {
      size_t size = sizeof *b - sizeof (struct sdata) + needed;

         In case you think of allowing it in a dumped Emacs at the
         cost of not being able to re-dump, there's another reason:
         mmap'ed data typically have an address towards the top of the
         address space, which won't fit into an EMACS_INT (at least on
         32-bit systems with the current tagging scheme).  --fx  */
      mallopt (M_MMAP_MAX, 0);
#endif

      b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);

#ifdef DOUG_LEA_MALLOC
      /* Back to a reasonable maximum of mmap'ed areas. */
      mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif

      b->next_free = &b->first_data;
      b->first_data.string = NULL;
      b->next = large_sblocks;

    b = current_sblock;

  data = b->next_free;
  b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);

  MALLOC_UNBLOCK_INPUT;

  data->string = s;
  s->data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
  SDATA_NBYTES (data) = nbytes;

		     / BOOL_VECTOR_BITS_PER_CHAR);

  /* We must allocate one more elements than LENGTH_IN_ELTS for the
     slot `size' of the struct Lisp_Bool_Vector.  */
  val = Fmake_vector (make_number (length_in_elts + 1), Qnil);

  /* Get rid of any bits that would cause confusion.  */
  XVECTOR (val)->size = 0;	/* No Lisp_Object to trace in there.  */
  /* Use  XVECTOR (val) rather than `p' because p->size is not TRT. */
  XSETPVECTYPE (XVECTOR (val), PVEC_BOOL_VECTOR);

  p = XBOOL_VECTOR (val);
  p->size = XFASTINT (length);

  real_init = (NILP (init) ? 0 : -1);
  for (i = 0; i < length_in_chars ; i++)
    p->data[i] = real_init;

  /* Clear the extraneous bits in the last byte.  */
  if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
    p->data[length_in_chars - 1]
      &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;

  return val;
}

{
  register Lisp_Object val;

  /* eassert (!handling_signal); */

  MALLOC_BLOCK_INPUT;

  if (float_free_list)
    {
      /* We use the data field for chaining the free list
	 so that we won't use the same field that has the mark bit.  */

	}
      XSETFLOAT (val, &float_block->floats[float_block_index]);
      float_block_index++;
    }

  MALLOC_UNBLOCK_INPUT;

  XFLOAT_DATA (val) = float_value;
  eassert (!FLOAT_MARKED_P (XFLOAT (val)));
  consing_since_gc += sizeof (struct Lisp_Float);
  floats_consed++;

{
  register Lisp_Object val;

  /* eassert (!handling_signal); */

  MALLOC_BLOCK_INPUT;

  if (cons_free_list)
    {
      /* We use the cdr for chaining the free list
	 so that we won't use the same field that has the mark bit.  */

	}
      XSETCONS (val, &cons_block->conses[cons_block_index]);
      cons_block_index++;
    }

  MALLOC_UNBLOCK_INPUT;

  XSETCAR (val, car);
  XSETCDR (val, cdr);
  eassert (!CONS_MARKED_P (XCONS (val)));
  consing_since_gc += sizeof (struct Lisp_Cons);

/* Value is a pointer to a newly allocated Lisp_Vector structure
   with room for LEN Lisp_Objects.  */

static struct Lisp_Vector *
allocate_vectorlike (len)
     EMACS_INT len;
{
  struct Lisp_Vector *p;
  size_t nbytes;

  MALLOC_BLOCK_INPUT;

#ifdef DOUG_LEA_MALLOC
  /* Prevent mmap'ing the chunk.  Lisp data may not be mmap'ed
     because mapped region contents are not preserved in
     a dumped Emacs.  */
  mallopt (M_MMAP_MAX, 0);
#endif

  /* This gets triggered by code which I haven't bothered to fix.  --Stef  */
  /* eassert (!handling_signal); */

  nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
  p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);

#ifdef DOUG_LEA_MALLOC
  /* Back to a reasonable maximum of mmap'ed areas.  */
  mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif

  consing_since_gc += nbytes;
  vector_cells_consed += len;

  p->next = all_vectors;
  all_vectors = p;

  MALLOC_UNBLOCK_INPUT;

  ++n_vectors;
  return p;
}

struct Lisp_Vector *
allocate_vector (nslots)
     EMACS_INT nslots;
{
  struct Lisp_Vector *v = allocate_vectorlike (nslots);
  v->size = nslots;
  return v;
}


/* Allocate other vector-like structures.  */

static struct Lisp_Vector *
allocate_pseudovector (memlen, lisplen, tag)
     int memlen, lisplen;
     EMACS_INT tag;
{
  struct Lisp_Vector *v = allocate_vectorlike (memlen);
  EMACS_INT i;

  /* Only the first lisplen slots will be traced normally by the GC.  */
  v->size = lisplen;
  for (i = 0; i < lisplen; ++i)
    v->contents[i] = Qnil;

  XSETPVECTYPE (v, tag);	/* Add the appropriate tag.  */
  return v;
}
#define ALLOCATE_PSEUDOVECTOR(typ,field,tag)				\
  ((typ*)								\
   allocate_pseudovector						\
       (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag))

struct Lisp_Hash_Table *
allocate_hash_table (void)
{
  return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
}


struct window *
allocate_window ()
{
  return ALLOCATE_PSEUDOVECTOR(struct window, current_matrix, PVEC_WINDOW);
}


struct terminal *
allocate_terminal ()
{
  struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal,
					      next_terminal, PVEC_TERMINAL);
  /* Zero out the non-GC'd fields.  FIXME: This should be made unnecessary.  */
  bzero (&(t->next_terminal),
	 ((char*)(t+1)) - ((char*)&(t->next_terminal)));

  return t;
}

struct frame *
allocate_frame ()
{
  struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame,
					   face_cache, PVEC_FRAME);
  /* Zero out the non-GC'd fields.  FIXME: This should be made unnecessary.  */
  bzero (&(f->face_cache),
	 ((char*)(f+1)) - ((char*)&(f->face_cache)));
  return f;
}


struct Lisp_Process *
allocate_process ()
{
  return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
}


/* Only used for PVEC_WINDOW_CONFIGURATION. */
struct Lisp_Vector *
allocate_other_vector (len)
     EMACS_INT len;
{
  struct Lisp_Vector *v = allocate_vectorlike (len);
  EMACS_INT i;

  for (i = 0; i < len; ++i)
    v->contents[i] = Qnil;
  v->size = len;

  p = allocate_vector (sizei);
  for (index = 0; index < sizei; index++)
    p->contents[index] = init;

  XSETVECTOR (vector, p);
  return vector;
}


DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
       doc: /* Return a newly created char-table, with purpose PURPOSE.
Each element is initialized to INIT, which defaults to nil.
PURPOSE should be a symbol which has a `char-table-extra-slots' property.
The property's value should be an integer between 0 and 10.  */)
     (purpose, init)
     register Lisp_Object purpose, init;
{
  Lisp_Object vector;
  Lisp_Object n;
  CHECK_SYMBOL (purpose);
  n = Fget (purpose, Qchar_table_extra_slots);
  CHECK_NUMBER (n);
  if (XINT (n) < 0 || XINT (n) > 10)
    args_out_of_range (n, Qnil);
  /* Add 2 to the size for the defalt and parent slots.  */
  vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
			 init);
  XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
  XCHAR_TABLE (vector)->top = Qt;
  XCHAR_TABLE (vector)->parent = Qnil;
  XCHAR_TABLE (vector)->purpose = purpose;
  XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
  return vector;
}


/* Return a newly created sub char table with slots initialized by INIT.
   Since a sub char table does not appear as a top level Emacs Lisp
   object, we don't need a Lisp interface to make it.  */

Lisp_Object
make_sub_char_table (init)
     Lisp_Object init;
{
  Lisp_Object vector
    = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init);
  XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
  XCHAR_TABLE (vector)->top = Qnil;
  XCHAR_TABLE (vector)->defalt = Qnil;
  XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
  return vector;
}


DEFUN ("vector", Fvector, Svector, 0, MANY, 0,

    {
      if (!NILP (Vpurify_flag))
	args[index] = Fpurecopy (args[index]);
      p->contents[index] = args[index];
    }
  XSETPVECTYPE (p, PVEC_COMPILED);
  XSETCOMPILED (val, p);
  return val;
}

  CHECK_STRING (name);

  /* eassert (!handling_signal); */

  MALLOC_BLOCK_INPUT;

  if (symbol_free_list)
    {
      XSETSYMBOL (val, symbol_free_list);
      symbol_free_list = symbol_free_list->next;

	}
      XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
      symbol_block_index++;
    }

  MALLOC_UNBLOCK_INPUT;

  p = XSYMBOL (val);
  p->xname = name;
  p->plist = Qnil;
  p->value = Qunbound;

{
  Lisp_Object val;

  /* eassert (!handling_signal); */

  MALLOC_BLOCK_INPUT;

  if (marker_free_list)
    {
      XSETMISC (val, marker_free_list);
      marker_free_list = marker_free_list->u_free.chain;

	}
      XSETMISC (val, &marker_block->markers[marker_block_index]);
      marker_block_index++;
    }

  MALLOC_UNBLOCK_INPUT;

  --total_free_markers;
  consing_since_gc += sizeof (union Lisp_Misc);
  misc_objects_consed++;
  XMARKER (val)->gcmarkbit = 0;

static INLINE int
live_vector_p (m, p)
     struct mem_node *m;
     void *p;
{
  return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
}


/* Value is non-zero if P is a pointer to a live buffer.  M is a
   pointer to the mem_block for P.  */

	case MEM_TYPE_FLOAT:
	  if (live_float_p (m, p) && !FLOAT_MARKED_P (p))
	    XSETFLOAT (obj, p);
	  break;

	case MEM_TYPE_VECTORLIKE:
	  if (live_vector_p (m, p))
	    {
	      Lisp_Object tem;
	      XSETVECTOR (tem, p);
	      if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))

      return live_symbol_p (m, p);

    case MEM_TYPE_FLOAT:
      return live_float_p (m, p);

    case MEM_TYPE_VECTORLIKE:
      return live_vector_p (m, p);

    default:
      break;
    }

  for (bind = specpdl; bind != specpdl_ptr; bind++)
    {
      mark_object (bind->symbol);
      mark_object (bind->old_value);
    }
  mark_terminals ();
  mark_kboards ();
  mark_ttys ();

#ifdef USE_GTK
  {
    extern void xg_mark_data ();
    xg_mark_data ();

   links of a list, in mark_object.  In debugging,
   the call to abort will hit a breakpoint.
   Normally this is zero and the check never goes off.  */
int mark_object_loop_halt;

/* Return non-zero if the object was not yet marked.  */
static int
mark_vectorlike (ptr)
     struct Lisp_Vector *ptr;
{
  register EMACS_INT size = ptr->size;
  register int i;

  if (VECTOR_MARKED_P (ptr))
    return 0;			/* Already marked */
  VECTOR_MARK (ptr);		/* Else mark it */
  if (size & PSEUDOVECTOR_FLAG)
    size &= PSEUDOVECTOR_SIZE_MASK;
  
  /* Note that this size is not the memory-footprint size, but only
     the number of Lisp_Object fields that we should trace.
     The distinction is used e.g. by Lisp_Process which places extra
     non-Lisp_Object fields at the end of the structure.  */
  for (i = 0; i < size; i++) /* and then mark its elements */
    mark_object (ptr->contents[i]);
  return 1;
}

void
mark_object (arg)
     Lisp_Object arg;
{
  register Lisp_Object obj = arg;

	  goto loop;
	}
      else if (FRAMEP (obj))
	{
	  register struct frame *ptr = XFRAME (obj);
	  if (mark_vectorlike (XVECTOR (obj)))
	    {
	      mark_face_cache (ptr->face_cache);
#ifdef HAVE_WINDOW_SYSTEM
	      mark_image_cache (ptr);
#endif /* HAVE_WINDOW_SYSTEM */
	    }
	}
      else if (WINDOWP (obj))
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  struct window *w = XWINDOW (obj);
	  if (mark_vectorlike (ptr))
	    {
	      /* Mark glyphs for leaf windows.  Marking window matrices is
		 sufficient because frame matrices use the same glyph
		 memory.  */
	      if (NILP (w->hchild)
		  && NILP (w->vchild)
		  && w->current_matrix)
		{
		  mark_glyph_matrix (w->current_matrix);
		  mark_glyph_matrix (w->desired_matrix);
		}
	    }
	}
      else if (HASH_TABLE_P (obj))
	{
	  struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
	  if (mark_vectorlike ((struct Lisp_Vector *)h))
	    { /* If hash table is not weak, mark all keys and values.
		 For weak tables, mark only the vector.  */
	      if (NILP (h->weak))
		mark_object (h->key_and_value);
	      else
		VECTOR_MARK (XVECTOR (h->key_and_value));
	    }
	}
      else
	mark_vectorlike (XVECTOR (obj));
      break;

    case Lisp_Symbol:
      {
	register struct Lisp_Symbol *ptr = XSYMBOL (obj);

      XSETBUFFER (base_buffer, buffer->base_buffer);
      mark_buffer (base_buffer);
    }
}

/* Mark the Lisp pointers in the terminal objects.
   Called by the Fgarbage_collector.  */

static void
mark_terminals (void)
{
  struct terminal *t;
  for (t = terminal_list; t; t = t->next_terminal)
    {
      eassert (t->name != NULL);
      mark_vectorlike ((struct Lisp_Vector *)t);
    }
}



/* Value is non-zero if OBJ will survive the current GC because it's
   either marked or does not need to be marked to survive.  */

int

    cons_free_list = 0;

    for (cblk = cons_block; cblk; cblk = *cprev)
      {
	register int i = 0;
	int this_free = 0;
	int ilim = (lim + BITS_PER_INT - 1) / BITS_PER_INT;

	/* Scan the mark bits an int at a time.  */
	for (i = 0; i <= ilim; i++)
	  {
	    if (cblk->gcmarkbits[i] == -1)
	      {
		/* Fast path - all cons cells for this int are marked.  */
		cblk->gcmarkbits[i] = 0;
		num_used += BITS_PER_INT;
	      }
	    else
	      {
		/* Some cons cells for this int are not marked.
		   Find which ones, and free them.  */
		int start, pos, stop;

		start = i * BITS_PER_INT;
		stop = lim - start;
		if (stop > BITS_PER_INT)
		  stop = BITS_PER_INT;
		stop += start;

		for (pos = start; pos < stop; pos++)
		  {
		    if (!CONS_MARKED_P (&cblk->conses[pos]))
		      {
			this_free++;
			cblk->conses[pos].u.chain = cons_free_list;
			cons_free_list = &cblk->conses[pos];
#if GC_MARK_STACK
			cons_free_list->car = Vdead;
#endif
		      }
		    else
		      {
			num_used++;
			CONS_UNMARK (&cblk->conses[pos]);
		      }
		  }
	      }
	  }

	lim = CONS_BLOCK_SIZE;
	/* If this block contains only free conses and we have already
	   seen more than two blocks worth of free conses then deallocate
	   this block.  */
	if (this_free == CONS_BLOCK_SIZE && num_free > CONS_BLOCK_SIZE)