X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2003532193f74648fd709e36efe1bd83fdd66473..c596c392c82ad7b99f6263e2ef9c7ef913addb77:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index eba9d867c8..4affa42e68 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1,5 +1,5 @@ /* Storage allocation and gc for GNU Emacs Lisp interpreter. - Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000 + Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -26,12 +26,6 @@ Boston, MA 02111-1307, USA. */ #include -/* Define this temporarily to hunt a bug. If defined, the size of - strings is redundantly recorded in sdata structures so that it can - be compared to the sizes recorded in Lisp strings. */ - -#define GC_CHECK_STRING_BYTES 1 - /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd memory. Can do this only if using gmalloc.c. */ @@ -1201,50 +1195,84 @@ init_strings () #ifdef GC_CHECK_STRING_BYTES -/* Check validity of all live Lisp strings' string_bytes member. - Used for hunting a bug. */ - static int check_string_bytes_count; +void check_string_bytes P_ ((int)); +void check_sblock P_ ((struct sblock *)); + +#define CHECK_STRING_BYTES(S) STRING_BYTES (S) + + +/* Like GC_STRING_BYTES, but with debugging check. */ + +int +string_bytes (s) + struct Lisp_String *s; +{ + int nbytes = (s->size_byte < 0 ? s->size : s->size_byte) & ~MARKBIT; + if (!PURE_POINTER_P (s) + && s->data + && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) + abort (); + return nbytes; +} + +/* Check validity Lisp strings' string_bytes member in B. */ + void -check_string_bytes () +check_sblock (b) + struct sblock *b; { - struct sblock *b; - - for (b = large_sblocks; b; b = b->next) - { - struct Lisp_String *s = b->first_data.string; - if (s && GC_STRING_BYTES (s) != SDATA_NBYTES (SDATA_OF_STRING (s))) - abort (); - } + struct sdata *from, *end, *from_end; - for (b = oldest_sblock; b; b = b->next) + end = b->next_free; + + for (from = &b->first_data; from < end; from = from_end) { - struct sdata *from, *end, *from_end; + /* Compute the next FROM here because copying below may + overwrite data we need to compute it. */ + int nbytes; - end = b->next_free; + /* Check that the string size recorded in the string is the + same as the one recorded in the sdata structure. */ + if (from->string) + CHECK_STRING_BYTES (from->string); - for (from = &b->first_data; from < end; from = from_end) - { - /* Compute the next FROM here because copying below may - overwrite data we need to compute it. */ - int nbytes; + if (from->string) + nbytes = GC_STRING_BYTES (from->string); + else + nbytes = SDATA_NBYTES (from); + + nbytes = SDATA_SIZE (nbytes); + from_end = (struct sdata *) ((char *) from + nbytes); + } +} - /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ - if (from->string - && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from)) - abort (); - - if (from->string) - nbytes = GC_STRING_BYTES (from->string); - else - nbytes = SDATA_NBYTES (from); - - nbytes = SDATA_SIZE (nbytes); - from_end = (struct sdata *) ((char *) from + nbytes); + +/* Check validity of Lisp strings' string_bytes member. ALL_P + non-zero means check all strings, otherwise check only most + recently allocated strings. Used for hunting a bug. */ + +void +check_string_bytes (all_p) + int all_p; +{ + if (all_p) + { + struct sblock *b; + + for (b = large_sblocks; b; b = b->next) + { + struct Lisp_String *s = b->first_data.string; + if (s) + CHECK_STRING_BYTES (s); } + + for (b = oldest_sblock; b; b = b->next) + check_sblock (b); } + else + check_sblock (current_sblock); } #endif /* GC_CHECK_STRING_BYTES */ @@ -1294,12 +1322,21 @@ allocate_string () consing_since_gc += sizeof *s; #ifdef GC_CHECK_STRING_BYTES - if (!noninteractive && ++check_string_bytes_count == 50) + if (!noninteractive +#ifdef macintosh + && current_sblock +#endif + ) { - check_string_bytes_count = 0; - check_string_bytes (); + if (++check_string_bytes_count == 200) + { + check_string_bytes_count = 0; + check_string_bytes (1); + } + else + check_string_bytes (0); } -#endif +#endif /* GC_CHECK_STRING_BYTES */ return s; } @@ -2105,8 +2142,38 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, size = XFASTINT (length); val = Qnil; - while (size-- > 0) - val = Fcons (init, val); + while (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + } + } + } + } + + QUIT; + } + return val; } @@ -3702,6 +3769,7 @@ Garbage collection happens automatically if you cons more than\n\ register int i; int message_p; Lisp_Object total[8]; + int count = BINDING_STACK_SIZE (); /* In case user calls debug_print during GC, don't let that cause a recursive GC. */ @@ -3709,6 +3777,7 @@ Garbage collection happens automatically if you cons more than\n\ /* Save what's currently displayed in the echo area. */ message_p = push_message (); + record_unwind_protect (push_message_unwind, Qnil); /* Save a copy of the contents of the stack, for debugging. */ #if MAX_SAVE_STACK > 0 @@ -3913,7 +3982,7 @@ Garbage collection happens automatically if you cons more than\n\ message1_nolog ("Garbage collecting...done"); } - pop_message (); + unbind_to (count, Qnil); total[0] = Fcons (make_number (total_conses), make_number (total_free_conses)); @@ -4109,13 +4178,9 @@ mark_object (argptr) MARK_INTERVAL_TREE (ptr->intervals); MARK_STRING (ptr); #ifdef GC_CHECK_STRING_BYTES - { - /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ - struct sdata *p = SDATA_OF_STRING (ptr); - if (GC_STRING_BYTES (ptr) != SDATA_NBYTES (p)) - abort (); - } + /* Check that the string size recorded in the string is the + same as the one recorded in the sdata structure. */ + CHECK_STRING_BYTES (ptr); #endif /* GC_CHECK_STRING_BYTES */ } break; @@ -4606,6 +4671,10 @@ gc_sweep () sweep_weak_hash_tables (); sweep_strings (); +#ifdef GC_CHECK_STRING_BYTES + if (!noninteractive) + check_string_bytes (1); +#endif /* Put all unmarked conses on free list */ { @@ -4958,6 +5027,11 @@ gc_sweep () prev = vector, vector = vector->next; } } + +#ifdef GC_CHECK_STRING_BYTES + if (!noninteractive) + check_string_bytes (1); +#endif }