comparison src/alloc.c @ 20587:eaf988c7e291

(make_pure_string): New arg length_byte. Take account of size used by size_byte; store both sizes. (Fpurecopy): Call make_pure_string the new way. (compact_strings): Use size_byte field to compute string's size. (make_uninit_multibyte_string): New function. (make_uninit_string): Use make_uninit_multibyte_string. (make_multibyte_string): New function. (make_unibyte_string): New function. (make_string): Compute number of chars from the data.

20586:90d6a75210d6

    p->data[i] = real_init;

  return val;
}

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

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

Lisp_Object
make_uninit_string (length)
     int length;
{
  register Lisp_Object val;
  register int fullsize = STRING_FULLSIZE (length);

  if (length < 0) abort ();

  if (fullsize <= STRING_BLOCK_SIZE - current_string_block->pos)
    /* This string can fit in the current string block */

		  (struct Lisp_String *) current_string_block->chars);
    }
    
  string_chars_consed += fullsize;
  XSTRING (val)->size = length;
  XSTRING (val)->data[length] = 0;
  INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);

  return val;
}

 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)
     char *data;
     int length;
{
  register Lisp_Object new;
  register int size = sizeof (EMACS_INT) + INTERVAL_PTR_SIZE + length + 1;

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

  /* We must give strings in pure storage some kind of interval.  So we
     give them a null one.  */
#if defined (USE_TEXT_PROPERTIES)
  XSTRING (new)->intervals = NULL_INTERVAL;

#ifdef LISP_FLOAT_TYPE
  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);
  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;

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

	      /* If it won't fit in TO_SB, close it out,
		 and move to the next sb.  Keep doing so until
		 TO_SB reaches a large enough, empty enough string block.
		 We know that TO_SB cannot advance past FROM_SB here
		 since FROM_SB is large enough to contain this string.
		 Any string blocks skipped here
		 will be patched out and freed later.  */
	      while (to_pos + STRING_FULLSIZE (size)
		     > max (to_sb->pos, STRING_BLOCK_SIZE))
		{
		  to_sb->pos = to_pos;
		  to_sb = to_sb->next;
		  to_pos = 0;
		}
	      /* Compute new address of this string
		 and update TO_POS for the space being used.  */
	      newaddr = (struct Lisp_String *) &to_sb->chars[to_pos];
	      to_pos += STRING_FULLSIZE (size);

	      /* Copy the string itself to the new place.  */
	      if (nextstr != newaddr)
		bcopy (nextstr, newaddr, size + 1 + sizeof (EMACS_INT)
		       + INTERVAL_PTR_SIZE);

	      /* Go through NEXTSTR's chain of references
		 and make each slot in the chain point to
		 the new address of this string.  */
	      size = newaddr->size;

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

  /* Close out the last string block still used and free any that follow.  */
  to_sb->pos = to_pos;

20587:eaf988c7e291

    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;
{
  register Lisp_Object val;
  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;
{
  register Lisp_Object val;
  register int fullsize = STRING_FULLSIZE (length_byte);

  if (length < 0) abort ();

  if (fullsize <= STRING_BLOCK_SIZE - current_string_block->pos)
    /* This string can fit in the current string block */

		  (struct Lisp_String *) current_string_block->chars);
    }
    
  string_chars_consed += fullsize;
  XSTRING (val)->size = length;
  XSTRING (val)->size_byte = length_byte;
  XSTRING (val)->data[length_byte] = 0;
  INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);

  return val;
}

 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 = (2 * sizeof (EMACS_INT)
		       + INTERVAL_PTR_SIZE + length_byte + 1);

  if (pureptr + size > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSETSTRING (new, PUREBEG + pureptr);
  XSTRING (new)->size = length;
  XSTRING (new)->size_byte = 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.  */
#if defined (USE_TEXT_PROPERTIES)
  XSTRING (new)->intervals = NULL_INTERVAL;

#ifdef LISP_FLOAT_TYPE
  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,
			     XSTRING (obj)->size_byte);
  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;
		}

	      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
		 TO_SB reaches a large enough, empty enough string block.
		 We know that TO_SB cannot advance past FROM_SB here
		 since FROM_SB is large enough to contain this string.
		 Any string blocks skipped here
		 will be patched out and freed later.  */
	      while (to_pos + STRING_FULLSIZE (size_byte)
		     > max (to_sb->pos, STRING_BLOCK_SIZE))
		{
		  to_sb->pos = to_pos;
		  to_sb = to_sb->next;
		  to_pos = 0;
		}
	      /* Compute new address of this string
		 and update TO_POS for the space being used.  */
	      newaddr = (struct Lisp_String *) &to_sb->chars[to_pos];
	      to_pos += STRING_FULLSIZE (size_byte);

	      /* Copy the string itself to the new place.  */
	      if (nextstr != newaddr)
		bcopy (nextstr, newaddr, STRING_FULLSIZE (size_byte));

	      /* Go through NEXTSTR's chain of references
		 and make each slot in the chain point to
		 the new address of this string.  */
	      size = newaddr->size;

		  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.  */
  to_sb->pos = to_pos;