aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorTom Tromey2013-07-06 23:18:58 -0600
committerTom Tromey2013-07-06 23:18:58 -0600
commit6dacdad5fcb278e5a16b38bb81786aac9ca27be4 (patch)
treef5f331ea361ba0f99e0f9b638d183ad492a7da31 /src/alloc.c
parent0a6f2ff0c8ceb29703e76cddd46ea3f176dd873a (diff)
parent219afb88d9d484393418820d1c08dc93299110ec (diff)
downloademacs-6dacdad5fcb278e5a16b38bb81786aac9ca27be4.tar.gz
emacs-6dacdad5fcb278e5a16b38bb81786aac9ca27be4.zip
merge from trunk
this merges frmo trunk and fixes various build issues. this needed a few ugly tweaks. this hangs in "make check" now
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c114
1 files changed, 68 insertions, 46 deletions
diff --git a/src/alloc.c b/src/alloc.c
index d62b671d440..230b3b614d7 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -247,10 +247,6 @@ enum mem_type
247 247
248#if GC_MARK_STACK || defined GC_MALLOC_CHECK 248#if GC_MARK_STACK || defined GC_MALLOC_CHECK
249 249
250#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
251#include <stdio.h> /* For fprintf. */
252#endif
253
254/* A unique object in pure space used to make some Lisp objects 250/* A unique object in pure space used to make some Lisp objects
255 on free lists recognizable in O(1). */ 251 on free lists recognizable in O(1). */
256 252
@@ -355,6 +351,11 @@ static void *pure_alloc (size_t, int);
355 ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ 351 ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
356 & ~ ((ALIGNMENT) - 1))) 352 & ~ ((ALIGNMENT) - 1)))
357 353
354static void
355XFLOAT_INIT (Lisp_Object f, double n)
356{
357 XFLOAT (f)->u.data = n;
358}
358 359
359 360
360/************************************************************************ 361/************************************************************************
@@ -1247,7 +1248,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
1247 When a Lisp_String is freed during GC, it is put back on 1248 When a Lisp_String is freed during GC, it is put back on
1248 string_free_list, and its `data' member and its sdata's `string' 1249 string_free_list, and its `data' member and its sdata's `string'
1249 pointer is set to null. The size of the string is recorded in the 1250 pointer is set to null. The size of the string is recorded in the
1250 `u.nbytes' member of the sdata. So, sdata structures that are no 1251 `n.nbytes' member of the sdata. So, sdata structures that are no
1251 longer used, can be easily recognized, and it's easy to compact the 1252 longer used, can be easily recognized, and it's easy to compact the
1252 sblocks of small strings which we do in compact_small_strings. */ 1253 sblocks of small strings which we do in compact_small_strings. */
1253 1254
@@ -1261,10 +1262,12 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
1261 1262
1262#define LARGE_STRING_BYTES 1024 1263#define LARGE_STRING_BYTES 1024
1263 1264
1264/* Structure describing string memory sub-allocated from an sblock. 1265/* Struct or union describing string memory sub-allocated from an sblock.
1265 This is where the contents of Lisp strings are stored. */ 1266 This is where the contents of Lisp strings are stored. */
1266 1267
1267struct sdata 1268#ifdef GC_CHECK_STRING_BYTES
1269
1270typedef struct
1268{ 1271{
1269 /* Back-pointer to the string this sdata belongs to. If null, this 1272 /* Back-pointer to the string this sdata belongs to. If null, this
1270 structure is free, and the NBYTES member of the union below 1273 structure is free, and the NBYTES member of the union below
@@ -1274,34 +1277,42 @@ struct sdata
1274 contents. */ 1277 contents. */
1275 struct Lisp_String *string; 1278 struct Lisp_String *string;
1276 1279
1277#ifdef GC_CHECK_STRING_BYTES
1278
1279 ptrdiff_t nbytes; 1280 ptrdiff_t nbytes;
1280 unsigned char data[1]; 1281 unsigned char data[FLEXIBLE_ARRAY_MEMBER];
1282} sdata;
1281 1283
1282#define SDATA_NBYTES(S) (S)->nbytes 1284#define SDATA_NBYTES(S) (S)->nbytes
1283#define SDATA_DATA(S) (S)->data 1285#define SDATA_DATA(S) (S)->data
1284#define SDATA_SELECTOR(member) member 1286#define SDATA_SELECTOR(member) member
1285 1287
1286#else /* not GC_CHECK_STRING_BYTES */ 1288#else
1287 1289
1288 union 1290typedef union
1291{
1292 struct Lisp_String *string;
1293
1294 /* When STRING is non-null. */
1295 struct
1289 { 1296 {
1290 /* When STRING is non-null. */ 1297 struct Lisp_String *string;
1291 unsigned char data[1]; 1298 unsigned char data[FLEXIBLE_ARRAY_MEMBER];
1299 } u;
1292 1300
1293 /* When STRING is null. */ 1301 /* When STRING is null. */
1302 struct
1303 {
1304 struct Lisp_String *string;
1294 ptrdiff_t nbytes; 1305 ptrdiff_t nbytes;
1295 } u; 1306 } n;
1307} sdata;
1296 1308
1297#define SDATA_NBYTES(S) (S)->u.nbytes 1309#define SDATA_NBYTES(S) (S)->n.nbytes
1298#define SDATA_DATA(S) (S)->u.data 1310#define SDATA_DATA(S) (S)->u.data
1299#define SDATA_SELECTOR(member) u.member 1311#define SDATA_SELECTOR(member) u.member
1300 1312
1301#endif /* not GC_CHECK_STRING_BYTES */ 1313#endif /* not GC_CHECK_STRING_BYTES */
1302 1314
1303#define SDATA_DATA_OFFSET offsetof (struct sdata, SDATA_SELECTOR (data)) 1315#define SDATA_DATA_OFFSET offsetof (sdata, SDATA_SELECTOR (data))
1304};
1305 1316
1306 1317
1307/* Structure describing a block of memory which is sub-allocated to 1318/* Structure describing a block of memory which is sub-allocated to
@@ -1316,10 +1327,10 @@ struct sblock
1316 1327
1317 /* Pointer to the next free sdata block. This points past the end 1328 /* Pointer to the next free sdata block. This points past the end
1318 of the sblock if there isn't any space left in this block. */ 1329 of the sblock if there isn't any space left in this block. */
1319 struct sdata *next_free; 1330 sdata *next_free;
1320 1331
1321 /* Start of data. */ 1332 /* Start of data. */
1322 struct sdata first_data; 1333 sdata first_data;
1323}; 1334};
1324 1335
1325/* Number of Lisp strings in a string_block structure. The 1020 is 1336/* Number of Lisp strings in a string_block structure. The 1020 is
@@ -1375,7 +1386,7 @@ static EMACS_INT total_string_bytes;
1375 a pointer to the `u.data' member of its sdata structure; the 1386 a pointer to the `u.data' member of its sdata structure; the
1376 structure starts at a constant offset in front of that. */ 1387 structure starts at a constant offset in front of that. */
1377 1388
1378#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET)) 1389#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET))
1379 1390
1380 1391
1381#ifdef GC_CHECK_STRING_OVERRUN 1392#ifdef GC_CHECK_STRING_OVERRUN
@@ -1474,7 +1485,7 @@ string_bytes (struct Lisp_String *s)
1474static void 1485static void
1475check_sblock (struct sblock *b) 1486check_sblock (struct sblock *b)
1476{ 1487{
1477 struct sdata *from, *end, *from_end; 1488 sdata *from, *end, *from_end;
1478 1489
1479 end = b->next_free; 1490 end = b->next_free;
1480 1491
@@ -1488,7 +1499,7 @@ check_sblock (struct sblock *b)
1488 same as the one recorded in the sdata structure. */ 1499 same as the one recorded in the sdata structure. */
1489 nbytes = SDATA_SIZE (from->string ? string_bytes (from->string) 1500 nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
1490 : SDATA_NBYTES (from)); 1501 : SDATA_NBYTES (from));
1491 from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); 1502 from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
1492 } 1503 }
1493} 1504}
1494 1505
@@ -1618,7 +1629,7 @@ void
1618allocate_string_data (struct Lisp_String *s, 1629allocate_string_data (struct Lisp_String *s,
1619 EMACS_INT nchars, EMACS_INT nbytes) 1630 EMACS_INT nchars, EMACS_INT nbytes)
1620{ 1631{
1621 struct sdata *data, *old_data; 1632 sdata *data, *old_data;
1622 struct sblock *b; 1633 struct sblock *b;
1623 ptrdiff_t needed, old_nbytes; 1634 ptrdiff_t needed, old_nbytes;
1624 1635
@@ -1688,7 +1699,7 @@ allocate_string_data (struct Lisp_String *s,
1688 b = current_sblock; 1699 b = current_sblock;
1689 1700
1690 data = b->next_free; 1701 data = b->next_free;
1691 b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); 1702 b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA);
1692 1703
1693 MALLOC_UNBLOCK_INPUT; 1704 MALLOC_UNBLOCK_INPUT;
1694 1705
@@ -1759,7 +1770,7 @@ sweep_strings (void)
1759 else 1770 else
1760 { 1771 {
1761 /* String is dead. Put it on the free-list. */ 1772 /* String is dead. Put it on the free-list. */
1762 struct sdata *data = SDATA_OF_STRING (s); 1773 sdata *data = SDATA_OF_STRING (s);
1763 1774
1764 /* Save the size of S in its sdata so that we know 1775 /* Save the size of S in its sdata so that we know
1765 how large that is. Reset the sdata's string 1776 how large that is. Reset the sdata's string
@@ -1768,7 +1779,7 @@ sweep_strings (void)
1768 if (string_bytes (s) != SDATA_NBYTES (data)) 1779 if (string_bytes (s) != SDATA_NBYTES (data))
1769 emacs_abort (); 1780 emacs_abort ();
1770#else 1781#else
1771 data->u.nbytes = STRING_BYTES (s); 1782 data->n.nbytes = STRING_BYTES (s);
1772#endif 1783#endif
1773 data->string = NULL; 1784 data->string = NULL;
1774 1785
@@ -1849,13 +1860,13 @@ static void
1849compact_small_strings (void) 1860compact_small_strings (void)
1850{ 1861{
1851 struct sblock *b, *tb, *next; 1862 struct sblock *b, *tb, *next;
1852 struct sdata *from, *to, *end, *tb_end; 1863 sdata *from, *to, *end, *tb_end;
1853 struct sdata *to_end, *from_end; 1864 sdata *to_end, *from_end;
1854 1865
1855 /* TB is the sblock we copy to, TO is the sdata within TB we copy 1866 /* TB is the sblock we copy to, TO is the sdata within TB we copy
1856 to, and TB_END is the end of TB. */ 1867 to, and TB_END is the end of TB. */
1857 tb = oldest_sblock; 1868 tb = oldest_sblock;
1858 tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); 1869 tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
1859 to = &tb->first_data; 1870 to = &tb->first_data;
1860 1871
1861 /* Step through the blocks from the oldest to the youngest. We 1872 /* Step through the blocks from the oldest to the youngest. We
@@ -1884,7 +1895,7 @@ compact_small_strings (void)
1884 eassert (nbytes <= LARGE_STRING_BYTES); 1895 eassert (nbytes <= LARGE_STRING_BYTES);
1885 1896
1886 nbytes = SDATA_SIZE (nbytes); 1897 nbytes = SDATA_SIZE (nbytes);
1887 from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); 1898 from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
1888 1899
1889#ifdef GC_CHECK_STRING_OVERRUN 1900#ifdef GC_CHECK_STRING_OVERRUN
1890 if (memcmp (string_overrun_cookie, 1901 if (memcmp (string_overrun_cookie,
@@ -1897,14 +1908,14 @@ compact_small_strings (void)
1897 if (s) 1908 if (s)
1898 { 1909 {
1899 /* If TB is full, proceed with the next sblock. */ 1910 /* If TB is full, proceed with the next sblock. */
1900 to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); 1911 to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
1901 if (to_end > tb_end) 1912 if (to_end > tb_end)
1902 { 1913 {
1903 tb->next_free = to; 1914 tb->next_free = to;
1904 tb = tb->next; 1915 tb = tb->next;
1905 tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); 1916 tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
1906 to = &tb->first_data; 1917 to = &tb->first_data;
1907 to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); 1918 to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
1908 } 1919 }
1909 1920
1910 /* Copy, and update the string's `data' pointer. */ 1921 /* Copy, and update the string's `data' pointer. */
@@ -2568,7 +2579,7 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
2568 2579
2569/* Size of the minimal vector allocated from block. */ 2580/* Size of the minimal vector allocated from block. */
2570 2581
2571#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector)) 2582#define VBLOCK_BYTES_MIN vroundup (header_size + sizeof (Lisp_Object))
2572 2583
2573/* Size of the largest vector allocated from block. */ 2584/* Size of the largest vector allocated from block. */
2574 2585
@@ -2932,7 +2943,8 @@ allocate_vectorlike (ptrdiff_t len)
2932 else 2943 else
2933 { 2944 {
2934 struct large_vector *lv 2945 struct large_vector *lv
2935 = lisp_malloc (sizeof (*lv) + (len - 1) * word_size, 2946 = lisp_malloc ((offsetof (struct large_vector, v.contents)
2947 + len * word_size),
2936 MEM_TYPE_VECTORLIKE); 2948 MEM_TYPE_VECTORLIKE);
2937 lv->next.vector = large_vectors; 2949 lv->next.vector = large_vectors;
2938 large_vectors = lv; 2950 large_vectors = lv;
@@ -3188,6 +3200,12 @@ static int symbol_block_index = SYMBOL_BLOCK_SIZE;
3188 3200
3189static struct Lisp_Symbol *symbol_free_list; 3201static struct Lisp_Symbol *symbol_free_list;
3190 3202
3203static void
3204set_symbol_name (Lisp_Object sym, Lisp_Object name)
3205{
3206 XSYMBOL (sym)->name = name;
3207}
3208
3191DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3209DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
3192 doc: /* Return a newly allocated uninterned symbol whose name is NAME. 3210 doc: /* Return a newly allocated uninterned symbol whose name is NAME.
3193Its value is void, and its function definition and property list are nil. */) 3211Its value is void, and its function definition and property list are nil. */)
@@ -3308,7 +3326,7 @@ allocate_misc (enum Lisp_Misc_Type type)
3308 --total_free_markers; 3326 --total_free_markers;
3309 consing_since_gc += sizeof (union Lisp_Misc); 3327 consing_since_gc += sizeof (union Lisp_Misc);
3310 misc_objects_consed++; 3328 misc_objects_consed++;
3311 XMISCTYPE (val) = type; 3329 XMISCANY (val)->type = type;
3312 XMISCANY (val)->gcmarkbit = 0; 3330 XMISCANY (val)->gcmarkbit = 0;
3313 return val; 3331 return val;
3314} 3332}
@@ -3318,7 +3336,7 @@ allocate_misc (enum Lisp_Misc_Type type)
3318void 3336void
3319free_misc (Lisp_Object misc) 3337free_misc (Lisp_Object misc)
3320{ 3338{
3321 XMISCTYPE (misc) = Lisp_Misc_Free; 3339 XMISCANY (misc)->type = Lisp_Misc_Free;
3322 XMISC (misc)->u_free.chain = marker_free_list; 3340 XMISC (misc)->u_free.chain = marker_free_list;
3323 marker_free_list = XMISC (misc); 3341 marker_free_list = XMISC (misc);
3324 consing_since_gc -= sizeof (union Lisp_Misc); 3342 consing_since_gc -= sizeof (union Lisp_Misc);
@@ -3329,7 +3347,9 @@ free_misc (Lisp_Object misc)
3329 that are assumed here and elsewhere. */ 3347 that are assumed here and elsewhere. */
3330 3348
3331verify (SAVE_UNUSED == 0); 3349verify (SAVE_UNUSED == 0);
3332verify ((SAVE_INTEGER | SAVE_POINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS == 0); 3350verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
3351 >> SAVE_SLOT_BITS)
3352 == 0);
3333 3353
3334/* Return a Lisp_Save_Value object with the data saved according to 3354/* Return a Lisp_Save_Value object with the data saved according to
3335 DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ 3355 DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
@@ -3356,6 +3376,10 @@ make_save_value (enum Lisp_Save_Type save_type, ...)
3356 p->data[i].pointer = va_arg (ap, void *); 3376 p->data[i].pointer = va_arg (ap, void *);
3357 break; 3377 break;
3358 3378
3379 case SAVE_FUNCPOINTER:
3380 p->data[i].funcpointer = va_arg (ap, voidfuncptr);
3381 break;
3382
3359 case SAVE_INTEGER: 3383 case SAVE_INTEGER:
3360 p->data[i].integer = va_arg (ap, ptrdiff_t); 3384 p->data[i].integer = va_arg (ap, ptrdiff_t);
3361 break; 3385 break;
@@ -5387,7 +5411,8 @@ See Info node `(elisp)Garbage Collection'. */)
5387 total[4] = list3 (Qstring_bytes, make_number (1), 5411 total[4] = list3 (Qstring_bytes, make_number (1),
5388 bounded_number (total_string_bytes)); 5412 bounded_number (total_string_bytes));
5389 5413
5390 total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)), 5414 total[5] = list3 (Qvectors,
5415 make_number (header_size + sizeof (Lisp_Object)),
5391 bounded_number (total_vectors)); 5416 bounded_number (total_vectors));
5392 5417
5393 total[6] = list4 (Qvector_slots, make_number (word_size), 5418 total[6] = list4 (Qvector_slots, make_number (word_size),
@@ -5629,7 +5654,7 @@ mark_discard_killed_buffers (Lisp_Object list)
5629 { 5654 {
5630 CONS_MARK (XCONS (tail)); 5655 CONS_MARK (XCONS (tail));
5631 mark_object (XCAR (tail)); 5656 mark_object (XCAR (tail));
5632 prev = &XCDR_AS_LVALUE (tail); 5657 prev = xcdr_addr (tail);
5633 } 5658 }
5634 } 5659 }
5635 mark_object (tail); 5660 mark_object (tail);
@@ -6486,7 +6511,7 @@ bool suppress_checking;
6486void 6511void
6487die (const char *msg, const char *file, int line) 6512die (const char *msg, const char *file, int line)
6488{ 6513{
6489 fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n", 6514 fprintf (stderr, "\r\n%s:%d: Emacs fatal error: assertion failed: %s\r\n",
6490 file, line, msg); 6515 file, line, msg);
6491 terminate_due_to_signal (SIGABRT, INT_MAX); 6516 terminate_due_to_signal (SIGABRT, INT_MAX);
6492} 6517}
@@ -6671,8 +6696,5 @@ union
6671 enum MAX_ALLOCA MAX_ALLOCA; 6696 enum MAX_ALLOCA MAX_ALLOCA;
6672 enum More_Lisp_Bits More_Lisp_Bits; 6697 enum More_Lisp_Bits More_Lisp_Bits;
6673 enum pvec_type pvec_type; 6698 enum pvec_type pvec_type;
6674#if USE_LSB_TAG
6675 enum lsb_bits lsb_bits;
6676#endif
6677} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; 6699} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
6678#endif /* __GNUC__ */ 6700#endif /* __GNUC__ */