comparison src/alloc.c @ 39572:715a67381594

(purebeg, pure_size, pure_bytes_used_before_overflow): New variables. (init_alloc_once): Initialize new variables. (PURE_POINTER_P): Use new variables. (pure_alloc): If pure storage overflows, allocate from the heap. (check_pure_size): New function. (Fgarbage_collect): Don't GC if pure storage has overflowed. (Vpost_gc_hook, Qpost_gc_hook): New variables. (syms_of_alloc): DEFVAR_LISP post-gc-hook, initialize Qpost_gc_hook. (Fgarbage_collect): Run post-gc-hook. (Fmake_symbol): Adapt to changes of struct Lisp_Symbol.

39571:9b87a63bcb36

/* Force it into data space! */

EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
#define PUREBEG (char *) pure

#else /* not HAVE_SHM */

#define pure PURE_SEG_BITS   /* Use shared memory segment */
#define PUREBEG (char *)PURE_SEG_BITS

/* This variable is used only by the XPNTR macro when HAVE_SHM is
   defined.  If we used the PURESIZE macro directly there, that would
   make most of Emacs dependent on puresize.h, which we don't want -
   you should be able to change that without too much recompilation.
   So map_in_data initializes pure_size, and the dependencies work
   out.  */

EMACS_INT pure_size;

#endif /* not HAVE_SHM */

/* Value is non-zero if P points into pure space.  */

#define PURE_POINTER_P(P)					\
     (((PNTR_COMPARISON_TYPE) (P)				\
       < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE))	\
      && ((PNTR_COMPARISON_TYPE) (P)				\
	  >= (PNTR_COMPARISON_TYPE) pure))

/* Index in pure at which next pure object will be allocated.. */

int pure_bytes_used;

   Currently not used.  */

int ignore_warnings;

Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;

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 *));

      XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
    }
  
  p = XSYMBOL (val);
  p->name = XSTRING (name);
  p->obarray = Qnil;
  p->plist = Qnil;
  p->value = Qunbound;
  p->function = Qunbound;
  p->next = 0;
  consing_since_gc += sizeof (struct Lisp_Symbol);
  symbols_consed++;
  return val;
}

     size_t size;
     int type;
{
  size_t nbytes;
  POINTER_TYPE *result;
  char *beg = PUREBEG;

  /* Give Lisp_Floats an extra alignment.  */
  if (type == Lisp_Float)
    {
      size_t alignment;

#endif
      pure_bytes_used = ALIGN (pure_bytes_used, alignment);
    }
    
  nbytes = ALIGN (size, sizeof (EMACS_INT));
  if (pure_bytes_used + nbytes > PURESIZE)
    error ("Pure Lisp storage exhausted");

  result = (POINTER_TYPE *) (beg + pure_bytes_used);
  pure_bytes_used += nbytes;
  return result;
}


/* Return a string allocated in pure space.  DATA is a buffer holding
   NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE

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

  /* In case user calls debug_print during GC,
     don't let that cause a recursive GC.  */
  consing_since_gc = 0;

    max_zombies = max (nzombies, max_zombies);
    ++ngcs;
    }
#endif

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


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

void
init_alloc_once ()
{
  /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
  pure_bytes_used = 0;
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
  mem_init ();
  Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
#ifdef HAVE_SHM
  pure_size = PURESIZE;
#endif
  all_vectors = 0;
  ignore_warnings = 1;
#ifdef DOUG_LEA_MALLOC
  mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
  mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */

  undo_strong_limit = 30000;

  DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
    "Non-nil means display messages at start and end of garbage collection.");
  garbage_collection_messages = 0;

  /* We build this in advance because if we wait until we need it, we might
     not be able to allocate the memory to hold it.  */
  memory_signal_data
    = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil));

39572:715a67381594

/* Force it into data space! */

EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
#define PUREBEG (char *) pure

#else /* HAVE_SHM */

#define pure PURE_SEG_BITS   /* Use shared memory segment */
#define PUREBEG (char *)PURE_SEG_BITS

#endif /* HAVE_SHM */

/* Pointer to the pure area, and its size.  */

static char *purebeg;
static size_t pure_size;

/* Number of bytes of pure storage used before pure storage overflowed.
   If this is non-zero, this implies that an overflow occurred.  */

static size_t pure_bytes_used_before_overflow;

/* Value is non-zero if P points into pure space.  */

#define PURE_POINTER_P(P)					\
     (((PNTR_COMPARISON_TYPE) (P)				\
       < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size))	\
      && ((PNTR_COMPARISON_TYPE) (P)				\
	  >= (PNTR_COMPARISON_TYPE) purebeg))

/* Index in pure at which next pure object will be allocated.. */

int pure_bytes_used;

   Currently not used.  */

int ignore_warnings;

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 *));

      XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
    }
  
  p = XSYMBOL (val);
  p->name = XSTRING (name);
  p->plist = Qnil;
  p->value = Qunbound;
  p->function = Qunbound;
  p->next = NULL;
  p->interned = SYMBOL_UNINTERNED;
  p->constant = 0;
  p->indirect_variable = 0;
  consing_since_gc += sizeof (struct Lisp_Symbol);
  symbols_consed++;
  return val;
}

     size_t size;
     int type;
{
  size_t nbytes;
  POINTER_TYPE *result;
  char *beg = purebeg;

  /* Give Lisp_Floats an extra alignment.  */
  if (type == Lisp_Float)
    {
      size_t alignment;

#endif
      pure_bytes_used = ALIGN (pure_bytes_used, alignment);
    }
    
  nbytes = ALIGN (size, sizeof (EMACS_INT));
  
  if (pure_bytes_used + nbytes > pure_size)
    {
      beg = purebeg = (char *) xmalloc (PURESIZE);
      pure_size = PURESIZE;
      pure_bytes_used_before_overflow += pure_bytes_used;
      pure_bytes_used = 0;
    }

  result = (POINTER_TYPE *) (beg + pure_bytes_used);
  pure_bytes_used += nbytes;
  return result;
}


/* Signal an error if PURESIZE is too small.  */

void
check_pure_size ()
{
  if (pure_bytes_used_before_overflow)
    error ("Pure Lisp storage overflow (approx. %d bytes needed)",
	   (int) (pure_bytes_used + pure_bytes_used_before_overflow));
}


/* Return a string allocated in pure space.  DATA is a buffer holding
   NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE

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

  /* 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;

  /* In case user calls debug_print during GC,
     don't let that cause a recursive GC.  */
  consing_since_gc = 0;

    max_zombies = max (nzombies, max_zombies);
    ++ngcs;
    }
#endif

  if (!NILP (Vpost_gc_hook))
    {
      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

void
init_alloc_once ()
{
  /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
  purebeg = PUREBEG;
  pure_size = PURESIZE;
  pure_bytes_used = 0;
  pure_bytes_used_before_overflow = 0;

#if GC_MARK_STACK || defined GC_MALLOC_CHECK
  mem_init ();
  Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif

  all_vectors = 0;
  ignore_warnings = 1;
#ifdef DOUG_LEA_MALLOC
  mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
  mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */

  undo_strong_limit = 30000;

  DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
    "Non-nil means display messages at start and end of garbage collection.");
  garbage_collection_messages = 0;

  DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
    "Hook run after garbage collection has finished.");
  Vpost_gc_hook = Qnil;
  Qpost_gc_hook = intern ("post-gc-hook");
  staticpro (&Qpost_gc_hook);

  /* We build this in advance because if we wait until we need it, we might
     not be able to allocate the memory to hold it.  */
  memory_signal_data
    = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil));