diff options
| author | Karoly Lorentey | 2004-12-08 22:20:27 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-12-08 22:20:27 +0000 |
| commit | fad2f6858075f49c4c8fd16f0535c287e3f14ac3 (patch) | |
| tree | 843a2ffe6caea6201877e3d2f1b6b954f47344b5 /src/alloc.c | |
| parent | 856dd47583918edd7987c13334703d3e7492d8f4 (diff) | |
| parent | b11e88237593ff7556d8535305e8f342e6b61d66 (diff) | |
| download | emacs-fad2f6858075f49c4c8fd16f0535c287e3f14ac3.tar.gz emacs-fad2f6858075f49c4c8fd16f0535c287e3f14ac3.zip | |
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-714
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-271
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 293 |
1 files changed, 278 insertions, 15 deletions
diff --git a/src/alloc.c b/src/alloc.c index ea1d542bc7c..56f8be25f61 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -31,6 +31,10 @@ Boston, MA 02111-1307, USA. */ | |||
| 31 | 31 | ||
| 32 | #include <signal.h> | 32 | #include <signal.h> |
| 33 | 33 | ||
| 34 | #ifdef HAVE_GTK_AND_PTHREAD | ||
| 35 | #include <pthread.h> | ||
| 36 | #endif | ||
| 37 | |||
| 34 | /* This file is part of the core Lisp implementation, and thus must | 38 | /* This file is part of the core Lisp implementation, and thus must |
| 35 | deal with the real data structures. If the Lisp implementation is | 39 | deal with the real data structures. If the Lisp implementation is |
| 36 | replaced, this file likely will not be used. */ | 40 | replaced, this file likely will not be used. */ |
| @@ -85,6 +89,35 @@ extern __malloc_size_t __malloc_extra_blocks; | |||
| 85 | 89 | ||
| 86 | #endif /* not DOUG_LEA_MALLOC */ | 90 | #endif /* not DOUG_LEA_MALLOC */ |
| 87 | 91 | ||
| 92 | #if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD) | ||
| 93 | |||
| 94 | static pthread_mutex_t alloc_mutex; | ||
| 95 | pthread_t main_thread; | ||
| 96 | |||
| 97 | #define BLOCK_INPUT_ALLOC \ | ||
| 98 | do \ | ||
| 99 | { \ | ||
| 100 | pthread_mutex_lock (&alloc_mutex); \ | ||
| 101 | if (pthread_self () == main_thread) \ | ||
| 102 | BLOCK_INPUT; \ | ||
| 103 | } \ | ||
| 104 | while (0) | ||
| 105 | #define UNBLOCK_INPUT_ALLOC \ | ||
| 106 | do \ | ||
| 107 | { \ | ||
| 108 | if (pthread_self () == main_thread) \ | ||
| 109 | UNBLOCK_INPUT; \ | ||
| 110 | pthread_mutex_unlock (&alloc_mutex); \ | ||
| 111 | } \ | ||
| 112 | while (0) | ||
| 113 | |||
| 114 | #else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */ | ||
| 115 | |||
| 116 | #define BLOCK_INPUT_ALLOC BLOCK_INPUT | ||
| 117 | #define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT | ||
| 118 | |||
| 119 | #endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */ | ||
| 120 | |||
| 88 | /* Value of _bytes_used, when spare_memory was freed. */ | 121 | /* Value of _bytes_used, when spare_memory was freed. */ |
| 89 | 122 | ||
| 90 | static __malloc_size_t bytes_used_when_full; | 123 | static __malloc_size_t bytes_used_when_full; |
| @@ -517,6 +550,140 @@ buffer_memory_full () | |||
| 517 | } | 550 | } |
| 518 | 551 | ||
| 519 | 552 | ||
| 553 | #ifdef XMALLOC_OVERRUN_CHECK | ||
| 554 | |||
| 555 | /* Check for overrun in malloc'ed buffers by wrapping a 16 byte header | ||
| 556 | and a 16 byte trailer around each block. | ||
| 557 | |||
| 558 | The header consists of 12 fixed bytes + a 4 byte integer contaning the | ||
| 559 | original block size, while the trailer consists of 16 fixed bytes. | ||
| 560 | |||
| 561 | The header is used to detect whether this block has been allocated | ||
| 562 | through these functions -- as it seems that some low-level libc | ||
| 563 | functions may bypass the malloc hooks. | ||
| 564 | */ | ||
| 565 | |||
| 566 | |||
| 567 | #define XMALLOC_OVERRUN_CHECK_SIZE 16 | ||
| 568 | |||
| 569 | static char xmalloc_overrun_check_header[XMALLOC_OVERRUN_CHECK_SIZE-4] = | ||
| 570 | { 0x9a, 0x9b, 0xae, 0xaf, | ||
| 571 | 0xbf, 0xbe, 0xce, 0xcf, | ||
| 572 | 0xea, 0xeb, 0xec, 0xed }; | ||
| 573 | |||
| 574 | static char xmalloc_overrun_check_trailer[XMALLOC_OVERRUN_CHECK_SIZE] = | ||
| 575 | { 0xaa, 0xab, 0xac, 0xad, | ||
| 576 | 0xba, 0xbb, 0xbc, 0xbd, | ||
| 577 | 0xca, 0xcb, 0xcc, 0xcd, | ||
| 578 | 0xda, 0xdb, 0xdc, 0xdd }; | ||
| 579 | |||
| 580 | /* Macros to insert and extract the block size in the header. */ | ||
| 581 | |||
| 582 | #define XMALLOC_PUT_SIZE(ptr, size) \ | ||
| 583 | (ptr[-1] = (size & 0xff), \ | ||
| 584 | ptr[-2] = ((size >> 8) & 0xff), \ | ||
| 585 | ptr[-3] = ((size >> 16) & 0xff), \ | ||
| 586 | ptr[-4] = ((size >> 24) & 0xff)) | ||
| 587 | |||
| 588 | #define XMALLOC_GET_SIZE(ptr) \ | ||
| 589 | (size_t)((unsigned)(ptr[-1]) | \ | ||
| 590 | ((unsigned)(ptr[-2]) << 8) | \ | ||
| 591 | ((unsigned)(ptr[-3]) << 16) | \ | ||
| 592 | ((unsigned)(ptr[-4]) << 24)) | ||
| 593 | |||
| 594 | |||
| 595 | /* Like malloc, but wraps allocated block with header and trailer. */ | ||
| 596 | |||
| 597 | POINTER_TYPE * | ||
| 598 | overrun_check_malloc (size) | ||
| 599 | size_t size; | ||
| 600 | { | ||
| 601 | register unsigned char *val; | ||
| 602 | |||
| 603 | val = (unsigned char *) malloc (size + XMALLOC_OVERRUN_CHECK_SIZE*2); | ||
| 604 | if (val) | ||
| 605 | { | ||
| 606 | bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4); | ||
| 607 | val += XMALLOC_OVERRUN_CHECK_SIZE; | ||
| 608 | XMALLOC_PUT_SIZE(val, size); | ||
| 609 | bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE); | ||
| 610 | } | ||
| 611 | return (POINTER_TYPE *)val; | ||
| 612 | } | ||
| 613 | |||
| 614 | |||
| 615 | /* Like realloc, but checks old block for overrun, and wraps new block | ||
| 616 | with header and trailer. */ | ||
| 617 | |||
| 618 | POINTER_TYPE * | ||
| 619 | overrun_check_realloc (block, size) | ||
| 620 | POINTER_TYPE *block; | ||
| 621 | size_t size; | ||
| 622 | { | ||
| 623 | register unsigned char *val = (unsigned char *)block; | ||
| 624 | |||
| 625 | if (val | ||
| 626 | && bcmp (xmalloc_overrun_check_header, | ||
| 627 | val - XMALLOC_OVERRUN_CHECK_SIZE, | ||
| 628 | XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0) | ||
| 629 | { | ||
| 630 | size_t osize = XMALLOC_GET_SIZE (val); | ||
| 631 | if (bcmp (xmalloc_overrun_check_trailer, | ||
| 632 | val + osize, | ||
| 633 | XMALLOC_OVERRUN_CHECK_SIZE)) | ||
| 634 | abort (); | ||
| 635 | bzero (val + osize, XMALLOC_OVERRUN_CHECK_SIZE); | ||
| 636 | val -= XMALLOC_OVERRUN_CHECK_SIZE; | ||
| 637 | bzero (val, XMALLOC_OVERRUN_CHECK_SIZE); | ||
| 638 | } | ||
| 639 | |||
| 640 | val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + XMALLOC_OVERRUN_CHECK_SIZE*2); | ||
| 641 | |||
| 642 | if (val) | ||
| 643 | { | ||
| 644 | bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4); | ||
| 645 | val += XMALLOC_OVERRUN_CHECK_SIZE; | ||
| 646 | XMALLOC_PUT_SIZE(val, size); | ||
| 647 | bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE); | ||
| 648 | } | ||
| 649 | return (POINTER_TYPE *)val; | ||
| 650 | } | ||
| 651 | |||
| 652 | /* Like free, but checks block for overrun. */ | ||
| 653 | |||
| 654 | void | ||
| 655 | overrun_check_free (block) | ||
| 656 | POINTER_TYPE *block; | ||
| 657 | { | ||
| 658 | unsigned char *val = (unsigned char *)block; | ||
| 659 | |||
| 660 | if (val | ||
| 661 | && bcmp (xmalloc_overrun_check_header, | ||
| 662 | val - XMALLOC_OVERRUN_CHECK_SIZE, | ||
| 663 | XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0) | ||
| 664 | { | ||
| 665 | size_t osize = XMALLOC_GET_SIZE (val); | ||
| 666 | if (bcmp (xmalloc_overrun_check_trailer, | ||
| 667 | val + osize, | ||
| 668 | XMALLOC_OVERRUN_CHECK_SIZE)) | ||
| 669 | abort (); | ||
| 670 | bzero (val + osize, XMALLOC_OVERRUN_CHECK_SIZE); | ||
| 671 | val -= XMALLOC_OVERRUN_CHECK_SIZE; | ||
| 672 | bzero (val, XMALLOC_OVERRUN_CHECK_SIZE); | ||
| 673 | } | ||
| 674 | |||
| 675 | free (val); | ||
| 676 | } | ||
| 677 | |||
| 678 | #undef malloc | ||
| 679 | #undef realloc | ||
| 680 | #undef free | ||
| 681 | #define malloc overrun_check_malloc | ||
| 682 | #define realloc overrun_check_realloc | ||
| 683 | #define free overrun_check_free | ||
| 684 | #endif | ||
| 685 | |||
| 686 | |||
| 520 | /* Like malloc but check for no memory and block interrupt input.. */ | 687 | /* Like malloc but check for no memory and block interrupt input.. */ |
| 521 | 688 | ||
| 522 | POINTER_TYPE * | 689 | POINTER_TYPE * |
| @@ -603,7 +770,9 @@ safe_alloca_unwind (arg) | |||
| 603 | number of bytes to allocate, TYPE describes the intended use of the | 770 | number of bytes to allocate, TYPE describes the intended use of the |
| 604 | allcated memory block (for strings, for conses, ...). */ | 771 | allcated memory block (for strings, for conses, ...). */ |
| 605 | 772 | ||
| 773 | #ifndef USE_LSB_TAG | ||
| 606 | static void *lisp_malloc_loser; | 774 | static void *lisp_malloc_loser; |
| 775 | #endif | ||
| 607 | 776 | ||
| 608 | static POINTER_TYPE * | 777 | static POINTER_TYPE * |
| 609 | lisp_malloc (nbytes, type) | 778 | lisp_malloc (nbytes, type) |
| @@ -933,7 +1102,7 @@ static void | |||
| 933 | emacs_blocked_free (ptr) | 1102 | emacs_blocked_free (ptr) |
| 934 | void *ptr; | 1103 | void *ptr; |
| 935 | { | 1104 | { |
| 936 | BLOCK_INPUT; | 1105 | BLOCK_INPUT_ALLOC; |
| 937 | 1106 | ||
| 938 | #ifdef GC_MALLOC_CHECK | 1107 | #ifdef GC_MALLOC_CHECK |
| 939 | if (ptr) | 1108 | if (ptr) |
| @@ -971,7 +1140,7 @@ emacs_blocked_free (ptr) | |||
| 971 | spare_memory = (char *) malloc ((size_t) SPARE_MEMORY); | 1140 | spare_memory = (char *) malloc ((size_t) SPARE_MEMORY); |
| 972 | 1141 | ||
| 973 | __free_hook = emacs_blocked_free; | 1142 | __free_hook = emacs_blocked_free; |
| 974 | UNBLOCK_INPUT; | 1143 | UNBLOCK_INPUT_ALLOC; |
| 975 | } | 1144 | } |
| 976 | 1145 | ||
| 977 | 1146 | ||
| @@ -997,7 +1166,7 @@ emacs_blocked_malloc (size) | |||
| 997 | { | 1166 | { |
| 998 | void *value; | 1167 | void *value; |
| 999 | 1168 | ||
| 1000 | BLOCK_INPUT; | 1169 | BLOCK_INPUT_ALLOC; |
| 1001 | __malloc_hook = old_malloc_hook; | 1170 | __malloc_hook = old_malloc_hook; |
| 1002 | #ifdef DOUG_LEA_MALLOC | 1171 | #ifdef DOUG_LEA_MALLOC |
| 1003 | mallopt (M_TOP_PAD, malloc_hysteresis * 4096); | 1172 | mallopt (M_TOP_PAD, malloc_hysteresis * 4096); |
| @@ -1029,7 +1198,7 @@ emacs_blocked_malloc (size) | |||
| 1029 | #endif /* GC_MALLOC_CHECK */ | 1198 | #endif /* GC_MALLOC_CHECK */ |
| 1030 | 1199 | ||
| 1031 | __malloc_hook = emacs_blocked_malloc; | 1200 | __malloc_hook = emacs_blocked_malloc; |
| 1032 | UNBLOCK_INPUT; | 1201 | UNBLOCK_INPUT_ALLOC; |
| 1033 | 1202 | ||
| 1034 | /* fprintf (stderr, "%p malloc\n", value); */ | 1203 | /* fprintf (stderr, "%p malloc\n", value); */ |
| 1035 | return value; | 1204 | return value; |
| @@ -1045,7 +1214,7 @@ emacs_blocked_realloc (ptr, size) | |||
| 1045 | { | 1214 | { |
| 1046 | void *value; | 1215 | void *value; |
| 1047 | 1216 | ||
| 1048 | BLOCK_INPUT; | 1217 | BLOCK_INPUT_ALLOC; |
| 1049 | __realloc_hook = old_realloc_hook; | 1218 | __realloc_hook = old_realloc_hook; |
| 1050 | 1219 | ||
| 1051 | #ifdef GC_MALLOC_CHECK | 1220 | #ifdef GC_MALLOC_CHECK |
| @@ -1090,17 +1259,45 @@ emacs_blocked_realloc (ptr, size) | |||
| 1090 | #endif /* GC_MALLOC_CHECK */ | 1259 | #endif /* GC_MALLOC_CHECK */ |
| 1091 | 1260 | ||
| 1092 | __realloc_hook = emacs_blocked_realloc; | 1261 | __realloc_hook = emacs_blocked_realloc; |
| 1093 | UNBLOCK_INPUT; | 1262 | UNBLOCK_INPUT_ALLOC; |
| 1094 | 1263 | ||
| 1095 | return value; | 1264 | return value; |
| 1096 | } | 1265 | } |
| 1097 | 1266 | ||
| 1098 | 1267 | ||
| 1268 | #ifdef HAVE_GTK_AND_PTHREAD | ||
| 1269 | /* Called from Fdump_emacs so that when the dumped Emacs starts, it has a | ||
| 1270 | normal malloc. Some thread implementations need this as they call | ||
| 1271 | malloc before main. The pthread_self call in BLOCK_INPUT_ALLOC then | ||
| 1272 | calls malloc because it is the first call, and we have an endless loop. */ | ||
| 1273 | |||
| 1274 | void | ||
| 1275 | reset_malloc_hooks () | ||
| 1276 | { | ||
| 1277 | __free_hook = 0; | ||
| 1278 | __malloc_hook = 0; | ||
| 1279 | __realloc_hook = 0; | ||
| 1280 | } | ||
| 1281 | #endif /* HAVE_GTK_AND_PTHREAD */ | ||
| 1282 | |||
| 1283 | |||
| 1099 | /* Called from main to set up malloc to use our hooks. */ | 1284 | /* Called from main to set up malloc to use our hooks. */ |
| 1100 | 1285 | ||
| 1101 | void | 1286 | void |
| 1102 | uninterrupt_malloc () | 1287 | uninterrupt_malloc () |
| 1103 | { | 1288 | { |
| 1289 | #ifdef HAVE_GTK_AND_PTHREAD | ||
| 1290 | pthread_mutexattr_t attr; | ||
| 1291 | |||
| 1292 | /* GLIBC has a faster way to do this, but lets keep it portable. | ||
| 1293 | This is according to the Single UNIX Specification. */ | ||
| 1294 | pthread_mutexattr_init (&attr); | ||
| 1295 | pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE); | ||
| 1296 | pthread_mutex_init (&alloc_mutex, &attr); | ||
| 1297 | |||
| 1298 | main_thread = pthread_self (); | ||
| 1299 | #endif /* HAVE_GTK_AND_PTHREAD */ | ||
| 1300 | |||
| 1104 | if (__free_hook != emacs_blocked_free) | 1301 | if (__free_hook != emacs_blocked_free) |
| 1105 | old_free_hook = __free_hook; | 1302 | old_free_hook = __free_hook; |
| 1106 | __free_hook = emacs_blocked_free; | 1303 | __free_hook = emacs_blocked_free; |
| @@ -1429,6 +1626,21 @@ static int total_string_size; | |||
| 1429 | 1626 | ||
| 1430 | #endif /* not GC_CHECK_STRING_BYTES */ | 1627 | #endif /* not GC_CHECK_STRING_BYTES */ |
| 1431 | 1628 | ||
| 1629 | |||
| 1630 | #ifdef GC_CHECK_STRING_OVERRUN | ||
| 1631 | |||
| 1632 | /* We check for overrun in string data blocks by appending a small | ||
| 1633 | "cookie" after each allocated string data block, and check for the | ||
| 1634 | presense of this cookie during GC. */ | ||
| 1635 | |||
| 1636 | #define GC_STRING_OVERRUN_COOKIE_SIZE 4 | ||
| 1637 | static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = | ||
| 1638 | { 0xde, 0xad, 0xbe, 0xef }; | ||
| 1639 | |||
| 1640 | #else | ||
| 1641 | #define GC_STRING_OVERRUN_COOKIE_SIZE 0 | ||
| 1642 | #endif | ||
| 1643 | |||
| 1432 | /* Value is the size of an sdata structure large enough to hold NBYTES | 1644 | /* Value is the size of an sdata structure large enough to hold NBYTES |
| 1433 | bytes of string data. The value returned includes a terminating | 1645 | bytes of string data. The value returned includes a terminating |
| 1434 | NUL byte, the size of the sdata structure, and padding. */ | 1646 | NUL byte, the size of the sdata structure, and padding. */ |
| @@ -1452,6 +1664,10 @@ static int total_string_size; | |||
| 1452 | 1664 | ||
| 1453 | #endif /* not GC_CHECK_STRING_BYTES */ | 1665 | #endif /* not GC_CHECK_STRING_BYTES */ |
| 1454 | 1666 | ||
| 1667 | /* Extra bytes to allocate for each string. */ | ||
| 1668 | |||
| 1669 | #define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE) | ||
| 1670 | |||
| 1455 | /* Initialize string allocation. Called from init_alloc_once. */ | 1671 | /* Initialize string allocation. Called from init_alloc_once. */ |
| 1456 | 1672 | ||
| 1457 | void | 1673 | void |
| @@ -1516,7 +1732,7 @@ check_sblock (b) | |||
| 1516 | nbytes = SDATA_NBYTES (from); | 1732 | nbytes = SDATA_NBYTES (from); |
| 1517 | 1733 | ||
| 1518 | nbytes = SDATA_SIZE (nbytes); | 1734 | nbytes = SDATA_SIZE (nbytes); |
| 1519 | from_end = (struct sdata *) ((char *) from + nbytes); | 1735 | from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); |
| 1520 | } | 1736 | } |
| 1521 | } | 1737 | } |
| 1522 | 1738 | ||
| @@ -1549,6 +1765,28 @@ check_string_bytes (all_p) | |||
| 1549 | 1765 | ||
| 1550 | #endif /* GC_CHECK_STRING_BYTES */ | 1766 | #endif /* GC_CHECK_STRING_BYTES */ |
| 1551 | 1767 | ||
| 1768 | #ifdef GC_CHECK_STRING_FREE_LIST | ||
| 1769 | |||
| 1770 | /* Walk through the string free list looking for bogus next pointers. | ||
| 1771 | This may catch buffer overrun from a previous string. */ | ||
| 1772 | |||
| 1773 | static void | ||
| 1774 | check_string_free_list () | ||
| 1775 | { | ||
| 1776 | struct Lisp_String *s; | ||
| 1777 | |||
| 1778 | /* Pop a Lisp_String off the free-list. */ | ||
| 1779 | s = string_free_list; | ||
| 1780 | while (s != NULL) | ||
| 1781 | { | ||
| 1782 | if ((unsigned)s < 1024) | ||
| 1783 | abort(); | ||
| 1784 | s = NEXT_FREE_LISP_STRING (s); | ||
| 1785 | } | ||
| 1786 | } | ||
| 1787 | #else | ||
| 1788 | #define check_string_free_list() | ||
| 1789 | #endif | ||
| 1552 | 1790 | ||
| 1553 | /* Return a new Lisp_String. */ | 1791 | /* Return a new Lisp_String. */ |
| 1554 | 1792 | ||
| @@ -1580,6 +1818,8 @@ allocate_string () | |||
| 1580 | total_free_strings += STRING_BLOCK_SIZE; | 1818 | total_free_strings += STRING_BLOCK_SIZE; |
| 1581 | } | 1819 | } |
| 1582 | 1820 | ||
| 1821 | check_string_free_list (); | ||
| 1822 | |||
| 1583 | /* Pop a Lisp_String off the free-list. */ | 1823 | /* Pop a Lisp_String off the free-list. */ |
| 1584 | s = string_free_list; | 1824 | s = string_free_list; |
| 1585 | string_free_list = NEXT_FREE_LISP_STRING (s); | 1825 | string_free_list = NEXT_FREE_LISP_STRING (s); |
| @@ -1649,7 +1889,7 @@ allocate_string_data (s, nchars, nbytes) | |||
| 1649 | mallopt (M_MMAP_MAX, 0); | 1889 | mallopt (M_MMAP_MAX, 0); |
| 1650 | #endif | 1890 | #endif |
| 1651 | 1891 | ||
| 1652 | b = (struct sblock *) lisp_malloc (size, MEM_TYPE_NON_LISP); | 1892 | b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); |
| 1653 | 1893 | ||
| 1654 | #ifdef DOUG_LEA_MALLOC | 1894 | #ifdef DOUG_LEA_MALLOC |
| 1655 | /* Back to a reasonable maximum of mmap'ed areas. */ | 1895 | /* Back to a reasonable maximum of mmap'ed areas. */ |
| @@ -1664,7 +1904,7 @@ allocate_string_data (s, nchars, nbytes) | |||
| 1664 | else if (current_sblock == NULL | 1904 | else if (current_sblock == NULL |
| 1665 | || (((char *) current_sblock + SBLOCK_SIZE | 1905 | || (((char *) current_sblock + SBLOCK_SIZE |
| 1666 | - (char *) current_sblock->next_free) | 1906 | - (char *) current_sblock->next_free) |
| 1667 | < needed)) | 1907 | < (needed + GC_STRING_EXTRA))) |
| 1668 | { | 1908 | { |
| 1669 | /* Not enough room in the current sblock. */ | 1909 | /* Not enough room in the current sblock. */ |
| 1670 | b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); | 1910 | b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); |
| @@ -1693,7 +1933,11 @@ allocate_string_data (s, nchars, nbytes) | |||
| 1693 | s->size = nchars; | 1933 | s->size = nchars; |
| 1694 | s->size_byte = nbytes; | 1934 | s->size_byte = nbytes; |
| 1695 | s->data[nbytes] = '\0'; | 1935 | s->data[nbytes] = '\0'; |
| 1696 | b->next_free = (struct sdata *) ((char *) data + needed); | 1936 | #ifdef GC_CHECK_STRING_OVERRUN |
| 1937 | bcopy (string_overrun_cookie, (char *) data + needed, | ||
| 1938 | GC_STRING_OVERRUN_COOKIE_SIZE); | ||
| 1939 | #endif | ||
| 1940 | b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); | ||
| 1697 | 1941 | ||
| 1698 | /* If S had already data assigned, mark that as free by setting its | 1942 | /* If S had already data assigned, mark that as free by setting its |
| 1699 | string back-pointer to null, and recording the size of the data | 1943 | string back-pointer to null, and recording the size of the data |
| @@ -1798,9 +2042,13 @@ sweep_strings () | |||
| 1798 | } | 2042 | } |
| 1799 | } | 2043 | } |
| 1800 | 2044 | ||
| 2045 | check_string_free_list (); | ||
| 2046 | |||
| 1801 | string_blocks = live_blocks; | 2047 | string_blocks = live_blocks; |
| 1802 | free_large_strings (); | 2048 | free_large_strings (); |
| 1803 | compact_small_strings (); | 2049 | compact_small_strings (); |
| 2050 | |||
| 2051 | check_string_free_list (); | ||
| 1804 | } | 2052 | } |
| 1805 | 2053 | ||
| 1806 | 2054 | ||
| @@ -1872,28 +2120,38 @@ compact_small_strings () | |||
| 1872 | else | 2120 | else |
| 1873 | nbytes = SDATA_NBYTES (from); | 2121 | nbytes = SDATA_NBYTES (from); |
| 1874 | 2122 | ||
| 2123 | if (nbytes > LARGE_STRING_BYTES) | ||
| 2124 | abort (); | ||
| 2125 | |||
| 1875 | nbytes = SDATA_SIZE (nbytes); | 2126 | nbytes = SDATA_SIZE (nbytes); |
| 1876 | from_end = (struct sdata *) ((char *) from + nbytes); | 2127 | from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); |
| 2128 | |||
| 2129 | #ifdef GC_CHECK_STRING_OVERRUN | ||
| 2130 | if (bcmp (string_overrun_cookie, | ||
| 2131 | ((char *) from_end) - GC_STRING_OVERRUN_COOKIE_SIZE, | ||
| 2132 | GC_STRING_OVERRUN_COOKIE_SIZE)) | ||
| 2133 | abort (); | ||
| 2134 | #endif | ||
| 1877 | 2135 | ||
| 1878 | /* FROM->string non-null means it's alive. Copy its data. */ | 2136 | /* FROM->string non-null means it's alive. Copy its data. */ |
| 1879 | if (from->string) | 2137 | if (from->string) |
| 1880 | { | 2138 | { |
| 1881 | /* If TB is full, proceed with the next sblock. */ | 2139 | /* If TB is full, proceed with the next sblock. */ |
| 1882 | to_end = (struct sdata *) ((char *) to + nbytes); | 2140 | to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); |
| 1883 | if (to_end > tb_end) | 2141 | if (to_end > tb_end) |
| 1884 | { | 2142 | { |
| 1885 | tb->next_free = to; | 2143 | tb->next_free = to; |
| 1886 | tb = tb->next; | 2144 | tb = tb->next; |
| 1887 | tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); | 2145 | tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); |
| 1888 | to = &tb->first_data; | 2146 | to = &tb->first_data; |
| 1889 | to_end = (struct sdata *) ((char *) to + nbytes); | 2147 | to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); |
| 1890 | } | 2148 | } |
| 1891 | 2149 | ||
| 1892 | /* Copy, and update the string's `data' pointer. */ | 2150 | /* Copy, and update the string's `data' pointer. */ |
| 1893 | if (from != to) | 2151 | if (from != to) |
| 1894 | { | 2152 | { |
| 1895 | xassert (tb != b || to <= from); | 2153 | xassert (tb != b || to <= from); |
| 1896 | safe_bcopy ((char *) from, (char *) to, nbytes); | 2154 | safe_bcopy ((char *) from, (char *) to, nbytes + GC_STRING_EXTRA); |
| 1897 | to->string->data = SDATA_DATA (to); | 2155 | to->string->data = SDATA_DATA (to); |
| 1898 | } | 2156 | } |
| 1899 | 2157 | ||
| @@ -2403,9 +2661,9 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, | |||
| 2403 | void | 2661 | void |
| 2404 | check_cons_list () | 2662 | check_cons_list () |
| 2405 | { | 2663 | { |
| 2664 | #ifdef GC_CHECK_CONS_LIST | ||
| 2406 | struct Lisp_Cons *tail = cons_free_list; | 2665 | struct Lisp_Cons *tail = cons_free_list; |
| 2407 | 2666 | ||
| 2408 | #if 0 | ||
| 2409 | while (tail) | 2667 | while (tail) |
| 2410 | tail = *(struct Lisp_Cons **)&tail->cdr; | 2668 | tail = *(struct Lisp_Cons **)&tail->cdr; |
| 2411 | #endif | 2669 | #endif |
| @@ -4100,6 +4358,11 @@ mark_stack () | |||
| 4100 | #endif | 4358 | #endif |
| 4101 | for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) | 4359 | for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) |
| 4102 | mark_memory ((char *) stack_base + i, end); | 4360 | mark_memory ((char *) stack_base + i, end); |
| 4361 | /* Allow for marking a secondary stack, like the register stack on the | ||
| 4362 | ia64. */ | ||
| 4363 | #ifdef GC_MARK_SECONDARY_STACK | ||
| 4364 | GC_MARK_SECONDARY_STACK (); | ||
| 4365 | #endif | ||
| 4103 | 4366 | ||
| 4104 | #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS | 4367 | #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS |
| 4105 | check_gcpros (); | 4368 | check_gcpros (); |