comparison src/alloc.c @ 89518:c9f7a2f363ca

Sync with HEAD version.

89517:d5ec115216af

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


/* Like free but block interrupt input..  */

void
xfree (block)
     POINTER_TYPE *block;
{

/* Pointer to the (not necessarily aligned) malloc block.  */
#ifdef HAVE_POSIX_MEMALIGN
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
  (1 & (int) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
#endif

/* The list of free ablock.   */
static struct ablock *free_ablock;

  allocated_mem_type = type;
#endif

  if (!free_ablock)
    {
      int i, aligned;

#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.  */

	{
	  abase->blocks[i].abase = abase;
	  abase->blocks[i].x.next_free = free_ablock;
	  free_ablock = &abase->blocks[i];
	}
      ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;

      eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN);
      eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
      eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
      eassert (ABLOCKS_BASE (abase) == base);
      eassert (aligned == (int)ABLOCKS_BUSY (abase));
    }

  abase = ABLOCK_ABASE (free_ablock);
  ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (int) ABLOCKS_BUSY (abase));
  val = free_ablock;
  free_ablock = free_ablock->x.next_free;

#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  if (val && type != MEM_TYPE_NON_LISP)

#endif
  /* Put on free list.  */
  ablock->x.next_free = free_ablock;
  free_ablock = ablock;
  /* Update busy count.  */
  ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (int) ABLOCKS_BUSY (abase));
  
  if (2 > (int) ABLOCKS_BUSY (abase))
    { /* All the blocks are free.  */
      int i = 0, aligned = (int) ABLOCKS_BUSY (abase);
      struct ablock **tem = &free_ablock;
      struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];

      while (*tem)
	{

/* Initialize interval allocation.  */

static void
init_intervals ()
{
  interval_block
    = (struct interval_block *) lisp_malloc (sizeof *interval_block,
					     MEM_TYPE_NON_LISP);
  interval_block->next = 0;
  bzero ((char *) interval_block->intervals, sizeof interval_block->intervals);
  interval_block_index = 0;
  interval_free_list = 0;
  n_interval_blocks = 1;
}


/* Return a new interval.  */

/* Initialize symbol allocation.  */

void
init_symbol ()
{
  symbol_block = (struct symbol_block *) lisp_malloc (sizeof *symbol_block,
						      MEM_TYPE_SYMBOL);
  symbol_block->next = 0;
  bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols);
  symbol_block_index = 0;
  symbol_free_list = 0;
  n_symbol_blocks = 1;
}


DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
       doc: /* Return a newly allocated uninterned symbol whose name is NAME.

int n_marker_blocks;

void
init_marker ()
{
  marker_block = (struct marker_block *) lisp_malloc (sizeof *marker_block,
						      MEM_TYPE_MISC);
  marker_block->next = 0;
  bzero ((char *) marker_block->markers, sizeof marker_block->markers);
  marker_block_index = 0;
  marker_free_list = 0;
  n_marker_blocks = 1;
}

/* Return a newly allocated Lisp_Misc object, with no substructure.  */

Lisp_Object

  gc_in_progress = 1;

  /* clear_marks (); */

  /* Mark all the special slots that serve as the roots of accessibility.

     Usually the special slots to mark are contained in particular structures.
     Then we know no slot is marked twice because the structures don't overlap.
     In some cases, the structures point to the slots to be marked.
     For these, we use MARKBIT to avoid double marking of the slot.  */

  for (i = 0; i < staticidx; i++)
    mark_object (*staticvec[i]);

#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \

#else
  {
    register struct gcpro *tail;
    for (tail = gcprolist; tail; tail = tail->next)
      for (i = 0; i < tail->nvars; i++)
	if (!XMARKBIT (tail->var[i]))
	  {
	    mark_object (tail->var[i]);
	    XMARK (tail->var[i]);
	  }
  }
#endif

  mark_byte_stack ();
  for (bind = specpdl; bind != specpdl_ptr; bind++)

      mark_object (handler->handler);
      mark_object (handler->var);
    }
  for (backlist = backtrace_list; backlist; backlist = backlist->next)
    {
      if (!XMARKBIT (*backlist->function))
	{
	  mark_object (*backlist->function);
	  XMARK (*backlist->function);
	}
      if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
	i = 0;
      else
	i = backlist->nargs - 1;
      for (; i >= 0; i--)
	if (!XMARKBIT (backlist->args[i]))
	  {
	    mark_object (backlist->args[i]);
	    XMARK (backlist->args[i]);
	  }
    }
  mark_kboards ();

  /* Look thru every buffer's undo list
     for elements that update markers that were not marked,

#if (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE \
     || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
  {
    register struct gcpro *tail;

    for (tail = gcprolist; tail; tail = tail->next)
      for (i = 0; i < tail->nvars; i++)
	XUNMARK (tail->var[i]);
  }
#endif

  unmark_byte_stack ();
  for (backlist = backtrace_list; backlist; backlist = backlist->next)
    {
      XUNMARK (*backlist->function);
      if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
	i = 0;
      else
	i = backlist->nargs - 1;
      for (; i >= 0; i--)
	XUNMARK (backlist->args[i]);
    }
  VECTOR_UNMARK (&buffer_defaults);
  VECTOR_UNMARK (&buffer_local_symbols);

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0
  dump_zombies ();

  struct mem_node *m;
#endif
  int cdr_count = 0;

 loop:
  XUNMARK (obj);

  if (PURE_POINTER_P (XPNTR (obj)))
    return;

  last_marked[last_marked_index++] = obj;

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
  defsubr (&Sgc_status);
#endif
}

89518:c9f7a2f363ca

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


/* Like free but block interrupt input.  */

void
xfree (block)
     POINTER_TYPE *block;
{

/* Pointer to the (not necessarily aligned) malloc block.  */
#ifdef HAVE_POSIX_MEMALIGN
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
  (1 & (long) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
#endif

/* The list of free ablock.   */
static struct ablock *free_ablock;

  allocated_mem_type = type;
#endif

  if (!free_ablock)
    {
      int i;
      EMACS_INT aligned; /* int gets warning casting to 64-bit pointer.  */

#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.  */

	{
	  abase->blocks[i].abase = abase;
	  abase->blocks[i].x.next_free = free_ablock;
	  free_ablock = &abase->blocks[i];
	}
      ABLOCKS_BUSY (abase) = (struct ablocks *) (long) aligned;

      eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN);
      eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
      eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
      eassert (ABLOCKS_BASE (abase) == base);
      eassert (aligned == (long) ABLOCKS_BUSY (abase));
    }

  abase = ABLOCK_ABASE (free_ablock);
  ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (long) ABLOCKS_BUSY (abase));
  val = free_ablock;
  free_ablock = free_ablock->x.next_free;

#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
  if (val && type != MEM_TYPE_NON_LISP)

#endif
  /* Put on free list.  */
  ablock->x.next_free = free_ablock;
  free_ablock = ablock;
  /* Update busy count.  */
  ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase));
  
  if (2 > (long) ABLOCKS_BUSY (abase))
    { /* All the blocks are free.  */
      int i = 0, aligned = (long) ABLOCKS_BUSY (abase);
      struct ablock **tem = &free_ablock;
      struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];

      while (*tem)
	{

/* Initialize interval allocation.  */

static void
init_intervals ()
{
  interval_block = NULL;
  interval_block_index = INTERVAL_BLOCK_SIZE;
  interval_free_list = 0;
  n_interval_blocks = 0;
}


/* Return a new interval.  */

/* Initialize symbol allocation.  */

void
init_symbol ()
{
  symbol_block = NULL;
  symbol_block_index = SYMBOL_BLOCK_SIZE;
  symbol_free_list = 0;
  n_symbol_blocks = 0;
}


DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
       doc: /* Return a newly allocated uninterned symbol whose name is NAME.

int n_marker_blocks;

void
init_marker ()
{
  marker_block = NULL;
  marker_block_index = MARKER_BLOCK_SIZE;
  marker_free_list = 0;
  n_marker_blocks = 0;
}

/* Return a newly allocated Lisp_Misc object, with no substructure.  */

Lisp_Object

  gc_in_progress = 1;

  /* clear_marks (); */

  /* Mark all the special slots that serve as the roots of accessibility.  */

  for (i = 0; i < staticidx; i++)
    mark_object (*staticvec[i]);

#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \

#else
  {
    register struct gcpro *tail;
    for (tail = gcprolist; tail; tail = tail->next)
      for (i = 0; i < tail->nvars; i++)
	mark_object (tail->var[i]);
  }
#endif

  mark_byte_stack ();
  for (bind = specpdl; bind != specpdl_ptr; bind++)

      mark_object (handler->handler);
      mark_object (handler->var);
    }
  for (backlist = backtrace_list; backlist; backlist = backlist->next)
    {
      mark_object (*backlist->function);

      if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
	i = 0;
      else
	i = backlist->nargs - 1;
      for (; i >= 0; i--)
	mark_object (backlist->args[i]);
    }
  mark_kboards ();

  /* Look thru every buffer's undo list
     for elements that update markers that were not marked,

#if (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE \
     || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
  {
    register struct gcpro *tail;
  }
#endif

  unmark_byte_stack ();
  VECTOR_UNMARK (&buffer_defaults);
  VECTOR_UNMARK (&buffer_local_symbols);

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0
  dump_zombies ();

  struct mem_node *m;
#endif
  int cdr_count = 0;

 loop:

  if (PURE_POINTER_P (XPNTR (obj)))
    return;

  last_marked[last_marked_index++] = obj;

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
  defsubr (&Sgc_status);
#endif
}

/* arch-tag: 6695ca10-e3c5-4c2c-8bc3-ed26a7dda857
   (do not change this comment) */