comparison src/alloc.c @ 2439:b6c62e4abf59

Put interrupt input blocking in a separate file from xterm.h. This isn't specific to X, and it allows us to avoid #including xterm.h in files that don't really have anything to do with X. * blockinput.h: New file. * xterm.h (BLOCK_INPUT, UNBLOCK_INPUT, TOTALLY_UNBLOCK_INPUT, UNBLOCK_INPUT_RESIGNAL): These are now in blockinput.h. (x_input_blocked, x_pending_input): Deleted; there are analogs in blockinput.h called interrupt_input_blocked and interrupt_input_pending. * keyboard.c (interrupt_input_blocked, interrupt_input_pending): New variables, used by the macros in blockinput.h. * xterm.c: #include blockinput.h. (x_input_blocked, x_pending_input): Deleted. (XTread_socket): Test and set interrupt_input_blocked and interrupt_input_pending instead of the old variables. * alloc.c, xfaces.c, xfns.c, xmenu.c, xselect.c, keymap.c: #include blockinput.h. * eval.c: #include blockinput.h instead of xterm.h. * keyboard.c: #include blockinput.h. (input_poll_signal): Just test interrupt_input_blocked, instead of testing HAVE_X_WINDOWS and x_input_blocked. Block the processing of interrupt input while we're manipulating the malloc heap. * alloc.c: (xfree): New function, to make it easy to free things safely. (xmalloc, xrealloc): Block X input while doing the deed. (VALIDATE_LISP_STORAGE, gc_sweep, compact_strings): Use xfree instead of free. (uninterrupt_malloc): New function, to install input-blocking hooks into the GNU malloc routines. * emacs.c [not SYSTEM_MALLOC] (main): Call uninterrupt_malloc on startup. * alloc.c: (make_interval, make_float, Fcons, Fmake_vector, Fmake_symbol, Fmake_marker, make_uninit_string, Fgarbage_collect): Use xmalloc instead of malloc; don't bother to check if out of memory here. (Fgarbage_collect): Call xrealloc instead of realloc. * buffer.c: Use xmalloc and xfree instead of malloc and free; don't bother to check if out of memory here. (Fget_buffer_create): Put BLOCK_INPUT/UNBLOCK_INPUT pair around calls to ralloc routines. * insdel.c: Same. * lisp.h (xfree): New extern declaration. * xfaces.c (xfree): Don't #define this to be free; use the definition in alloc.c. * dispnew.c, doc.c, doprnt.c, fileio.c, lread.c, term.c, xfns.c, xmenu.c, xterm.c: Use xfree instead of free. * hftctl.c: Use xfree and xmalloc instead of free and malloc. * keymap.c (current_minor_maps): BLOCK_INPUT while calling realloc and malloc. * search.c: Since the regexp routines can malloc, BLOCK_INPUT while runing them. #include blockinput.h. * sysdep.c: #include blockinput.h. Call xfree and xmalloc instead of free and malloc. BLOCK_INPUT around routines which we know will call malloc. ymakefile (keyboard.o, keymap.o, search.o, sysdep.o, xfaces.o, xfns.o, xmenu.o, xterm.o, xselect.o, alloc.o, eval.o): Note that these depend on blockinput.h.

2438:b513de4de386

#include "puresize.h"
#ifndef standalone
#include "buffer.h"
#include "window.h"
#include "frame.h"
#endif

#include "syssignal.h"

#define max(A,B) ((A) > (B) ? (A) : (B))

  {								\
    Lisp_Object val;						\
    XSET (val, Lisp_Cons, (char *) address + size);		\
    if ((char *) XCONS (val) != (char *) address + size)	\
      {								\
	free (address);						\
	memory_full ();						\
      }								\
  } while (0)

/* Number of bytes of consing done since the last gc */

memory_full ()
{
  error ("Memory exhausted");
}

/* like malloc and realloc but check for no memory left */

long *
xmalloc (size)
     int size;
{
  register long *val;

  val = (long *) malloc (size);

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

     long *block;
     int size;
{
  register long *val;

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

  if (!val && size) memory_full ();
  return val;
}

/* Interval allocation.  */

#ifdef USE_TEXT_PROPERTIES
#define INTERVAL_BLOCK_SIZE \

  else
    {
      if (interval_block_index == INTERVAL_BLOCK_SIZE)
	{
	  register struct interval_block *newi
	    = (struct interval_block *) malloc (sizeof (struct interval_block));

	  if (!newi)
	    memory_full ();

	  VALIDATE_LISP_STORAGE (newi, sizeof *newi);
	  newi->next = interval_block;
	  interval_block = newi;
	  interval_block_index = 0;

    }
  else
    {
      if (float_block_index == FLOAT_BLOCK_SIZE)
	{
	  register struct float_block *new = (struct float_block *) malloc (sizeof (struct float_block));
	  if (!new) memory_full ();
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = float_block;
	  float_block = new;
	  float_block_index = 0;
	}

    }
  else
    {
      if (cons_block_index == CONS_BLOCK_SIZE)
	{
	  register struct cons_block *new = (struct cons_block *) malloc (sizeof (struct cons_block));
	  if (!new) memory_full ();
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = cons_block;
	  cons_block = new;
	  cons_block_index = 0;
	}

  if (XTYPE (length) != Lisp_Int || XINT (length) < 0)
    length = wrong_type_argument (Qnatnump, length);
  sizei = XINT (length);

  p = (struct Lisp_Vector *) malloc (sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object));
  if (p == 0)
    memory_full ();
  VALIDATE_LISP_STORAGE (p, 0);

  XSET (vector, Lisp_Vector, p);
  consing_since_gc += sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object);

    }
  else
    {
      if (symbol_block_index == SYMBOL_BLOCK_SIZE)
	{
	  struct symbol_block *new = (struct symbol_block *) malloc (sizeof (struct symbol_block));
	  if (!new) memory_full ();
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = symbol_block;
	  symbol_block = new;
	  symbol_block_index = 0;
	}

    }
  else
    {
      if (marker_block_index == MARKER_BLOCK_SIZE)
	{
	  struct marker_block *new = (struct marker_block *) malloc (sizeof (struct marker_block));
	  if (!new) memory_full ();
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = marker_block;
	  marker_block = new;
	  marker_block_index = 0;
	}

    }
  else if (fullsize > STRING_BLOCK_OUTSIZE)
    /* This string gets its own string block */
    {
      register struct string_block *new
	= (struct string_block *) malloc (sizeof (struct string_block_head) + fullsize);
      VALIDATE_LISP_STORAGE (new, 0);
      if (!new) memory_full ();
      consing_since_gc += sizeof (struct string_block_head) + fullsize;
      new->pos = fullsize;
      new->next = large_string_blocks;
      large_string_blocks = new;
      XSET (val, Lisp_String,

    }
  else
    /* Make a new current string block and start it off with this string */
    {
      register struct string_block *new
	= (struct string_block *) malloc (sizeof (struct string_block));
      if (!new) memory_full ();
      VALIDATE_LISP_STORAGE (new, sizeof *new);
      consing_since_gc += sizeof (struct string_block);
      current_string_block->next = new;
      new->prev = current_string_block;
      new->next = 0;

      i = &stack_top_variable - stack_bottom;
      if (i < 0) i = -i;
      if (i < MAX_SAVE_STACK)
	{
	  if (stack_copy == 0)
	    stack_copy = (char *) malloc (stack_copy_size = i);
	  else if (stack_copy_size < i)
	    stack_copy = (char *) realloc (stack_copy, (stack_copy_size = i));
	  if (stack_copy)
	    {
	      if ((int) (&stack_top_variable - stack_bottom) > 0)
		bcopy (stack_bottom, stack_copy, i);
	      else

	  if (prev)
	    prev->next = buffer->next;
	  else
	    all_buffers = buffer->next;
	  next = buffer->next;
	  free (buffer);
	  buffer = next;
	}
      else
	{
	  XUNMARK (buffer->name);

	  if (prev)
	    prev->next = vector->next;
	  else
	    all_vectors = vector->next;
	  next = vector->next;
	  free (vector);
	  vector = next;
	}
      else
	{
	  vector->size &= ~ARRAY_MARK_FLAG;

	  if (prev)
	    prev->next = sb->next;
	  else
	    large_string_blocks = sb->next;
	  next = sb->next;
	  free (sb);
	  sb = next;
	}
      else
	{
	  ((struct Lisp_String *)(&sb->chars[0]))->size

  from_sb = to_sb->next;
  to_sb->next = 0;
  while (from_sb)
    {
      to_sb = from_sb->next;
      free (from_sb);
      from_sb = to_sb;
    }

  /* Free any empty string blocks further back in the chain.
     This loop will never free first_string_block, but it is very

    {
      if (to_sb->pos == 0)
	{
	  if (from_sb->next = to_sb->next)
	    from_sb->next->prev = from_sb;
	  free (to_sb);
	}
      else
	from_sb = to_sb;
    }
}

2439:b6c62e4abf59

#include "puresize.h"
#ifndef standalone
#include "buffer.h"
#include "window.h"
#include "frame.h"
#include "blockinput.h"
#endif

#include "syssignal.h"

#define max(A,B) ((A) > (B) ? (A) : (B))

  {								\
    Lisp_Object val;						\
    XSET (val, Lisp_Cons, (char *) address + size);		\
    if ((char *) XCONS (val) != (char *) address + size)	\
      {								\
	xfree (address);					\
	memory_full ();						\
      }								\
  } while (0)

/* Number of bytes of consing done since the last gc */

memory_full ()
{
  error ("Memory exhausted");
}

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

long *
xmalloc (size)
     int size;
{
  register long *val;

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

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

     long *block;
     int size;
{
  register long *val;

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

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

void
xfree (block)
     long *block;
{
  BLOCK_INPUT;
  free (block);
  UNBLOCK_INPUT;
}


/* Arranging to disable input signals while we're in malloc.

   This only works with GNU malloc.  To help out systems which can't
   use GNU malloc, all the calls to malloc, realloc, and free
   elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
   pairs; unfortunately, we have no idea what C library functions
   might call malloc, so we can't really protect them unless you're
   using GNU malloc.  Fortunately, most of the major operating can use
   GNU malloc.  */

#ifndef SYSTEM_MALLOC
static void (*__malloc_hook) (),  (*old_malloc_hook) ();
static void (*__realloc_hook) (), (*old_realloc_hook) ();
static void (*__free_hook) (),    (*old_free_hook) ();

static void
emacs_blocked_free (ptr)
     void *ptr;
{
  BLOCK_INPUT;
  __free_hook = old_free_hook;
  free (ptr);
  __free_hook = &emacs_blocked_free;
  UNBLOCK_INPUT;
}

static void *
emacs_blocked_malloc (size)
     unsigned size;
{
  void *value;

  BLOCK_INPUT;
  __malloc_hook = old_malloc_hook;
  value = malloc (size);
  __malloc_hook = &emacs_blocked_malloc;
  UNBLOCK_INPUT;

  return value;
}

static void *
emacs_blocked_realloc (ptr, size)
     void *ptr;
     unsigned size;
{
  void *value;

  BLOCK_INPUT;
  __realloc_hook = old_realloc_hook;
  value = realloc (ptr, size);
  __realloc_hook = &emacs_blocked_realloc;
  UNBLOCK_INPUT;

  return value;
}

void
uninterrupt_malloc ()
{
  old_free_hook = __free_hook;
  __free_hook = &emacs_blocked_free;

  old_malloc_hook = __malloc_hook;
  __malloc_hook = &emacs_blocked_malloc;

  old_realloc_hook = __realloc_hook;
  __realloc_hook = &emacs_blocked_realloc;
}
#endif

/* Interval allocation.  */

#ifdef USE_TEXT_PROPERTIES
#define INTERVAL_BLOCK_SIZE \

  else
    {
      if (interval_block_index == INTERVAL_BLOCK_SIZE)
	{
	  register struct interval_block *newi
	    = (struct interval_block *) xmalloc (sizeof (struct interval_block));

	  VALIDATE_LISP_STORAGE (newi, sizeof *newi);
	  newi->next = interval_block;
	  interval_block = newi;
	  interval_block_index = 0;

    }
  else
    {
      if (float_block_index == FLOAT_BLOCK_SIZE)
	{
	  register struct float_block *new = (struct float_block *) xmalloc (sizeof (struct float_block));
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = float_block;
	  float_block = new;
	  float_block_index = 0;
	}

    }
  else
    {
      if (cons_block_index == CONS_BLOCK_SIZE)
	{
	  register struct cons_block *new = (struct cons_block *) xmalloc (sizeof (struct cons_block));
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = cons_block;
	  cons_block = new;
	  cons_block_index = 0;
	}

  if (XTYPE (length) != Lisp_Int || XINT (length) < 0)
    length = wrong_type_argument (Qnatnump, length);
  sizei = XINT (length);

  p = (struct Lisp_Vector *) xmalloc (sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object));
  VALIDATE_LISP_STORAGE (p, 0);

  XSET (vector, Lisp_Vector, p);
  consing_since_gc += sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object);

    }
  else
    {
      if (symbol_block_index == SYMBOL_BLOCK_SIZE)
	{
	  struct symbol_block *new = (struct symbol_block *) xmalloc (sizeof (struct symbol_block));
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = symbol_block;
	  symbol_block = new;
	  symbol_block_index = 0;
	}

    }
  else
    {
      if (marker_block_index == MARKER_BLOCK_SIZE)
	{
	  struct marker_block *new = (struct marker_block *) xmalloc (sizeof (struct marker_block));
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = marker_block;
	  marker_block = new;
	  marker_block_index = 0;
	}

    }
  else if (fullsize > STRING_BLOCK_OUTSIZE)
    /* This string gets its own string block */
    {
      register struct string_block *new
	= (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize);
      VALIDATE_LISP_STORAGE (new, 0);
      consing_since_gc += sizeof (struct string_block_head) + fullsize;
      new->pos = fullsize;
      new->next = large_string_blocks;
      large_string_blocks = new;
      XSET (val, Lisp_String,

    }
  else
    /* Make a new current string block and start it off with this string */
    {
      register struct string_block *new
	= (struct string_block *) xmalloc (sizeof (struct string_block));
      VALIDATE_LISP_STORAGE (new, sizeof *new);
      consing_since_gc += sizeof (struct string_block);
      current_string_block->next = new;
      new->prev = current_string_block;
      new->next = 0;

      i = &stack_top_variable - stack_bottom;
      if (i < 0) i = -i;
      if (i < MAX_SAVE_STACK)
	{
	  if (stack_copy == 0)
	    stack_copy = (char *) xmalloc (stack_copy_size = i);
	  else if (stack_copy_size < i)
	    stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
	  if (stack_copy)
	    {
	      if ((int) (&stack_top_variable - stack_bottom) > 0)
		bcopy (stack_bottom, stack_copy, i);
	      else

	  if (prev)
	    prev->next = buffer->next;
	  else
	    all_buffers = buffer->next;
	  next = buffer->next;
	  xfree (buffer);
	  buffer = next;
	}
      else
	{
	  XUNMARK (buffer->name);

	  if (prev)
	    prev->next = vector->next;
	  else
	    all_vectors = vector->next;
	  next = vector->next;
	  xfree (vector);
	  vector = next;
	}
      else
	{
	  vector->size &= ~ARRAY_MARK_FLAG;

	  if (prev)
	    prev->next = sb->next;
	  else
	    large_string_blocks = sb->next;
	  next = sb->next;
	  xfree (sb);
	  sb = next;
	}
      else
	{
	  ((struct Lisp_String *)(&sb->chars[0]))->size

  from_sb = to_sb->next;
  to_sb->next = 0;
  while (from_sb)
    {
      to_sb = from_sb->next;
      xfree (from_sb);
      from_sb = to_sb;
    }

  /* Free any empty string blocks further back in the chain.
     This loop will never free first_string_block, but it is very

    {
      if (to_sb->pos == 0)
	{
	  if (from_sb->next = to_sb->next)
	    from_sb->next->prev = from_sb;
	  xfree (to_sb);
	}
      else
	from_sb = to_sb;
    }
}