aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c49
1 files changed, 34 insertions, 15 deletions
diff --git a/src/alloc.c b/src/alloc.c
index c701abe3a84..63463dbbc7f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -114,6 +114,8 @@ static void mark_object (), mark_buffer ();
114static void clear_marks (), gc_sweep (); 114static void clear_marks (), gc_sweep ();
115static void compact_strings (); 115static void compact_strings ();
116 116
117/* Versions of malloc and realloc that print warnings as memory gets full. */
118
117Lisp_Object 119Lisp_Object
118malloc_warning_1 (str) 120malloc_warning_1 (str)
119 Lisp_Object str; 121 Lisp_Object str;
@@ -179,6 +181,8 @@ xrealloc (block, size)
179 return val; 181 return val;
180} 182}
181 183
184/* Interval allocation. */
185
182#ifdef USE_TEXT_PROPERTIES 186#ifdef USE_TEXT_PROPERTIES
183#define INTERVAL_BLOCK_SIZE \ 187#define INTERVAL_BLOCK_SIZE \
184 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) 188 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
@@ -260,19 +264,22 @@ mark_interval_tree (tree)
260 if (XMARKBIT (tree->plist)) 264 if (XMARKBIT (tree->plist))
261 return; 265 return;
262 266
263 traverse_intervals (tree, 1, 0, &mark_interval); 267 traverse_intervals (tree, 1, 0, mark_interval);
264} 268}
265 269
266#define MARK_INTERVAL_TREE(i) \ 270#define MARK_INTERVAL_TREE(i) \
267 { if (!NULL_INTERVAL_P (i)) mark_interval_tree (i); } 271 { if (!NULL_INTERVAL_P (i)) mark_interval_tree (i); }
268 272
269#define UNMARK_BALANCE_INTERVALS(i) \ 273/* The oddity in the call to XUNMARK is necessary because XUNMARK
270{ \ 274 expands to an assigment to its argument, and most C compilers don't
271 if (! NULL_INTERVAL_P (i)) \ 275 support casts on the left operand of `='. */
272 { \ 276#define UNMARK_BALANCE_INTERVALS(i) \
273 XUNMARK ((Lisp_Object) (i->parent)); \ 277{ \
274 i = balance_intervals (i); \ 278 if (! NULL_INTERVAL_P (i)) \
275 } \ 279 { \
280 XUNMARK (* (Lisp_Object *) (&(i)->parent)); \
281 (i) = balance_intervals (i); \
282 } \
276} 283}
277 284
278#else /* no interval use */ 285#else /* no interval use */
@@ -284,6 +291,8 @@ mark_interval_tree (tree)
284 291
285#endif /* no interval use */ 292#endif /* no interval use */
286 293
294/* Floating point allocation. */
295
287#ifdef LISP_FLOAT_TYPE 296#ifdef LISP_FLOAT_TYPE
288/* Allocation of float cells, just like conses */ 297/* Allocation of float cells, just like conses */
289/* We store float cells inside of float_blocks, allocating a new 298/* We store float cells inside of float_blocks, allocating a new
@@ -883,6 +892,8 @@ make_array (nargs, args)
883 } 892 }
884} 893}
885 894
895/* Allocation of ropes. */
896
886/* Note: the user cannot manipulate ropes portably by referring 897/* Note: the user cannot manipulate ropes portably by referring
887 to the chars of the string, because combining two chars to make a GLYPH 898 to the chars of the string, because combining two chars to make a GLYPH
888 depends on endianness. */ 899 depends on endianness. */
@@ -932,6 +943,8 @@ See variable `buffer-display-table' for the uses of ropes.")
932 return ((GLYPH *) XSTRING (r)->data)[XFASTINT (n)]; 943 return ((GLYPH *) XSTRING (r)->data)[XFASTINT (n)];
933} 944}
934 945
946/* Pure storage management. */
947
935/* Must get an error if pure storage is full, 948/* Must get an error if pure storage is full,
936 since if it cannot hold a large string 949 since if it cannot hold a large string
937 it may be able to hold conses that point to that string; 950 it may be able to hold conses that point to that string;
@@ -979,6 +992,12 @@ make_pure_float (num)
979{ 992{
980 register Lisp_Object new; 993 register Lisp_Object new;
981 994
995 /* Make sure that pureptr is aligned on at least a sizeof (double)
996 boundary. Some architectures (like the sparc) require this, and
997 I suspect that floats are rare enough that it's no tragedy for
998 those that do. */
999 pureptr = (pureptr + sizeof (num) - 1) & - sizeof (num);
1000
982 if (pureptr + sizeof (struct Lisp_Float) > PURESIZE) 1001 if (pureptr + sizeof (struct Lisp_Float) > PURESIZE)
983 error ("Pure Lisp storage exhausted"); 1002 error ("Pure Lisp storage exhausted");
984 XSET (new, Lisp_Float, PUREBEG + pureptr); 1003 XSET (new, Lisp_Float, PUREBEG + pureptr);
@@ -1120,6 +1139,8 @@ struct backtrace
1120you lose 1139you lose
1121#endif 1140#endif
1122 1141
1142/* Garbage collection! */
1143
1123int total_conses, total_markers, total_symbols, total_string_size, total_vector_size; 1144int total_conses, total_markers, total_symbols, total_string_size, total_vector_size;
1124int total_free_conses, total_free_markers, total_free_symbols; 1145int total_free_conses, total_free_markers, total_free_symbols;
1125#ifdef LISP_FLOAT_TYPE 1146#ifdef LISP_FLOAT_TYPE
@@ -1366,8 +1387,9 @@ clear_marks ()
1366} 1387}
1367#endif 1388#endif
1368 1389
1369/* Mark reference to a Lisp_Object. If the object referred to 1390/* Mark reference to a Lisp_Object.
1370 has not been seen yet, recursively mark all the references contained in it. 1391 If the object referred to has not been seen yet, recursively mark
1392 all the references contained in it.
1371 1393
1372 If the object referenced is a short string, the referrencing slot 1394 If the object referenced is a short string, the referrencing slot
1373 is threaded into a chain of such slots, pointed to from 1395 is threaded into a chain of such slots, pointed to from
@@ -1485,7 +1507,6 @@ mark_object (objptr)
1485 { 1507 {
1486 register struct frame *ptr = XFRAME (obj); 1508 register struct frame *ptr = XFRAME (obj);
1487 register int size = ptr->size; 1509 register int size = ptr->size;
1488 register int i;
1489 1510
1490 if (size & ARRAY_MARK_FLAG) break; /* Already marked */ 1511 if (size & ARRAY_MARK_FLAG) break; /* Already marked */
1491 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ 1512 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
@@ -1589,7 +1610,6 @@ static void
1589mark_buffer (buf) 1610mark_buffer (buf)
1590 Lisp_Object buf; 1611 Lisp_Object buf;
1591{ 1612{
1592 Lisp_Object tem;
1593 register struct buffer *buffer = XBUFFER (buf); 1613 register struct buffer *buffer = XBUFFER (buf);
1594 register Lisp_Object *ptr; 1614 register Lisp_Object *ptr;
1595 1615
@@ -1627,7 +1647,7 @@ mark_buffer (buf)
1627 mark_object (ptr); 1647 mark_object (ptr);
1628} 1648}
1629 1649
1630/* Find all structures not marked, and free them. */ 1650/* Sweep: find all structures not marked, and free them. */
1631 1651
1632static void 1652static void
1633gc_sweep () 1653gc_sweep ()
@@ -1886,8 +1906,7 @@ gc_sweep ()
1886 } 1906 }
1887} 1907}
1888 1908
1889/* Compactify strings, relocate references to them, and 1909/* Compactify strings, relocate references, and free empty string blocks. */
1890 free any string blocks that become empty. */
1891 1910
1892static void 1911static void
1893compact_strings () 1912compact_strings ()