1893 |
|
|
1894 |
|
|
1895 |
DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, |
DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, |
1896 |
doc: /* Return a newly created string of length LENGTH, with each element being INIT. |
doc: /* Return a newly created string of length LENGTH, with INIT in each element. |
1897 |
Both LENGTH and INIT must be numbers. */) |
LENGTH must be an integer. |
1898 |
|
INIT must be an integer that represents a character. */) |
1899 |
(length, init) |
(length, init) |
1900 |
Lisp_Object length, init; |
Lisp_Object length, init; |
1901 |
{ |
{ |
2335 |
cons_free_list = ptr; |
cons_free_list = ptr; |
2336 |
} |
} |
2337 |
|
|
|
|
|
2338 |
DEFUN ("cons", Fcons, Scons, 2, 2, 0, |
DEFUN ("cons", Fcons, Scons, 2, 2, 0, |
2339 |
doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) |
doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) |
2340 |
(car, cdr) |
(car, cdr) |
4287 |
/* If nargs is UNEVALLED, args points to slot holding list of |
/* If nargs is UNEVALLED, args points to slot holding list of |
4288 |
unevalled args. */ |
unevalled args. */ |
4289 |
char evalargs; |
char evalargs; |
4290 |
|
/* Nonzero means call value of debugger when done with this operation. */ |
4291 |
|
char debug_on_exit; |
4292 |
}; |
}; |
4293 |
|
|
4294 |
|
|
4468 |
} |
} |
4469 |
mark_kboards (); |
mark_kboards (); |
4470 |
|
|
4471 |
/* Look thru every buffer's undo list |
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
4472 |
for elements that update markers that were not marked, |
mark_stack (); |
4473 |
and delete them. */ |
#endif |
4474 |
|
|
4475 |
|
#ifdef USE_GTK |
4476 |
|
{ |
4477 |
|
extern void xg_mark_data (); |
4478 |
|
xg_mark_data (); |
4479 |
|
} |
4480 |
|
#endif |
4481 |
|
|
4482 |
|
gc_sweep (); |
4483 |
|
|
4484 |
|
/* Look thru every buffer's undo list for elements that used to |
4485 |
|
contain update markers that were changed to Lisp_Misc_Free |
4486 |
|
objects and delete them. This may leave a few cons cells |
4487 |
|
unchained, but we will get those on the next sweep. */ |
4488 |
{ |
{ |
4489 |
register struct buffer *nextb = all_buffers; |
register struct buffer *nextb = all_buffers; |
4490 |
|
|
4491 |
while (nextb) |
while (nextb) |
4492 |
{ |
{ |
4493 |
/* If a buffer's undo list is Qt, that means that undo is |
/* If a buffer's undo list is Qt, that means that undo is |
4494 |
turned off in that buffer. Calling truncate_undo_list on |
turned off in that buffer. */ |
|
Qt tends to return NULL, which effectively turns undo back on. |
|
|
So don't call truncate_undo_list if undo_list is Qt. */ |
|
4495 |
if (! EQ (nextb->undo_list, Qt)) |
if (! EQ (nextb->undo_list, Qt)) |
4496 |
{ |
{ |
4497 |
Lisp_Object tail, prev; |
Lisp_Object tail, prev, elt, car; |
4498 |
tail = nextb->undo_list; |
tail = nextb->undo_list; |
4499 |
prev = Qnil; |
prev = Qnil; |
4500 |
while (CONSP (tail)) |
while (CONSP (tail)) |
4501 |
{ |
{ |
4502 |
if (GC_CONSP (XCAR (tail)) |
if ((elt = XCAR (tail), GC_CONSP (elt)) |
4503 |
&& GC_MARKERP (XCAR (XCAR (tail))) |
&& (car = XCAR (elt), GC_MISCP (car)) |
4504 |
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) |
&& XMISCTYPE (car) == Lisp_Misc_Free) |
4505 |
{ |
{ |
4506 |
|
Lisp_Object cdr = XCDR (tail); |
4507 |
|
/* Do not use free_cons here, as we don't know if |
4508 |
|
anybody else has a pointer to these conses. */ |
4509 |
|
XSETCAR (elt, Qnil); |
4510 |
|
XSETCDR (elt, Qnil); |
4511 |
|
XSETCAR (tail, Qnil); |
4512 |
|
XSETCDR (tail, Qnil); |
4513 |
if (NILP (prev)) |
if (NILP (prev)) |
4514 |
nextb->undo_list = tail = XCDR (tail); |
nextb->undo_list = tail = cdr; |
4515 |
else |
else |
4516 |
{ |
{ |
4517 |
tail = XCDR (tail); |
tail = cdr; |
4518 |
XSETCDR (prev, tail); |
XSETCDR (prev, tail); |
4519 |
} |
} |
4520 |
} |
} |
4530 |
} |
} |
4531 |
} |
} |
4532 |
|
|
|
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
|
|
mark_stack (); |
|
|
#endif |
|
|
|
|
|
#ifdef USE_GTK |
|
|
{ |
|
|
extern void xg_mark_data (); |
|
|
xg_mark_data (); |
|
|
} |
|
|
#endif |
|
|
|
|
|
gc_sweep (); |
|
|
|
|
4533 |
/* Clear the mark bits that we set in certain root slots. */ |
/* Clear the mark bits that we set in certain root slots. */ |
4534 |
|
|
4535 |
unmark_byte_stack (); |
unmark_byte_stack (); |
4985 |
break; |
break; |
4986 |
|
|
4987 |
case Lisp_Misc: |
case Lisp_Misc: |
|
if (XMISCTYPE (obj) == Lisp_Misc_Free) |
|
|
{ |
|
|
/* This is (probably) a freed marker which may still exist on |
|
|
a buffer undo list, so accept it here, as check below will |
|
|
fail (not live). KFS 2004-05-17 */ |
|
|
XMARKER (obj)->gcmarkbit = 1; |
|
|
break; |
|
|
} |
|
4988 |
CHECK_ALLOCATED_AND_LIVE (live_misc_p); |
CHECK_ALLOCATED_AND_LIVE (live_misc_p); |
4989 |
if (XMARKER (obj)->gcmarkbit) |
if (XMARKER (obj)->gcmarkbit) |
4990 |
break; |
break; |
5210 |
static void |
static void |
5211 |
gc_sweep () |
gc_sweep () |
5212 |
{ |
{ |
|
/* Remove or mark entries in weak hash tables. |
|
|
This must be done before any object is unmarked. */ |
|
|
sweep_weak_hash_tables (); |
|
|
|
|
|
sweep_strings (); |
|
|
#ifdef GC_CHECK_STRING_BYTES |
|
|
if (!noninteractive) |
|
|
check_string_bytes (1); |
|
|
#endif |
|
|
|
|
5213 |
/* Put all unmarked conses on free list */ |
/* Put all unmarked conses on free list */ |
5214 |
{ |
{ |
5215 |
register struct cons_block *cblk; |
register struct cons_block *cblk; |
5260 |
total_free_conses = num_free; |
total_free_conses = num_free; |
5261 |
} |
} |
5262 |
|
|
5263 |
|
/* Remove or mark entries in weak hash tables. |
5264 |
|
This must be done before any object is unmarked. */ |
5265 |
|
sweep_weak_hash_tables (); |
5266 |
|
|
5267 |
|
sweep_strings (); |
5268 |
|
#ifdef GC_CHECK_STRING_BYTES |
5269 |
|
if (!noninteractive) |
5270 |
|
check_string_bytes (1); |
5271 |
|
#endif |
5272 |
|
|
5273 |
/* Put all unmarked floats on free list */ |
/* Put all unmarked floats on free list */ |
5274 |
{ |
{ |
5275 |
register struct float_block *fblk; |
register struct float_block *fblk; |
5468 |
/* If this block contains only free markers and we have already |
/* If this block contains only free markers and we have already |
5469 |
seen more than two blocks worth of free markers then deallocate |
seen more than two blocks worth of free markers then deallocate |
5470 |
this block. */ |
this block. */ |
5471 |
|
#if 0 |
5472 |
|
/* There may still be pointers to these markers from a buffer's |
5473 |
|
undo list, so don't free them. KFS 2004-05-21 / |
5474 |
if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE) |
if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE) |
5475 |
{ |
{ |
5476 |
*mprev = mblk->next; |
*mprev = mblk->next; |
5480 |
n_marker_blocks--; |
n_marker_blocks--; |
5481 |
} |
} |
5482 |
else |
else |
5483 |
|
#endif |
5484 |
{ |
{ |
5485 |
num_free += this_free; |
num_free += this_free; |
5486 |
mprev = &mblk->next; |
mprev = &mblk->next; |