comparison src/alloc.c @ 110503:fda36a325177

Fix some more uses of int instead of EMACS_INT. font.c (font_intern_prop): Use EMACS_INT for string length variables. character.c (parse_str_as_multibyte, str_as_multibyte) (parse_str_to_multibyte, str_to_multibyte, str_as_unibyte) (string_count_byte8, string_escape_byte8): Use EMACS_INT for string length arguments, variables, and return values. character.h (parse_str_as_multibyte, str_as_multibyte) (parse_str_to_multibyte, str_to_multibyte, str_as_unibyte): Adjust prototypes. fns.c (Fstring_as_multibyte): Use EMACS_INT for string length variables. alloc.c <total_string_size>: Declare as EMACS_INT, not int. (Fmake_string): Protect against too large strings. (live_string_p, live_cons_p, live_symbol_p, live_float_p) (live_misc_p): Use ptrdiff_t instead of int for pointer differences. (string_bytes, check_sblock, check_string_free_list) (allocate_string_data, compact_small_strings, Fmake_string) (Fmake_bool_vector, make_string, make_unibyte_string) (make_multibyte_string, make_string_from_bytes) (make_specified_string_string, Fmake_list, Fmake_vector): Use EMACS_INT for string length variables and arguments. (find_string_data_in_pure, make_pure_string, make_pure_c_string) (Fpurecopy): Use EMACS_INT for string size. (mark_vectorlike, mark_char_table, mark_object): Use EMACS_UINT for vector size. lisp.h (make_string, make_unibyte_string, make_multibyte_string) (make_string_from_bytes, make_specified_string_string) (make_pure_string, string_bytes): Adjust prototypes.

110502:10e44274dbb4

static int total_strings, total_free_strings;

/* Number of bytes used by live strings.  */

static int total_string_size;

/* Given a pointer to a Lisp_String S which is on the free-list
   string_free_list, return a pointer to its successor in the
   free-list.  */

#define CHECK_STRING_BYTES(S)	STRING_BYTES (S)


/* Like GC_STRING_BYTES, but with debugging check.  */

int
string_bytes (s)
     struct Lisp_String *s;
{
  int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
  if (!PURE_POINTER_P (s)
      && s->data
      && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
    abort ();
  return nbytes;

  for (from = &b->first_data; from < end; from = from_end)
    {
      /* Compute the next FROM here because copying below may
	 overwrite data we need to compute it.  */
      int nbytes;

      /* Check that the string size recorded in the string is the
	 same as the one recorded in the sdata structure. */
      if (from->string)
	CHECK_STRING_BYTES (from->string);

  /* Pop a Lisp_String off the free-list.  */
  s = string_free_list;
  while (s != NULL)
    {
      if ((unsigned)s < 1024)
	abort();
      s = NEXT_FREE_LISP_STRING (s);
    }
}
#else

allocate_string_data (struct Lisp_String *s,
		      EMACS_INT nchars, EMACS_INT nbytes)
{
  struct sdata *data, *old_data;
  struct sblock *b;
  int needed, old_nbytes;

  /* Determine the number of bytes needed to store NBYTES bytes
     of string data.  */
  needed = SDATA_SIZE (nbytes);
  old_data = s->data ? SDATA_OF_STRING (s) : NULL;

      for (from = &b->first_data; from < end; from = from_end)
	{
	  /* Compute the next FROM here because copying below may
	     overwrite data we need to compute it.  */
	  int nbytes;

#ifdef GC_CHECK_STRING_BYTES
	  /* Check that the string size recorded in the string is the
	     same as the one recorded in the sdata structure. */
	  if (from->string

INIT must be an integer that represents a character.  */)
  (Lisp_Object length, Lisp_Object init)
{
  register Lisp_Object val;
  register unsigned char *p, *end;
  int c, nbytes;

  CHECK_NATNUM (length);
  CHECK_NUMBER (init);

  c = XINT (init);

    }
  else
    {
      unsigned char str[MAX_MULTIBYTE_LENGTH];
      int len = CHAR_STRING (c, str);

      nbytes = len * XINT (length);
      val = make_uninit_multibyte_string (XINT (length), nbytes);
      p = SDATA (val);
      end = p + nbytes;
      while (p != end)
	{
	  memcpy (p, str, len);

  (Lisp_Object length, Lisp_Object init)
{
  register Lisp_Object val;
  struct Lisp_Bool_Vector *p;
  int real_init, i;
  int length_in_chars, length_in_elts, bits_per_value;

  CHECK_NATNUM (length);

  bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;

/* Make a string from NBYTES bytes at CONTENTS, and compute the number
   of characters from the contents.  This string may be unibyte or
   multibyte, depending on the contents.  */

Lisp_Object
make_string (const char *contents, int nbytes)
{
  register Lisp_Object val;
  int nchars, multibyte_nbytes;

  parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
  if (nbytes == nchars || nbytes != multibyte_nbytes)
    /* CONTENTS contains no multibyte sequences or contains an invalid
       multibyte sequence.  We must make unibyte string.  */

/* Make an unibyte string from LENGTH bytes at CONTENTS.  */

Lisp_Object
make_unibyte_string (const char *contents, int length)
{
  register Lisp_Object val;
  val = make_uninit_string (length);
  memcpy (SDATA (val), contents, length);
  STRING_SET_UNIBYTE (val);

/* Make a multibyte string from NCHARS characters occupying NBYTES
   bytes at CONTENTS.  */

Lisp_Object
make_multibyte_string (const char *contents, int nchars, int nbytes)
{
  register Lisp_Object val;
  val = make_uninit_multibyte_string (nchars, nbytes);
  memcpy (SDATA (val), contents, nbytes);
  return val;

/* Make a string from NCHARS characters occupying NBYTES bytes at
   CONTENTS.  It is a multibyte string if NBYTES != NCHARS.  */

Lisp_Object
make_string_from_bytes (const char *contents, int nchars, int nbytes)
{
  register Lisp_Object val;
  val = make_uninit_multibyte_string (nchars, nbytes);
  memcpy (SDATA (val), contents, nbytes);
  if (SBYTES (val) == SCHARS (val))

   CONTENTS.  The argument MULTIBYTE controls whether to label the
   string as multibyte.  If NCHARS is negative, it counts the number of
   characters by itself.  */

Lisp_Object
make_specified_string (const char *contents, int nchars, int nbytes, int multibyte)
{
  register Lisp_Object val;

  if (nchars < 0)
    {

DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
       doc: /* Return a newly created list of length LENGTH, with each element being INIT.  */)
  (register Lisp_Object length, Lisp_Object init)
{
  register Lisp_Object val;
  register int size;

  CHECK_NATNUM (length);
  size = XFASTINT (length);

  val = Qnil;

See also the function `vector'.  */)
  (register Lisp_Object length, Lisp_Object init)
{
  Lisp_Object vector;
  register EMACS_INT sizei;
  register int index;
  register struct Lisp_Vector *p;

  CHECK_NATNUM (length);
  sizei = XFASTINT (length);

live_string_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_STRING)
    {
      struct string_block *b = (struct string_block *) m->start;
      int offset = (char *) p - (char *) &b->strings[0];

      /* P must point to the start of a Lisp_String structure, and it
	 must not be on the free-list.  */
      return (offset >= 0
	      && offset % sizeof b->strings[0] == 0

live_cons_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_CONS)
    {
      struct cons_block *b = (struct cons_block *) m->start;
      int offset = (char *) p - (char *) &b->conses[0];

      /* P must point to the start of a Lisp_Cons, not be
	 one of the unused cells in the current cons block,
	 and not be on the free-list.  */
      return (offset >= 0

live_symbol_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_SYMBOL)
    {
      struct symbol_block *b = (struct symbol_block *) m->start;
      int offset = (char *) p - (char *) &b->symbols[0];

      /* P must point to the start of a Lisp_Symbol, not be
	 one of the unused cells in the current symbol block,
	 and not be on the free-list.  */
      return (offset >= 0

live_float_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_FLOAT)
    {
      struct float_block *b = (struct float_block *) m->start;
      int offset = (char *) p - (char *) &b->floats[0];

      /* P must point to the start of a Lisp_Float and not be
	 one of the unused cells in the current float block.  */
      return (offset >= 0
	      && offset % sizeof b->floats[0] == 0

live_misc_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_MISC)
    {
      struct marker_block *b = (struct marker_block *) m->start;
      int offset = (char *) p - (char *) &b->markers[0];

      /* P must point to the start of a Lisp_Misc, not be
	 one of the unused cells in the current misc block,
	 and not be on the free-list.  */
      return (offset >= 0

/* 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 (const char *data, int nbytes)
{
  int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
  const unsigned char *p;
  char *non_lisp_beg;

  if (pure_bytes_used_non_lisp < nbytes + 1)
    return NULL;

   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_string (const char *data, int nchars, int nbytes, int multibyte)
{
  Lisp_Object string;
  struct Lisp_String *s;

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);

Lisp_Object
make_pure_c_string (const char *data)
{
  Lisp_Object string;
  struct Lisp_String *s;
  int nchars = strlen (data);

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
  s->size = nchars;
  s->size_byte = -1;
  s->data = (unsigned char *) data;

			    SBYTES (obj),
			    STRING_MULTIBYTE (obj));
  else if (COMPILEDP (obj) || VECTORP (obj))
    {
      register struct Lisp_Vector *vec;
      register int i;
      EMACS_INT size;

      size = XVECTOR (obj)->size;
      if (size & PSEUDOVECTOR_FLAG)
	size &= PSEUDOVECTOR_SIZE_MASK;

static int mark_object_loop_halt;

static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
  register EMACS_INT size = ptr->size;
  register int i;

  eassert (!VECTOR_MARKED_P (ptr));
  VECTOR_MARK (ptr);		/* Else mark it */
  if (size & PSEUDOVECTOR_FLAG)
    size &= PSEUDOVECTOR_SIZE_MASK;

   symbols.  */

static void
mark_char_table (struct Lisp_Vector *ptr)
{
  register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
  register int i;

  eassert (!VECTOR_MARKED_P (ptr));
  VECTOR_MARK (ptr);
  for (i = 0; i < size; i++)
    {

	/* We could treat this just like a vector, but it is better to
	   save the COMPILED_CONSTANTS element for last and avoid
	   recursion there.  */
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  register EMACS_INT size = ptr->size;
	  register int i;

	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);	/* Else mark it */
	  size &= PSEUDOVECTOR_SIZE_MASK;
	  for (i = 0; i < size; i++) /* and then mark its elements */

110503:fda36a325177

static int total_strings, total_free_strings;

/* Number of bytes used by live strings.  */

static EMACS_INT total_string_size;

/* Given a pointer to a Lisp_String S which is on the free-list
   string_free_list, return a pointer to its successor in the
   free-list.  */

#define CHECK_STRING_BYTES(S)	STRING_BYTES (S)


/* Like GC_STRING_BYTES, but with debugging check.  */

EMACS_INT
string_bytes (struct Lisp_String *s)
{
  EMACS_INT nbytes =
    (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);

  if (!PURE_POINTER_P (s)
      && s->data
      && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
    abort ();
  return nbytes;

  for (from = &b->first_data; from < end; from = from_end)
    {
      /* Compute the next FROM here because copying below may
	 overwrite data we need to compute it.  */
      EMACS_INT nbytes;

      /* Check that the string size recorded in the string is the
	 same as the one recorded in the sdata structure. */
      if (from->string)
	CHECK_STRING_BYTES (from->string);

  /* Pop a Lisp_String off the free-list.  */
  s = string_free_list;
  while (s != NULL)
    {
      if ((unsigned long)s < 1024)
	abort();
      s = NEXT_FREE_LISP_STRING (s);
    }
}
#else

allocate_string_data (struct Lisp_String *s,
		      EMACS_INT nchars, EMACS_INT nbytes)
{
  struct sdata *data, *old_data;
  struct sblock *b;
  EMACS_INT needed, old_nbytes;

  /* Determine the number of bytes needed to store NBYTES bytes
     of string data.  */
  needed = SDATA_SIZE (nbytes);
  old_data = s->data ? SDATA_OF_STRING (s) : NULL;

      for (from = &b->first_data; from < end; from = from_end)
	{
	  /* Compute the next FROM here because copying below may
	     overwrite data we need to compute it.  */
	  EMACS_INT nbytes;

#ifdef GC_CHECK_STRING_BYTES
	  /* Check that the string size recorded in the string is the
	     same as the one recorded in the sdata structure. */
	  if (from->string

INIT must be an integer that represents a character.  */)
  (Lisp_Object length, Lisp_Object init)
{
  register Lisp_Object val;
  register unsigned char *p, *end;
  int c;
  EMACS_INT nbytes;

  CHECK_NATNUM (length);
  CHECK_NUMBER (init);

  c = XINT (init);

    }
  else
    {
      unsigned char str[MAX_MULTIBYTE_LENGTH];
      int len = CHAR_STRING (c, str);
      EMACS_INT string_len = XINT (length);

      if (string_len > MOST_POSITIVE_FIXNUM / len)
	error ("Maximum string size exceeded");
      nbytes = len * string_len;
      val = make_uninit_multibyte_string (string_len, nbytes);
      p = SDATA (val);
      end = p + nbytes;
      while (p != end)
	{
	  memcpy (p, str, len);

  (Lisp_Object length, Lisp_Object init)
{
  register Lisp_Object val;
  struct Lisp_Bool_Vector *p;
  int real_init, i;
  EMACS_INT length_in_chars, length_in_elts;
  int bits_per_value;

  CHECK_NATNUM (length);

  bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;

/* Make a string from NBYTES bytes at CONTENTS, and compute the number
   of characters from the contents.  This string may be unibyte or
   multibyte, depending on the contents.  */

Lisp_Object
make_string (const char *contents, EMACS_INT nbytes)
{
  register Lisp_Object val;
  EMACS_INT nchars, multibyte_nbytes;

  parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
  if (nbytes == nchars || nbytes != multibyte_nbytes)
    /* CONTENTS contains no multibyte sequences or contains an invalid
       multibyte sequence.  We must make unibyte string.  */

/* Make an unibyte string from LENGTH bytes at CONTENTS.  */

Lisp_Object
make_unibyte_string (const char *contents, EMACS_INT length)
{
  register Lisp_Object val;
  val = make_uninit_string (length);
  memcpy (SDATA (val), contents, length);
  STRING_SET_UNIBYTE (val);

/* Make a multibyte string from NCHARS characters occupying NBYTES
   bytes at CONTENTS.  */

Lisp_Object
make_multibyte_string (const char *contents,
		       EMACS_INT nchars, EMACS_INT nbytes)
{
  register Lisp_Object val;
  val = make_uninit_multibyte_string (nchars, nbytes);
  memcpy (SDATA (val), contents, nbytes);
  return val;

/* Make a string from NCHARS characters occupying NBYTES bytes at
   CONTENTS.  It is a multibyte string if NBYTES != NCHARS.  */

Lisp_Object
make_string_from_bytes (const char *contents,
			EMACS_INT nchars, EMACS_INT nbytes)
{
  register Lisp_Object val;
  val = make_uninit_multibyte_string (nchars, nbytes);
  memcpy (SDATA (val), contents, nbytes);
  if (SBYTES (val) == SCHARS (val))

   CONTENTS.  The argument MULTIBYTE controls whether to label the
   string as multibyte.  If NCHARS is negative, it counts the number of
   characters by itself.  */

Lisp_Object
make_specified_string (const char *contents,
		       EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
{
  register Lisp_Object val;

  if (nchars < 0)
    {

DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
       doc: /* Return a newly created list of length LENGTH, with each element being INIT.  */)
  (register Lisp_Object length, Lisp_Object init)
{
  register Lisp_Object val;
  register EMACS_INT size;

  CHECK_NATNUM (length);
  size = XFASTINT (length);

  val = Qnil;

See also the function `vector'.  */)
  (register Lisp_Object length, Lisp_Object init)
{
  Lisp_Object vector;
  register EMACS_INT sizei;
  register EMACS_INT index;
  register struct Lisp_Vector *p;

  CHECK_NATNUM (length);
  sizei = XFASTINT (length);

live_string_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_STRING)
    {
      struct string_block *b = (struct string_block *) m->start;
      ptrdiff_t offset = (char *) p - (char *) &b->strings[0];

      /* P must point to the start of a Lisp_String structure, and it
	 must not be on the free-list.  */
      return (offset >= 0
	      && offset % sizeof b->strings[0] == 0

live_cons_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_CONS)
    {
      struct cons_block *b = (struct cons_block *) m->start;
      ptrdiff_t offset = (char *) p - (char *) &b->conses[0];

      /* P must point to the start of a Lisp_Cons, not be
	 one of the unused cells in the current cons block,
	 and not be on the free-list.  */
      return (offset >= 0

live_symbol_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_SYMBOL)
    {
      struct symbol_block *b = (struct symbol_block *) m->start;
      ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];

      /* P must point to the start of a Lisp_Symbol, not be
	 one of the unused cells in the current symbol block,
	 and not be on the free-list.  */
      return (offset >= 0

live_float_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_FLOAT)
    {
      struct float_block *b = (struct float_block *) m->start;
      ptrdiff_t offset = (char *) p - (char *) &b->floats[0];

      /* P must point to the start of a Lisp_Float and not be
	 one of the unused cells in the current float block.  */
      return (offset >= 0
	      && offset % sizeof b->floats[0] == 0

live_misc_p (struct mem_node *m, void *p)
{
  if (m->type == MEM_TYPE_MISC)
    {
      struct marker_block *b = (struct marker_block *) m->start;
      ptrdiff_t offset = (char *) p - (char *) &b->markers[0];

      /* P must point to the start of a Lisp_Misc, not be
	 one of the unused cells in the current misc block,
	 and not be on the free-list.  */
      return (offset >= 0

/* 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 (const char *data, EMACS_INT nbytes)
{
  int i;
  EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
  const unsigned char *p;
  char *non_lisp_beg;

  if (pure_bytes_used_non_lisp < nbytes + 1)
    return NULL;

   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_string (const char *data,
		  EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
{
  Lisp_Object string;
  struct Lisp_String *s;

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);

Lisp_Object
make_pure_c_string (const char *data)
{
  Lisp_Object string;
  struct Lisp_String *s;
  EMACS_INT nchars = strlen (data);

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
  s->size = nchars;
  s->size_byte = -1;
  s->data = (unsigned char *) data;

			    SBYTES (obj),
			    STRING_MULTIBYTE (obj));
  else if (COMPILEDP (obj) || VECTORP (obj))
    {
      register struct Lisp_Vector *vec;
      register EMACS_INT i;
      EMACS_INT size;

      size = XVECTOR (obj)->size;
      if (size & PSEUDOVECTOR_FLAG)
	size &= PSEUDOVECTOR_SIZE_MASK;

static int mark_object_loop_halt;

static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
  register EMACS_UINT size = ptr->size;
  register EMACS_UINT i;

  eassert (!VECTOR_MARKED_P (ptr));
  VECTOR_MARK (ptr);		/* Else mark it */
  if (size & PSEUDOVECTOR_FLAG)
    size &= PSEUDOVECTOR_SIZE_MASK;

   symbols.  */

static void
mark_char_table (struct Lisp_Vector *ptr)
{
  register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
  register EMACS_UINT i;

  eassert (!VECTOR_MARKED_P (ptr));
  VECTOR_MARK (ptr);
  for (i = 0; i < size; i++)
    {

	/* We could treat this just like a vector, but it is better to
	   save the COMPILED_CONSTANTS element for last and avoid
	   recursion there.  */
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  register EMACS_UINT size = ptr->size;
	  register EMACS_UINT i;

	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);	/* Else mark it */
	  size &= PSEUDOVECTOR_SIZE_MASK;
	  for (i = 0; i < size; i++) /* and then mark its elements */