comparison src/alloc.c @ 21258:693573ac0944

(make_specified_string): New function. (make_string_from_bytes): New function. (compact_strings): Get byte size from size, if size_byte < 0. (Fmake_string): Use make_uninit_string for single-byte char. (make_unibyte_string): Mark string as unibyte. (make_uninit_string): Likewise. (make_string): Likewise, if size == size in bytes. (make_pure_string): New arg MULTIBYTE. (Fpurecopy): Pass new arg to make_pure_string.

21257:205a5aa4aa2f

  current_string_block->next = 0;
  current_string_block->prev = 0;
  current_string_block->pos = 0;
  large_string_blocks = 0;
}

DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
  "Return a newly created string of length LENGTH, with each element being INIT.\n\
Both LENGTH and INIT must be numbers.")
  (length, init)
     Lisp_Object length, init;

  c = XINT (init);
  if (SINGLE_BYTE_CHAR_P (c))
    {
      nbytes = XINT (length);
      val = make_uninit_multibyte_string (nbytes, nbytes);
      p = XSTRING (val)->data;
      end = p + XSTRING (val)->size;
      while (p != end)
	*p++ = c;
    }

  for (i = 0; i < length_in_chars ; i++)
    p->data[i] = real_init;

  return val;
}

/* Make a string from NBYTES bytes at CONTENTS,
   and compute the number of characters from the contents.  */

Lisp_Object
make_string (contents, nbytes)
     char *contents;
     int nbytes;
{
  register Lisp_Object val;
  int nchars = chars_in_text (contents, nbytes);
  val = make_uninit_multibyte_string (nchars, nbytes);
  bcopy (contents, XSTRING (val)->data, nbytes);
  return val;
}

/* Make a string from LENGTH bytes at CONTENTS,
   assuming each byte is a character.  */

Lisp_Object
make_unibyte_string (contents, length)
     char *contents;
     int length;
{
  register Lisp_Object val;
  val = make_uninit_string (length);
  bcopy (contents, XSTRING (val)->data, length);
  return val;
}

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

Lisp_Object
make_multibyte_string (contents, nchars, nbytes)
     char *contents;
     int nchars, nbytes;

  val = make_uninit_multibyte_string (nchars, nbytes);
  bcopy (contents, XSTRING (val)->data, nbytes);
  return val;
}

/* Make a string from the data at STR,
   treating it as multibyte if the data warrants.  */

Lisp_Object
build_string (str)
     char *str;
{
  return make_string (str, strlen (str));
}

Lisp_Object
make_uninit_string (length)
     int length;
{
  return make_uninit_multibyte_string (length, length);
}

Lisp_Object
make_uninit_multibyte_string (length, length_byte)
     int length, length_byte;

  XSTRING (val)->data[length_byte] = 0;
  INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);

  return val;
}

/* Return a newly created vector or string with specified arguments as
   elements.  If all the arguments are characters that can fit
   in a string of events, make a string; otherwise, make a vector.

   Any number of arguments, even zero arguments, are allowed.  */

 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 (data, length, length_byte)
     char *data;
     int length;
     int length_byte;
{
  register Lisp_Object new;
  register int size = STRING_FULLSIZE (length_byte);

  if (pureptr + size > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSETSTRING (new, PUREBEG + pureptr);
  XSTRING (new)->size = length;
  SET_STRING_BYTES (XSTRING (new), length_byte);
  bcopy (data, XSTRING (new)->data, length_byte);
  XSTRING (new)->data[length_byte] = 0;

  /* We must give strings in pure storage some kind of interval.  So we
     give them a null one.  */

  else if (FLOATP (obj))
    return make_pure_float (XFLOAT (obj)->data);
#endif /* LISP_FLOAT_TYPE */
  else if (STRINGP (obj))
    return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
			     STRING_BYTES (XSTRING (obj)));
  else if (COMPILEDP (obj) || VECTORP (obj))
    {
      register struct Lisp_Vector *vec;
      register int i, size;

	  register struct Lisp_String *nextstr
	    = (struct Lisp_String *) &from_sb->chars[pos];

	  register struct Lisp_String *newaddr;
	  register EMACS_INT size = nextstr->size;
	  EMACS_INT size_byte = STRING_BYTES (nextstr);

	  /* NEXTSTR is the old address of the next string.
	     Just skip it if it isn't marked.  */
	  if (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE)
	    {

		{
		  if (size & DONT_COPY_FLAG)
		    size ^= MARKBIT | DONT_COPY_FLAG;
		  size = *(EMACS_INT *)size & ~MARKBIT;
		}

	      total_string_size += size_byte;

	      /* If it won't fit in TO_SB, close it out,
		 and move to the next sb.  Keep doing so until

		  XSETSTRING (* (Lisp_Object *) &newaddr->intervals->parent,
			      newaddr);
		}
#endif /* USE_TEXT_PROPERTIES */
	    }
	  pos += STRING_FULLSIZE (size_byte);
	}
    }

  /* Close out the last string block still used and free any that follow.  */

21258:693573ac0944

  current_string_block->next = 0;
  current_string_block->prev = 0;
  current_string_block->pos = 0;
  large_string_blocks = 0;
}

DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
  "Return a newly created string of length LENGTH, with each element being INIT.\n\
Both LENGTH and INIT must be numbers.")
  (length, init)
     Lisp_Object length, init;

  c = XINT (init);
  if (SINGLE_BYTE_CHAR_P (c))
    {
      nbytes = XINT (length);
      val = make_uninit_string (nbytes);
      p = XSTRING (val)->data;
      end = p + XSTRING (val)->size;
      while (p != end)
	*p++ = c;
    }

  for (i = 0; i < length_in_chars ; i++)
    p->data[i] = real_init;

  return val;
}

/* 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 (contents, nbytes)
     char *contents;
     int nbytes;
{
  register Lisp_Object val;
  int nchars = chars_in_text (contents, nbytes);
  val = make_uninit_multibyte_string (nchars, nbytes);
  bcopy (contents, XSTRING (val)->data, nbytes);
  if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
    SET_STRING_BYTES (XSTRING (val), -1);
  return val;
}

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

Lisp_Object
make_unibyte_string (contents, length)
     char *contents;
     int length;
{
  register Lisp_Object val;
  val = make_uninit_string (length);
  bcopy (contents, XSTRING (val)->data, length);
  SET_STRING_BYTES (XSTRING (val), -1);
  return val;
}

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

Lisp_Object
make_multibyte_string (contents, nchars, nbytes)
     char *contents;
     int nchars, nbytes;

  val = make_uninit_multibyte_string (nchars, nbytes);
  bcopy (contents, XSTRING (val)->data, 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 (contents, nchars, nbytes)
     char *contents;
     int nchars, nbytes;
{
  register Lisp_Object val;
  val = make_uninit_multibyte_string (nchars, nbytes);
  bcopy (contents, XSTRING (val)->data, nbytes);
  if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
    SET_STRING_BYTES (XSTRING (val), -1);
  return val;
}

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

Lisp_Object
make_specified_string (contents, nchars, nbytes, multibyte)
     char *contents;
     int nchars, nbytes;
     int multibyte;
{
  register Lisp_Object val;
  val = make_uninit_multibyte_string (nchars, nbytes);
  bcopy (contents, XSTRING (val)->data, nbytes);
  if (!multibyte)
    SET_STRING_BYTES (XSTRING (val), -1);
  return val;
}

/* Make a string from the data at STR,
   treating it as multibyte if the data warrants.  */

Lisp_Object
build_string (str)
     char *str;
{
  return make_string (str, strlen (str));
}

Lisp_Object
make_uninit_string (length)
     int length;
{
  Lisp_Object val;
  val = make_uninit_multibyte_string (length, length);
  SET_STRING_BYTES (XSTRING (val), -1);
  return val;
}

Lisp_Object
make_uninit_multibyte_string (length, length_byte)
     int length, length_byte;

  XSTRING (val)->data[length_byte] = 0;
  INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);

  return val;
}

/* Return a newly created vector or string with specified arguments as
   elements.  If all the arguments are characters that can fit
   in a string of events, make a string; otherwise, make a vector.

   Any number of arguments, even zero arguments, are allowed.  */

 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 (data, length, length_byte, multibyte)
     char *data;
     int length;
     int length_byte;
     int multibyte;
{

  register Lisp_Object new;
  register int size = STRING_FULLSIZE (length_byte);

  if (pureptr + size > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSETSTRING (new, PUREBEG + pureptr);
  XSTRING (new)->size = length;
  SET_STRING_BYTES (XSTRING (new), (multibyte ? length_byte : -1));
  bcopy (data, XSTRING (new)->data, length_byte);
  XSTRING (new)->data[length_byte] = 0;

  /* We must give strings in pure storage some kind of interval.  So we
     give them a null one.  */

  else if (FLOATP (obj))
    return make_pure_float (XFLOAT (obj)->data);
#endif /* LISP_FLOAT_TYPE */
  else if (STRINGP (obj))
    return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
			     STRING_BYTES (XSTRING (obj)),
			     STRING_MULTIBYTE (obj));
  else if (COMPILEDP (obj) || VECTORP (obj))
    {
      register struct Lisp_Vector *vec;
      register int i, size;

	  register struct Lisp_String *nextstr
	    = (struct Lisp_String *) &from_sb->chars[pos];

	  register struct Lisp_String *newaddr;
	  register EMACS_INT size = nextstr->size;
	  EMACS_INT size_byte = nextstr->size_byte;

	  /* NEXTSTR is the old address of the next string.
	     Just skip it if it isn't marked.  */
	  if (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE)
	    {

		{
		  if (size & DONT_COPY_FLAG)
		    size ^= MARKBIT | DONT_COPY_FLAG;
		  size = *(EMACS_INT *)size & ~MARKBIT;
		}

	      if (size_byte < 0)
		size_byte = size;

	      total_string_size += size_byte;

	      /* If it won't fit in TO_SB, close it out,
		 and move to the next sb.  Keep doing so until

		  XSETSTRING (* (Lisp_Object *) &newaddr->intervals->parent,
			      newaddr);
		}
#endif /* USE_TEXT_PROPERTIES */
	    }
	  else if (size_byte < 0)
	    size_byte = size;

	  pos += STRING_FULLSIZE (size_byte);
	}
    }

  /* Close out the last string block still used and free any that follow.  */