diff options
| author | Richard M. Stallman | 1998-03-21 18:07:06 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1998-03-21 18:07:06 +0000 |
| commit | c0696668ada15b284ec63a6c89981a54ecefd1d1 (patch) | |
| tree | 9d1e62d620a30add0619a67aa44be5955de32737 /src/alloc.c | |
| parent | 5f75e6660f4f633c2c8640dd3973ff57bf2be26a (diff) | |
| download | emacs-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.c | 78 |
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 | ||
| 1183 | DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, | 1183 | DEFUN ("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\ |
| 1185 | Both LENGTH and INIT must be numbers.") | 1185 | Both 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 | ||
| 1262 | Lisp_Object | 1263 | Lisp_Object |
| 1263 | make_string (contents, nbytes) | 1264 | make_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 | ||
| 1277 | Lisp_Object | 1279 | Lisp_Object |
| 1278 | make_unibyte_string (contents, length) | 1280 | make_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 | ||
| 1290 | Lisp_Object | 1294 | Lisp_Object |
| 1291 | make_multibyte_string (contents, nchars, nbytes) | 1295 | make_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 | |||
| 1309 | Lisp_Object | ||
| 1310 | make_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 | |||
| 1325 | Lisp_Object | ||
| 1326 | make_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 | ||
| 1311 | Lisp_Object | 1349 | Lisp_Object |
| 1312 | make_uninit_string (length) | 1350 | make_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 | ||
| 1318 | Lisp_Object | 1359 | Lisp_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 | ||
| 1432 | Lisp_Object | 1473 | Lisp_Object |
| 1433 | make_pure_string (data, length, length_byte) | 1474 | make_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 | } |