comparison src/alloc.c @ 1300:b13b79e28eb5

* alloc.c: #include "intervals.h". (init_intervals, make_interval, mark_interval, mark_interval_tree): New functions conditionally defined. (make_uninit_string): Call INITIALIZE_INTERVAL. (INIT_INTERVALS, UNMARK_BALANCE_INTERVALS, MARK_INTERVAL_TREE): New macros, conditionally defined. (mark_object): Call MARK_INTERVAL_TREE in case Lisp_String. (gc_sweep): If text properties are in use, place all unmarked intervals on the free list. Call UNMARK_BALANCE_INTERVALS on `buffer->intervals' when unmarking `buffer'. (compact_strings): Include INTERVAL_PTR_SIZE in calculation for target of bcopy when relocating strings. (init_alloc_once): Call INIT_INTERVALS. (make_pure_string): Include INTERVAL_PTR_SIZE in calculation of `size'.

1299:b8337cdf2e8b

the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"
#include "lisp.h"
#include "puresize.h"
#ifndef standalone
#include "buffer.h"
#include "window.h"
#ifdef MULTI_FRAME

  if (!val && size) memory_full ();
  return val;
}

#ifdef LISP_FLOAT_TYPE
/* Allocation of float cells, just like conses */
/* We store float cells inside of float_blocks, allocating a new
   float_block with malloc whenever necessary.  Float cells reclaimed by
   GC are put on a free list to be reallocated before allocating

	    (struct Lisp_String *) current_string_block->chars);
    }
    
  XSTRING (val)->size = length;
  XSTRING (val)->data[length] = 0;

  return val;
}

/* Return a newly created vector or string with specified arguments as

make_pure_string (data, length)
     char *data;
     int length;
{
  register Lisp_Object new;
  register int size = sizeof (int) + length + 1;

  if (pureptr + size > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSET (new, Lisp_String, PUREBEG + pureptr);
  XSTRING (new)->size = length;

    {
    case Lisp_String:
      {
	register struct Lisp_String *ptr = XSTRING (obj);

	if (ptr->size & MARKBIT)
	  /* A large string.  Just set ARRAY_MARK_FLAG.  */
	  ptr->size |= ARRAY_MARK_FLAG;
	else
	  {

  register Lisp_Object *ptr;

  /* This is the buffer's markbit */
  mark_object (&buffer->name);
  XMARK (buffer->name);

#if 0
  mark_object (buffer->syntax_table);

  /* Mark the various string-pointers in the buffer object.

      }
    total_floats = num_used;
    total_free_floats = num_free;
  }
#endif /* LISP_FLOAT_TYPE */

  /* Put all unmarked symbols on free list */
  {
    register struct symbol_block *sblk;
    register int lim = symbol_block_index;

	  buffer = next;
	}
      else
	{
	  XUNMARK (buffer->name);

#if 0
	  /* Each `struct Lisp_String *' was turned into a Lisp_Object
	     for purposes of marking and relocation.
	     Turn them back into C pointers now.  */

	      newaddr = (struct Lisp_String *) &to_sb->chars[to_pos];
	      to_pos += STRING_FULLSIZE (size);

	      /* Copy the string itself to the new place.  */
	      if (nextstr != newaddr)
		bcopy (nextstr, newaddr, size + 1 + sizeof (int));

	      /* Go through NEXTSTR's chain of references
		 and make each slot in the chain point to
		 the new address of this string.  */
	      size = newaddr->size;

  init_symbol ();
  init_marker ();
#ifdef LISP_FLOAT_TYPE
  init_float ();
#endif /* LISP_FLOAT_TYPE */
  ignore_warnings = 0;
  gcprolist = 0;
  staticidx = 0;
  consing_since_gc = 0;
  gc_cons_threshold = 100000;

1300:b13b79e28eb5

the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"
#include "lisp.h"
#include "intervals.h"
#include "puresize.h"
#ifndef standalone
#include "buffer.h"
#include "window.h"
#ifdef MULTI_FRAME

  if (!val && size) memory_full ();
  return val;
}

#ifdef USE_TEXT_PROPERTIES
#define INTERVAL_BLOCK_SIZE \
  ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))

struct interval_block
  {
    struct interval_block *next;
    struct interval intervals[INTERVAL_BLOCK_SIZE];
  };

struct interval_block *interval_block;
static int interval_block_index;

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

#define INIT_INTERVALS init_intervals ()

INTERVAL
make_interval ()
{
  INTERVAL val;

  if (interval_free_list)
    {
      val = interval_free_list;
      interval_free_list = interval_free_list->parent;
    }
  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;
	}
      val = &interval_block->intervals[interval_block_index++];
    }
  consing_since_gc += sizeof (struct interval);
  RESET_INTERVAL (val);
  return val;
}

static int total_free_intervals, total_intervals;

/* Mark the pointers of one interval. */

static void
mark_interval (i)
     register INTERVAL i;
{
  if (XMARKBIT (i->plist))
    abort ();
  mark_object (&i->plist);
  XMARK (i->plist);
}

static void
mark_interval_tree (tree)
     register INTERVAL tree;
{
  if (XMARKBIT (tree->plist))
    return;

  traverse_intervals (tree, 1, &mark_interval);
}

#define MARK_INTERVAL_TREE(i) \
  { if (!NULL_INTERVAL_P (i)) mark_interval_tree (i); }

#define UNMARK_BALANCE_INTERVALS(i) \
{                                   \
   if (! NULL_INTERVAL_P (i))       \
     {                              \
       XUNMARK ((Lisp_Object) (i->parent)); \
       i = balance_intervals (i);           \
     } \
}

#else  /* no interval use */

#define INIT_INTERVALS

#define UNMARK_BALANCE_INTERVALS(i)
#define MARK_INTERVAL_TREE(i)

#endif /* no interval use */

#ifdef LISP_FLOAT_TYPE
/* Allocation of float cells, just like conses */
/* We store float cells inside of float_blocks, allocating a new
   float_block with malloc whenever necessary.  Float cells reclaimed by
   GC are put on a free list to be reallocated before allocating

	    (struct Lisp_String *) current_string_block->chars);
    }
    
  XSTRING (val)->size = length;
  XSTRING (val)->data[length] = 0;
  INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);

  return val;
}

/* Return a newly created vector or string with specified arguments as

make_pure_string (data, length)
     char *data;
     int length;
{
  register Lisp_Object new;
  register int size = sizeof (int) + INTERVAL_PTR_SIZE + length + 1;

  if (pureptr + size > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSET (new, Lisp_String, PUREBEG + pureptr);
  XSTRING (new)->size = length;

    {
    case Lisp_String:
      {
	register struct Lisp_String *ptr = XSTRING (obj);

	MARK_INTERVAL_TREE (ptr->intervals);
	if (ptr->size & MARKBIT)
	  /* A large string.  Just set ARRAY_MARK_FLAG.  */
	  ptr->size |= ARRAY_MARK_FLAG;
	else
	  {

  register Lisp_Object *ptr;

  /* This is the buffer's markbit */
  mark_object (&buffer->name);
  XMARK (buffer->name);

  MARK_INTERVAL_TREE (buffer->intervals);

#if 0
  mark_object (buffer->syntax_table);

  /* Mark the various string-pointers in the buffer object.

      }
    total_floats = num_used;
    total_free_floats = num_free;
  }
#endif /* LISP_FLOAT_TYPE */

#ifdef USE_TEXT_PROPERTIES
  /* Put all unmarked intervals on free list */
  {
    register struct interval_block *iblk;
    register int lim = interval_block_index;
    register int num_free = 0, num_used = 0;

    interval_free_list = 0;

    for (iblk = interval_block; iblk; iblk = iblk->next)
      {
	register int i;

	for (i = 0; i < lim; i++)
	  {
	    if (! XMARKBIT (iblk->intervals[i].plist))
	      {
		iblk->intervals[i].parent = interval_free_list;
		interval_free_list = &iblk->intervals[i];
		num_free++;
	      }
	    else
	      {
		num_used++;
		XUNMARK (iblk->intervals[i].plist);
	      }
	  }
	lim = INTERVAL_BLOCK_SIZE;
      }
    total_intervals = num_used;
    total_free_intervals = num_free;
  }
#endif /* USE_TEXT_PROPERTIES */

  /* Put all unmarked symbols on free list */
  {
    register struct symbol_block *sblk;
    register int lim = symbol_block_index;

	  buffer = next;
	}
      else
	{
	  XUNMARK (buffer->name);
	  UNMARK_BALANCE_INTERVALS (buffer->intervals);

#if 0
	  /* Each `struct Lisp_String *' was turned into a Lisp_Object
	     for purposes of marking and relocation.
	     Turn them back into C pointers now.  */

	      newaddr = (struct Lisp_String *) &to_sb->chars[to_pos];
	      to_pos += STRING_FULLSIZE (size);

	      /* Copy the string itself to the new place.  */
	      if (nextstr != newaddr)
		bcopy (nextstr, newaddr, size + 1 + sizeof (int)
		       + INTERVAL_PTR_SIZE);

	      /* Go through NEXTSTR's chain of references
		 and make each slot in the chain point to
		 the new address of this string.  */
	      size = newaddr->size;

  init_symbol ();
  init_marker ();
#ifdef LISP_FLOAT_TYPE
  init_float ();
#endif /* LISP_FLOAT_TYPE */
  INIT_INTERVALS;

  ignore_warnings = 0;
  gcprolist = 0;
  staticidx = 0;
  consing_since_gc = 0;
  gc_cons_threshold = 100000;