aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c74
1 files changed, 60 insertions, 14 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 528cd2e118e..d6294c69523 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1197,8 +1197,26 @@ LENGTH must be a number. INIT matters only in whether it is t or nil.")
1197 return val; 1197 return val;
1198} 1198}
1199 1199
1200/* Make a string from NBYTES bytes at CONTENTS,
1201 and compute the number of characters from the contents. */
1202
1200Lisp_Object 1203Lisp_Object
1201make_string (contents, length) 1204make_string (contents, nbytes)
1205 char *contents;
1206 int nbytes;
1207{
1208 register Lisp_Object val;
1209 int nchars = chars_in_text (contents, nbytes);
1210 val = make_uninit_multibyte_string (nchars, nbytes);
1211 bcopy (contents, XSTRING (val)->data, nbytes);
1212 return val;
1213}
1214
1215/* Make a string from LENGTH bytes at CONTENTS,
1216 assuming each byte is a character. */
1217
1218Lisp_Object
1219make_unibyte_string (contents, length)
1202 char *contents; 1220 char *contents;
1203 int length; 1221 int length;
1204{ 1222{
@@ -1208,6 +1226,22 @@ make_string (contents, length)
1208 return val; 1226 return val;
1209} 1227}
1210 1228
1229/* Make a string from NCHARS characters occupying NBYTES bytes at CONTENTS. */
1230
1231Lisp_Object
1232make_multibyte_string (contents, nchars, nbytes)
1233 char *contents;
1234 int nchars, nbytes;
1235{
1236 register Lisp_Object val;
1237 val = make_uninit_multibyte_string (nchars, nbytes);
1238 bcopy (contents, XSTRING (val)->data, nbytes);
1239 return val;
1240}
1241
1242/* Make a string from the data at STR,
1243 treating it as multibyte if the data warrants. */
1244
1211Lisp_Object 1245Lisp_Object
1212build_string (str) 1246build_string (str)
1213 char *str; 1247 char *str;
@@ -1219,8 +1253,15 @@ Lisp_Object
1219make_uninit_string (length) 1253make_uninit_string (length)
1220 int length; 1254 int length;
1221{ 1255{
1256 return make_uninit_multibyte_string (length, length);
1257}
1258
1259Lisp_Object
1260make_uninit_multibyte_string (length, length_byte)
1261 int length, length_byte;
1262{
1222 register Lisp_Object val; 1263 register Lisp_Object val;
1223 register int fullsize = STRING_FULLSIZE (length); 1264 register int fullsize = STRING_FULLSIZE (length_byte);
1224 1265
1225 if (length < 0) abort (); 1266 if (length < 0) abort ();
1226 1267
@@ -1276,7 +1317,8 @@ make_uninit_string (length)
1276 1317
1277 string_chars_consed += fullsize; 1318 string_chars_consed += fullsize;
1278 XSTRING (val)->size = length; 1319 XSTRING (val)->size = length;
1279 XSTRING (val)->data[length] = 0; 1320 XSTRING (val)->size_byte = length_byte;
1321 XSTRING (val)->data[length_byte] = 0;
1280 INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL); 1322 INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL);
1281 1323
1282 return val; 1324 return val;
@@ -1329,19 +1371,22 @@ make_event_array (nargs, args)
1329 then the string is not protected from gc. */ 1371 then the string is not protected from gc. */
1330 1372
1331Lisp_Object 1373Lisp_Object
1332make_pure_string (data, length) 1374make_pure_string (data, length, length_byte)
1333 char *data; 1375 char *data;
1334 int length; 1376 int length;
1377 int length_byte;
1335{ 1378{
1336 register Lisp_Object new; 1379 register Lisp_Object new;
1337 register int size = sizeof (EMACS_INT) + INTERVAL_PTR_SIZE + length + 1; 1380 register int size = (2 * sizeof (EMACS_INT)
1381 + INTERVAL_PTR_SIZE + length_byte + 1);
1338 1382
1339 if (pureptr + size > PURESIZE) 1383 if (pureptr + size > PURESIZE)
1340 error ("Pure Lisp storage exhausted"); 1384 error ("Pure Lisp storage exhausted");
1341 XSETSTRING (new, PUREBEG + pureptr); 1385 XSETSTRING (new, PUREBEG + pureptr);
1342 XSTRING (new)->size = length; 1386 XSTRING (new)->size = length;
1343 bcopy (data, XSTRING (new)->data, length); 1387 XSTRING (new)->size_byte = length_byte;
1344 XSTRING (new)->data[length] = 0; 1388 bcopy (data, XSTRING (new)->data, length_byte);
1389 XSTRING (new)->data[length_byte] = 0;
1345 1390
1346 /* We must give strings in pure storage some kind of interval. So we 1391 /* We must give strings in pure storage some kind of interval. So we
1347 give them a null one. */ 1392 give them a null one. */
@@ -1445,7 +1490,8 @@ Does not copy symbols.")
1445 return make_pure_float (XFLOAT (obj)->data); 1490 return make_pure_float (XFLOAT (obj)->data);
1446#endif /* LISP_FLOAT_TYPE */ 1491#endif /* LISP_FLOAT_TYPE */
1447 else if (STRINGP (obj)) 1492 else if (STRINGP (obj))
1448 return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size); 1493 return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
1494 XSTRING (obj)->size_byte);
1449 else if (COMPILEDP (obj) || VECTORP (obj)) 1495 else if (COMPILEDP (obj) || VECTORP (obj))
1450 { 1496 {
1451 register struct Lisp_Vector *vec; 1497 register struct Lisp_Vector *vec;
@@ -2539,6 +2585,7 @@ compact_strings ()
2539 2585
2540 register struct Lisp_String *newaddr; 2586 register struct Lisp_String *newaddr;
2541 register EMACS_INT size = nextstr->size; 2587 register EMACS_INT size = nextstr->size;
2588 EMACS_INT size_byte = nextstr->size_byte;
2542 2589
2543 /* NEXTSTR is the old address of the next string. 2590 /* NEXTSTR is the old address of the next string.
2544 Just skip it if it isn't marked. */ 2591 Just skip it if it isn't marked. */
@@ -2553,7 +2600,7 @@ compact_strings ()
2553 size = *(EMACS_INT *)size & ~MARKBIT; 2600 size = *(EMACS_INT *)size & ~MARKBIT;
2554 } 2601 }
2555 2602
2556 total_string_size += size; 2603 total_string_size += size_byte;
2557 2604
2558 /* If it won't fit in TO_SB, close it out, 2605 /* If it won't fit in TO_SB, close it out,
2559 and move to the next sb. Keep doing so until 2606 and move to the next sb. Keep doing so until
@@ -2562,7 +2609,7 @@ compact_strings ()
2562 since FROM_SB is large enough to contain this string. 2609 since FROM_SB is large enough to contain this string.
2563 Any string blocks skipped here 2610 Any string blocks skipped here
2564 will be patched out and freed later. */ 2611 will be patched out and freed later. */
2565 while (to_pos + STRING_FULLSIZE (size) 2612 while (to_pos + STRING_FULLSIZE (size_byte)
2566 > max (to_sb->pos, STRING_BLOCK_SIZE)) 2613 > max (to_sb->pos, STRING_BLOCK_SIZE))
2567 { 2614 {
2568 to_sb->pos = to_pos; 2615 to_sb->pos = to_pos;
@@ -2572,12 +2619,11 @@ compact_strings ()
2572 /* Compute new address of this string 2619 /* Compute new address of this string
2573 and update TO_POS for the space being used. */ 2620 and update TO_POS for the space being used. */
2574 newaddr = (struct Lisp_String *) &to_sb->chars[to_pos]; 2621 newaddr = (struct Lisp_String *) &to_sb->chars[to_pos];
2575 to_pos += STRING_FULLSIZE (size); 2622 to_pos += STRING_FULLSIZE (size_byte);
2576 2623
2577 /* Copy the string itself to the new place. */ 2624 /* Copy the string itself to the new place. */
2578 if (nextstr != newaddr) 2625 if (nextstr != newaddr)
2579 bcopy (nextstr, newaddr, size + 1 + sizeof (EMACS_INT) 2626 bcopy (nextstr, newaddr, STRING_FULLSIZE (size_byte));
2580 + INTERVAL_PTR_SIZE);
2581 2627
2582 /* Go through NEXTSTR's chain of references 2628 /* Go through NEXTSTR's chain of references
2583 and make each slot in the chain point to 2629 and make each slot in the chain point to
@@ -2613,7 +2659,7 @@ compact_strings ()
2613 } 2659 }
2614#endif /* USE_TEXT_PROPERTIES */ 2660#endif /* USE_TEXT_PROPERTIES */
2615 } 2661 }
2616 pos += STRING_FULLSIZE (size); 2662 pos += STRING_FULLSIZE (size_byte);
2617 } 2663 }
2618 } 2664 }
2619 2665