comparison src/alloc.c @ 83533:02e39decdc84

Merged from [e-mail] Patches applied: * [e-mail]/emacs--devo--0--patch-351 Update from CVS * [e-mail]/emacs--devo--0--patch-352 Update from CVS * [e-mail]/emacs--devo--0--patch-353 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-354 Update from CVS * [e-mail]/emacs--devo--0--patch-355 Update from CVS * [e-mail]/emacs--devo--0--patch-356 Update from CVS * [e-mail]/emacs--devo--0--patch-357 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-358 Update from CVS * [e-mail]/emacs--devo--0--patch-359 Update from CVS * [e-mail]/emacs--devo--0--patch-360 Update from CVS * [e-mail]/emacs--devo--0--patch-361 Update from CVS * [e-mail]/emacs--devo--0--patch-362 Update from CVS * [e-mail]/emacs--devo--0--patch-363 Update from CVS * [e-mail]/emacs--devo--0--patch-364 Update from CVS * [e-mail]/emacs--devo--0--patch-365 Update from CVS * [e-mail]/emacs--devo--0--patch-366 Update from CVS * [e-mail]/emacs--devo--0--patch-367 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-368 Update from CVS * [e-mail]/emacs--devo--0--patch-369 Update from CVS * [e-mail]/emacs--devo--0--patch-370 Update from CVS * [e-mail]/gnus--rel--5.10--patch-115 Update from CVS * [e-mail]/gnus--rel--5.10--patch-116 Update from CVS * [e-mail]/gnus--rel--5.10--patch-117 Update from CVS * [e-mail]/gnus--rel--5.10--patch-118 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-119 Update from CVS * [e-mail]/gnus--rel--5.10--patch-120 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-573

83532:b19aaf4ab0ee

     (((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.. */

EMACS_INT pure_bytes_used;

/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

char *pending_malloc_warning;

  memory_full ();
#endif

  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
  while (1)
    Fsignal (Qnil, Vmemory_signal_data);
}


#ifdef XMALLOC_OVERRUN_CHECK

  while (tail)
    tail = tail->u.chain;
#endif
}

/* Make a list of 2, 3, 4 or 5 specified objects.  */

Lisp_Object
list2 (arg1, arg2)
     Lisp_Object arg1, arg2;
{

  bytes_used_when_full = BYTES_USED;
#endif

  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
  while (1)
    Fsignal (Qnil, Vmemory_signal_data);
}

/* If we released our reserve (due to running out of memory),
   and we have a fair amount free once again,
   try to set aside another reserve in case we run out once more.

		       Pure Storage Management
 ***********************************************************************/

/* Allocate room for SIZE bytes from pure Lisp storage and return a
   pointer to it.  TYPE is the Lisp type for which the memory is
   allocated.  TYPE < 0 means it's not used for a Lisp object.

   If store_pure_type_info is set and TYPE is >= 0, the type of
   the allocated object is recorded in pure_types.  */

static POINTER_TYPE *
pure_alloc (size, type)
     size_t size;
     int type;

#endif
    }
#endif

 again:
  result = ALIGN (purebeg + pure_bytes_used, alignment);
  pure_bytes_used = ((char *)result - (char *)purebeg) + size;

  if (pure_bytes_used <= pure_size)
    return result;

  /* Don't allocate a large amount here,

     might not be usable.  */
  purebeg = (char *) xmalloc (10000);
  pure_size = 10000;
  pure_bytes_used_before_overflow += pure_bytes_used - size;
  pure_bytes_used = 0;
  goto again;
}


/* Print a warning if PURESIZE is too small.  */

check_pure_size ()
{
  if (pure_bytes_used_before_overflow)
    message ("emacs:0: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

{
  Lisp_Object string;
  struct Lisp_String *s;

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
  s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
  s->size = nchars;
  s->size_byte = multibyte ? nbytes : -1;
  bcopy (data, s->data, nbytes);
  s->data[nbytes] = '\0';
  s->intervals = NULL_INTERVAL;
  XSETSTRING (string, s);
  return string;
}

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

  /* Initialize the list of free aligned blocks.  */
  free_ablock = NULL;

83533:02e39decdc84

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

/* Total number of bytes allocated in pure storage. */

EMACS_INT pure_bytes_used;

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

static EMACS_INT pure_bytes_used_lisp;

/* Number of bytes allocated for non-Lisp objects in pure storage.  */

static EMACS_INT pure_bytes_used_non_lisp;

/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

char *pending_malloc_warning;

  memory_full ();
#endif

  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
  xsignal (Qnil, Vmemory_signal_data);
}


#ifdef XMALLOC_OVERRUN_CHECK

  while (tail)
    tail = tail->u.chain;
#endif
}

/* Make a list of 1, 2, 3, 4 or 5 specified objects.  */

Lisp_Object
list1 (arg1)
     Lisp_Object arg1;
{
  return Fcons (arg1, Qnil);
}

Lisp_Object
list2 (arg1, arg2)
     Lisp_Object arg1, arg2;
{

  bytes_used_when_full = BYTES_USED;
#endif

  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
  xsignal (Qnil, Vmemory_signal_data);
}

/* If we released our reserve (due to running out of memory),
   and we have a fair amount free once again,
   try to set aside another reserve in case we run out once more.

		       Pure Storage Management
 ***********************************************************************/

/* Allocate room for SIZE bytes from pure Lisp storage and return a
   pointer to it.  TYPE is the Lisp type for which the memory is
   allocated.  TYPE < 0 means it's not used for a Lisp object.  */

static POINTER_TYPE *
pure_alloc (size, type)
     size_t size;
     int type;

#endif
    }
#endif

 again:
  if (type >= 0)
    {
      /* Allocate space for a Lisp object from the beginning of the free
	 space with taking account of alignment.  */
      result = ALIGN (purebeg + pure_bytes_used_lisp, alignment);
      pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
    }
  else
    {
      /* Allocate space for a non-Lisp object from the end of the free
	 space.  */
      pure_bytes_used_non_lisp += size;
      result = purebeg + pure_size - pure_bytes_used_non_lisp;
    }
  pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;

  if (pure_bytes_used <= pure_size)
    return result;

  /* Don't allocate a large amount here,

     might not be usable.  */
  purebeg = (char *) xmalloc (10000);
  pure_size = 10000;
  pure_bytes_used_before_overflow += pure_bytes_used - size;
  pure_bytes_used = 0;
  pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
  goto again;
}


/* Print a warning if PURESIZE is too small.  */

check_pure_size ()
{
  if (pure_bytes_used_before_overflow)
    message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
	     (int) (pure_bytes_used + pure_bytes_used_before_overflow));
}


/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from
   the non-Lisp data pool of the pure storage, and return its start
   address.  Return NULL if not found.  */

static char *
find_string_data_in_pure (data, nbytes)
     char *data;
     int nbytes;
{
  int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
  unsigned char *p;
  char *non_lisp_beg;

  if (pure_bytes_used_non_lisp < nbytes + 1)
    return NULL;

  /* Set up the Boyer-Moore table.  */
  skip = nbytes + 1;
  for (i = 0; i < 256; i++)
    bm_skip[i] = skip;

  p = (unsigned char *) data;
  while (--skip > 0)
    bm_skip[*p++] = skip;

  last_char_skip = bm_skip['\0'];

  non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp;
  start_max = pure_bytes_used_non_lisp - (nbytes + 1);

  /* See the comments in the function `boyer_moore' (search.c) for the
     use of `infinity'.  */
  infinity = pure_bytes_used_non_lisp + 1;
  bm_skip['\0'] = infinity;

  p = (unsigned char *) non_lisp_beg + nbytes;
  start = 0;
  do
    {
      /* Check the last character (== '\0').  */
      do
	{
	  start += bm_skip[*(p + start)];
	}
      while (start <= start_max);

      if (start < infinity)
	/* Couldn't find the last character.  */
	return NULL;

      /* No less than `infinity' means we could find the last
	 character at `p[start - infinity]'.  */
      start -= infinity;

      /* Check the remaining characters.  */
      if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
	/* Found.  */
	return non_lisp_beg + start;

      start += last_char_skip;
    }
  while (start <= start_max);

  return NULL;
}


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

{
  Lisp_Object string;
  struct Lisp_String *s;

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
  s->data = find_string_data_in_pure (data, nbytes);
  if (s->data == NULL)
    {
      s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
      bcopy (data, s->data, nbytes);
      s->data[nbytes] = '\0';
    }
  s->size = nchars;
  s->size_byte = multibyte ? nbytes : -1;
  s->intervals = NULL_INTERVAL;
  XSETSTRING (string, s);
  return string;
}

{
  /* 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_lisp = pure_bytes_used_non_lisp = 0;
  pure_bytes_used_before_overflow = 0;

  /* Initialize the list of free aligned blocks.  */
  free_ablock = NULL;