aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorJoakim Verona2013-07-02 22:46:17 +0200
committerJoakim Verona2013-07-02 22:46:17 +0200
commit3718127221fbbc31f8ebd027ab7c95403dbe9118 (patch)
treeef422898f3344c8f94f6ecf63eb583122bbf2bd8 /src/alloc.c
parent1ce45b902c67b8a0dda8d71bd2812de29a9988a6 (diff)
parenta3b49114c186d84404226af75ae7905bd1cd018f (diff)
downloademacs-3718127221fbbc31f8ebd027ab7c95403dbe9118.tar.gz
emacs-3718127221fbbc31f8ebd027ab7c95403dbe9118.zip
Merge branch 'trunk' into xwidget
Conflicts: src/window.c
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c110
1 files changed, 68 insertions, 42 deletions
diff --git a/src/alloc.c b/src/alloc.c
index cce0fff4fd4..b625e1f27e0 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -363,6 +363,11 @@ static void *pure_alloc (size_t, int);
363 ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \ 363 ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
364 & ~ ((ALIGNMENT) - 1))) 364 & ~ ((ALIGNMENT) - 1)))
365 365
366static void
367XFLOAT_INIT (Lisp_Object f, double n)
368{
369 XFLOAT (f)->u.data = n;
370}
366 371
367 372
368/************************************************************************ 373/************************************************************************
@@ -1255,7 +1260,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
1255 When a Lisp_String is freed during GC, it is put back on 1260 When a Lisp_String is freed during GC, it is put back on
1256 string_free_list, and its `data' member and its sdata's `string' 1261 string_free_list, and its `data' member and its sdata's `string'
1257 pointer is set to null. The size of the string is recorded in the 1262 pointer is set to null. The size of the string is recorded in the
1258 `u.nbytes' member of the sdata. So, sdata structures that are no 1263 `n.nbytes' member of the sdata. So, sdata structures that are no
1259 longer used, can be easily recognized, and it's easy to compact the 1264 longer used, can be easily recognized, and it's easy to compact the
1260 sblocks of small strings which we do in compact_small_strings. */ 1265 sblocks of small strings which we do in compact_small_strings. */
1261 1266
@@ -1269,10 +1274,12 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
1269 1274
1270#define LARGE_STRING_BYTES 1024 1275#define LARGE_STRING_BYTES 1024
1271 1276
1272/* Structure describing string memory sub-allocated from an sblock. 1277/* Struct or union describing string memory sub-allocated from an sblock.
1273 This is where the contents of Lisp strings are stored. */ 1278 This is where the contents of Lisp strings are stored. */
1274 1279
1275struct sdata 1280#ifdef GC_CHECK_STRING_BYTES
1281
1282typedef struct
1276{ 1283{
1277 /* Back-pointer to the string this sdata belongs to. If null, this 1284 /* Back-pointer to the string this sdata belongs to. If null, this
1278 structure is free, and the NBYTES member of the union below 1285 structure is free, and the NBYTES member of the union below
@@ -1282,34 +1289,42 @@ struct sdata
1282 contents. */ 1289 contents. */
1283 struct Lisp_String *string; 1290 struct Lisp_String *string;
1284 1291
1285#ifdef GC_CHECK_STRING_BYTES
1286
1287 ptrdiff_t nbytes; 1292 ptrdiff_t nbytes;
1288 unsigned char data[1]; 1293 unsigned char data[FLEXIBLE_ARRAY_MEMBER];
1294} sdata;
1289 1295
1290#define SDATA_NBYTES(S) (S)->nbytes 1296#define SDATA_NBYTES(S) (S)->nbytes
1291#define SDATA_DATA(S) (S)->data 1297#define SDATA_DATA(S) (S)->data
1292#define SDATA_SELECTOR(member) member 1298#define SDATA_SELECTOR(member) member
1293 1299
1294#else /* not GC_CHECK_STRING_BYTES */ 1300#else
1295 1301
1296 union 1302typedef union
1303{
1304 struct Lisp_String *string;
1305
1306 /* When STRING is non-null. */
1307 struct
1297 { 1308 {
1298 /* When STRING is non-null. */ 1309 struct Lisp_String *string;
1299 unsigned char data[1]; 1310 unsigned char data[FLEXIBLE_ARRAY_MEMBER];
1311 } u;
1300 1312
1301 /* When STRING is null. */ 1313 /* When STRING is null. */
1314 struct
1315 {
1316 struct Lisp_String *string;
1302 ptrdiff_t nbytes; 1317 ptrdiff_t nbytes;
1303 } u; 1318 } n;
1319} sdata;
1304 1320
1305#define SDATA_NBYTES(S) (S)->u.nbytes 1321#define SDATA_NBYTES(S) (S)->n.nbytes
1306#define SDATA_DATA(S) (S)->u.data 1322#define SDATA_DATA(S) (S)->u.data
1307#define SDATA_SELECTOR(member) u.member 1323#define SDATA_SELECTOR(member) u.member
1308 1324
1309#endif /* not GC_CHECK_STRING_BYTES */ 1325#endif /* not GC_CHECK_STRING_BYTES */
1310 1326
1311#define SDATA_DATA_OFFSET offsetof (struct sdata, SDATA_SELECTOR (data)) 1327#define SDATA_DATA_OFFSET offsetof (sdata, SDATA_SELECTOR (data))
1312};
1313 1328
1314 1329
1315/* Structure describing a block of memory which is sub-allocated to 1330/* Structure describing a block of memory which is sub-allocated to
@@ -1324,10 +1339,10 @@ struct sblock
1324 1339
1325 /* Pointer to the next free sdata block. This points past the end 1340 /* Pointer to the next free sdata block. This points past the end
1326 of the sblock if there isn't any space left in this block. */ 1341 of the sblock if there isn't any space left in this block. */
1327 struct sdata *next_free; 1342 sdata *next_free;
1328 1343
1329 /* Start of data. */ 1344 /* Start of data. */
1330 struct sdata first_data; 1345 sdata first_data;
1331}; 1346};
1332 1347
1333/* Number of Lisp strings in a string_block structure. The 1020 is 1348/* Number of Lisp strings in a string_block structure. The 1020 is
@@ -1383,7 +1398,7 @@ static EMACS_INT total_string_bytes;
1383 a pointer to the `u.data' member of its sdata structure; the 1398 a pointer to the `u.data' member of its sdata structure; the
1384 structure starts at a constant offset in front of that. */ 1399 structure starts at a constant offset in front of that. */
1385 1400
1386#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET)) 1401#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET))
1387 1402
1388 1403
1389#ifdef GC_CHECK_STRING_OVERRUN 1404#ifdef GC_CHECK_STRING_OVERRUN
@@ -1482,7 +1497,7 @@ string_bytes (struct Lisp_String *s)
1482static void 1497static void
1483check_sblock (struct sblock *b) 1498check_sblock (struct sblock *b)
1484{ 1499{
1485 struct sdata *from, *end, *from_end; 1500 sdata *from, *end, *from_end;
1486 1501
1487 end = b->next_free; 1502 end = b->next_free;
1488 1503
@@ -1496,7 +1511,7 @@ check_sblock (struct sblock *b)
1496 same as the one recorded in the sdata structure. */ 1511 same as the one recorded in the sdata structure. */
1497 nbytes = SDATA_SIZE (from->string ? string_bytes (from->string) 1512 nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
1498 : SDATA_NBYTES (from)); 1513 : SDATA_NBYTES (from));
1499 from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); 1514 from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
1500 } 1515 }
1501} 1516}
1502 1517
@@ -1626,7 +1641,7 @@ void
1626allocate_string_data (struct Lisp_String *s, 1641allocate_string_data (struct Lisp_String *s,
1627 EMACS_INT nchars, EMACS_INT nbytes) 1642 EMACS_INT nchars, EMACS_INT nbytes)
1628{ 1643{
1629 struct sdata *data, *old_data; 1644 sdata *data, *old_data;
1630 struct sblock *b; 1645 struct sblock *b;
1631 ptrdiff_t needed, old_nbytes; 1646 ptrdiff_t needed, old_nbytes;
1632 1647
@@ -1696,7 +1711,7 @@ allocate_string_data (struct Lisp_String *s,
1696 b = current_sblock; 1711 b = current_sblock;
1697 1712
1698 data = b->next_free; 1713 data = b->next_free;
1699 b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); 1714 b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA);
1700 1715
1701 MALLOC_UNBLOCK_INPUT; 1716 MALLOC_UNBLOCK_INPUT;
1702 1717
@@ -1767,7 +1782,7 @@ sweep_strings (void)
1767 else 1782 else
1768 { 1783 {
1769 /* String is dead. Put it on the free-list. */ 1784 /* String is dead. Put it on the free-list. */
1770 struct sdata *data = SDATA_OF_STRING (s); 1785 sdata *data = SDATA_OF_STRING (s);
1771 1786
1772 /* Save the size of S in its sdata so that we know 1787 /* Save the size of S in its sdata so that we know
1773 how large that is. Reset the sdata's string 1788 how large that is. Reset the sdata's string
@@ -1776,7 +1791,7 @@ sweep_strings (void)
1776 if (string_bytes (s) != SDATA_NBYTES (data)) 1791 if (string_bytes (s) != SDATA_NBYTES (data))
1777 emacs_abort (); 1792 emacs_abort ();
1778#else 1793#else
1779 data->u.nbytes = STRING_BYTES (s); 1794 data->n.nbytes = STRING_BYTES (s);
1780#endif 1795#endif
1781 data->string = NULL; 1796 data->string = NULL;
1782 1797
@@ -1857,13 +1872,13 @@ static void
1857compact_small_strings (void) 1872compact_small_strings (void)
1858{ 1873{
1859 struct sblock *b, *tb, *next; 1874 struct sblock *b, *tb, *next;
1860 struct sdata *from, *to, *end, *tb_end; 1875 sdata *from, *to, *end, *tb_end;
1861 struct sdata *to_end, *from_end; 1876 sdata *to_end, *from_end;
1862 1877
1863 /* TB is the sblock we copy to, TO is the sdata within TB we copy 1878 /* TB is the sblock we copy to, TO is the sdata within TB we copy
1864 to, and TB_END is the end of TB. */ 1879 to, and TB_END is the end of TB. */
1865 tb = oldest_sblock; 1880 tb = oldest_sblock;
1866 tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); 1881 tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
1867 to = &tb->first_data; 1882 to = &tb->first_data;
1868 1883
1869 /* Step through the blocks from the oldest to the youngest. We 1884 /* Step through the blocks from the oldest to the youngest. We
@@ -1892,7 +1907,7 @@ compact_small_strings (void)
1892 eassert (nbytes <= LARGE_STRING_BYTES); 1907 eassert (nbytes <= LARGE_STRING_BYTES);
1893 1908
1894 nbytes = SDATA_SIZE (nbytes); 1909 nbytes = SDATA_SIZE (nbytes);
1895 from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); 1910 from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
1896 1911
1897#ifdef GC_CHECK_STRING_OVERRUN 1912#ifdef GC_CHECK_STRING_OVERRUN
1898 if (memcmp (string_overrun_cookie, 1913 if (memcmp (string_overrun_cookie,
@@ -1905,14 +1920,14 @@ compact_small_strings (void)
1905 if (s) 1920 if (s)
1906 { 1921 {
1907 /* If TB is full, proceed with the next sblock. */ 1922 /* If TB is full, proceed with the next sblock. */
1908 to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); 1923 to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
1909 if (to_end > tb_end) 1924 if (to_end > tb_end)
1910 { 1925 {
1911 tb->next_free = to; 1926 tb->next_free = to;
1912 tb = tb->next; 1927 tb = tb->next;
1913 tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); 1928 tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
1914 to = &tb->first_data; 1929 to = &tb->first_data;
1915 to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); 1930 to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
1916 } 1931 }
1917 1932
1918 /* Copy, and update the string's `data' pointer. */ 1933 /* Copy, and update the string's `data' pointer. */
@@ -2576,7 +2591,7 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
2576 2591
2577/* Size of the minimal vector allocated from block. */ 2592/* Size of the minimal vector allocated from block. */
2578 2593
2579#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector)) 2594#define VBLOCK_BYTES_MIN vroundup (header_size + sizeof (Lisp_Object))
2580 2595
2581/* Size of the largest vector allocated from block. */ 2596/* Size of the largest vector allocated from block. */
2582 2597
@@ -2933,7 +2948,8 @@ allocate_vectorlike (ptrdiff_t len)
2933 else 2948 else
2934 { 2949 {
2935 struct large_vector *lv 2950 struct large_vector *lv
2936 = lisp_malloc (sizeof (*lv) + (len - 1) * word_size, 2951 = lisp_malloc ((offsetof (struct large_vector, v.contents)
2952 + len * word_size),
2937 MEM_TYPE_VECTORLIKE); 2953 MEM_TYPE_VECTORLIKE);
2938 lv->next.vector = large_vectors; 2954 lv->next.vector = large_vectors;
2939 large_vectors = lv; 2955 large_vectors = lv;
@@ -3189,6 +3205,12 @@ static int symbol_block_index = SYMBOL_BLOCK_SIZE;
3189 3205
3190static struct Lisp_Symbol *symbol_free_list; 3206static struct Lisp_Symbol *symbol_free_list;
3191 3207
3208static void
3209set_symbol_name (Lisp_Object sym, Lisp_Object name)
3210{
3211 XSYMBOL (sym)->name = name;
3212}
3213
3192DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3214DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
3193 doc: /* Return a newly allocated uninterned symbol whose name is NAME. 3215 doc: /* Return a newly allocated uninterned symbol whose name is NAME.
3194Its value is void, and its function definition and property list are nil. */) 3216Its value is void, and its function definition and property list are nil. */)
@@ -3309,7 +3331,7 @@ allocate_misc (enum Lisp_Misc_Type type)
3309 --total_free_markers; 3331 --total_free_markers;
3310 consing_since_gc += sizeof (union Lisp_Misc); 3332 consing_since_gc += sizeof (union Lisp_Misc);
3311 misc_objects_consed++; 3333 misc_objects_consed++;
3312 XMISCTYPE (val) = type; 3334 XMISCANY (val)->type = type;
3313 XMISCANY (val)->gcmarkbit = 0; 3335 XMISCANY (val)->gcmarkbit = 0;
3314 return val; 3336 return val;
3315} 3337}
@@ -3319,7 +3341,7 @@ allocate_misc (enum Lisp_Misc_Type type)
3319void 3341void
3320free_misc (Lisp_Object misc) 3342free_misc (Lisp_Object misc)
3321{ 3343{
3322 XMISCTYPE (misc) = Lisp_Misc_Free; 3344 XMISCANY (misc)->type = Lisp_Misc_Free;
3323 XMISC (misc)->u_free.chain = marker_free_list; 3345 XMISC (misc)->u_free.chain = marker_free_list;
3324 marker_free_list = XMISC (misc); 3346 marker_free_list = XMISC (misc);
3325 consing_since_gc -= sizeof (union Lisp_Misc); 3347 consing_since_gc -= sizeof (union Lisp_Misc);
@@ -3330,7 +3352,9 @@ free_misc (Lisp_Object misc)
3330 that are assumed here and elsewhere. */ 3352 that are assumed here and elsewhere. */
3331 3353
3332verify (SAVE_UNUSED == 0); 3354verify (SAVE_UNUSED == 0);
3333verify ((SAVE_INTEGER | SAVE_POINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS == 0); 3355verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
3356 >> SAVE_SLOT_BITS)
3357 == 0);
3334 3358
3335/* Return a Lisp_Save_Value object with the data saved according to 3359/* Return a Lisp_Save_Value object with the data saved according to
3336 DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ 3360 DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
@@ -3357,6 +3381,10 @@ make_save_value (enum Lisp_Save_Type save_type, ...)
3357 p->data[i].pointer = va_arg (ap, void *); 3381 p->data[i].pointer = va_arg (ap, void *);
3358 break; 3382 break;
3359 3383
3384 case SAVE_FUNCPOINTER:
3385 p->data[i].funcpointer = va_arg (ap, voidfuncptr);
3386 break;
3387
3360 case SAVE_INTEGER: 3388 case SAVE_INTEGER:
3361 p->data[i].integer = va_arg (ap, ptrdiff_t); 3389 p->data[i].integer = va_arg (ap, ptrdiff_t);
3362 break; 3390 break;
@@ -5405,7 +5433,8 @@ See Info node `(elisp)Garbage Collection'. */)
5405 total[4] = list3 (Qstring_bytes, make_number (1), 5433 total[4] = list3 (Qstring_bytes, make_number (1),
5406 bounded_number (total_string_bytes)); 5434 bounded_number (total_string_bytes));
5407 5435
5408 total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)), 5436 total[5] = list3 (Qvectors,
5437 make_number (header_size + sizeof (Lisp_Object)),
5409 bounded_number (total_vectors)); 5438 bounded_number (total_vectors));
5410 5439
5411 total[6] = list4 (Qvector_slots, make_number (word_size), 5440 total[6] = list4 (Qvector_slots, make_number (word_size),
@@ -5647,7 +5676,7 @@ mark_discard_killed_buffers (Lisp_Object list)
5647 { 5676 {
5648 CONS_MARK (XCONS (tail)); 5677 CONS_MARK (XCONS (tail));
5649 mark_object (XCAR (tail)); 5678 mark_object (XCAR (tail));
5650 prev = &XCDR_AS_LVALUE (tail); 5679 prev = xcdr_addr (tail);
5651 } 5680 }
5652 } 5681 }
5653 mark_object (tail); 5682 mark_object (tail);
@@ -6504,7 +6533,7 @@ bool suppress_checking;
6504void 6533void
6505die (const char *msg, const char *file, int line) 6534die (const char *msg, const char *file, int line)
6506{ 6535{
6507 fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n", 6536 fprintf (stderr, "\r\n%s:%d: Emacs fatal error: assertion failed: %s\r\n",
6508 file, line, msg); 6537 file, line, msg);
6509 terminate_due_to_signal (SIGABRT, INT_MAX); 6538 terminate_due_to_signal (SIGABRT, INT_MAX);
6510} 6539}
@@ -6689,8 +6718,5 @@ union
6689 enum MAX_ALLOCA MAX_ALLOCA; 6718 enum MAX_ALLOCA MAX_ALLOCA;
6690 enum More_Lisp_Bits More_Lisp_Bits; 6719 enum More_Lisp_Bits More_Lisp_Bits;
6691 enum pvec_type pvec_type; 6720 enum pvec_type pvec_type;
6692#if USE_LSB_TAG
6693 enum lsb_bits lsb_bits;
6694#endif
6695} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; 6721} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
6696#endif /* __GNUC__ */ 6722#endif /* __GNUC__ */