changeset 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.
author Richard M. Stallman <rms@gnu.org>
date Mon, 05 Jan 1998 17:17:27 +0000
parents 90d6a75210d6
children 138c95482e6b
files src/alloc.c
diffstat 1 files changed, 60 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/src/alloc.c	Mon Jan 05 17:15:53 1998 +0000
+++ b/src/alloc.c	Mon Jan 05 17:17:27 1998 +0000
@@ -1197,8 +1197,26 @@
   return val;
 }
 
+/* Make a string from NBYTES bytes at CONTENTS,
+   and compute the number of characters from the contents.  */
+
 Lisp_Object
-make_string (contents, length)
+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;
 {
@@ -1208,6 +1226,22 @@
   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;
@@ -1219,8 +1253,15 @@
 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);
+  register int fullsize = STRING_FULLSIZE (length_byte);
 
   if (length < 0) abort ();
 
@@ -1276,7 +1317,8 @@
     
   string_chars_consed += fullsize;
   XSTRING (val)->size = length;
-  XSTRING (val)->data[length] = 0;
+  XSTRING (val)->size_byte = length_byte;
+  XSTRING (val)->data[length_byte] = 0;
   INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);
 
   return val;
@@ -1329,19 +1371,22 @@
  then the string is not protected from gc. */
 
 Lisp_Object
-make_pure_string (data, length)
+make_pure_string (data, length, length_byte)
      char *data;
      int length;
+     int length_byte;
 {
   register Lisp_Object new;
-  register int size = sizeof (EMACS_INT) + INTERVAL_PTR_SIZE + length + 1;
+  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;
-  bcopy (data, XSTRING (new)->data, length);
-  XSTRING (new)->data[length] = 0;
+  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.  */
@@ -1445,7 +1490,8 @@
     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);
+    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;
@@ -2539,6 +2585,7 @@
 
 	  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.  */
@@ -2553,7 +2600,7 @@
 		  size = *(EMACS_INT *)size & ~MARKBIT;
 		}
 
-	      total_string_size += 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
@@ -2562,7 +2609,7 @@
 		 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)
+	      while (to_pos + STRING_FULLSIZE (size_byte)
 		     > max (to_sb->pos, STRING_BLOCK_SIZE))
 		{
 		  to_sb->pos = to_pos;
@@ -2572,12 +2619,11 @@
 	      /* 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);
+	      to_pos += STRING_FULLSIZE (size_byte);
 
 	      /* Copy the string itself to the new place.  */
 	      if (nextstr != newaddr)
-		bcopy (nextstr, newaddr, size + 1 + sizeof (EMACS_INT)
-		       + INTERVAL_PTR_SIZE);
+		bcopy (nextstr, newaddr, STRING_FULLSIZE (size_byte));
 
 	      /* Go through NEXTSTR's chain of references
 		 and make each slot in the chain point to
@@ -2613,7 +2659,7 @@
 		}
 #endif /* USE_TEXT_PROPERTIES */
 	    }
-	  pos += STRING_FULLSIZE (size);
+	  pos += STRING_FULLSIZE (size_byte);
 	}
     }