155 |
|
|
156 |
EMACS_INT undo_limit; |
EMACS_INT undo_limit; |
157 |
EMACS_INT undo_strong_limit; |
EMACS_INT undo_strong_limit; |
158 |
|
EMACS_INT undo_outer_limit; |
159 |
|
|
160 |
/* Number of live and free conses etc. */ |
/* Number of live and free conses etc. */ |
161 |
|
|
257 |
|
|
258 |
static void mark_buffer P_ ((Lisp_Object)); |
static void mark_buffer P_ ((Lisp_Object)); |
259 |
extern void mark_kboards P_ ((void)); |
extern void mark_kboards P_ ((void)); |
260 |
|
extern void mark_backtrace P_ ((void)); |
261 |
static void gc_sweep P_ ((void)); |
static void gc_sweep P_ ((void)); |
262 |
static void mark_glyph_matrix P_ ((struct glyph_matrix *)); |
static void mark_glyph_matrix P_ ((struct glyph_matrix *)); |
263 |
static void mark_face_cache P_ ((struct face_cache *)); |
static void mark_face_cache P_ ((struct face_cache *)); |
755 |
#ifdef HAVE_POSIX_MEMALIGN |
#ifdef HAVE_POSIX_MEMALIGN |
756 |
{ |
{ |
757 |
int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES); |
int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES); |
758 |
abase = err ? (base = NULL) : base; |
if (err) |
759 |
|
base = NULL; |
760 |
|
abase = base; |
761 |
} |
} |
762 |
#else |
#else |
763 |
base = malloc (ABLOCKS_BYTES); |
base = malloc (ABLOCKS_BYTES); |
764 |
abase = ALIGN (base, BLOCK_ALIGN); |
abase = ALIGN (base, BLOCK_ALIGN); |
765 |
|
#endif |
766 |
|
|
767 |
if (base == 0) |
if (base == 0) |
768 |
{ |
{ |
769 |
UNBLOCK_INPUT; |
UNBLOCK_INPUT; |
770 |
memory_full (); |
memory_full (); |
771 |
} |
} |
|
#endif |
|
772 |
|
|
773 |
aligned = (base == abase); |
aligned = (base == abase); |
774 |
if (!aligned) |
if (!aligned) |
849 |
free_ablock = ablock; |
free_ablock = ablock; |
850 |
/* Update busy count. */ |
/* Update busy count. */ |
851 |
ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase)); |
ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase)); |
852 |
|
|
853 |
if (2 > (long) ABLOCKS_BUSY (abase)) |
if (2 > (long) ABLOCKS_BUSY (abase)) |
854 |
{ /* All the blocks are free. */ |
{ /* All the blocks are free. */ |
855 |
int i = 0, aligned = (long) ABLOCKS_BUSY (abase); |
int i = 0, aligned = (long) ABLOCKS_BUSY (abase); |
1898 |
|
|
1899 |
|
|
1900 |
DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, |
DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, |
1901 |
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. |
1902 |
Both LENGTH and INIT must be numbers. */) |
LENGTH must be an integer. |
1903 |
|
INIT must be an integer that represents a character. */) |
1904 |
(length, init) |
(length, init) |
1905 |
Lisp_Object length, init; |
Lisp_Object length, init; |
1906 |
{ |
{ |
1955 |
|
|
1956 |
CHECK_NATNUM (length); |
CHECK_NATNUM (length); |
1957 |
|
|
1958 |
bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; |
bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR; |
1959 |
|
|
1960 |
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; |
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; |
1961 |
length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR); |
length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) |
1962 |
|
/ BOOL_VECTOR_BITS_PER_CHAR); |
1963 |
|
|
1964 |
/* We must allocate one more elements than LENGTH_IN_ELTS for the |
/* We must allocate one more elements than LENGTH_IN_ELTS for the |
1965 |
slot `size' of the struct Lisp_Bool_Vector. */ |
slot `size' of the struct Lisp_Bool_Vector. */ |
1976 |
p->data[i] = real_init; |
p->data[i] = real_init; |
1977 |
|
|
1978 |
/* Clear the extraneous bits in the last byte. */ |
/* Clear the extraneous bits in the last byte. */ |
1979 |
if (XINT (length) != length_in_chars * BITS_PER_CHAR) |
if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR) |
1980 |
XBOOL_VECTOR (val)->data[length_in_chars - 1] |
XBOOL_VECTOR (val)->data[length_in_chars - 1] |
1981 |
&= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; |
&= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; |
1982 |
|
|
1983 |
return val; |
return val; |
1984 |
} |
} |
2340 |
cons_free_list = ptr; |
cons_free_list = ptr; |
2341 |
} |
} |
2342 |
|
|
|
|
|
2343 |
DEFUN ("cons", Fcons, Scons, 2, 2, 0, |
DEFUN ("cons", Fcons, Scons, 2, 2, 0, |
2344 |
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. */) |
2345 |
(car, cdr) |
(car, cdr) |
4239 |
struct catchtag *next; |
struct catchtag *next; |
4240 |
}; |
}; |
4241 |
|
|
|
struct backtrace |
|
|
{ |
|
|
struct backtrace *next; |
|
|
Lisp_Object *function; |
|
|
Lisp_Object *args; /* Points to vector of args. */ |
|
|
int nargs; /* Length of vector. */ |
|
|
/* If nargs is UNEVALLED, args points to slot holding list of |
|
|
unevalled args. */ |
|
|
char evalargs; |
|
|
}; |
|
|
|
|
|
|
|
4242 |
|
|
4243 |
/*********************************************************************** |
/*********************************************************************** |
4244 |
Protection from GC |
Protection from GC |
4273 |
register struct specbinding *bind; |
register struct specbinding *bind; |
4274 |
struct catchtag *catch; |
struct catchtag *catch; |
4275 |
struct handler *handler; |
struct handler *handler; |
|
register struct backtrace *backlist; |
|
4276 |
char stack_top_variable; |
char stack_top_variable; |
4277 |
register int i; |
register int i; |
4278 |
int message_p; |
int message_p; |
4341 |
if (! EQ (nextb->undo_list, Qt)) |
if (! EQ (nextb->undo_list, Qt)) |
4342 |
nextb->undo_list |
nextb->undo_list |
4343 |
= truncate_undo_list (nextb->undo_list, undo_limit, |
= truncate_undo_list (nextb->undo_list, undo_limit, |
4344 |
undo_strong_limit); |
undo_strong_limit, undo_outer_limit); |
4345 |
|
|
4346 |
/* Shrink buffer gaps, but skip indirect and dead buffers. */ |
/* Shrink buffer gaps, but skip indirect and dead buffers. */ |
4347 |
if (nextb->base_buffer == 0 && !NILP (nextb->name)) |
if (nextb->base_buffer == 0 && !NILP (nextb->name)) |
4401 |
mark_object (handler->handler); |
mark_object (handler->handler); |
4402 |
mark_object (handler->var); |
mark_object (handler->var); |
4403 |
} |
} |
4404 |
for (backlist = backtrace_list; backlist; backlist = backlist->next) |
mark_backtrace (); |
|
{ |
|
|
mark_object (*backlist->function); |
|
|
|
|
|
if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) |
|
|
i = 0; |
|
|
else |
|
|
i = backlist->nargs - 1; |
|
|
for (; i >= 0; i--) |
|
|
mark_object (backlist->args[i]); |
|
|
} |
|
4405 |
mark_kboards (); |
mark_kboards (); |
4406 |
|
|
4407 |
/* Look thru every buffer's undo list |
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
4408 |
|
mark_stack (); |
4409 |
|
#endif |
4410 |
|
|
4411 |
|
#ifdef USE_GTK |
4412 |
|
{ |
4413 |
|
extern void xg_mark_data (); |
4414 |
|
xg_mark_data (); |
4415 |
|
} |
4416 |
|
#endif |
4417 |
|
|
4418 |
|
/* Everything is now marked, except for the things that require special |
4419 |
|
finalization, i.e. the undo_list. |
4420 |
|
Look thru every buffer's undo list |
4421 |
for elements that update markers that were not marked, |
for elements that update markers that were not marked, |
4422 |
and delete them. */ |
and delete them. */ |
4423 |
{ |
{ |
4455 |
} |
} |
4456 |
} |
} |
4457 |
} |
} |
4458 |
|
/* Now that we have stripped the elements that need not be in the |
4459 |
|
undo_list any more, we can finally mark the list. */ |
4460 |
|
mark_object (nextb->undo_list); |
4461 |
|
|
4462 |
nextb = nextb->next; |
nextb = nextb->next; |
4463 |
} |
} |
4464 |
} |
} |
4465 |
|
|
|
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
|
|
mark_stack (); |
|
|
#endif |
|
|
|
|
|
#ifdef USE_GTK |
|
|
{ |
|
|
extern void xg_mark_data (); |
|
|
xg_mark_data (); |
|
|
} |
|
|
#endif |
|
|
|
|
4466 |
gc_sweep (); |
gc_sweep (); |
4467 |
|
|
4468 |
/* Clear the mark bits that we set in certain root slots. */ |
/* Clear the mark bits that we set in certain root slots. */ |
5031 |
|
|
5032 |
MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); |
MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); |
5033 |
|
|
5034 |
if (CONSP (buffer->undo_list)) |
/* For now, we just don't mark the undo_list. It's done later in |
5035 |
{ |
a special way just before the sweep phase, and after stripping |
5036 |
Lisp_Object tail; |
some of its elements that are not needed any more. */ |
|
tail = buffer->undo_list; |
|
|
|
|
|
/* We mark the undo list specially because |
|
|
its pointers to markers should be weak. */ |
|
|
|
|
|
while (CONSP (tail)) |
|
|
{ |
|
|
register struct Lisp_Cons *ptr = XCONS (tail); |
|
|
|
|
|
if (CONS_MARKED_P (ptr)) |
|
|
break; |
|
|
CONS_MARK (ptr); |
|
|
if (GC_CONSP (ptr->car) |
|
|
&& !CONS_MARKED_P (XCONS (ptr->car)) |
|
|
&& GC_MARKERP (XCAR (ptr->car))) |
|
|
{ |
|
|
CONS_MARK (XCONS (ptr->car)); |
|
|
mark_object (XCDR (ptr->car)); |
|
|
} |
|
|
else |
|
|
mark_object (ptr->car); |
|
|
|
|
|
if (CONSP (ptr->cdr)) |
|
|
tail = ptr->cdr; |
|
|
else |
|
|
break; |
|
|
} |
|
|
|
|
|
mark_object (XCDR (tail)); |
|
|
} |
|
|
else |
|
|
mark_object (buffer->undo_list); |
|
5037 |
|
|
5038 |
if (buffer->overlays_before) |
if (buffer->overlays_before) |
5039 |
{ |
{ |
5627 |
|
|
5628 |
DEFVAR_INT ("undo-strong-limit", &undo_strong_limit, |
DEFVAR_INT ("undo-strong-limit", &undo_strong_limit, |
5629 |
doc: /* Don't keep more than this much size of undo information. |
doc: /* Don't keep more than this much size of undo information. |
5630 |
A command which pushes past this size is itself forgotten. |
A previous command which pushes the undo list past this size |
5631 |
This limit is applied when garbage collection happens. |
is entirely forgotten when GC happens. |
5632 |
The size is counted as the number of bytes occupied, |
The size is counted as the number of bytes occupied, |
5633 |
which includes both saved text and other data. */); |
which includes both saved text and other data. */); |
5634 |
undo_strong_limit = 30000; |
undo_strong_limit = 30000; |
5635 |
|
|
5636 |
|
DEFVAR_INT ("undo-outer-limit", &undo_outer_limit, |
5637 |
|
doc: /* Don't keep more than this much size of undo information. |
5638 |
|
If the current command has produced more than this much undo information, |
5639 |
|
GC discards it. This is a last-ditch limit to prevent memory overflow. |
5640 |
|
The size is counted as the number of bytes occupied, |
5641 |
|
which includes both saved text and other data. */); |
5642 |
|
undo_outer_limit = 300000; |
5643 |
|
|
5644 |
DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages, |
DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages, |
5645 |
doc: /* Non-nil means display messages at start and end of garbage collection. */); |
doc: /* Non-nil means display messages at start and end of garbage collection. */); |
5646 |
garbage_collection_messages = 0; |
garbage_collection_messages = 0; |