comparison src/alloc.c @ 12529:c7d32f5da2b3

(Flist): Rewritten. (allocating_for_lisp): New variable. (init_intervals, make_interval, init_symbol, Fmake_symbol) (init_float, make_float, init_cons, Fcons) (allocate_vectorlike, init_marker, allocate_misc) (init_strings, make_uninit_string): Set allocate_misc temporarily.

12528:ed5b91dd829a

#define SPARE_MEMORY (1 << 14)

/* Number of extra blocks malloc should get when it needs more core.  */
static int malloc_hysteresis;

/* Non-nil means defun should do purecopy on the function definition */
Lisp_Object Vpurify_flag;

#ifndef HAVE_SHM
EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};   /* Force it into data space! */

INTERVAL interval_free_list;

static void
init_intervals ()
{
  interval_block
    = (struct interval_block *) malloc (sizeof (struct interval_block));
  interval_block->next = 0;
  bzero (interval_block->intervals, sizeof interval_block->intervals);
  interval_block_index = 0;
  interval_free_list = 0;
}

    }
  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;
	}

struct Lisp_Float *float_free_list;

void
init_float ()
{
  float_block = (struct float_block *) malloc (sizeof (struct float_block));
  float_block->next = 0;
  bzero (float_block->floats, sizeof float_block->floats);
  float_block_index = 0;
  float_free_list = 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;
	}

struct Lisp_Cons *cons_free_list;

void
init_cons ()
{
  cons_block = (struct cons_block *) malloc (sizeof (struct cons_block));
  cons_block->next = 0;
  bzero (cons_block->conses, sizeof cons_block->conses);
  cons_block_index = 0;
  cons_free_list = 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;
	}

Any number of arguments, even zero arguments, are allowed.")
  (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
  register Lisp_Object len, val, val_tail;

  XSETFASTINT (len, nargs);
  val = Fmake_list (len, Qnil);
  val_tail = val;
  while (!NILP (val_tail))
    {
      XCONS (val_tail)->car = *args++;
      val_tail = XCONS (val_tail)->cdr;
    }
  return val;
}

DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
  "Return a newly created list of length LENGTH, with each element being INIT.")

allocate_vectorlike (len)
     EMACS_INT len;
{
  struct Lisp_Vector *p;

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

  p->next = all_vectors;

struct Lisp_Symbol *symbol_free_list;

void
init_symbol ()
{
  symbol_block = (struct symbol_block *) malloc (sizeof (struct symbol_block));
  symbol_block->next = 0;
  bzero (symbol_block->symbols, sizeof symbol_block->symbols);
  symbol_block_index = 0;
  symbol_free_list = 0;
}

    }
  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;
	}

union Lisp_Misc *marker_free_list;

void
init_marker ()
{
  marker_block = (struct marker_block *) malloc (sizeof (struct marker_block));
  marker_block->next = 0;
  bzero (marker_block->markers, sizeof marker_block->markers);
  marker_block_index = 0;
  marker_free_list = 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;
	}

#endif

void
init_strings ()
{
  current_string_block = (struct string_block *) malloc (sizeof (struct string_block));
  first_string_block = current_string_block;
  consing_since_gc += sizeof (struct string_block);
  current_string_block->next = 0;
  current_string_block->prev = 0;
  current_string_block->pos = 0;

      current_string_block->pos += fullsize;
    }
  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;

		   ((struct string_block_head *)new + 1)));
    }
  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;

12529:c7d32f5da2b3

#define SPARE_MEMORY (1 << 14)

/* Number of extra blocks malloc should get when it needs more core.  */
static int malloc_hysteresis;

/* Nonzero when malloc is called for allocating Lisp object space.  */
int allocating_for_lisp;

/* Non-nil means defun should do purecopy on the function definition */
Lisp_Object Vpurify_flag;

#ifndef HAVE_SHM
EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};   /* Force it into data space! */

INTERVAL interval_free_list;

static void
init_intervals ()
{
  allocating_for_lisp = 1;
  interval_block
    = (struct interval_block *) malloc (sizeof (struct interval_block));
  allocating_for_lisp = 0;
  interval_block->next = 0;
  bzero (interval_block->intervals, sizeof interval_block->intervals);
  interval_block_index = 0;
  interval_free_list = 0;
}

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

	  allocating_for_lisp = 1;
	  newi = (struct interval_block *) xmalloc (sizeof (struct interval_block));

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

struct Lisp_Float *float_free_list;

void
init_float ()
{
  allocating_for_lisp = 1;
  float_block = (struct float_block *) malloc (sizeof (struct float_block));
  allocating_for_lisp = 0;
  float_block->next = 0;
  bzero (float_block->floats, sizeof float_block->floats);
  float_block_index = 0;
  float_free_list = 0;
}

    }
  else
    {
      if (float_block_index == FLOAT_BLOCK_SIZE)
	{
	  register struct float_block *new;

	  allocating_for_lisp = 1;
	  new = (struct float_block *) xmalloc (sizeof (struct float_block));
	  allocating_for_lisp = 0;
	  VALIDATE_LISP_STORAGE (new, sizeof *new);
	  new->next = float_block;
	  float_block = new;
	  float_block_index = 0;
	}

struct Lisp_Cons *cons_free_list;

void
init_cons ()
{
  allocating_for_lisp = 1;
  cons_block = (struct cons_block *) malloc (sizeof (struct cons_block));
  allocating_for_lisp = 0;
  cons_block->next = 0;
  bzero (cons_block->conses, sizeof cons_block->conses);
  cons_block_index = 0;
  cons_free_list = 0;
}

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

Any number of arguments, even zero arguments, are allowed.")
  (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
  register Lisp_Object val = Qnil;

  while (nargs--)
    val = Fcons (args[nargs], val);
  return val;
}

DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
  "Return a newly created list of length LENGTH, with each element being INIT.")

allocate_vectorlike (len)
     EMACS_INT len;
{
  struct Lisp_Vector *p;

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

  p->next = all_vectors;

struct Lisp_Symbol *symbol_free_list;

void
init_symbol ()
{
  allocating_for_lisp = 1;
  symbol_block = (struct symbol_block *) malloc (sizeof (struct symbol_block));
  allocating_for_lisp = 0;
  symbol_block->next = 0;
  bzero (symbol_block->symbols, sizeof symbol_block->symbols);
  symbol_block_index = 0;
  symbol_free_list = 0;
}

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

union Lisp_Misc *marker_free_list;

void
init_marker ()
{
  allocating_for_lisp = 1;
  marker_block = (struct marker_block *) malloc (sizeof (struct marker_block));
  allocating_for_lisp = 0;
  marker_block->next = 0;
  bzero (marker_block->markers, sizeof marker_block->markers);
  marker_block_index = 0;
  marker_free_list = 0;
}

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

#endif

void
init_strings ()
{
  allocating_for_lisp = 1;
  current_string_block = (struct string_block *) malloc (sizeof (struct string_block));
  allocating_for_lisp = 0;
  first_string_block = current_string_block;
  consing_since_gc += sizeof (struct string_block);
  current_string_block->next = 0;
  current_string_block->prev = 0;
  current_string_block->pos = 0;

      current_string_block->pos += fullsize;
    }
  else if (fullsize > STRING_BLOCK_OUTSIZE)
    /* This string gets its own string block */
    {
      register struct string_block *new;
      allocating_for_lisp = 1;
      new = (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize);
      allocating_for_lisp = 0;
      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;

		   ((struct string_block_head *)new + 1)));
    }
  else
    /* Make a new current string block and start it off with this string */
    {
      register struct string_block *new;
      allocating_for_lisp = 1;
      new = (struct string_block *) xmalloc (sizeof (struct string_block));
      allocating_for_lisp = 0;
      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;