comparison src/alloc.c @ 49529:fd79b3081e01

(Vgc_elapsed, gcs_done): New variables. (Fgarbage_collect): Use them. (init_alloc, syms_of_alloc): Set them up.

49528:bbee23d72342

Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;

/* Hook run after GC has finished.  */

Lisp_Object Vpost_gc_hook, Qpost_gc_hook;

static void mark_buffer P_ ((Lisp_Object));
static void mark_kboards P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));

   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
#ifndef DOUG_LEA_MALLOC
extern void * (*__malloc_hook) P_ ((size_t));
extern void * (*__realloc_hook) P_ ((void *, size_t));

      && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
    abort ();
  return nbytes;
}
    
/* Check validity Lisp strings' string_bytes member in B.  */

void
check_sblock (b)
     struct sblock *b;
{

  char stack_top_variable;
  register int i;
  int message_p;
  Lisp_Object total[8];
  int count = SPECPDL_INDEX ();

  /* Can't GC if pure storage overflowed because we can't determine
     if something is a pure object or not.  */
  if (pure_bytes_used_before_overflow)
    return Qnil;

    {
      int count = inhibit_garbage_collection ();
      safe_run_hooks (Qpost_gc_hook);
      unbind_to (count, Qnil);
    }
  
  return Flist (sizeof total / sizeof *total, total);
}


/* Mark Lisp objects in glyph matrix MATRIX.  Currently the

#if GC_MARK_STACK
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
  setjmp_tested_p = longjmps_done = 0;
#endif
#endif
}

void
syms_of_alloc ()
{

  staticpro (&Qgc_cons_threshold);
  Qgc_cons_threshold = intern ("gc-cons-threshold");

  staticpro (&Qchar_table_extra_slots);
  Qchar_table_extra_slots = intern ("char-table-extra-slots");

  defsubr (&Scons);
  defsubr (&Slist);
  defsubr (&Svector);
  defsubr (&Smake_byte_code);

49529:fd79b3081e01

Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;

/* Hook run after GC has finished.  */

Lisp_Object Vpost_gc_hook, Qpost_gc_hook;

Lisp_Object Vgc_elapsed;	/* accumulated elapsed time in GC  */
EMACS_INT gcs_done;		/* accumulated GCs  */

static void mark_buffer P_ ((Lisp_Object));
static void mark_kboards P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));

   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 systems
   can use GNU malloc.  */

#ifndef SYSTEM_MALLOC
#ifndef DOUG_LEA_MALLOC
extern void * (*__malloc_hook) P_ ((size_t));
extern void * (*__realloc_hook) P_ ((void *, size_t));

      && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
    abort ();
  return nbytes;
}
    
/* Check validity of Lisp strings' string_bytes member in B.  */

void
check_sblock (b)
     struct sblock *b;
{

  char stack_top_variable;
  register int i;
  int message_p;
  Lisp_Object total[8];
  int count = SPECPDL_INDEX ();
  EMACS_TIME t1, t2, t3;

  EMACS_GET_TIME (t1);

  /* Can't GC if pure storage overflowed because we can't determine
     if something is a pure object or not.  */
  if (pure_bytes_used_before_overflow)
    return Qnil;

    {
      int count = inhibit_garbage_collection ();
      safe_run_hooks (Qpost_gc_hook);
      unbind_to (count, Qnil);
    }

  /* Accumulate statistics.  */
  EMACS_GET_TIME (t2);
  EMACS_SUB_TIME (t3, t2, t1);
  if (FLOATP (Vgc_elapsed))
    XSETFLOAT (Vgc_elapsed, make_float (XFLOAT_DATA (Vgc_elapsed) +
					EMACS_SECS (t3) +
					EMACS_USECS (t3) * 1.0e-6));
  gcs_done++;

  return Flist (sizeof total / sizeof *total, total);
}


/* Mark Lisp objects in glyph matrix MATRIX.  Currently the

#if GC_MARK_STACK
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
  setjmp_tested_p = longjmps_done = 0;
#endif
#endif
  Vgc_elapsed = make_float (0.0);
  gcs_done = 0;
}

void
syms_of_alloc ()
{

  staticpro (&Qgc_cons_threshold);
  Qgc_cons_threshold = intern ("gc-cons-threshold");

  staticpro (&Qchar_table_extra_slots);
  Qchar_table_extra_slots = intern ("char-table-extra-slots");

  DEFVAR_LISP ("gc-elapsed", &Vgc_elapsed,
	       doc: /* Accumulated time elapsed in garbage collections.
The time is in seconds as a floating point value.
Programs may reset this to get statistics in a specific period.  */);
  DEFVAR_INT ("gcs-done", &gcs_done,
	      doc: /* Accumulated number of garbage collections done.
Programs may reset this to get statistics in a specific period.  */);

  defsubr (&Scons);
  defsubr (&Slist);
  defsubr (&Svector);
  defsubr (&Smake_byte_code);