X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4df043c55892b20418c763df48e313f1c44f442e..5feeead12693cd97c6d77b14ef05d29ba5cf18bb:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index 5ee1cc340a..054e1ca23c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7,8 +7,8 @@ This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -2174,89 +2174,96 @@ free_large_strings (void) static void compact_small_strings (void) { - struct sblock *b, *tb, *next; - sdata *from, *to, *end, *tb_end; - sdata *to_end, *from_end; - /* TB is the sblock we copy to, TO is the sdata within TB we copy to, and TB_END is the end of TB. */ - tb = oldest_sblock; - tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE); - to = tb->data; - - /* Step through the blocks from the oldest to the youngest. We - expect that old blocks will stabilize over time, so that less - copying will happen this way. */ - for (b = oldest_sblock; b; b = b->next) + struct sblock *tb = oldest_sblock; + if (tb) { - end = b->next_free; - eassert ((char *) end <= (char *) b + SBLOCK_SIZE); + sdata *tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE); + sdata *to = tb->data; - for (from = b->data; from < end; from = from_end) + /* Step through the blocks from the oldest to the youngest. We + expect that old blocks will stabilize over time, so that less + copying will happen this way. */ + struct sblock *b = tb; + do { - /* Compute the next FROM here because copying below may - overwrite data we need to compute it. */ - ptrdiff_t nbytes; - struct Lisp_String *s = from->string; + sdata *end = b->next_free; + eassert ((char *) end <= (char *) b + SBLOCK_SIZE); + + for (sdata *from = b->data; from < end; ) + { + /* Compute the next FROM here because copying below may + overwrite data we need to compute it. */ + ptrdiff_t nbytes; + struct Lisp_String *s = from->string; #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. */ - if (s && string_bytes (s) != SDATA_NBYTES (from)) - emacs_abort (); + /* Check that the string size recorded in the string is the + same as the one recorded in the sdata structure. */ + if (s && string_bytes (s) != SDATA_NBYTES (from)) + emacs_abort (); #endif /* GC_CHECK_STRING_BYTES */ - nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from); - eassert (nbytes <= LARGE_STRING_BYTES); + nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from); + eassert (nbytes <= LARGE_STRING_BYTES); - nbytes = SDATA_SIZE (nbytes); - from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); + nbytes = SDATA_SIZE (nbytes); + sdata *from_end = (sdata *) ((char *) from + + nbytes + GC_STRING_EXTRA); #ifdef GC_CHECK_STRING_OVERRUN - if (memcmp (string_overrun_cookie, - (char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE, - GC_STRING_OVERRUN_COOKIE_SIZE)) - emacs_abort (); + if (memcmp (string_overrun_cookie, + (char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE, + GC_STRING_OVERRUN_COOKIE_SIZE)) + emacs_abort (); #endif - /* Non-NULL S means it's alive. Copy its data. */ - if (s) - { - /* If TB is full, proceed with the next sblock. */ - to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); - if (to_end > tb_end) + /* Non-NULL S means it's alive. Copy its data. */ + if (s) { - tb->next_free = to; - tb = tb->next; - tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE); - to = tb->data; - to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); - } + /* If TB is full, proceed with the next sblock. */ + sdata *to_end = (sdata *) ((char *) to + + nbytes + GC_STRING_EXTRA); + if (to_end > tb_end) + { + tb->next_free = to; + tb = tb->next; + tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE); + to = tb->data; + to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); + } - /* Copy, and update the string's `data' pointer. */ - if (from != to) - { - eassert (tb != b || to < from); - memmove (to, from, nbytes + GC_STRING_EXTRA); - to->string->data = SDATA_DATA (to); - } + /* Copy, and update the string's `data' pointer. */ + if (from != to) + { + eassert (tb != b || to < from); + memmove (to, from, nbytes + GC_STRING_EXTRA); + to->string->data = SDATA_DATA (to); + } - /* Advance past the sdata we copied to. */ - to = to_end; + /* Advance past the sdata we copied to. */ + to = to_end; + } + from = from_end; } + b = b->next; } - } + while (b); - /* The rest of the sblocks following TB don't contain live data, so - we can free them. */ - for (b = tb->next; b; b = next) - { - next = b->next; - lisp_free (b); + /* The rest of the sblocks following TB don't contain live data, so + we can free them. */ + for (b = tb->next; b; ) + { + struct sblock *next = b->next; + lisp_free (b); + b = next; + } + + tb->next_free = to; + tb->next = NULL; } - tb->next_free = to; - tb->next = NULL; current_sblock = tb; } @@ -3724,7 +3731,6 @@ make_save_ptr_int (void *a, ptrdiff_t b) return val; } -#if ! (defined USE_X_TOOLKIT || defined USE_GTK) Lisp_Object make_save_ptr_ptr (void *a, void *b) { @@ -3735,7 +3741,6 @@ make_save_ptr_ptr (void *a, void *b) p->data[1].pointer = b; return val; } -#endif Lisp_Object make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c) @@ -5427,7 +5432,7 @@ purecopy (Lisp_Object obj) } else { - Lisp_Object fmt = build_pure_c_string ("Don't know how to purify: %S"); + AUTO_STRING (fmt, "Don't know how to purify: %S"); Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj))); } @@ -5658,7 +5663,7 @@ garbage_collect_1 (void *end) return Qnil; /* Record this function, so it appears on the profiler's backtraces. */ - record_in_backtrace (Qautomatic_gc, 0, 0); + record_in_backtrace (QAutomatic_GC, 0, 0); check_cons_list (); @@ -6121,7 +6126,7 @@ mark_face_cache (struct face_cache *c) int i, j; for (i = 0; i < c->used; ++i) { - struct face *face = FACE_FROM_ID (c->f, i); + struct face *face = FACE_OPT_FROM_ID (c->f, i); if (face) { @@ -7218,21 +7223,6 @@ die (const char *msg, const char *file, int line) #if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS -/* Debugging check whether STR is ASCII-only. */ - -const char * -verify_ascii (const char *str) -{ - const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str); - while (ptr < end) - { - int c = STRING_CHAR_ADVANCE (ptr); - if (!ASCII_CHAR_P (c)) - emacs_abort (); - } - return str; -} - /* Stress alloca with inconveniently sized requests and check whether all allocated areas may be used for Lisp_Object. */ @@ -7388,7 +7378,7 @@ do hash-consing of the objects allocated to pure space. */); DEFSYM (Qstring_bytes, "string-bytes"); DEFSYM (Qvector_slots, "vector-slots"); DEFSYM (Qheap, "heap"); - DEFSYM (Qautomatic_gc, "Automatic GC"); + DEFSYM (QAutomatic_GC, "Automatic GC"); DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");