/* 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.
#include <signal.h>
-/* 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. */
#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 */
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;
}
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;
}
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. */
/* 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
message1_nolog ("Garbage collecting...done");
}
- pop_message ();
+ unbind_to (count, Qnil);
total[0] = Fcons (make_number (total_conses),
make_number (total_free_conses));
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;
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 */
{
prev = vector, vector = vector->next;
}
}
+
+#ifdef GC_CHECK_STRING_BYTES
+ if (!noninteractive)
+ check_string_bytes (1);
+#endif
}
HCoop / bpt / emacs.git / blobdiff