comparison src/alloc.c @ 1908:d649f2179d67

* alloc.c (make_pure_float): Align pureptr on a sizeof (double) boundary before allocating the float. * alloc.c: Add description lines to the top of each page. * alloc.c (mark_interval_tree): Remove spurious & in front of function name. * alloc.c (UNMARK_BALANCE_INTERVALS): Fix to accomodate compilers other than GCC, which do not allow casts on the LHS of an assignment. * alloc.c (mark_object, mark_buffer): Remove some unused variables.

1907:df8b67adcee3

static void mark_object (), mark_buffer ();
static void clear_marks (), gc_sweep ();
static void compact_strings ();

Lisp_Object
malloc_warning_1 (str)
     Lisp_Object str;
{
  Fprinc (str, Vstandard_output);

  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

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

  traverse_intervals (tree, 1, 0, &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

    
    return result;
  }
}

/* Note: the user cannot manipulate ropes portably by referring
   to the chars of the string, because combining two chars to make a GLYPH
   depends on endianness.  */

DEFUN ("make-rope", Fmake_rope, Smake_rope, 0, MANY, 0,

  if ((XSTRING (r)->size / sizeof (GLYPH)) <= XINT (n) || XINT (n) < 0)
    args_out_of_range (r, n);
  return ((GLYPH *) XSTRING (r)->data)[XFASTINT (n)];
}

/* Must get an error if pure storage is full,
 since if it cannot hold a large string
 it may be able to hold conses that point to that string;
 then the string is not protected from gc. */

Lisp_Object
make_pure_float (num)
     double num;
{
  register Lisp_Object new;

  if (pureptr + sizeof (struct Lisp_Float) > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSET (new, Lisp_Float, PUREBEG + pureptr);
  pureptr += sizeof (struct Lisp_Float);

#if ARRAY_MARK_FLAG == MARKBIT
you lose
#endif

int total_conses, total_markers, total_symbols, total_string_size, total_vector_size;
int total_free_conses, total_free_markers, total_free_symbols;
#ifdef LISP_FLOAT_TYPE
int total_free_floats, total_floats;
#endif /* LISP_FLOAT_TYPE */

      }
  }
}
#endif

/* Mark reference to a Lisp_Object.  If the object referred to
   has not been seen yet, recursively mark all the references contained in it.

   If the object referenced is a short string, the referrencing slot
   is threaded into a chain of such slots, pointed to from
   the `size' field of the string.  The actual string size
   lives in the last slot in the chain.  We recognize the end

#ifdef MULTI_FRAME
    case Lisp_Frame:
      {
	register struct frame *ptr = XFRAME (obj);
	register int size = ptr->size;
	register int i;

	if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
	ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */

	mark_object (&ptr->name);

static void
mark_buffer (buf)
     Lisp_Object buf;
{
  Lisp_Object tem;
  register struct buffer *buffer = XBUFFER (buf);
  register Lisp_Object *ptr;

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

       (char *)ptr < (char *)buffer + sizeof (struct buffer);
       ptr++)
    mark_object (ptr);
}

/* Find all structures not marked, and free them. */

static void
gc_sweep ()
{
  total_string_size = 0;

	  prev = sb, sb = sb->next;
	}
  }
}

/* Compactify strings, relocate references to them, and
   free any string blocks that become empty.  */

static void
compact_strings ()
{
  /* String block of old strings we are scanning.  */

1908:d649f2179d67

static void mark_object (), mark_buffer ();
static void clear_marks (), gc_sweep ();
static void compact_strings ();

/* Versions of malloc and realloc that print warnings as memory gets full.  */

Lisp_Object
malloc_warning_1 (str)
     Lisp_Object str;
{
  Fprinc (str, Vstandard_output);

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

#ifdef USE_TEXT_PROPERTIES
#define INTERVAL_BLOCK_SIZE \
  ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))

struct interval_block

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

  traverse_intervals (tree, 1, 0, mark_interval);
}

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

/* The oddity in the call to XUNMARK is necessary because XUNMARK
   expands to an assigment to its argument, and most C compilers don't
   support casts on the left operand of `='.  */
#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 */

/* Floating point allocation.  */

#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

    
    return result;
  }
}

/* Allocation of ropes.  */

/* Note: the user cannot manipulate ropes portably by referring
   to the chars of the string, because combining two chars to make a GLYPH
   depends on endianness.  */

DEFUN ("make-rope", Fmake_rope, Smake_rope, 0, MANY, 0,

  if ((XSTRING (r)->size / sizeof (GLYPH)) <= XINT (n) || XINT (n) < 0)
    args_out_of_range (r, n);
  return ((GLYPH *) XSTRING (r)->data)[XFASTINT (n)];
}

/* Pure storage management.  */

/* Must get an error if pure storage is full,
 since if it cannot hold a large string
 it may be able to hold conses that point to that string;
 then the string is not protected from gc. */

Lisp_Object
make_pure_float (num)
     double num;
{
  register Lisp_Object new;

  /* Make sure that pureptr is aligned on at least a sizeof (double)
     boundary.  Some architectures (like the sparc) require this, and
     I suspect that floats are rare enough that it's no tragedy for
     those that do.  */
  pureptr = (pureptr + sizeof (num) - 1) & - sizeof (num);

  if (pureptr + sizeof (struct Lisp_Float) > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSET (new, Lisp_Float, PUREBEG + pureptr);
  pureptr += sizeof (struct Lisp_Float);

#if ARRAY_MARK_FLAG == MARKBIT
you lose
#endif

/* Garbage collection!  */

int total_conses, total_markers, total_symbols, total_string_size, total_vector_size;
int total_free_conses, total_free_markers, total_free_symbols;
#ifdef LISP_FLOAT_TYPE
int total_free_floats, total_floats;
#endif /* LISP_FLOAT_TYPE */

      }
  }
}
#endif

/* Mark reference to a Lisp_Object.
  If the object referred to has not been seen yet, recursively mark
  all the references contained in it.

   If the object referenced is a short string, the referrencing slot
   is threaded into a chain of such slots, pointed to from
   the `size' field of the string.  The actual string size
   lives in the last slot in the chain.  We recognize the end

#ifdef MULTI_FRAME
    case Lisp_Frame:
      {
	register struct frame *ptr = XFRAME (obj);
	register int size = ptr->size;

	if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
	ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */

	mark_object (&ptr->name);

static void
mark_buffer (buf)
     Lisp_Object buf;
{
  register struct buffer *buffer = XBUFFER (buf);
  register Lisp_Object *ptr;

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

       (char *)ptr < (char *)buffer + sizeof (struct buffer);
       ptr++)
    mark_object (ptr);
}

/* Sweep: find all structures not marked, and free them. */

static void
gc_sweep ()
{
  total_string_size = 0;

	  prev = sb, sb = sb->next;
	}
  }
}

/* Compactify strings, relocate references, and free empty string blocks.  */

static void
compact_strings ()
{
  /* String block of old strings we are scanning.  */