aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorRichard M. Stallman1998-03-21 18:07:06 +0000
committerRichard M. Stallman1998-03-21 18:07:06 +0000
commitc0696668ada15b284ec63a6c89981a54ecefd1d1 (patch)
tree9d1e62d620a30add0619a67aa44be5955de32737 /src/alloc.c
parent5f75e6660f4f633c2c8640dd3973ff57bf2be26a (diff)
downloademacs-c0696668ada15b284ec63a6c89981a54ecefd1d1.tar.gz
emacs-c0696668ada15b284ec63a6c89981a54ecefd1d1.zip
(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.
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c78
1 files changed, 64 insertions, 14 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 5948229cc4b..47fa6820102 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1179,7 +1179,7 @@ init_strings ()
1179 current_string_block->pos = 0; 1179 current_string_block->pos = 0;
1180 large_string_blocks = 0; 1180 large_string_blocks = 0;
1181} 1181}
1182 1182
1183DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, 1183DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
1184 "Return a newly created string of length LENGTH, with each element being INIT.\n\ 1184 "Return a newly created string of length LENGTH, with each element being INIT.\n\
1185Both LENGTH and INIT must be numbers.") 1185Both LENGTH and INIT must be numbers.")
@@ -1197,7 +1197,7 @@ Both LENGTH and INIT must be numbers.")
1197 if (SINGLE_BYTE_CHAR_P (c)) 1197 if (SINGLE_BYTE_CHAR_P (c))
1198 { 1198 {
1199 nbytes = XINT (length); 1199 nbytes = XINT (length);
1200 val = make_uninit_multibyte_string (nbytes, nbytes); 1200 val = make_uninit_string (nbytes);
1201 p = XSTRING (val)->data; 1201 p = XSTRING (val)->data;
1202 end = p + XSTRING (val)->size; 1202 end = p + XSTRING (val)->size;
1203 while (p != end) 1203 while (p != end)
@@ -1255,9 +1255,10 @@ LENGTH must be a number. INIT matters only in whether it is t or nil.")
1255 1255
1256 return val; 1256 return val;
1257} 1257}
1258 1258
1259/* Make a string from NBYTES bytes at CONTENTS, 1259/* Make a string from NBYTES bytes at CONTENTS,
1260 and compute the number of characters from the contents. */ 1260 and compute the number of characters from the contents.
1261 This string may be unibyte or multibyte, depending on the contents. */
1261 1262
1262Lisp_Object 1263Lisp_Object
1263make_string (contents, nbytes) 1264make_string (contents, nbytes)
@@ -1268,11 +1269,12 @@ make_string (contents, nbytes)
1268 int nchars = chars_in_text (contents, nbytes); 1269 int nchars = chars_in_text (contents, nbytes);
1269 val = make_uninit_multibyte_string (nchars, nbytes); 1270 val = make_uninit_multibyte_string (nchars, nbytes);
1270 bcopy (contents, XSTRING (val)->data, nbytes); 1271 bcopy (contents, XSTRING (val)->data, nbytes);
1272 if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
1273 SET_STRING_BYTES (XSTRING (val), -1);
1271 return val; 1274 return val;
1272} 1275}
1273 1276
1274/* Make a string from LENGTH bytes at CONTENTS, 1277/* Make a unibyte string from LENGTH bytes at CONTENTS. */
1275 assuming each byte is a character. */
1276 1278
1277Lisp_Object 1279Lisp_Object
1278make_unibyte_string (contents, length) 1280make_unibyte_string (contents, length)
@@ -1282,10 +1284,12 @@ make_unibyte_string (contents, length)
1282 register Lisp_Object val; 1284 register Lisp_Object val;
1283 val = make_uninit_string (length); 1285 val = make_uninit_string (length);
1284 bcopy (contents, XSTRING (val)->data, length); 1286 bcopy (contents, XSTRING (val)->data, length);
1287 SET_STRING_BYTES (XSTRING (val), -1);
1285 return val; 1288 return val;
1286} 1289}
1287 1290
1288/* Make a string from NCHARS characters occupying NBYTES bytes at CONTENTS. */ 1291/* Make a multibyte string from NCHARS characters
1292 occupying NBYTES bytes at CONTENTS. */
1289 1293
1290Lisp_Object 1294Lisp_Object
1291make_multibyte_string (contents, nchars, nbytes) 1295make_multibyte_string (contents, nchars, nbytes)
@@ -1298,6 +1302,40 @@ make_multibyte_string (contents, nchars, nbytes)
1298 return val; 1302 return val;
1299} 1303}
1300 1304
1305/* Make a string from NCHARS characters
1306 occupying NBYTES bytes at CONTENTS.
1307 It is a multibyte string if NBYTES != NCHARS. */
1308
1309Lisp_Object
1310make_string_from_bytes (contents, nchars, nbytes)
1311 char *contents;
1312 int nchars, nbytes;
1313{
1314 register Lisp_Object val;
1315 val = make_uninit_multibyte_string (nchars, nbytes);
1316 bcopy (contents, XSTRING (val)->data, nbytes);
1317 if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
1318 SET_STRING_BYTES (XSTRING (val), -1);
1319 return val;
1320}
1321
1322/* Make a multibyte string from NCHARS characters
1323 occupying NBYTES bytes at CONTENTS. */
1324
1325Lisp_Object
1326make_specified_string (contents, nchars, nbytes, multibyte)
1327 char *contents;
1328 int nchars, nbytes;
1329 int multibyte;
1330{
1331 register Lisp_Object val;
1332 val = make_uninit_multibyte_string (nchars, nbytes);
1333 bcopy (contents, XSTRING (val)->data, nbytes);
1334 if (!multibyte)
1335 SET_STRING_BYTES (XSTRING (val), -1);
1336 return val;
1337}
1338
1301/* Make a string from the data at STR, 1339/* Make a string from the data at STR,
1302 treating it as multibyte if the data warrants. */ 1340 treating it as multibyte if the data warrants. */
1303 1341
@@ -1307,12 +1345,15 @@ build_string (str)
1307{ 1345{
1308 return make_string (str, strlen (str)); 1346 return make_string (str, strlen (str));
1309} 1347}
1310 1348
1311Lisp_Object 1349Lisp_Object
1312make_uninit_string (length) 1350make_uninit_string (length)
1313 int length; 1351 int length;
1314{ 1352{
1315 return make_uninit_multibyte_string (length, length); 1353 Lisp_Object val;
1354 val = make_uninit_multibyte_string (length, length);
1355 SET_STRING_BYTES (XSTRING (val), -1);
1356 return val;
1316} 1357}
1317 1358
1318Lisp_Object 1359Lisp_Object
@@ -1382,7 +1423,7 @@ make_uninit_multibyte_string (length, length_byte)
1382 1423
1383 return val; 1424 return val;
1384} 1425}
1385 1426
1386/* Return a newly created vector or string with specified arguments as 1427/* Return a newly created vector or string with specified arguments as
1387 elements. If all the arguments are characters that can fit 1428 elements. If all the arguments are characters that can fit
1388 in a string of events, make a string; otherwise, make a vector. 1429 in a string of events, make a string; otherwise, make a vector.
@@ -1430,11 +1471,13 @@ make_event_array (nargs, args)
1430 then the string is not protected from gc. */ 1471 then the string is not protected from gc. */
1431 1472
1432Lisp_Object 1473Lisp_Object
1433make_pure_string (data, length, length_byte) 1474make_pure_string (data, length, length_byte, multibyte)
1434 char *data; 1475 char *data;
1435 int length; 1476 int length;
1436 int length_byte; 1477 int length_byte;
1478 int multibyte;
1437{ 1479{
1480
1438 register Lisp_Object new; 1481 register Lisp_Object new;
1439 register int size = STRING_FULLSIZE (length_byte); 1482 register int size = STRING_FULLSIZE (length_byte);
1440 1483
@@ -1442,7 +1485,7 @@ make_pure_string (data, length, length_byte)
1442 error ("Pure Lisp storage exhausted"); 1485 error ("Pure Lisp storage exhausted");
1443 XSETSTRING (new, PUREBEG + pureptr); 1486 XSETSTRING (new, PUREBEG + pureptr);
1444 XSTRING (new)->size = length; 1487 XSTRING (new)->size = length;
1445 SET_STRING_BYTES (XSTRING (new), length_byte); 1488 SET_STRING_BYTES (XSTRING (new), (multibyte ? length_byte : -1));
1446 bcopy (data, XSTRING (new)->data, length_byte); 1489 bcopy (data, XSTRING (new)->data, length_byte);
1447 XSTRING (new)->data[length_byte] = 0; 1490 XSTRING (new)->data[length_byte] = 0;
1448 1491
@@ -1548,7 +1591,8 @@ Does not copy symbols.")
1548#endif /* LISP_FLOAT_TYPE */ 1591#endif /* LISP_FLOAT_TYPE */
1549 else if (STRINGP (obj)) 1592 else if (STRINGP (obj))
1550 return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size, 1593 return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
1551 STRING_BYTES (XSTRING (obj))); 1594 STRING_BYTES (XSTRING (obj)),
1595 STRING_MULTIBYTE (obj));
1552 else if (COMPILEDP (obj) || VECTORP (obj)) 1596 else if (COMPILEDP (obj) || VECTORP (obj))
1553 { 1597 {
1554 register struct Lisp_Vector *vec; 1598 register struct Lisp_Vector *vec;
@@ -2646,7 +2690,7 @@ compact_strings ()
2646 2690
2647 register struct Lisp_String *newaddr; 2691 register struct Lisp_String *newaddr;
2648 register EMACS_INT size = nextstr->size; 2692 register EMACS_INT size = nextstr->size;
2649 EMACS_INT size_byte = STRING_BYTES (nextstr); 2693 EMACS_INT size_byte = nextstr->size_byte;
2650 2694
2651 /* NEXTSTR is the old address of the next string. 2695 /* NEXTSTR is the old address of the next string.
2652 Just skip it if it isn't marked. */ 2696 Just skip it if it isn't marked. */
@@ -2661,6 +2705,9 @@ compact_strings ()
2661 size = *(EMACS_INT *)size & ~MARKBIT; 2705 size = *(EMACS_INT *)size & ~MARKBIT;
2662 } 2706 }
2663 2707
2708 if (size_byte < 0)
2709 size_byte = size;
2710
2664 total_string_size += size_byte; 2711 total_string_size += size_byte;
2665 2712
2666 /* If it won't fit in TO_SB, close it out, 2713 /* If it won't fit in TO_SB, close it out,
@@ -2720,6 +2767,9 @@ compact_strings ()
2720 } 2767 }
2721#endif /* USE_TEXT_PROPERTIES */ 2768#endif /* USE_TEXT_PROPERTIES */
2722 } 2769 }
2770 else if (size_byte < 0)
2771 size_byte = size;
2772
2723 pos += STRING_FULLSIZE (size_byte); 2773 pos += STRING_FULLSIZE (size_byte);
2724 } 2774 }
2725 } 2775 }