aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorJoakim Verona2012-07-27 02:22:03 +0200
committerJoakim Verona2012-07-27 02:22:03 +0200
commit5fb63197843dcae66f2fe0ddd6f4a9d560e9db2f (patch)
tree5c55f1096a656a9759f0b53a0b5d1a2289bd366f /src/alloc.c
parent0c5c85cf2b350c965bb1ffa5b2d77c2adebc406b (diff)
parent562157c814037dcba58a20cd6908a95992c22283 (diff)
downloademacs-5fb63197843dcae66f2fe0ddd6f4a9d560e9db2f.tar.gz
emacs-5fb63197843dcae66f2fe0ddd6f4a9d560e9db2f.zip
upstream
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c1167
1 files changed, 619 insertions, 548 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 5c6297faae5..ac6cb861c4d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -161,6 +161,10 @@ static pthread_mutex_t alloc_mutex;
161 161
162#define GC_STRING_BYTES(S) (STRING_BYTES (S)) 162#define GC_STRING_BYTES(S) (STRING_BYTES (S))
163 163
164/* Default value of gc_cons_threshold (see below). */
165
166#define GC_DEFAULT_THRESHOLD (100000 * sizeof (Lisp_Object))
167
164/* Global variables. */ 168/* Global variables. */
165struct emacs_globals globals; 169struct emacs_globals globals;
166 170
@@ -189,7 +193,7 @@ int abort_on_gc;
189 193
190/* Number of live and free conses etc. */ 194/* Number of live and free conses etc. */
191 195
192static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size; 196static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
193static EMACS_INT total_free_conses, total_free_markers, total_free_symbols; 197static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
194static EMACS_INT total_free_floats, total_floats; 198static EMACS_INT total_free_floats, total_floats;
195 199
@@ -258,11 +262,7 @@ static char *stack_copy;
258static ptrdiff_t stack_copy_size; 262static ptrdiff_t stack_copy_size;
259#endif 263#endif
260 264
261/* Non-zero means ignore malloc warnings. Set during initialization. 265static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
262 Currently not used. */
263
264static int ignore_warnings;
265
266static Lisp_Object Qgc_cons_threshold; 266static Lisp_Object Qgc_cons_threshold;
267Lisp_Object Qchar_table_extra_slots; 267Lisp_Object Qchar_table_extra_slots;
268 268
@@ -270,7 +270,6 @@ Lisp_Object Qchar_table_extra_slots;
270 270
271static Lisp_Object Qpost_gc_hook; 271static Lisp_Object Qpost_gc_hook;
272 272
273static void mark_buffer (Lisp_Object);
274static void mark_terminals (void); 273static void mark_terminals (void);
275static void gc_sweep (void); 274static void gc_sweep (void);
276static Lisp_Object make_pure_vector (ptrdiff_t); 275static Lisp_Object make_pure_vector (ptrdiff_t);
@@ -287,6 +286,14 @@ static void sweep_strings (void);
287static void free_misc (Lisp_Object); 286static void free_misc (Lisp_Object);
288extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; 287extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
289 288
289/* Handy constants for vectorlike objects. */
290enum
291 {
292 header_size = offsetof (struct Lisp_Vector, contents),
293 bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
294 word_size = sizeof (Lisp_Object)
295 };
296
290/* When scanning the C stack for live Lisp objects, Emacs keeps track 297/* When scanning the C stack for live Lisp objects, Emacs keeps track
291 of what memory allocated via lisp_malloc is intended for what 298 of what memory allocated via lisp_malloc is intended for what
292 purpose. This enumeration specifies the type of memory. */ 299 purpose. This enumeration specifies the type of memory. */
@@ -431,12 +438,12 @@ struct gcpro *gcprolist;
431/* Addresses of staticpro'd variables. Initialize it to a nonzero 438/* Addresses of staticpro'd variables. Initialize it to a nonzero
432 value; otherwise some compilers put it into BSS. */ 439 value; otherwise some compilers put it into BSS. */
433 440
434#define NSTATICS 0x640 441#define NSTATICS 0x650
435static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; 442static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
436 443
437/* Index of next unused slot in staticvec. */ 444/* Index of next unused slot in staticvec. */
438 445
439static int staticidx = 0; 446static int staticidx;
440 447
441static void *pure_alloc (size_t, int); 448static void *pure_alloc (size_t, int);
442 449
@@ -616,7 +623,7 @@ overrun_check_malloc (size_t size)
616 if (SIZE_MAX - overhead < size) 623 if (SIZE_MAX - overhead < size)
617 abort (); 624 abort ();
618 625
619 val = (unsigned char *) malloc (size + overhead); 626 val = malloc (size + overhead);
620 if (val && check_depth == 1) 627 if (val && check_depth == 1)
621 { 628 {
622 memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE); 629 memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
@@ -736,6 +743,22 @@ xmalloc (size_t size)
736 return val; 743 return val;
737} 744}
738 745
746/* Like the above, but zeroes out the memory just allocated. */
747
748void *
749xzalloc (size_t size)
750{
751 void *val;
752
753 MALLOC_BLOCK_INPUT;
754 val = malloc (size);
755 MALLOC_UNBLOCK_INPUT;
756
757 if (!val && size)
758 memory_full (size);
759 memset (val, 0, size);
760 return val;
761}
739 762
740/* Like realloc but check for no memory and block interrupt input.. */ 763/* Like realloc but check for no memory and block interrupt input.. */
741 764
@@ -787,7 +810,7 @@ verify (INT_MAX <= PTRDIFF_MAX);
787void * 810void *
788xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size) 811xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
789{ 812{
790 xassert (0 <= nitems && 0 < item_size); 813 eassert (0 <= nitems && 0 < item_size);
791 if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems) 814 if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
792 memory_full (SIZE_MAX); 815 memory_full (SIZE_MAX);
793 return xmalloc (nitems * item_size); 816 return xmalloc (nitems * item_size);
@@ -800,7 +823,7 @@ xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
800void * 823void *
801xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size) 824xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
802{ 825{
803 xassert (0 <= nitems && 0 < item_size); 826 eassert (0 <= nitems && 0 < item_size);
804 if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems) 827 if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
805 memory_full (SIZE_MAX); 828 memory_full (SIZE_MAX);
806 return xrealloc (pa, nitems * item_size); 829 return xrealloc (pa, nitems * item_size);
@@ -850,7 +873,7 @@ xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
850 ptrdiff_t nitems_incr_max = n_max - n; 873 ptrdiff_t nitems_incr_max = n_max - n;
851 ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max)); 874 ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
852 875
853 xassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max); 876 eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
854 if (! pa) 877 if (! pa)
855 *nitems = 0; 878 *nitems = 0;
856 if (nitems_incr_max < incr) 879 if (nitems_incr_max < incr)
@@ -868,7 +891,7 @@ char *
868xstrdup (const char *s) 891xstrdup (const char *s)
869{ 892{
870 size_t len = strlen (s) + 1; 893 size_t len = strlen (s) + 1;
871 char *p = (char *) xmalloc (len); 894 char *p = xmalloc (len);
872 memcpy (p, s, len); 895 memcpy (p, s, len);
873 return p; 896 return p;
874} 897}
@@ -908,7 +931,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
908 allocated_mem_type = type; 931 allocated_mem_type = type;
909#endif 932#endif
910 933
911 val = (void *) malloc (nbytes); 934 val = malloc (nbytes);
912 935
913#if ! USE_LSB_TAG 936#if ! USE_LSB_TAG
914 /* If the memory just allocated cannot be addressed thru a Lisp 937 /* If the memory just allocated cannot be addressed thru a Lisp
@@ -1187,21 +1210,6 @@ lisp_align_free (void *block)
1187 MALLOC_UNBLOCK_INPUT; 1210 MALLOC_UNBLOCK_INPUT;
1188} 1211}
1189 1212
1190/* Return a new buffer structure allocated from the heap with
1191 a call to lisp_malloc. */
1192
1193struct buffer *
1194allocate_buffer (void)
1195{
1196 struct buffer *b
1197 = (struct buffer *) lisp_malloc (sizeof (struct buffer),
1198 MEM_TYPE_BUFFER);
1199 XSETPVECTYPESIZE (b, PVEC_BUFFER,
1200 ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
1201 / sizeof (EMACS_INT)));
1202 return b;
1203}
1204
1205 1213
1206#ifndef SYSTEM_MALLOC 1214#ifndef SYSTEM_MALLOC
1207 1215
@@ -1309,7 +1317,7 @@ emacs_blocked_malloc (size_t size, const void *ptr)
1309 __malloc_extra_blocks = malloc_hysteresis; 1317 __malloc_extra_blocks = malloc_hysteresis;
1310#endif 1318#endif
1311 1319
1312 value = (void *) malloc (size); 1320 value = malloc (size);
1313 1321
1314#ifdef GC_MALLOC_CHECK 1322#ifdef GC_MALLOC_CHECK
1315 { 1323 {
@@ -1371,7 +1379,7 @@ emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
1371 dont_register_blocks = 1; 1379 dont_register_blocks = 1;
1372#endif /* GC_MALLOC_CHECK */ 1380#endif /* GC_MALLOC_CHECK */
1373 1381
1374 value = (void *) realloc (ptr, size); 1382 value = realloc (ptr, size);
1375 1383
1376#ifdef GC_MALLOC_CHECK 1384#ifdef GC_MALLOC_CHECK
1377 dont_register_blocks = 0; 1385 dont_register_blocks = 0;
@@ -1481,7 +1489,7 @@ static struct interval_block *interval_block;
1481/* Index in interval_block above of the next unused interval 1489/* Index in interval_block above of the next unused interval
1482 structure. */ 1490 structure. */
1483 1491
1484static int interval_block_index; 1492static int interval_block_index = INTERVAL_BLOCK_SIZE;
1485 1493
1486/* Number of free and live intervals. */ 1494/* Number of free and live intervals. */
1487 1495
@@ -1491,18 +1499,6 @@ static EMACS_INT total_free_intervals, total_intervals;
1491 1499
1492static INTERVAL interval_free_list; 1500static INTERVAL interval_free_list;
1493 1501
1494
1495/* Initialize interval allocation. */
1496
1497static void
1498init_intervals (void)
1499{
1500 interval_block = NULL;
1501 interval_block_index = INTERVAL_BLOCK_SIZE;
1502 interval_free_list = 0;
1503}
1504
1505
1506/* Return a new interval. */ 1502/* Return a new interval. */
1507 1503
1508INTERVAL 1504INTERVAL
@@ -1523,14 +1519,13 @@ make_interval (void)
1523 { 1519 {
1524 if (interval_block_index == INTERVAL_BLOCK_SIZE) 1520 if (interval_block_index == INTERVAL_BLOCK_SIZE)
1525 { 1521 {
1526 register struct interval_block *newi; 1522 struct interval_block *newi
1527 1523 = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP);
1528 newi = (struct interval_block *) lisp_malloc (sizeof *newi,
1529 MEM_TYPE_NON_LISP);
1530 1524
1531 newi->next = interval_block; 1525 newi->next = interval_block;
1532 interval_block = newi; 1526 interval_block = newi;
1533 interval_block_index = 0; 1527 interval_block_index = 0;
1528 total_free_intervals += INTERVAL_BLOCK_SIZE;
1534 } 1529 }
1535 val = &interval_block->intervals[interval_block_index++]; 1530 val = &interval_block->intervals[interval_block_index++];
1536 } 1531 }
@@ -1539,18 +1534,21 @@ make_interval (void)
1539 1534
1540 consing_since_gc += sizeof (struct interval); 1535 consing_since_gc += sizeof (struct interval);
1541 intervals_consed++; 1536 intervals_consed++;
1537 total_free_intervals--;
1542 RESET_INTERVAL (val); 1538 RESET_INTERVAL (val);
1543 val->gcmarkbit = 0; 1539 val->gcmarkbit = 0;
1544 return val; 1540 return val;
1545} 1541}
1546 1542
1547 1543
1548/* Mark Lisp objects in interval I. */ 1544/* Mark Lisp objects in interval I. */
1549 1545
1550static void 1546static void
1551mark_interval (register INTERVAL i, Lisp_Object dummy) 1547mark_interval (register INTERVAL i, Lisp_Object dummy)
1552{ 1548{
1553 eassert (!i->gcmarkbit); /* Intervals are never shared. */ 1549 /* Intervals should never be shared. So, if extra internal checking is
1550 enabled, GC aborts if it seems to have visited an interval twice. */
1551 eassert (!i->gcmarkbit);
1554 i->gcmarkbit = 1; 1552 i->gcmarkbit = 1;
1555 mark_object (i->plist); 1553 mark_object (i->plist);
1556} 1554}
@@ -1723,7 +1721,7 @@ static EMACS_INT total_strings, total_free_strings;
1723 1721
1724/* Number of bytes used by live strings. */ 1722/* Number of bytes used by live strings. */
1725 1723
1726static EMACS_INT total_string_size; 1724static EMACS_INT total_string_bytes;
1727 1725
1728/* Given a pointer to a Lisp_String S which is on the free-list 1726/* Given a pointer to a Lisp_String S which is on the free-list
1729 string_free_list, return a pointer to its successor in the 1727 string_free_list, return a pointer to its successor in the
@@ -1805,10 +1803,6 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
1805static void 1803static void
1806init_strings (void) 1804init_strings (void)
1807{ 1805{
1808 total_strings = total_free_strings = total_string_size = 0;
1809 oldest_sblock = current_sblock = large_sblocks = NULL;
1810 string_blocks = NULL;
1811 string_free_list = NULL;
1812 empty_unibyte_string = make_pure_string ("", 0, 0, 0); 1806 empty_unibyte_string = make_pure_string ("", 0, 0, 0);
1813 empty_multibyte_string = make_pure_string ("", 0, 0, 1); 1807 empty_multibyte_string = make_pure_string ("", 0, 0, 1);
1814} 1808}
@@ -1852,7 +1846,7 @@ check_sblock (struct sblock *b)
1852 ptrdiff_t nbytes; 1846 ptrdiff_t nbytes;
1853 1847
1854 /* Check that the string size recorded in the string is the 1848 /* Check that the string size recorded in the string is the
1855 same as the one recorded in the sdata structure. */ 1849 same as the one recorded in the sdata structure. */
1856 if (from->string) 1850 if (from->string)
1857 CHECK_STRING_BYTES (from->string); 1851 CHECK_STRING_BYTES (from->string);
1858 1852
@@ -1888,7 +1882,7 @@ check_string_bytes (int all_p)
1888 for (b = oldest_sblock; b; b = b->next) 1882 for (b = oldest_sblock; b; b = b->next)
1889 check_sblock (b); 1883 check_sblock (b);
1890 } 1884 }
1891 else 1885 else if (current_sblock)
1892 check_sblock (current_sblock); 1886 check_sblock (current_sblock);
1893} 1887}
1894 1888
@@ -1932,17 +1926,17 @@ allocate_string (void)
1932 add all the Lisp_Strings in it to the free-list. */ 1926 add all the Lisp_Strings in it to the free-list. */
1933 if (string_free_list == NULL) 1927 if (string_free_list == NULL)
1934 { 1928 {
1935 struct string_block *b; 1929 struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING);
1936 int i; 1930 int i;
1937 1931
1938 b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING);
1939 memset (b, 0, sizeof *b);
1940 b->next = string_blocks; 1932 b->next = string_blocks;
1941 string_blocks = b; 1933 string_blocks = b;
1942 1934
1943 for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i) 1935 for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
1944 { 1936 {
1945 s = b->strings + i; 1937 s = b->strings + i;
1938 /* Every string on a free list should have NULL data pointer. */
1939 s->data = NULL;
1946 NEXT_FREE_LISP_STRING (s) = string_free_list; 1940 NEXT_FREE_LISP_STRING (s) = string_free_list;
1947 string_free_list = s; 1941 string_free_list = s;
1948 } 1942 }
@@ -1958,9 +1952,6 @@ allocate_string (void)
1958 1952
1959 MALLOC_UNBLOCK_INPUT; 1953 MALLOC_UNBLOCK_INPUT;
1960 1954
1961 /* Probably not strictly necessary, but play it safe. */
1962 memset (s, 0, sizeof *s);
1963
1964 --total_free_strings; 1955 --total_free_strings;
1965 ++total_strings; 1956 ++total_strings;
1966 ++strings_consed; 1957 ++strings_consed;
@@ -2003,8 +1994,13 @@ allocate_string_data (struct Lisp_String *s,
2003 /* Determine the number of bytes needed to store NBYTES bytes 1994 /* Determine the number of bytes needed to store NBYTES bytes
2004 of string data. */ 1995 of string data. */
2005 needed = SDATA_SIZE (nbytes); 1996 needed = SDATA_SIZE (nbytes);
2006 old_data = s->data ? SDATA_OF_STRING (s) : NULL; 1997 if (s->data)
2007 old_nbytes = GC_STRING_BYTES (s); 1998 {
1999 old_data = SDATA_OF_STRING (s);
2000 old_nbytes = GC_STRING_BYTES (s);
2001 }
2002 else
2003 old_data = NULL;
2008 2004
2009 MALLOC_BLOCK_INPUT; 2005 MALLOC_BLOCK_INPUT;
2010 2006
@@ -2025,7 +2021,7 @@ allocate_string_data (struct Lisp_String *s,
2025 mallopt (M_MMAP_MAX, 0); 2021 mallopt (M_MMAP_MAX, 0);
2026#endif 2022#endif
2027 2023
2028 b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); 2024 b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
2029 2025
2030#ifdef DOUG_LEA_MALLOC 2026#ifdef DOUG_LEA_MALLOC
2031 /* Back to a reasonable maximum of mmap'ed areas. */ 2027 /* Back to a reasonable maximum of mmap'ed areas. */
@@ -2043,7 +2039,7 @@ allocate_string_data (struct Lisp_String *s,
2043 < (needed + GC_STRING_EXTRA))) 2039 < (needed + GC_STRING_EXTRA)))
2044 { 2040 {
2045 /* Not enough room in the current sblock. */ 2041 /* Not enough room in the current sblock. */
2046 b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); 2042 b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
2047 b->next_free = &b->first_data; 2043 b->next_free = &b->first_data;
2048 b->first_data.string = NULL; 2044 b->first_data.string = NULL;
2049 b->next = NULL; 2045 b->next = NULL;
@@ -2075,9 +2071,9 @@ allocate_string_data (struct Lisp_String *s,
2075 GC_STRING_OVERRUN_COOKIE_SIZE); 2071 GC_STRING_OVERRUN_COOKIE_SIZE);
2076#endif 2072#endif
2077 2073
2078 /* If S had already data assigned, mark that as free by setting its 2074 /* Note that Faset may call to this function when S has already data
2079 string back-pointer to null, and recording the size of the data 2075 assigned. In this case, mark data as free by setting it's string
2080 in it. */ 2076 back-pointer to null, and record the size of the data in it. */
2081 if (old_data) 2077 if (old_data)
2082 { 2078 {
2083 SDATA_NBYTES (old_data) = old_nbytes; 2079 SDATA_NBYTES (old_data) = old_nbytes;
@@ -2098,7 +2094,7 @@ sweep_strings (void)
2098 2094
2099 string_free_list = NULL; 2095 string_free_list = NULL;
2100 total_strings = total_free_strings = 0; 2096 total_strings = total_free_strings = 0;
2101 total_string_size = 0; 2097 total_string_bytes = 0;
2102 2098
2103 /* Scan strings_blocks, free Lisp_Strings that aren't marked. */ 2099 /* Scan strings_blocks, free Lisp_Strings that aren't marked. */
2104 for (b = string_blocks; b; b = next) 2100 for (b = string_blocks; b; b = next)
@@ -2124,7 +2120,7 @@ sweep_strings (void)
2124 UNMARK_BALANCE_INTERVALS (s->intervals); 2120 UNMARK_BALANCE_INTERVALS (s->intervals);
2125 2121
2126 ++total_strings; 2122 ++total_strings;
2127 total_string_size += STRING_BYTES (s); 2123 total_string_bytes += STRING_BYTES (s);
2128 } 2124 }
2129 else 2125 else
2130 { 2126 {
@@ -2234,7 +2230,7 @@ compact_small_strings (void)
2234 for (b = oldest_sblock; b; b = b->next) 2230 for (b = oldest_sblock; b; b = b->next)
2235 { 2231 {
2236 end = b->next_free; 2232 end = b->next_free;
2237 xassert ((char *) end <= (char *) b + SBLOCK_SIZE); 2233 eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
2238 2234
2239 for (from = &b->first_data; from < end; from = from_end) 2235 for (from = &b->first_data; from < end; from = from_end)
2240 { 2236 {
@@ -2285,7 +2281,7 @@ compact_small_strings (void)
2285 /* Copy, and update the string's `data' pointer. */ 2281 /* Copy, and update the string's `data' pointer. */
2286 if (from != to) 2282 if (from != to)
2287 { 2283 {
2288 xassert (tb != b || to < from); 2284 eassert (tb != b || to < from);
2289 memmove (to, from, nbytes + GC_STRING_EXTRA); 2285 memmove (to, from, nbytes + GC_STRING_EXTRA);
2290 to->string->data = SDATA_DATA (to); 2286 to->string->data = SDATA_DATA (to);
2291 } 2287 }
@@ -2373,6 +2369,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2373 ptrdiff_t length_in_chars; 2369 ptrdiff_t length_in_chars;
2374 EMACS_INT length_in_elts; 2370 EMACS_INT length_in_elts;
2375 int bits_per_value; 2371 int bits_per_value;
2372 int extra_bool_elts = ((bool_header_size - header_size + word_size - 1)
2373 / word_size);
2376 2374
2377 CHECK_NATNUM (length); 2375 CHECK_NATNUM (length);
2378 2376
@@ -2380,9 +2378,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2380 2378
2381 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; 2379 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
2382 2380
2383 /* We must allocate one more elements than LENGTH_IN_ELTS for the 2381 val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
2384 slot `size' of the struct Lisp_Bool_Vector. */
2385 val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
2386 2382
2387 /* No Lisp_Object to trace in there. */ 2383 /* No Lisp_Object to trace in there. */
2388 XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0); 2384 XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
@@ -2398,7 +2394,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2398 2394
2399 /* Clear any extraneous bits in the last byte. */ 2395 /* Clear any extraneous bits in the last byte. */
2400 p->data[length_in_chars - 1] 2396 p->data[length_in_chars - 1]
2401 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; 2397 &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
2402 } 2398 }
2403 2399
2404 return val; 2400 return val;
@@ -2496,16 +2492,6 @@ make_specified_string (const char *contents,
2496} 2492}
2497 2493
2498 2494
2499/* Make a string from the data at STR, treating it as multibyte if the
2500 data warrants. */
2501
2502Lisp_Object
2503build_string (const char *str)
2504{
2505 return make_string (str, strlen (str));
2506}
2507
2508
2509/* Return an unibyte Lisp_String set up to hold LENGTH characters 2495/* Return an unibyte Lisp_String set up to hold LENGTH characters
2510 occupying LENGTH bytes. */ 2496 occupying LENGTH bytes. */
2511 2497
@@ -2537,12 +2523,27 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
2537 return empty_multibyte_string; 2523 return empty_multibyte_string;
2538 2524
2539 s = allocate_string (); 2525 s = allocate_string ();
2526 s->intervals = NULL_INTERVAL;
2540 allocate_string_data (s, nchars, nbytes); 2527 allocate_string_data (s, nchars, nbytes);
2541 XSETSTRING (string, s); 2528 XSETSTRING (string, s);
2542 string_chars_consed += nbytes; 2529 string_chars_consed += nbytes;
2543 return string; 2530 return string;
2544} 2531}
2545 2532
2533/* Print arguments to BUF according to a FORMAT, then return
2534 a Lisp_String initialized with the data from BUF. */
2535
2536Lisp_Object
2537make_formatted_string (char *buf, const char *format, ...)
2538{
2539 va_list ap;
2540 int length;
2541
2542 va_start (ap, format);
2543 length = vsprintf (buf, format, ap);
2544 va_end (ap);
2545 return make_string (buf, length);
2546}
2546 2547
2547 2548
2548/*********************************************************************** 2549/***********************************************************************
@@ -2602,24 +2603,12 @@ static struct float_block *float_block;
2602 2603
2603/* Index of first unused Lisp_Float in the current float_block. */ 2604/* Index of first unused Lisp_Float in the current float_block. */
2604 2605
2605static int float_block_index; 2606static int float_block_index = FLOAT_BLOCK_SIZE;
2606 2607
2607/* Free-list of Lisp_Floats. */ 2608/* Free-list of Lisp_Floats. */
2608 2609
2609static struct Lisp_Float *float_free_list; 2610static struct Lisp_Float *float_free_list;
2610 2611
2611
2612/* Initialize float allocation. */
2613
2614static void
2615init_float (void)
2616{
2617 float_block = NULL;
2618 float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
2619 float_free_list = 0;
2620}
2621
2622
2623/* Return a new float object with value FLOAT_VALUE. */ 2612/* Return a new float object with value FLOAT_VALUE. */
2624 2613
2625Lisp_Object 2614Lisp_Object
@@ -2642,14 +2631,13 @@ make_float (double float_value)
2642 { 2631 {
2643 if (float_block_index == FLOAT_BLOCK_SIZE) 2632 if (float_block_index == FLOAT_BLOCK_SIZE)
2644 { 2633 {
2645 register struct float_block *new; 2634 struct float_block *new
2646 2635 = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT);
2647 new = (struct float_block *) lisp_align_malloc (sizeof *new,
2648 MEM_TYPE_FLOAT);
2649 new->next = float_block; 2636 new->next = float_block;
2650 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); 2637 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
2651 float_block = new; 2638 float_block = new;
2652 float_block_index = 0; 2639 float_block_index = 0;
2640 total_free_floats += FLOAT_BLOCK_SIZE;
2653 } 2641 }
2654 XSETFLOAT (val, &float_block->floats[float_block_index]); 2642 XSETFLOAT (val, &float_block->floats[float_block_index]);
2655 float_block_index++; 2643 float_block_index++;
@@ -2661,6 +2649,7 @@ make_float (double float_value)
2661 eassert (!FLOAT_MARKED_P (XFLOAT (val))); 2649 eassert (!FLOAT_MARKED_P (XFLOAT (val)));
2662 consing_since_gc += sizeof (struct Lisp_Float); 2650 consing_since_gc += sizeof (struct Lisp_Float);
2663 floats_consed++; 2651 floats_consed++;
2652 total_free_floats--;
2664 return val; 2653 return val;
2665} 2654}
2666 2655
@@ -2710,24 +2699,12 @@ static struct cons_block *cons_block;
2710 2699
2711/* Index of first unused Lisp_Cons in the current block. */ 2700/* Index of first unused Lisp_Cons in the current block. */
2712 2701
2713static int cons_block_index; 2702static int cons_block_index = CONS_BLOCK_SIZE;
2714 2703
2715/* Free-list of Lisp_Cons structures. */ 2704/* Free-list of Lisp_Cons structures. */
2716 2705
2717static struct Lisp_Cons *cons_free_list; 2706static struct Lisp_Cons *cons_free_list;
2718 2707
2719
2720/* Initialize cons allocation. */
2721
2722static void
2723init_cons (void)
2724{
2725 cons_block = NULL;
2726 cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
2727 cons_free_list = 0;
2728}
2729
2730
2731/* Explicitly free a cons cell by putting it on the free-list. */ 2708/* Explicitly free a cons cell by putting it on the free-list. */
2732 2709
2733void 2710void
@@ -2738,6 +2715,8 @@ free_cons (struct Lisp_Cons *ptr)
2738 ptr->car = Vdead; 2715 ptr->car = Vdead;
2739#endif 2716#endif
2740 cons_free_list = ptr; 2717 cons_free_list = ptr;
2718 consing_since_gc -= sizeof *ptr;
2719 total_free_conses++;
2741} 2720}
2742 2721
2743DEFUN ("cons", Fcons, Scons, 2, 2, 0, 2722DEFUN ("cons", Fcons, Scons, 2, 2, 0,
@@ -2761,13 +2740,13 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2761 { 2740 {
2762 if (cons_block_index == CONS_BLOCK_SIZE) 2741 if (cons_block_index == CONS_BLOCK_SIZE)
2763 { 2742 {
2764 register struct cons_block *new; 2743 struct cons_block *new
2765 new = (struct cons_block *) lisp_align_malloc (sizeof *new, 2744 = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
2766 MEM_TYPE_CONS);
2767 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); 2745 memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
2768 new->next = cons_block; 2746 new->next = cons_block;
2769 cons_block = new; 2747 cons_block = new;
2770 cons_block_index = 0; 2748 cons_block_index = 0;
2749 total_free_conses += CONS_BLOCK_SIZE;
2771 } 2750 }
2772 XSETCONS (val, &cons_block->conses[cons_block_index]); 2751 XSETCONS (val, &cons_block->conses[cons_block_index]);
2773 cons_block_index++; 2752 cons_block_index++;
@@ -2779,6 +2758,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2779 XSETCDR (val, cdr); 2758 XSETCDR (val, cdr);
2780 eassert (!CONS_MARKED_P (XCONS (val))); 2759 eassert (!CONS_MARKED_P (XCONS (val)));
2781 consing_since_gc += sizeof (struct Lisp_Cons); 2760 consing_since_gc += sizeof (struct Lisp_Cons);
2761 total_free_conses--;
2782 cons_cells_consed++; 2762 cons_cells_consed++;
2783 return val; 2763 return val;
2784} 2764}
@@ -2908,18 +2888,20 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2908 2888
2909#define VECTOR_BLOCK_SIZE 4096 2889#define VECTOR_BLOCK_SIZE 4096
2910 2890
2911/* Handy constants for vectorlike objects. */ 2891/* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */
2912enum 2892enum
2913 { 2893 {
2914 header_size = offsetof (struct Lisp_Vector, contents), 2894 roundup_size = COMMON_MULTIPLE (word_size,
2915 word_size = sizeof (Lisp_Object),
2916 roundup_size = COMMON_MULTIPLE (sizeof (Lisp_Object),
2917 USE_LSB_TAG ? 1 << GCTYPEBITS : 1) 2895 USE_LSB_TAG ? 1 << GCTYPEBITS : 1)
2918 }; 2896 };
2919 2897
2920/* ROUNDUP_SIZE must be a power of 2. */ 2898/* ROUNDUP_SIZE must be a power of 2. */
2921verify ((roundup_size & (roundup_size - 1)) == 0); 2899verify ((roundup_size & (roundup_size - 1)) == 0);
2922 2900
2901/* Verify assumptions described above. */
2902verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
2903verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
2904
2923/* Round up X to nearest mult-of-ROUNDUP_SIZE. */ 2905/* Round up X to nearest mult-of-ROUNDUP_SIZE. */
2924 2906
2925#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1)) 2907#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
@@ -2935,7 +2917,7 @@ verify ((roundup_size & (roundup_size - 1)) == 0);
2935/* Size of the largest vector allocated from block. */ 2917/* Size of the largest vector allocated from block. */
2936 2918
2937#define VBLOCK_BYTES_MAX \ 2919#define VBLOCK_BYTES_MAX \
2938 vroundup ((VECTOR_BLOCK_BYTES / 2) - sizeof (Lisp_Object)) 2920 vroundup ((VECTOR_BLOCK_BYTES / 2) - word_size)
2939 2921
2940/* We maintain one free list for each possible block-allocated 2922/* We maintain one free list for each possible block-allocated
2941 vector size, and this is the number of free lists we have. */ 2923 vector size, and this is the number of free lists we have. */
@@ -2943,12 +2925,6 @@ verify ((roundup_size & (roundup_size - 1)) == 0);
2943#define VECTOR_MAX_FREE_LIST_INDEX \ 2925#define VECTOR_MAX_FREE_LIST_INDEX \
2944 ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1) 2926 ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1)
2945 2927
2946/* When the vector is on a free list, vectorlike_header.SIZE is set to
2947 this special value ORed with vector's memory footprint size. */
2948
2949#define VECTOR_FREE_LIST_FLAG (~(ARRAY_MARK_FLAG | PSEUDOVECTOR_FLAG \
2950 | (VECTOR_BLOCK_SIZE - 1)))
2951
2952/* Common shortcut to advance vector pointer over a block data. */ 2928/* Common shortcut to advance vector pointer over a block data. */
2953 2929
2954#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes))) 2930#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
@@ -2961,12 +2937,13 @@ verify ((roundup_size & (roundup_size - 1)) == 0);
2961 2937
2962#define SETUP_ON_FREE_LIST(v, nbytes, index) \ 2938#define SETUP_ON_FREE_LIST(v, nbytes, index) \
2963 do { \ 2939 do { \
2964 (v)->header.size = VECTOR_FREE_LIST_FLAG | (nbytes); \ 2940 XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \
2965 eassert ((nbytes) % roundup_size == 0); \ 2941 eassert ((nbytes) % roundup_size == 0); \
2966 (index) = VINDEX (nbytes); \ 2942 (index) = VINDEX (nbytes); \
2967 eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ 2943 eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
2968 (v)->header.next.vector = vector_free_lists[index]; \ 2944 (v)->header.next.vector = vector_free_lists[index]; \
2969 vector_free_lists[index] = (v); \ 2945 vector_free_lists[index] = (v); \
2946 total_free_vector_slots += (nbytes) / word_size; \
2970 } while (0) 2947 } while (0)
2971 2948
2972struct vector_block 2949struct vector_block
@@ -2990,24 +2967,22 @@ static struct Lisp_Vector *large_vectors;
2990 2967
2991/* The only vector with 0 slots, allocated from pure space. */ 2968/* The only vector with 0 slots, allocated from pure space. */
2992 2969
2993static struct Lisp_Vector *zero_vector; 2970Lisp_Object zero_vector;
2971
2972/* Number of live vectors. */
2973
2974static EMACS_INT total_vectors;
2975
2976/* Total size of live and free vectors, in Lisp_Object units. */
2977
2978static EMACS_INT total_vector_slots, total_free_vector_slots;
2994 2979
2995/* Get a new vector block. */ 2980/* Get a new vector block. */
2996 2981
2997static struct vector_block * 2982static struct vector_block *
2998allocate_vector_block (void) 2983allocate_vector_block (void)
2999{ 2984{
3000 struct vector_block *block; 2985 struct vector_block *block = xmalloc (sizeof *block);
3001
3002#ifdef DOUG_LEA_MALLOC
3003 mallopt (M_MMAP_MAX, 0);
3004#endif
3005
3006 block = xmalloc (sizeof (struct vector_block));
3007
3008#ifdef DOUG_LEA_MALLOC
3009 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
3010#endif
3011 2986
3012#if GC_MARK_STACK && !defined GC_MALLOC_CHECK 2987#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
3013 mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES, 2988 mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
@@ -3024,8 +2999,7 @@ allocate_vector_block (void)
3024static void 2999static void
3025init_vectors (void) 3000init_vectors (void)
3026{ 3001{
3027 zero_vector = pure_alloc (header_size, Lisp_Vectorlike); 3002 zero_vector = make_pure_vector (0);
3028 zero_vector->header.size = 0;
3029} 3003}
3030 3004
3031/* Allocate vector from a vector block. */ 3005/* Allocate vector from a vector block. */
@@ -3048,6 +3022,7 @@ allocate_vector_from_block (size_t nbytes)
3048 vector = vector_free_lists[index]; 3022 vector = vector_free_lists[index];
3049 vector_free_lists[index] = vector->header.next.vector; 3023 vector_free_lists[index] = vector->header.next.vector;
3050 vector->header.next.nbytes = nbytes; 3024 vector->header.next.nbytes = nbytes;
3025 total_free_vector_slots -= nbytes / word_size;
3051 return vector; 3026 return vector;
3052 } 3027 }
3053 3028
@@ -3062,6 +3037,7 @@ allocate_vector_from_block (size_t nbytes)
3062 vector = vector_free_lists[index]; 3037 vector = vector_free_lists[index];
3063 vector_free_lists[index] = vector->header.next.vector; 3038 vector_free_lists[index] = vector->header.next.vector;
3064 vector->header.next.nbytes = nbytes; 3039 vector->header.next.nbytes = nbytes;
3040 total_free_vector_slots -= nbytes / word_size;
3065 3041
3066 /* Excess bytes are used for the smaller vector, 3042 /* Excess bytes are used for the smaller vector,
3067 which should be set on an appropriate free list. */ 3043 which should be set on an appropriate free list. */
@@ -3091,18 +3067,22 @@ allocate_vector_from_block (size_t nbytes)
3091 return vector; 3067 return vector;
3092 } 3068 }
3093 3069
3094/* Return how many Lisp_Objects can be stored in V. */
3095
3096#define VECTOR_SIZE(v) ((v)->header.size & PSEUDOVECTOR_FLAG ? \
3097 (PSEUDOVECTOR_SIZE_MASK & (v)->header.size) : \
3098 (v)->header.size)
3099
3100/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */ 3070/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
3101 3071
3102#define VECTOR_IN_BLOCK(vector, block) \ 3072#define VECTOR_IN_BLOCK(vector, block) \
3103 ((char *) (vector) <= (block)->data \ 3073 ((char *) (vector) <= (block)->data \
3104 + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) 3074 + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
3105 3075
3076/* Number of bytes used by vector-block-allocated object. This is the only
3077 place where we actually use the `nbytes' field of the vector-header.
3078 I.e. we could get rid of the `nbytes' field by computing it based on the
3079 vector-type. */
3080
3081#define PSEUDOVECTOR_NBYTES(vector) \
3082 (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
3083 ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
3084 : vector->header.next.nbytes)
3085
3106/* Reclaim space used by unmarked vectors. */ 3086/* Reclaim space used by unmarked vectors. */
3107 3087
3108static void 3088static void
@@ -3111,7 +3091,7 @@ sweep_vectors (void)
3111 struct vector_block *block = vector_blocks, **bprev = &vector_blocks; 3091 struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
3112 struct Lisp_Vector *vector, *next, **vprev = &large_vectors; 3092 struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
3113 3093
3114 total_vector_size = 0; 3094 total_vectors = total_vector_slots = total_free_vector_slots = 0;
3115 memset (vector_free_lists, 0, sizeof (vector_free_lists)); 3095 memset (vector_free_lists, 0, sizeof (vector_free_lists));
3116 3096
3117 /* Looking through vector blocks. */ 3097 /* Looking through vector blocks. */
@@ -3126,19 +3106,16 @@ sweep_vectors (void)
3126 if (VECTOR_MARKED_P (vector)) 3106 if (VECTOR_MARKED_P (vector))
3127 { 3107 {
3128 VECTOR_UNMARK (vector); 3108 VECTOR_UNMARK (vector);
3129 total_vector_size += VECTOR_SIZE (vector); 3109 total_vectors++;
3110 total_vector_slots += vector->header.next.nbytes / word_size;
3130 next = ADVANCE (vector, vector->header.next.nbytes); 3111 next = ADVANCE (vector, vector->header.next.nbytes);
3131 } 3112 }
3132 else 3113 else
3133 { 3114 {
3134 ptrdiff_t nbytes; 3115 ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector);
3116 ptrdiff_t total_bytes = nbytes;
3135 3117
3136 if ((vector->header.size & VECTOR_FREE_LIST_FLAG) 3118 next = ADVANCE (vector, nbytes);
3137 == VECTOR_FREE_LIST_FLAG)
3138 vector->header.next.nbytes =
3139 vector->header.size & (VECTOR_BLOCK_SIZE - 1);
3140
3141 next = ADVANCE (vector, vector->header.next.nbytes);
3142 3119
3143 /* While NEXT is not marked, try to coalesce with VECTOR, 3120 /* While NEXT is not marked, try to coalesce with VECTOR,
3144 thus making VECTOR of the largest possible size. */ 3121 thus making VECTOR of the largest possible size. */
@@ -3147,16 +3124,12 @@ sweep_vectors (void)
3147 { 3124 {
3148 if (VECTOR_MARKED_P (next)) 3125 if (VECTOR_MARKED_P (next))
3149 break; 3126 break;
3150 if ((next->header.size & VECTOR_FREE_LIST_FLAG) 3127 nbytes = PSEUDOVECTOR_NBYTES (next);
3151 == VECTOR_FREE_LIST_FLAG) 3128 total_bytes += nbytes;
3152 nbytes = next->header.size & (VECTOR_BLOCK_SIZE - 1);
3153 else
3154 nbytes = next->header.next.nbytes;
3155 vector->header.next.nbytes += nbytes;
3156 next = ADVANCE (next, nbytes); 3129 next = ADVANCE (next, nbytes);
3157 } 3130 }
3158 3131
3159 eassert (vector->header.next.nbytes % roundup_size == 0); 3132 eassert (total_bytes % roundup_size == 0);
3160 3133
3161 if (vector == (struct Lisp_Vector *) block->data 3134 if (vector == (struct Lisp_Vector *) block->data
3162 && !VECTOR_IN_BLOCK (next, block)) 3135 && !VECTOR_IN_BLOCK (next, block))
@@ -3164,7 +3137,10 @@ sweep_vectors (void)
3164 space was coalesced into the only free vector. */ 3137 space was coalesced into the only free vector. */
3165 free_this_block = 1; 3138 free_this_block = 1;
3166 else 3139 else
3167 SETUP_ON_FREE_LIST (vector, vector->header.next.nbytes, nbytes); 3140 {
3141 int tmp;
3142 SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
3143 }
3168 } 3144 }
3169 } 3145 }
3170 3146
@@ -3187,7 +3163,24 @@ sweep_vectors (void)
3187 if (VECTOR_MARKED_P (vector)) 3163 if (VECTOR_MARKED_P (vector))
3188 { 3164 {
3189 VECTOR_UNMARK (vector); 3165 VECTOR_UNMARK (vector);
3190 total_vector_size += VECTOR_SIZE (vector); 3166 total_vectors++;
3167 if (vector->header.size & PSEUDOVECTOR_FLAG)
3168 {
3169 struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) vector;
3170
3171 /* All non-bool pseudovectors are small enough to be allocated
3172 from vector blocks. This code should be redesigned if some
3173 pseudovector type grows beyond VBLOCK_BYTES_MAX. */
3174 eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
3175
3176 total_vector_slots
3177 += (bool_header_size
3178 + ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
3179 / BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
3180 }
3181 else
3182 total_vector_slots
3183 += header_size / word_size + vector->header.size;
3191 vprev = &vector->header.next.vector; 3184 vprev = &vector->header.next.vector;
3192 } 3185 }
3193 else 3186 else
@@ -3205,44 +3198,42 @@ static struct Lisp_Vector *
3205allocate_vectorlike (ptrdiff_t len) 3198allocate_vectorlike (ptrdiff_t len)
3206{ 3199{
3207 struct Lisp_Vector *p; 3200 struct Lisp_Vector *p;
3208 size_t nbytes;
3209 3201
3210 MALLOC_BLOCK_INPUT; 3202 MALLOC_BLOCK_INPUT;
3211 3203
3212#ifdef DOUG_LEA_MALLOC
3213 /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
3214 because mapped region contents are not preserved in
3215 a dumped Emacs. */
3216 mallopt (M_MMAP_MAX, 0);
3217#endif
3218
3219 /* This gets triggered by code which I haven't bothered to fix. --Stef */ 3204 /* This gets triggered by code which I haven't bothered to fix. --Stef */
3220 /* eassert (!handling_signal); */ 3205 /* eassert (!handling_signal); */
3221 3206
3222 if (len == 0) 3207 if (len == 0)
3208 p = XVECTOR (zero_vector);
3209 else
3223 { 3210 {
3224 MALLOC_UNBLOCK_INPUT; 3211 size_t nbytes = header_size + len * word_size;
3225 return zero_vector;
3226 }
3227 3212
3228 nbytes = header_size + len * word_size; 3213#ifdef DOUG_LEA_MALLOC
3214 /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
3215 because mapped region contents are not preserved in
3216 a dumped Emacs. */
3217 mallopt (M_MMAP_MAX, 0);
3218#endif
3229 3219
3230 if (nbytes <= VBLOCK_BYTES_MAX) 3220 if (nbytes <= VBLOCK_BYTES_MAX)
3231 p = allocate_vector_from_block (vroundup (nbytes)); 3221 p = allocate_vector_from_block (vroundup (nbytes));
3232 else 3222 else
3233 { 3223 {
3234 p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); 3224 p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
3235 p->header.next.vector = large_vectors; 3225 p->header.next.vector = large_vectors;
3236 large_vectors = p; 3226 large_vectors = p;
3237 } 3227 }
3238 3228
3239#ifdef DOUG_LEA_MALLOC 3229#ifdef DOUG_LEA_MALLOC
3240 /* Back to a reasonable maximum of mmap'ed areas. */ 3230 /* Back to a reasonable maximum of mmap'ed areas. */
3241 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); 3231 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
3242#endif 3232#endif
3243 3233
3244 consing_since_gc += nbytes; 3234 consing_since_gc += nbytes;
3245 vector_cells_consed += len; 3235 vector_cells_consed += len;
3236 }
3246 3237
3247 MALLOC_UNBLOCK_INPUT; 3238 MALLOC_UNBLOCK_INPUT;
3248 3239
@@ -3282,50 +3273,70 @@ allocate_pseudovector (int memlen, int lisplen, int tag)
3282 return v; 3273 return v;
3283} 3274}
3284 3275
3276struct buffer *
3277allocate_buffer (void)
3278{
3279 struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
3280
3281 XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
3282 - header_size) / word_size);
3283 /* Note that the fields of B are not initialized. */
3284 return b;
3285}
3286
3285struct Lisp_Hash_Table * 3287struct Lisp_Hash_Table *
3286allocate_hash_table (void) 3288allocate_hash_table (void)
3287{ 3289{
3288 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE); 3290 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
3289} 3291}
3290 3292
3291
3292struct window * 3293struct window *
3293allocate_window (void) 3294allocate_window (void)
3294{ 3295{
3295 return ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW); 3296 struct window *w;
3296}
3297 3297
3298 w = ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
3299 /* Users assumes that non-Lisp data is zeroed. */
3300 memset (&w->current_matrix, 0,
3301 sizeof (*w) - offsetof (struct window, current_matrix));
3302 return w;
3303}
3298 3304
3299struct terminal * 3305struct terminal *
3300allocate_terminal (void) 3306allocate_terminal (void)
3301{ 3307{
3302 struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal, 3308 struct terminal *t;
3303 next_terminal, PVEC_TERMINAL);
3304 /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
3305 memset (&t->next_terminal, 0,
3306 (char*) (t + 1) - (char*) &t->next_terminal);
3307 3309
3310 t = ALLOCATE_PSEUDOVECTOR (struct terminal, next_terminal, PVEC_TERMINAL);
3311 /* Users assumes that non-Lisp data is zeroed. */
3312 memset (&t->next_terminal, 0,
3313 sizeof (*t) - offsetof (struct terminal, next_terminal));
3308 return t; 3314 return t;
3309} 3315}
3310 3316
3311struct frame * 3317struct frame *
3312allocate_frame (void) 3318allocate_frame (void)
3313{ 3319{
3314 struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame, 3320 struct frame *f;
3315 face_cache, PVEC_FRAME); 3321
3316 /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */ 3322 f = ALLOCATE_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME);
3323 /* Users assumes that non-Lisp data is zeroed. */
3317 memset (&f->face_cache, 0, 3324 memset (&f->face_cache, 0,
3318 (char *) (f + 1) - (char *) &f->face_cache); 3325 sizeof (*f) - offsetof (struct frame, face_cache));
3319 return f; 3326 return f;
3320} 3327}
3321 3328
3322
3323struct Lisp_Process * 3329struct Lisp_Process *
3324allocate_process (void) 3330allocate_process (void)
3325{ 3331{
3326 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS); 3332 struct Lisp_Process *p;
3327}
3328 3333
3334 p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
3335 /* Users assumes that non-Lisp data is zeroed. */
3336 memset (&p->pid, 0,
3337 sizeof (*p) - offsetof (struct Lisp_Process, pid));
3338 return p;
3339}
3329 3340
3330DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, 3341DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
3331 doc: /* Return a newly created vector of length LENGTH, with each element being INIT. 3342 doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
@@ -3458,24 +3469,12 @@ struct symbol_block
3458 structure in it. */ 3469 structure in it. */
3459 3470
3460static struct symbol_block *symbol_block; 3471static struct symbol_block *symbol_block;
3461static int symbol_block_index; 3472static int symbol_block_index = SYMBOL_BLOCK_SIZE;
3462 3473
3463/* List of free symbols. */ 3474/* List of free symbols. */
3464 3475
3465static struct Lisp_Symbol *symbol_free_list; 3476static struct Lisp_Symbol *symbol_free_list;
3466 3477
3467
3468/* Initialize symbol allocation. */
3469
3470static void
3471init_symbol (void)
3472{
3473 symbol_block = NULL;
3474 symbol_block_index = SYMBOL_BLOCK_SIZE;
3475 symbol_free_list = 0;
3476}
3477
3478
3479DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3478DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
3480 doc: /* Return a newly allocated uninterned symbol whose name is NAME. 3479 doc: /* Return a newly allocated uninterned symbol whose name is NAME.
3481Its value and function definition are void, and its property list is nil. */) 3480Its value and function definition are void, and its property list is nil. */)
@@ -3499,12 +3498,12 @@ Its value and function definition are void, and its property list is nil. */)
3499 { 3498 {
3500 if (symbol_block_index == SYMBOL_BLOCK_SIZE) 3499 if (symbol_block_index == SYMBOL_BLOCK_SIZE)
3501 { 3500 {
3502 struct symbol_block *new; 3501 struct symbol_block *new
3503 new = (struct symbol_block *) lisp_malloc (sizeof *new, 3502 = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
3504 MEM_TYPE_SYMBOL);
3505 new->next = symbol_block; 3503 new->next = symbol_block;
3506 symbol_block = new; 3504 symbol_block = new;
3507 symbol_block_index = 0; 3505 symbol_block_index = 0;
3506 total_free_symbols += SYMBOL_BLOCK_SIZE;
3508 } 3507 }
3509 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s); 3508 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s);
3510 symbol_block_index++; 3509 symbol_block_index++;
@@ -3525,6 +3524,7 @@ Its value and function definition are void, and its property list is nil. */)
3525 p->declared_special = 0; 3524 p->declared_special = 0;
3526 consing_since_gc += sizeof (struct Lisp_Symbol); 3525 consing_since_gc += sizeof (struct Lisp_Symbol);
3527 symbols_consed++; 3526 symbols_consed++;
3527 total_free_symbols--;
3528 return val; 3528 return val;
3529} 3529}
3530 3530
@@ -3560,22 +3560,14 @@ struct marker_block
3560}; 3560};
3561 3561
3562static struct marker_block *marker_block; 3562static struct marker_block *marker_block;
3563static int marker_block_index; 3563static int marker_block_index = MARKER_BLOCK_SIZE;
3564 3564
3565static union Lisp_Misc *marker_free_list; 3565static union Lisp_Misc *marker_free_list;
3566 3566
3567static void 3567/* Return a newly allocated Lisp_Misc object of specified TYPE. */
3568init_marker (void)
3569{
3570 marker_block = NULL;
3571 marker_block_index = MARKER_BLOCK_SIZE;
3572 marker_free_list = 0;
3573}
3574
3575/* Return a newly allocated Lisp_Misc object, with no substructure. */
3576 3568
3577Lisp_Object 3569static Lisp_Object
3578allocate_misc (void) 3570allocate_misc (enum Lisp_Misc_Type type)
3579{ 3571{
3580 Lisp_Object val; 3572 Lisp_Object val;
3581 3573
@@ -3592,9 +3584,7 @@ allocate_misc (void)
3592 { 3584 {
3593 if (marker_block_index == MARKER_BLOCK_SIZE) 3585 if (marker_block_index == MARKER_BLOCK_SIZE)
3594 { 3586 {
3595 struct marker_block *new; 3587 struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC);
3596 new = (struct marker_block *) lisp_malloc (sizeof *new,
3597 MEM_TYPE_MISC);
3598 new->next = marker_block; 3588 new->next = marker_block;
3599 marker_block = new; 3589 marker_block = new;
3600 marker_block_index = 0; 3590 marker_block_index = 0;
@@ -3609,6 +3599,7 @@ allocate_misc (void)
3609 --total_free_markers; 3599 --total_free_markers;
3610 consing_since_gc += sizeof (union Lisp_Misc); 3600 consing_since_gc += sizeof (union Lisp_Misc);
3611 misc_objects_consed++; 3601 misc_objects_consed++;
3602 XMISCTYPE (val) = type;
3612 XMISCANY (val)->gcmarkbit = 0; 3603 XMISCANY (val)->gcmarkbit = 0;
3613 return val; 3604 return val;
3614} 3605}
@@ -3621,7 +3612,7 @@ free_misc (Lisp_Object misc)
3621 XMISCTYPE (misc) = Lisp_Misc_Free; 3612 XMISCTYPE (misc) = Lisp_Misc_Free;
3622 XMISC (misc)->u_free.chain = marker_free_list; 3613 XMISC (misc)->u_free.chain = marker_free_list;
3623 marker_free_list = XMISC (misc); 3614 marker_free_list = XMISC (misc);
3624 3615 consing_since_gc -= sizeof (union Lisp_Misc);
3625 total_free_markers++; 3616 total_free_markers++;
3626} 3617}
3627 3618
@@ -3635,8 +3626,7 @@ make_save_value (void *pointer, ptrdiff_t integer)
3635 register Lisp_Object val; 3626 register Lisp_Object val;
3636 register struct Lisp_Save_Value *p; 3627 register struct Lisp_Save_Value *p;
3637 3628
3638 val = allocate_misc (); 3629 val = allocate_misc (Lisp_Misc_Save_Value);
3639 XMISCTYPE (val) = Lisp_Misc_Save_Value;
3640 p = XSAVE_VALUE (val); 3630 p = XSAVE_VALUE (val);
3641 p->pointer = pointer; 3631 p->pointer = pointer;
3642 p->integer = integer; 3632 p->integer = integer;
@@ -3644,6 +3634,21 @@ make_save_value (void *pointer, ptrdiff_t integer)
3644 return val; 3634 return val;
3645} 3635}
3646 3636
3637/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
3638
3639Lisp_Object
3640build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
3641{
3642 register Lisp_Object overlay;
3643
3644 overlay = allocate_misc (Lisp_Misc_Overlay);
3645 OVERLAY_START (overlay) = start;
3646 OVERLAY_END (overlay) = end;
3647 OVERLAY_PLIST (overlay) = plist;
3648 XOVERLAY (overlay)->next = NULL;
3649 return overlay;
3650}
3651
3647DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, 3652DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
3648 doc: /* Return a newly allocated marker which does not point at any place. */) 3653 doc: /* Return a newly allocated marker which does not point at any place. */)
3649 (void) 3654 (void)
@@ -3651,8 +3656,7 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
3651 register Lisp_Object val; 3656 register Lisp_Object val;
3652 register struct Lisp_Marker *p; 3657 register struct Lisp_Marker *p;
3653 3658
3654 val = allocate_misc (); 3659 val = allocate_misc (Lisp_Misc_Marker);
3655 XMISCTYPE (val) = Lisp_Misc_Marker;
3656 p = XMARKER (val); 3660 p = XMARKER (val);
3657 p->buffer = 0; 3661 p->buffer = 0;
3658 p->bytepos = 0; 3662 p->bytepos = 0;
@@ -3662,6 +3666,32 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
3662 return val; 3666 return val;
3663} 3667}
3664 3668
3669/* Return a newly allocated marker which points into BUF
3670 at character position CHARPOS and byte position BYTEPOS. */
3671
3672Lisp_Object
3673build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
3674{
3675 Lisp_Object obj;
3676 struct Lisp_Marker *m;
3677
3678 /* No dead buffers here. */
3679 eassert (!NILP (BVAR (buf, name)));
3680
3681 /* Every character is at least one byte. */
3682 eassert (charpos <= bytepos);
3683
3684 obj = allocate_misc (Lisp_Misc_Marker);
3685 m = XMARKER (obj);
3686 m->buffer = buf;
3687 m->charpos = charpos;
3688 m->bytepos = bytepos;
3689 m->insertion_type = 0;
3690 m->next = BUF_MARKERS (buf);
3691 BUF_MARKERS (buf) = m;
3692 return obj;
3693}
3694
3665/* Put MARKER back on the free list after using it temporarily. */ 3695/* Put MARKER back on the free list after using it temporarily. */
3666 3696
3667void 3697void
@@ -3787,25 +3817,25 @@ refill_memory_reserve (void)
3787{ 3817{
3788#ifndef SYSTEM_MALLOC 3818#ifndef SYSTEM_MALLOC
3789 if (spare_memory[0] == 0) 3819 if (spare_memory[0] == 0)
3790 spare_memory[0] = (char *) malloc (SPARE_MEMORY); 3820 spare_memory[0] = malloc (SPARE_MEMORY);
3791 if (spare_memory[1] == 0) 3821 if (spare_memory[1] == 0)
3792 spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block), 3822 spare_memory[1] = lisp_align_malloc (sizeof (struct cons_block),
3793 MEM_TYPE_CONS); 3823 MEM_TYPE_CONS);
3794 if (spare_memory[2] == 0) 3824 if (spare_memory[2] == 0)
3795 spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block), 3825 spare_memory[2] = lisp_align_malloc (sizeof (struct cons_block),
3796 MEM_TYPE_CONS); 3826 MEM_TYPE_CONS);
3797 if (spare_memory[3] == 0) 3827 if (spare_memory[3] == 0)
3798 spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block), 3828 spare_memory[3] = lisp_align_malloc (sizeof (struct cons_block),
3799 MEM_TYPE_CONS); 3829 MEM_TYPE_CONS);
3800 if (spare_memory[4] == 0) 3830 if (spare_memory[4] == 0)
3801 spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block), 3831 spare_memory[4] = lisp_align_malloc (sizeof (struct cons_block),
3802 MEM_TYPE_CONS); 3832 MEM_TYPE_CONS);
3803 if (spare_memory[5] == 0) 3833 if (spare_memory[5] == 0)
3804 spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block), 3834 spare_memory[5] = lisp_malloc (sizeof (struct string_block),
3805 MEM_TYPE_STRING); 3835 MEM_TYPE_STRING);
3806 if (spare_memory[6] == 0) 3836 if (spare_memory[6] == 0)
3807 spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block), 3837 spare_memory[6] = lisp_malloc (sizeof (struct string_block),
3808 MEM_TYPE_STRING); 3838 MEM_TYPE_STRING);
3809 if (spare_memory[0] && spare_memory[1] && spare_memory[5]) 3839 if (spare_memory[0] && spare_memory[1] && spare_memory[5])
3810 Vmemory_full = Qnil; 3840 Vmemory_full = Qnil;
3811#endif 3841#endif
@@ -3905,11 +3935,11 @@ mem_insert (void *start, void *end, enum mem_type type)
3905 3935
3906 /* Create a new node. */ 3936 /* Create a new node. */
3907#ifdef GC_MALLOC_CHECK 3937#ifdef GC_MALLOC_CHECK
3908 x = (struct mem_node *) _malloc_internal (sizeof *x); 3938 x = _malloc_internal (sizeof *x);
3909 if (x == NULL) 3939 if (x == NULL)
3910 abort (); 3940 abort ();
3911#else 3941#else
3912 x = (struct mem_node *) xmalloc (sizeof *x); 3942 x = xmalloc (sizeof *x);
3913#endif 3943#endif
3914 x->start = start; 3944 x->start = start;
3915 x->end = end; 3945 x->end = end;
@@ -4362,10 +4392,9 @@ live_vector_p (struct mem_node *m, void *p)
4362 while (VECTOR_IN_BLOCK (vector, block) 4392 while (VECTOR_IN_BLOCK (vector, block)
4363 && vector <= (struct Lisp_Vector *) p) 4393 && vector <= (struct Lisp_Vector *) p)
4364 { 4394 {
4365 if ((vector->header.size & VECTOR_FREE_LIST_FLAG) 4395 if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
4366 == VECTOR_FREE_LIST_FLAG)
4367 vector = ADVANCE (vector, (vector->header.size 4396 vector = ADVANCE (vector, (vector->header.size
4368 & (VECTOR_BLOCK_SIZE - 1))); 4397 & PSEUDOVECTOR_SIZE_MASK));
4369 else if (vector == p) 4398 else if (vector == p)
4370 return 1; 4399 return 1;
4371 else 4400 else
@@ -4622,6 +4651,14 @@ mark_maybe_pointer (void *p)
4622 4651
4623static void 4652static void
4624mark_memory (void *start, void *end) 4653mark_memory (void *start, void *end)
4654#if defined (__clang__) && defined (__has_feature)
4655#if __has_feature(address_sanitizer)
4656 /* Do not allow -faddress-sanitizer to check this function, since it
4657 crosses the function stack boundary, and thus would yield many
4658 false positives. */
4659 __attribute__((no_address_safety_analysis))
4660#endif
4661#endif
4625{ 4662{
4626 void **pp; 4663 void **pp;
4627 int i; 4664 int i;
@@ -5070,7 +5107,7 @@ pure_alloc (size_t size, int type)
5070 /* Don't allocate a large amount here, 5107 /* Don't allocate a large amount here,
5071 because it might get mmap'd and then its address 5108 because it might get mmap'd and then its address
5072 might not be usable. */ 5109 might not be usable. */
5073 purebeg = (char *) xmalloc (10000); 5110 purebeg = xmalloc (10000);
5074 pure_size = 10000; 5111 pure_size = 10000;
5075 pure_bytes_used_before_overflow += pure_bytes_used - size; 5112 pure_bytes_used_before_overflow += pure_bytes_used - size;
5076 pure_bytes_used = 0; 5113 pure_bytes_used = 0;
@@ -5187,15 +5224,14 @@ make_pure_string (const char *data,
5187 return string; 5224 return string;
5188} 5225}
5189 5226
5190/* Return a string a string allocated in pure space. Do not allocate 5227/* Return a string allocated in pure space. Do not
5191 the string data, just point to DATA. */ 5228 allocate the string data, just point to DATA. */
5192 5229
5193Lisp_Object 5230Lisp_Object
5194make_pure_c_string (const char *data) 5231make_pure_c_string (const char *data, ptrdiff_t nchars)
5195{ 5232{
5196 Lisp_Object string; 5233 Lisp_Object string;
5197 struct Lisp_String *s; 5234 struct Lisp_String *s;
5198 ptrdiff_t nchars = strlen (data);
5199 5235
5200 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); 5236 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
5201 s->size = nchars; 5237 s->size = nchars;
@@ -5246,8 +5282,7 @@ make_pure_vector (ptrdiff_t len)
5246{ 5282{
5247 Lisp_Object new; 5283 Lisp_Object new;
5248 struct Lisp_Vector *p; 5284 struct Lisp_Vector *p;
5249 size_t size = (offsetof (struct Lisp_Vector, contents) 5285 size_t size = header_size + len * word_size;
5250 + len * sizeof (Lisp_Object));
5251 5286
5252 p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); 5287 p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
5253 XSETVECTOR (new, p); 5288 XSETVECTOR (new, p);
@@ -5294,7 +5329,7 @@ Does not copy symbols. Copies strings without text properties. */)
5294 size &= PSEUDOVECTOR_SIZE_MASK; 5329 size &= PSEUDOVECTOR_SIZE_MASK;
5295 vec = XVECTOR (make_pure_vector (size)); 5330 vec = XVECTOR (make_pure_vector (size));
5296 for (i = 0; i < size; i++) 5331 for (i = 0; i < size; i++)
5297 vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); 5332 vec->contents[i] = Fpurecopy (AREF (obj, i));
5298 if (COMPILEDP (obj)) 5333 if (COMPILEDP (obj))
5299 { 5334 {
5300 XSETPVECTYPE (vec, PVEC_COMPILED); 5335 XSETPVECTYPE (vec, PVEC_COMPILED);
@@ -5348,28 +5383,40 @@ inhibit_garbage_collection (void)
5348 return count; 5383 return count;
5349} 5384}
5350 5385
5386/* Used to avoid possible overflows when
5387 converting from C to Lisp integers. */
5388
5389static inline Lisp_Object
5390bounded_number (EMACS_INT number)
5391{
5392 return make_number (min (MOST_POSITIVE_FIXNUM, number));
5393}
5351 5394
5352DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", 5395DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
5353 doc: /* Reclaim storage for Lisp objects no longer needed. 5396 doc: /* Reclaim storage for Lisp objects no longer needed.
5354Garbage collection happens automatically if you cons more than 5397Garbage collection happens automatically if you cons more than
5355`gc-cons-threshold' bytes of Lisp data since previous garbage collection. 5398`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
5356`garbage-collect' normally returns a list with info on amount of space in use: 5399`garbage-collect' normally returns a list with info on amount of space in use,
5357 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS) 5400where each entry has the form (NAME SIZE USED FREE), where:
5358 (USED-MISCS . FREE-MISCS) USED-STRING-CHARS USED-VECTOR-SLOTS 5401- NAME is a symbol describing the kind of objects this entry represents,
5359 (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS) 5402- SIZE is the number of bytes used by each one,
5360 (USED-STRINGS . FREE-STRINGS)) 5403- USED is the number of those objects that were found live in the heap,
5404- FREE is the number of those objects that are not live but that Emacs
5405 keeps around for future allocations (maybe because it does not know how
5406 to return them to the OS).
5361However, if there was overflow in pure space, `garbage-collect' 5407However, if there was overflow in pure space, `garbage-collect'
5362returns nil, because real GC can't be done. 5408returns nil, because real GC can't be done.
5363See Info node `(elisp)Garbage Collection'. */) 5409See Info node `(elisp)Garbage Collection'. */)
5364 (void) 5410 (void)
5365{ 5411{
5366 register struct specbinding *bind; 5412 register struct specbinding *bind;
5413 register struct buffer *nextb;
5367 char stack_top_variable; 5414 char stack_top_variable;
5368 ptrdiff_t i; 5415 ptrdiff_t i;
5369 int message_p; 5416 int message_p;
5370 Lisp_Object total[8]; 5417 Lisp_Object total[11];
5371 ptrdiff_t count = SPECPDL_INDEX (); 5418 ptrdiff_t count = SPECPDL_INDEX ();
5372 EMACS_TIME t1, t2, t3; 5419 EMACS_TIME t1;
5373 5420
5374 if (abort_on_gc) 5421 if (abort_on_gc)
5375 abort (); 5422 abort ();
@@ -5383,41 +5430,10 @@ See Info node `(elisp)Garbage Collection'. */)
5383 5430
5384 /* Don't keep undo information around forever. 5431 /* Don't keep undo information around forever.
5385 Do this early on, so it is no problem if the user quits. */ 5432 Do this early on, so it is no problem if the user quits. */
5386 { 5433 FOR_EACH_BUFFER (nextb)
5387 register struct buffer *nextb = all_buffers; 5434 compact_buffer (nextb);
5388 5435
5389 while (nextb) 5436 t1 = current_emacs_time ();
5390 {
5391 /* If a buffer's undo list is Qt, that means that undo is
5392 turned off in that buffer. Calling truncate_undo_list on
5393 Qt tends to return NULL, which effectively turns undo back on.
5394 So don't call truncate_undo_list if undo_list is Qt. */
5395 if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
5396 truncate_undo_list (nextb);
5397
5398 /* Shrink buffer gaps, but skip indirect and dead buffers. */
5399 if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
5400 && ! nextb->text->inhibit_shrinking)
5401 {
5402 /* If a buffer's gap size is more than 10% of the buffer
5403 size, or larger than 2000 bytes, then shrink it
5404 accordingly. Keep a minimum size of 20 bytes. */
5405 int size = min (2000, max (20, (nextb->text->z_byte / 10)));
5406
5407 if (nextb->text->gap_size > size)
5408 {
5409 struct buffer *save_current = current_buffer;
5410 current_buffer = nextb;
5411 make_gap (-(nextb->text->gap_size - size));
5412 current_buffer = save_current;
5413 }
5414 }
5415
5416 nextb = nextb->header.next.buffer;
5417 }
5418 }
5419
5420 EMACS_GET_TIME (t1);
5421 5437
5422 /* In case user calls debug_print during GC, 5438 /* In case user calls debug_print during GC,
5423 don't let that cause a recursive GC. */ 5439 don't let that cause a recursive GC. */
@@ -5447,7 +5463,7 @@ See Info node `(elisp)Garbage Collection'. */)
5447 { 5463 {
5448 if (stack_copy_size < stack_size) 5464 if (stack_copy_size < stack_size)
5449 { 5465 {
5450 stack_copy = (char *) xrealloc (stack_copy, stack_size); 5466 stack_copy = xrealloc (stack_copy, stack_size);
5451 stack_copy_size = stack_size; 5467 stack_copy_size = stack_size;
5452 } 5468 }
5453 memcpy (stack_copy, stack, stack_size); 5469 memcpy (stack_copy, stack, stack_size);
@@ -5464,8 +5480,6 @@ See Info node `(elisp)Garbage Collection'. */)
5464 5480
5465 gc_in_progress = 1; 5481 gc_in_progress = 1;
5466 5482
5467 /* clear_marks (); */
5468
5469 /* Mark all the special slots that serve as the roots of accessibility. */ 5483 /* Mark all the special slots that serve as the roots of accessibility. */
5470 5484
5471 for (i = 0; i < staticidx; i++) 5485 for (i = 0; i < staticidx; i++)
@@ -5529,48 +5543,42 @@ See Info node `(elisp)Garbage Collection'. */)
5529 Look thru every buffer's undo list 5543 Look thru every buffer's undo list
5530 for elements that update markers that were not marked, 5544 for elements that update markers that were not marked,
5531 and delete them. */ 5545 and delete them. */
5532 { 5546 FOR_EACH_BUFFER (nextb)
5533 register struct buffer *nextb = all_buffers; 5547 {
5534 5548 /* If a buffer's undo list is Qt, that means that undo is
5535 while (nextb) 5549 turned off in that buffer. Calling truncate_undo_list on
5536 { 5550 Qt tends to return NULL, which effectively turns undo back on.
5537 /* If a buffer's undo list is Qt, that means that undo is 5551 So don't call truncate_undo_list if undo_list is Qt. */
5538 turned off in that buffer. Calling truncate_undo_list on 5552 if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
5539 Qt tends to return NULL, which effectively turns undo back on. 5553 {
5540 So don't call truncate_undo_list if undo_list is Qt. */ 5554 Lisp_Object tail, prev;
5541 if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) 5555 tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
5542 { 5556 prev = Qnil;
5543 Lisp_Object tail, prev; 5557 while (CONSP (tail))
5544 tail = nextb->BUFFER_INTERNAL_FIELD (undo_list); 5558 {
5545 prev = Qnil; 5559 if (CONSP (XCAR (tail))
5546 while (CONSP (tail)) 5560 && MARKERP (XCAR (XCAR (tail)))
5547 { 5561 && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
5548 if (CONSP (XCAR (tail)) 5562 {
5549 && MARKERP (XCAR (XCAR (tail))) 5563 if (NILP (prev))
5550 && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) 5564 nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
5551 { 5565 else
5552 if (NILP (prev)) 5566 {
5553 nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail); 5567 tail = XCDR (tail);
5554 else 5568 XSETCDR (prev, tail);
5555 { 5569 }
5556 tail = XCDR (tail); 5570 }
5557 XSETCDR (prev, tail); 5571 else
5558 } 5572 {
5559 } 5573 prev = tail;
5560 else 5574 tail = XCDR (tail);
5561 { 5575 }
5562 prev = tail; 5576 }
5563 tail = XCDR (tail); 5577 }
5564 } 5578 /* Now that we have stripped the elements that need not be in the
5565 } 5579 undo_list any more, we can finally mark the list. */
5566 } 5580 mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
5567 /* Now that we have stripped the elements that need not be in the 5581 }
5568 undo_list any more, we can finally mark the list. */
5569 mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
5570
5571 nextb = nextb->header.next.buffer;
5572 }
5573 }
5574 5582
5575 gc_sweep (); 5583 gc_sweep ();
5576 5584
@@ -5588,12 +5596,11 @@ See Info node `(elisp)Garbage Collection'. */)
5588 5596
5589 CHECK_CONS_LIST (); 5597 CHECK_CONS_LIST ();
5590 5598
5591 /* clear_marks (); */
5592 gc_in_progress = 0; 5599 gc_in_progress = 0;
5593 5600
5594 consing_since_gc = 0; 5601 consing_since_gc = 0;
5595 if (gc_cons_threshold < 10000) 5602 if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
5596 gc_cons_threshold = 10000; 5603 gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10;
5597 5604
5598 gc_relative_threshold = 0; 5605 gc_relative_threshold = 0;
5599 if (FLOATP (Vgc_cons_percentage)) 5606 if (FLOATP (Vgc_cons_percentage))
@@ -5603,8 +5610,8 @@ See Info node `(elisp)Garbage Collection'. */)
5603 tot += total_conses * sizeof (struct Lisp_Cons); 5610 tot += total_conses * sizeof (struct Lisp_Cons);
5604 tot += total_symbols * sizeof (struct Lisp_Symbol); 5611 tot += total_symbols * sizeof (struct Lisp_Symbol);
5605 tot += total_markers * sizeof (union Lisp_Misc); 5612 tot += total_markers * sizeof (union Lisp_Misc);
5606 tot += total_string_size; 5613 tot += total_string_bytes;
5607 tot += total_vector_size * sizeof (Lisp_Object); 5614 tot += total_vector_slots * word_size;
5608 tot += total_floats * sizeof (struct Lisp_Float); 5615 tot += total_floats * sizeof (struct Lisp_Float);
5609 tot += total_intervals * sizeof (struct interval); 5616 tot += total_intervals * sizeof (struct interval);
5610 tot += total_strings * sizeof (struct Lisp_String); 5617 tot += total_strings * sizeof (struct Lisp_String);
@@ -5629,20 +5636,51 @@ See Info node `(elisp)Garbage Collection'. */)
5629 5636
5630 unbind_to (count, Qnil); 5637 unbind_to (count, Qnil);
5631 5638
5632 total[0] = Fcons (make_number (total_conses), 5639 total[0] = list4 (Qcons, make_number (sizeof (struct Lisp_Cons)),
5633 make_number (total_free_conses)); 5640 bounded_number (total_conses),
5634 total[1] = Fcons (make_number (total_symbols), 5641 bounded_number (total_free_conses));
5635 make_number (total_free_symbols)); 5642
5636 total[2] = Fcons (make_number (total_markers), 5643 total[1] = list4 (Qsymbol, make_number (sizeof (struct Lisp_Symbol)),
5637 make_number (total_free_markers)); 5644 bounded_number (total_symbols),
5638 total[3] = make_number (total_string_size); 5645 bounded_number (total_free_symbols));
5639 total[4] = make_number (total_vector_size); 5646
5640 total[5] = Fcons (make_number (total_floats), 5647 total[2] = list4 (Qmisc, make_number (sizeof (union Lisp_Misc)),
5641 make_number (total_free_floats)); 5648 bounded_number (total_markers),
5642 total[6] = Fcons (make_number (total_intervals), 5649 bounded_number (total_free_markers));
5643 make_number (total_free_intervals)); 5650
5644 total[7] = Fcons (make_number (total_strings), 5651 total[3] = list4 (Qstring, make_number (sizeof (struct Lisp_String)),
5645 make_number (total_free_strings)); 5652 bounded_number (total_strings),
5653 bounded_number (total_free_strings));
5654
5655 total[4] = list3 (Qstring_bytes, make_number (1),
5656 bounded_number (total_string_bytes));
5657
5658 total[5] = list3 (Qvector, make_number (sizeof (struct Lisp_Vector)),
5659 bounded_number (total_vectors));
5660
5661 total[6] = list4 (Qvector_slots, make_number (word_size),
5662 bounded_number (total_vector_slots),
5663 bounded_number (total_free_vector_slots));
5664
5665 total[7] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)),
5666 bounded_number (total_floats),
5667 bounded_number (total_free_floats));
5668
5669 total[8] = list4 (Qinterval, make_number (sizeof (struct interval)),
5670 bounded_number (total_intervals),
5671 bounded_number (total_free_intervals));
5672
5673 total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)),
5674 bounded_number (total_buffers));
5675
5676 total[10] = list4 (Qheap, make_number (1024),
5677#ifdef DOUG_LEA_MALLOC
5678 bounded_number ((mallinfo ().uordblks + 1023) >> 10),
5679 bounded_number ((mallinfo ().fordblks + 1023) >> 10)
5680#else
5681 Qnil, Qnil
5682#endif
5683 );
5646 5684
5647#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES 5685#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
5648 { 5686 {
@@ -5669,12 +5707,14 @@ See Info node `(elisp)Garbage Collection'. */)
5669 } 5707 }
5670 5708
5671 /* Accumulate statistics. */ 5709 /* Accumulate statistics. */
5672 EMACS_GET_TIME (t2);
5673 EMACS_SUB_TIME (t3, t2, t1);
5674 if (FLOATP (Vgc_elapsed)) 5710 if (FLOATP (Vgc_elapsed))
5675 Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) + 5711 {
5676 EMACS_SECS (t3) + 5712 EMACS_TIME t2 = current_emacs_time ();
5677 EMACS_USECS (t3) * 1.0e-6); 5713 EMACS_TIME t3 = sub_emacs_time (t2, t1);
5714 Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
5715 + EMACS_TIME_TO_DOUBLE (t3));
5716 }
5717
5678 gcs_done++; 5718 gcs_done++;
5679 5719
5680 return Flist (sizeof total / sizeof *total, total); 5720 return Flist (sizeof total / sizeof *total, total);
@@ -5752,15 +5792,15 @@ mark_vectorlike (struct Lisp_Vector *ptr)
5752 ptrdiff_t i; 5792 ptrdiff_t i;
5753 5793
5754 eassert (!VECTOR_MARKED_P (ptr)); 5794 eassert (!VECTOR_MARKED_P (ptr));
5755 VECTOR_MARK (ptr); /* Else mark it */ 5795 VECTOR_MARK (ptr); /* Else mark it. */
5756 if (size & PSEUDOVECTOR_FLAG) 5796 if (size & PSEUDOVECTOR_FLAG)
5757 size &= PSEUDOVECTOR_SIZE_MASK; 5797 size &= PSEUDOVECTOR_SIZE_MASK;
5758 5798
5759 /* Note that this size is not the memory-footprint size, but only 5799 /* Note that this size is not the memory-footprint size, but only
5760 the number of Lisp_Object fields that we should trace. 5800 the number of Lisp_Object fields that we should trace.
5761 The distinction is used e.g. by Lisp_Process which places extra 5801 The distinction is used e.g. by Lisp_Process which places extra
5762 non-Lisp_Object fields at the end of the structure. */ 5802 non-Lisp_Object fields at the end of the structure... */
5763 for (i = 0; i < size; i++) /* and then mark its elements */ 5803 for (i = 0; i < size; i++) /* ...and then mark its elements. */
5764 mark_object (ptr->contents[i]); 5804 mark_object (ptr->contents[i]);
5765} 5805}
5766 5806
@@ -5792,6 +5832,46 @@ mark_char_table (struct Lisp_Vector *ptr)
5792 } 5832 }
5793} 5833}
5794 5834
5835/* Mark the chain of overlays starting at PTR. */
5836
5837static void
5838mark_overlay (struct Lisp_Overlay *ptr)
5839{
5840 for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
5841 {
5842 ptr->gcmarkbit = 1;
5843 mark_object (ptr->start);
5844 mark_object (ptr->end);
5845 mark_object (ptr->plist);
5846 }
5847}
5848
5849/* Mark Lisp_Objects and special pointers in BUFFER. */
5850
5851static void
5852mark_buffer (struct buffer *buffer)
5853{
5854 /* This is handled much like other pseudovectors... */
5855 mark_vectorlike ((struct Lisp_Vector *) buffer);
5856
5857 /* ...but there are some buffer-specific things. */
5858
5859 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
5860
5861 /* For now, we just don't mark the undo_list. It's done later in
5862 a special way just before the sweep phase, and after stripping
5863 some of its elements that are not needed any more. */
5864
5865 mark_overlay (buffer->overlays_before);
5866 mark_overlay (buffer->overlays_after);
5867
5868 /* If this is an indirect buffer, mark its base buffer. */
5869 if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
5870 mark_buffer (buffer->base_buffer);
5871}
5872
5873/* Determine type of generic Lisp_Object and mark it accordingly. */
5874
5795void 5875void
5796mark_object (Lisp_Object arg) 5876mark_object (Lisp_Object arg)
5797{ 5877{
@@ -5857,99 +5937,133 @@ mark_object (Lisp_Object arg)
5857 if (STRING_MARKED_P (ptr)) 5937 if (STRING_MARKED_P (ptr))
5858 break; 5938 break;
5859 CHECK_ALLOCATED_AND_LIVE (live_string_p); 5939 CHECK_ALLOCATED_AND_LIVE (live_string_p);
5860 MARK_INTERVAL_TREE (ptr->intervals);
5861 MARK_STRING (ptr); 5940 MARK_STRING (ptr);
5941 MARK_INTERVAL_TREE (ptr->intervals);
5862#ifdef GC_CHECK_STRING_BYTES 5942#ifdef GC_CHECK_STRING_BYTES
5863 /* Check that the string size recorded in the string is the 5943 /* Check that the string size recorded in the string is the
5864 same as the one recorded in the sdata structure. */ 5944 same as the one recorded in the sdata structure. */
5865 CHECK_STRING_BYTES (ptr); 5945 CHECK_STRING_BYTES (ptr);
5866#endif /* GC_CHECK_STRING_BYTES */ 5946#endif /* GC_CHECK_STRING_BYTES */
5867 } 5947 }
5868 break; 5948 break;
5869 5949
5870 case Lisp_Vectorlike: 5950 case Lisp_Vectorlike:
5871 if (VECTOR_MARKED_P (XVECTOR (obj))) 5951 {
5872 break; 5952 register struct Lisp_Vector *ptr = XVECTOR (obj);
5953 register ptrdiff_t pvectype;
5954
5955 if (VECTOR_MARKED_P (ptr))
5956 break;
5957
5873#ifdef GC_CHECK_MARKED_OBJECTS 5958#ifdef GC_CHECK_MARKED_OBJECTS
5874 m = mem_find (po); 5959 m = mem_find (po);
5875 if (m == MEM_NIL && !SUBRP (obj) 5960 if (m == MEM_NIL && !SUBRP (obj)
5876 && po != &buffer_defaults 5961 && po != &buffer_defaults
5877 && po != &buffer_local_symbols) 5962 && po != &buffer_local_symbols)
5878 abort (); 5963 abort ();
5879#endif /* GC_CHECK_MARKED_OBJECTS */ 5964#endif /* GC_CHECK_MARKED_OBJECTS */
5880 5965
5881 if (BUFFERP (obj)) 5966 if (ptr->header.size & PSEUDOVECTOR_FLAG)
5882 { 5967 pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
5968 >> PSEUDOVECTOR_SIZE_BITS);
5969 else
5970 pvectype = 0;
5971
5972 if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER)
5973 CHECK_LIVE (live_vector_p);
5974
5975 switch (pvectype)
5976 {
5977 case PVEC_BUFFER:
5883#ifdef GC_CHECK_MARKED_OBJECTS 5978#ifdef GC_CHECK_MARKED_OBJECTS
5884 if (po != &buffer_defaults && po != &buffer_local_symbols) 5979 if (po != &buffer_defaults && po != &buffer_local_symbols)
5980 {
5981 struct buffer *b;
5982 FOR_EACH_BUFFER (b)
5983 if (b == po)
5984 break;
5985 if (b == NULL)
5986 abort ();
5987 }
5988#endif /* GC_CHECK_MARKED_OBJECTS */
5989 mark_buffer ((struct buffer *) ptr);
5990 break;
5991
5992 case PVEC_COMPILED:
5993 { /* We could treat this just like a vector, but it is better
5994 to save the COMPILED_CONSTANTS element for last and avoid
5995 recursion there. */
5996 int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
5997 int i;
5998
5999 VECTOR_MARK (ptr);
6000 for (i = 0; i < size; i++)
6001 if (i != COMPILED_CONSTANTS)
6002 mark_object (ptr->contents[i]);
6003 if (size > COMPILED_CONSTANTS)
6004 {
6005 obj = ptr->contents[COMPILED_CONSTANTS];
6006 goto loop;
6007 }
6008 }
6009 break;
6010
6011 case PVEC_FRAME:
5885 { 6012 {
5886 struct buffer *b; 6013 mark_vectorlike (ptr);
5887 for (b = all_buffers; b && b != po; b = b->header.next.buffer) 6014 mark_face_cache (((struct frame *) ptr)->face_cache);
5888 ;
5889 if (b == NULL)
5890 abort ();
5891 } 6015 }
5892#endif /* GC_CHECK_MARKED_OBJECTS */ 6016 break;
5893 mark_buffer (obj);
5894 }
5895 else if (SUBRP (obj))
5896 break;
5897 else if (COMPILEDP (obj))
5898 /* We could treat this just like a vector, but it is better to
5899 save the COMPILED_CONSTANTS element for last and avoid
5900 recursion there. */
5901 {
5902 register struct Lisp_Vector *ptr = XVECTOR (obj);
5903 int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
5904 int i;
5905 6017
5906 CHECK_LIVE (live_vector_p); 6018 case PVEC_WINDOW:
5907 VECTOR_MARK (ptr); /* Else mark it */
5908 for (i = 0; i < size; i++) /* and then mark its elements */
5909 { 6019 {
5910 if (i != COMPILED_CONSTANTS) 6020 struct window *w = (struct window *) ptr;
5911 mark_object (ptr->contents[i]); 6021
6022 mark_vectorlike (ptr);
6023 /* Mark glyphs for leaf windows. Marking window
6024 matrices is sufficient because frame matrices
6025 use the same glyph memory. */
6026 if (NILP (w->hchild) && NILP (w->vchild) && w->current_matrix)
6027 {
6028 mark_glyph_matrix (w->current_matrix);
6029 mark_glyph_matrix (w->desired_matrix);
6030 }
5912 } 6031 }
5913 obj = ptr->contents[COMPILED_CONSTANTS]; 6032 break;
5914 goto loop; 6033
5915 } 6034 case PVEC_HASH_TABLE:
5916 else if (FRAMEP (obj))
5917 {
5918 register struct frame *ptr = XFRAME (obj);
5919 mark_vectorlike (XVECTOR (obj));
5920 mark_face_cache (ptr->face_cache);
5921 }
5922 else if (WINDOWP (obj))
5923 {
5924 register struct Lisp_Vector *ptr = XVECTOR (obj);
5925 struct window *w = XWINDOW (obj);
5926 mark_vectorlike (ptr);
5927 /* Mark glyphs for leaf windows. Marking window matrices is
5928 sufficient because frame matrices use the same glyph
5929 memory. */
5930 if (NILP (w->hchild)
5931 && NILP (w->vchild)
5932 && w->current_matrix)
5933 { 6035 {
5934 mark_glyph_matrix (w->current_matrix); 6036 struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
5935 mark_glyph_matrix (w->desired_matrix); 6037
6038 mark_vectorlike (ptr);
6039 /* If hash table is not weak, mark all keys and values.
6040 For weak tables, mark only the vector. */
6041 if (NILP (h->weak))
6042 mark_object (h->key_and_value);
6043 else
6044 VECTOR_MARK (XVECTOR (h->key_and_value));
5936 } 6045 }
5937 } 6046 break;
5938 else if (HASH_TABLE_P (obj)) 6047
5939 { 6048 case PVEC_CHAR_TABLE:
5940 struct Lisp_Hash_Table *h = XHASH_TABLE (obj); 6049 mark_char_table (ptr);
5941 mark_vectorlike ((struct Lisp_Vector *)h); 6050 break;
5942 /* If hash table is not weak, mark all keys and values. 6051
5943 For weak tables, mark only the vector. */ 6052 case PVEC_BOOL_VECTOR:
5944 if (NILP (h->weak)) 6053 /* No Lisp_Objects to mark in a bool vector. */
5945 mark_object (h->key_and_value); 6054 VECTOR_MARK (ptr);
5946 else 6055 break;
5947 VECTOR_MARK (XVECTOR (h->key_and_value)); 6056
5948 } 6057 case PVEC_SUBR:
5949 else if (CHAR_TABLE_P (obj)) 6058 break;
5950 mark_char_table (XVECTOR (obj)); 6059
5951 else 6060 case PVEC_FREE:
5952 mark_vectorlike (XVECTOR (obj)); 6061 abort ();
6062
6063 default:
6064 mark_vectorlike (ptr);
6065 }
6066 }
5953 break; 6067 break;
5954 6068
5955 case Lisp_Symbol: 6069 case Lisp_Symbol:
@@ -6000,7 +6114,7 @@ mark_object (Lisp_Object arg)
6000 ptr = ptr->next; 6114 ptr = ptr->next;
6001 if (ptr) 6115 if (ptr)
6002 { 6116 {
6003 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */ 6117 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun. */
6004 XSETSYMBOL (obj, ptrx); 6118 XSETSYMBOL (obj, ptrx);
6005 goto loop; 6119 goto loop;
6006 } 6120 }
@@ -6009,20 +6123,21 @@ mark_object (Lisp_Object arg)
6009 6123
6010 case Lisp_Misc: 6124 case Lisp_Misc:
6011 CHECK_ALLOCATED_AND_LIVE (live_misc_p); 6125 CHECK_ALLOCATED_AND_LIVE (live_misc_p);
6126
6012 if (XMISCANY (obj)->gcmarkbit) 6127 if (XMISCANY (obj)->gcmarkbit)
6013 break; 6128 break;
6014 XMISCANY (obj)->gcmarkbit = 1;
6015 6129
6016 switch (XMISCTYPE (obj)) 6130 switch (XMISCTYPE (obj))
6017 { 6131 {
6018
6019 case Lisp_Misc_Marker: 6132 case Lisp_Misc_Marker:
6020 /* DO NOT mark thru the marker's chain. 6133 /* DO NOT mark thru the marker's chain.
6021 The buffer's markers chain does not preserve markers from gc; 6134 The buffer's markers chain does not preserve markers from gc;
6022 instead, markers are removed from the chain when freed by gc. */ 6135 instead, markers are removed from the chain when freed by gc. */
6136 XMISCANY (obj)->gcmarkbit = 1;
6023 break; 6137 break;
6024 6138
6025 case Lisp_Misc_Save_Value: 6139 case Lisp_Misc_Save_Value:
6140 XMISCANY (obj)->gcmarkbit = 1;
6026#if GC_MARK_STACK 6141#if GC_MARK_STACK
6027 { 6142 {
6028 register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); 6143 register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
@@ -6040,17 +6155,7 @@ mark_object (Lisp_Object arg)
6040 break; 6155 break;
6041 6156
6042 case Lisp_Misc_Overlay: 6157 case Lisp_Misc_Overlay:
6043 { 6158 mark_overlay (XOVERLAY (obj));
6044 struct Lisp_Overlay *ptr = XOVERLAY (obj);
6045 mark_object (ptr->start);
6046 mark_object (ptr->end);
6047 mark_object (ptr->plist);
6048 if (ptr->next)
6049 {
6050 XSETMISC (obj, ptr->next);
6051 goto loop;
6052 }
6053 }
6054 break; 6159 break;
6055 6160
6056 default: 6161 default:
@@ -6096,52 +6201,6 @@ mark_object (Lisp_Object arg)
6096#undef CHECK_ALLOCATED 6201#undef CHECK_ALLOCATED
6097#undef CHECK_ALLOCATED_AND_LIVE 6202#undef CHECK_ALLOCATED_AND_LIVE
6098} 6203}
6099
6100/* Mark the pointers in a buffer structure. */
6101
6102static void
6103mark_buffer (Lisp_Object buf)
6104{
6105 register struct buffer *buffer = XBUFFER (buf);
6106 register Lisp_Object *ptr, tmp;
6107 Lisp_Object base_buffer;
6108
6109 eassert (!VECTOR_MARKED_P (buffer));
6110 VECTOR_MARK (buffer);
6111
6112 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
6113
6114 /* For now, we just don't mark the undo_list. It's done later in
6115 a special way just before the sweep phase, and after stripping
6116 some of its elements that are not needed any more. */
6117
6118 if (buffer->overlays_before)
6119 {
6120 XSETMISC (tmp, buffer->overlays_before);
6121 mark_object (tmp);
6122 }
6123 if (buffer->overlays_after)
6124 {
6125 XSETMISC (tmp, buffer->overlays_after);
6126 mark_object (tmp);
6127 }
6128
6129 /* buffer-local Lisp variables start at `undo_list',
6130 tho only the ones from `name' on are GC'd normally. */
6131 for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
6132 ptr <= &PER_BUFFER_VALUE (buffer,
6133 PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER));
6134 ptr++)
6135 mark_object (*ptr);
6136
6137 /* If this is an indirect buffer, mark its base buffer. */
6138 if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
6139 {
6140 XSETBUFFER (base_buffer, buffer->base_buffer);
6141 mark_buffer (base_buffer);
6142 }
6143}
6144
6145/* Mark the Lisp pointers in the terminal objects. 6204/* Mark the Lisp pointers in the terminal objects.
6146 Called by Fgarbage_collect. */ 6205 Called by Fgarbage_collect. */
6147 6206
@@ -6523,6 +6582,7 @@ gc_sweep (void)
6523 { 6582 {
6524 register struct buffer *buffer = all_buffers, *prev = 0, *next; 6583 register struct buffer *buffer = all_buffers, *prev = 0, *next;
6525 6584
6585 total_buffers = 0;
6526 while (buffer) 6586 while (buffer)
6527 if (!VECTOR_MARKED_P (buffer)) 6587 if (!VECTOR_MARKED_P (buffer))
6528 { 6588 {
@@ -6538,6 +6598,7 @@ gc_sweep (void)
6538 { 6598 {
6539 VECTOR_UNMARK (buffer); 6599 VECTOR_UNMARK (buffer);
6540 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); 6600 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
6601 total_buffers++;
6541 prev = buffer, buffer = buffer->header.next.buffer; 6602 prev = buffer, buffer = buffer->header.next.buffer;
6542 } 6603 }
6543 } 6604 }
@@ -6585,14 +6646,14 @@ Frames, windows, buffers, and subprocesses count as vectors
6585{ 6646{
6586 Lisp_Object consed[8]; 6647 Lisp_Object consed[8];
6587 6648
6588 consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed)); 6649 consed[0] = bounded_number (cons_cells_consed);
6589 consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed)); 6650 consed[1] = bounded_number (floats_consed);
6590 consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed)); 6651 consed[2] = bounded_number (vector_cells_consed);
6591 consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed)); 6652 consed[3] = bounded_number (symbols_consed);
6592 consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed)); 6653 consed[4] = bounded_number (string_chars_consed);
6593 consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed)); 6654 consed[5] = bounded_number (misc_objects_consed);
6594 consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed)); 6655 consed[6] = bounded_number (intervals_consed);
6595 consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed)); 6656 consed[7] = bounded_number (strings_consed);
6596 6657
6597 return Flist (8, consed); 6658 return Flist (8, consed);
6598} 6659}
@@ -6667,32 +6728,19 @@ init_alloc_once (void)
6667 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ 6728 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
6668 purebeg = PUREBEG; 6729 purebeg = PUREBEG;
6669 pure_size = PURESIZE; 6730 pure_size = PURESIZE;
6670 pure_bytes_used = 0;
6671 pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
6672 pure_bytes_used_before_overflow = 0;
6673
6674 /* Initialize the list of free aligned blocks. */
6675 free_ablock = NULL;
6676 6731
6677#if GC_MARK_STACK || defined GC_MALLOC_CHECK 6732#if GC_MARK_STACK || defined GC_MALLOC_CHECK
6678 mem_init (); 6733 mem_init ();
6679 Vdead = make_pure_string ("DEAD", 4, 4, 0); 6734 Vdead = make_pure_string ("DEAD", 4, 4, 0);
6680#endif 6735#endif
6681 6736
6682 ignore_warnings = 1;
6683#ifdef DOUG_LEA_MALLOC 6737#ifdef DOUG_LEA_MALLOC
6684 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ 6738 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
6685 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */ 6739 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
6686 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */ 6740 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
6687#endif 6741#endif
6688 init_strings (); 6742 init_strings ();
6689 init_cons ();
6690 init_symbol ();
6691 init_marker ();
6692 init_float ();
6693 init_intervals ();
6694 init_vectors (); 6743 init_vectors ();
6695 init_weak_hash_tables ();
6696 6744
6697#ifdef REL_ALLOC 6745#ifdef REL_ALLOC
6698 malloc_hysteresis = 32; 6746 malloc_hysteresis = 32;
@@ -6701,14 +6749,7 @@ init_alloc_once (void)
6701#endif 6749#endif
6702 6750
6703 refill_memory_reserve (); 6751 refill_memory_reserve ();
6704 6752 gc_cons_threshold = GC_DEFAULT_THRESHOLD;
6705 ignore_warnings = 0;
6706 gcprolist = 0;
6707 byte_stack_list = 0;
6708 staticidx = 0;
6709 consing_since_gc = 0;
6710 gc_cons_threshold = 100000 * sizeof (Lisp_Object);
6711 gc_relative_threshold = 0;
6712} 6753}
6713 6754
6714void 6755void
@@ -6796,12 +6837,16 @@ do hash-consing of the objects allocated to pure space. */);
6796 not be able to allocate the memory to hold it. */ 6837 not be able to allocate the memory to hold it. */
6797 Vmemory_signal_data 6838 Vmemory_signal_data
6798 = pure_cons (Qerror, 6839 = pure_cons (Qerror,
6799 pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); 6840 pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
6800 6841
6801 DEFVAR_LISP ("memory-full", Vmemory_full, 6842 DEFVAR_LISP ("memory-full", Vmemory_full,
6802 doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); 6843 doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
6803 Vmemory_full = Qnil; 6844 Vmemory_full = Qnil;
6804 6845
6846 DEFSYM (Qstring_bytes, "string-bytes");
6847 DEFSYM (Qvector_slots, "vector-slots");
6848 DEFSYM (Qheap, "heap");
6849
6805 DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); 6850 DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
6806 DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); 6851 DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
6807 6852
@@ -6830,3 +6875,29 @@ The time is in seconds as a floating point value. */);
6830 defsubr (&Sgc_status); 6875 defsubr (&Sgc_status);
6831#endif 6876#endif
6832} 6877}
6878
6879/* Make some symbols visible to GDB. These cannot be done as enums, like
6880 GCTYPEBITS or USE_LSB_TAG, since values might not be in 'int' range.
6881 Each symbol X has a corresponding X_VAL symbol, verified to have
6882 the correct value.
6883
6884 This is last, so that the #undef lines don't mess up later code. */
6885
6886#define ARRAY_MARK_FLAG_VAL PTRDIFF_MIN
6887#define PSEUDOVECTOR_FLAG_VAL (PTRDIFF_MAX - PTRDIFF_MAX / 2)
6888#define VALMASK_VAL (USE_LSB_TAG ? -1 << GCTYPEBITS : VAL_MAX)
6889
6890verify (ARRAY_MARK_FLAG_VAL == ARRAY_MARK_FLAG);
6891verify (PSEUDOVECTOR_FLAG_VAL == PSEUDOVECTOR_FLAG);
6892verify (VALMASK_VAL == VALMASK);
6893
6894#undef ARRAY_MARK_FLAG
6895#undef PSEUDOVECTOR_FLAG
6896#undef VALMASK
6897
6898ptrdiff_t const EXTERNALLY_VISIBLE
6899 ARRAY_MARK_FLAG = ARRAY_MARK_FLAG_VAL,
6900 PSEUDOVECTOR_FLAG = PSEUDOVECTOR_FLAG_VAL;
6901
6902EMACS_INT const EXTERNALLY_VISIBLE
6903 VALMASK = VALMASK_VAL;