aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c74
1 files changed, 39 insertions, 35 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 63447d078f9..ae156d89f24 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1894,8 +1894,9 @@ compact_small_strings ()
1894 1894
1895 1895
1896DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, 1896DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
1897 doc: /* Return a newly created string of length LENGTH, with each element being INIT. 1897 doc: /* Return a newly created string of length LENGTH, with INIT in each element.
1898Both LENGTH and INIT must be numbers. */) 1898LENGTH must be an integer.
1899INIT must be an integer that represents a character. */)
1899 (length, init) 1900 (length, init)
1900 Lisp_Object length, init; 1901 Lisp_Object length, init;
1901{ 1902{
@@ -2335,7 +2336,6 @@ free_cons (ptr)
2335 cons_free_list = ptr; 2336 cons_free_list = ptr;
2336} 2337}
2337 2338
2338
2339DEFUN ("cons", Fcons, Scons, 2, 2, 0, 2339DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2340 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) 2340 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */)
2341 (car, cdr) 2341 (car, cdr)
@@ -4287,6 +4287,8 @@ struct backtrace
4287 /* If nargs is UNEVALLED, args points to slot holding list of 4287 /* If nargs is UNEVALLED, args points to slot holding list of
4288 unevalled args. */ 4288 unevalled args. */
4289 char evalargs; 4289 char evalargs;
4290 /* Nonzero means call value of debugger when done with this operation. */
4291 char debug_on_exit;
4290}; 4292};
4291 4293
4292 4294
@@ -4478,34 +4480,42 @@ returns nil, because real GC can't be done. */)
4478 } 4480 }
4479#endif 4481#endif
4480 4482
4481 /* Look thru every buffer's undo list 4483 gc_sweep ();
4482 for elements that update markers that were not marked, 4484
4483 and delete them. */ 4485 /* Look thru every buffer's undo list for elements that used to
4486 contain update markers that were changed to Lisp_Misc_Free
4487 objects and delete them. This may leave a few cons cells
4488 unchained, but we will get those on the next sweep. */
4484 { 4489 {
4485 register struct buffer *nextb = all_buffers; 4490 register struct buffer *nextb = all_buffers;
4486 4491
4487 while (nextb) 4492 while (nextb)
4488 { 4493 {
4489 /* If a buffer's undo list is Qt, that means that undo is 4494 /* If a buffer's undo list is Qt, that means that undo is
4490 turned off in that buffer. Calling truncate_undo_list on 4495 turned off in that buffer. */
4491 Qt tends to return NULL, which effectively turns undo back on.
4492 So don't call truncate_undo_list if undo_list is Qt. */
4493 if (! EQ (nextb->undo_list, Qt)) 4496 if (! EQ (nextb->undo_list, Qt))
4494 { 4497 {
4495 Lisp_Object tail, prev; 4498 Lisp_Object tail, prev, elt, car;
4496 tail = nextb->undo_list; 4499 tail = nextb->undo_list;
4497 prev = Qnil; 4500 prev = Qnil;
4498 while (CONSP (tail)) 4501 while (CONSP (tail))
4499 { 4502 {
4500 if (GC_CONSP (XCAR (tail)) 4503 if ((elt = XCAR (tail), GC_CONSP (elt))
4501 && GC_MARKERP (XCAR (XCAR (tail))) 4504 && (car = XCAR (elt), GC_MISCP (car))
4502 && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) 4505 && XMISCTYPE (car) == Lisp_Misc_Free)
4503 { 4506 {
4507 Lisp_Object cdr = XCDR (tail);
4508 /* Do not use free_cons here, as we don't know if
4509 anybody else has a pointer to these conses. */
4510 XSETCAR (elt, Qnil);
4511 XSETCDR (elt, Qnil);
4512 XSETCAR (tail, Qnil);
4513 XSETCDR (tail, Qnil);
4504 if (NILP (prev)) 4514 if (NILP (prev))
4505 nextb->undo_list = tail = XCDR (tail); 4515 nextb->undo_list = tail = cdr;
4506 else 4516 else
4507 { 4517 {
4508 tail = XCDR (tail); 4518 tail = cdr;
4509 XSETCDR (prev, tail); 4519 XSETCDR (prev, tail);
4510 } 4520 }
4511 } 4521 }
@@ -4521,8 +4531,6 @@ returns nil, because real GC can't be done. */)
4521 } 4531 }
4522 } 4532 }
4523 4533
4524 gc_sweep ();
4525
4526 /* Clear the mark bits that we set in certain root slots. */ 4534 /* Clear the mark bits that we set in certain root slots. */
4527 4535
4528 unmark_byte_stack (); 4536 unmark_byte_stack ();
@@ -4978,14 +4986,6 @@ mark_object (arg)
4978 break; 4986 break;
4979 4987
4980 case Lisp_Misc: 4988 case Lisp_Misc:
4981 if (XMISCTYPE (obj) == Lisp_Misc_Free)
4982 {
4983 /* This is (probably) a freed marker which may still exist on
4984 a buffer undo list, so accept it here, as check below will
4985 fail (not live). KFS 2004-05-17 */
4986 XMARKER (obj)->gcmarkbit = 1;
4987 break;
4988 }
4989 CHECK_ALLOCATED_AND_LIVE (live_misc_p); 4989 CHECK_ALLOCATED_AND_LIVE (live_misc_p);
4990 if (XMARKER (obj)->gcmarkbit) 4990 if (XMARKER (obj)->gcmarkbit)
4991 break; 4991 break;
@@ -5211,16 +5211,6 @@ survives_gc_p (obj)
5211static void 5211static void
5212gc_sweep () 5212gc_sweep ()
5213{ 5213{
5214 /* Remove or mark entries in weak hash tables.
5215 This must be done before any object is unmarked. */
5216 sweep_weak_hash_tables ();
5217
5218 sweep_strings ();
5219#ifdef GC_CHECK_STRING_BYTES
5220 if (!noninteractive)
5221 check_string_bytes (1);
5222#endif
5223
5224 /* Put all unmarked conses on free list */ 5214 /* Put all unmarked conses on free list */
5225 { 5215 {
5226 register struct cons_block *cblk; 5216 register struct cons_block *cblk;
@@ -5271,6 +5261,16 @@ gc_sweep ()
5271 total_free_conses = num_free; 5261 total_free_conses = num_free;
5272 } 5262 }
5273 5263
5264 /* Remove or mark entries in weak hash tables.
5265 This must be done before any object is unmarked. */
5266 sweep_weak_hash_tables ();
5267
5268 sweep_strings ();
5269#ifdef GC_CHECK_STRING_BYTES
5270 if (!noninteractive)
5271 check_string_bytes (1);
5272#endif
5273
5274 /* Put all unmarked floats on free list */ 5274 /* Put all unmarked floats on free list */
5275 { 5275 {
5276 register struct float_block *fblk; 5276 register struct float_block *fblk;
@@ -5469,6 +5469,9 @@ gc_sweep ()
5469 /* If this block contains only free markers and we have already 5469 /* If this block contains only free markers and we have already
5470 seen more than two blocks worth of free markers then deallocate 5470 seen more than two blocks worth of free markers then deallocate
5471 this block. */ 5471 this block. */
5472#if 0
5473 /* There may still be pointers to these markers from a buffer's
5474 undo list, so don't free them. KFS 2004-05-21 /
5472 if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE) 5475 if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)
5473 { 5476 {
5474 *mprev = mblk->next; 5477 *mprev = mblk->next;
@@ -5478,6 +5481,7 @@ gc_sweep ()
5478 n_marker_blocks--; 5481 n_marker_blocks--;
5479 } 5482 }
5480 else 5483 else
5484#endif
5481 { 5485 {
5482 num_free += this_free; 5486 num_free += this_free;
5483 mprev = &mblk->next; 5487 mprev = &mblk->next;