Mercurial > emacs
comparison src/alloc.c @ 1908:d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
boundary before allocating the float.
* alloc.c: Add description lines to the top of each page.
* alloc.c (mark_interval_tree): Remove spurious & in front of
function name.
* alloc.c (UNMARK_BALANCE_INTERVALS): Fix to accomodate compilers
other than GCC, which do not allow casts on the LHS of an
assignment.
* alloc.c (mark_object, mark_buffer): Remove some unused
variables.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Mon, 22 Feb 1993 14:22:03 +0000 |
parents | b047e77f3be4 |
children | 82bbf90208d4 |
comparison
equal
deleted
inserted
replaced
1907:df8b67adcee3 | 1908:d649f2179d67 |
---|---|
112 | 112 |
113 static void mark_object (), mark_buffer (); | 113 static void mark_object (), mark_buffer (); |
114 static void clear_marks (), gc_sweep (); | 114 static void clear_marks (), gc_sweep (); |
115 static void compact_strings (); | 115 static void compact_strings (); |
116 | 116 |
117 /* Versions of malloc and realloc that print warnings as memory gets full. */ | |
118 | |
117 Lisp_Object | 119 Lisp_Object |
118 malloc_warning_1 (str) | 120 malloc_warning_1 (str) |
119 Lisp_Object str; | 121 Lisp_Object str; |
120 { | 122 { |
121 Fprinc (str, Vstandard_output); | 123 Fprinc (str, Vstandard_output); |
177 | 179 |
178 if (!val && size) memory_full (); | 180 if (!val && size) memory_full (); |
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)) |
185 | 189 |
186 struct interval_block | 190 struct interval_block |
258 register INTERVAL tree; | 262 register INTERVAL tree; |
259 { | 263 { |
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 */ |
279 | 286 |
280 #define INIT_INTERVALS | 287 #define INIT_INTERVALS |
282 #define UNMARK_BALANCE_INTERVALS(i) | 289 #define UNMARK_BALANCE_INTERVALS(i) |
283 #define MARK_INTERVAL_TREE(i) | 290 #define MARK_INTERVAL_TREE(i) |
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 |
290 float_block with malloc whenever necessary. Float cells reclaimed by | 299 float_block with malloc whenever necessary. Float cells reclaimed by |
291 GC are put on a free list to be reallocated before allocating | 300 GC are put on a free list to be reallocated before allocating |
881 | 890 |
882 return result; | 891 return result; |
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. */ |
889 | 900 |
890 DEFUN ("make-rope", Fmake_rope, Smake_rope, 0, MANY, 0, | 901 DEFUN ("make-rope", Fmake_rope, Smake_rope, 0, MANY, 0, |
930 if ((XSTRING (r)->size / sizeof (GLYPH)) <= XINT (n) || XINT (n) < 0) | 941 if ((XSTRING (r)->size / sizeof (GLYPH)) <= XINT (n) || XINT (n) < 0) |
931 args_out_of_range (r, n); | 942 args_out_of_range (r, n); |
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; |
938 then the string is not protected from gc. */ | 951 then the string is not protected from gc. */ |
939 | 952 |
976 Lisp_Object | 989 Lisp_Object |
977 make_pure_float (num) | 990 make_pure_float (num) |
978 double num; | 991 double num; |
979 { | 992 { |
980 register Lisp_Object new; | 993 register Lisp_Object new; |
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); | |
981 | 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); |
985 pureptr += sizeof (struct Lisp_Float); | 1004 pureptr += sizeof (struct Lisp_Float); |
1118 | 1137 |
1119 #if ARRAY_MARK_FLAG == MARKBIT | 1138 #if ARRAY_MARK_FLAG == MARKBIT |
1120 you lose | 1139 you lose |
1121 #endif | 1140 #endif |
1122 | 1141 |
1142 /* Garbage collection! */ | |
1143 | |
1123 int total_conses, total_markers, total_symbols, total_string_size, total_vector_size; | 1144 int total_conses, total_markers, total_symbols, total_string_size, total_vector_size; |
1124 int total_free_conses, total_free_markers, total_free_symbols; | 1145 int total_free_conses, total_free_markers, total_free_symbols; |
1125 #ifdef LISP_FLOAT_TYPE | 1146 #ifdef LISP_FLOAT_TYPE |
1126 int total_free_floats, total_floats; | 1147 int total_free_floats, total_floats; |
1127 #endif /* LISP_FLOAT_TYPE */ | 1148 #endif /* LISP_FLOAT_TYPE */ |
1364 } | 1385 } |
1365 } | 1386 } |
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 |
1374 the `size' field of the string. The actual string size | 1396 the `size' field of the string. The actual string size |
1375 lives in the last slot in the chain. We recognize the end | 1397 lives in the last slot in the chain. We recognize the end |
1483 #ifdef MULTI_FRAME | 1505 #ifdef MULTI_FRAME |
1484 case Lisp_Frame: | 1506 case Lisp_Frame: |
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 */ |
1492 | 1513 |
1493 mark_object (&ptr->name); | 1514 mark_object (&ptr->name); |
1587 | 1608 |
1588 static void | 1609 static void |
1589 mark_buffer (buf) | 1610 mark_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 |
1596 /* This is the buffer's markbit */ | 1616 /* This is the buffer's markbit */ |
1597 mark_object (&buffer->name); | 1617 mark_object (&buffer->name); |
1625 (char *)ptr < (char *)buffer + sizeof (struct buffer); | 1645 (char *)ptr < (char *)buffer + sizeof (struct buffer); |
1626 ptr++) | 1646 ptr++) |
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 |
1632 static void | 1652 static void |
1633 gc_sweep () | 1653 gc_sweep () |
1634 { | 1654 { |
1635 total_string_size = 0; | 1655 total_string_size = 0; |
1884 prev = sb, sb = sb->next; | 1904 prev = sb, sb = sb->next; |
1885 } | 1905 } |
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 |
1892 static void | 1911 static void |
1893 compact_strings () | 1912 compact_strings () |
1894 { | 1913 { |
1895 /* String block of old strings we are scanning. */ | 1914 /* String block of old strings we are scanning. */ |